No OneTemporary
Actions

Size

483 KB

Subscribers

None

View Options

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

	Index: trunk/src/qed_pdf/qed_pdf.nw
	===================================================================
	--- trunk/src/qed_pdf/qed_pdf.nw (revision 8963)
	+++ trunk/src/qed_pdf/qed_pdf.nw (revision 8964)
	@@ -1,3887 +1,3883 @@
	%% -- ess-noweb-wp-code-mode: f90-mode; noweb-wp-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: QED ISR structure functions ("PDFs")
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{QED Parton Distribution Functions}
	\label{chap:qed_pdf}
	\includemodulegraph{qed_pdf}

	We start with a module that gives access to the ISR structure function:
	\begin{description}
	\item[electron\_pdfs]
	\end{description}
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Electron PDFs}

	This module contains the formulae for the numerical evaluation of
	different incarnations of the QED initial-state radiation (ISR)
	structure functions (a.k.a. electron PDFs).

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

	module electron_pdfs

	<<Use kinds>>
	<<electron pdfs use>>

	<<Standard module head>>

	<<Electron PDFs: public>>

	<<Electron PDFs: parameters>>
	integer, parameter :: wp = default
	real(wp),parameter :: &
	pi = 3.1415926535897932384626433832795028841972_wp, &
	zeta2 = 1.6449340668482264364724151666460251892189_wp, &
	zeta3 = 1.2020569031595942853997381615114499907649_wp, &
	zeta4 = 1.0823232337111381915160036965411679027747_wp, &
	zeta5 = 1.0369277551433699263313654864570341680570_wp, &
	eulerc = 0.5772156649015328606065120900824024310421_wp, &
	pi2 = pi**2, &
	pi4 = pi**4, &
	ln2 = log(2._wp), &
	ln10 = log(10._wp)

	<<Electron PDFs: types>>

	interface
	<<Electron PDFs: sub interfaces>>
	end interface

	-contains
	-
	-<<Electron PDFs: main procedures>>
	-
	end module electron_pdfs
	@ %def electron_pdfs
	@
	<<electron pdfs use>>=
	use io_units
	use sm_qed, only: alpha_qed_t, alpha_qed_fixed_t, alpha_qed_from_scale_t
	@ %def electron_pdfs use
	@
	<<[[electron_pdfs_sub.f90]]>>=
	<<File header>>

	submodule (electron_pdfs) electron_pdfs_s

	<<Use strings>>
	<<electron pdfs use>>
	use diagnostics
	use format_defs, only: FMT_12
	use numeric_utils, only: log_prec
	use physics_defs, only: EPDF_LL, EPDF_NLL
	use sm_physics, only: polylog, Li2, psimr, psir

	implicit none

	contains

	<<Electron PDFs: procedures>>

	end submodule electron_pdfs_s
	@
	\subsection{The physics for electron beam PDFs (structure functions)}
	The ISR structure function is in the most crude approximation (LLA
	without $\alpha$ corrections, i.e. $\epsilon^0$)
	\begin{equation}
	f_0(x) = \epsilon (1-x)^{-1+\epsilon} \qquad\text{with}\qquad
	\epsilon = \frac{\alpha}{\pi}q_e^2\ln\frac{s}{m^2},
	\end{equation}
	where $m$ is the mass of the incoming (and outgoing) particle, which
	is initially assumed on-shell.

	Here, the form of $\epsilon$ results from the kinematical bounds for
	the momentum squared of the outgoing particle, which in the limit
	$m^2\ll s$ are given by
	\begin{align}
	t_0 &= -2\bar xE(E+p) + m^2 \approx -\bar x s,
	\\
	t_1 &= -2\bar xE(E-p) + m^2 \approx x m^2,
	\end{align}
	so the integration over the propagator $1/(t-m^2)$ yields
	\begin{equation}
	\ln\frac{t_0-m^2}{t_1-m^2} = \ln\frac{s}{m^2}.
	\end{equation}

	The structure function has three parameters: $\alpha$, $m_{\rm in}$ of
	the incoming particle and $s$, the hard scale. Internally, we store
	the exponent $\epsilon$ which is the relevant parameter. (In
	conventional
	notation, $\epsilon=\beta/2$.) As defaults, we take the
	actual values of $\alpha$ (which is probably $\alpha(s)$), the actual
	mass $m_{\rm in}$ and the squared total c.m. energy $s$.

	Including $\epsilon$, $\epsilon^2$, and $\epsilon^3$ corrections, the
	successive approximation of the ISR structure function read
	\begin{align}
	f_0(x) &= \epsilon(1-x)^{-1+\epsilon} \\
	f_1(x) &= g_1(\epsilon)\,f_0(x) - \frac{\epsilon}{2}(1+x) \\
	\begin{split}
	f_2(x) &= g_2(\epsilon)\,f_0(x) - \frac{\epsilon}{2}(1+x) \\
	&\quad - \frac{\epsilon^2}{8}\left(
	\frac{1+3x^2}{1-x}\ln x + 4(1+x) \ln(1-x) + 5 + x \right)
	\end{split} \\
	\begin{split}
	f_3(x) &= g_3(\epsilon)\,f_0(x) - \frac{\epsilon}{2}(1+x) \\
	&\quad - \frac{\epsilon^2}{8}\left(
	\frac{1+3x^2}{1-x}\ln x + 4(1+x) \ln(1-x) + 5 + x \right) \\
	&\quad - \frac{\epsilon^3}{48}\left( \vphantom{\frac{1}{1-x}}
	(1+x)\left[6\mathop{\rm Li_2}(x) + 12\ln^2(1-x) - 3\pi^2\right]\right.
	+ 6(x+5)\ln(1-x) \\
	&\qquad\qquad + \frac{1}{1-x}\left[\frac32(1+8x+3x^2)\ln x
	+ 12(1+x^2)\ln x\ln(1-x) \right. \\
	&\qquad\qquad\qquad\qquad
	\left.\left. - \frac12(1+7x^2)\ln^2x + \frac14(39-24x-15x^2)\right]
	\vphantom{\frac{1}{1-x}} \right)
	\end{split}
	\end{align}
	where the successive approximations to the prefactor of the leading
	singularity
	\begin{equation}
	g(\epsilon) = \frac{\exp\left(\epsilon(-\gamma_E + \tfrac34)\right)}
	{\Gamma(1 + \epsilon)},
	\end{equation}
	are given by
	\begin{align}
	g_0(\epsilon) &= 1 \\
	g_1(\epsilon) &= 1 + \frac34\epsilon \\
	g_2(\epsilon) &= 1 + \frac34\epsilon
	+ \frac{27 - 8\pi^2}{96}\epsilon^2 \\
	g_3(\epsilon) &= 1 + \frac34\epsilon
	+ \frac{27 - 8\pi^2}{96}\epsilon^2
	+ \frac{27 - 24\pi^2 + 128 \zeta(3)}{384}\epsilon^3,
	\end{align}
	where, numerically
	\begin{equation}
	\zeta(3) = 1.20205690315959428539973816151\ldots
	\end{equation}
	Although one could calculate the function $g(\epsilon)$ exactly,
	truncating its Taylor expansion ensures the exact normalization of the
	truncated structure function at each given order:
	\begin{equation}
	\int_0^1 dx\,f_i(x) = 1 \qquad\text{for all $i$.}
	\end{equation}

	Effectively, the $O(\epsilon)$ correction reduces the low-$x$ tail of
	the structure function by $50\%$ while increasing the coefficient of
	the singularity by $O(\epsilon)$. Relative to this, the
	$O(\epsilon^2)$ correction slightly enhances $x>\frac12$ compared to
	$x<\frac12$. At $x=0$, $f_2(x)$ introduces a logarithmic singularity
	which should be cut off at $x_0=O(e^{-1/\epsilon})$: for lower $x$ the
	perturbative series breaks down. The $f_3$ correction is slightly
	positive for low $x$ values and negative near $x=1$, where the
	$\mathop{\rm Li_2}$ piece slightly softens the singularity at $x=1$.

	Instead of the definition for $\epsilon$ given above, it is customary
	to include a universal nonlogarithmic piece:
	\begin{equation}
	\epsilon = \frac{\alpha}{\pi}q_e^2\left(\ln\tfrac{s}{m^2} - 1\right)
	\end{equation}

	\subsection{Implementation}

	The basic type for lepton beam (QED) structure functions:
	<<Electron PDFs: public>>=
	public :: qed_pdf_t
	<<Electron PDFs: types>>=
	type :: qed_pdf_t
	private
	integer :: flv = 0
	class(alpha_qed_t), allocatable :: aqed
	real(wp) :: mass = 0._wp
	real(wp) :: q_max = 0._wp
	real(wp) :: alpha = 0._wp
	real(wp) :: eps = 0._wp
	real(wp), allocatable :: q_in
	integer :: order
	integer :: log_order
	integer :: nlep
	logical :: running
	contains
	<<Electron PDFs: QED PDF: TBP>>
	end type qed_pdf_t

	@ %def qed_pdf_t
	@
	<<Electron PDFs: parameters>>=
	integer, parameter, public :: EPDF_ELE = 0, EPDF_POS = 1, &
	EPDF_S = 2, EPDF_NS = 3, EPDF_G = 4

	@ %def EPDF_ELE EPDF_POS EPDF_S EPDF_NS EPDF_G
	@
	<<Electron PDFs: public>>=
	public :: coeffqed_b0
	<<Electron PDFs: sub interfaces>>=
	module pure function coeffqed_b0(nf, nlep)
	integer, intent(in) :: nf, nlep
	real(wp) :: n_lep, coeffqed_b0
	end function coeffqed_b0
	<<Electron PDFs: procedures>>=
	module pure function coeffqed_b0(nf, nlep)
	integer, intent(in) :: nf, nlep
	real(wp) :: n_lep, coeffqed_b0
	n_lep = real(nlep, kind=wp)
	coeffqed_b0 = sumQ2q(nf) + n_lep/3._wp
	contains
	pure function sumQ2q (nf)
	integer, intent(in) :: nf
	real(wp) :: sumQ2q
	select case (nf)
	case (0)
	sumQ2q = 0.0_wp
	case (1)
	sumQ2q = 1.0_wp/9.0_wp
	case (2)
	sumQ2q = 5.0_wp/9.0_wp
	case (3)
	sumQ2q = 2.0_wp/3.0_wp
	case (4)
	sumQ2q = 10.0_wp/9.0_wp
	case (5)
	sumQ2q = 11.0_wp/9.0_wp
	case (6:)
	sumQ2q = 5.0_wp/3.0_wp
	end select
	end function sumQ2q
	end function coeffqed_b0

	@ %def coeffqed_b0
	@
	<<Electron PDFs: public>>=
	public :: coeffqed_b1
	<<Electron PDFs: sub interfaces>>=
	module pure function coeffqed_b1(nf, nlep)
	integer, intent(in) :: nf, nlep
	real(wp) :: n_lep, coeffqed_b1
	end function coeffqed_b1
	<<Electron PDFs: procedures>>=
	module pure function coeffqed_b1(nf, nlep)
	integer, intent(in) :: nf, nlep
	real(wp) :: n_lep, coeffqed_b1
	n_lep = real(nlep, kind=wp)
	coeffqed_b1 = sumQ4q(nf) + n_lep/4._wp
	contains
	pure function sumQ4q (nf)
	integer, intent(in) :: nf
	real(wp) :: sumQ4q
	select case (nf)
	case (0)
	sumQ4q = 0.0_wp
	case (1)
	sumQ4q = 1.0_wp/81.0_wp
	case (2)
	sumQ4q = 17.0_wp/81.0_wp
	case (3)
	sumQ4q = 2.0_wp/9.0_wp
	case (4)
	sumQ4q = 34.0_wp/81.0_wp
	case (5)
	sumQ4q = 35.0_wp/81.0_wp
	case (6:)
	sumQ4q = 17.0_wp/27.0_wp
	end select
	end function sumQ4q
	end function coeffqed_b1

	@ %def coeffqed_b1
	@
	<<Electron PDFs: QED PDF: TBP>>=
	procedure :: init => qed_pdf_init
	<<Electron PDFs: sub interfaces>>=
	module subroutine qed_pdf_init &
	(qed_pdf, mass, alpha, charge, q_max, order, log_order, nlep)
	class(qed_pdf_t), intent(out) :: qed_pdf
	real(default), intent(in) :: mass, alpha, q_max, charge
	integer, intent(in) :: order, log_order, nlep
	end subroutine qed_pdf_init
	<<Electron PDFs: procedures>>=
	module subroutine qed_pdf_init &
	(qed_pdf, mass, alpha, charge, q_max, order, log_order, nlep)
	class(qed_pdf_t), intent(out) :: qed_pdf
	real(default), intent(in) :: mass, alpha, q_max, charge
	integer, intent(in) :: order, log_order, nlep
	qed_pdf%mass = real(mass,kind=wp)
	qed_pdf%q_max = real(q_max,kind=wp)
	qed_pdf%alpha = real(alpha,kind=wp)
	qed_pdf%order = order
	qed_pdf%log_order = log_order
	qed_pdf%nlep = nlep
	qed_pdf%running = .false.
	qed_pdf%eps = alpha/pi * real(charge,kind=wp)**2 &
	* (2._wp * log (q_max / mass) - 1._wp)
	end subroutine qed_pdf_init

	@ %def qed_pdf_init
	@ Write routine.
	<<Electron PDFs: QED PDF: TBP>>=
	procedure :: write => qed_pdf_write
	<<Electron PDFs: sub interfaces>>=
	module subroutine qed_pdf_write (qed_pdf, unit, with_qed)
	class(qed_pdf_t), intent(in) :: qed_pdf
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: with_qed
	end subroutine qed_pdf_write
	<<Electron PDFs: procedures>>=
	module subroutine qed_pdf_write (qed_pdf, unit, with_qed)
	class(qed_pdf_t), intent(in) :: qed_pdf
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: with_qed
	integer :: u
	logical :: show_qed
	u = given_output_unit (unit)
	show_qed = .false.
	if (present (with_qed)) show_qed = with_qed
	write (u, "(3x,A)") "QED structure function (PDF):"
	write (u, "(5x,A,I0)") "Flavor = ", qed_pdf%flv
	write (u, "(5x,A," // FMT_12 // ")") "Mass = ", qed_pdf%mass
	write (u, "(5x,A," // FMT_12 // ")") "q_max = ", qed_pdf%q_max
	write (u, "(5x,A," // FMT_12 // ")") "alpha = ", qed_pdf%alpha
	write (u, "(5x,A,I0)") "Order = ", qed_pdf%order
	write (u, "(5x,A,I0)") "Log. ord. = ", qed_pdf%log_order
	write (u, "(5x,A,I0)") "# leptons = ", qed_pdf%nlep
	write (u, "(5x,A,I0)") "Run. Coupling = ", qed_pdf%running
	write (u, "(5x,A," // FMT_12 // ")") "epsilon = ", qed_pdf%eps
	if (show_qed) then
	call qed_pdf%aqed%write (u)
	end if
	end subroutine qed_pdf_write

	@ %def qed_pdf_write
	@ For some unit tests, the order has to be set explicitly.
	<<Electron PDFs: QED PDF: TBP>>=
	procedure :: set_order => qed_pdf_set_order
	<<Electron PDFs: sub interfaces>>=
	module subroutine qed_pdf_set_order (qed_pdf, order)
	class(qed_pdf_t), intent(inout) :: qed_pdf
	integer, intent(in) :: order
	end subroutine qed_pdf_set_order
	<<Electron PDFs: procedures>>=
	module subroutine qed_pdf_set_order (qed_pdf, order)
	class(qed_pdf_t), intent(inout) :: qed_pdf
	integer, intent(in) :: order
	qed_pdf%order = order
	end subroutine qed_pdf_set_order

	@ %def qed_pdf_set_order
	@ Calculate the actual value depending on the order and a possible
	mapping parameter.
	<<Electron PDFs: QED PDF: TBP>>=
	procedure :: evolve_qed_pdf => qed_pdf_evolve_qed_pdf
	<<Electron PDFs: sub interfaces>>=
	module subroutine qed_pdf_evolve_qed_pdf (qed_pdf, x, xb, rb, ff)
	class(qed_pdf_t), intent(inout) :: qed_pdf
	real(default), intent(in) :: x, xb, rb
	real(default), intent(inout) :: ff
	end subroutine qed_pdf_evolve_qed_pdf
	<<Electron PDFs: procedures>>=
	module subroutine qed_pdf_evolve_qed_pdf (qed_pdf, x, xb, rb, ff)
	class(qed_pdf_t), intent(inout) :: qed_pdf
	real(default), intent(in) :: x, xb, rb
	real(default), intent(inout) :: ff
	real(default), parameter :: &
	& xmin = 0.00714053329734592839549879772019_default
	real(default), parameter :: &
	g1 = 3._default / 4._default, &
	g2 = (27 - 8 * pi2) / 96._default, &
	g3 = (27 - 24 * pi2 + 128 * zeta3) / 384._default
	real(default) :: x_2, log_x, log_xb
	if (ff > 0 .and. qed_pdf%order > 0) then
	ff = ff * (1 + g1 * qed_pdf%eps)
	x_2 = x * x
	if (rb > 0) ff = ff * (1 - (1-x_2) / (2 * rb))
	if (qed_pdf%order > 1) then
	ff = ff * (1 + g2 * qed_pdf%eps**2)
	if (rb > 0 .and. xb > 0 .and. x > xmin) then
	log_x = log_prec (x, xb)
	log_xb = log_prec (xb, x)
	ff = ff * (1 - ((1 + 3 * x_2) * log_x + xb * (4 * (1 + x) * &
	log_xb + 5 + x)) / (8 * rb) * qed_pdf%eps)
	end if
	if (qed_pdf%order > 2) then
	ff = ff * (1 + g3 * qed_pdf%eps**3)
	if (rb > 0 .and. xb > 0 .and. x > xmin) then
	ff = ff * (1 - ((1 + x) * xb &
	* (6 * Li2(x) + 12 * log_xb*2 - 3 pi2) &
	+ 1.5_default * (1 + 8 * x + 3 * x_2) * log_x &
	+ 6 * (x + 5) * xb * log_xb &
	+ 12 * (1 + x_2) * log_x * log_xb &
	- (1 + 7 * x_2) * log_x**2 / 2 &
	+ (39 - 24 * x - 15 * x_2) / 4) &
	/ (48 * rb) * qed_pdf%eps**2)
	end if
	end if
	end if
	end if
	end subroutine qed_pdf_evolve_qed_pdf

	@ %def qed_pdf_evolve_qed_pdf
	@
	<<Electron PDFs: QED PDF: TBP>>=
	procedure :: allocate_aqed => qed_pdf_allocate_aqed
	<<Electron PDFs: sub interfaces>>=
	module subroutine qed_pdf_allocate_aqed (qed, order, n_f, nlep, running)
	class(qed_pdf_t), intent(inout) :: qed
	integer, intent(in) :: order, n_f, nlep
	logical, intent(in) :: running
	end subroutine qed_pdf_allocate_aqed
	-<<Electron PDFs: main procedures>>=
	+<<Electron PDFs: procedures>>=
	module subroutine qed_pdf_allocate_aqed (qed, order, n_f, nlep, running)
	class(qed_pdf_t), intent(inout) :: qed
	integer, intent(in) :: order, n_f, nlep
	logical, intent(in) :: running
	qed%running = running
	if (running) then
	allocate (alpha_qed_from_scale_t :: qed%aqed)
	select type (aqed => qed%aqed)
	type is (alpha_qed_from_scale_t)
	aqed%order = order
	aqed%nf = n_f
	aqed%nlep = nlep
	end select
	else
	allocate (alpha_qed_fixed_t :: qed%aqed)
	end if
	end subroutine qed_pdf_allocate_aqed

	@ %def qed_pdf_allocate_qed
	@ Part for the singlet- and non-singlet contributions of the PDF.
	<<Electron PDFs: public>>=
	public :: set_qed_pdf_parameters
	<<Electron PDFs: sub interfaces>>=
	module subroutine set_qed_pdf_parameters &
	(epdf, scale, alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	type(qed_pdf_t), intent(in) :: epdf
	real(wp), intent(in) :: scale
	logical, intent(out) :: running
	real(wp), intent(out) :: ln0, eta0, p, alpha, al0_2pi, al_2pi, n, run
	integer, intent(out) :: nlep, nf
	logical, dimension(6), intent(out) :: order
	end subroutine set_qed_pdf_parameters
	<<Electron PDFs: procedures>>=
	module subroutine set_qed_pdf_parameters &
	(epdf, scale, alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	type(qed_pdf_t), intent(in) :: epdf
	real(wp), intent(in) :: scale
	real(wp), intent(out) :: ln0, eta0, p, alpha, al0_2pi, al_2pi, n, run
	logical, intent(out) :: running
	integer, intent(out) :: nlep, nf
	logical, dimension(6), intent(out) :: order
	order = .false.
	running=epdf%running
	alpha=epdf%alpha
	al0_2pi = alpha / 2._wp / pi
	if (allocated (epdf%q_in)) then
	ln0 = 2._wp*log(epdf%q_in/epdf%mass)
	eta0 = alpha/pi * 2._wp*log(scale/epdf%q_in)
	else
	ln0 = 0._wp
	eta0 = alpha/pi * 2._wp*log(scale/epdf%mass)
	end if
	if (running) then
	p = t_alpha (epdf, scale)
	run = 1._wp
	else
	p = eta0 / 2._wp
	run = 0._wp
	end if
	select case (epdf%log_order)
	case (EPDF_LL)
	order(1:4) = .true.
	nlep = epdf%nlep
	nf = 0
	al_2pi = 0._wp
	case (EPDF_NLL)
	order(1:6) = .true.
	if (running) then
	select type (aqed => epdf%aqed)
	type is (alpha_qed_from_scale_t)
	nf = aqed%nf
	nlep = aqed%nlep
	al_2pi = aqed%get(scale) / 2._wp / pi
	type is (alpha_qed_fixed_t)
	call msg_fatal &
	("Object has to be called with running alpha.")
	end select
	else
	nlep = epdf%nlep
	al_2pi = al0_2pi
	end if
	end select
	n = real(nlep, kind=wp)
	end subroutine set_qed_pdf_parameters

	@ %def set_qed_pdf_parameters
	@
	<<Electron PDFs: public>>=
	public :: elec_asym
	<<Electron PDFs: sub interfaces>>=
	module pure function elec_asym &
	(xb, nlep, nf, n, p, al0_2pi, al_2pi, order, running) &
	result (elec_as)
	real(wp), dimension(7,7,2) :: elec_as
	real(wp), intent(in) :: xb
	real(wp), intent(in) :: n, p, al0_2pi, al_2pi
	integer, intent(in) :: nf, nlep
	logical, intent(in) :: running
	logical, intent(in), dimension(6) :: order
	end function elec_asym
	<<Electron PDFs: procedures>>=
	module pure function elec_asym &
	(xb, nlep, nf, n, p, al0_2pi, al_2pi, order, running) &
	result (elec_as)
	real(wp), dimension(7,7,2) :: elec_as
	real(wp), intent(in) :: xb
	real(wp), intent(in) :: n, p, al0_2pi, al_2pi
	integer, intent(in) :: nf, nlep
	logical, intent(in) :: running
	logical, intent(in), dimension(6) :: order
	real(wp), parameter :: lambda0 = 3._wp/4._wp
	real(wp) :: lambda1, xi0, xi1, xihat1, fac, ex0
	real(wp) :: ca, cb, b0, b01
	elec_as=0.0_wp
	xi0 = 2._wp*p
	if ( order(5) .eqv. .false. ) then
	elec_as(7,4,1) = exp((lambda0 - eulerc)xi0) / gamma (xi0) &
	xb**(xi0 - 1._wp)
	else
	lambda1 = 3._wp/16._wp - pi2/4._wp + 3._wp*zeta3 - &
	n(3._wp + 4._wppi2)/36._wp
	if (running) then
	b0 = coeffqed_b0(nf,nlep)
	b01 = coeffqed_b1(nf,nlep)/b0
	ex0 = al_2pi(1._wp - exp(-b0xi0))/b0
	xi1 = xi0 - 2._wpex0(5._wp/9._wp*n + b01)
	xihat1 = xi0lambda0 + ex0(lambda1 - 3._wp/2._wp*b01)
	else
	xi1 = xi0(1._wp - 10._wp/9._wpal_2pi*n)
	xihat1 = xi0(lambda0 + al_2pilambda1)
	end if
	fac = exp(xihat1 - eulercxi1) xb**(xi1 - 1._wp) / gamma(xi1)
	ca = eulerc + psir(xi1) - 0.5_wp
	cb = 2._wp(ca*2 - psimr(xi1,1)) + pi2/3._wp - 2.5_wp
	elec_as(7,4,1) = fac(1._wp - al0_2picb)
	elec_as(7,4,2) = fac*(0.25_wp - ca)
	elec_as(7,5,2) = fac2._wpal0_2pi
	elec_as(7,5,1) = 2._wpcaelec_as(7,5,2)
	elec_as(7,6,1) = -elec_as(7,5,2)
	end if
	end function elec_asym

	@ %def elec_asym
	@ Photon component of the PDF.
	<<Electron PDFs: public>>=
	public :: phot_asym
	<<Electron PDFs: sub interfaces>>=
	module pure function phot_asym &
	(x, xb, log_xb, n, p, al0_2pi, order, running) result (phot_as)
	real(wp), dimension(7,7,2) :: phot_as
	real(wp), intent(in) :: x, xb, log_xb
	real(wp), intent(in) :: p, n, al0_2pi
	logical, intent(in) :: running
	logical, intent(in), dimension(6) :: order
	end function phot_asym
	<<Electron PDFs: procedures>>=
	module pure function phot_asym &
	(x, xb, log_xb, n, p, al0_2pi, order, running) result (phot_as)
	real(wp), dimension(7,7,2) :: phot_as
	real(wp), intent(in) :: x, xb, log_xb
	real(wp), intent(in) :: p, n, al0_2pi
	logical, intent(in) :: running
	logical, intent(in), dimension(6) :: order
	real(wp) :: lambda1, xi10, xihat10
	real(wp) :: xi0, den
	real(wp) :: mf1k, mf10, ca, cb, fac0, fac
	real(wp) :: d1, d2, cc, k0
	phot_as = 0.0_wp
	xi0 = 2._wp*p
	if (order(5) .eqv. .false. ) then
	den = -2._wp/3._wpn - 3._wp/2._wp - 2._wplog_xb
	mf10 = 1._wp - 2._wp/3._wppi2/den*2
	mf1k = 1._wp - xi0(pi2/3._wp - 2._wpzeta3*xi0)/den - &
	(2._wp/3._wppi2 - (8._wpzeta3 - pi4/45._wpxi0)xi0)/den**2
	phot_as(7,4,1) = ( &
	exp(-xi0n/3._wp)mf10 - &
	exp((3._wp/4._wp - eulerc + log_xb)xi0)/gamma(1._wp+xi0)mf1k &
	)/den
	else
	lambda1 = 1._wp/4._wp - pi2/3._wp + 4._wp*zeta3 - &
	n(3._wp + 4._wppi2)/27._wp
	ca = 5._wp + 4._wp/3._wp*n
	if (running) then
	xi10 = 2._wp(1._wp - al0_2pi(10._wp/9._wp*n + 3._wp/2._wp))
	xihat10 = 3._wp/2._wp(1._wp + al0_2pi(lambda1 - 3._wp/2._wp))
	cb = (pi2/2._wp - 22._wp + 8._wp*ca)/3._wp + 3._wp/2._wp
	fac0 = 2._wpexp(-nxi0/3._wp)
	d2 = -((2._wp/3._wp)*n + xihat10)/xi10
	d1 = d2 - (2._wp/3._wp)*n/xi10
	cc = exp(-n*xi0/3._wp)
	else
	xi10 = 2._wp(1._wp - 10._wp/9._wpal0_2pi*n)
	xihat10 = 3._wp/2._wp(1._wp + al0_2pilambda1)
	cb = (pi2/2._wp - 22._wp + 8._wp*ca)/3._wp
	fac0 = 2._wpexp(-(2._wp/3._wp + al0_2pi)n*p)
	d2 = -((2._wp/3._wp + al0_2pi)*n + xihat10)/xi10
	d1 = d2
	cc = 1._wp
	end if
	k0 = xi10*p
	phot_as(7,:,:) = sum_rm(log_xb, al0_2pi, ca, cb, d1, d2, cc, k0)/xi10
	phot_as(7,3,1) = -al0_2pi(2._wpxb/x + x)
	phot_as(7,4,1) = phot_as(7,4,1) + phot_as(7,3,1)/2._wp
	phot_as(7,4,2) = phot_as(7,4,2) - phot_as(7,4,1)
	phot_as = fac0*phot_as
	end if
	end function phot_asym

	@ %def phot_asym
	@
	<<Electron PDFs: public>>=
	public :: recasym
	<<Electron PDFs: sub interfaces>>=
	module function recasym &
	(flv, x, xb, log_xb, nlep, nf, n, p, &
	al0_2pi, al_2pi, order, running) result (jll_nll)
	integer, intent(in) :: flv, nlep, nf
	real(wp), intent(in) :: x, xb, log_xb
	real(wp), intent(in) :: n, p, al0_2pi, al_2pi
	logical, intent(in) :: running
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2) :: jll_nll
	end function recasym
	<<Electron PDFs: procedures>>=
	module function recasym &
	(flv, x, xb, log_xb, nlep, nf, n, p, &
	al0_2pi, al_2pi, order, running) result (jll_nll)
	integer, intent(in) :: flv, nlep, nf
	real(wp), intent(in) :: x, xb, log_xb
	real(wp), intent(in) :: n, p, al0_2pi, al_2pi
	logical, intent(in) :: running
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2) :: jll_nll
	jll_nll = 0.0
	select case (flv)
	case (EPDF_ELE,EPDF_S,EPDF_NS)
	jll_nll = elec_asym &
	(xb, nlep, nf, n, p, al0_2pi, al_2pi, order, running)
	case (EPDF_POS)
	jll_nll = 0._wp
	case (EPDF_G)
	jll_nll = phot_asym &
	(x, xb, log_xb, n, p, al0_2pi, order, running)
	case default
	call msg_fatal &
	("recasym: wrong lepton flavor.")
	end select
	end function recasym

	@ %def recasym
	@
	<<Electron PDFs: public>>=
	public :: bar_asym
	<<Electron PDFs: sub interfaces>>=
	module function bar_asym (flv, xb, n, run, order) result (jll_nll)
	integer, intent(in) :: flv
	real(wp), intent(in) :: xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2) :: jll_nll
	end function bar_asym
	<<Electron PDFs: procedures>>=
	module function bar_asym (flv, xb, n, run, order) result (jll_nll)
	integer, intent(in) :: flv
	real(wp), intent(in) :: xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2) :: jll_nll
	select case (flv)
	case (EPDF_ELE,EPDF_S,EPDF_NS)
	call elecbar_asym_p (xb, jll_nll, n, run, order)
	case (EPDF_POS)
	jll_nll = 0._wp
	case (EPDF_G)
	call photbar_asym_p (jll_nll, n, run, order)
	case default
	call msg_fatal &
	("bar_asym: wrong lepton flavor.")
	end select
	end function bar_asym

	@ %def bar_asym
	@
	<<Electron PDFs: public>>=
	public :: recnum
	<<Electron PDFs: sub interfaces>>=
	module function recnum &
	(flv, x, xb, xp, pl, n) result (jll_nll)
	integer, intent(in) :: flv
	real(wp), dimension(7,7,2) :: jll_nll
	real(wp), intent(in) :: x, xb, xp, n
	real(wp), dimension(12), intent(in) :: pl
	end function recnum
	<<Electron PDFs: procedures>>=
	module function recnum &
	(flv, x, xb, xp, pl, n) result (jll_nll)
	integer, intent(in) :: flv
	real(wp), dimension(7,7,2) :: jll_nll
	real(wp), intent(in) :: x, xb, xp, n
	real(wp), dimension(12), intent(in) :: pl
	jll_nll = 0._wp
	select case (flv)
	case (EPDF_S)
	jll_nll(6,:,1) = endpoint_func_S (x, xb, xp, pl, n)
	case (EPDF_NS)
	jll_nll(6,:,1) = endpoint_func_NS (x, xb, xp, pl, n)
	case (EPDF_G)
	jll_nll(6,:,1) = endpoint_func_GAM (x, xb, xp, pl)
	case (EPDF_ELE)
	jll_nll(6,:,1) = endpoint_func_ELE (x, xb, xp, pl, n)
	case (EPDF_POS)
	jll_nll(6,:,1) = endpoint_func_POS (x, xb, xp, pl, n)
	case default
	call msg_fatal &
	("recnum: wrong lepton flavor.")
	end select
	end function recnum

	@ %def recnum
	@
	<<Electron PDFs: public>>=
	public :: recbar
	<<Electron PDFs: sub interfaces>>=
	module function recbar &
	(flv, x, xb, n, run, order) result (jll_nll)
	integer, intent(in) :: flv
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2) :: jll_nll
	end function recbar
	<<Electron PDFs: procedures>>=
	module function recbar &
	(flv, x, xb, n, run, order) result (jll_nll)
	integer, intent(in) :: flv
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2) :: jll_nll
	select case (flv)
	case (EPDF_S)
	call recbar_singlet (x, xb, jll_nll, n, run, order)
	case (EPDF_NS)
	call recbar_nonsinglet (x, xb, jll_nll, n, run, order)
	case (EPDF_G)
	call recbar_photon (jll_nll, x, xb, n, run, order)
	case (EPDF_ELE)
	call recbar_ele (x, xb, jll_nll, n, run, order)
	case (EPDF_POS)
	call recbar_pos (jll_nll, n, run, order)
	case default
	call msg_fatal &
	("recbar: wrong lepton flavor.")
	end select
	end function recbar

	@ %def recbar
	<<Electron PDFs: public>>=
	public :: rechat
	<<Electron PDFs: sub interfaces>>=
	module function rechat &
	(flv, x, xb, xp, pl, n, run, order) result (jll_nll)
	integer, intent(in) :: flv
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2) :: jll_nll
	end function rechat
	<<Electron PDFs: procedures>>=
	module function rechat &
	(flv, x, xb, xp, pl, n, run, order) result (jll_nll)
	integer, intent(in) :: flv
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2) :: jll_nll
	select case (flv)
	case (EPDF_S)
	call rechat_singlet (x, xb, xp, pl, jll_nll, n, run, order)
	case (EPDF_G)
	call rechat_photon (x, xb, xp, pl, jll_nll, n, run, order)
	case (EPDF_NS)
	call rechat_nonsinglet (x, xb, xp, pl, jll_nll, n, run, order)
	case (EPDF_ELE)
	call rechat_ele (x, xb, xp, pl, jll_nll, n, run, order)
	case (EPDF_POS)
	call rechat_pos (x, xb, xp, pl, jll_nll, n, run, order)
	case default
	call msg_fatal &
	("rechat: wrong lepton flavor.")
	end select
	end function rechat

	@ %def rechat
	@ The logical array [[order]] allows to individually switch the
	expansion terms on and off. For LL, the first three are taken, for NLL
	all of them.
	<<Electron PDFs: public>>=
	public :: elecbar_asym_p
	<<Electron PDFs: sub interfaces>>=
	module subroutine elecbar_asym_p (xb, jll_nll, n, run, order)
	real(wp), intent(in) :: xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine elecbar_asym_p
	<<Electron PDFs: procedures>>=
	module subroutine elecbar_asym_p (xb, jll_nll, n, run, order)
	real(wp), intent(in) :: xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	jll_nll = 0._wp
	if (order(1)) then
	jll_nll(1,4,1)=2._wp
	end if
	if (order(2)) then
	jll_nll(2,4,1)=6._wp
	jll_nll(2,5,1)=8._wp
	end if
	if (order(3)) then
	jll_nll(3,4,1)=27._wp/2._wp - 4._wp*pi2
	jll_nll(3,5,1)=36._wp
	jll_nll(3,6,1)=24._wp
	end if
	if (order(4)) then
	jll_nll(4,4,1)=-2._wp
	jll_nll(4,4,2)=2._wp
	jll_nll(4,5,1)=-4._wp
	end if
	if (order(5)) then
	jll_nll(5,4,1)=1._wp- &
	4._wp(5._wp/9._wpn - pi2/3._wp - (n/3._wp-3._wp/4._wp)*run)
	jll_nll(5,4,2)=2._wp(3._wp-2._wp/3._wpn*run)
	jll_nll(5,5,1)=-2._wp(7._wp-4._wp/3._wpn*run)
	jll_nll(5,5,2)=8._wp
	jll_nll(5,6,1)=-12._wp
	end if
	if (order(6)) then
	jll_nll(6,4,1)=2._wp(4.5_wp - 20._wpzeta3 + 3._wp*pi2 - &
	n(11._wp+ (4._wp/3._wp)pi2)/3._wp - &
	2._wp(4._wp + 4._wp/9._wppi2 + 2._wp/9._wpn2 - 1._wp/27._wpn)*run)
	jll_nll(6,4,2)= 2._wp(6.75_wp - 2._wppi2 - &
	4._wp(1._wp - n/3._wp)n*run)
	jll_nll(6,5,1)=-2._wp(8.5_wp + (80._wp/9._wp)n - (20._wp/3._wp)*pi2 + &
	4._wp(3._wp - 7._wp/3._wpn + 2._wp/9._wpn2)run)
	jll_nll(6,5,2)=4._wp(9._wp - 8._wp/3._wpn*run)
	jll_nll(6,6,1)=-12._wp(5._wp - 4._wp/3._wpn*run)
	jll_nll(6,6,2)=24._wp
	jll_nll(6,7,1)=-32._wp
	end if
	jll_nll = jll_nll/xb
	end subroutine elecbar_asym_p

	@ %def elecbar_asym
	@
	<<Electron PDFs: public>>=
	public :: photbar_asym_p
	<<Electron PDFs: sub interfaces>>=
	module subroutine photbar_asym_p (jll_nll, n, run, order)
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine photbar_asym_p
	<<Electron PDFs: procedures>>=
	module subroutine photbar_asym_p (jll_nll, n, run, order)
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	jll_nll = 0._wp
	if (order(1)) then
	jll_nll(1,4,1)=1._wp
	end if
	if (order(2)) then
	jll_nll(2,4,1)=1.5_wp - (2._wp * n)/3._wp
	jll_nll(2,5,1)=2._wp
	end if
	if (order(3)) then
	jll_nll(3,4,1)=2.25_wp - n + 4._wp * n*2 / 9._wp - (2._wppi2)/3._wp
	jll_nll(3,5,1)=6._wp - (4._wp*n)/3._wp
	jll_nll(3,6,1)=4._wp
	end if
	if (order(4)) then
	jll_nll(4,4,1)=- 1._wp
	jll_nll(4,4,2)=1._wp
	end if
	if (order(5)) then
	jll_nll(5,4,1)=-4._wp - 26._wp/9._wpn + 2._wp(n/3._wp - 3._wp/4._wp)*run
	jll_nll(5,4,2)=3._wp/2._wp - 2._wp/3._wpn - 2._wp/3._wpn*run
	jll_nll(5,5,1)=-7._wp - 4._wp/3._wp*n
	jll_nll(5,5,2)=2._wp
	jll_nll(5,6,1)=-3._wp
	end if
	if (order(6)) then
	jll_nll(6,4,1)= -5.625_wp + 11._wp/6._wppi2 - 6._wpzeta3 + &
	(2._wp/9._wppi2 - 23._wp/6._wp)n + 52._wp * n**2/27._wp + &
	(13._wp/3._wpn - 9._wp/2._wp + 28._wp/27._wpn*2)run
	jll_nll(6,4,2)=2.25_wp - 2._wp/3._wp*pi2 - &
	n + 4._wp/9._wpn2 + 2._wp(8._wp/9._wpn - 1._wp)n*run
	jll_nll(6,5,1)=-18.5_wp + 2._wppi2 + 8._wp/9._wpn*2 - 20._wp/3._wpn + &
	2._wp(3._wpn - 3._wp + 4._wp/9._wpn2)run
	jll_nll(6,5,2)=2._wp(3._wp - 2._wpn/3._wp - 4._wp/3._wpnrun)
	jll_nll(6,6,1)=-18.5_wp - 2._wp/3._wpn + 10._wp/3._wpn*run
	jll_nll(6,6,2)=4._wp
	jll_nll(6,7,1)=-6._wp
	end if
	end subroutine photbar_asym_p

	@ %def photbar_asym_p
	@
	<<Electron PDFs: public>>=
	public :: recbar_singlet
	<<Electron PDFs: sub interfaces>>=
	module subroutine recbar_singlet (x, xb, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine recbar_singlet
	<<Electron PDFs: procedures>>=
	module subroutine recbar_singlet (x, xb, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	real(wp), dimension(7,7,2) :: jll_nll_pos, jll_nll_ele
	call recbar_ele (x, xb, jll_nll_ele, n, run, order)
	call recbar_pos (jll_nll_pos, n, run, order)
	jll_nll = add_logvec(jll_nll_ele,jll_nll_pos)
	end subroutine recbar_singlet

	@ %def recbar_singlet
	@
	<<Electron PDFs: public>>=
	public :: recbar_nonsinglet
	<<Electron PDFs: sub interfaces>>=
	module subroutine recbar_nonsinglet (x, xb, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine recbar_nonsinglet
	<<Electron PDFs: procedures>>=
	module subroutine recbar_nonsinglet (x, xb, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	real(wp), dimension(7,7,2) :: jll_nll_pos, jll_nll_ele
	call recbar_ele (x, xb, jll_nll_ele, n, run, order)
	call recbar_pos (jll_nll_pos, n, run, order)
	jll_nll = sub_logvec(jll_nll_ele,jll_nll_pos)
	end subroutine recbar_nonsinglet

	@ %def recbar_nonsinglet
	@
	<<Electron PDFs: public>>=
	public :: recbar_photon
	<<Electron PDFs: sub interfaces>>=
	module subroutine recbar_photon (jll_nll, x, xb, n, run, order)
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine recbar_photon
	<<Electron PDFs: procedures>>=
	module subroutine recbar_photon (jll_nll, x, xb, n, run, order)
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	jll_nll = 0._wp
	if (x .le. 0.1e-5_wp) then
	if (order(1)) then
	jll_nll(1,4,1) = 1._wp
	end if
	if (order(2)) then
	jll_nll(2,4,1) = (9._wp - 4._wp*n)/6._wp
	end if
	if (order(3)) then
	jll_nll(3,4,1) = (-4._wp(9._wp - 4._wpn)n + 3._wp(27._wp - 8._wp*pi2))/36._wp
	jll_nll(3,4,1) = (-4._wp(9._wp - 4._wpn)n + 3._wp(27._wp - 8._wp*pi2))/36._wp
	jll_nll(3,5,1) = (2._wp(9._wp - 2._wpn))/3._wp
	jll_nll(3,6,1) = 4._wp
	end if
	if (order(4)) then
	jll_nll(4,4,1) = -1._wp
	jll_nll(4,4,1) = -1._wp
	end if
	if (order(5)) then
	jll_nll(5,4,1) = (-4._wpn(13._wp - 3._wprun) - 9._wp(8._wp + 3._wp*run))/18._wp
	jll_nll(5,4,2) = (9._wp - 4._wpn(1._wp + run))/6._wp
	end if
	if (order(6)) then
	jll_nll(6,4,1)=(4._wpn(8._wpn(13._wp + 7._wp*run) - &
	3._wp(69._wp - 2._wp(2._wppi2 + 39._wprun))) - &
	9._wp(135._wp - 4._wp(11._wppi2 + 9._wp(-3._wprun - 4._wpzeta3))))/216._wp
	jll_nll(6,4,2) = (3._wp(27._wp - 8._wppi2) + &
	4._wpn(-9._wp(1._wp + 2._wprun) + 4._wpn(1._wp + 3._wp*run)))/36._wp
	end if
	elseif (xb .le. 1.0e-7_wp) then
	if (order(1)) then
	jll_nll(1,4,1) = 1._wp
	end if
	if (order(2)) then
	jll_nll(2,4,1) = (9._wp - 4._wp*n)/6._wp
	jll_nll(2,5,1) = 2._wp
	end if
	if (order(3)) then
	jll_nll(3,4,1) = (-4._wp(9._wp - 4._wpn)n + 3._wp(27._wp - 8._wp*pi2))/36._wp
	jll_nll(3,5,1) = (2._wp(9._wp - 2._wpn))/3._wp
	jll_nll(3,6,1) = 4._wp
	end if
	if (order(4)) then
	jll_nll(4,4,1) = -1._wp
	end if
	if (order(5)) then
	jll_nll(5,4,1) = (-4._wpn(13._wp - 3._wprun) - 9._wp(8._wp + 3._wp*run))/18._wp
	jll_nll(5,5,1) = (-21._wp - 4._wp*n)/3._wp
	jll_nll(5,6,1) = -3._wp
	jll_nll(5,4,2) = (9._wp - 4._wpn(1._wp + run))/6._wp
	end if
	if (order(6)) then
	jll_nll(6,4,1)=(4._wpn(8._wpn(13._wp + 7._wp*run) - &
	3._wp(69._wp - 2._wp(2._wppi2 + 39._wprun))) - 9._wp*(135._wp - &
	4._wp(11._wppi2 + 9._wp(-3._wprun - 4._wp*zeta3))))/216._wp
	jll_nll(6,5,1)=(-9._wp(37._wp - 4._wp(pi2 - 3._wp*run)) + &
	4._wpn(-3._wp(10._wp - 9._wprun) + 4._wpn(1._wp + run)))/18._wp
	jll_nll(6,6,1) = (-111._wp - 4._wpn(1._wp - 5._wp*run))/6._wp
	jll_nll(6,7,1) = -6._wp
	jll_nll(6,4,2) = (3._wp(27._wp - 8._wppi2) + &
	4._wpn(-9._wp(1._wp + 2._wprun) + 4._wpn(1._wp + 3._wp*run)))/36._wp
	jll_nll(6,5,2) = (2._wp(9._wp - 2._wpn(1._wp + 2._wprun)))/3._wp
	end if
	else
	if (order(1)) then
	jll_nll(1,4,1)=1._wp
	end if
	if (order(2)) then
	jll_nll(2,4,1)=3._wp/2._wp - (2._wp*n)/3._wp
	jll_nll(2,5,1)=2._wp
	end if
	if (order(3)) then
	jll_nll(3,4,1)=9._wp/4._wp + (-1._wp + (4._wpn)/9._wp)n - (2._wp*pi2)/3._wp
	jll_nll(3,5,1)=6._wp - (4._wp*n)/3._wp
	jll_nll(3,6,1)=4._wp
	end if
	if (order(4)) then
	jll_nll(4,4,1)=-1._wp
	jll_nll(4,4,2)=1._wp
	end if
	if (order(5)) then
	jll_nll(5,4,1) = (-4._wpn(13._wp - 3._wprun) - 9._wp(8._wp + 3._wp*run))/18._wp
	jll_nll(5,5,1) = (-21._wp - 4._wp*n)/3._wp
	jll_nll(5,6,1) = -3._wp
	jll_nll(5,4,2) = (9._wp - 4._wpn(1._wp + run))/6._wp
	end if
	if (order(6)) then
	jll_nll(6,4,1)=(4._wpn(8._wpn(13._wp + 7._wprun) - 3._wp(69._wp - &
	2._wp(2._wppi2 + 39._wprun))) - 9._wp(135._wp - 4._wp(11._wppi2 + &
	9._wp(-3._wprun - 4._wp*zeta3))))/216._wp
	jll_nll(6,5,1)=(-9._wp(37._wp - 4._wp(pi2 - 3._wp*run)) + &
	4._wpn(-3._wp(10._wp - 9._wprun) + 4._wpn(1._wp + run)))/18._wp
	jll_nll(6,6,1) = (-111._wp - 4._wpn(1._wp - 5._wp*run))/6._wp
	jll_nll(6,7,1) = -6._wp
	jll_nll(6,4,2) = (3._wp(27._wp - 8._wppi2) + 4._wpn(-9._wp*(1._wp + &
	2._wprun) + 4._wpn(1._wp + 3._wprun)))/36._wp
	jll_nll(6,5,2) = (2._wp(9._wp - 2._wpn(1._wp + 2._wprun)))/3._wp
	jll_nll(6,6,2) = 4._wp
	end if
	end if
	end subroutine recbar_photon

	@ %def recbar_photon
	@
	<<Electron PDFs: public>>=
	public :: recbar_ele
	<<Electron PDFs: sub interfaces>>=
	module subroutine recbar_ele (x, xb, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine recbar_ele
	<<Electron PDFs: procedures>>=
	module subroutine recbar_ele (x, xb, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	jll_nll = 0._wp
	if (x .le. 0.1e-5_wp) then
	if (order(1)) then
	jll_nll(1,4,1) = 2._wp*x
	end if
	if (order(2)) then
	jll_nll(2,4,1) = 4._wp
	end if
	if (order(3)) then
	jll_nll(3,4,1) = 18._wp
	end if
	if (order(4)) then
	jll_nll(4,4,1) = -2._wp*x
	jll_nll(4,4,2) = 2._wp*x
	end if
	if (order(5)) then
	jll_nll(5,4,1) = (-3._wp + 4._wp*n)/3._wp
	jll_nll(5,4,2) = 4._wp
	end if
	if (order(6)) then
	jll_nll(6,4,1) = (3._wp(15._wp + 4._wp(2._wppi2 - 9._wprun)) - &
	2._wpn(22._wp - (15._wp - 4._wpn)run))/9._wp
	jll_nll(6,4,2) = (2._wp(27._wp - 8._wpn*run))/3._wp
	end if
	elseif (xb .le. 1.0e-7_wp) then
	if (order(1)) then
	jll_nll(1,4,1) = 2._wp/xb
	end if
	if (order(2)) then
	jll_nll(2,4,1) = 6._wp/xb
	jll_nll(2,5,1) = 8._wp/xb
	end if
	if (order(3)) then
	jll_nll(3,4,1) = (27._wp - 8._wppi2)/(2._wpxb)
	jll_nll(3,5,1) = 36._wp/xb
	jll_nll(3,6,1) = 24._wp/xb
	end if
	if (order(4)) then
	jll_nll(4,4,1) = -2._wp/xb
	jll_nll(4,5,1) = -4._wp/xb
	jll_nll(4,4,2) = 2._wp/xb
	end if
	if (order(5)) then
	jll_nll(5,4,1) = (3._wp(4._wppi2 + 3._wp(1._wp - 3._wprun)) - &
	4._wpn(5._wp - 3._wprun))/(9._wpxb)
	jll_nll(5,5,1) = (-2._wp(21._wp - 4._wpnrun))/(3._wpxb)
	jll_nll(5,6,1) = -12._wp/xb
	jll_nll(5,4,2) = (2._wp(9._wp - 2._wpnrun))/(3._wpxb)
	jll_nll(5,5,2) = 8._wp/xb
	end if
	if (order(6)) then
	jll_nll(6,4,1)=(2._wp(-((243._wp - 8._wpn*2)run) + &
	3._wp(n(-4._wppi2 - 3._wp(11._wp - run)) + &
	pi2(27._wp - 8._wpnrun))) + 27._wp(9._wp - 40._wpzeta3))/(27._wpxb)
	jll_nll(6, 5, 1) = -1._wp/9._wp(3._wp(51._wp - 40._wp*pi2) + &
	8._wp(n(20._wp - 21._wprun) + (27._wp + 2._wpn*2)run))/xb
	jll_nll(6,6,1) = (-4._wp(15._wp - 4._wpn*run))/xb
	jll_nll(6,7,1) = -32._wp/xb
	jll_nll(6,4,2) = (9._wp(27._wp - 8._wppi2) - &
	16._wp(9._wp - n)nrun)/(18._wpxb)
	jll_nll(6,5,2) = (4._wp(27._wp - 8._wpnrun))/(3._wpxb)
	jll_nll(6,6,2) = 24._wp/xb
	end if
	else
	if (order(1)) then
	jll_nll(1,4,1)=2._wp(-1._wp + xb*(-1))
	end if
	if (order(2)) then
	jll_nll(2,4,1)=2._wp*(-1._wp + 3._wp/xb)
	jll_nll(2,5,1)=8._wp(-1._wp + xb*(-1))
	end if
	if (order(3)) then
	jll_nll(3,4,1)=(9._wp + 8._wppi2 + (27._wp - 8._wppi2)/xb)/2._wp
	jll_nll(3,5,1)=12._wp*(-1._wp + 3._wp/xb)
	jll_nll(3,6,1)=24._wp(-1._wp + xb*(-1))
	end if
	if (order(4)) then
	jll_nll(4,4,1)=2._wp(1._wp - xb*(-1))
	jll_nll(4,5,1)=4._wp(1._wp - xb*(-1))
	jll_nll(4,4,2)=2._wp(-1._wp + xb*(-1))
	end if
	if (order(5)) then
	jll_nll(5,4,1)=(-3._wp(2._wp(3._wp + 2._wppi2) - 9._wprun) + 4._wpn(8._wp - &
	3._wprun))/9._wp + (3._wp(4._wppi2 + 3._wp(1._wp - 3._wp*run)) - &
	4._wpn(5._wp - 3._wprun))/(9._wpxb)
	jll_nll(5,5,1) = (2._wp(15._wp - 4._wpnrun))/3._wp - (2._wp(21._wp - 4._wpnrun))/(3._wp*xb)
	jll_nll(5,6,1) = 12._wp - 12._wp/xb
	jll_nll(5,4,2) = (-2._wp(3._wp - 2._wpnrun))/3._wp + (2._wp(9._wp - 2._wpnrun))/(3._wp*xb)
	jll_nll(5,5,2) = -8._wp + 8._wp/xb
	end if
	if (order(6)) then
	jll_nll(6,4,1)=(2._wpn(-20._wpnrun + 3._wp(11._wp + 4._wp(3._wp*run + &
	pi2(1._wp + 2._wprun)))))/27._wp + (135._wp + 2._wp(run(-2._wp*(81._wp - &
	4._wpn2) - 81._wpx) + 3._wp(n(-4._wppi2 - 3._wp(11._wp - run)) + &
	pi2(4._wp(3._wp - 2._wpnrun) + 15._wpx) + 18._wpx*(1._wp - &
	10._wpzeta3))))/(27._wpxb)
	jll_nll(6,5,1)=(-3._wp(21._wp + 8._wp(5._wppi2 - 9._wprun)) + &
	16._wpn(13._wp - (6._wp - n)run))/9._wp - (3._wp(51._wp - 40._wp*pi2) + &
	8._wp(n(20._wp - 21._wprun) + (27._wp + 2._wpn*2)run))/(9._wp*xb)
	jll_nll(6,6,1) = 4._wp(9._wp - 4._wpnrun) - (4._wp(15._wp - 4._wpnrun))/xb
	jll_nll(6,7,1) = 32._wp - 32._wp/xb
	jll_nll(6,4,2)=(9._wp(9._wp + 8._wppi2) + 16._wp(3._wp - n)n*run)/18._wp + &
	(9._wp(27._wp - 8._wppi2) - 16._wp(9._wp - n)nrun)/(18._wpxb)
	jll_nll(6,5,2) = (-4._wp(9._wp - 8._wpnrun))/3._wp + (4._wp(27._wp - 8._wpnrun))/(3._wp*xb)
	jll_nll(6,6,2) = -24._wp + 24._wp/xb
	end if
	end if
	end subroutine recbar_ele

	@ %def recbar_ele
	@
	<<Electron PDFs: public>>=
	public :: recbar_pos
	<<Electron PDFs: sub interfaces>>=
	module subroutine recbar_pos (jll_nll, n, run, order)
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine recbar_pos
	<<Electron PDFs: procedures>>=
	module subroutine recbar_pos (jll_nll, n, run, order)
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	jll_nll = 0._wp
	end subroutine recbar_pos

	@ %def recbar_pos
	@
	<<Electron PDFs: public>>=
	public :: rechat_singlet
	<<Electron PDFs: sub interfaces>>=
	module subroutine rechat_singlet (x, xb, xp, pl, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine rechat_singlet
	<<Electron PDFs: procedures>>=
	module subroutine rechat_singlet (x, xb, xp, pl, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	real(wp), dimension(7,7,2) :: jll_nll_pos, jll_nll_ele
	call rechat_ele (x, xb, xp, pl, jll_nll_ele, n, run, order)
	call rechat_pos (x, xb, xp, pl, jll_nll_pos, n, run, order)
	jll_nll = add_logvec(jll_nll_ele,jll_nll_pos)
	end subroutine rechat_singlet

	@ %def rechat_singlet
	@
	<<Electron PDFs: public>>=
	public :: rechat_nonsinglet
	<<Electron PDFs: sub interfaces>>=
	module subroutine rechat_nonsinglet (x, xb, xp, pl, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine rechat_nonsinglet
	<<Electron PDFs: procedures>>=
	module subroutine rechat_nonsinglet (x, xb, xp, pl, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	real(wp), dimension(7,7,2) :: jll_nll_pos, jll_nll_ele
	call rechat_ele (x, xb, xp, pl, jll_nll_ele, n, run, order)
	call rechat_pos (x, xb, xp, pl, jll_nll_pos, n, run, order)
	jll_nll = sub_logvec(jll_nll_ele,jll_nll_pos)
	end subroutine rechat_nonsinglet

	@ %def rechat_nonsinglet
	@
	<<Electron PDFs: public>>=
	public :: rechat_photon
	<<Electron PDFs: sub interfaces>>=
	module subroutine rechat_photon (x, xb, xp, pl, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine rechat_photon
	<<Electron PDFs: procedures>>=
	module subroutine rechat_photon (x, xb, xp, pl, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	jll_nll = 0._wp
	if (x .le. 1.0e-7_wp) then
	if (order(1)) then
	jll_nll(1,4,1) = 2._wp/x
	end if
	if (order(2)) then
	jll_nll(2,4,1) = (-4._wpn)/(3._wpx)
	end if
	if (order(3)) then
	jll_nll(3,3,1) = (-16._wpn)/(3._wpx)
	jll_nll(3,4,1) = (-4._wp(31._wp - 2._wpn)n)/(9._wpx)
	end if
	if (order(4)) then
	jll_nll(4,3,1) = -4._wp/x
	jll_nll(4,4,1) = -2._wp/x
	jll_nll(4,4,2) = 2._wp/x
	end if
	if (order(5)) then
	jll_nll(5,3,1) = (8._wpn(1._wp + run))/(3._wp*x)
	jll_nll(5,4,1) = (-4._wpn(7._wp - 3._wprun) - 27._wprun)/(9._wp*x)
	jll_nll(5,4,2) = (-4._wpn(1._wp + run))/(3._wp*x)
	end if
	if (order(6)) then
	jll_nll(6,2,1) = (16._wpn)/(3._wpx)
	jll_nll(6,3,1) = (8._wpn(15._wp - 2._wpn(1._wp + 3._wprun)))/(9._wpx)
	jll_nll(6,4,1)=(2._wpn(81._wprun - 4._wp(34._wp - n*(7._wp + run))) + &
	27._wp(13._wp + 2._wp(-pi2 + 8._wpzeta3)))/(27._wpx)
	jll_nll(6,3,2) = (-16._wpn)/(3._wpx)
	jll_nll(6,4,2) = (-4._wpn(31._wp - 2._wpn(1._wp + 3._wprun)))/(9._wpx)
	end if
	elseif (xb .le. 1.0e-7_wp) then
	if (order(1)) then
	jll_nll(1,4,1) = xb
	end if
	if (order(2)) then
	jll_nll(2,4,1) = -1._wp/6._wp((3._wp + 4._wpn)*xb)
	jll_nll(2,5,1) = 2._wp*xb
	end if
	if (order(3)) then
	jll_nll(3,4,1) = ((4._wpn(3._wp + 4._wpn) + 3._wp(99._wp - 8._wppi2))xb)/36._wp
	jll_nll(3,5,1) = (-2._wp(3._wp + 2._wpn)*xb)/3._wp
	jll_nll(3,6,1) = 4._wp*xb
	end if
	if (order(4)) then
	jll_nll(4,4,1) = xb
	jll_nll(4,4,2) = xb
	end if
	if (order(5)) then
	jll_nll(5,4,1) = ((-9._wp(4._wp + 3._wprun) - 4._wpn(7._wp + 3._wprun))xb)/18._wp
	jll_nll(5,5,1) = ((3._wp - 4._wpn)xb)/3._wp
	jll_nll(5,6,1) = -3._wp*xb
	jll_nll(5,4,2) = -1._wp/6._wp((3._wp + 4._wpn(1._wp + run))xb)
	jll_nll(5,5,2) = 2._wp*xb
	end if
	if (order(6)) then
	jll_nll(6,4,1)=(xb(4._wp(n(8._wpn(7._wp + 13._wprun) - &
	3._wp(21._wp - 2._wp(2._wppi2 + 39._wprun))) + &
	36._wpln2(-4._wppi2 - (9._wp - 10._wpln2)*ln2)) + &
	27._wp(35._wp - 4._wp(pi2 - 3._wprun - 32._wpzeta3))))/216._wp
	jll_nll(6,5,1) = ((-3._wp(99._wp - 4._wp(pi2 - 9._wp*run)) + &
	4._wpn(4._wpn(1._wp + run) - 9._wp(2._wp + run)))xb)/18._wp
	jll_nll(6,6,1) = ((21._wp - 4._wpn(1._wp - 5._wprun))xb)/6._wp
	jll_nll(6,7,1) = -2._wp*xb
	jll_nll(6,4,2) = ((3._wp(99._wp - 8._wppi2) + &
	4._wpn(3._wp(1._wp + 2._wprun) + 4._wpn(1._wp + 3._wprun)))xb)/36._wp
	jll_nll(6,5,2) = (-2._wp(3._wp + 2._wpn(1._wp + 2._wprun))*xb)/3._wp
	jll_nll(6,6,2) = 4._wp*xb
	end if
	else
	if (xb .le. 0.0_wp) then
	jll_nll = 0._wp
	elseif (x .ge. 1.0_wp) then
	jll_nll = 0._wp
	else
	if (order(1)) then
	jll_nll(1,4,1)=-3._wp + 2._wp/x + x
	end if
	if (order(2)) then
	jll_nll(2,3,1)=2._wp - x
	jll_nll(2,4,1)=(3._wp + 4._wpn(3._wp - 2._wp/x) + &
	(-3._wp - 4._wpn)x)/6._wp
	jll_nll(2,5,1)=2._wp*(-3._wp + 2._wp/x + x)
	end if
	if (order(3)) then
	jll_nll(3,2,1) = -1._wp/2._wp((1._wp - 4._wpn)*(2._wp - x))
	jll_nll(3,3,1) = (-4._wpn(1._wp - 5._wpx) - 3._wp(5._wp - 2._wp*x))/3._wp - &
	(16._wpn)/(3._wpx)
	jll_nll(3,4,1)=(4._wp(-((31._wp - 2._wpn)n) + 3._wp(-pi2 + &
	6._wppl(4))))/(9._wpx) + (4._wpn(283._wp - 159._wpx + 4._wp(-(n*(3._wp - &
	x)) - 4._wpxbxp)) + 3._wp(8._wppi2(5._wp - 2._wpx) + 3._wp(-11._wpxb - &
	16._wp(2._wp - x)(pl(2) + pl(4)))))/36._wp
	jll_nll(3,5,1) = (-8._wpn)/(3._wpx) + (2._wp(2._wpn(3._wp - x) + 3._wpxb))/3._wp
	jll_nll(3,6,1) = -4._wp*(3._wp - x) + 8._wp/x
	end if
	if (order(4)) then
	jll_nll(4,3,1)=2._wp(2._wp(1._wp - x**(-1)) - x)
	jll_nll(4,4,1)=3._wp - 2._wp/x - x
	jll_nll(4,4,2)=-3._wp + 2._wp/x + x
	end if
	if (order(5)) then
	jll_nll(5,2,1) = (-2._wp + x)/2._wp
	jll_nll(5,3,1) = (8._wpn(1._wp + run))/(3._wpx) + (-8._wpn*(1._wp + &
	run)(2._wp - x) + 15._wpx)/6._wp
	jll_nll(5,4,1)=(-4._wpn(7._wp - 3._wp*run) - &
	27._wprun)/(9._wpx) + (3._wp(-2._wppi2*(2._wp - x) + &
	3._wp(3._wprun(3._wp - x) + 5._wpxb)) + 4._wp(n(3._wp(9._wp - run(3._wp - &
	x)) - 13._wpx) + 9._wp(2._wp - x)*pl(2)))/18._wp
	jll_nll(5,5,1) = (3._wp(7._wp - 3._wpx) + 4._wpn(3._wp - x))/3._wp - &
	(4._wp(3._wp + 2._wpn))/(3._wp*x)
	jll_nll(5,6,1) = 3._wp*(3._wp - x) - 6._wp/x
	jll_nll(5,3,2) = 2._wp - x
	jll_nll(5,4,2) = (-4._wpn(1._wp + run))/(3._wpx) + (4._wpn*(1._wp + &
	run)(3._wp - x) + 3._wpxb)/6._wp
	jll_nll(5,5,2) = -2._wp*(3._wp - x) + 4._wp/x
	end if
	if (order(6)) then
	jll_nll(6,1,1) = (2._wp(1._wp - 4._wpn*(2._wp - x)) + x)/3._wp
	jll_nll(6,2,1) = (16._wpn)/(3._wpx) + (-(n(-(run(2._wp - x)) + &
	12._wp(2._wp + x))) + 6._wpxp)/3._wp
	jll_nll(6,3,1)=(-2._wp(-4._wpn(15._wp - 2._wpn(1._wp + 3._wprun)) + &
	3._wp(-pi2 + 6._wp(pl(6) + pl(8)))))/(9._wpx) + (3._wp(2._wp*(81._wp + &
	2._wp(4._wppi2 - 9._wprun(2._wp - x))) + 39._wp*x) + &
	4._wp(n(3._wp(run(4._wp - 3._wpx) - 15._wpx) - 2._wp*(397._wp - &
	4._wp(n(1._wp + 3._wprun)(2._wp - x) + 4._wpxbxp))) + 18._wp*(-((6._wp - &
	x)(pl(6) + pl(2))) - (2._wp + x)pl(8))))/36._wp
	jll_nll(6,4,1)=(4._wp(-(n(2993._wp - 3._wp(1179._wp - 8._wppi2run)x - &
	4._wp(3._wp(-9._wprun(5._wp - 2._wpx) - pi2(3._wp - 4._wp*run - x)) + &
	2._wp(-(n(27._wp + run(9._wp - 7._wpx) - 13._wpx)) - 14._wpxb*xp)))) + &
	9._wp(pi2(24._wpln2 + (2._wp - 3._wpx)pl(1)) + pl(1)((18._wp + &
	5._wpx)pl(1)*2 + 6._wp(10._wp + x)pl(6)) + 2._wp((-8._wpnrun*(2._wp - x) - &
	9._wp(2._wp + x))pl(2) + (3._wp(4._wp - 7._wpx) + 4._wpn(2._wp - &
	x))pl(4) + 3._wp(-4._wp(5._wp + 2._wpx) + (6._wp - x)pl(1))pl(8) + &
	2._wp(-3._wp((5._wp + 2._wpx)pl(1)*2 - (14._wp - 3._wpx)*pl(3) - (10._wp - &
	3._wpx)pl(5)) + 2._wp(-7._wpln2*3 + 3._wp((6._wp - x)pl(7) + 2._wp(2._wp &
	- x)pl(9))))))) - 27._wp(135._wp - 4._wp(3._wp(pi2 - run) - &
	56._wpzeta3)))/216._wp + (27._wp(135._wp - xbxp(31._wp + 32._wp*zeta3)) + &
	4._wp(81._wprun(1._wp - xbxp) + 2._wp(9._wp(pi2(2._wp(5._wp - &
	3._wpxbxp) - 7._wppl(1)) + pl(1)(-((18._wp - 17._wppl(1))pl(1)) + &
	6._wp(pl(6) - pl(8)))) + 2._wp(n(81._wprun + 2._wp(3._wppi2 - &
	2._wp(34._wp - n(7._wp + run) + 9._wppl(4)))) + 54._wp(-3._wp*pl(8) + &
	2._wp(-pl(4) + pl(7)) + 5._wpzeta3)))))/(216._wp*x)
	jll_nll(6,5,1)=-1._wp/9._wp(45._wp - 4._wp(3._wp(-(n(8._wp - run)) - &
	9._wprun) + 2._wp(2._wpn2(1._wp + run) + 3._wp(pi2 - 3._wppl(4)))))/x + &
	(3._wp(3._wp(3._wp(11._wp + 4._wprun(3._wp - x)) - 23._wpx) - pi2*(42._wp &
	- 19._wpx)) + 2._wp(2._wpn(3._wp(2._wp(13._wp - 5._wpx) - run(3._wp - &
	x)) - 4._wpn(1._wp + run)(3._wp - x)) - 9._wp(2._wp - x)(-7._wppl(2) - &
	pl(4))))/18._wp
	jll_nll(6,6,1)=(3._wp(25._wp - 9._wpx) + 4._wpn(1._wp - 5._wprun)(3._wp - &
	x))/6._wp - (4._wp(6._wp + n(1._wp - 5._wprun)))/(3._wpx)
	jll_nll(6,7,1) = 2._wp(7._wp - 3._wpx) - 8._wp/x
	jll_nll(6,2,2) = -1._wp/2._wp((1._wp - 4._wpn)*(2._wp - x))
	jll_nll(6,3,2) = (-4._wpn(1._wp + run(2._wp - x) - 5._wpx) - 3._wp*(5._wp &
	- 2._wpx))/3._wp - (16._wpn)/(3._wp*x)
	jll_nll(6,4,2)=(4._wp(-(n(31._wp - 2._wpn(1._wp + 3._wprun))) + 3._wp(-pi2 &
	+ 6._wppl(4))))/(9._wpx) + (4._wpn(283._wp - 159._wp*x + &
	2._wp(-3._wprunxb + 2._wp(-(n(1._wp + 3._wprun)*(3._wp - x)) - &
	4._wpxbxp))) + 3._wp(8._wppi2(5._wp - 2._wpx) + 3._wp(-11._wpxb - &
	16._wp(2._wp - x)(pl(2) + pl(4)))))/36._wp
	jll_nll(6,5,2) = (-8._wpn(1._wp + 2._wprun))/(3._wpx) + &
	(2._wp(2._wpn(1._wp + 2._wprun)(3._wp - x) + 3._wpxb))/3._wp
	jll_nll(6,6,2) = -4._wp*(3._wp - x) + 8._wp/x
	end if
	end if
	end if
	end subroutine rechat_photon

	@ %def rechat_photon
	@
	<<Electron PDFs: public>>=
	public :: rechat_ele
	<<Electron PDFs: sub interfaces>>=
	module subroutine rechat_ele (x, xb, xp, pl, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine rechat_ele
	<<Electron PDFs: procedures>>=
	module subroutine rechat_ele (x, xb, xp, pl, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	jll_nll=0._wp
	if (x .le. 1.0e-7_wp) then
	if (order(1)) then
	jll_nll(1,4,1) = 1._wp
	end if
	if (order(2)) then
	jll_nll(2,4,1) = (4._wpn)/(3._wpx)
	end if
	if (order(3)) then
	jll_nll(3,4,1) = (-8._wpn2)/(9._wpx)
	end if
	if (order(4)) then
	jll_nll(4,4,1) = -1._wp
	jll_nll(4,4,2) = 1._wp
	end if
	if (order(5)) then
	jll_nll(5,3,1) = (-8._wpn)/(3._wpx)
	jll_nll(5,4,1) = (-2._wp*n)/x
	jll_nll(5,4,2) = (4._wpn)/(3._wpx)
	end if
	if (order(6)) then
	jll_nll(6,3,1) = (16._wpn2(1._wp + 2._wprun))/(9._wpx)
	jll_nll(6,4,1) = (4._wpn(-(n(1._wp - 28._wprun)) + &
	3._wp(2._wp(6._wp - pi2) - 9._wprun)))/(27._wpx)
	jll_nll(6,4,2) = (-8._wpn2(1._wp + 2._wprun))/(9._wpx)
	end if
	elseif (xb .le. 1.0e-7_wp) then
	if (order(1)) then
	jll_nll(1,4,1) = xb
	end if
	if (order(2)) then
	jll_nll(2,4,1) = -((3._wp - n)*xb)
	jll_nll(2,5,1) = 4._wp*xb
	end if
	if (order(3)) then
	jll_nll(3,4,1) = ((-4._wpn(3._wp + 2._wp*n) + &
	3._wp(31._wp - 8._wppi2))*xb)/12._wp
	jll_nll(3,5,1) = -2._wp(9._wp - 2._wpn)*xb
	jll_nll(3,6,1) = 12._wp*xb
	end if
	if (order(4)) then
	jll_nll(4,4,1) = -xb
	jll_nll(4,5,1) = -2._wp*xb
	jll_nll(4,4,2) = xb
	end if
	if (order(5)) then
	jll_nll(5,4,1) = ((3._wp(-2._wp(9._wp - 2._wppi2) - 9._wprun) - &
	2._wpn(37._wp - 6._wprun))xb)/18._wp
	jll_nll(5,5,1) = ((9._wp + 4._wpnrun)*xb)/3._wp
	jll_nll(5,6,1) = -6._wp*xb
	jll_nll(5,4,2) = -1._wp/3._wp((9._wp - n(3._wp - 2._wprun))xb)
	jll_nll(5,5,2) = 4._wp*xb
	end if
	if (order(6)) then
	jll_nll(6,4,1)=(xb(n(-2._wpn(21._wp - 40._wp*run) - &
	3._wp(-3._wp(77._wp + 3._wprun) + pi2(7._wp + 8._wp*run))) - &
	9._wp(-27._wprun + 10._wp(pi2 - 3._wp(5._wp - 2._wp*zeta3)))))/27._wp
	jll_nll(6,5,1)=((-3._wp(195._wp - 8._wp(5._wppi2 - 9._wprun)) - &
	2._wpn(197._wp - 4._wp(-12._wprun - n(3._wp + 2._wprun))))*xb)/18._wp
	jll_nll(6,6,1) = 2._wp(11._wp - n(1._wp - 4._wprun))xb
	jll_nll(6,7,1) = -16._wp*xb
	jll_nll(6,4,2) = ((9._wp(31._wp - 8._wppi2) + 4._wpn(-9._wp(1._wp - 4._wprun) - &
	2._wpn(3._wp + 4._wprun)))xb)/36._wp
	jll_nll(6,5,2) = (-2._wp(27._wp - 2._wpn(3._wp - 4._wprun))*xb)/3._wp
	jll_nll(6,6,2) = 12._wp*xb
	end if
	else
	if (order(1)) then
	jll_nll(1,4,1)=xb
	end if
	if (order(2)) then
	jll_nll(2,3,1) = -4._wp/xb + (3._wp + 2._wpn)xp
	jll_nll(2,4,1) = (4._wpn)/(3._wpx) + &
	(-3._wp(3._wp + x) - n(1._wp + 3._wpx - 4._wpxb*xp))/3._wp
	jll_nll(2,5,1) = 4._wp*xb
	end if
	if (order(3)) then
	jll_nll(3,2,1) = 4._wp/xb - ((7._wp + 4._wpn)xp)/2._wp
	jll_nll(3,3,1) = -18._wp/xb + (9._wp(11._wp + 3._wpx) + 8._wpn(4._wp + 3._wp*x + (-n - &
	4._wpxb)xp))/6._wp
	jll_nll(3,4,1)=(-8._wpn2)/(9._wpx) - (4._wp(pi2 - 6._wp(pl(2) + pl(4))))/xb + &
	(4._wp(n(-3._wp(23._wp - 23._wpx - 4._wppi2xp) + 2._wpn(1._wp + 3._wp*x - &
	4._wpxbxp)) - 18._wp(9._wp + 4._wpn)xppl(2)) + 9._wp(4._wppi2(1._wp + 5._wpx) - &
	3._wp(19._wp + 5._wpx + 16._wpxppl(4))))/36._wp
	jll_nll(3,5,1) = (16._wpn)/(3._wpx) + (2._wp(-9._wp(3._wp + x) - 2._wpn(1._wp + &
	3._wpx - 4._wpxb*xp)))/3._wp
	jll_nll(3,6,1) = 12._wp*xb
	end if
	if (order(4)) then
	jll_nll(4,4,1)=-xb
	jll_nll(4,4,2)=xb
	jll_nll(4,5,1)=-2._wp*xb
	end if
	if (order(5)) then
	jll_nll(5,2,1) = -1._wp/2._wp((1._wp + 6._wpn)*xp)
	jll_nll(5,3,1) = (-8._wpn)/(3._wpx) + (3._wp - 4._wpn)/(3._wpxb) + &
	(-(n(13._wp + 8._wpx)xb) - 9._wpxp)/3._wp
	jll_nll(5,4,1)=(-2._wpn)/x + (2._wp(pi2 - 6._wp(pl(2) + pl(4))))/(3._wpxb) + &
	(3._wp((27._wp - 8._wppi2)x - 3._wp(7._wp + 3._wprunxb)) + &
	2._wp(-(n(79._wp - 85._wpx - 6._wpxb(run + 3._wpxp))) + &
	18._wpxp(2._wp*pl(2) + pl(4))))/18._wp
	jll_nll(5,5,1) = (3._wp(1._wp + 3._wpx) + 4._wpnrun*xb)/3._wp
	jll_nll(5,6,1) = -6._wp*xb
	jll_nll(5,3,2) = -4._wp/xb + (3._wp + 2._wpn)xp
	jll_nll(5,4,2) = (4._wpn)/(3._wpx) + (-3._wp(3._wp + x) - n(1._wp + 3._wp*x - &
	2._wpxb(-run + 2._wp*xp)))/3._wp
	jll_nll(5,5,2) = 4._wp*xb
	end if
	if (order(6)) then
	jll_nll(6,1,1) = ((1._wp + 6._wpn)xp)/3._wp
	jll_nll(6,2,1)=(2._wp(3._wp + 4._wpn))/(3._wpxb) + (9._wpx + &
	n(-5._wp(4._wp + 3._wpx) + (run + 2._wp(n(2._wp + 5._wprun) + &
	10._wpxb))xp))/3._wp
	jll_nll(6,3,1)=(16._wpn2(1._wp + 2._wprun))/(9._wpx) + &
	(2._wp(3._wp(3._wp - 2._wppi2) + n(22._wp - 15._wprun) + 2._wp(27._wp + &
	2._wpn2)run))/(9._wpxb) + (n(277._wp + 2._wp(3._wp(-(pi2*(7._wp + &
	4._wpx)) - run(3._wp + 5._wpx)) + 8._wp(-9._wpx - 4._wpxb*xp) + &
	n(run(23._wp + 7._wpx + 8._wpxbxp) - 2._wp(11._wp - 4._wp(-4._wpx + &
	xbxp))))) + 3._wp(3._wp(7._wp - 9._wp(x + run*xp)) + &
	2._wp(3._wp(-2._wpn(2._wp - x) - 3._wpxp)pl(2) + xp(2._wppi2 - &
	3._wp*pl(4)))))/9._wp
	jll_nll(6,4,1)=(-2._wpn(9._wp(3._wp(1._wp - run*(1._wp - 3._wp/xb)) - &
	(11._wp - 2._wppi2)/xb) + 2._wp(n(1._wp - 28._wprun) + 18._wp(-2._wppl(2) &
	- pl(4)))))/(27._wpx) - (3._wp(-(pi2(5._wp - 4._wp(n*run - x))) + &
	3._wp(-41._wpxb + 6._wp(3._wppl(2) + 4._wp*pl(4)))) + &
	2._wp(9._wprun(-3._wpxb - 4._wpn(pl(2) + pl(4))) + n(3._wp(11._wp - &
	9._wprun) + 2._wp(-pi2 - 12._wp(pl(2) + pl(4))))))/(9._wpxb) + &
	(4._wp(9._wp((6._wp(7._wp + 3._wpx) + n(10._wp(1._wp - run - run*x) - &
	(1._wp - 4._wp(n + 2._wpxb))xp))pl(2) + (6._wp(5._wp + x) - n(5._wp + &
	7._wpx + 2._wp(3._wprun - 2._wpxb)xp))pl(4) + 3._wp((4._wpn*(4._wp + x) &
	+ 7._wpxp)pl(3) + 2._wp(n(5._wp + 2._wpx) + 6._wpxp)*pl(5))) + &
	n(-(n(7._wp - 9._wpx + 2._wp((19._wp + 3._wppi2 - 19._wpx)*xp + &
	2._wprun(-11._wp(1._wp - 2._wpx) - 5._wpxbxp)))) + 3._wp*(83._wp - &
	85._wpx + pi2(run + 2._wp(2._wpx - 3._wp(1._wp + xbxp))) + &
	3._wp(run(-((1._wp - 3._wppi2)x) + 2._wp(1._wp - 3._wpxb*xp)) + &
	3._wp(xp(xb - 4._wpzeta3) - 12._wpzeta3))))) - 9._wp*((99._wp + &
	2._wp(10._wppi2 - 9._wprun))xp + 12._wp(17._wp - 3._wpx)*zeta3))/54._wp
	jll_nll(6,5,1)=(-8._wpn(1._wp + 2._wpn))/(9._wpx) + (4._wp*(pi2 - &
	6._wp(pl(2) + pl(4))))/xb + (-3._wp(-3._wp(5._wp + 31._wpx) + &
	2._wp(-(pi2(9._wp - 31._wpx)) + 36._wprunxb)) + 2._wp(-(n*(333._wp - &
	293._wpx - 2._wp(-3._wppi2xp + 2._wp((-9._wprun + 16._wpxb)xp + n*(1._wp &
	+ 3._wpx - 2._wpxb(run + 2._wpxp)))))) + 18._wpxp((11._wp + 2._wpn)pl(2) &
	- (1._wp + 2._wpn)pl(4))))/18._wp
	jll_nll(6,6,1) = (-8._wpn)/(3._wpx) + (2._wp(3._wp(7._wp + 5._wp*x) + &
	n(1._wp + 3._wpx - 4._wpxb(-3._wp*run + xp))))/3._wp
	jll_nll(6,7,1) = -16._wp*xb
	jll_nll(6,2,2) = 4._wp/xb - ((7._wp + 4._wpn)xp)/2._wp
	jll_nll(6,3,2)=(-2._wp(27._wp - 8._wpnrun))/(3._wpxb) + (9._wp*(11._wp + &
	3._wpx) + 8._wpn(4._wp - (n(1._wp + 2._wprun) + 4._wpxb)xp - 3._wp(-x + &
	run*xp)))/6._wp
	jll_nll(6,4,2)=(-8._wpn2(1._wp + 2._wprun))/(9._wpx) - (4._wp*(pi2 - &
	6._wp(pl(2) + pl(4))))/xb + (4._wp(n(2._wpn(1._wp + 3._wpx + 4._wp*(run - &
	(1._wp + 2._wprun)xb)xp) - 3._wp(23._wp - 23._wpx - 4._wp(run*(3._wp + x) &
	+ pi2xp))) - 18._wp(9._wp + 4._wpn)xppl(2)) + 9._wp(4._wppi2(1._wp + &
	5._wpx) - 3._wp(19._wp + 5._wpx + 16._wpxp*pl(4))))/36._wp
	jll_nll(6,5,2) = (16._wpn)/(3._wpx) + (2._wp(-9._wp(3._wp + x) - &
	2._wpn(1._wp + 3._wpx - 4._wpxb*(-run + xp))))/3._wp
	jll_nll(6,6,2) = 12._wp*xb
	end if
	end if
	end subroutine rechat_ele

	@ %def rechat_ele
	@
	<<Electron PDFs: public>>=
	public :: rechat_pos
	<<Electron PDFs: sub interfaces>>=
	module subroutine rechat_pos (x, xb, xp, pl, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	end subroutine rechat_pos
	<<Electron PDFs: procedures>>=
	module subroutine rechat_pos (x, xb, xp, pl, jll_nll, n, run, order)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), intent(in) :: n, run
	logical, dimension(6), intent(in) :: order
	real(wp), dimension(7,7,2), intent(out) :: jll_nll
	jll_nll = 0._wp
	if (x .le. 1.0e-7_wp) then
	if (order(1)) then
	jll_nll(1,:,:)=0._wp
	end if
	if (order(2)) then
	jll_nll(2,4,1) = (4._wpn)/(3._wpx)
	end if
	if (order(3)) then
	jll_nll(3,4,1) = (-8._wpn2)/(9._wpx)
	end if
	if (order(4)) then
	jll_nll(4,:,:)=0._wp
	end if
	if (order(5)) then
	jll_nll(5,3,1) = (-8._wpn)/(3._wpx)
	jll_nll(5,4,1) = (-2._wp*n)/x
	jll_nll(5,4,2) = (4._wpn)/(3._wpx)
	end if
	if (order(6)) then
	jll_nll(6,3,1) = (16._wpn2(1._wp + 2._wprun))/(9._wpx)
	jll_nll(6,4,1) = (4._wpn(-(n(1._wp - 28._wprun)) + &
	3._wp(2._wp(6._wp - pi2) - 9._wprun)))/(27._wpx)
	jll_nll(6,4,2) = (-8._wpn2(1._wp + 2._wprun))/(9._wpx)
	end if
	elseif (xb .le. 1.0e-7_wp) then
	if (order(1)) then
	jll_nll(1,:,:)=0._wp
	end if
	if (order(2)) then
	jll_nll(2,4,1) = n*xb
	end if
	if (order(3)) then
	jll_nll(3,4,1) = -1._wp/3._wp(n(3._wp + 2._wpn)xb)
	jll_nll(3,5,1) = 4._wpnxb
	end if
	if (order(4)) then
	jll_nll(4,:,:)=0._wp
	end if
	if (order(5)) then
	jll_nll(5,4,1) = -(n*xb)
	jll_nll(5,4,2) = n*xb
	end if
	if (order(6)) then
	jll_nll(6,4,1)=(xb(2._wp(6._wppi2 + n(-3._wp(pi2 - 3._wp(14._wp - 3._wp*run)) - &
	2._wpn(7._wp - 6._wprun))) - 45._wpln2(6._wp + 5._wpln2)))/18._wp
	jll_nll(6,5,1) = ((-(n(15._wp + 4._wpn)) + pi2)*xb)/3._wp
	jll_nll(6,6,1) = -2._wpnxb
	jll_nll(6,4,2) = -1._wp/3._wp(n(3._wp + 2._wpn(1._wp + 2._wprun))xb)
	jll_nll(6,5,2) = 4._wpnxb
	end if
	else
	if (order(1)) then
	jll_nll(1,:,:)=0._wp
	end if
	if (order(2)) then
	jll_nll(2,3,1) = 2._wpnxp
	jll_nll(2,4,1) = (4._wpn)/(3._wpx) - (n(1._wp + 3._wpx - 4._wpxbxp))/3._wp
	end if
	if (order(3)) then
	jll_nll(3,2,1) = -2._wpnxp
	jll_nll(3,3,1) = (4._wpn(4._wp + 3._wpx + (-n - 4._wpxb)*xp))/3._wp
	jll_nll(3,4,1)=(-8._wpn2)/(9._wpx) + (n(-3._wp(23._wp - 23._wp*x - &
	4._wppi2xp) + 2._wp(n(1._wp + 3._wpx - 4._wpxb*xp) - &
	36._wpxppl(2))))/9._wp
	jll_nll(3,5,1) = (16._wpn)/(3._wpx) - (4._wpn(1._wp + 3._wpx - 4._wpxb*xp))/3._wp
	end if
	if (order(4)) then
	jll_nll(4,:,:)=0._wp
	end if
	if (order(5)) then
	jll_nll(5,2,1) = -xb + 2._wp/xp - 3._wpnxp
	jll_nll(5,3,1) = (-8._wpn)/(3._wpx) + (6._wpxp - n(7._wp - 3._wp*x + &
	8._wpxbxp))/3._wp
	jll_nll(5,4,1)=(-2._wpn)/x + (2._wp(pi2 + 6._wp(-pl(1)*2 - &
	2._wppl(8))))/(3._wpxp) + (-3._wpn(5._wp - 7._wp*x - &
	2._wpxbxp) + xb(-pi2 + 6._wp(pl(1)*2 + 2._wp(1._wp + pl(8)))))/3._wp
	jll_nll(5,3,2) = 2._wpnxp
	jll_nll(5,4,2) = (4._wpn)/(3._wpx) - (n(1._wp + 3._wpx - 4._wpxbxp))/3._wp
	end if
	if (order(6)) then
	jll_nll(6,1,1) = (2._wp(xb + 3._wpn*xp))/3._wp
	jll_nll(6,2,1)=(2._wp(3._wp - 2._wprunn))/(3._wpxp) + (-6._wp*(2._wp - x) + &
	n(-9._wpx - 2._wp(7._wp - (2._wp + 5._wprun)nxp - xb*(run + &
	10._wp*xp))))/3._wp
	jll_nll(6,3,1)=(16._wp(1._wp + 2._wprun)n2)/(9._wpx) - (2._wp*(pi2 + &
	6._wp(pl(2) + pl(4))))/(3._wpxp) + (2._wp(pi2 - 6._wp(pl(6) + &
	pl(8))))/(3._wpxb) + (n(283._wp + 2._wp(-33._wpx - pi2(21._wp + 12._wpx) - &
	(32._wp + 32._wpx)xb + n(-2._wp(11._wp + 16._wpx - 4._wpxb*xp) + &
	run(25._wp + 9._wpx + 8._wpxbxp)) + 3._wp(-11._wprun*xp - &
	6._wp(3._wp - xp)pl(2)))) + 6._wp((15._wp - pi2)x - &
	3._wp(3._wp - 2._wp(pl(6) - (1._wp - 2._wpx)pl(8)))))/9._wp
	jll_nll(6,4,1)=(n(-3._wp(103._wp - 151._wpxbxp) + 4._wp*(-((1._wp - &
	28._wprun)n) + 9._wp(-3._wprun - pi2 + 2._wp(2._wppl(2) + &
	pl(4))))))/(27._wpx) - (pi2(8._wpln2 - 5._wppl(1)) + &
	3._wppl(1)(5._wppl(1)2 + 2._wp(-pl(6) + pl(8))) + 4._wp(-5._wpln2**3 + &
	6._wp(-pl(7) + 2._wppl(9))))/(3._wpxb) - (pi2(-15._wp(5._wp + 3._wpx) + &
	2._wp(2._wp(runn + 3._wpln2) + 51._wp*pl(1))) + &
	6._wp(pl(1)(pl(1)(4._wp(9._wp - runn) + 15._wppl(1)) + 6._wp(5._wppl(6) - &
	4._wp(pl(2) + pl(4)))) + 2._wp(2._wp(3._wp - 2._wprunn)pl(8) + &
	15._wp(-ln23 - pl(1)pl(8) - 2._wp(ln2pl(10) + pl(11))))))/(9._wp*xp) - &
	(20._wp(1._wp - 3._wpx)zeta3)/(xbxp) + (-9._wp(2._wp(36._wp + &
	17._wppi2)xb + 3._wp(27._wp + 13._wpx)zeta3) + 2._wp(9._wp(pi2(8._wp*ln2 &
	- (2._wp + 3._wpx)pl(1)) + pl(1)*2(-4._wprunnxb + 3._wp(19._wp + 7._wp*x + &
	5._wp(2._wp - x)pl(1))) + 2._wp(5._wp(-3._wp(1._wp + 2._wpx) - &
	2._wpln2)ln2*2 + (n(13._wp + 3._wpx + 8._wpxbxp) + 4._wp(-((3._wp - &
	n*2)xp) - 3._wpxbpl(1)))pl(2) + (-(n(1._wp + 3._wpx - 4._wpxb*xp)) - &
	12._wpxbpl(1))pl(4) + (4._wp(3._wp(1._wp - 2._wpx) - runnxb) + &
	3._wp(4._wp - 3._wpx)pl(1))pl(8) + 3._wp((10._wpx + (6._wp - &
	7._wpx)pl(1))pl(6) + 2._wp(-2._wppl(7) + (2._wpn(4._wp + x) + xb)pl(3) + &
	(n(5._wp + 2._wpx) - 2._wpxb)pl(5) + (1._wp + 3._wpx)pl(9) + xb*pl(12))))) &
	+ n(-2._wpn(7._wp - 9._wpx - 2._wp(-((19._wp + 3._wppi2 - 19._wpx)xp) - &
	2._wprun(-2._wp(2._wp - 9._wpx) - 5._wpxbxp))) + 3._wp*(103._wp - &
	run(-2._wppi2xb + 3._wp(5._wp - 17._wpx + 12._wpxb*xp)) - &
	6._wp(-3._wpxp(xb - 4._wpzeta3) + 2._wp(pi2(1._wp + xb*xp) + &
	18._wp*zeta3))))))/54._wp
	jll_nll(6,5,1)=(-8._wpn(1._wp + 2._wpn))/(9._wpx) - (4._wp(15._wp(ln2**2 - &
	pl(1)*2) + 2._wp(pi2 + 6._wppl(6))))/(3._wpxp) + (6._wp(pi2(3._wp - &
	2._wpx) + 12._wpxb(2._wp + pl(6))) - n(157._wp - 165._wp*x - &
	2._wp(-3._wppi2xp + 2._wp(n(1._wp + 3._wpx - 4._wpxbxp) + xp(16._wpxb &
	+ 9._wp*(pl(2) - pl(4)))))))/9._wp
	jll_nll(6,6,1) = (-8._wpn)/(3._wpx) + (2._wpn(1._wp + 3._wpx - 4._wpxb*xp))/3._wp
	jll_nll(6,2,2) = -2._wpnxp
	jll_nll(6,3,2) = (4._wpn(x(3._wp + 4._wpx) - (1._wp + 2._wprun)n*xp))/3._wp
	jll_nll(6,4,2)=(-8._wp(1._wp + 2._wprun)n2)/(9._wpx) + (n(2._wp(1._wp + &
	2._wprun)n(1._wp + 3._wpx - 4._wpxbxp) - 3._wp(23._wp - 23._wpx - &
	4._wpxp(pi2 - 6._wp*pl(2)))))/9._wp
	jll_nll(6,5,2) = (16._wpn)/(3._wpx) - (4._wpn(1._wp + 3._wpx - 4._wpxb*xp))/3._wp
	end if
	end if
	end subroutine rechat_pos

	@ %def rechat_pos
	@
	<<Electron PDFs: procedures>>=
	pure function sum_rm (log_xb, al0_2pi, ca, cb, d1, d2, cc, k0) result (s_rm)
	real(wp), intent(in) :: log_xb, al0_2pi, ca, cb, d1, d2, cc, k0
	real(wp),dimension(7,2) :: s_rm
	real(wp),dimension(5,7) :: mf, nf
	real(wp),dimension(5,2) :: rr, ss
	real(wp), parameter :: f0=1._wp-pi2/6._wp, f0ln=3._wp/4._wp
	real(wp) :: den1, den2, g1, g2, g3, g4, ta, tb, fac, logxb10
	integer :: i, j
	fac = exp(-(eulerc+d1-log_xb)*k0) / gamma(1._wp+k0)
	logxb10 = - log_xb / ln10
	nf = 0._wp
	nf(1,4) = 1._wp
	nf(2,4) = 1._wp
	nf(3,5) = -1._wp
	nf(4,4) = -pi2/6._wp
	nf(4,6) = 1._wp
	nf(5,4) = -2._wp*zeta3
	nf(5,5) = pi2/2._wp
	nf(5,7) = -1._wp
	mf = 0._wp
	mf(3,4) = (pi2/6._wp - zeta3k0)k0
	mf(4,4) = (2._wpzeta3 - pi4/180._wpk0)*k0
	mf(4,5) = -mf(3,4)*2._wp
	mf(5,4) = -(pi4/60._wp - 3._wpk0(pi2zeta3/2._wp - 4._wpzeta5))*k0
	mf(5,5) = -mf(4,4)*3._wp
	mf(5,6) = mf(3,4)*3._wp
	ta = ca + d1
	tb = f0 - ta*(1._wp + d1) - cb
	rr = 0._wp
	den1 = (d1 - log_xb)**(-1)
	den2 = (d2 - log_xb)**(-1)
	g1 = (fac(1._wp - (mf(3,4) - (nf(4,4) + mf(4,4))den1)*den1) - &
	1._wp - nf(4,4)den12)den1al0_2pi(cb + d1*ta)
	g2 = (faccc(1._wp - (mf(3,4) - (nf(4,4) + mf(4,4))den2)den2) - &
	1._wp - nf(4,4)den22)den2
	rr(1,1) = (g1 - g2)(0.5_wp + al0_2pi(f0 + 0.25_wp)) - &
	al0_2pi(g1(0.5_wp + d1)*2 - g2(0.5_wp + d2)**2)
	rr(1,2) = al0_2pi((g1 - g2)f0ln - (g1d1 - g2d2))
	rr(2,1) = -ta/2._wp - cc(1._wp + d2) - al0_2pi(caf0 + d1tb - cb)
	rr(2,2) = -cc - al0_2pi(cb + taf0ln + d1*(d1 - ca))
	rr(3,1) = 0.5_wp + cc + al0_2pi*tb
	rr(3,2) = -al0_2pi(ta + 2._wpf0ln)
	rr(4,1) = 1._wp + ta
	rr(4,2) = 1._wp
	rr(5,1) = - rr(4,2)
	ss = 0._wp
	ss(2,1) = (cc - 1._wp)*(1._wp + d2)
	ss(2,2) = -1._wp + cc
	ss(3,1) = -ss(2,2)
	s_rm = 0._wp
	do i = 1, size(s_rm,1)
	do j = 1, size(s_rm,2)
	s_rm(i,j) = rr(1,j)*nf(1,i) + &
	al0_2pi*( &
	((fac - 1._wp)rr(2,j) - ss(2,j))nf(2,i) + &
	((fac - 1._wp)nf(3,i) + facmf(3,i))rr(3,j) - ss(3,j)nf(3,i) &
	)
	s_rm(i,j) = s_rm(i,j) + al0_2pi*2( &
	(fac - 1._wp)(nf(4,i)rr(4,j) + nf(5,i)*rr(5,j)) + &
	fac(mf(4,i)rr(4,j) + mf(5,i)*rr(5,j)) &
	)
	end do
	end do
	end function sum_rm

	@ %def sum_rm
	@ For the moment, the number of quark flavors in the running of
	$alpha$ is set equal to 0.
	<<Electron PDFs: public>>=
	public :: t_alpha
	<<Electron PDFs: sub interfaces>>=
	module function t_alpha (epdf, scale) result (t)
	real(wp) :: t
	type(qed_pdf_t), intent(in) :: epdf
	real(wp), intent(in) :: scale
	end function t_alpha
	<<Electron PDFs: procedures>>=
	module function t_alpha (epdf, scale) result (t)
	real(wp) :: t
	type(qed_pdf_t), intent(in) :: epdf
	real(wp), intent(in) :: scale
	real(wp) :: alphamu, alpharef
	select type (alpha => epdf%aqed)
	type is (alpha_qed_from_scale_t)
	alpharef = real(alpha%ref,kind=wp)
	alphamu = alpha%get(scale)
	type is (alpha_qed_fixed_t)
	call msg_fatal &
	("t integrator: has to be called with running alpha.")
	end select
	t = log(alphamu/alpharef)/(2._wp*coeffqed_b0(0, epdf%nlep))
	end function t_alpha

	@ %def t_alpha
	@
	<<Electron PDFs: public>>=
	public :: full_series
	<<Electron PDFs: sub interfaces>>=
	module pure function full_series ( &
	log_x, log_xb, ln0, p, al_2pi, a01, a02, a03, a04, a05) result (res)
	real(wp) :: res
	real(wp), intent(in) :: log_x, log_xb, p, al_2pi, ln0
	real(wp), intent(in), dimension(7,7,2) :: a01
	real(wp), intent(in), dimension(7,7,2), optional :: a02, a03, a04, a05
	end function full_series
	<<Electron PDFs: procedures>>=
	module pure function full_series ( &
	log_x, log_xb, ln0, p, al_2pi, a01, a02, a03, a04, a05) result (res)
	real(wp) :: res
	real(wp), intent(in) :: log_x, log_xb, p, al_2pi, ln0
	real(wp), intent(in), dimension(7,7,2) :: a01
	real(wp), intent(in), dimension(7,7,2), optional :: a02, a03, a04, a05
	real(wp), dimension(5,7,7,2) :: aa
	real(wp), dimension(7) :: fac
	real(wp), dimension(7) :: lv
	real(wp), dimension(2) :: l0v
	real(wp) :: temp, s, t, c , cc, cs, ccs
	integer :: h, i, j, k
	fac = [p, p2/2._wp, p3/6._wp, al_2pi, al_2pip, al_2pip**2/2._wp,1._wp]
	lv = [log_x3, log_x2, log_x, 1.0_wp, log_xb, log_xb2, log_xb3]
	l0v = [1._wp, ln0]
	aa = 0._wp
	aa(1,:,:,:)=a01
	if (present(a02)) aa(2,:,:,:)=a02
	if (present(a03)) aa(3,:,:,:)=a03
	if (present(a04)) aa(4,:,:,:)=a04
	if (present(a05)) aa(5,:,:,:)=a05
	! Use Kahan Babushka Klein summation algorithm
	t = 0._wp
	c = 0._wp
	cc = 0._wp
	cs = 0._wp
	ccs = 0._wp
	s = 0._wp
	do h=1, size(aa,1)
	do i=1, size(aa,2)
	do j=1, size(aa,3)
	do k=1, size(aa,4)
	temp = l0v(k)lv(j)fac(i)*aa(h,i,j,k)
	t = s + temp
	if (abs(s) .ge. abs(temp)) then
	c = (s - t) + temp
	else
	c = (temp - t) + s
	end if
	s = t
	t = cs + c
	if (abs(cs) .ge. abs(c)) then
	cc = (cs - t) + c
	else
	cc = (c - t) + cs
	end if
	cs = t
	ccs = ccs + cc
	enddo
	enddo
	enddo
	enddo
	res = s + cs + ccs
	end function full_series

	@ %def full_series
	@
	<<Electron PDFs: public>>=
	public :: rec_log_series
	<<Electron PDFs: sub interfaces>>=
	module pure function rec_log_series (log_x, log_xb, ln0, expansion) result (jll_nll)
	real(wp), intent(in) :: log_x, log_xb, ln0
	real(wp), dimension(7,7,2), intent(in) :: expansion
	real(wp), dimension(6) :: jll_nll
	end function rec_log_series
	<<Electron PDFs: procedures>>=
	module pure function rec_log_series (log_x, log_xb, ln0, expansion) result (jll_nll)
	real(wp), intent(in) :: log_x, log_xb, ln0
	real(wp), dimension(7,7,2), intent(in) :: expansion
	real(wp), dimension(6) :: jll_nll
	real(wp), dimension(7) :: lv
	real(wp), dimension(2) :: l0v
	real(wp) :: temp, s, t, c , cc, cs, ccs
	integer :: i, j, k
	lv = [log_x3, log_x2, log_x, 1.0_wp, log_xb, log_xb2, log_xb3]
	l0v = [1._wp, ln0]
	jll_nll = 0._wp
	do i = 1, size(expansion,1) - 1
	! Use Kahan Babushka Klein summation algorithm
	t = 0._wp
	c = 0._wp
	cc = 0._wp
	cs = 0._wp
	ccs = 0._wp
	s = 0._wp
	do j = 1, size(expansion,2)
	do k = 1, size(expansion,3)
	temp = l0v(k)lv(j)expansion(i,j,k)
	t = s + temp
	if (abs(s) .ge. abs(temp)) then
	c = (s - t) + temp
	else
	c = (temp - t) + s
	end if
	s = t
	t = cs + c
	if (abs(cs) .ge. abs(c)) then
	cc = (cs - t) + c
	else
	cc = (c - t) + cs
	end if
	cs = t
	ccs = ccs + cc
	end do
	end do
	jll_nll(i)=s + cs + ccs
	end do
	end function rec_log_series

	@ %def rec_log_series
	@
	<<Electron PDFs: public>>=
	public :: add_logvec
	<<Electron PDFs: sub interfaces>>=
	module pure function add_logvec (expansion1, expansion2) result (jll_nll)
	real(wp), dimension(7,7,2), intent(in) :: expansion1, expansion2
	real(wp), dimension(7,7,2) :: jll_nll
	end function add_logvec
	<<Electron PDFs: procedures>>=
	module pure function add_logvec (expansion1, expansion2) result (jll_nll)
	real(wp), dimension(7,7,2), intent(in) :: expansion1, expansion2
	real(wp), dimension(7,7,2) :: jll_nll
	integer :: i,j,k
	real(wp) :: temp, s, t, c , cc, cs, ccs
	do i = 1, size(jll_nll,1)
	do j = 1, size(jll_nll,2)
	do k = 1, size(jll_nll,3)
	jll_nll(i,j,k) = expansion1(i,j,k) + expansion2(i,j,k)
	end do
	end do
	end do
	end function add_logvec

	@ %def add_logvec
	@
	<<Electron PDFs: public>>=
	public :: sub_logvec
	<<Electron PDFs: sub interfaces>>=
	module pure function sub_logvec (expansion1, expansion2) result (jll_nll)
	real(wp), dimension(7,7,2), intent(in) :: expansion1, expansion2
	real(wp), dimension(7,7,2) :: jll_nll
	end function sub_logvec
	<<Electron PDFs: procedures>>=
	module pure function sub_logvec (expansion1, expansion2) result (jll_nll)
	real(wp), dimension(7,7,2), intent(in) :: expansion1, expansion2
	real(wp), dimension(7,7,2) :: jll_nll
	integer :: i,j,k
	real(wp) :: temp, s, t, c , cc, cs, ccs
	do i = 1, size(jll_nll,1)
	do j = 1, size(jll_nll,2)
	do k = 1, size(jll_nll,3)
	jll_nll(i,j,k) = expansion1(i,j,k) - expansion2(i,j,k)
	end do
	end do
	end do
	end function sub_logvec

	@ %def sub_logvec
	@
	<<Electron PDFs: public>>=
	public :: endpoint_func_S
	<<Electron PDFs: sub interfaces>>=
	module pure function endpoint_func_S (x, xb, xp, pl, n) result (ints)
	real(wp), intent(in) :: x, xb, xp, n
	real(wp), dimension(12), intent(in) :: pl
	real(wp), dimension(7) :: ints
	end function endpoint_func_S
	<<Electron PDFs: procedures>>=
	module pure function endpoint_func_S (x, xb, xp, pl, n) result (ints)
	real(wp), intent(in) :: x, xb, xp, n
	real(wp), dimension(12), intent(in) :: pl
	real(wp), dimension(7) :: ints
	real(wp), dimension(7) :: ele, pos
	integer :: i
	ele=endpoint_func_ELE (x, xb, xp, pl, n)
	pos=endpoint_func_POS (x, xb, xp, pl, n)
	do i = 1, size(ints)
	ints(i) = ele(i) + pos(i)
	end do
	end function endpoint_func_S

	@ %def endpoint_func_S
	@
	<<Electron PDFs: public>>=
	public :: endpoint_func_NS
	<<Electron PDFs: sub interfaces>>=
	module pure function endpoint_func_NS (x, xb, xp, pl, n) result (ints)
	real(wp), intent(in) :: x, xb, xp, n
	real(wp), dimension(12), intent(in) :: pl
	real(wp), dimension(7) :: ints
	end function endpoint_func_NS
	<<Electron PDFs: procedures>>=
	module pure function endpoint_func_NS (x, xb, xp, pl, n) result (ints)
	real(wp), intent(in) :: x, xb, xp, n
	real(wp), dimension(12), intent(in) :: pl
	real(wp), dimension(7) :: ints
	real(wp), dimension(7) :: ele, pos
	integer :: i
	ele=endpoint_func_ELE (x, xb, xp, pl, n)
	pos=endpoint_func_POS (x, xb, xp, pl, n)
	do i = 1, size(ints)
	ints(i) = ele(i) - pos(i)
	end do
	end function endpoint_func_NS

	@ %def endpoint_func_NS
	@
	<<Electron PDFs: public>>=
	public :: endpoint_func_GAM
	<<Electron PDFs: sub interfaces>>=
	module pure function endpoint_func_GAM (x, xb, xp, pl) result (ints)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), dimension(7) :: ints
	end function endpoint_func_GAM
	<<Electron PDFs: procedures>>=
	module pure function endpoint_func_GAM (x, xb, xp, pl) result (ints)
	real(wp), intent(in) :: x, xb, xp
	real(wp), dimension(12), intent(in) :: pl
	real(wp), dimension(7) :: ints
	ints=0._wp
	if (xb .le. 1.0e-7_wp) then
	ints(4) = (2._wpxb(-pi2 + ln2(4._wppi2 + (9._wp - 10._wpln2)ln2) + &
	3._wp(8._wp - 11._wpzeta3)))/3._wp
	ints(5) = (-4._wp(6._wp - pi2)xb)/3._wp
	ints(7) = -4._wp*xb
	elseif (x .le. 1.0e-7_wp ) then
	ints(4) = (-8._wp*zeta3)/x
	else
	ints(3) = (8._wp(-pi2 + 6._wppl(6)))/3._wp
	ints(4) = (4._wp(pl(1)(pi2 - 3._wppl(1)2) + 6._wp(2._wp*(pl(5) - pl(9)) -&
	zeta3)))/(3._wpx) + (2._wp(2._wp(7._wpln2*3 + pi2(-3._wp*ln2 - pl(1)) - &
	pl(1)*3 + 6._wp(-(pl(1)pl(6)) - pl(1)pl(8) - 4._wp*(pl(7) + pl(9)))) + &
	39._wp*zeta3))/3._wp
	ints(5) = (-4._wppi2)/3._wp + (4._wp(pi2 - 6._wppl(4)))/(3._wpx)
	ints(6) = 0._wp
	ints(7) = 4._wp - 4._wp/x
	endif
	end function endpoint_func_GAM

	@ %def endpoint_func_GAM
	@
	<<Electron PDFs: public>>=
	public :: endpoint_func_POS
	<<Electron PDFs: sub interfaces>>=
	module pure function endpoint_func_POS (x, xb, xp, pl, n) result (ints)
	real(wp), intent(in) :: x, xb, xp, n
	real(wp), dimension(12), intent(in) :: pl
	real(wp), dimension(7) :: ints
	end function endpoint_func_POS
	<<Electron PDFs: procedures>>=
	module pure function endpoint_func_POS (x, xb, xp, pl, n) result (ints)
	real(wp), intent(in) :: x, xb, xp, n
	real(wp), dimension(12), intent(in) :: pl
	real(wp), dimension(7) :: ints
	ints = 0._wp
	if (xb .le. 1.0e-7_wp) then
	ints(4) = (xb(4._wp(-18._wpn - pi2) + 15._wpln2(6._wp + 5._wpln2)))/6._wp
	ints(5) = -1._wp/3._wp(pi2xb)
	elseif (x .le. 1.0e-7_wp) then
	ints(1) = -4._wp/3._wp
	ints(2) = 1._wp
	ints(3) = 2._wp(npi2 - 2._wp(1._wp - pi)(1._wp + pi))
	ints(4) = (4._wpln2(2._wppi2 + 5._wp(3._wp - 2._wpln2)ln2) + &
	3._wp(-2._wp(8._wp + pi2) + (61._wp + 24._wpn)zeta3))/6._wp
	else
	ints(1) = (4._wpxb)/3._wp - 8._wp/(3._wpxp)
	ints(2) = -3._wp - 7._wp*x + 4._wp/xp
	ints(3) = (-2._wp(pi2 + 3._wp(-pl(1)*2 - 2._wp(pl(6) + &
	pl(8)))))/(3._wpxb) + (2._wp(pi2 + 2._wp(3._wppl(1)**2 + pl(2) + pl(4) + &
	2._wp(-pl(6) + 3._wppl(8)))))/xp + (2._wp(-(pi2(2._wp - 3._wp*x)) + &
	3._wp(npi2 - (2._wp - x)pl(1)2 - 2._wp(xp - (2._wp - 3._wpx)pl(6) - &
	3._wpnpl(2) + (2._wp - x)*pl(8)))))/3._wp
	ints(4) = (4._wp(-5._wpln2*3 + pi2(2._wp*ln2 - pl(1)) + &
	3._wp(pl(1)3 + 2._wp(-pl(7) + 2._wppl(9)))))/(3._wpxb) - (pi2*(19._wp + &
	15._wpx + 2._wp(-2._wpln2 - 21._wppl(1))) + 6._wp(pl(1)(-3._wp*(2._wp - &
	pl(1))pl(1) + 2._wp(-5._wppl(6) - 4._wp(pl(2) + pl(4)))) + &
	2._wp(5._wp(ln2*3 + pl(1)pl(8)) + 2._wp(5._wp(ln2*pl(10) + pl(11)) + &
	2._wp(pl(8) - pl(7) + pl(3) + 2._wp(-pl(5) - 3._wp*pl(9)) + &
	pl(12))))))/(3._wpxp) - (4._wp(9._wp + x)zeta3)/(xbxp) + (3._wp*(59._wp - &
	19._wpx)zeta3 + 2._wp(pi2(-8._wpln2 - (1._wp - 5._wpx)*pl(1)) + &
	3._wppl(1)2(-5._wpxp - (3._wp + x)pl(1)) + 2._wp*(-((12._wp - &
	7._wppi2)xb) + 5._wp(ln22(3._wp(1._wp + 2._wpx) + 2._wp*ln2) + &
	3._wp((-2._wpx - xbpl(1))pl(6) + (2._wpxp - xbpl(1))*pl(8))) + &
	6._wp((-6._wpn + xb)pl(3) + (-3._wpn - 2._wpxb)pl(5) - (13._wp - &
	9._wpx)pl(9) + xbpl(12) + 2._wp(-(xbpl(1)pl(2)) - xbpl(1)pl(4) - (2._wp - &
	3._wpx)pl(7) + 3._wpnzeta3)))))/6._wp
	ints(5) = (4._wp(5._wp(ln22 - pl(1)2) - 4._wp*pl(6)))/xp + &
	(2._wp(-pi2 + 12._wpxb*pl(6)))/3._wp
	endif
	end function endpoint_func_POS

	@ %def endpoint_func_POS
	@
	<<Electron PDFs: public>>=
	public :: endpoint_func_ELE
	<<Electron PDFs: sub interfaces>>=
	module pure function endpoint_func_ELE (x, xb, xp, pl, n) result (ints)
	real(wp), intent(in) :: x, xb, xp, n
	real(wp), dimension(12), intent(in) :: pl
	real(wp), dimension(7) :: ints
	end function endpoint_func_ELE
	<<Electron PDFs: procedures>>=
	module pure function endpoint_func_ELE (x, xb, xp, pl, n) result (ints)
	real(wp), intent(in) :: x, xb, xp, n
	real(wp), dimension(12), intent(in) :: pl
	real(wp), dimension(7) :: ints
	ints=0._wp
	if (xb .le. 1.0e-7_wp) then
	ints(4) = ((-6._wp(5._wp + 6._wpn) - pi2)*xb)/3._wp
	ints(5) = 4._wp*xb
	elseif (x .le. 1.0e-7_wp) then
	ints(3) = (-2._wp(1._wp - 3._wpn)*pi2)/3._wp
	ints(4) = 2._wp(-pi2 - 2._wp(1._wp - 3._wpnzeta3))
	else
	ints(2) = -2._wp*x
	ints(3) = -1._wp/3._wp(21._wp + 4._wppi2)/xb + (pi2xp + 3._wp(7._wp + &
	x + 2._wp(npi2 + (6._wpn + xp)pl(2) + xp*pl(4))))/3._wp
	ints(4) = (-(pi2(7._wp - 10._wpx)) + 3._wp(5._wpxb - &
	6._wppl(2)))/(3._wpxb) + (12._wp(-((6._wpn + xp)pl(3)) - (3._wpn + &
	xp)pl(5) + 6._wpnzeta3) + xp(pi2 - 3._wp(9._wp - 4._wp(pl(2) + &
	zeta3))))/3._wp
	ints(5) = -3._wp(1._wp - 3._wpx) + 4._wpxppl(4)
	endif
	end function endpoint_func_ELE

	@ %def endpoint_func_ELE
	@
	<<Electron PDFs: procedures>>=
	subroutine photon_matching (log_xb, x0, x1, p, bar, asym)
	real(wp), intent(in) :: log_xb, x0, x1, p
	real(wp), intent(inout), dimension(7,7,2) :: bar
	real(wp), intent(inout), dimension(7,7,2) :: asym
	real(wp) :: xm, logxb10, p_match
	logxb10 = - log_xb / ln10
	if (logxb10 < x0) then
	bar = bar
	asym = 0._wp
	else if (logxb10 > x1) then
	bar = 0._wp
	asym = asym
	else
	xm = (x1 - x0) / (logxb10 - x0)
	p_match = (1._wp + (xm - 1._wp)p)(-1)
	bar = (1._wp - p_match) * bar
	asym = p_match * asym
	end if
	end subroutine photon_matching

	@ %def photon_matching
	@
	<<Electron PDFs: public>>=
	public :: elec_pdf
	<<Electron PDFs: sub interfaces>>=
	module function elec_pdf (epdf, flv, x, xb, scale) result (res)
	type(qed_pdf_t), intent(in) :: epdf
	real(wp) :: res
	integer, intent(in) :: flv
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: scale
	end function elec_pdf
	<<Electron PDFs: procedures>>=
	module function elec_pdf (epdf, flv, x, xb, scale) result (res)
	type(qed_pdf_t), intent(in) :: epdf
	real(wp) :: res
	integer, intent(in) :: flv
	real(wp), intent(in) :: x, xb
	real(wp), intent(in) :: scale
	integer :: nf, nlep
	real(wp), parameter :: &
	x0gam = 2.0_wp, x1gam = 6.0_wp, pgam = 2.0_wp
	real(wp), parameter :: xmin=0._wp, xmax=1._wp
	real(wp) :: xp, log_x, log_xb
	real(wp) :: ln0, eta0, alpha, al0_2pi, al_2pi, p, n, run
	real(wp), dimension(7,7,2) :: &
	asym=0._wp, asymb=0._wp, hat=0._wp, bar=0._wp, num=0.0_wp
	real(wp), dimension(12) :: pl
	logical :: running
	logical, dimension(6) :: order
	! Cut for x->0
	if (x .le. 1.0e-45_wp) then
	res = 0._wp
	return
	end if
	! Cut Positron part for x->1
	if (xb .le. 1.0e-6_wp .and. flv .eq. EPDF_POS) then
	res = 0._wp
	return
	end if
	! Cut Photon part for x->1
	if (xb .le. 1.0e-8_wp .and. flv .eq. EPDF_G) then
	res = 0._wp
	return
	end if
	! Cut Electron part for x->1
	if (xb .le. 1.0e-15_wp .and. flv .eq. EPDF_ELE) then
	res = 0._wp
	return
	end if
	! Calculate computing intensive polylogs only if necessary
	pl = 0._wp
	if (xb .ge. 1.0e-7_wp .and. x .ge. 1.0e-7) then
	pl(1) = log(1._wp+x)
	pl(2) = polylog(2,x)
	pl(3) = polylog(3,x)
	pl(4) = polylog(2,xb)
	pl(5) = polylog(3,xb)
	pl(6) = polylog(2,-x)
	pl(7) = polylog(3,-x)
	pl(8) = polylog(2,1._wp/(1._wp+x))
	pl(9) = polylog(3,1._wp/(1._wp+x))
	pl(10) = polylog(2,(1._wp+x)/2._wp)
	pl(11) = polylog(3,(1._wp+x)/2._wp)
	pl(12) = polylog(3,xb*(1._wp+x))
	endif
	xp = 1._wp + x
	log_x = log_prec(x,xb)
	log_xb = log_prec(xb,x)
	call set_qed_pdf_parameters (epdf, scale, alpha, running, &
	nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	select case (flv)
	case (EPDF_S,EPDF_NS,EPDF_ELE, EPDF_POS)
	bar = recbar (flv, x, xb, n, run, order)
	hat = rechat (flv, x, xb, xp, pl, n, run, order)
	asymb = - bar_asym (flv, xb, n, run, order)
	asym = recasym (flv, x, xb, log_xb, nlep, nf, &
	n, p, al0_2pi, al_2pi, order, running)
	num = recnum (flv, x, xb, xp, pl, n)
	case (EPDF_G)
	bar = recbar (flv, x, xb, n, run, order)
	hat = rechat (flv, x, xb, xp, pl, n, run, order)
	asymb = 0._wp
	asym = recasym (flv, x, xb, log_xb, nlep, nf, &
	n, p, al0_2pi, al_2pi, order, running)
	num = recnum (flv, x, xb, xp, pl, n)
	call photon_matching (log_xb, x0gam, x1gam, pgam, bar, asym)
	case default
	call msg_fatal ("elec_pdf: wrong lepton flavor.")
	end select
	res = full_series (log_x, log_xb, ln0, p, al_2pi, bar, hat, num, asymb, asym)
	end function elec_pdf

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

	module electron_pdfs_ut
	use unit_tests
	use electron_pdfs_uti

	<<Standard module head>>

	<<Electron PDFs: public test>>

	contains

	<<Electron PDFs: test driver>>

	end module electron_pdfs_ut
	@ %def electron_pdfs_ut
	@
	<<[[electron_pdfs_uti.f90]]>>=
	<<File header>>

	module electron_pdfs_uti

	<<Use kinds>>
	use numeric_utils, only: log_prec
	use format_defs, only: FMT_15
	use constants
	use physics_defs, only: ME_REF, ALPHA_QED_ME_REF
	use sm_physics, only: polylog
	use electron_pdfs

	<<Standard module head>>

	<<Electron PDFs: test declarations>>

	integer, parameter :: wp = default
	integer, parameter :: dimx = 37
	!
	! Attention:
	! The commented out c values are for testing only and cause minor
	! numerical fluctuations between quadruple, extended and double precision
	!
	real(wp), dimension(dimx), parameter :: xx = [ &
	! 0.000000000000000000000000000000000000000000010_wp, &
	! 0.000000000000000000000000000000000000000000100_wp, &
	! 0.000000000000000000000000000000000000000001000_wp, &
	! 0.000000000000000000000000000000000000000010000_wp, &
	! 0.000000000000000000000000000000000000000100000_wp, &
	! 0.000000000000000000000000000000000000001000000_wp, &
	! 0.000000000000000000000000000000000000010000000_wp, &
	! 0.000000000000000000000000000000000000100000000_wp, &
	! 0.000000000000000000000000000000000001000000000_wp, &
	! 0.000000000000000000000000000000000010000000000_wp, &
	! 0.000000000000000000000000000000000100000000000_wp, &
	! 0.000000000000000000000000000000001000000000000_wp, &
	! 0.000000000000000000000000000000010000000000000_wp, &
	! 0.000000000000000000000000000000100000000000000_wp, &
	! 0.000000000000000000000000000001000000000000000_wp, &
	! 0.000000000000000000000000000010000000000000000_wp, &
	! 0.000000000000000000000000000100000000000000000_wp, &
	! 0.000000000000000000000000001000000000000000000_wp, &
	! 0.000000000000000000000000010000000000000000000_wp, &
	! 0.000000000000000000000000100000000000000000000_wp, &
	0.000000000000000000000001000000000000000000000_wp, &
	0.000000000000000000000010000000000000000000000_wp, &
	0.000000000000000000000100000000000000000000000_wp, &
	0.000000000000000000001000000000000000000000000_wp, &
	0.000000000000000000010000000000000000000000000_wp, &
	0.000000000000000000100000000000000000000000000_wp, &
	0.000000000000000001000000000000000000000000000_wp, &
	0.000000000000000010000000000000000000000000000_wp, &
	0.000000000000000100000000000000000000000000000_wp, &
	0.000000000000001000000000000000000000000000000_wp, &
	0.000000000000010000000000000000000000000000000_wp, &
	0.000000000000100000000000000000000000000000000_wp, &
	0.000000000001000000000000000000000000000000000_wp, &
	0.000000000010000000000000000000000000000000000_wp, &
	0.000000000100000000000000000000000000000000000_wp, &
	0.000000001000000000000000000000000000000000000_wp, &
	0.000000010000000000000000000000000000000000000_wp, &
	0.000000100000000000000000000000000000000000000_wp, &
	0.000001000000000000000000000000000000000000000_wp, &
	0.000010000000000000000000000000000000000000000_wp, &
	0.000100000000000000000000000000000000000000000_wp, &
	0.001000000000000000000000000000000000000000000_wp, &
	0.010000000000000000000000000000000000000000000_wp, &
	0.100000000000000000000000000000000000000000000_wp, &
	0.200000000000000000000000000000000000000000000_wp, &
	0.300000000000000000000000000000000000000000000_wp, &
	0.400000000000000000000000000000000000000000000_wp, &
	0.500000000000000000000000000000000000000000000_wp, &
	0.600000000000000000000000000000000000000000000_wp, &
	0.700000000000000000000000000000000000000000000_wp, &
	0.800000000000000000000000000000000000000000000_wp, &
	0.900000000000000000000000000000000000000000000_wp, &
	0.950000000000000000000000000000000000000000000_wp, &
	0.990000000000000000000000000000000000000000000_wp, &
	0.999000000000000000000000000000000000000000000_wp, &
	0.999900000000000000000000000000000000000000000_wp, &
	0.999990000000000000000000000000000000000000000_wp &
	! 0.999999000000000000000000000000000000000000000_wp, &
	! 0.999999900000000000000000000000000000000000000_wp, &
	! 0.999999990000000000000000000000000000000000000_wp, &
	! 0.999999999000000000000000000000000000000000000_wp, &
	! 0.999999999900000000000000000000000000000000000_wp, &
	! 0.999999999990000000000000000000000000000000000_wp, &
	! 0.999999999999000000000000000000000000000000000_wp, &
	! 0.999999999999900000000000000000000000000000000_wp, &
	! 0.999999999999990000000000000000000000000000000_wp, &
	! 0.999999999999999000000000000000000000000000000_wp, &
	! 0.999999999999999900000000000000000000000000000_wp &
	]

	contains

	<<Electron PDFs: tests>>

	end module electron_pdfs_uti
	@ %def electron_pdfs_ut
	@ API: driver for the unit tests below.
	<<Electron PDFs: public test>>=
	public :: electron_pdfs_test
	<<Electron PDFs: test driver>>=
	subroutine electron_pdfs_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Electron PDFs: execute tests>>
	end subroutine electron_pdfs_test

	@ %def electron_pdfs_test
	@
	\subsubsection{Electron PDF tests}
	<<Electron PDFs: execute tests>>=
	call test (electron_pdfs_1, "electron_pdfs_1", &
	"Electron PDFs: auxiliary functions", &
	u, results)
	<<Electron PDFs: test declarations>>=
	public :: electron_pdfs_1
	<<Electron PDFs: tests>>=
	subroutine electron_pdfs_1 (u)
	integer, intent(in) :: u
	type(qed_pdf_t) :: pdf
	real(wp) :: alpha, ln0, eta0, n, p, b0, b01, al0_2pi, al_2pi, run
	real(wp), parameter :: Q=10._wp
	real(wp), dimension(dimx) :: x, xb, xp, log_x, log_xb
	real(wp), dimension(dimx,12) :: pl
	logical, dimension(6) :: order = .true.
	logical :: running
	integer :: nlep, nf, i
	alpha = ALPHA_QED_ME_REF
	nlep = 1
	do i = 1, size(x)
	x(i) =real(xx(i), kind=wp)
	xb(i) = 1._wp - x(i)
	xp(i) = 1._wp + x(i)
	log_x(i) = log_prec(x(i),xb(i))
	log_xb(i) = log_prec(xb(i),x(i))
	pl(i,1) = log(1._wp+x(i))
	pl(i,2) = polylog(2,x(i))
	pl(i,3) = polylog(3,x(i))
	pl(i,4) = polylog(2,xb(i))
	pl(i,5) = polylog(3,xb(i))
	pl(i,6) = polylog(2,-x(i))
	pl(i,7) = polylog(3,-x(i))
	pl(i,8) = polylog(2,1._wp/(1._wp+x(i)))
	pl(i,9) = polylog(3,1._wp/(1._wp+x(i)))
	pl(i,10) = polylog(2,(1._wp+x(i))/2._wp)
	pl(i,11) = polylog(3,(1._wp+x(i))/2._wp)
	pl(i,12) = polylog(3,xb(i)*(1._wp+x(i)))
	end do
	write (u, "(A)") "* Test output: electron_pdfs_1"
	write (u, "(A)") "* Purpose: check analytic properties"
	write (u, "(A)")
	write (u, "(A)") "* Auxiliary functions I:"
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, elec_asym, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, 1)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,1) " elec_asym (LL,x=", xx(i) ,") = ", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, elec_asym ( &
	xb(i), nlep, nf, n, p, al0_2pi, al_2pi, order, .false.) &
	)
	1 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, 1)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,2) " elec_asym (NLL,x=", xx(i) ,") = ", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, elec_asym ( &
	xb(i), nlep, nf, n, p, al0_2pi, al_2pi, order, .false.) &
	)
	2 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, elec_asym, LL+NLL, alpha running:"
	write (u, "(A)")
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, 1)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,3) " elec_asym (LL,x=", xx(i) ,") = ", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, elec_asym ( &
	xb(i), nlep, nf, n, p, al0_2pi, al_2pi, order, .true.) &
	)
	3 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, 1)
	write (u, "(A)")
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,4) " elec_asym (NLL,x=", xx(i) ,") = ", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, elec_asym ( &
	xb(i), nlep, nf, n, p, al0_2pi, al_2pi, order, .true.) &
	)
	4 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, phot_asym, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, 1)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,5) " phot_asym (LL,x=", xx(i) ,") = ", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, phot_asym ( &
	x(i), xb(i), log_xb(i), n, p, al0_2pi, order, .false.) &
	)
	5 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, 1)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	write (u, "(A)")
	do i = 1, size(x)
	write (u,6) " phot_asym (NLL,x=", xx(i) ,") = ", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, phot_asym ( &
	x(i), xb(i), log_xb(i), n, p, al0_2pi, order, .false.) &
	)
	6 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, phot_asym, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, 1)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,7) " phot_asym (LL,x=", xx(i) ,") = ", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, phot_asym ( &
	x(i), xb(i), log_xb(i), n, p, al0_2pi, order, .true.) &
	)
	7 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, 1)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	write (u, "(A)")
	do i = 1, size(x)
	write (u,8) " phot_asym (NLL,x=", xx(i) ,") = ", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, phot_asym ( &
	x(i), xb(i), log_xb(i), n, p, al0_2pi, order, .true.) &
	)
	8 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Test output end: electron_pdfs_1"
	end subroutine electron_pdfs_1

	@ %def electron_Pd's_1
	@
	<<Electron PDFs: execute tests>>=
	call test (electron_pdfs_2, "electron_pdfs_2", &
	"Electron PDFs: auxiliary functions (2)", &
	u, results)
	<<Electron PDFs: test declarations>>=
	public :: electron_pdfs_2
	<<Electron PDFs: tests>>=
	subroutine electron_pdfs_2 (u)
	integer, intent(in) :: u
	type(qed_pdf_t) :: pdf
	real(wp) :: alpha, ln0, eta0, n, p, b0, b01, al0_2pi, al_2pi, run
	real(wp), parameter :: Q=10._wp
	real(wp), dimension(dimx) :: x, xb, xp, log_x, log_xb
	real(wp), dimension(dimx,12) :: pl
	real(wp), dimension(7,7,2) :: jll_nll = 0.0_wp
	logical, dimension(6) :: order = .true.
	logical :: running
	integer :: nlep, nf, i
	nlep = 1
	do i = 1, size(x)
	x(i) =real(xx(i), kind=wp)
	xb(i) = 1._wp - x(i)
	xp(i) = 1._wp + x(i)
	log_x(i) = log_prec(x(i),xb(i))
	log_xb(i) = log_prec(xb(i),x(i))
	pl(i,1) = log(1._wp+x(i))
	pl(i,2) = polylog(2,x(i))
	pl(i,3) = polylog(3,x(i))
	pl(i,4) = polylog(2,xb(i))
	pl(i,5) = polylog(3,xb(i))
	pl(i,6) = polylog(2,-x(i))
	pl(i,7) = polylog(3,-x(i))
	pl(i,8) = polylog(2,1._wp/(1._wp+x(i)))
	pl(i,9) = polylog(3,1._wp/(1._wp+x(i)))
	pl(i,10) = polylog(2,(1._wp+x(i))/2._wp)
	pl(i,11) = polylog(3,(1._wp+x(i))/2._wp)
	pl(i,12) = polylog(3,xb(i)*(1._wp+x(i)))
	end do
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	write (u, "(A)") "* Test output: electron_pdfs_2"
	write (u, "(A)") "* Purpose: check analytic properties"
	write (u, "(A)")
	write (u, "(A)") "* Auxiliary functions II:"
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, elecbar_asym_p, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call elecbar_asym_p (xb(i), jll_nll, n, 0._wp, order)
	write (u,1) " elecbar_asym_p (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	1 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, elecbar_asym_p, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call elecbar_asym_p (xb(i), jll_nll, n, 1._wp, order)
	write (u,2) " elecbar_asym_p (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	2 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, photbar_asym_p, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call photbar_asym_p (jll_nll, n, 0._wp, order)
	write (u,3) " photbar_asym_p (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	3 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, photbar_asym_p, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call photbar_asym_p (jll_nll, n, run, order)
	write (u,4) " photbar_asym_p (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	4 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat_s, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call rechat_singlet (x(i), xb(i), xp(i), pl(i,:), jll_nll, n, 0._wp, order)
	write (u,5) " rechat_singlet (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	5 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat_s, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call rechat_singlet (x(i), xb(i), xp(i), pl(i,:), jll_nll, n, run, order)
	write (u,6) " rechat_singlet (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	6 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat_ns, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call rechat_nonsinglet (x(i), xb(i), xp(i), pl(i,:), jll_nll, n, 0._wp, order)
	write (u,7) " rechat_nonsinglet (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	7 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat_ns, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call rechat_nonsinglet (x(i), xb(i), xp(i), pl(i,:), jll_nll, n, run, order)
	write (u,8) " rechat_nonsinglet (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	8 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat_photon, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call rechat_photon (x(i), xb(i), xp(i), pl(i,:), jll_nll, n, 0._wp, order)
	write (u,9) " rechat_photon (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	9 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat_photon, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call rechat_photon (x(i), xb(i), xp(i), pl(i,:), jll_nll, n, run, order)
	write (u,10) " rechat_photon (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	10 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat_ele, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call rechat_ele (x(i), xb(i), xp(i), pl(i,:), jll_nll, n, 0._wp, order)
	write (u,11) " rechat_ele (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	11 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat_ele, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call rechat_ele (x(i), xb(i), xp(i), pl(i,:), jll_nll, n, run, order)
	write (u,12) " rechat_ele (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	12 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat_pos, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call rechat_pos (x(i), xb(i), xp(i), pl(i,:), jll_nll, n, 0._wp, order)
	write (u,13) " rechat_pos (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	13 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat_pos, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call rechat_pos (x(i), xb(i), xp(i), pl(i,:), jll_nll, n, run, order)
	write (u,14) " rechat_pos (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	14 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar_s, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call recbar_singlet (x(i), xb(i), jll_nll, n, 0._wp, order)
	write (u,15) " recbar_singlet (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	15 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar_s, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call recbar_singlet (x(i), xb(i), jll_nll, n, run, order)
	write (u,16) " recbar_singlet (x=", xx(i) ,") = " ,&
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	16 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar_ns, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call recbar_nonsinglet (x(i), xb(i), jll_nll, n, 0._wp, order)
	write (u,17) " recbar_nonsinglet (x=", xx(i) ,") = " ,&
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	17 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar_ns, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call recbar_nonsinglet (x(i), xb(i), jll_nll, n, run, order)
	write (u,18) " recbar_nonsinglet (x=", xx(i) ,") = " ,&
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	18 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar_photon, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call recbar_photon (jll_nll, x(i), xb(i), n, 0._wp, order)
	write (u,19) " recbar_photon (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	19 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar_photon, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call recbar_photon (jll_nll, x(i), xb(i), n, run, order)
	write (u,20) " recbar_photon (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	20 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar_ele, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call recbar_ele (x(i), xb(i), jll_nll, n, 0._wp, order)
	write (u,21) " recbar_ele (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	21 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar_ele, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call recbar_ele (x(i), xb(i), jll_nll, n, run, order)
	write (u,22) " recbar_ele (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	22 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar_pos, LL+NLL, alpha fixed:"
	write (u, "(A)")
	do i = 1, size(x)
	call recbar_pos (jll_nll, n, 0._wp, order)
	write (u,23) " recbar_pos (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	23 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar_pos, LL+NLL, alpha running:"
	write (u, "(A)")
	do i = 1, size(x)
	call recbar_pos (jll_nll, n, run, order)
	write (u,24) " recbar_pos (x=", xx(i) ,") = " , &
	rec_log_series(log_x(i), log_xb(i), ln0, jll_nll)
	24 format(A,RN,ES20.10,A,6(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Test output end: electron_pdfs_2"
	end subroutine electron_pdfs_2

	@ %def electron_pdfs_2
	@
	<<Electron PDFs: execute tests>>=
	call test (electron_pdfs_3, "electron_pdfs_3", &
	"Electron PDFs: auxiliary functions (3)", &
	u, results)
	<<Electron PDFs: test declarations>>=
	public :: electron_pdfs_3
	<<Electron PDFs: tests>>=
	subroutine electron_pdfs_3 (u)
	integer, intent(in) :: u
	type(qed_pdf_t) :: pdf
	real(wp) :: alpha, ln0, eta0, n, p, al0_2pi, al_2pi, run
	real(wp), parameter :: Q=10._wp
	real(wp), dimension(dimx) :: x, xb, xp, log_x, log_xb
	real(wp), dimension(dimx,12) :: pl
	logical :: running
	logical, dimension(6) :: order = .true.
	integer :: nlep, nf, i
	alpha = ALPHA_QED_ME_REF
	nlep = 1
	do i = 1, size(x)
	x(i) =real(xx(i), kind=wp)
	xb(i) = 1._wp - x(i)
	xp(i) = 1._wp + x(i)
	log_x(i) = log_prec(x(i),xb(i))
	log_xb(i) = log_prec(xb(i),x(i))
	pl(i,1) = log(1._wp+x(i))
	pl(i,2) = polylog(2,x(i))
	pl(i,3) = polylog(3,x(i))
	pl(i,4) = polylog(2,xb(i))
	pl(i,5) = polylog(3,xb(i))
	pl(i,6) = polylog(2,-x(i))
	pl(i,7) = polylog(3,-x(i))
	pl(i,8) = polylog(2,1._wp/(1._wp+x(i)))
	pl(i,9) = polylog(3,1._wp/(1._wp+x(i)))
	pl(i,10) = polylog(2,(1._wp+x(i))/2._wp)
	pl(i,11) = polylog(3,(1._wp+x(i))/2._wp)
	pl(i,12) = polylog(3,xb(i)*(1._wp+x(i)))
	end do
	write (u, "(A)") "* Test output: electron_pdfs_3"
	write (u, "(A)") "* Purpose: check analytic properties"
	write (u, "(A)")
	write (u, "(A)") "* Auxiliary functions III:"
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, bar_asym, e+-, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,1) " bar_asym (ELE,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, bar_asym ( &
	EPDF_ELE, xb(i), n, run, order))
	1 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,2) " bar_asym (ELE,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, bar_asym ( &
	EPDF_ELE, xb(i), n, run, order))
	2 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, bar_asym, e+-, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,3) " bar_asym (ELE,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, bar_asym ( &
	EPDF_ELE, xb(i), n, run, order))
	3 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,4) " bar_asym (ELE,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, bar_asym ( &
	EPDF_ELE, xb(i), n, run, order))
	4 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, bar_asym, gam, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,5) " bar_asym (GAM,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, bar_asym ( &
	EPDF_G, xb(i), n, run, order))
	5 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,6) " bar_asym (GAM,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, bar_asym ( &
	EPDF_G, xb(i), n, run, order))
	6 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, bar_asym, gam, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,7) " bar_asym (GAM,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, bar_asym ( &
	EPDF_G, xb(i), n, run, order))
	7 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,8) " bar_asym (GAM,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, bar_asym ( &
	EPDF_G, xb(i), n, run, order))
	8 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar, S, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,9) " recbar (S,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_S, x(i), xb(i), n, 0._wp, order))
	9 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,10) " recbar (S,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_S, x(i), xb(i), n, 0._wp, order))
	10 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar, S, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,11) " recbar (S,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_S, x(i), xb(i), n, run, order))
	11 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,12) " recbar (S,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_S, x(i), xb(i), n, run, order))
	12 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar, NS, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,13) " recbar (NS,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_NS, x(i), xb(i), n, 0._wp, order))
	13 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,14) " recbar (NS,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_NS, x(i), xb(i), n, 0._wp, order))
	14 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar, NS, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,15) " recbar (NS,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_NS, x(i), xb(i), n, run, order))
	15 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,16) " recbar (NS,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_NS, x(i), xb(i), n, run, order))
	16 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar, GAM, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,17) " recbar (GAM,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_G, x(i), xb(i), n, run, order))
	17 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,18) " recbar (GAM,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_G, x(i), xb(i), n, run, order))
	18 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar, GAM, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,19) " recbar (GAM,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_G, x(i), xb(i), n, run, order))
	19 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,20) " recbar (GAM,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_G, x(i), xb(i), n, run, order))
	20 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar, ELE, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,21) " recbar (ELE,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_ELE, x(i), xb(i), n, 0._wp, order))
	21 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,22) " recbar (ELE,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_ELE, x(i), xb(i), n, 0._wp, order))
	22 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar, ELE, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,23) " recbar (ELE,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_ELE, x(i), xb(i), n, run, order))
	23 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,24) " recbar (ELE,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_ELE, x(i), xb(i), n, run, order))
	24 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar, POS, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,25) " recbar (POS,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_POS, x(i), xb(i), n, 0._wp, order))
	25 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,26) " recbar (POS,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_POS, x(i), xb(i), n, 0._wp, order))
	26 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recbar, POS, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,27) " recbar (POS,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_POS, x(i), xb(i), n, run, order))
	27 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,28) " recbar (POS,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recbar ( &
	EPDF_POS, x(i), xb(i), n, run, order))
	28 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Test output end: electron_pdfs_3"
	end subroutine electron_pdfs_3

	@ %def electron_pdfs_3
	@
	<<Electron PDFs: execute tests>>=
	call test (electron_pdfs_4, "electron_pdfs_4", &
	"Electron PDFs: auxiliary functions (4)", &
	u, results)
	<<Electron PDFs: test declarations>>=
	public :: electron_pdfs_4
	<<Electron PDFs: tests>>=
	subroutine electron_pdfs_4 (u)
	integer, intent(in) :: u
	type(qed_pdf_t) :: pdf
	real(wp) :: alpha, ln0, eta0, n, p, b0, b01, al0_2pi, al_2pi, run
	real(wp), parameter :: Q=10._wp
	real(wp), dimension(dimx) :: x, xb, xp, log_x, log_xb
	real(wp), dimension(dimx,12) :: pl
	logical, dimension(6) :: order = .true.
	logical :: running
	integer :: nlep, nf, i
	alpha = ALPHA_QED_ME_REF
	nlep = 1
	do i = 1, size(x)
	x(i) =real(xx(i), kind=wp)
	xb(i) = 1._wp - x(i)
	xp(i) = 1._wp + x(i)
	log_x(i) = log_prec(x(i),xb(i))
	log_xb(i) = log_prec(xb(i),x(i))
	pl(i,1) = log(1._wp+x(i))
	pl(i,2) = polylog(2,x(i))
	pl(i,3) = polylog(3,x(i))
	pl(i,4) = polylog(2,xb(i))
	pl(i,5) = polylog(3,xb(i))
	pl(i,6) = polylog(2,-x(i))
	pl(i,7) = polylog(3,-x(i))
	pl(i,8) = polylog(2,1._wp/(1._wp+x(i)))
	pl(i,9) = polylog(3,1._wp/(1._wp+x(i)))
	pl(i,10) = polylog(2,(1._wp+x(i))/2._wp)
	pl(i,11) = polylog(3,(1._wp+x(i))/2._wp)
	pl(i,12) = polylog(3,xb(i)*(1._wp+x(i)))
	end do
	write (u, "(A)") "* Test output: electron_pdfs_4"
	write (u, "(A)") "* Purpose: check analytic properties"
	write (u, "(A)")
	write (u, "(A)") "* Auxiliary functions IV:"
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat, S, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,1) " rechat (S,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_S, x(i), xb(i), xp(i), pl(i,:), n, 0._wp, order))
	1 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,2) " rechat (S,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_S, x(i), xb(i), xp(i), pl(i,:), n, 0._wp, order))
	2 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat, S, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,3) " rechat (S,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_S, x(i), xb(i), xp(i), pl(i,:), n, run, order))
	3 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,4) " rechat (S,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_S, x(i), xb(i), xp(i), pl(i,:), n, run, order))
	4 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat, NS, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,5) " rechat (NS,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_NS, x(i), xb(i), xp(i), pl(i,:), n, 0._wp, order))
	5 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,6) " rechat (NS,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_NS, x(i), xb(i), xp(i), pl(i,:), n, 0._wp, order))
	6 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat, NS, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,7) " rechat (NS,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_NS, x(i), xb(i), xp(i), pl(i,:), n, run, order))
	7 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,8) " rechat (NS,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_NS, x(i), xb(i), xp(i), pl(i,:), n, run, order))
	8 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat, GAM, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,9) " rechat (GAM,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_G, x(i), xb(i), xp(i), pl(i,:), n, 0._wp, order))
	9 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,10) " rechat (GAM,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_G, x(i), xb(i), xp(i), pl(i,:), n, 0._wp, order))
	10 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat, GAM, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,11) " rechat (GAM,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_G, x(i), xb(i), xp(i), pl(i,:), n, run, order))
	11 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,12) " rechat (GAM,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_G, x(i), xb(i), xp(i), pl(i,:), n, run, order))
	12 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat, ELE, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,13) " rechat (ELE,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_ELE, x(i), xb(i), xp(i), pl(i,:), n, 0._wp, order))
	13 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,14) " rechat (ELE,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_ELE, x(i), xb(i), xp(i), pl(i,:), n, 0._wp, order))
	14 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat, ELE, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,15) " rechat (ELE,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_ELE, x(i), xb(i), xp(i), pl(i,:), n, run, order))
	15 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,16) " rechat (ELE,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_ELE, x(i), xb(i), xp(i), pl(i,:), n, run, order))
	16 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat, POS, LL+NLL, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,17) " rechat (POS,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_POS, x(i), xb(i), xp(i), pl(i,:), n, 0._wp, order))
	17 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,18) " rechat (POS,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_POS, x(i), xb(i), xp(i), pl(i,:), n, 0._wp, order))
	18 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, rechat, POS, LL+NLL, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 0, nlep)
	call pdf%allocate_aqed (order = 0, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,19) " rechat (POS,LL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_POS, x(i), xb(i), xp(i), pl(i,:), n, run, order))
	19 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,20) " rechat (POS,NLL,x=", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, rechat ( &
	EPDF_POS, x(i), xb(i), xp(i), pl(i,:), n, run, order))
	20 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Test output end: electron_pdfs_4"
	end subroutine electron_pdfs_4

	@ %def electron_pdfs_4
	@
	<<Electron PDFs: execute tests>>=
	call test (electron_pdfs_5, "electron_pdfs_5", &
	"Electron PDFs: auxiliary functions (5)", &
	u, results)
	<<Electron PDFs: test declarations>>=
	public :: electron_pdfs_5
	<<Electron PDFs: tests>>=
	subroutine electron_pdfs_5 (u)
	integer, intent(in) :: u
	type(qed_pdf_t) :: pdf
	real(default), parameter :: scale=3000._wp
	real(wp) :: ens, es, egam, eele, epos
	real(wp),dimension(7,7,2) :: iens, ies, iegam, ieele, iepos
	real(wp) :: alpha, ln0, eta0, n, p, al0_2pi, al_2pi, run
	real(wp), parameter :: Q=10._wp
	real(wp), dimension(dimx) :: x, xb, xp, log_x, log_xb
	real(wp), dimension(dimx,12) :: pl
	logical, dimension(6) :: order = .true.
	logical :: running
	integer :: nlep, nf, i
	alpha = ALPHA_QED_ME_REF
	nlep=1
	do i = 1, size(x)
	x(i) =real(xx(i), kind=wp)
	xb(i) = 1._wp - x(i)
	xp(i) = 1._wp + x(i)
	log_x(i) = log_prec(x(i),xb(i))
	log_xb(i) = log_prec(xb(i),x(i))
	pl(i,1) = log(1._wp+x(i))
	pl(i,2) = polylog(2,x(i))
	pl(i,3) = polylog(3,x(i))
	pl(i,4) = polylog(2,xb(i))
	pl(i,5) = polylog(3,xb(i))
	pl(i,6) = polylog(2,-x(i))
	pl(i,7) = polylog(3,-x(i))
	pl(i,8) = polylog(2,1._wp/(1._wp+x(i)))
	pl(i,9) = polylog(3,1._wp/(1._wp+x(i)))
	pl(i,10) = polylog(2,(1._wp+x(i))/2._wp)
	pl(i,11) = polylog(3,(1._wp+x(i))/2._wp)
	pl(i,12) = polylog(3,xb(i)*(1._wp+x(i)))
	end do
	write (u, "(A)") "* Test output: electron_pdfs_5"
	write (u, "(A)") "* Purpose: check analytic properties"
	write (u, "(A)")
	write (u, "(A)") "* Auxiliary functions V:"
	write (u, "(A)")
	write (u, "(A)") "* Integrals over all endpoint functions, interval [0,1]:"
	write (u, "(A)")
	n = 1._wp
	p = 0._wp
	ln0 = 0._wp
	al_2pi = 0._wp
	do i = 1, size(x)
	ies = 0._wp
	iens = 0._wp
	iepos = 0._wp
	ieele = 0._wp
	iegam = 0._wp
	ies(7,:,1) = endpoint_func_S (x(i), xb(i), xp(i), pl(i,:), n)
	iens(7,:,1) = endpoint_func_NS (x(i), xb(i), xp(i), pl(i,:), n)
	iepos(7,:,1) = endpoint_func_POS (x(i), xb(i), xp(i), pl(i,:), n)
	ieele(7,:,1) = endpoint_func_ELE (x(i), xb(i), xp(i), pl(i,:), n)
	iegam(7,:,1) = endpoint_func_GAM (x(i), xb(i), xp(i), pl(i,:))
	es=full_series(log_x(i), log_xb(i), ln0, p, al_2pi, ies)
	ens=full_series(log_x(i), log_xb(i), ln0, p, al_2pi, iens)
	egam=full_series(log_x(i), log_xb(i), ln0, p, al_2pi, iegam)
	eele=full_series(log_x(i), log_xb(i), ln0, p, al_2pi, ieele)
	epos=full_series(log_x(i), log_xb(i), ln0, p, al_2pi, iepos)
	write (u,1) " endpoint_func_NS (", xx(i) ,") =", ens
	1 format(A,RN,ES20.10,A,1(1x,ES12.3))
	write (u,2) " endpoint_func_S (", xx(i) ,") =", es
	2 format(A,RN,ES20.10,A,1(1x,ES12.3))
	write (u,3) " endpoint_func_GAM (", xx(i) ,") =", egam
	3 format(A,RN,ES20.10,A,1(1x,ES12.3))
	write (u,4) " endpoint_func_ELE (", xx(i) ,") =", eele
	4 format(A,RN,ES20.10,A,1(1x,ES12.3))
	write (u,5) " endpoint_func_POS (", xx(i) ,") =", epos
	5 format(A,RN,ES20.10,A,1(1x,ES12.3))
	write (u, "(A,RN,ES20.10,A,F20.8)") &
	" endpoint_func (x = ", xx(i), ", e- - [S + NS]/2) = ", &
	abs(eele - (es + ens)/2._wp) / abs(eele + (es + ens)/2._wp) / 2._wp
	write (u, "(A,RN,ES20.10,A,F20.8)") &
	" endpoint_func (x = ", xx(i), ", e+ - [S - NS]/2) = ", &
	abs(epos - (es - ens)/2._wp ) / abs(epos + (es - ens)/2._wp) / 2._wp
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recnum, alpha fixed:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	scale, 3, 1, nlep)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,6) " recnum (S, ", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recnum( &
	EPDF_S, x(i), xb(i), xp(i), pl(i,:), n))
	6 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	do i = 1, size(x)
	write (u,7) " recnum (NS, ", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recnum( &
	EPDF_NS, x(i), xb(i), xp(i), pl(i,:), n))
	7 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	do i = 1, size(x)
	write (u,8) " recnum (GAM, ", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recnum( &
	EPDF_G, x(i), xb(i), xp(i), pl(i,:), n))
	8 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	do i = 1, size(x)
	write (u,9) " recnum (ELE, ", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recnum( &
	EPDF_ELE, x(i), xb(i), xp(i), pl(i,:), n))
	9 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	do i = 1, size(x)
	write (u,10) " recnum (POS, ", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recnum( &
	EPDF_POS, x(i), xb(i), xp(i), pl(i,:), n))
	10 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Q = 10 GeV, recnum, alpha running:"
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	scale, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	call set_qed_pdf_parameters (pdf, q, &
	alpha, running, nlep, nf, ln0, eta0, p, al0_2pi, al_2pi, n, run, order)
	do i = 1, size(x)
	write (u,11) " recnum (S, ", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recnum( &
	EPDF_S, x(i), xb(i), xp(i), pl(i,:), n))
	11 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	do i = 1, size(x)
	write (u,12) " recnum (NS, ", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recnum( &
	EPDF_NS, x(i), xb(i), xp(i), pl(i,:), n))
	12 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	do i = 1, size(x)
	write (u,13) " recnum (GAM, ", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recnum( &
	EPDF_G, x(i), xb(i), xp(i), pl(i,:), n))
	13 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	do i = 1, size(x)
	write (u,14) " recnum (ELE, ", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recnum( &
	EPDF_ELE, x(i), xb(i), xp(i), pl(i,:), n))
	14 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	do i = 1, size(x)
	write (u,15) " recnum (POS, ", xx(i) ,") =", &
	full_series(log_x(i), log_xb(i), ln0, p, al_2pi, recnum( &
	EPDF_POS, x(i), xb(i), xp(i), pl(i,:), n))
	15 format(A,RN,ES20.10,A,1(1x,ES12.3))
	end do
	write (u, "(A)")
	write (u, "(A)") "* Test output end: electron_pdfs_5"
	end subroutine electron_pdfs_5

	@ %def electron_pdfs_5
	@
	<<Electron PDFs: execute tests>>=
	call test (electron_pdfs_6, "electron_pdfs_6", &
	"Electron PDFs: full electron PDFs", &
	u, results)
	<<Electron PDFs: test declarations>>=
	public :: electron_pdfs_6
	<<Electron PDFs: tests>>=
	subroutine electron_pdfs_6 (u)
	integer, intent(in) :: u
	type(qed_pdf_t) :: pdf
	real(wp) :: pdf_s, pdf_ns, pdf_ele, pdf_pos, pdf_g
	real(wp) :: alpha, ln0, eta0, n, p, b0, b01, al_2pi, run
	real(wp), dimension(dimx) :: x, xb, xp, log_x, log_xb
	real(wp), dimension(dimx,12) :: pl
	real(wp), dimension(3), parameter :: Q = &
	[ 1.0_wp, 100.0_wp, 10000.0_wp ]
	integer :: nlep, nf, i, iq
	alpha = ALPHA_QED_ME_REF
	nlep = 1
	do i = 1, size(x)
	x(i) =real(xx(i), kind=wp)
	xb(i) = 1._wp - x(i)
	xp(i) = 1._wp + x(i)
	log_x(i) = log_prec(x(i),xb(i))
	log_xb(i) = log_prec(xb(i),x(i))
	pl(i,1) = log(1._wp+x(i))
	pl(i,2) = polylog(2,x(i))
	pl(i,3) = polylog(3,x(i))
	pl(i,4) = polylog(2,xb(i))
	pl(i,5) = polylog(3,xb(i))
	pl(i,6) = polylog(2,-x(i))
	pl(i,7) = polylog(3,-x(i))
	pl(i,8) = polylog(2,1._wp/(1._wp+x(i)))
	pl(i,9) = polylog(3,1._wp/(1._wp+x(i)))
	pl(i,10) = polylog(2,(1._wp+x(i))/2._wp)
	pl(i,11) = polylog(3,(1._wp+x(i))/2._wp)
	pl(i,12) = polylog(3,xb(i)*(1._wp+x(i)))
	end do
	write (u, "(A)") "* Test output: electron_pdfs_6"
	write (u, "(A)") "* Purpose: full electron PDFs"
	write (u, "(A)")
	write (u, "(A)") "* Full NLL electron PDFs:"
	do iq = 1, size(Q)
	write (u, 1) "* Q = ", Q(iq), " GeV, NLL, alpha fixed:"
	1 format(A,ES10.4,A)
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	do i = 1, size(x)
	pdf_s = elec_pdf (pdf, EPDF_S, x(i), xb(i), Q(iq))
	pdf_g = elec_pdf (pdf, EPDF_G, x(i), xb(i), Q(iq))
	pdf_ns = elec_pdf (pdf, EPDF_NS, x(i), xb(i), Q(iq))
	pdf_ele = elec_pdf (pdf, EPDF_ELE, x(i), xb(i), Q(iq))
	pdf_pos = elec_pdf (pdf, EPDF_POS, x(i), xb(i), Q(iq))
	write (u,2) " ePDF (x = ", xx(i), ", S/NS/ELE/POS/GAM) = ", &
	pdf_s, pdf_ns, pdf_ele, pdf_pos, pdf_g
	2 format(A,RN,ES20.10,A,5(1x,ES12.3))
	! write (u, "(A,RN,ES20.10,A,F10.8)") &
	! " ePDF (x = ", xx(i), ", e- - [S + NS]/2) = ", &
	! abs(pdf_ele - (pdf_s + pdf_ns)/2._wp) / &
	! abs(pdf_ele + (pdf_s + pdf_ns)/2._wp) / 2._wp
	! write (u, "(A,RN,ES20.10,A,F10.8)") &
	! " ePDF (x = ", xx(i), ", e+ - [S - NS]/2) = ", &
	! abs(pdf_pos - (pdf_s - pdf_ns)/2._wp) / &
	! abs(pdf_pos + (pdf_s - pdf_ns)/2._wp) / 2._wp
	end do
	write (u, "(A)")
	write (u, 3) "* Q = ", Q(iq), " GeV, NLL, alpha running:"
	3 format(A,ES10.4,A)
	write (u, "(A)")
	call pdf%init (ME_REF, ALPHA_QED_ME_REF, -1._default, &
	3000.0_default, 3, 1, nlep)
	call pdf%allocate_aqed (order = 1, n_f = 0, nlep = 1, running = .true.)
	do i = 1, size(x)
	pdf_s = elec_pdf (pdf, EPDF_S, x(i), xb(i), Q(iq))
	pdf_ns = elec_pdf (pdf, EPDF_NS, x(i), xb(i), Q(iq))
	pdf_ele = elec_pdf (pdf, EPDF_ELE, x(i), xb(i), Q(iq))
	pdf_pos = elec_pdf (pdf, EPDF_POS, x(i), xb(i), Q(iq))
	pdf_g = elec_pdf (pdf, EPDF_G, x(i), xb(i), Q(iq))
	write (u,4) " epdf (x = ", xx(i), ", S/NS/ELE/POS/GAM) = ", &
	pdf_s, pdf_ns, pdf_ele, pdf_pos, pdf_g
	4 format(A,RN,ES20.10,A,5(1x,ES12.3))
	! write (u, "(A,RN,ES20.10,A,F10.8)") &
	! " ePDF (x = ", xx(i), ", e- - [S + NS]/2) = ", &
	! abs(pdf_ele - (pdf_s + pdf_ns)/2._wp) / &
	! abs(pdf_ele + (pdf_s + pdf_ns)/2._wp) / 2._wp
	! write (u, "(A,RN,ES20.10,A,F10.8)") &
	! " ePDF (x = ", xx(i), ", e+ - [S - NS]/2) = ", &
	! abs(pdf_pos - (pdf_s - pdf_ns)/2._wp) / &
	! abs(pdf_pos + (pdf_s - pdf_ns)/2._wp) / 2._wp
	end do
	end do
	write (u, "(A)")
	write (u, "(A)") "* Test output end: electron_pdfs_6"
	end subroutine electron_pdfs_6

	@ %def electron_pdfs_6
	wp
	Index: trunk/src/types/types.nw
	===================================================================
	--- trunk/src/types/types.nw (revision 8963)
	+++ trunk/src/types/types.nw (revision 8964)
	@@ -1,9292 +1,9307 @@
	%% -- 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)
	+<<Particle specifiers: sub interfaces>>=
	+ module subroutine prt_expr_init_spec (object, spec)
	+ class(prt_expr_t), intent(out) :: object
	+ type(prt_spec_t), intent(in) :: spec
	+ end subroutine prt_expr_init_spec
	+<<Particle specifiers: procedures>>=
	+ module 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)
	+<<Particle specifiers: sub interfaces>>=
	+ module subroutine prt_expr_init_list (object, n)
	+ class(prt_expr_t), intent(out) :: object
	+ integer, intent(in) :: n
	+ end subroutine prt_expr_init_list
	+ module subroutine prt_expr_init_sum (object, n)
	+ class(prt_expr_t), intent(out) :: object
	+ integer, intent(in) :: n
	+ end subroutine prt_expr_init_sum
	+<<Particle specifiers: procedures>>=
	+ module 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)
	+ module 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)
	+sums are left untouched.)
	+<<Particle specifiers: sub interfaces>>=
	+ module subroutine distribute_prt_spec_list (object)
	+ class(prt_spec_expr_t), intent(inout), allocatable :: object
	+ end subroutine distribute_prt_spec_list
	+<<Particle specifiers: procedures>>=
	+ module 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)
	+<<Particle specifiers: sub interfaces>>=
	+ recursive module subroutine prt_expr_expand (expr)
	+ class(prt_expr_t), intent(inout) :: expr
	+ end subroutine prt_expr_expand
	+<<Particle specifiers: procedures>>=
	+ recursive module 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 pdg-number corresponds to a charged particle
	<<PDG arrays: public>>=
	public :: is_charged
	<<PDG arrays: sub interfaces>>=
	elemental module function is_charged (pdg_nr)
	logical :: is_charged
	integer, intent(in) :: pdg_nr
	end function is_charged
	<<PDG arrays: procedures>>=
	elemental module function is_charged (pdg_nr)
	logical :: is_charged
	integer, intent(in) :: pdg_nr
	is_charged = is_quark (pdg_nr) .or. is_charged_lepton (pdg_nr) .or. &
	abs (pdg_nr) == W_BOSON
	end function is_charged

	@ %def is_charged
	@ 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) then
	n_bound = n_legs - n_gluons - 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
	!!! Todo PB: This is not true for additional WHZA radiation
	!!! should be more generalized
	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 function 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
	Returns the minimal number of photons per flavor structure of an array of
	flavor structures. If the array is reduced to the initial- or final-state
	flavor structures this number corresponds to the number of on-shell
	photons of the IS or FS, respectively.
	<<PDG arrays: public>>=
	public :: n_onshell_photons
	<<PDG arrays: sub interfaces>>=
	module function n_onshell_photons (flv) result (n_photons)
	integer, intent(in), dimension(:,:) :: flv
	integer :: n_photons
	end function n_onshell_photons
	<<PDG arrays: procedures>>=
	module function n_onshell_photons (flv) result (n_photons)
	integer, intent(in), dimension(:,:) :: flv
	integer :: n_photons, i_flv
	n_photons = size (flv, dim = 1)
	do i_flv = 1, size (flv, dim = 2)
	n_photons = min (count (flv (:, i_flv) == PHOTON), n_photons)
	end do
	end function n_onshell_photons

	@ %def n_onshell_photons
	@ 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 = "' // 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

File Metadata

Mime Type: text/x-diff
Expires: Wed, May 14, 10:56 AM (1 d, 2 h)
Storage Engine: blob
Storage Format: Raw Data
Storage Handle: 5111304
Default Alt Text: (483 KB)

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions