No OneTemporary
Actions

Size

892 KB

Referenced Files

None

Subscribers

None

View Options

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

	Index: trunk/ChangeLog
	===================================================================
	--- trunk/ChangeLog (revision 8201)
	+++ trunk/ChangeLog (revision 8202)
	@@ -1,1801 +1,1804 @@
	ChangeLog -- Summary of changes to the WHIZARD package

	Use svn log to see detailed changes.

	Version 2.6.5

	2018-11-30
	RELEASE: version 2.6.5

	+2018-11-22
	+ Fixed bug: rescanning events with beam structure could fail
	+
	2018-11-09
	Major refactoring of internal process data

	2018-11-02
	PYTHIA8 interface

	2018-10-29
	Flat phase space parametrization with RAMBO (on diet) implemented

	2018-10-17
	Revise extended test suite

	2018-09-27
	Process container for RECOLA processes

	2018-09-15
	Fixes by M. Berggren for PYTHIA6 interface

	2018-09-14
	First fixes after HepForge modernization
	##################################################################

	2018-08-23
	RELEASE: version 2.6.4

	2018-08-09
	Infrastructure to check colored subevents

	2018-07-10
	Infrastructure for running WHIZARD in batch mode

	2018-07-04
	MPI available from distribution tarball

	2018-06-03
	Support Intel Fortran Compiler under MAC OS X

	2018-05-07
	FKS slicing parameter delta_i (initial state) implementend

	2018-05-03
	Refactor structure function assignment for NLO

	2018-05-02
	FKS slicing parameter xi_cut, delta_0 implemented

	2018-04-20
	Workspace subdirectory for process integration (grid/phs files)
	Packing/unpacking of files at job end/start
	Exporting integration results from scan loops

	2018-04-13
	Extended QCD NLO test suite

	2018-04-09
	Bugfix for Higgs Singlet Extension model

	2018-04-06
	Workspace subdirectory for process generation and compilation
	--job-id option for creating job-specific names

	2018-03-20
	Bug fix for color flow matching in hadron collisions
	with identical initial state quarks

	2018-03-08
	Structure functions quantum numbers correctly assigned for NLO

	2018-02-24
	Configure setup includes 'pgfortran' and 'flang'

	2018-02-21
	Include spin-correlated matrix elements in interactions

	2018-02-15
	Separate module for QED ISR structure functions

	##################################################################

	2018-02-10
	RELEASE: version 2.6.3

	2018-02-08
	Improvements in memory management for PS generation

	2018-01-31
	Partial refactoring: quantum number assigment NLO
	Initial-state QCD splittings for hadron collisions

	2018-01-25
	Bug fix for weighted events with VAMP2

	2018-01-17
	Generalized interface for Recola versions 1.3+ and 2.1+

	2018-01-15
	Channel equivalences also for VAMP2 integrator

	2018-01-12
	Fix for OCaml compiler 4.06 (and newer)

	2017-12-19
	RECOLA matrix elements with flavor sums can be integrated

	2017-12-18
	Bug fix for segmentation fault in empty resonance histories

	2017-12-16
	Fixing a bug in PYTHIA6 PYHEPC routine by omitting CMShowers
	from transferral between PYTHIA and WHIZARD event records

	2017-12-15
	Event index for multiple processes in event file correct

	##################################################################

	2017-12-13
	RELEASE: version 2.6.2

	2017-12-07
	User can set offset in event numbers

	2017-11-29
	Possibility to have more than one RECOLA process in one file

	2017-11-23
	Transversal/mixed (and unitarized) dim-8 operators

	2017-11-16
	epa_q_max replaces epa_e_max (trivial factor 2)

	2017-11-15
	O'Mega matrix element compilation silent now

	2017-11-14
	Complete expanded P-wave form factor for top threshold

	2017-11-10
	Incoming particles can be accessed in SINDARIN

	2017-11-08
	Improved handling of resonance insertion, additional parameters

	2017-11-04
	Added Higgs-electron coupling (SM_Higgs)

	##################################################################

	2017-11-03
	RELEASE: version 2.6.1

	2017-10-20
	More than 5 NLO components possible at same time

	2017-10-19
	Gaussian cutoff for shower resonance matching

	2017-10-12
	Alternative (more efficient) method to generate
	phase space file

	2017-10-11
	Bug fix for shower resonance histories for processes
	with multiple components

	2017-09-25
	Bugfix for process libraries in shower resonance histories

	2017-09-21
	Correctly generate pT distribution for EPA remnants

	2017-09-20
	Set branching ratios for unstable particles also by hand

	2017-09-14
	Correctly generate pT distribution for ISR photons

	##################################################################

	2017-09-08
	RELEASE: version 2.6.0

	2017-09-05
	Bug fix for initial state NLO QCD flavor structures
	Real and virtual NLO QCD hadron collider processes
	work with internal interactions

	2017-09-04
	Fully validated MPI integration and event generation

	2017-09-01
	Resonance histories for shower: full support
	Bug fix in O'Mega model constraints
	O'Mega allows to output a parsable form of the DAG

	2017-08-24
	Resonance histories in events for transferral
	to parton shower (e.g. in ee -> jjjj)

	2017-08-01
	Alpha version of HepMC v3 interface
	(not yet really functional)

	2017-07-31
	Beta version for RECOLA OLP support

	2017-07-06
	Radiation generator fix for LHC processes

	2017-06-30
	Fix bug for NLO with structure
	functions and/or polarization

	2017-06-23
	Collinear limit for QED corrections works

	2017-06-17
	POWHEG grids generated already during integration

	2017-06-12
	Soft limit for QED corrections works

	2017-05-16
	Beta version of full MPI parallelization (VAMP2)
	Check consistency of POWHEG grid files
	Logfile config-summary.log for configure summary

	2017-05-12
	Allow polarization in top threshold

	2017-05-09
	Minimal demand automake 1.12.2
	Silent rules for make procedures

	2017-05-07
	Major fix for POWHEG damping
	Correctly initialize FKS ISR phasespace

	##################################################################

	2017-05-06
	RELEASE: version 2.5.0

	2017-05-05
	Full UFO support (SM-like models)
	Fixed-beam ISR FKS phase space

	2017-04-26
	QED splittings in radiation generator

	2017-04-10
	Retire deprecated O'Mega vertex cache files

	##################################################################

	2017-03-24
	RELEASE: version 2.4.1

	2017-03-16
	Distinguish resonance charge in phase space channels
	Keep track of resonance histories in phase space
	Complex mass scheme default for OpenLoops amplitudes

	2017-03-13
	Fix helicities for polarized OpenLoops calculations

	2017-03-09
	Possibility to advance RNG state in rng_stream

	2017-03-04
	General setup for partitioning real emission
	phase space

	2017-03-06
	Bugfix on rescan command for converting event files

	2017-02-27
	Alternative multi-channel VEGAS implementation
	VAMP2: serial backbone for MPI setup
	Smoothstep top threshold matching

	2017-02-25
	Single-beam structure function with
	s-channel mapping supported
	Safeguard against invalid process libraries

	2017-02-16
	Radiation generator for photon emission

	2017-02-10
	Fixes for NLO QCD processes (color correlations)

	2017-01-16
	LCIO variable takes precedence over LCIO_DIR

	2017-01-13
	Alternative random number generator
	rng_stream (cf. L'Ecuyer et al.)

	2017-01-01
	Fix for multi-flavor BLHA tree
	matrix elements

	2016-12-31
	Grid path option for VAMP grids

	2016-12-28
	Alpha version of Recola OLP support

	2016-12-27
	Dalitz plots for FKS phase space

	2016-12-14
	NLO multi-flavor events possible

	2016-12-09
	LCIO event header information added

	2016-12-02
	Alpha version of RECOLA interface
	Bugfix for generator status in LCIO

	##################################################################

	2016-11-28
	RELEASE: version 2.4.0

	2016-11-24
	Bugfix for OpenLoops interface: EW scheme
	is set by WHIZARD
	Bugfixes for top threshold implementation

	2016-11-11
	Refactoring of dispatching

	2016-10-18
	Bug fix for LCIO output

	2016-10-10
	First implementation for collinear soft terms

	2016-10-06
	First full WHIZARD models from UFO files

	2016-10-05
	WHIZARD does not support legacy gcc 4.7.4 any longer

	2016-09-30
	Major refactoring of process core and NLO components

	2016-09-23
	WHIZARD homogeneous entity: discarding subconfigures
	for CIRCE1/2, O'Mega, VAMP subpackages; these are
	reconstructable by script projectors

	2016-09-06
	Introduce main configure summary

	2016-08-26
	Fix memory leak in event generation

	##################################################################

	2016-08-25
	RELEASE: version 2.3.1

	2016-08-19
	Bug fix for EW-scheme dependence of gluino propagators

	2016-08-01
	Beta version of complex mass scheme support

	2016-07-26
	Fix bug in POWHEG damping for the matching

	##################################################################

	2016-07-21
	RELEASE: version 2.3.0

	2016-07-20
	UFO file support (alpha version) in O'Mega

	2016-07-13
	New (more) stable of WHIZARD GUI
	Support for EW schemes for OpenLoops
	Factorized NLO top decays for threshold model

	2016-06-15
	Passing factorization scale to PYTHIA6
	Adding charge and neutral observables

	2016-06-14
	Correcting angular distribution/tweaked kinematics in
	non-collinear structure functions splittings

	2016-05-10
	Include (Fortran) TAUOLA/PHOTOS for tau decays via PYTHIA6
	(backwards validation of LC CDR/TDR samples)

	2016-04-27
	Within OpenLoops virtuals: support for Collier library

	2016-04-25
	O'Mega vertex tables only loaded at first usage

	2016-04-21
	New CJ15 PDF parameterizations added

	2016-04-21
	Support for hadron collisions at NLO QCD

	2016-04-05
	Support for different (parameter) schemes in model files

	2016-03-31
	Correct transferral of lifetime/vertex from PYTHIA/TAUOLA
	into the event record

	2016-03-21
	New internal implementation of polarization
	via Bloch vectors, remove pointer constructions

	2016-03-13
	Extension of cascade syntax for processes:
	exclude propagators/vertices etc. possible

	2016-02-24
	Full support for OpenLoops QCD NLO matrix
	elements, inclusion in test suite

	2016-02-12
	Substantial progress on QCD NLO support

	2016-02-02
	Automated resonance mapping for FKS subtraction

	2015-12-17
	New BSM model WZW for diphoton resonances

	##################################################################

	2015-11-22
	RELEASE: version 2.2.8

	2015-11-21
	Bugfix for fixed-order NLO events

	2015-11-20
	Anomalous FCNC top-charm vertices

	2015-11-19
	StdHEP output via HEPEVT/HEPEV4 supported

	2015-11-18
	Full set of electroweak dim-6 operators included

	2015-10-22
	Polarized one-loop amplitudes supported

	2015-10-21
	Fixes for event formats for showered events

	2015-10-14
	Callback mechanism for event output

	2015-09-22
	Bypass matrix elements in pure event sample rescans
	StdHep frozen final version v5.06.01 included internally

	2015-09-21
	configure option --with-precision to
	demand 64bit, 80bit, or 128bit Fortran
	and bind C precision types

	2015-09-07
	More extensive tests of NLO
	infrastructure and POWHEG matching

	2015-09-01
	NLO decay infrastructure
	User-defined squared matrix elements
	Inclusive FastJet algorithm plugin
	Numerical improvement for small boosts

	##################################################################

	2015-08-11
	RELEASE: version 2.2.7

	2015-08-10
	Infrastructure for damped POWHEG
	Massive emitters in POWHEG
	Born matrix elements via BLHA
	GoSam filters via SINDARIN
	Minor running coupling bug fixes
	Fixed-order NLO events

	2015-08-06
	CT14 PDFs included (LO, NLO, NNLL)

	2015-07-07
	Revalidation of ILC WHIZARD-PYTHIA event chain
	Extended test suite for showered events
	Alpha version of massive FSR for POWHEG

	2015-06-09
	Fix memory leak in interaction for long cascades
	Catch mismatch between beam definition and CIRCE2 spectrum

	2015-06-08
	Automated POWHEG matching: beta version
	Infrastructure for GKS matching
	Alpha version of fixed-order NLO events
	CIRCE2 polarization averaged spectra with
	explicitly polarized beams

	2015-05-12
	Abstract matching type: OO structure for matching/merging

	2015-05-07
	Bug fix in event record WHIZARD-PYTHIA6 transferral
	Gaussian beam spectra for lepton colliders

	##################################################################

	2015-05-02
	RELEASE: version 2.2.6

	2015-05-01
	Models for (unitarized) tensor resonances in VBS

	2015-04-28
	Bug fix in channel weights for event generation.

	2015-04-18
	Improved event record transfer WHIZARD/PYTHIA6

	2015-03-19
	POWHEG matching: alpha version

	##################################################################

	2015-02-27
	RELEASE: version 2.2.5

	2015-02-26
	Abstract types for quantum numbers

	2015-02-25
	Read-in of StdHEP events, self-tests

	2015-02-22
	Bugfix for mother-daughter relations in
	showered/hadronized events

	2015-02-20
	Projection on polarization in intermediate states

	2015-02-13
	Correct treatment of beam remnants in
	event formats (also LC remnants)

	##################################################################

	2015-02-06
	RELEASE: version 2.2.4

	2015-02-06
	Bugfix in event output

	2015-02-05
	LCIO event format supported

	2015-01-30
	Including state matrices in WHIZARD's internal IO
	Versioning for WHIZARD's internal IO
	Libtool update from 2.4.3 to 2.4.5
	LCIO event output (beta version)

	2015-01-27
	Progress on NLO integration
	Fixing a bug for multiple processes in a single
	event file when using beam event files

	2015-01-19
	Bug fix for spin correlations evaluated in the rest
	frame of the mother particle

	2015-01-17
	Regression fix for statically linked processes
	from SARAH and FeynRules

	2015-01-10
	NLO: massive FKS emitters supported (experimental)

	2015-01-06
	MMHT2014 PDF sets included

	2015-01-05
	Handling mass degeneracies in auto_decays

	2014-12-19
	Fixing bug in rescan of event files

	##################################################################

	2014-11-30
	RELEASE: version 2.2.3

	2014-11-29
	Beta version of LO continuum/NLL-threshold
	matched top threshold model for e+e- physics

	2014-11-28
	More internal refactoring: disentanglement of module
	dependencies

	2014-11-21
	OVM: O'Mega Virtual Machine, bytecode instructions
	instead of compiled Fortran code

	2014-11-01
	Higgs Singlet extension model included

	2014-10-18
	Internal restructuring of code; half-way
	WHIZARD main code file disassembled

	2014-07-09
	Alpha version of NLO infrastructure

	##################################################################

	2014-07-06
	RELEASE: version 2.2.2

	2014-07-05
	CIRCE2: correlated LC beam spectra and
	GuineaPig Interface to LC machine parameters

	2014-07-01
	Reading LHEF for decayed/factorized/showered/
	hadronized events

	2014-06-25
	Configure support for GoSAM/Ninja/Form/QGraf

	2014-06-22
	LHAPDF6 interface

	2014-06-18
	Module for automatic generation of
	radiation and loop infrastructure code

	2014-06-11
	Improved internal directory structure

	##################################################################

	2014-06-03
	RELEASE: version 2.2.1

	2014-05-30
	Extensions of internal PDG arrays

	2014-05-26
	FastJet interface

	2014-05-24
	CJ12 PDFs included

	2014-05-20
	Regression fix for external models (via SARAH
	or FeynRules)

	##################################################################

	2014-05-18
	RELEASE: version 2.2.0

	2014-04-11
	Multiple components: inclusive process definitions,
	syntax: process A + B + ...

	2014-03-13
	Improved PS mappings for e+e- ISR
	ILC TDR and CLIC spectra included in CIRCE1

	2014-02-23
	New models: AltH w\ Higgs for exclusion purposes,
	SM_rx for Dim 6-/Dim-8 operators, SSC for
	general strong interactions (w/ Higgs), and
	NoH_rx (w\ Higgs)

	2014-02-14
	Improved s-channel mapping, new on-shell
	production mapping (e.g. Drell-Yan)

	2014-02-03
	PRE-RELEASE: version 2.2.0_beta

	2014-01-26
	O'Mega: Feynman diagram generation possible (again)

	2013-12-16
	HOPPET interface for b parton matching

	2013-11-15
	PRE-RELEASE: version 2.2.0_alpha-4

	2013-10-27
	LHEF standards 1.0/2.0/3.0 implemented

	2013-10-15
	PRE-RELEASE: version 2.2.0_alpha-3

	2013-10-02
	PRE-RELEASE: version 2.2.0_alpha-2

	2013-09-25
	PRE-RELEASE: version 2.2.0_alpha-1

	2013-09-12
	PRE-RELEASE: version 2.2.0_alpha

	2013-09-03
	General 2HDM implemented

	2013-08-18
	Rescanning/recalculating events

	2013-06-07
	Reconstruction of complete event
	from 4-momenta possible

	2013-05-06
	Process library stacks

	2013-05-02
	Process stacks

	2013-04-29
	Single-particle phase space module

	2013-04-26
	Abstract interface for random
	number generator

	2013-04-24
	More object-orientation on modules
	Midpoint-rule integrator

	2013-04-05
	Object-oriented integration and
	event generation

	2013-03-12
	Processes recasted object-oriented:
	MEs, scales, structure functions
	First infrastructure for general Lorentz
	structures

	2013-01-17
	Object-orientated reworking of library and
	process core, more variable internal structure,
	unit tests

	2012-12-14
	Update Pythia version to 6.4.27

	2012-12-04
	Fix the phase in HAZ vertices

	2012-11-21
	First O'Mega unit tests, some infrastructure

	2012-11-13
	Bugfix in anom. HVV Lorentz structures

	##################################################################

	2012-09-18
	RELEASE: version 2.1.1

	2012-09-11
	Model MSSM_Hgg with Hgg and HAA vertices

	2012-09-10
	First version of implementation of multiple
	interactions in WHIZARD

	2012-09-05
	Infrastructure for internal CKKW matching

	2012-09-02
	C, C++, Python API

	2012-07-19
	Fixing particle numbering in HepMC format

	##################################################################

	2012-06-15
	RELEASE: version 2.1.0

	2012-06-14
	Analytical and kT-ordered shower officially
	released
	PYTHIA interface officially released

	2012-05-09
	Intrisince PDFs can be used for showering

	2012-05-04
	Anomalous Higgs couplings a la hep-ph/9902321

	##################################################################

	2012-03-19
	RELEASE: version 2.0.7

	2012-03-15
	Run IDs are available now
	More event variables in analysis
	Modified raw event format (compatibility mode exists)

	2012-03-12
	Bugfix in decay-integration order
	MLM matching steered completely internally now

	2012-03-09
	Special phase space mapping for narrow resonances
	decaying to 4-particle final states with far off-shell
	intermediate states
	Running alphas from PDF collaborations with
	builtin PDFs

	2012-02-16
	Bug fix in cascades decay infrastructure

	2012-02-04
	WHIZARD documentation compatible with TeXLive 2011

	2012-02-01
	Bug fix in FeynRules interface with --prefix flag

	2012-01-29
	Bug fix with name clash of O'Mega variable names

	2012-01-27
	Update internal PYTHIA to version 6.4.26
	Bug fix in LHEF output

	2012-01-21
	Catching stricter automake 1.11.2 rules

	2011-12-23
	Bug fix in decay cascade setup

	2011-12-20
	Bug fix in helicity selection rules

	2011-12-16
	Accuracy goal reimplemented

	2011-12-14
	WHIZARD compatible with TeXLive 2011

	2011-12-09
	Option --user-target added

	##################################################################

	2011-12-07
	RELEASE: version 2.0.6

	2011-12-07
	Bug fixes in SM_top_anom
	Added missing entries to HepMC format

	2011-12-06
	Allow to pass options to O'Mega
	Bug fix for HEPEVT block for showered/hadronized events

	2011-12-01
	Reenabled user plug-in for external code for
	cuts, structure functions, routines etc.

	2011-11-29
	Changed model SM_Higgs for Higgs phenomenology

	2011-11-25
	Supporting a Y, (B-L) Z' model

	2011-11-23
	Make WHIZARD compatible for MAC OS X Lion/XCode 4

	2011-09-25
	WHIZARD paper published: Eur.Phys.J. C71 (2011) 1742

	2011-08-16
	Model SM_QCD: QCD with one EW insertion

	2011-07-19
	Explicit output channel for dvips avoids printing

	2011-07-10
	Test suite for WHIZARD unit tests

	2011-07-01
	Commands for matrix element tests
	More OpenMP parallelization of kinematics
	Added unit tests

	2011-06-23
	Conversion of CIRCE2 from F77 to F90, major
	clean-up

	2011-06-14
	Conversion of CIRCE1 from F77 to F90

	2011-06-10
	OpenMP parallelization of channel kinematics
	(by Matthias Trudewind)

	2011-05-31
	RELEASE: version 1.97

	2011-05-24
	Minor bug fixes: update grids and elsif statement.

	##################################################################

	2011-05-10
	RELEASE: version 2.0.5

	2011-05-09
	Fixed bug in final state flavor sums
	Minor improvements on phase-space setup

	2011-05-05
	Minor bug fixes

	2011-04-15
	WHIZARD as a precompiled 64-bit binary available

	2011-04-06
	Wall clock instead of cpu time for time estimates

	2011-04-05
	Major improvement on the phase space setup

	2011-04-02
	OpenMP parallelization for helicity loop in O'Mega
	matrix elements

	2011-03-31
	Tools for relocating WHIZARD and use in batch
	environments

	2011-03-29
	Completely static builds possible, profiling options

	2011-03-28
	Visualization of integration history

	2011-03-27
	Fixed broken K-matrix implementation

	2011-03-23
	Including the GAMELAN manual in the distribution

	2011-01-26
	WHIZARD analysis can handle hadronized event files

	2011-01-17
	MSTW2008 and CT10 PDF sets included

	2010-12-23
	Inclusion of NMSSM with Hgg couplings

	2010-12-21
	Advanced options for integration passes

	2010-11-16
	WHIZARD supports CTEQ6 and possibly other PDFs
	directly; data files included in the distribution

	##################################################################

	2010-10-26
	RELEASE: version 2.0.4

	2010-10-06
	Bug fix in MSSM implementation

	2010-10-01
	Update to libtool 2.4

	2010-09-29
	Support for anomalous top couplings (form factors etc.)
	Bug fix for running gauge Yukawa SUSY couplings

	2010-09-28
	RELEASE: version 1.96

	2010-09-21
	Beam remnants and pT spectra for lepton collider re-enabled
	Restructuring subevt class

	2010-09-16
	Shower and matching are disabled by default
	PYTHIA as a conditional on these two options

	2010-09-14
	Possibility to read in beam spectra re-enabled (e.g. Guinea
	Pig)

	2010-09-13
	Energy scan as (pseudo-) structure functions re-implemented

	2010-09-10
	CIRCE2 included again in WHIZARD 2 and validated

	2010-09-02
	Re-implementation of asymmetric beam energies and collision
	angles, e-p collisions work, inclusion of a HERA DIS test
	case

	##################################################################

	2010-10-18
	RELEASE: version 2.0.3

	2010-08-08
	Bug in CP-violating anomalous triple TGCs fixed

	2010-08-06
	Solving backwards compatibility problem with O'Caml 3.12.0

	2010-07-12
	Conserved quantum numbers speed up O'Mega code generation

	2010-07-07
	Attaching full ISR/FSR parton shower and MPI/ISR
	module
	Added SM model containing Hgg, HAA, HAZ vertices

	2010-07-02
	Matching output available as LHEF and STDHEP

	2010-06-30
	Various bug fixes, missing files, typos

	2010-06-26
	CIRCE1 completely re-enabled
	Chaining structure functions supported

	2010-06-25
	Partial support for conserved quantum numbers in
	O'Mega

	2010-06-21
	Major upgrade of the graphics package: error bars,
	smarter SINDARIN steering, documentation, and all that...

	2010-06-17
	MLM matching with PYTHIA shower included

	2010-06-16
	Added full CIRCE1 and CIRCE2 versions including
	full documentation and miscellanea to the trunk

	2010-06-12
	User file management supported, improved variable
	and command structure

	2010-05-24
	Improved handling of variables in local command lists

	2010-05-20
	PYTHIA interface re-enabled

	2010-05-19
	ASCII file formats for interfacing ROOT and gnuplot in
	data analysis

	##################################################################

	2010-05-18
	RELEASE: version 2.0.2

	2010-05-14
	Reimplementation of visualization of phase space
	channels
	Minor bug fixes

	2010-05-12
	Improved phase space - elimination of redundancies

	2010-05-08
	Interface for polarization completed: polarized beams etc.

	2010-05-06
	Full quantum numbers appear in process log
	Integration results are usable as user variables
	Communication with external programs

	2010-05-05
	Split module commands into commands, integration,
	simulation modules

	2010-05-04
	FSR+ISR for the first time connected to the WHIZARD 2 core

	##################################################################

	2010-04-25
	RELEASE: version 2.0.1

	2010-04-23
	Automatic compile and integrate if simulate is called
	Minor bug fixes in O'Mega

	2010-04-21
	Checkpointing for event generation
	Flush statements to use WHIZARD inside a pipe

	2010-04-20
	Reimplementation of signal handling in WGIZARD 2.0

	2010-04-19
	VAMP is now a separately configurable and installable unit of
	WHIZARD, included VAMP self-checks
	Support again compilation in quadruple precision

	2010-04-06
	Allow for logarithmic plots in GAMELAN, reimplement the
	possibility to set the number of bins

	2010-04-15
	Improvement on time estimates for event generation

	##################################################################

	2010-04-12
	RELEASE: version 2.0.0

	2010-04-09
	Per default, the code for the amplitudes is subdivided to allow
	faster compiler optimization
	More advanced and unified and straightforward command language
	syntax
	Final bug fixes

	2010-04-07
	Improvement on SINDARIN syntax; printf, sprintf function
	thorugh a C interface

	2010-04-05
	Colorizing DAGs instead of model vertices: speed boost
	in colored code generation

	2010-03-31
	Generalized options for normalization of weighted and
	unweighted events
	Grid and weight histories added again to log files
	Weights can be used in analyses

	2010-03-28
	Cascade decays completely implemented including color and
	spin correlations

	2010-03-07
	Added new WHIZARD header with logo

	2010-03-05
	Removed conflict in O'Mega amplitudes between flavour sums
	and cascades
	StdHEP interface re-implemented

	2010-03-03
	RELEASE: version 2.0.0rc3
	Several bug fixes for preventing abuse in input files
	OpenMP support for amplitudes
	Reimplementation of WHIZARD 1 HEPEVT ASCII event formats
	FeynRules interface successfully passed MSSM test

	2010-02-26
	Eliminating ghost gluons from multi-gluon amplitudes

	2010-02-25
	RELEASE: version 1.95
	HEPEVT format from WHIZARD 1 re-implemented in WHIZARD 2

	2010-02-23
	Running alpha_s implemented in the FeynRules interface

	2010-02-19
	MSSM (semi-) automatized self-tests finalized

	2010-02-17
	RELEASE: version 1.94

	2010-02-16
	Closed memory corruption in WHIZARD 1
	Fixed problems of old MadGraph and CompHep drivers
	with modern compilers
	Uncolored vertex selection rules for colored amplitudes in
	O'Mega

	2010-02-15
	Infrastructure for color correlation computation in O'Mega
	finished
	Forbidden processes are warned about, but treated as non-fatal

	2010-02-14
	Color correlation computation in O'Mega finalized

	2010-02-10
	Improving phase space mappings for identical particles in
	initial and final states
	Introduction of more extended multi-line error message

	2010-02-08
	First O'Caml code for computation of color correlations in
	O'Mega

	2010-02-07
	First MLM matching with e+ e- -> jets

	##################################################################

	2010-02-06
	RELEASE: version 2.0.0rc2

	2010-02-05
	Reconsidered the Makefile structure and more extended tests
	Catch a crash between WHIZARD and O'Mega for forbidden processes
	Tensor products of arbitrary color structures in jet definitions

	2010-02-04
	Color correlation computation in O'Mega finalized

	##################################################################

	2010-02-03
	RELEASE: version 2.0.0rc1

	##################################################################

	2010-01-31
	Reimplemented numerical helicity selection rules
	Phase space functionality of version 1 restored and improved

	2009-12-05
	NMSSM validated with FeynRules in WHIZARD 1 (Felix Braam)

	2009-12-04
	RELEASE: version 2.0.0alpha

	##################################################################

	2009-04-16
	RELEASE: version 1.93

	2009-04-15
	Clean-up of Makefiles and configure scripts
	Reconfiguration of BSM model implementation
	extended supersymmetric models

	2008-12-23
	New model NMSSM (Felix Braam)
	SLHA2 added
	Bug in LHAPDF interface fixed

	2008-08-16
	Bug fixed in K matrix implementation
	Gravitino option in the MSSM added

	2008-03-20
	Improved color and flavor sums

	##################################################################

	2008-03-12
	RELEASE: version 1.92
	LHEF (Les Houches Event File) format added
	Fortran 2003 command-line interface (if supported by the compiler)
	Automated interface to colored models
	More bug fixes and workarounds for compiler compatibility

	##################################################################

	2008-03-06
	RELEASE: version 1.91
	New model K-matrix (resonances and anom. couplings in WW scattering)
	EWA spectrum
	Energy-scan pseudo spectrum
	Preliminary parton shower module (only from final-state quarks)
	Cleanup and improvements of configure process
	Improvements for O'Mega parameter files
	Quadruple precision works again
	More plotting options: lines, symbols, errors
	Documentation with PDF bookmarks enabled
	Various bug fixes

	2007-11-29
	New model UED

	##################################################################

	2007-11-23
	RELEASE: version 1.90
	O'Mega now part of the WHIZARD tree
	Madgraph/CompHEP disabled by default (but still usable)
	Support for LHAPDF (preliminary)
	Added new models: SMZprime, SM_km, Template
	Improved compiler recognition and compatibility
	Minor bug fixes

	##################################################################

	2006-06-15
	RELEASE: version 1.51
	Support for anomaly-type Higgs couplings (to gluon and photon/Z)
	Support for spin 3/2 and spin 2
	New models: Little Higgs (4 versions), toy models for extra dimensions
	and gravitinos
	Fixes to the whizard.nw source documentation to run through LaTeX
	Intel 9.0 bug workaround (deallocation of some arrays)

	2006-05-15
	O'Mega RELEASE: version 0.11
	merged JRR's O'Mega extensions

	##################################################################

	2006-02-07
	RELEASE: version 1.50
	To avoid confusion: Mention outdated manual example in BUGS file
	O'Mega becomes part of the WHIZARD generator

	2006-02-02 [bug fix update]
	Bug fix: spurious error when writing event files for weighted events
	Bug fix: 'r' option for omega produced garbage for some particle names
	Workaround for ifort90 bug (crash when compiling whizard_event)
	Workaround for ifort90 bug (crash when compiling hepevt_common)

	2006-01-27
	Added process definition files for MSSM 2->2 processes
	Included beam recoil for EPA (T.Barklow)
	Updated STDHEP byte counts (for STDHEP 5.04.02)
	Fixed STDHEP compatibility (avoid linking of incomplete .so libs)
	Fixed issue with comphep requiring Xlibs on Opteron
	Fixed issue with ifort 8.x on Opteron (compiling 'signal' interface)
	Fixed color-flow code: was broken for omega with option 'c' and 'w'
	Workaround hacks for g95 compatibility

	2005-11-07
	O'Mega RELEASE: version 0.10
	O'Mega, merged JRR's and WK's color hack for WHiZard
	O'Mega, EXPERIMENTAL: cache fusion tables (required for colors
	a la JRR/WK)
	O'Mega, make JRR's MSSM official

	##################################################################

	2005-10-25
	RELEASE: version 1.43
	Minor fixes in MSSM couplings (Higgs/3rd gen squarks).
	This should be final, since the MSSM results agree now completely
	with Madgraph and Sherpa
	User-defined lower and upper limits for split event file count
	Allow for counters (events, bytes) exceeding $2^{31}$
	Revised checksum treatment and implementation (now MD5)
	Bug fix: missing process energy scale in raw event file

	##################################################################

	2005-09-30
	RELEASE: version 1.42
	Graphical display of integration history ('make history')
	Allow for switching off signals even if supported (configure option)

	2005-09-29
	Revised phase space generation code, in particular for flavor sums
	Negative cut and histogram codes use initial beams instead of
	initial parton momenta. This allows for computing, e.g., E_miss
	Support constant-width and zero-width options for O'Mega
	Width options now denoted by w:X (X=f,c,z). f option obsolescent
	Bug fix: colorized code: flipped indices could screw up result
	Bug fix: O'Mega with 'c' and 'w:f' option together (still some problem)
	Bug fix: dvips on systems where dvips defaults to lpr
	Bug fix: integer overflow if too many events are requested

	2005-07-29
	Allow for 2 -> 1 processes (if structure functions are on)

	2005-07-26
	Fixed and expanded the 'test' matrix element:
	Unit matrix element with option 'u' / default: normalized phase space

	##################################################################

	2005-07-15
	RELEASE: version 1.41
	Bug fix: no result for particle decay processes with width=0
	Bug fix: line breaks in O'Mega files with color decomposition

	2005-06-02
	New self-tests (make test-QED / test-QCD / test-SM)
	check lists of 2->2 processes
	Bug fix: HELAS calling convention for wwwwxx and jwwwxx (4W-Vertex)

	2005-05-25
	Revised Makefile structure
	Eliminated obsolete references to ISAJET/SUSY (superseded by SLHA)

	2005-05-19
	Support for color in O'Mega (using color flow decomposition)
	New model QCD
	Parameter file changes that correspond to replaced SM module in O'Mega
	Bug fixes in MSSM (O'Mega) parameter file

	2005-05-18
	New event file formats, useful for LHC applications:
	ATHENA and Les Houches Accord (external fragmentation)
	Naive (i.e., leading 1/N) color factor now implemented both for
	incoming and outgoing partons

	2005-01-26
	include missing HELAS files for bundle
	pgf90 compatibility issues [note: still internal error in pgf90]

	##################################################################

	2004-12-13
	RELEASE: version 1.40
	compatibility fix: preprocessor marks in helas code now commented out
	minor bug fix: format string in madgraph source

	2004-12-03
	support for arbitray beam energies and directions
	allow for pT kick in structure functions
	bug fix: rounding error could result in zero cross section
	(compiler-dependent)

	2004-10-07
	simulate decay processes
	list fraction (of total width/cross section) instead of efficiency
	in process summary
	new cut/analysis parameters AA, AAD, CTA: absolute polar angle

	2004-10-04
	Replaced Madgraph I by Madgraph II. Main improvement: model no
	longer hardcoded
	introduced parameter reset_seed_each_process (useful for debugging)
	bug fix: color initialization for some processes was undefined

	2004-09-21
	don't compile unix_args module if it is not required

	##################################################################

	2004-09-20
	RELEASE: version 1.30
	g95 compatibility issues resolved
	some (irrelevant) memory leaks closed
	removed obsolete warning in circe1
	manual update (essentially) finished

	2004-08-03
	O'Mega RELEASE: version 0.9
	O'Mega, src/trie.mli, src/trie.ml: make interface compatible with
	the O'Caml 3.08 library (remains compatible with older
	versions). Implementation of unused functions still
	incomplete.

	2004-07-26
	minor fixes and improvements in make process

	2004-06-29
	workarounds for new Intel compiler bugs ...
	no rebuild of madgraph/comphep executables after 'make clean'
	bug fix in phase space routine:
	wrong energy for massive initial particles
	bug fix in (new) model interface: name checks for antiparticles
	pre-run checks for comphep improved
	ww-strong model file extended
	Model files particle name fixes, chep SM vertices included

	2004-06-22
	O'Mega RELEASE: version 0.8
	O'Mega MSSM: sign of W+/W-/A and W+/W-/Z couplings

	2004-05-05
	Fixed bug in PDFLIB interface: p+pbar was initialized as p+p (ThO)
	NAG compiler: set number of continuation lines to 200 as default
	Extended format for cross section summary; appears now in whizard.out
	Fixed 'bundle' feature

	2004-04-28
	Fixed compatibility with revised O'Mega SM_ac model
	Fixed problem with x=0 or x=1 when calling PDFLIB (ThO)
	Fixed bug in comphep module: Vtb was overlooked

	##################################################################

	2004-04-15
	RELEASE: version 1.28
	Fixed bug: Color factor was missing for O'Mega processes with
	four quarks and more
	Manual partially updated

	2004-04-08
	Support for grid files in binary format
	New default value show_histories=F (reduce output file size)
	Revised phase space switches: removed annihilation_lines,
	removed s_channel_resonance, changed meaning of
	extra_off_shell_lines, added show_deleted_channels
	Bug fixed which lead to omission of some phase space channels
	Color flow guessed only if requested by guess_color_flow

	2004-03-10
	New model interface: Only one model name specified in whizard.prc
	All model-dependent files reside in conf/models (modellib removed)

	2004-03-03
	Support for input/output in SUSY Les Houches Accord format
	Split event files if requested
	Support for overall time limit
	Support for CIRCE and CIRCE2 generator mode
	Support for reading beam events from file

	2004-02-05
	Fixed compiler problems with Intel Fortran 7.1 and 8.0
	Support for catching signals

	##################################################################

	2003-08-06
	RELEASE: version 1.27
	User-defined PDF libraries as an alternative to the standard PDFLIB

	2003-07-23
	Revised phase space module: improved mappings for massless particles,
	equivalences of phase space channels are exploited
	Improved mapping for PDF (hadron colliders)
	Madgraph module: increased max number of color flows from 250 to 1000

	##################################################################

	2003-06-23
	RELEASE: version 1.26
	CIRCE2 support
	Fixed problem with 'TC' integer kind [Intel compiler complained]

	2003-05-28
	Support for drawing histograms of grids
	Bug fixes for MSSM definitions

	##################################################################

	2003-05-22
	RELEASE: version 1.25
	Experimental MSSM support with ISAJET interface
	Improved capabilities of generating/analyzing weighted events
	Optional drawing phase space diagrams using FeynMF

	##################################################################

	2003-01-31
	RELEASE: version 1.24
	A few more fixes and workarounds (Intel and Lahey compiler)

	2003-01-15
	Fixes and workarounds needed for WHIZARD to run with Intel compiler
	Command-line option interface for the Lahey compiler

	Bug fix: problem with reading whizard.phs

	##################################################################

	2002-12-10
	RELEASE: version 1.23

	Command-line options (on some systems)

	Allow for initial particles in the event record, ordered:
	[beams, initials] - [remnants] - outgoing partons

	Support for PYTHIA 6.2: Les Houches external process interface
	String pythia_parameters can be up to 1000 characters long
	Select color flow states in (internal) analysis
	Bug fix in color flow content of raw event files

	Support for transversal polarization of fermion beams
	Cut codes: PHI now for absolute azimuthal angle, DPHI for distance
	'Test' matrix elements optionally respect polarization

	User-defined code can be inserted for spectra, structure functions
	and fragmentation

	Time limits can be specified for adaptation and simulation
	User-defined file names and file directory
	Initial weights in input file no longer supported

	Bug fix in MadGraph (wave function counter could overflow)

	Bug fix: Gamelan (graphical analysis) was not built if noweb absent

	##################################################################

	2002-03-16
	RELEASE: version 1.22
	Allow for beam remnants in the event record

	2002-03-01
	Handling of aliases in whizard.prc fixed (aliases are whole tokens)

	2002-02-28
	Optimized phase space handling routines
	(total execution time reduced by 20-60%, depending on process)

	##################################################################

	2002-02-26
	RELEASE: version 1.21
	Fixed ISR formula (ISR was underestimated in previous versions).
	New version includes ISR in leading-log approximation up to
	third order. Parameter ISR_sqrts renamed to ISR_scale.

	##################################################################

	2002-02-19
	RELEASE: version 1.20
	New process-generating method 'test' (dummy matrix element)
	Compatibility with autoconf 2.50 and current O'Mega version

	2002-02-05
	Prevent integration channels from being dropped (optionally)
	New internal mapping for structure functions improves performance
	Old whizard.phx file deleted after recompiling (could cause trouble)

	2002-01-24
	Support for user-defined cuts and matrix element reweighting
	STDHEP output now written by write_events_format=20 (was 3)

	2002-01-16
	Improved structure function handling; small changes in user interface:
	new parameter structured_beams in &process_input
	parameter fixed_energy in &beam_input removed
	Support for multiple initial states
	Eta-phi (cone) cut possible (hadron collider applications)
	Fixed bug: Whizard library was not always recompiled when necessary
	Fixed bug: Default cuts were insufficient in some cases
	Fixed bug: Unusable phase space mappings generated in some cases

	2001-12-06
	Reorganized document source

	2001-12-05
	Preliminary CIRCE2 support (no functionality yet)

	2001-11-27
	Intel compiler support (does not yet work because of compiler bugs)
	New cut and analysis mode cos-theta* and related
	Fixed circular jetset_interface dependency warning
	Some broadcast routines removed (parallel support disabled anyway)
	Minor shifts in cleanup targets (Makefiles)
	Modified library search, check for pdflib8*

	2001-08-06
	Fixed bug: I/O unit number could be undefined when reading phase space
	Fixed bug: Unitialized variable could cause segfault when
	event generation was disabled
	Fixed bug: Undefined subroutine in CIRCE replacement module
	Enabled feature: TGCs in O'Mega (not yet CompHEP!) matrix elements
	(CompHEP model sm-GF #5, O'Mega model SM_ac)
	Fixed portability issue: Makefile did rely on PWD environment variable
	Fixed portability issue: PYTHIA library search ambiguity resolved

	2001-08-01
	Default whizard.prc and whizard.in depend on activated modules
	Fixed bug: TEX=latex was not properly enabled when making plots

	2001-07-20
	Fixed output settings in PERL script calls
	Cache enabled in various configure checks

	2001-07-13
	Support for multiple processes in a single WHIZARD run. The
	integrations are kept separate, but the generated events are mixed
	The whizard.evx format has changed (incompatible), including now
	the color flow information for PYTHIA fragmentation
	Output files are now process-specific, except for the event file
	Phase space file whizard.phs (if present) is used only as input,
	program-generated phase space is now in whizard.phx

	2001-07-10
	Bug fix: Undefined parameters in parameters_SM_ac.f90 removed

	2001-07-04
	Bug fix: Compiler options for the case OMEGA is disabled
	Small inconsistencies in whizard.out format fixed

	2001-07-01
	Workaround for missing PDFLIB dummy routines in PYTHIA library

	##################################################################

	2001-06-30
	RELEASE: version 1.13
	Default path /cern/pro/lib in configure script

	2001-06-20
	New fragmentation option: Interface for PYTHIA with full color flow
	information, beam remnants etc.

	2001-06-18
	Severe bug fixed in madgraph interface: 3-gluon coupling was missing
	Enabled color flow information in madgraph

	2001-06-11
	VAMP interface module rewritten
	Revised output format: Multiple VAMP iterations count as one WHIZARD
	iteration in integration passes 1 and 3
	Improved message and error handling
	Bug fix in VAMP: handle exceptional cases in rebinning_weights

	2001-05-31
	new parameters for grid adaptation: accuracy_goal and efficiency_goal

	##################################################################

	2001-05-29
	RELEASE: version 1.12
	bug fixes (compilation problems): deleted/modified unused functions

	2001-05-16
	diagram selection improved and documented

	2001-05-06
	allow for disabling packages during configuration

	2001-05-03
	slight changes in whizard.out format; manual extended

	##################################################################

	2001-04-20
	RELEASE: version 1.11
	fixed some configuration and compilation problems (PDFLIB etc.)

	2001-04-18
	linked PDFLIB: support for quark/gluon structure functions

	2001-04-05
	parameter interface written by PERL script
	SM_ac model file: fixed error in continuation line

	2001-03-13
	O'Mega, O'Caml 3.01: incompatible changes
	O'Mega, src/trie.mli: add covariance annotation to T.t
	This breaks O'Caml 3.00, but is required for O'Caml 3.01.
	O'Mega, many instances: replace `sig include Module.T end' by
	`Module.T', since the bug is fixed in O'Caml 3.01

	2001-02-28
	O'Mega, src/model.mli:
	new field Model.vertices required for model functors, will
	retire Model.fuse2, Model.fuse3, Model.fusen soon.

	##################################################################

	2001-03-27
	RELEASE: version 1.10
	reorganized the modules as libraries
	linked PYTHIA: support for parton fragmentation

	2000-12-14
	fixed some configuration problems (if noweb etc. are absent)

	##################################################################

	2000-12-01
	RELEASE of first public version: version 1.00beta



	Index: trunk/src/beams/beams.nw
	===================================================================
	--- trunk/src/beams/beams.nw (revision 8201)
	+++ trunk/src/beams/beams.nw (revision 8202)
	@@ -1,25201 +1,25235 @@
	%% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: beams and beam structure
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Beams}
	\includemodulegraph{beams}

	These modules implement beam configuration and beam structure, the
	latter in abstract terms.
	\begin{description}
	\item[beam\_structures]
	The [[beam_structure_t]] type is a messenger type that communicates
	the user settings to the \whizard\ core.
	\item[beams]
	Beam configuration.
	\item[sf\_aux]
	Tools for handling structure functions and splitting
	\item[sf\_mappings]
	Mapping functions, useful for structure function implementation
	\item[sf\_base]
	The abstract structure-function interaction and structure-function
	chain types.
	\end{description}

	These are the implementation modules, the concrete counterparts of
	[[sf_base]]:
	\begin{description}
	\item[sf\_isr]
	ISR structure function (photon radiation inclusive and resummed in
	collinear and IR regions).
	\item[sf\_epa]
	Effective Photon Approximation.
	\item[sf\_ewa]
	Effective $W$ (and $Z$) approximation.
	\item[sf\_escan]
	Energy spectrum that emulates a uniform energy scan.
	\item[sf\_gaussian]
	Gaussian beam spread
	\item[sf\_beam\_events]
	Beam-event generator that reads its input from an external file.
	\item[sf\_circe1]
	CIRCE1 beam spectra for electrons and photons.
	\item[sf\_circe2]
	CIRCE2 beam spectra for electrons and photons.
	\item[hoppet\_interface]
	Support for $b$-quark matching, addon to PDF modules.
	\item[sf\_pdf\_builtin]
	Direct support for selected hadron PDFs.
	\item[sf\_lhapdf]
	LHAPDF library support.
	\end{description}

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Beam structure}

	This module stores the beam structure definition as it is declared in
	the SINDARIN script. The structure definition is not analyzed, just
	recorded for later use.

	We do not capture any numerical parameters, just names of particles and
	structure functions.
	<<[[beam_structures.f90]]>>=
	<<File header>>

	module beam_structures

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_19
	use diagnostics
	use lorentz
	use polarizations

	<<Standard module head>>

	<<Beam structures: public>>

	<<Beam structures: types>>

	<<Beam structures: interfaces>>

	contains

	<<Beam structures: procedures>>

	end module beam_structures
	@ %def beam_structures
	@
	\subsection{Beam structure elements}
	An entry in a beam-structure record consists of a string
	that denotes a type of structure function.
	<<Beam structures: types>>=
	type :: beam_structure_entry_t
	logical :: is_valid = .false.
	type(string_t) :: name
	contains
	<<Beam structures: beam structure entry: TBP>>
	end type beam_structure_entry_t

	@ %def beam_structure_entry_t
	@ Output.
	<<Beam structures: beam structure entry: TBP>>=
	procedure :: to_string => beam_structure_entry_to_string
	<<Beam structures: procedures>>=
	function beam_structure_entry_to_string (object) result (string)
	class(beam_structure_entry_t), intent(in) :: object
	type(string_t) :: string
	if (object%is_valid) then
	string = object%name
	else
	string = "none"
	end if
	end function beam_structure_entry_to_string

	@ %def beam_structure_entry_to_string
	@
	A record in the beam-structure sequence denotes either a
	structure-function entry, a pair of such entries, or a pair spectrum.
	<<Beam structures: types>>=
	type :: beam_structure_record_t
	type(beam_structure_entry_t), dimension(:), allocatable :: entry
	end type beam_structure_record_t

	@ %def beam_structure_record_t
	@
	\subsection{Beam structure type}
	The beam-structure object contains the beam particle(s) as simple strings.
	The sequence of records indicates the structure functions by name. No
	numerical parameters are stored.
	<<Beam structures: public>>=
	public :: beam_structure_t
	<<Beam structures: types>>=
	type :: beam_structure_t
	private
	integer :: n_beam = 0
	type(string_t), dimension(:), allocatable :: prt
	type(beam_structure_record_t), dimension(:), allocatable :: record
	type(smatrix_t), dimension(:), allocatable :: smatrix
	real(default), dimension(:), allocatable :: pol_f
	real(default), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: theta
	real(default), dimension(:), allocatable :: phi
	contains
	<<Beam structures: beam structure: TBP>>
	end type beam_structure_t

	@ %def beam_structure_t
	@ The finalizer deletes all contents explicitly, so we can continue
	with an empty beam record. (It is not needed for deallocation.) We
	have distinct finalizers for the independent parts of the beam structure.
	<<Beam structures: beam structure: TBP>>=
	procedure :: final_sf => beam_structure_final_sf
	<<Beam structures: procedures>>=
	subroutine beam_structure_final_sf (object)
	class(beam_structure_t), intent(inout) :: object
	if (allocated (object%prt)) deallocate (object%prt)
	if (allocated (object%record)) deallocate (object%record)
	object%n_beam = 0
	end subroutine beam_structure_final_sf

	@ %def beam_structure_final_sf
	@ Output. The actual information fits in a single line, therefore we can
	provide a [[to_string]] method. The [[show]] method also lists the
	current values of relevant global variables.
	<<Beam structures: beam structure: TBP>>=
	procedure :: write => beam_structure_write
	procedure :: to_string => beam_structure_to_string
	<<Beam structures: procedures>>=
	subroutine beam_structure_write (object, unit)
	class(beam_structure_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A,A)") "Beam structure: ", char (object%to_string ())
	if (allocated (object%smatrix)) then
	do i = 1, size (object%smatrix)
	write (u, "(3x,A,I0,A)") "polarization (beam ", i, "):"
	call object%smatrix(i)%write (u, indent=2)
	end do
	end if
	if (allocated (object%pol_f)) then
	write (u, "(3x,A,F10.7,:,',',F10.7)") "polarization degree =", &
	object%pol_f
	end if
	if (allocated (object%p)) then
	write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
	")") "momentum =", object%p
	end if
	if (allocated (object%theta)) then
	write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
	")") "angle th =", object%theta
	end if
	if (allocated (object%phi)) then
	write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
	")") "angle ph =", object%phi
	end if
	end subroutine beam_structure_write

	function beam_structure_to_string (object, sf_only) result (string)
	class(beam_structure_t), intent(in) :: object
	logical, intent(in), optional :: sf_only
	type(string_t) :: string
	integer :: i, j
	logical :: with_beams
	with_beams = .true.; if (present (sf_only)) with_beams = .not. sf_only
	select case (object%n_beam)
	case (1)
	if (with_beams) then
	string = object%prt(1)
	else
	string = ""
	end if
	case (2)
	if (with_beams) then
	string = object%prt(1) // ", " // object%prt(2)
	else
	string = ""
	end if
	if (allocated (object%record)) then
	if (size (object%record) > 0) then
	if (with_beams) string = string // " => "
	do i = 1, size (object%record)
	if (i > 1) string = string // " => "
	do j = 1, size (object%record(i)%entry)
	if (j > 1) string = string // ", "
	string = string // object%record(i)%entry(j)%to_string ()
	end do
	end do
	end if
	end if
	case default
	string = "[any particles]"
	end select
	end function beam_structure_to_string

	@ %def beam_structure_write beam_structure_to_string
	@ Initializer: dimension the beam structure record. Each array
	element denotes the number of entries for a record within the
	beam-structure sequence. The number of entries is either one or two,
	while the number of records is unlimited.
	<<Beam structures: beam structure: TBP>>=
	procedure :: init_sf => beam_structure_init_sf
	<<Beam structures: procedures>>=
	subroutine beam_structure_init_sf (beam_structure, prt, dim_array)
	class(beam_structure_t), intent(inout) :: beam_structure
	type(string_t), dimension(:), intent(in) :: prt
	integer, dimension(:), intent(in), optional :: dim_array
	integer :: i
	call beam_structure%final_sf ()
	beam_structure%n_beam = size (prt)
	allocate (beam_structure%prt (size (prt)))
	beam_structure%prt = prt
	if (present (dim_array)) then
	allocate (beam_structure%record (size (dim_array)))
	do i = 1, size (dim_array)
	allocate (beam_structure%record(i)%entry (dim_array(i)))
	end do
	else
	allocate (beam_structure%record (0))
	end if
	end subroutine beam_structure_init_sf

	@ %def beam_structure_init_sf
	@ Set an entry, specified by record number and entry number.
	<<Beam structures: beam structure: TBP>>=
	procedure :: set_sf => beam_structure_set_sf
	<<Beam structures: procedures>>=
	subroutine beam_structure_set_sf (beam_structure, i, j, name)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i, j
	type(string_t), intent(in) :: name
	associate (entry => beam_structure%record(i)%entry(j))
	entry%name = name
	entry%is_valid = .true.
	end associate
	end subroutine beam_structure_set_sf

	@ %def beam_structure_set_sf
	@ Expand the beam-structure object. (i) For a pair spectrum, keep the
	entry. (ii) For a single-particle structure function written as a
	single entry, replace this by a record with two entries.
	(ii) For a record with two nontrivial entries, separate this into two
	records with one trivial entry each.

	To achieve this, we need a function that tells us whether an entry is
	a spectrum or a structure function. It returns 0 for a trivial entry,
	1 for a single-particle structure function, and 2 for a two-particle
	spectrum.
	<<Beam structures: interfaces>>=
	abstract interface
	function strfun_mode_fun (name) result (n)
	import
	type(string_t), intent(in) :: name
	integer :: n
	end function strfun_mode_fun
	end interface

	@ %def is_spectrum_t
	@ Algorithm: (1) Mark entries as invalid where necessary. (2) Count
	the number of entries that we will need. (3) Expand and copy
	entries to a new record array. (4) Replace the old array by the new one.
	<<Beam structures: beam structure: TBP>>=
	procedure :: expand => beam_structure_expand
	<<Beam structures: procedures>>=
	subroutine beam_structure_expand (beam_structure, strfun_mode)
	class(beam_structure_t), intent(inout) :: beam_structure
	procedure(strfun_mode_fun) :: strfun_mode
	type(beam_structure_record_t), dimension(:), allocatable :: new
	integer :: n_record, i, j
	if (.not. allocated (beam_structure%record)) return
	do i = 1, size (beam_structure%record)
	associate (entry => beam_structure%record(i)%entry)
	do j = 1, size (entry)
	select case (strfun_mode (entry(j)%name))
	case (0); entry(j)%is_valid = .false.
	end select
	end do
	end associate
	end do
	n_record = 0
	do i = 1, size (beam_structure%record)
	associate (entry => beam_structure%record(i)%entry)
	select case (size (entry))
	case (1)
	if (entry(1)%is_valid) then
	select case (strfun_mode (entry(1)%name))
	case (1); n_record = n_record + 2
	case (2); n_record = n_record + 1
	end select
	end if
	case (2)
	do j = 1, 2
	if (entry(j)%is_valid) then
	select case (strfun_mode (entry(j)%name))
	case (1); n_record = n_record + 1
	case (2)
	call beam_structure%write ()
	call msg_fatal ("Pair spectrum used as &
	&single-particle structure function")
	end select
	end if
	end do
	end select
	end associate
	end do
	allocate (new (n_record))
	n_record = 0
	do i = 1, size (beam_structure%record)
	associate (entry => beam_structure%record(i)%entry)
	select case (size (entry))
	case (1)
	if (entry(1)%is_valid) then
	select case (strfun_mode (entry(1)%name))
	case (1)
	n_record = n_record + 1
	allocate (new(n_record)%entry (2))
	new(n_record)%entry(1) = entry(1)
	n_record = n_record + 1
	allocate (new(n_record)%entry (2))
	new(n_record)%entry(2) = entry(1)
	case (2)
	n_record = n_record + 1
	allocate (new(n_record)%entry (1))
	new(n_record)%entry(1) = entry(1)
	end select
	end if
	case (2)
	do j = 1, 2
	if (entry(j)%is_valid) then
	n_record = n_record + 1
	allocate (new(n_record)%entry (2))
	new(n_record)%entry(j) = entry(j)
	end if
	end do
	end select
	end associate
	end do
	call move_alloc (from = new, to = beam_structure%record)
	end subroutine beam_structure_expand

	@ %def beam_structure_expand
	@
	\subsection{Polarization}
	To record polarization, we provide an allocatable array of [[smatrix]]
	objects, sparse matrices. The polarization structure is independent of the
	structure-function setup, they are combined only when an actual beam object is
	constructed.
	<<Beam structures: beam structure: TBP>>=
	procedure :: final_pol => beam_structure_final_pol
	procedure :: init_pol => beam_structure_init_pol
	<<Beam structures: procedures>>=
	subroutine beam_structure_final_pol (beam_structure)
	class(beam_structure_t), intent(inout) :: beam_structure
	if (allocated (beam_structure%smatrix)) deallocate (beam_structure%smatrix)
	if (allocated (beam_structure%pol_f)) deallocate (beam_structure%pol_f)
	end subroutine beam_structure_final_pol

	subroutine beam_structure_init_pol (beam_structure, n)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: n
	if (allocated (beam_structure%smatrix)) deallocate (beam_structure%smatrix)
	allocate (beam_structure%smatrix (n))
	if (.not. allocated (beam_structure%pol_f)) &
	allocate (beam_structure%pol_f (n), source = 1._default)
	end subroutine beam_structure_init_pol

	@ %def beam_structure_final_pol
	@ %def beam_structure_init_pol
	@ Check if polarized beams are used.
	<<Beam structures: beam structure: TBP>>=
	procedure :: has_polarized_beams => beam_structure_has_polarized_beams
	<<Beam structures: procedures>>=
	elemental function beam_structure_has_polarized_beams (beam_structure) result (pol)
	logical :: pol
	class(beam_structure_t), intent(in) :: beam_structure
	if (allocated (beam_structure%pol_f)) then
	pol = any (beam_structure%pol_f /= 0)
	else
	pol = .false.
	end if
	end function beam_structure_has_polarized_beams

	@ %def beam_structure_has_polarized_beams
	@ Directly copy the spin density matrices.
	<<Beam structures: beam structure: TBP>>=
	procedure :: set_smatrix => beam_structure_set_smatrix
	<<Beam structures: procedures>>=
	subroutine beam_structure_set_smatrix (beam_structure, i, smatrix)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i
	type(smatrix_t), intent(in) :: smatrix
	beam_structure%smatrix(i) = smatrix
	end subroutine beam_structure_set_smatrix

	@ %def beam_structure_set_smatrix
	@ Initialize one of the spin density matrices manually.
	<<Beam structures: beam structure: TBP>>=
	procedure :: init_smatrix => beam_structure_init_smatrix
	<<Beam structures: procedures>>=
	subroutine beam_structure_init_smatrix (beam_structure, i, n_entry)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i
	integer, intent(in) :: n_entry
	call beam_structure%smatrix(i)%init (2, n_entry)
	end subroutine beam_structure_init_smatrix

	@ %def beam_structure_init_smatrix
	@ Set a polarization entry.
	<<Beam structures: beam structure: TBP>>=
	procedure :: set_sentry => beam_structure_set_sentry
	<<Beam structures: procedures>>=
	subroutine beam_structure_set_sentry &
	(beam_structure, i, i_entry, index, value)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i
	integer, intent(in) :: i_entry
	integer, dimension(:), intent(in) :: index
	complex(default), intent(in) :: value
	call beam_structure%smatrix(i)%set_entry (i_entry, index, value)
	end subroutine beam_structure_set_sentry

	@ %def beam_structure_set_sentry
	@ Set the array of polarization fractions.
	<<Beam structures: beam structure: TBP>>=
	procedure :: set_pol_f => beam_structure_set_pol_f
	<<Beam structures: procedures>>=
	subroutine beam_structure_set_pol_f (beam_structure, f)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: f
	if (allocated (beam_structure%pol_f)) deallocate (beam_structure%pol_f)
	allocate (beam_structure%pol_f (size (f)), source = f)
	end subroutine beam_structure_set_pol_f

	@ %def beam_structure_set_pol_f
	@
	\subsection{Beam momenta}
	By default, beam momenta are deduced from the [[sqrts]] value or from
	the mass of the decaying particle, assuming a c.m.\ setup. Here we
	set them explicitly.
	<<Beam structures: beam structure: TBP>>=
	procedure :: final_mom => beam_structure_final_mom
	<<Beam structures: procedures>>=
	subroutine beam_structure_final_mom (beam_structure)
	class(beam_structure_t), intent(inout) :: beam_structure
	if (allocated (beam_structure%p)) deallocate (beam_structure%p)
	if (allocated (beam_structure%theta)) deallocate (beam_structure%theta)
	if (allocated (beam_structure%phi)) deallocate (beam_structure%phi)
	end subroutine beam_structure_final_mom

	@ %def beam_structure_final_mom
	<<Beam structures: beam structure: TBP>>=
	procedure :: set_momentum => beam_structure_set_momentum
	procedure :: set_theta => beam_structure_set_theta
	procedure :: set_phi => beam_structure_set_phi
	<<Beam structures: procedures>>=
	subroutine beam_structure_set_momentum (beam_structure, p)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: p
	if (allocated (beam_structure%p)) deallocate (beam_structure%p)
	allocate (beam_structure%p (size (p)), source = p)
	end subroutine beam_structure_set_momentum

	subroutine beam_structure_set_theta (beam_structure, theta)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: theta
	if (allocated (beam_structure%theta)) deallocate (beam_structure%theta)
	allocate (beam_structure%theta (size (theta)), source = theta)
	end subroutine beam_structure_set_theta

	subroutine beam_structure_set_phi (beam_structure, phi)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: phi
	if (allocated (beam_structure%phi)) deallocate (beam_structure%phi)
	allocate (beam_structure%phi (size (phi)), source = phi)
	end subroutine beam_structure_set_phi

	@ %def beam_structure_set_momentum
	@ %def beam_structure_set_theta
	@ %def beam_structure_set_phi
	@
	\subsection{Get contents}
	Look at the incoming particles. We may also have the case that beam
	particles are not specified, but polarization.
	<<Beam structures: beam structure: TBP>>=
	procedure :: is_set => beam_structure_is_set
	procedure :: get_n_beam => beam_structure_get_n_beam
	procedure :: get_prt => beam_structure_get_prt
	<<Beam structures: procedures>>=
	function beam_structure_is_set (beam_structure) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	logical :: flag
	flag = beam_structure%n_beam > 0 .or. beam_structure%asymmetric ()
	end function beam_structure_is_set

	function beam_structure_get_n_beam (beam_structure) result (n)
	class(beam_structure_t), intent(in) :: beam_structure
	integer :: n
	n = beam_structure%n_beam
	end function beam_structure_get_n_beam

	function beam_structure_get_prt (beam_structure) result (prt)
	class(beam_structure_t), intent(in) :: beam_structure
	type(string_t), dimension(:), allocatable :: prt
	allocate (prt (size (beam_structure%prt)))
	prt = beam_structure%prt
	end function beam_structure_get_prt

	@ %def beam_structure_is_set
	@ %def beam_structure_get_n_beam
	@ %def beam_structure_get_prt
	@
	Return the number of records.
	<<Beam structures: beam structure: TBP>>=
	procedure :: get_n_record => beam_structure_get_n_record
	<<Beam structures: procedures>>=
	function beam_structure_get_n_record (beam_structure) result (n)
	class(beam_structure_t), intent(in) :: beam_structure
	integer :: n
	if (allocated (beam_structure%record)) then
	n = size (beam_structure%record)
	else
	n = 0
	end if
	end function beam_structure_get_n_record

	@ %def beam_structure_get_n_record
	@ Return an array consisting of the beam indices affected by the valid
	entries within a record. After expansion, there should be exactly one
	valid entry per record.
	<<Beam structures: beam structure: TBP>>=
	procedure :: get_i_entry => beam_structure_get_i_entry
	<<Beam structures: procedures>>=
	function beam_structure_get_i_entry (beam_structure, i) result (i_entry)
	class(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: i
	integer, dimension(:), allocatable :: i_entry
	associate (record => beam_structure%record(i))
	select case (size (record%entry))
	case (1)
	if (record%entry(1)%is_valid) then
	allocate (i_entry (2), source = [1, 2])
	else
	allocate (i_entry (0))
	end if
	case (2)
	if (all (record%entry%is_valid)) then
	allocate (i_entry (2), source = [1, 2])
	else if (record%entry(1)%is_valid) then
	allocate (i_entry (1), source = [1])
	else if (record%entry(2)%is_valid) then
	allocate (i_entry (1), source = [2])
	else
	allocate (i_entry (0))
	end if
	end select
	end associate
	end function beam_structure_get_i_entry

	@ %def beam_structure_get_i_entry
	@ Return the name of the first valid entry within a record. After
	expansion, there should be exactly one valid entry per record.
	<<Beam structures: beam structure: TBP>>=
	procedure :: get_name => beam_structure_get_name
	<<Beam structures: procedures>>=
	function beam_structure_get_name (beam_structure, i) result (name)
	type(string_t) :: name
	class(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: i
	associate (record => beam_structure%record(i))
	if (record%entry(1)%is_valid) then
	name = record%entry(1)%name
	else if (size (record%entry) == 2) then
	name = record%entry(2)%name
	end if
	end associate
	end function beam_structure_get_name

	@ %def beam_structure_get_name
	@
	<<Beam structures: beam structure: TBP>>=
	procedure :: has_pdf => beam_structure_has_pdf
	<<Beam structures: procedures>>=
	function beam_structure_has_pdf (beam_structure) result (has_pdf)
	logical :: has_pdf
	class(beam_structure_t), intent(in) :: beam_structure
	integer :: i
	type(string_t) :: name
	has_pdf = .false.
	do i = 1, beam_structure%get_n_record ()
	name = beam_structure%get_name (i)
	has_pdf = has_pdf .or. name == var_str ("pdf_builtin") .or. name == var_str ("lhapdf")
	end do
	end function beam_structure_has_pdf

	@ %def beam_structure_has_pdf
	@ Return true if the beam structure contains a particular structure
	function identifier (such as [[lhapdf]], [[isr]], etc.)
	<<Beam structures: beam structure: TBP>>=
	procedure :: contains => beam_structure_contains
	<<Beam structures: procedures>>=
	function beam_structure_contains (beam_structure, name) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	character(*), intent(in) :: name
	logical :: flag
	integer :: i, j
	flag = .false.
	if (allocated (beam_structure%record)) then
	do i = 1, size (beam_structure%record)
	do j = 1, size (beam_structure%record(i)%entry)
	flag = beam_structure%record(i)%entry(j)%name == name
	if (flag) return
	end do
	end do
	end if
	end function beam_structure_contains

	@ %def beam_structure_contains
	@ Return polarization data.
	<<Beam structures: beam structure: TBP>>=
	procedure :: polarized => beam_structure_polarized
	procedure :: get_smatrix => beam_structure_get_smatrix
	procedure :: get_pol_f => beam_structure_get_pol_f
	procedure :: asymmetric => beam_structure_asymmetric
	<<Beam structures: procedures>>=
	function beam_structure_polarized (beam_structure) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	logical :: flag
	flag = allocated (beam_structure%smatrix)
	end function beam_structure_polarized

	function beam_structure_get_smatrix (beam_structure) result (smatrix)
	class(beam_structure_t), intent(in) :: beam_structure
	type(smatrix_t), dimension(:), allocatable :: smatrix
	allocate (smatrix (size (beam_structure%smatrix)), &
	source = beam_structure%smatrix)
	end function beam_structure_get_smatrix

	function beam_structure_get_pol_f (beam_structure) result (pol_f)
	class(beam_structure_t), intent(in) :: beam_structure
	real(default), dimension(:), allocatable :: pol_f
	allocate (pol_f (size (beam_structure%pol_f)), &
	source = beam_structure%pol_f)
	end function beam_structure_get_pol_f

	function beam_structure_asymmetric (beam_structure) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	logical :: flag
	flag = allocated (beam_structure%p) &
	.or. allocated (beam_structure%theta) &
	.or. allocated (beam_structure%phi)
	end function beam_structure_asymmetric

	@ %def beam_structure_polarized
	@ %def beam_structure_get_smatrix
	@ %def beam_structure_get_pol_f
	@ %def beam_structure_asymmetric
	@ Return the beam momenta (the space part, i.e., three-momenta). This
	is meaningful only if momenta and, optionally, angles have been set.
	<<Beam structures: beam structure: TBP>>=
	procedure :: get_momenta => beam_structure_get_momenta
	<<Beam structures: procedures>>=
	function beam_structure_get_momenta (beam_structure) result (p)
	class(beam_structure_t), intent(in) :: beam_structure
	type(vector3_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: theta, phi
	integer :: n, i
	if (allocated (beam_structure%p)) then
	n = size (beam_structure%p)
	if (allocated (beam_structure%theta)) then
	if (size (beam_structure%theta) == n) then
	allocate (theta (n), source = beam_structure%theta)
	else
	call msg_fatal ("Beam structure: mismatch in momentum vs. &
	&angle theta specification")
	end if
	else
	allocate (theta (n), source = 0._default)
	end if
	if (allocated (beam_structure%phi)) then
	if (size (beam_structure%phi) == n) then
	allocate (phi (n), source = beam_structure%phi)
	else
	call msg_fatal ("Beam structure: mismatch in momentum vs. &
	&angle phi specification")
	end if
	else
	allocate (phi (n), source = 0._default)
	end if
	allocate (p (n))
	do i = 1, n
	p(i) = beam_structure%p(i) * vector3_moving ([ &
	sin (theta(i)) * cos (phi(i)), &
	sin (theta(i)) * sin (phi(i)), &
	cos (theta(i))])
	end do
	if (n == 2) p(2) = - p(2)
	else
	call msg_fatal ("Beam structure: angle theta/phi specified but &
	&momentum/a p undefined")
	end if
	end function beam_structure_get_momenta

	@ %def beam_structure_get_momenta
	@ Check for a complete beam structure. The [[applies]] flag tells if
	the beam structure should actually be used for a process with the
	given [[n_in]] number of incoming particles.

	It set if the beam structure matches the process as either decay or
	scattering. It is unset if beam structure references a scattering
	setup but the process is a decay. It is also unset if the beam
	structure itself is empty.

	If the beam structure cannot be used, terminate with fatal error.
	<<Beam structures: beam structure: TBP>>=
	procedure :: check_against_n_in => beam_structure_check_against_n_in
	<<Beam structures: procedures>>=
	subroutine beam_structure_check_against_n_in (beam_structure, n_in, applies)
	class(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: n_in
	logical, intent(out) :: applies
	if (beam_structure%is_set ()) then
	if (n_in == beam_structure%get_n_beam ()) then
	applies = .true.
	else if (beam_structure%get_n_beam () == 0) then
	call msg_fatal &
	("Asymmetric beams: missing beam particle specification")
	applies = .false.
	else
	call msg_fatal &
	("Mismatch of process and beam setup (scattering/decay)")
	applies = .false.
	end if
	else
	applies = .false.
	end if
	end subroutine beam_structure_check_against_n_in

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

	module beam_structures_ut
	use unit_tests
	use beam_structures_uti

	<<Standard module head>>

	<<Beam structures: public test>>

	contains

	<<Beam structures: test driver>>

	end module beam_structures_ut
	@ %def beam_structures_ut
	@
	<<[[beam_structures_uti.f90]]>>=
	<<File header>>

	module beam_structures_uti

	<<Use kinds>>
	<<Use strings>>

	use beam_structures

	<<Standard module head>>

	<<Beam structures: test declarations>>

	contains

	<<Beam structures: tests>>

	<<Beam structures: test auxiliary>>

	end module beam_structures_uti
	@ %def beam_structures_ut
	@ API: driver for the unit tests below.
	<<Beam structures: public test>>=
	public :: beam_structures_test
	<<Beam structures: test driver>>=
	subroutine beam_structures_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Beam structures: execute tests>>
	end subroutine beam_structures_test

	@ %def beam_structures_tests
	@
	\subsubsection{Empty structure}
	<<Beam structures: execute tests>>=
	call test (beam_structures_1, "beam_structures_1", &
	"empty beam structure record", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_1
	<<Beam structures: tests>>=
	subroutine beam_structures_1 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure

	write (u, "(A)") "* Test output: beam_structures_1"
	write (u, "(A)") "* Purpose: display empty beam structure record"
	write (u, "(A)")

	call beam_structure%write (u)

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

	end subroutine beam_structures_1

	@ %def beam_structures_1
	@
	\subsubsection{Nontrivial configurations}
	<<Beam structures: execute tests>>=
	call test (beam_structures_2, "beam_structures_2", &
	"beam structure records", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_2
	<<Beam structures: tests>>=
	subroutine beam_structures_2 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure
	integer, dimension(0) :: empty_array
	type(string_t) :: s

	write (u, "(A)") "* Test output: beam_structures_2"
	write (u, "(A)") "* Purpose: setup beam structure records"
	write (u, "(A)")

	s = "s"

	call beam_structure%init_sf ([s], empty_array)
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [1])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [2])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%set_sf (1, 2, var_str ("b"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [2, 1])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%set_sf (1, 2, var_str ("b"))
	call beam_structure%set_sf (2, 1, var_str ("c"))
	call beam_structure%write (u)

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

	end subroutine beam_structures_2

	@ %def beam_structures_2
	@
	\subsubsection{Expansion}
	Provide a function that tells, for the dummy structure function names
	used here, whether they are considered a two-particle spectrum or a
	single-particle structure function:
	<<Beam structures: test auxiliary>>=
	function test_strfun_mode (name) result (n)
	type(string_t), intent(in) :: name
	integer :: n
	select case (char (name))
	case ("a"); n = 2
	case ("b"); n = 1
	case default; n = 0
	end select
	end function test_strfun_mode

	@ %def test_ist_pair_spectrum
	@
	<<Beam structures: execute tests>>=
	call test (beam_structures_3, "beam_structures_3", &
	"beam structure expansion", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_3
	<<Beam structures: tests>>=
	subroutine beam_structures_3 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure
	type(string_t) :: s

	write (u, "(A)") "* Test output: beam_structures_3"
	write (u, "(A)") "* Purpose: expand beam structure records"
	write (u, "(A)")

	s = "s"

	write (u, "(A)") "* Pair spectrum (keep as-is)"
	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [1])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%expand (test_strfun_mode)
	call beam_structure%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Structure function pair (expand)"
	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [2])
	call beam_structure%set_sf (1, 1, var_str ("b"))
	call beam_structure%set_sf (1, 2, var_str ("b"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%expand (test_strfun_mode)
	call beam_structure%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Structure function (separate and expand)"
	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [1])
	call beam_structure%set_sf (1, 1, var_str ("b"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%expand (test_strfun_mode)
	call beam_structure%write (u)

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

	call beam_structure%init_sf ([s, s], [1, 1])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%set_sf (2, 1, var_str ("b"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%expand (test_strfun_mode)
	call beam_structure%write (u)

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

	end subroutine beam_structures_3

	@ %def beam_structures_3
	@
	\subsubsection{Public methods}
	Check the methods that can be called to get the beam-structure
	contents.
	<<Beam structures: execute tests>>=
	call test (beam_structures_4, "beam_structures_4", &
	"beam structure contents", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_4
	<<Beam structures: tests>>=
	subroutine beam_structures_4 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure
	type(string_t) :: s
	type(string_t), dimension(2) :: prt
	integer :: i

	write (u, "(A)") "* Test output: beam_structures_4"
	write (u, "(A)") "* Purpose: check the API"
	write (u, "(A)")

	s = "s"

	write (u, "(A)") "* Structure-function combination"
	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [1, 2, 2])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%set_sf (2, 1, var_str ("b"))
	call beam_structure%set_sf (3, 2, var_str ("c"))
	call beam_structure%write (u)

	write (u, *)
	write (u, "(1x,A,I0)") "n_beam = ", beam_structure%get_n_beam ()
	prt = beam_structure%get_prt ()
	write (u, "(1x,A,2(1x,A))") "prt =", char (prt(1)), char (prt(2))

	write (u, *)
	write (u, "(1x,A,I0)") "n_record = ", beam_structure%get_n_record ()

	do i = 1, 3
	write (u, "(A)")
	write (u, "(1x,A,I0,A,A)") "name(", i, ") = ", &
	char (beam_structure%get_name (i))
	write (u, "(1x,A,I0,A,2(1x,I0))") "i_entry(", i, ") =", &
	beam_structure%get_i_entry (i)
	end do

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

	end subroutine beam_structures_4

	@ %def beam_structures_4
	@
	\subsubsection{Polarization}
	The polarization properties are independent from the structure-function setup.
	<<Beam structures: execute tests>>=
	call test (beam_structures_5, "beam_structures_5", &
	"polarization", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_5
	<<Beam structures: tests>>=
	subroutine beam_structures_5 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure
	integer, dimension(0) :: empty_array
	type(string_t) :: s

	write (u, "(A)") "* Test output: beam_structures_5"
	write (u, "(A)") "* Purpose: setup polarization in beam structure records"
	write (u, "(A)")

	s = "s"

	call beam_structure%init_sf ([s], empty_array)
	call beam_structure%init_pol (1)
	call beam_structure%init_smatrix (1, 1)
	call beam_structure%set_sentry (1, 1, [0,0], (1._default, 0._default))
	call beam_structure%set_pol_f ([0.5_default])
	call beam_structure%write (u)


	write (u, "(A)")
	call beam_structure%final_sf ()
	call beam_structure%final_pol ()

	call beam_structure%init_sf ([s, s], [1])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%init_pol (2)
	call beam_structure%init_smatrix (1, 2)
	call beam_structure%set_sentry (1, 1, [-1,1], (0.5_default,-0.5_default))
	call beam_structure%set_sentry (1, 2, [ 1,1], (1._default, 0._default))
	call beam_structure%init_smatrix (2, 0)
	call beam_structure%write (u)

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

	end subroutine beam_structures_5

	@ %def beam_structures_5
	@
	\subsubsection{Momenta}
	The momenta are independent from the structure-function setup.
	<<Beam structures: execute tests>>=
	call test (beam_structures_6, "beam_structures_6", &
	"momenta", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_6
	<<Beam structures: tests>>=
	subroutine beam_structures_6 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure
	integer, dimension(0) :: empty_array
	type(string_t) :: s

	write (u, "(A)") "* Test output: beam_structures_6"
	write (u, "(A)") "* Purpose: setup momenta in beam structure records"
	write (u, "(A)")

	s = "s"

	call beam_structure%init_sf ([s], empty_array)
	call beam_structure%set_momentum ([500._default])
	call beam_structure%write (u)


	write (u, "(A)")
	call beam_structure%final_sf ()
	call beam_structure%final_mom ()

	call beam_structure%init_sf ([s, s], [1])
	call beam_structure%set_momentum ([500._default, 700._default])
	call beam_structure%set_theta ([0._default, 0.1_default])
	call beam_structure%set_phi ([0._default, 1.51_default])
	call beam_structure%write (u)

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

	end subroutine beam_structures_6

	@ %def beam_structures_6
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Beams for collisions and decays}

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

	module beams

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_19
	use numeric_utils
	use diagnostics
	use md5
	use lorentz
	use model_data
	use flavors
	use quantum_numbers
	use state_matrices
	use interactions
	use polarizations
	use beam_structures

	<<Standard module head>>

	<<Beams: public>>

	<<Beams: types>>

	<<Beams: interfaces>>

	contains

	<<Beams: procedures>>

	end module beams
	@ %def beams
	@
	\subsection{Beam data}
	The beam data type contains beam data for one or two beams, depending
	on whether we are dealing with beam collisions or particle decay. In
	addition, it holds the c.m.\ energy [[sqrts]], the Lorentz
	transformation [[L]] that transforms the c.m.\ system into the lab
	system, and the pair of c.m.\ momenta.
	<<Beams: public>>=
	public :: beam_data_t
	<<Beams: types>>=
	type :: beam_data_t
	logical :: initialized = .false.
	integer :: n = 0
	type(flavor_t), dimension(:), allocatable :: flv
	real(default), dimension(:), allocatable :: mass
	type(pmatrix_t), dimension(:), allocatable :: pmatrix
	logical :: lab_is_cm_frame = .true.
	type(vector4_t), dimension(:), allocatable :: p_cm
	type(vector4_t), dimension(:), allocatable :: p
	type(lorentz_transformation_t), allocatable :: L_cm_to_lab
	real(default) :: sqrts = 0
	character(32) :: md5sum = ""
	contains
	<<Beams: beam data: TBP>>
	end type beam_data_t

	@ %def beam_data_t
	@ Generic initializer. This is called by the specific initializers
	below. Initialize either for decay or for collision.
	<<Beams: procedures>>=
	subroutine beam_data_init (beam_data, n)
	type(beam_data_t), intent(out) :: beam_data
	integer, intent(in) :: n
	beam_data%n = n
	allocate (beam_data%flv (n))
	allocate (beam_data%mass (n))
	allocate (beam_data%pmatrix (n))
	allocate (beam_data%p_cm (n))
	allocate (beam_data%p (n))
	beam_data%initialized = .true.
	end subroutine beam_data_init

	@ %def beam_data_init
	@ Finalizer: needed for the polarization components of the beams.
	<<Beams: beam data: TBP>>=
	procedure :: final => beam_data_final
	<<Beams: procedures>>=
	subroutine beam_data_final (beam_data)
	class(beam_data_t), intent(inout) :: beam_data
	beam_data%initialized = .false.
	end subroutine beam_data_final

	@ %def beam_data_final
	@ The verbose (default) version is for debugging. The short version
	is for screen output in the UI.
	<<Beams: beam data: TBP>>=
	procedure :: write => beam_data_write
	<<Beams: procedures>>=
	subroutine beam_data_write (beam_data, unit, verbose, write_md5sum)
	class(beam_data_t), intent(in) :: beam_data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, write_md5sum
	integer :: prt_name_len
	logical :: verb, write_md5
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	verb = .false.; if (present (verbose)) verb = verbose
	write_md5 = verb; if (present (write_md5sum)) write_md5 = write_md5sum
	if (.not. beam_data%initialized) then
	write (u, "(1x,A)") "Beam data: [undefined]"
	return
	end if
	prt_name_len = maxval (len (beam_data%flv%get_name ()))
	select case (beam_data%n)
	case (1)
	write (u, "(1x,A)") "Beam data (decay):"
	if (verb) then
	call write_prt (1)
	call beam_data%pmatrix(1)%write (u)
	write (u, *) "R.f. momentum:"
	call vector4_write (beam_data%p_cm(1), u)
	write (u, *) "Lab momentum:"
	call vector4_write (beam_data%p(1), u)
	else
	call write_prt (1)
	end if
	case (2)
	write (u, "(1x,A)") "Beam data (collision):"
	if (verb) then
	call write_prt (1)
	call beam_data%pmatrix(1)%write (u)
	call write_prt (2)
	call beam_data%pmatrix(2)%write (u)
	call write_sqrts
	write (u, *) "C.m. momenta:"
	call vector4_write (beam_data%p_cm(1), u)
	call vector4_write (beam_data%p_cm(2), u)
	write (u, *) "Lab momenta:"
	call vector4_write (beam_data%p(1), u)
	call vector4_write (beam_data%p(2), u)
	else
	call write_prt (1)
	call write_prt (2)
	call write_sqrts
	end if
	end select
	if (allocated (beam_data%L_cm_to_lab)) then
	if (verb) then
	call lorentz_transformation_write (beam_data%L_cm_to_lab, u)
	else
	write (u, "(1x,A)") "Beam structure: lab and c.m. frame differ"
	end if
	end if
	if (write_md5) then
	write (u, *) "MD5 sum: ", beam_data%md5sum
	end if
	contains
	subroutine write_sqrts
	character(80) :: sqrts_str
	write (sqrts_str, "(" // FMT_19 // ")") beam_data%sqrts
	write (u, "(3x,A)") "sqrts = " // trim (adjustl (sqrts_str)) // " GeV"
	end subroutine write_sqrts
	subroutine write_prt (i)
	integer, intent(in) :: i
	character(80) :: name_str, mass_str
	write (name_str, "(A)") char (beam_data%flv(i)%get_name ())
	write (mass_str, "(ES13.7)") beam_data%mass(i)
	write (u, "(3x,A)", advance="no") &
	name_str(:prt_name_len) // " (mass = " &
	// trim (adjustl (mass_str)) // " GeV)"
	if (beam_data%pmatrix(i)%is_polarized ()) then
	write (u, "(2x,A)") "polarized"
	else
	write (u, *)
	end if
	end subroutine write_prt
	end subroutine beam_data_write

	@ %def beam_data_write
	@ Return initialization status:
	<<Beams: beam data: TBP>>=
	procedure :: are_valid => beam_data_are_valid
	<<Beams: procedures>>=
	function beam_data_are_valid (beam_data) result (flag)
	class(beam_data_t), intent(in) :: beam_data
	logical :: flag
	flag = beam_data%initialized
	end function beam_data_are_valid

	@ %def beam_data_are_valid
	@ Check whether beam data agree with the current values of relevant
	parameters.
	<<Beams: beam data: TBP>>=
	procedure :: check_scattering => beam_data_check_scattering
	<<Beams: procedures>>=
	subroutine beam_data_check_scattering (beam_data, sqrts)
	class(beam_data_t), intent(in) :: beam_data
	real(default), intent(in), optional :: sqrts
	if (beam_data_are_valid (beam_data)) then
	if (present (sqrts)) then
	if (.not. nearly_equal (sqrts, beam_data%sqrts)) then
	call msg_error ("Current setting of sqrts is inconsistent " &
	// "with beam setup (ignored).")
	end if
	end if
	else
	call msg_bug ("Beam setup: invalid beam data")
	end if
	end subroutine beam_data_check_scattering

	@ %def beam_data_check_scattering
	@ Return the number of beams (1 for decays, 2 for collisions).
	<<Beams: beam data: TBP>>=
	procedure :: get_n_in => beam_data_get_n_in
	<<Beams: procedures>>=
	function beam_data_get_n_in (beam_data) result (n_in)
	class(beam_data_t), intent(in) :: beam_data
	integer :: n_in
	n_in = beam_data%n
	end function beam_data_get_n_in

	@ %def beam_data_get_n_in
	@ Return the beam flavor
	<<Beams: beam data: TBP>>=
	procedure :: get_flavor => beam_data_get_flavor
	<<Beams: procedures>>=
	function beam_data_get_flavor (beam_data) result (flv)
	class(beam_data_t), intent(in) :: beam_data
	type(flavor_t), dimension(:), allocatable :: flv
	allocate (flv (beam_data%n))
	flv = beam_data%flv
	end function beam_data_get_flavor

	@ %def beam_data_get_flavor
	@ Return the beam energies
	<<Beams: beam data: TBP>>=
	procedure :: get_energy => beam_data_get_energy
	<<Beams: procedures>>=
	function beam_data_get_energy (beam_data) result (e)
	class(beam_data_t), intent(in) :: beam_data
	real(default), dimension(:), allocatable :: e
	integer :: i
	allocate (e (beam_data%n))
	if (beam_data%initialized) then
	do i = 1, beam_data%n
	e(i) = energy (beam_data%p(i))
	end do
	else
	e = 0
	end if
	end function beam_data_get_energy

	@ %def beam_data_get_energy
	@ Return the c.m.\ energy.
	<<Beams: beam data: TBP>>=
	procedure :: get_sqrts => beam_data_get_sqrts
	<<Beams: procedures>>=
	function beam_data_get_sqrts (beam_data) result (sqrts)
	class(beam_data_t), intent(in) :: beam_data
	real(default) :: sqrts
	sqrts = beam_data%sqrts
	end function beam_data_get_sqrts

	@ %def beam_data_get_sqrts
	@ Return true if the lab and c.m.\ frame are specified as identical.
	<<Beams: beam data: TBP>>=
	procedure :: cm_frame => beam_data_cm_frame
	<<Beams: procedures>>=
	function beam_data_cm_frame (beam_data) result (flag)
	class(beam_data_t), intent(in) :: beam_data
	logical :: flag
	flag = beam_data%lab_is_cm_frame
	end function beam_data_cm_frame

	@ %def beam_data_cm_frame
	@ Return the polarization in case it is just two degrees
	<<Beams: beam data: TBP>>=
	procedure :: get_polarization => beam_data_get_polarization
	<<Beams: procedures>>=
	function beam_data_get_polarization (beam_data) result (pol)
	class(beam_data_t), intent(in) :: beam_data
	real(default), dimension(2) :: pol
	if (beam_data%n /= 2) &
	call msg_fatal ("Beam data: can only treat scattering processes.")
	pol = beam_data%pmatrix%get_simple_pol ()
	end function beam_data_get_polarization

	@ %def beam_data_get_polarization
	@
	<<Beams: beam data: TBP>>=
	procedure :: get_helicity_state_matrix => beam_data_get_helicity_state_matrix
	<<Beams: procedures>>=
	function beam_data_get_helicity_state_matrix (beam_data) result (state_hel)
	type(state_matrix_t) :: state_hel
	class(beam_data_t), intent(in) :: beam_data
	type(polarization_t), dimension(:), allocatable :: pol
	integer :: i
	allocate (pol (beam_data%n))
	do i = 1, beam_data%n
	call pol(i)%init_pmatrix (beam_data%pmatrix(i))
	end do
	call combine_polarization_states (pol, state_hel)
	end function beam_data_get_helicity_state_matrix

	@ %def beam_data_get_helicity_state_matrix
	@
	<<Beams: beam data: TBP>>=
	procedure :: is_initialized => beam_data_is_initialized
	<<Beams: procedures>>=
	function beam_data_is_initialized (beam_data) result (initialized)
	logical :: initialized
	class(beam_data_t), intent(in) :: beam_data
	initialized = any (beam_data%pmatrix%exists ())
	end function beam_data_is_initialized

	@ %def beam_data_is_initialized
	@ Return a MD5 checksum for beam data. If no checksum is present
	(because beams have not been initialized), compute the checksum of the
	sqrts value.
	<<Beams: beam data: TBP>>=
	procedure :: get_md5sum => beam_data_get_md5sum
	<<Beams: procedures>>=
	function beam_data_get_md5sum (beam_data, sqrts) result (md5sum_beams)
	class(beam_data_t), intent(in) :: beam_data
	real(default), intent(in) :: sqrts
	character(32) :: md5sum_beams
	character(80) :: buffer
	if (beam_data%md5sum /= "") then
	md5sum_beams = beam_data%md5sum
	else
	write (buffer, *) sqrts
	md5sum_beams = md5sum (buffer)
	end if
	end function beam_data_get_md5sum

	@ %def beam_data_get_md5sum
	@
	\subsection{Initializers: beam structure}
	Initialize the beam data object from a beam structure object, given energy and
	model.
	<<Beams: beam data: TBP>>=
	procedure :: init_structure => beam_data_init_structure
	<<Beams: procedures>>=
	subroutine beam_data_init_structure &
	(beam_data, structure, sqrts, model, decay_rest_frame)
	class(beam_data_t), intent(out) :: beam_data
	type(beam_structure_t), intent(in) :: structure
	integer :: n_beam
	real(default), intent(in) :: sqrts
	class(model_data_t), intent(in), target :: model
	logical, intent(in), optional :: decay_rest_frame
	type(flavor_t), dimension(:), allocatable :: flv
	n_beam = structure%get_n_beam ()
	allocate (flv (n_beam))
	call flv%init (structure%get_prt (), model)
	if (structure%asymmetric ()) then
	if (structure%polarized ()) then
	call beam_data%init_momenta (structure%get_momenta (), flv, &
	structure%get_smatrix (), structure%get_pol_f ())
	else
	call beam_data%init_momenta (structure%get_momenta (), flv)
	end if
	else
	select case (n_beam)
	case (1)
	if (structure%polarized ()) then
	call beam_data%init_decay (flv, &
	structure%get_smatrix (), structure%get_pol_f (), &
	rest_frame = decay_rest_frame)
	else
	call beam_data%init_decay (flv, &
	rest_frame = decay_rest_frame)
	end if
	case (2)
	if (structure%polarized ()) then
	call beam_data%init_sqrts (sqrts, flv, &
	structure%get_smatrix (), structure%get_pol_f ())
	else
	call beam_data%init_sqrts (sqrts, flv)
	end if
	case default
	call msg_bug ("Beam data: invalid beam structure object")
	end select
	end if
	end subroutine beam_data_init_structure

	@ %def beam_data_init_structure
	@
	\subsection{Initializers: collisions}
	This is the simplest one: just the two flavors, c.m.\ energy,
	polarization. Color is inferred from flavor. Beam momenta and c.m.\
	momenta coincide.
	<<Beams: beam data: TBP>>=
	procedure :: init_sqrts => beam_data_init_sqrts
	<<Beams: procedures>>=
	subroutine beam_data_init_sqrts (beam_data, sqrts, flv, smatrix, pol_f)
	class(beam_data_t), intent(out) :: beam_data
	real(default), intent(in) :: sqrts
	type(flavor_t), dimension(:), intent(in) :: flv
	type(smatrix_t), dimension(:), intent(in), optional :: smatrix
	real(default), dimension(:), intent(in), optional :: pol_f
	real(default), dimension(size(flv)) :: E, p
	call beam_data_init (beam_data, size (flv))
	beam_data%sqrts = sqrts
	beam_data%lab_is_cm_frame = .true.
	select case (beam_data%n)
	case (1)
	E = sqrts; p = 0
	beam_data%p_cm = vector4_moving (E, p, 3)
	beam_data%p = beam_data%p_cm
	case (2)
	beam_data%p_cm = colliding_momenta (sqrts, flv%get_mass ())
	beam_data%p = colliding_momenta (sqrts, flv%get_mass ())
	end select
	call beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
	end subroutine beam_data_init_sqrts

	@ %def beam_data_init_sqrts
	@ This version sets beam momenta directly, assuming that they are
	asymmetric, i.e., lab frame and c.m.\ frame do not coincide.
	Polarization info is deferred to a common initializer.

	The Lorentz transformation that we compute here is not actually used
	in the calculation; instead, it will be recomputed for each event in
	the subroutine [[phs_set_incoming_momenta]]. We compute it here for
	the nominal beam setup nevertheless, so we can print it and, in
	particular, include it in the MD5 sum.
	<<Beams: beam data: TBP>>=
	procedure :: init_momenta => beam_data_init_momenta
	<<Beams: procedures>>=
	subroutine beam_data_init_momenta (beam_data, p3, flv, smatrix, pol_f)
	class(beam_data_t), intent(out) :: beam_data
	type(vector3_t), dimension(:), intent(in) :: p3
	type(flavor_t), dimension(:), intent(in) :: flv
	type(smatrix_t), dimension(:), intent(in), optional :: smatrix
	real(default), dimension(:), intent(in), optional :: pol_f
	type(vector4_t) :: p0
	type(vector4_t), dimension(:), allocatable :: p, p_cm_rot
	real(default), dimension(size(p3)) :: e
	real(default), dimension(size(flv)) :: m
	type(lorentz_transformation_t) :: L_boost, L_rot
	call beam_data_init (beam_data, size (flv))
	m = flv%get_mass ()
	e = sqrt (p3 2 + m 2)
	allocate (p (beam_data%n))
	p = vector4_moving (e, p3)
	p0 = sum (p)
	beam_data%p = p
	beam_data%lab_is_cm_frame = .false.
	beam_data%sqrts = p0 ** 1
	L_boost = boost (p0, beam_data%sqrts)
	allocate (p_cm_rot (beam_data%n))
	p_cm_rot = inverse (L_boost) * p
	allocate (beam_data%L_cm_to_lab)
	select case (beam_data%n)
	case (1)
	beam_data%L_cm_to_lab = L_boost
	beam_data%p_cm = vector4_at_rest (beam_data%sqrts)
	case (2)
	L_rot = rotation_to_2nd (3, space_part (p_cm_rot(1)))
	beam_data%L_cm_to_lab = L_boost * L_rot
	beam_data%p_cm = &
	colliding_momenta (beam_data%sqrts, flv%get_mass ())
	end select
	call beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
	end subroutine beam_data_init_momenta

	@ %def beam_data_init_momenta
	@
	Final steps:
	If requested, rotate the beams in the lab frame, and set
	the beam-data components.
	<<Beams: procedures>>=
	subroutine beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
	type(beam_data_t), intent(inout) :: beam_data
	type(flavor_t), dimension(:), intent(in) :: flv
	type(smatrix_t), dimension(:), intent(in), optional :: smatrix
	real(default), dimension(:), intent(in), optional :: pol_f
	integer :: i
	do i = 1, beam_data%n
	beam_data%flv(i) = flv(i)
	beam_data%mass(i) = flv(i)%get_mass ()
	if (present (smatrix)) then
	if (size (smatrix) /= beam_data%n) &
	call msg_fatal ("Beam data: &
	&polarization density array has wrong dimension")
	beam_data%pmatrix(i) = smatrix(i)
	if (present (pol_f)) then
	if (size (pol_f) /= size (smatrix)) &
	call msg_fatal ("Beam data: &
	&polarization fraction array has wrong dimension")
	call beam_data%pmatrix(i)%normalize (flv(i), pol_f(i))
	else
	call beam_data%pmatrix(i)%normalize (flv(i), 1._default)
	end if
	else
	call beam_data%pmatrix(i)%init (2, 0)
	call beam_data%pmatrix(i)%normalize (flv(i), 0._default)
	end if
	end do
	call beam_data%compute_md5sum ()
	end subroutine beam_data_finish_initialization

	@ %def beam_data_finish_initialization
	@
	The MD5 sum is stored within the beam-data record, so it can be
	checked for integrity in subsequent runs.
	<<Beams: beam data: TBP>>=
	procedure :: compute_md5sum => beam_data_compute_md5sum
	<<Beams: procedures>>=
	subroutine beam_data_compute_md5sum (beam_data)
	class(beam_data_t), intent(inout) :: beam_data
	integer :: unit
	unit = free_unit ()
	open (unit = unit, status = "scratch", action = "readwrite")
	call beam_data%write (unit, write_md5sum = .false., &
	verbose = .true.)
	rewind (unit)
	beam_data%md5sum = md5sum (unit)
	close (unit)
	end subroutine beam_data_compute_md5sum

	@ %def beam_data_compute_md5sum
	@
	\subsection{Initializers: decays}
	This is the simplest one: decay in rest frame. We need just flavor
	and polarization. Color is inferred from flavor. Beam momentum and
	c.m.\ momentum coincide.
	<<Beams: beam data: TBP>>=
	procedure :: init_decay => beam_data_init_decay
	<<Beams: procedures>>=
	subroutine beam_data_init_decay (beam_data, flv, smatrix, pol_f, rest_frame)
	class(beam_data_t), intent(out) :: beam_data
	type(flavor_t), dimension(1), intent(in) :: flv
	type(smatrix_t), dimension(1), intent(in), optional :: smatrix
	real(default), dimension(:), intent(in), optional :: pol_f
	logical, intent(in), optional :: rest_frame
	real(default), dimension(1) :: m
	m = flv%get_mass ()
	if (present (smatrix)) then
	call beam_data%init_sqrts (m(1), flv, smatrix, pol_f)
	else
	call beam_data%init_sqrts (m(1), flv, smatrix, pol_f)
	end if
	if (present (rest_frame)) beam_data%lab_is_cm_frame = rest_frame
	end subroutine beam_data_init_decay

	@ %def beam_data_init_decay
	@
	\subsection{Sanity check}
	After the beams have been set, the initial-particle masses may have
	been modified. This can be checked here.
	<<Beams: beam data: TBP>>=
	procedure :: masses_are_consistent => beam_data_masses_are_consistent
	<<Beams: procedures>>=
	function beam_data_masses_are_consistent (beam_data) result (flag)
	logical :: flag
	class(beam_data_t), intent(in) :: beam_data
	flag = all (nearly_equal (beam_data%mass, beam_data%flv%get_mass ()))
	end function beam_data_masses_are_consistent

	@ %def beam_data_masses_are_consistent
	@
	\subsection{The beams type}
	Beam objects are interaction objects that contain the actual beam
	data including polarization and density matrix. For collisions, the
	beam object actually contains two beams.
	<<Beams: public>>=
	public :: beam_t
	<<Beams: types>>=
	type :: beam_t
	private
	type(interaction_t) :: int
	end type beam_t

	@ %def beam_t
	@ The constructor contains code that converts beam data into the
	(entangled) particle-pair quantum state. First, we set the number of
	particles and polarization mask. (The polarization mask is handed
	over to all later interactions, so if helicity is diagonal or absent, this fact
	is used when constructing the hard-interaction events.) Then, we
	construct the entangled state that combines helicity, flavor and color
	of the two particles (where flavor and color are unique, while several
	helicity states are possible). Then, we transfer this state together
	with the associated values from the spin density matrix into the
	[[interaction_t]] object.

	Calling the [[add_state]] method of the interaction object, we keep
	the entries of the helicity density matrix without adding them up.
	This ensures that for unpolarized states, we do not normalize but end
	up with an $1/N$ entry, where $N$ is the initial-state multiplicity.
	<<Beams: public>>=
	public :: beam_init
	<<Beams: procedures>>=
	subroutine beam_init (beam, beam_data)
	type(beam_t), intent(out) :: beam
	type(beam_data_t), intent(in), target :: beam_data
	logical, dimension(beam_data%n) :: polarized, diagonal
	type(quantum_numbers_mask_t), dimension(beam_data%n) :: mask, mask_d
	type(state_matrix_t), target :: state_hel, state_fc, state_tmp
	type(state_iterator_t) :: it_hel, it_tmp
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	complex(default) :: value
	real(default), parameter :: tolerance = 100 * epsilon (1._default)
	polarized = beam_data%pmatrix%is_polarized ()
	diagonal = beam_data%pmatrix%is_diagonal ()
	mask = quantum_numbers_mask (.false., .false., &
	mask_h = .not. polarized, &
	mask_hd = diagonal)
	mask_d = quantum_numbers_mask (.false., .false., .false., &
	mask_hd = polarized .and. diagonal)
	call beam%int%basic_init &
	(0, 0, beam_data%n, mask = mask, store_values = .true.)
	state_hel = beam_data%get_helicity_state_matrix ()
	allocate (qn (beam_data%n))
	call qn%init (beam_data%flv, color_from_flavor (beam_data%flv, 1))
	call state_fc%init ()
	call state_fc%add_state (qn)
	call merge_state_matrices (state_hel, state_fc, state_tmp)
	call it_hel%init (state_hel)
	call it_tmp%init (state_tmp)
	do while (it_hel%is_valid ())
	qn = it_tmp%get_quantum_numbers ()
	value = it_hel%get_matrix_element ()
	if (any (qn%are_redundant (mask_d))) then
	! skip off-diagonal elements for diagonal polarization
	else if (abs (value) <= tolerance) then
	! skip zero entries
	else
	call beam%int%add_state (qn, value = value)
	end if
	call it_hel%advance ()
	call it_tmp%advance ()
	end do
	call beam%int%freeze ()
	call beam%int%set_momenta (beam_data%p, outgoing = .true.)
	call state_hel%final ()
	call state_fc%final ()
	call state_tmp%final ()
	end subroutine beam_init

	@ %def beam_init
	@ Finalizer:
	<<Beams: public>>=
	public :: beam_final
	<<Beams: procedures>>=
	subroutine beam_final (beam)
	type(beam_t), intent(inout) :: beam
	call beam%int%final ()
	end subroutine beam_final

	@ %def beam_final
	@ I/O:
	<<Beams: public>>=
	public :: beam_write
	<<Beams: procedures>>=
	subroutine beam_write (beam, unit, verbose, show_momentum_sum, show_mass, col_verbose)
	type(beam_t), intent(in) :: beam
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, show_momentum_sum, show_mass
	logical, intent(in), optional :: col_verbose
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	select case (beam%int%get_n_out ())
	case (1); write (u, *) "Decaying particle:"
	case (2); write (u, *) "Colliding beams:"
	end select
	call beam%int%basic_write &
	(unit, verbose = verbose, show_momentum_sum = &
	show_momentum_sum, show_mass = show_mass, &
	col_verbose = col_verbose)
	end subroutine beam_write

	@ %def beam_write
	@ Defined assignment: deep copy
	<<Beams: public>>=
	public :: assignment(=)
	<<Beams: interfaces>>=
	interface assignment(=)
	module procedure beam_assign
	end interface

	<<Beams: procedures>>=
	subroutine beam_assign (beam_out, beam_in)
	type(beam_t), intent(out) :: beam_out
	type(beam_t), intent(in) :: beam_in
	beam_out%int = beam_in%int
	end subroutine beam_assign

	@ %def beam_assign
	@
	\subsection{Inherited procedures}
	<<Beams: public>>=
	public :: interaction_set_source_link
	<<Beams: interfaces>>=
	interface interaction_set_source_link
	module procedure interaction_set_source_link_beam
	end interface
	<<Beams: procedures>>=
	subroutine interaction_set_source_link_beam (int, i, beam1, i1)
	type(interaction_t), intent(inout) :: int
	type(beam_t), intent(in), target :: beam1
	integer, intent(in) :: i, i1
	call int%set_source_link (i, beam1%int, i1)
	end subroutine interaction_set_source_link_beam

	@ %def interaction_set_source_link_beam
	@
	\subsection{Accessing contents}
	Return the interaction component -- as a pointer, to avoid any copying.
	<<Beams: public>>=
	public :: beam_get_int_ptr
	<<Beams: procedures>>=
	function beam_get_int_ptr (beam) result (int)
	type(interaction_t), pointer :: int
	type(beam_t), intent(in), target :: beam
	int => beam%int
	end function beam_get_int_ptr

	@ %def beam_get_int_ptr
	@ Set beam momenta directly. (Used for cascade decays.)
	<<Beams: public>>=
	public :: beam_set_momenta
	<<Beams: procedures>>=
	subroutine beam_set_momenta (beam, p)
	type(beam_t), intent(inout) :: beam
	type(vector4_t), dimension(:), intent(in) :: p
	call beam%int%set_momenta (p)
	end subroutine beam_set_momenta

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

	module beams_ut
	use unit_tests
	use beams_uti

	<<Standard module head>>

	<<Beams: public test>>

	contains

	<<Beams: test driver>>

	end module beams_ut
	@ %def beams_ut
	@
	<<[[beams_uti.f90]]>>=
	<<File header>>

	module beams_uti

	<<Use kinds>>
	use lorentz
	use flavors
	use interactions, only: reset_interaction_counter
	use polarizations, only: smatrix_t
	use model_data
	use beam_structures

	use beams

	<<Standard module head>>

	<<Beams: test declarations>>

	contains

	<<Beams: tests>>

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

	@ %def beams_test
	@ Test the basic beam setup.
	<<Beams: execute tests>>=
	call test (beam_1, "beam_1", &
	"check basic beam setup", &
	u, results)
	<<Beams: test declarations>>=
	public :: beam_1
	<<Beams: tests>>=
	subroutine beam_1 (u)
	integer, intent(in) :: u
	type(beam_data_t), target :: beam_data
	type(beam_t) :: beam
	real(default) :: sqrts
	type(flavor_t), dimension(2) :: flv
	type(smatrix_t), dimension(2) :: smatrix
	real(default), dimension(2) :: pol_f
	type(model_data_t), target :: model

	write (u, "(A)") "* Test output: beam_1"
	write (u, "(A)") "* Purpose: test basic beam setup"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"
	write (u, "(A)")

	call reset_interaction_counter ()

	call model%init_sm_test ()

	write (u, "(A)") "* Unpolarized scattering, massless fermions"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([1,-1], model)

	call beam_data%init_sqrts (sqrts, flv)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized scattering, massless bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([22,22], model)

	call beam_data%init_sqrts (sqrts, flv)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized scattering, massive bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([24,-24], model)

	call beam_data%init_sqrts (sqrts, flv)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Polarized scattering, massless fermions"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([1,-1], model)

	call smatrix(1)%init (2, 1)
	call smatrix(1)%set_entry (1, [1,1], (1._default, 0._default))
	pol_f(1) = 0.5_default

	call smatrix(2)%init (2, 3)
	call smatrix(2)%set_entry (1, [1,1], (1._default, 0._default))
	call smatrix(2)%set_entry (2, [-1,-1], (1._default, 0._default))
	call smatrix(2)%set_entry (3, [-1,1], (1._default, 0._default))
	pol_f(2) = 1._default

	call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Semi-polarized scattering, massless bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([22,22], model)

	call smatrix(1)%init (2, 0)
	pol_f(1) = 0._default

	call smatrix(2)%init (2, 1)
	call smatrix(2)%set_entry (1, [1,1], (1._default, 0._default))
	pol_f(2) = 1._default

	call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Semi-polarized scattering, massive bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([24,-24], model)

	call smatrix(1)%init (2, 0)
	pol_f(1) = 0._default

	call smatrix(2)%init (2, 1)
	call smatrix(2)%set_entry (1, [0,0], (1._default, 0._default))
	pol_f(2) = 1._default

	call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized decay, massive boson"
	write (u, "(A)")

	call reset_interaction_counter ()
	call flv(1)%init (23, model)

	call beam_data%init_decay (flv(1:1))
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)

	write (u, "(A)")
	write (u, "(A)") "* Polarized decay, massive boson"
	write (u, "(A)")

	call reset_interaction_counter ()
	call flv(1)%init (23, model)
	call smatrix(1)%init (2, 1)
	call smatrix(1)%set_entry (1, [0,0], (1._default, 0._default))
	pol_f(1) = 0.4_default

	call beam_data%init_decay (flv(1:1), smatrix(1:1), pol_f(1:1))
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)

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

	call beam_final (beam)
	call beam_data%final ()

	call model%final ()

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

	end subroutine beam_1

	@ %def beam_1
	@ Test advanced beam setup.
	<<Beams: execute tests>>=
	call test (beam_2, "beam_2", &
	"beam initialization", &
	u, results)
	<<Beams: test declarations>>=
	public :: beam_2
	<<Beams: tests>>=
	subroutine beam_2 (u)
	integer, intent(in) :: u
	type(beam_data_t), target :: beam_data
	type(beam_t) :: beam
	real(default) :: sqrts
	type(flavor_t), dimension(2) :: flv
	integer, dimension(0) :: no_records
	type(beam_structure_t) :: beam_structure
	type(model_data_t), target :: model

	write (u, "(A)") "* Test output: beam_2"
	write (u, "(A)") "* Purpose: transfer beam polarization using &
	&beam structure"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"
	write (u, "(A)")

	call model%init_sm_test ()

	write (u, "(A)") "* Unpolarized scattering, massless fermions"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([1,-1], model)
	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%final_pol ()

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

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized scattering, massless bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([22,22], model)

	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%final_pol ()

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

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized scattering, massive bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([24,-24], model)

	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%final_pol ()

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

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Polarized scattering, massless fermions"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([1,-1], model)
	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%init_pol (2)

	call beam_structure%init_smatrix (1, 1)
	call beam_structure%set_sentry (1, 1, [1,1], (1._default, 0._default))

	call beam_structure%init_smatrix (2, 3)
	call beam_structure%set_sentry (2, 1, [1,1], (1._default, 0._default))
	call beam_structure%set_sentry (2, 2, [-1,-1], (1._default, 0._default))
	call beam_structure%set_sentry (2, 3, [-1,1], (1._default, 0._default))

	call beam_structure%set_pol_f ([0.5_default, 1._default])
	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)
	write (u, *)

	call beam_init (beam, beam_data)
	call beam_write (beam, u)

	call beam_final (beam)
	call beam_data%final ()
	call beam_structure%final_pol ()
	call beam_structure%final_sf ()

	write (u, "(A)")
	write (u, "(A)") "* Semi-polarized scattering, massless bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([22,22], model)

	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%init_pol (2)

	call beam_structure%init_smatrix (1, 0)

	call beam_structure%init_smatrix (2, 1)
	call beam_structure%set_sentry (2, 1, [1,1], (1._default, 0._default))

	call beam_structure%set_pol_f ([0._default, 1._default])
	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Semi-polarized scattering, massive bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([24,-24], model)

	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%init_pol (2)

	call beam_structure%init_smatrix (1, 0)

	call beam_structure%init_smatrix (2, 1)
	call beam_structure%set_sentry (2, 1, [0,0], (1._default, 0._default))
	call beam_structure%write (u)

	write (u, "(A)")
	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized decay, massive boson"
	write (u, "(A)")

	call reset_interaction_counter ()
	call flv(1)%init (23, model)

	call beam_structure%init_sf ([flv(1)%get_name ()], no_records)
	call beam_structure%final_pol ()
	call beam_structure%write (u)

	write (u, "(A)")
	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)

	write (u, "(A)")
	write (u, "(A)") "* Polarized decay, massive boson"
	write (u, "(A)")

	call reset_interaction_counter ()
	call flv(1)%init (23, model)
	call beam_structure%init_sf ([flv(1)%get_name ()], no_records)

	call beam_structure%init_pol (1)

	call beam_structure%init_smatrix (1, 1)
	call beam_structure%set_sentry (1, 1, [0,0], (1._default, 0._default))
	call beam_structure%set_pol_f ([0.4_default])
	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)

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

	call beam_final (beam)
	call beam_data%final ()

	call model%final ()

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

	end subroutine beam_2

	@ %def beam_2
	@ Test advanced beam setup, completely arbitrary momenta.
	<<Beams: execute tests>>=
	call test (beam_3, "beam_3", &
	"generic beam momenta", &
	u, results)
	<<Beams: test declarations>>=
	public :: beam_3
	<<Beams: tests>>=
	subroutine beam_3 (u)
	integer, intent(in) :: u
	type(beam_data_t), target :: beam_data
	type(beam_t) :: beam
	type(flavor_t), dimension(2) :: flv
	integer, dimension(0) :: no_records
	type(model_data_t), target :: model
	type(beam_structure_t) :: beam_structure
	type(vector3_t), dimension(2) :: p3
	type(vector4_t), dimension(2) :: p

	write (u, "(A)") "* Test output: beam_3"
	write (u, "(A)") "* Purpose: set up beams with generic momenta"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"
	write (u, "(A)")

	call reset_interaction_counter ()

	call model%init_sm_test ()

	write (u, "(A)") "* 1: Scattering process"
	write (u, "(A)")

	call flv%init ([2212,2212], model)

	p3(1) = vector3_moving ([5._default, 0._default, 10._default])
	p3(2) = -vector3_moving ([1._default, 1._default, -10._default])

	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%set_momentum (p3 ** 1)
	call beam_structure%set_theta (polar_angle (p3))
	call beam_structure%set_phi (azimuthal_angle (p3))
	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, 0._default, model)
	call pacify (beam_data%l_cm_to_lab, 1e-20_default)
	call beam_data%compute_md5sum ()
	call beam_data%write (u, verbose = .true.)
	write (u, *)

	write (u, "(1x,A)") "Beam momenta reconstructed from LT:"
	p = beam_data%L_cm_to_lab * beam_data%p_cm
	call pacify (p, 1e-12_default)
	call vector4_write (p(1), u)
	call vector4_write (p(2), u)
	write (u, "(A)")

	call beam_init (beam, beam_data)
	call beam_write (beam, u)

	call beam_final (beam)
	call beam_data%final ()
	call beam_structure%final_sf ()
	call beam_structure%final_mom ()

	write (u, "(A)")
	write (u, "(A)") "* 2: Decay"
	write (u, "(A)")

	call flv(1)%init (23, model)
	p3(1) = vector3_moving ([10._default, 5._default, 50._default])

	call beam_structure%init_sf ([flv(1)%get_name ()], no_records)
	call beam_structure%set_momentum ([p3(1) ** 1])
	call beam_structure%set_theta ([polar_angle (p3(1))])
	call beam_structure%set_phi ([azimuthal_angle (p3(1))])
	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, 0._default, model)
	call beam_data%write (u, verbose = .true.)
	write (u, "(A)")

	write (u, "(1x,A)") "Beam momentum reconstructed from LT:"
	p(1) = beam_data%L_cm_to_lab * beam_data%p_cm(1)
	call pacify (p(1), 1e-12_default)
	call vector4_write (p(1), u)
	write (u, "(A)")

	call beam_init (beam, beam_data)
	call beam_write (beam, u)

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

	call beam_final (beam)
	call beam_data%final ()
	call beam_structure%final_sf ()
	call beam_structure%final_mom ()

	call model%final ()

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

	end subroutine beam_3

	@ %def beam_3
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Tools}

	This module contains auxiliary procedures that can be accessed by the
	structure function code.

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

	module sf_aux

	<<Use kinds>>
	use io_units
	use constants, only: twopi
	use numeric_utils

	use lorentz

	<<Standard module head>>

	<<SF aux: public>>

	<<SF aux: parameters>>

	<<SF aux: types>>

	contains

	<<SF aux: procedures>>

	end module sf_aux

	@ %def sf_aux
	@
	\subsection{Momentum splitting}
	Let us consider first an incoming parton with momentum $k$ and
	invariant mass squared $s=k^2$ that splits into two partons with
	momenta $q,p$ and invariant masses $t=q^2$ and $u=p^2$. (This is an
	abuse of the Mandelstam notation. $t$ is actually the momentum
	transfer, assuming that $p$ is radiated and $q$ initiates the hard
	process.) The energy is split among the partons such that if $E=k^0$,
	we have $q^0 = xE$ and $p^0=\bar x E$, where $\bar x\equiv 1-x$.

	We define the angle $\theta$ as the polar angle of $p$ w.r.t.\ the
	momentum axis of the incoming momentum $k$. Ignoring azimuthal angle,
	we can write the four-momenta in the basis $(E,p_T,p_L)$ as
	\begin{equation}
	k =
	\begin{pmatrix}
	E \\ 0 \\ p
	\end{pmatrix},
	\qquad
	p =
	\begin{pmatrix}
	\bar x E \\ \bar x\bar p\sin\theta \\ \bar x\bar p\cos\theta
	\end{pmatrix},
	\qquad
	q =
	\begin{pmatrix}
	x E \\ -\bar x\bar p\sin\theta \\ p - \bar x\bar p\cos\theta
	\end{pmatrix},
	\end{equation}
	where the first two mass-shell conditions are
	\begin{equation}
	p^2 = E^2 - s,
	\qquad
	\bar p^2 = E^2 - \frac{u}{\bar x^2}.
	\end{equation}
	The second condition implies that, for positive $u$, $\bar x^2 >
	u/E^2$, or equivalently
	\begin{equation}
	x < 1 - \sqrt{u} / E.
	\end{equation}

	We are interested in the third mass-shell conditions: $s$ and $u$ are
	fixed, so we need $t$ as a function of $\cos\theta$:
	\begin{equation}
	t = -2\bar x \left(E^2 - p\bar p\cos\theta\right) + s + u.
	\end{equation}
	Solving for $\cos\theta$, we get
	\begin{equation}
	\cos\theta = \frac{2\bar x E^2 + t - s - u}{2\bar x p\bar p}.
	\end{equation}
	We can compute $\sin\theta$ numerically as
	$\sin^2\theta=1-\cos^2\theta$, but it is important to reexpress this
	in view of numerical stability. To this end, we first determine the
	bounds for $t$. The cosine must be between $-1$ and $1$, so the
	bounds are
	\begin{align}
	t_0 &= -2\bar x\left(E^2 + p\bar p\right) + s + u,
	\\
	t_1 &= -2\bar x\left(E^2 - p\bar p\right) + s + u.
	\end{align}
	Computing $\sin^2\theta$ from $\cos\theta$ above, we observe that the
	numerator is a quadratic polynomial in $t$ which has the zeros $t_0$
	and $t_1$, while the common denominator is given by $(2\bar x p\bar
	p)^2$. Hence, we can write
	\begin{equation}
	\sin^2\theta = -\frac{(t - t_0)(t - t_1)}{(2\bar x p\bar p)^2}
	\qquad\text{and}\qquad
	\cos\theta = \frac{(t-t_0) + (t-t_1)}{4\bar x p\bar p},
	\end{equation}
	which is free of large cancellations near $t=t_0$ or $t=t_1$.

	If all is massless, i.e., $s=u=0$, this simplifies to
	\begin{align}
	t_0 &= -4\bar x E^2,
	&
	t_1 &= 0,
	\\
	\sin^2\theta &= -\frac{t}{\bar x E^2}
	\left(1 + \frac{t}{4\bar x E^2}\right),
	&
	\cos\theta &= 1 + \frac{t}{2\bar x E^2}.
	\end{align}

	Here is the implementation. First, we define a container for the
	kinematical integration limits and some further data.

	Note: contents are public only for easy access in unit test.
	<<SF aux: public>>=
	public :: splitting_data_t
	<<SF aux: types>>=
	type :: splitting_data_t
	! private
	logical :: collinear = .false.
	real(default) :: x0 = 0
	real(default) :: x1
	real(default) :: t0
	real(default) :: t1
	real(default) :: phi0 = 0
	real(default) :: phi1 = twopi
	real(default) :: E, p, s, u, m2
	real(default) :: x, xb, pb
	real(default) :: t = 0
	real(default) :: phi = 0
	contains
	<<SF aux: splitting data: TBP>>
	end type splitting_data_t

	@ %def splitting_data_t
	@ I/O for debugging:
	<<SF aux: splitting data: TBP>>=
	procedure :: write => splitting_data_write
	<<SF aux: procedures>>=
	subroutine splitting_data_write (d, unit)
	class(splitting_data_t), intent(in) :: d
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A)") "Splitting data:"
	write (u, "(2x,A,L1)") "collinear = ", d%collinear
	1 format (2x,A,1x,ES15.8)
	write (u, 1) "x0 =", d%x0
	write (u, 1) "x =", d%x
	write (u, 1) "xb =", d%xb
	write (u, 1) "x1 =", d%x1
	write (u, 1) "t0 =", d%t0
	write (u, 1) "t =", d%t
	write (u, 1) "t1 =", d%t1
	write (u, 1) "phi0 =", d%phi0
	write (u, 1) "phi =", d%phi
	write (u, 1) "phi1 =", d%phi1
	write (u, 1) "E =", d%E
	write (u, 1) "p =", d%p
	write (u, 1) "pb =", d%pb
	write (u, 1) "s =", d%s
	write (u, 1) "u =", d%u
	write (u, 1) "m2 =", d%m2
	end subroutine splitting_data_write

	@ %def splitting_data_write
	@
	\subsection{Constant data}
	This is the initializer for the data. The input consists of the
	incoming momentum, its invariant mass squared, and the invariant mass
	squared of the radiated particle. $m2$ is the \emph{physical} mass
	squared of the outgoing particle. The $t$ bounds depend on the chosen $x$
	value and cannot be determined yet.
	<<SF aux: splitting data: TBP>>=
	procedure :: init => splitting_data_init
	<<SF aux: procedures>>=
	subroutine splitting_data_init (d, k, mk2, mr2, mo2, collinear)
	class(splitting_data_t), intent(out) :: d
	type(vector4_t), intent(in) :: k
	real(default), intent(in) :: mk2, mr2, mo2
	logical, intent(in), optional :: collinear
	if (present (collinear)) d%collinear = collinear
	d%E = energy (k)
	d%x1 = 1 - sqrt (max (mr2, 0._default)) / d%E
	d%p = sqrt (d%E**2 - mk2)
	d%s = mk2
	d%u = mr2
	d%m2 = mo2
	end subroutine splitting_data_init

	@ %def splitting_data_init
	@ Retrieve the $x$ bounds, if needed for $x$ sampling. Generating an
	$x$ value is done by the caller, since this is the part that depends
	on the nature of the structure function.
	<<SF aux: splitting data: TBP>>=
	procedure :: get_x_bounds => splitting_get_x_bounds
	<<SF aux: procedures>>=
	function splitting_get_x_bounds (d) result (x)
	class(splitting_data_t), intent(in) :: d
	real(default), dimension(2) :: x
	x = [ d%x0, d%x1 ]
	end function splitting_get_x_bounds

	@ %def splitting_get_x_bounds
	@ Now set the momentum fraction and compute $t_0$ and $t_1$.

	[The calculation of $t_1$ is subject to numerical problems. The exact
	formula is ($s=m_i^2$, $u=m_r^2$)
	\begin{equation}
	t_1 = -2\bar x E^2 + m_i^2 + m_r^2
	+ 2\bar x \sqrt{E^2-m_i^2}\,\sqrt{E^2 - m_r^2/\bar x^2}.
	\end{equation}
	The structure-function paradigm is useful only if $E\gg m_i,m_r$. In
	a Taylor expansion for large $E$, the leading term cancels. The
	expansion of the square roots (to subleading order) yields
	\begin{equation}
	t_1 = xm_i^2 - \frac{x}{\bar x}m_r^2.
	\end{equation}
	There are two cases of interest: $m_i=m_o$ and $m_r=0$,
	\begin{equation}
	t_1 = xm_o^2
	\end{equation}
	and $m_i=m_r$ and $m_o=0$,
	\begin{equation}
	t_1 = -\frac{x^2}{\bar x}m_i^2.
	\end{equation}
	In both cases, $t_1\leq m_o^2$.]

	That said, it turns out that taking the $t_1$ evaluation at face value
	leads to less problems than the approximation. We express the angles
	in terms of $t-t_0$ and $t-t_1$. Numerical noise in $t_1$ can then be
	tolerated.
	<<SF aux: splitting data: TBP>>=
	procedure :: set_t_bounds => splitting_set_t_bounds
	<<SF aux: procedures>>=
	elemental subroutine splitting_set_t_bounds (d, x, xb)
	class(splitting_data_t), intent(inout) :: d
	real(default), intent(in), optional :: x, xb
	real(default) :: tp, tm
	if (present (x)) d%x = x
	if (present (xb)) d%xb = xb
	if (vanishes (d%u)) then
	d%pb = d%E
	else
	if (.not. vanishes (d%xb)) then
	d%pb = sqrt (max (d%E2 - d%u / d%xb2, 0._default))
	else
	d%pb = 0
	end if
	end if
	tp = -2 * d%xb * d%E**2 + d%s + d%u
	tm = -2 * d%xb * d%p * d%pb
	d%t0 = tp + tm
	d%t1 = tp - tm
	d%t = d%t1
	end subroutine splitting_set_t_bounds

	@ %def splitting_set_t_bounds
	@
	\subsection{Sampling recoil}
	Compute a value for the momentum transfer $t$, using a random number
	$r$. We assume a logarithmic distribution for $t-m^2$, corresponding
	to the propagator $1/(t-m^2)$ with the physical mass $m$ for the
	outgoing particle. Optionally, we can narrow the kinematical bounds.

	If all three masses in the splitting vanish, the upper limit for $t$
	is zero. In that case, the $t$ value is set to zero and the splitting
	will be collinear.
	<<SF aux: splitting data: TBP>>=
	procedure :: sample_t => splitting_sample_t
	<<SF aux: procedures>>=
	subroutine splitting_sample_t (d, r, t0, t1)
	class(splitting_data_t), intent(inout) :: d
	real(default), intent(in) :: r
	real(default), intent(in), optional :: t0, t1
	real(default) :: tt0, tt1, tt0m, tt1m
	if (d%collinear) then
	d%t = d%t1
	else
	tt0 = d%t0; if (present (t0)) tt0 = max (t0, tt0)
	tt1 = d%t1; if (present (t1)) tt1 = min (t1, tt1)
	tt0m = tt0 - d%m2
	tt1m = tt1 - d%m2
	if (tt0m < 0 .and. tt1m < 0 .and. abs(tt0m) > &
	epsilon(tt0m) .and. abs(tt1m) > epsilon(tt0m)) then
	d%t = d%m2 + tt0m * exp (r * log (tt1m / tt0m))
	else
	d%t = tt1
	end if
	end if
	end subroutine splitting_sample_t

	@ %def splitting_sample_t
	@ The inverse operation: Given $t$, we recover the value of $r$ that
	would have produced this value.
	<<SF aux: splitting data: TBP>>=
	procedure :: inverse_t => splitting_inverse_t
	<<SF aux: procedures>>=
	subroutine splitting_inverse_t (d, r, t0, t1)
	class(splitting_data_t), intent(in) :: d
	real(default), intent(out) :: r
	real(default), intent(in), optional :: t0, t1
	real(default) :: tt0, tt1, tt0m, tt1m
	if (d%collinear) then
	r = 0
	else
	tt0 = d%t0; if (present (t0)) tt0 = max (t0, tt0)
	tt1 = d%t1; if (present (t1)) tt1 = min (t1, tt1)
	tt0m = tt0 - d%m2
	tt1m = tt1 - d%m2
	if (tt0m < 0 .and. tt1m < 0) then
	r = log ((d%t - d%m2) / tt0m) / log (tt1m / tt0m)
	else
	r = 0
	end if
	end if
	end subroutine splitting_inverse_t

	@ %def splitting_inverse_t
	@ This is trivial, but provided for convenience:
	<<SF aux: splitting data: TBP>>=
	procedure :: sample_phi => splitting_sample_phi
	<<SF aux: procedures>>=
	subroutine splitting_sample_phi (d, r)
	class(splitting_data_t), intent(inout) :: d
	real(default), intent(in) :: r
	if (d%collinear) then
	d%phi = 0
	else
	d%phi = (1-r) * d%phi0 + r * d%phi1
	end if
	end subroutine splitting_sample_phi

	@ %def splitting_sample_phi
	@ Inverse:
	<<SF aux: splitting data: TBP>>=
	procedure :: inverse_phi => splitting_inverse_phi
	<<SF aux: procedures>>=
	subroutine splitting_inverse_phi (d, r)
	class(splitting_data_t), intent(in) :: d
	real(default), intent(out) :: r
	if (d%collinear) then
	r = 0
	else
	r = (d%phi - d%phi0) / (d%phi1 - d%phi0)
	end if
	end subroutine splitting_inverse_phi

	@ %def splitting_inverse_phi
	@
	\subsection{Splitting}
	In this function, we actually perform the splitting. The incoming momentum
	$k$ is split into (if no recoil) $q_1=(1-x)k$ and $q_2=xk$.

	Apart from the splitting data, we need the incoming momentum $k$, the momentum
	transfer $t$, and the azimuthal angle $\phi$. The momentum fraction $x$ is
	already known here.

	Alternatively, we can split without recoil. The azimuthal angle is
	irrelevant, and the momentum transfer is always equal to the upper
	limit $t_1$, so the polar angle is zero. Obviously, if there are
	nonzero masses it is not possible to keep both energy-momentum
	conservation and at the same time all particles on shell. We choose
	for dropping the on-shell condition here.
	<<SF aux: splitting data: TBP>>=
	procedure :: split_momentum => splitting_split_momentum
	<<SF aux: procedures>>=
	function splitting_split_momentum (d, k) result (q)
	class(splitting_data_t), intent(in) :: d
	type(vector4_t), dimension(2) :: q
	type(vector4_t), intent(in) :: k
	real(default) :: st2, ct2, st, ct, cp, sp
	type(lorentz_transformation_t) :: rot
	real(default) :: tt0, tt1, den
	type(vector3_t) :: kk, q1, q2
	if (d%collinear) then
	if (vanishes (d%s) .and. vanishes(d%u)) then
	q(1) = d%xb * k
	q(2) = d%x * k
	else
	kk = space_part (k)
	q1 = d%xb * (d%pb / d%p) * kk
	q2 = kk - q1
	q(1) = vector4_moving (d%xb * d%E, q1)
	q(2) = vector4_moving (d%x * d%E, q2)
	end if
	else
	den = 2 * d%xb * d%p * d%pb
	tt0 = max (d%t - d%t0, 0._default)
	tt1 = min (d%t - d%t1, 0._default)
	if (den**2 <= epsilon(den)) then
	st2 = 0
	else
	st2 = - (tt0 * tt1) / den ** 2
	end if
	if (st2 > 1) then
	st2 = 1
	end if
	ct2 = 1 - st2
	st = sqrt (max (st2, 0._default))
	ct = sqrt (max (ct2, 0._default))
	if ((d%t - d%t0 + d%t - d%t1) < 0) then
	ct = - ct
	end if
	sp = sin (d%phi)
	cp = cos (d%phi)
	rot = rotation_to_2nd (3, space_part (k))
	q1 = vector3_moving (d%xb * d%pb * [st * cp, st * sp, ct])
	q2 = vector3_moving (d%p, 3) - q1
	q(1) = rot * vector4_moving (d%xb * d%E, q1)
	q(2) = rot * vector4_moving (d%x * d%E, q2)
	end if
	end function splitting_split_momentum

	@ %def splitting_split_momentum
	@
	Momenta generated by splitting will in general be off-shell. They are
	on-shell only if they are collinear and massless. This subroutine
	puts them on shell by brute force, violating either momentum or energy
	conservation. The direction of three-momentum is always retained.

	If the energy is below mass shell, we return a zero momentum.
	<<SF aux: parameters>>=
	integer, parameter, public :: KEEP_ENERGY = 0, KEEP_MOMENTUM = 1
	@ %def KEEP_ENERGY KEEP_MOMENTUM
	<<SF aux: public>>=
	public :: on_shell
	<<SF aux: procedures>>=
	elemental subroutine on_shell (p, m2, keep)
	type(vector4_t), intent(inout) :: p
	real(default), intent(in) :: m2
	integer, intent(in) :: keep
	real(default) :: E, E2, pn
	select case (keep)
	case (KEEP_ENERGY)
	E = energy (p)
	E2 = E ** 2
	if (E2 >= m2) then
	pn = sqrt (E2 - m2)
	p = vector4_moving (E, pn * direction (space_part (p)))
	else
	p = vector4_null
	end if
	case (KEEP_MOMENTUM)
	E = sqrt (space_part (p) ** 2 + m2)
	p = vector4_moving (E, space_part (p))
	end select
	end subroutine on_shell

	@ %def on_shell
	@
	\subsection{Recovering the splitting}
	This is the inverse problem. We have on-shell momenta and want to
	deduce the splitting parameters $x$, $t$, and $\phi$.

	Update 2018-08-22: As a true inverse to [[splitting_split_momentum]], we now use
	not just a single momentum [[q2]] as before, but the momentum pair [[q1]], [[q2]]
	for recovering $x$ and $\bar x$ separately. If $x$ happens to be
	close to $1$, we would completely lose the tiny $\bar x$ value,
	otherwise, and thus get a meaningless result.
	<<SF aux: splitting data: TBP>>=
	procedure :: recover => splitting_recover
	<<SF aux: procedures>>=
	subroutine splitting_recover (d, k, q, keep)
	class(splitting_data_t), intent(inout) :: d
	type(vector4_t), intent(in) :: k
	type(vector4_t), dimension(2), intent(in) :: q
	integer, intent(in) :: keep
	type(lorentz_transformation_t) :: rot
	type(vector4_t) :: k0
	type(vector4_t), dimension(2) :: q0
	real(default) :: p1, p2, p3, pt2, pp2, pl
	real(default) :: aux, den, norm
	real(default) :: st2, ct2, ct
	rot = inverse (rotation_to_2nd (3, space_part (k)))
	q0 = rot * q
	p1 = vector4_get_component (q0(2), 1)
	p2 = vector4_get_component (q0(2), 2)
	p3 = vector4_get_component (q0(2), 3)
	pt2 = p1 2 + p2 2
	pp2 = p1 2 + p2 2 + p3 ** 2
	pl = abs (p3)
	k0 = vector4_moving (d%E, d%p, 3)
	select case (keep)
	case (KEEP_ENERGY)
	d%x = energy (q0(2)) / d%E
	d%xb = energy (q0(1)) / d%E
	call d%set_t_bounds ()
	if (.not. d%collinear) then
	aux = (d%xb * d%pb) ** 2 * pp2 - d%p ** 2 * pt2
	den = d%p ** 2 - (d%xb * d%pb) ** 2
	if (aux >= 0 .and. den > 0) then
	norm = (d%p * pl + sqrt (aux)) / den
	else
	norm = 1
	end if
	end if
	case (KEEP_MOMENTUM)
	d%xb = sqrt (space_part (q0(1)) ** 2 + d%u) / d%E
	d%x = 1 - d%xb
	call d%set_t_bounds ()
	norm = 1
	end select
	if (d%collinear) then
	d%t = d%t1
	d%phi = 0
	else
	if ((d%xb * d%pb * norm)**2 < epsilon(d%xb)) then
	st2 = 1
	else
	st2 = pt2 / (d%xb * d%pb * norm ) ** 2
	end if
	if (st2 > 1) then
	st2 = 1
	end if
	ct2 = 1 - st2
	ct = sqrt (max (ct2, 0._default))
	if (.not. vanishes (1 + ct)) then
	d%t = d%t1 - 2 * d%xb * d%p * d%pb * st2 / (1 + ct)
	else
	d%t = d%t0
	end if
	if (.not. vanishes (p1) .or. .not. vanishes (p2)) then
	d%phi = atan2 (-p2, -p1)
	else
	d%phi = 0
	end if
	end if
	end subroutine splitting_recover

	@ %def splitting_recover
	@
	\subsection{Extract data}
	<<SF aux: splitting data: TBP>>=
	procedure :: get_x => splitting_get_x
	procedure :: get_xb => splitting_get_xb
	<<SF aux: procedures>>=
	function splitting_get_x (sd) result (x)
	class(splitting_data_t), intent(in) :: sd
	real(default) :: x
	x = sd%x
	end function splitting_get_x

	function splitting_get_xb (sd) result (xb)
	class(splitting_data_t), intent(in) :: sd
	real(default) :: xb
	xb = sd%xb
	end function splitting_get_xb

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

	module sf_aux_ut
	use unit_tests
	use sf_aux_uti

	<<Standard module head>>

	<<SF aux: public test>>

	contains

	<<SF aux: test driver>>

	end module sf_aux_ut
	@ %def sf_aux_ut
	@
	<<[[sf_aux_uti.f90]]>>=
	<<File header>>

	module sf_aux_uti

	<<Use kinds>>
	use lorentz

	use sf_aux

	<<Standard module head>>

	<<SF aux: test declarations>>

	contains

	<<SF aux: tests>>

	end module sf_aux_uti
	@ %def sf_aux_ut
	@ API: driver for the unit tests below.
	<<SF aux: public test>>=
	public :: sf_aux_test
	<<SF aux: test driver>>=
	subroutine sf_aux_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF aux: execute tests>>
	end subroutine sf_aux_test

	@ %def sf_aux_test
	@
	\subsubsection{Momentum splitting: massless radiation}
	Compute momentum splitting for generic kinematics. It turns out that
	for $x=0.5$, where $t-m^2$ is the geometric mean between its upper and
	lower bounds (this can be directly seen from the logarithmic
	distribution in the function [[sample_t]] for $r \equiv x = 1 - x =
	0.5$), we arrive at an exact number $t=-0.15$ for the given
	input values.
	<<SF aux: execute tests>>=
	call test (sf_aux_1, "sf_aux_1", &
	"massless radiation", &
	u, results)
	<<SF aux: test declarations>>=
	public :: sf_aux_1
	<<SF aux: tests>>=
	subroutine sf_aux_1 (u)
	integer, intent(in) :: u
	type(splitting_data_t) :: sd
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q, q0
	real(default) :: E, mk, mp, mq
	real(default) :: x, r1, r2, r1o, r2o
	real(default) :: k2, q0_2, q1_2, q2_2

	write (u, "(A)") "* Test output: sf_aux_1"
	write (u, "(A)") "* Purpose: compute momentum splitting"
	write (u, "(A)") " (massless radiated particle)"
	write (u, "(A)")

	E = 1
	mk = 0.3_default
	mp = 0
	mq = mk

	k = vector4_moving (E, sqrt (E2 - mk2), 3)
	k2 = k ** 2; call pacify (k2, 1e-10_default)

	x = 0.6_default
	r1 = 0.5_default
	r2 = 0.125_default

	write (u, "(A)") "* (1) Non-collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%sample_t (r1)
	call sd%sample_phi (r2)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "Extract: x, 1-x"
	write (u, "(2(1x,F11.8))") sd%get_x (), sd%get_xb ()

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q0_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t


	call sd%inverse_t (r1o)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q0_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	call sd%inverse_t (r1o)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (2) Collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, 1 - x)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q0_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q0_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

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

	end subroutine sf_aux_1

	@ %def sf_aux_1
	@
	\subsubsection{Momentum splitting: massless parton}
	Compute momentum splitting for generic kinematics. It turns out that
	for $x=0.5$, where $t-m^2$ is the geometric mean between its upper and
	lower bounds, we arrive at an exact number $t=-0.36$ for the given
	input values.
	<<SF aux: execute tests>>=
	call test (sf_aux_2, "sf_aux_2", &
	"massless parton", &
	u, results)
	<<SF aux: test declarations>>=
	public :: sf_aux_2
	<<SF aux: tests>>=
	subroutine sf_aux_2 (u)
	integer, intent(in) :: u
	type(splitting_data_t) :: sd
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q, q0
	real(default) :: E, mk, mp, mq
	real(default) :: x, r1, r2, r1o, r2o
	real(default) :: k2, q02_2, q1_2, q2_2

	write (u, "(A)") "* Test output: sf_aux_2"
	write (u, "(A)") "* Purpose: compute momentum splitting"
	write (u, "(A)") " (massless outgoing particle)"
	write (u, "(A)")

	E = 1
	mk = 0.3_default
	mp = mk
	mq = 0

	k = vector4_moving (E, sqrt (E2 - mk2), 3)
	k2 = k ** 2; call pacify (k2, 1e-10_default)

	x = 0.6_default
	r1 = 0.5_default
	r2 = 0.125_default

	write (u, "(A)") "* (1) Non-collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%sample_t (r1)
	call sd%sample_phi (r2)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t


	call sd%inverse_t (r1o)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	call sd%inverse_t (r1o)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (2) Collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, 1 - x)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

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

	end subroutine sf_aux_2

	@ %def sf_aux_2
	@
	\subsubsection{Momentum splitting: all massless}
	Compute momentum splitting for massless kinematics. In the non-collinear
	case, we need a lower cutoff for $\|t\|$, otherwise a logarithmic distribution
	is not possible.
	<<SF aux: execute tests>>=
	call test (sf_aux_3, "sf_aux_3", &
	"massless parton", &
	u, results)
	<<SF aux: test declarations>>=
	public :: sf_aux_3
	<<SF aux: tests>>=
	subroutine sf_aux_3 (u)
	integer, intent(in) :: u
	type(splitting_data_t) :: sd
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q, q0
	real(default) :: E, mk, mp, mq, qmin, qmax
	real(default) :: x, r1, r2, r1o, r2o
	real(default) :: k2, q02_2, q1_2, q2_2

	write (u, "(A)") "* Test output: sf_aux_3"
	write (u, "(A)") "* Purpose: compute momentum splitting"
	write (u, "(A)") " (all massless, q cuts)"
	write (u, "(A)")

	E = 1
	mk = 0
	mp = 0
	mq = 0
	qmin = 1e-2_default
	qmax = 1e0_default

	k = vector4_moving (E, sqrt (E2 - mk2), 3)
	k2 = k ** 2; call pacify (k2, 1e-10_default)

	x = 0.6_default
	r1 = 0.5_default
	r2 = 0.125_default

	write (u, "(A)") "* (1) Non-collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%sample_t (r1, t1 = - qmin 2, t0 = - qmax 2)
	call sd%sample_phi (r2)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t


	call sd%inverse_t (r1o, t1 = - qmin 2, t0 = - qmax 2)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	call sd%inverse_t (r1o, t1 = - qmin 2, t0 = - qmax 2)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (2) Collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, 1 - x)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

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

	end subroutine sf_aux_3

	@ %def sf_aux_3
	@
	\subsubsection{Endpoint stability}
	Compute momentum splitting for collinear kinematics close to both
	endpoints. In particular, check both directions $x\to$ momenta and
	momenta $\to x$.

	For purely massless collinear splitting, the [[KEEP_XXX]] flag is
	irrelevant. We choose [[KEEP_ENERGY]] here.
	<<SF aux: execute tests>>=
	call test (sf_aux_4, "sf_aux_4", &
	"endpoint numerics", &
	u, results)
	<<SF aux: test declarations>>=
	public :: sf_aux_4
	<<SF aux: tests>>=
	subroutine sf_aux_4 (u)
	integer, intent(in) :: u
	type(splitting_data_t) :: sd
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E, mk, mp, mq, qmin, qmax
	real(default) :: x, xb

	write (u, "(A)") "* Test output: sf_aux_4"
	write (u, "(A)") "* Purpose: compute massless collinear splitting near endpoint"

	E = 1
	mk = 0
	mp = 0
	mq = 0
	qmin = 1e-2_default
	qmax = 1e0_default

	k = vector4_moving (E, sqrt (E2 - mk2), 3)

	x = 0.1_default
	xb = 1 - x

	write (u, "(A)")
	write (u, "(A)") "* (1) Collinear setup, moderate kinematics"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)

	call sd%write (u)

	q = sd%split_momentum (k)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momenta"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)
	call sd%recover (k, q, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") xb, sd%xb

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (2) Close to x=0"
	write (u, "(A)")

	x = 1e-9_default
	xb = 1 - x

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)

	call sd%write (u)

	q = sd%split_momentum (k)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momenta"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)
	call sd%recover (k, q, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") xb, sd%xb

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (3) Close to x=1"
	write (u, "(A)")

	xb = 1e-9_default
	x = 1 - xb

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)

	call sd%write (u)

	q = sd%split_momentum (k)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momenta"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)
	call sd%recover (k, q, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") xb, sd%xb

	write (u, "(A)")
	call sd%write (u)

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

	end subroutine sf_aux_4

	@ %def sf_aux_4
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Mappings for structure functions}
	In this module, we provide a wrapper for useful mappings of the unit
	(hyper-)square that we can apply to a set of structure functions.

	In some cases it is useful, or even mandatory, to map the MC input
	parameters nontrivially onto a set of structure functions for the two
	beams. In all cases considered here, instead of $x_1,x_2,\ldots$ as
	parameters for the beams, we generate one parameter that is equal, or
	related to, the product $x_1x_2\cdots$ (so it directly corresponds to
	$\sqrt{s}$). The other parameters describe the distribution of energy
	(loss) between beams and radiations.
	<<[[sf_mappings.f90]]>>=
	<<File header>>

	module sf_mappings

	<<Use kinds>>
	use kinds, only: double
	use io_units
	use constants, only: pi, zero, one
	use numeric_utils
	use diagnostics

	<<Standard module head>>

	<<SF mappings: public>>

	<<SF mappings: parameters>>

	<<SF mappings: types>>

	<<SF mappings: interfaces>>

	contains

	<<SF mappings: procedures>>

	end module sf_mappings
	@ %def sf_mappings
	@
	\subsection{Base type}
	First, we define an abstract base type for the mapping. In all cases
	we need to store the indices of the parameters on which the mapping
	applies. Additional parameters can be stored in the extensions of
	this type.
	<<SF mappings: public>>=
	public :: sf_mapping_t
	<<SF mappings: types>>=
	type, abstract :: sf_mapping_t
	integer, dimension(:), allocatable :: i
	contains
	<<SF mappings: sf mapping: TBP>>
	end type sf_mapping_t

	@ %def sf_mapping_t
	@ The output routine is deferred:
	<<SF mappings: sf mapping: TBP>>=
	procedure (sf_mapping_write), deferred :: write
	<<SF mappings: interfaces>>=
	abstract interface
	subroutine sf_mapping_write (object, unit)
	import
	class(sf_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_mapping_write
	end interface

	@ %def sf_mapping_write
	@ Initializer for the base type. The array of parameter indices is
	allocated but initialized to zero.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: base_init => sf_mapping_base_init
	<<SF mappings: procedures>>=
	subroutine sf_mapping_base_init (mapping, n_par)
	class(sf_mapping_t), intent(out) :: mapping
	integer, intent(in) :: n_par
	allocate (mapping%i (n_par))
	mapping%i = 0
	end subroutine sf_mapping_base_init

	@ %def sf_mapping_base_init
	@ Set an index value.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: set_index => sf_mapping_set_index
	<<SF mappings: procedures>>=
	subroutine sf_mapping_set_index (mapping, j, i)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	mapping%i(j) = i
	end subroutine sf_mapping_set_index

	@ %def sf_mapping_set_index
	@ Retrieve an index value.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: get_index => sf_mapping_get_index
	<<SF mappings: procedures>>=
	function sf_mapping_get_index (mapping, j) result (i)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j
	integer :: i
	i = mapping%i(j)
	end function sf_mapping_get_index

	@ %def sf_mapping_get_index
	@ Return the dimensionality, i.e., the number of parameters.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: get_n_dim => sf_mapping_get_n_dim
	<<SF mappings: procedures>>=
	function sf_mapping_get_n_dim (mapping) result (n)
	class(sf_mapping_t), intent(in) :: mapping
	integer :: n
	n = size (mapping%i)
	end function sf_mapping_get_n_dim

	@ %def sf_mapping_get_n_dim
	@ Computation: the values [[p]] are the input parameters, the values
	[[r]] are the output parameters. The values [[rb]] are defined as
	$\bar r = 1 - r$, but provided explicitly. They allow us to avoid
	numerical problems near $r=1$.

	The extra parameter [[x_free]]
	indicates that the total energy has already been renormalized by this
	factor. We have to take such a factor into account in a resonance or
	on-shell mapping.

	The Jacobian is [[f]]. We modify only
	the two parameters indicated by the indices [[i]].
	<<SF mappings: sf mapping: TBP>>=
	procedure (sf_mapping_compute), deferred :: compute
	<<SF mappings: interfaces>>=
	abstract interface
	subroutine sf_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	import
	class(sf_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_mapping_compute
	end interface

	@ %def sf_mapping_compute
	@ The inverse mapping. Use [[r]] and/or [[rb]] to reconstruct [[p]]
	and also compute [[f]].
	<<SF mappings: sf mapping: TBP>>=
	procedure (sf_mapping_inverse), deferred :: inverse
	<<SF mappings: interfaces>>=
	abstract interface
	subroutine sf_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	import
	class(sf_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_mapping_inverse
	end interface

	@ %def sf_mapping_inverse
	@
	\subsection{Methods for self-tests}
	This is a shorthand for: inject parameters, compute the mapping,
	display results, compute the inverse, display again. We provide an
	output format for the parameters and, optionally, a different output
	format for the Jacobians.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: check => sf_mapping_check
	<<SF mappings: procedures>>=
	subroutine sf_mapping_check (mapping, u, p_in, pb_in, fmt_p, fmt_f)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: u
	real(default), dimension(:), intent(in) :: p_in, pb_in
	character(*), intent(in) :: fmt_p
	character(*), intent(in), optional :: fmt_f
	real(default), dimension(size(p_in)) :: p, pb, r, rb
	real(default) :: f, tolerance
	tolerance = 1.5E-17
	p = p_in
	pb= pb_in
	call mapping%compute (r, rb, f, p, pb)
	call pacify (p, tolerance)
	call pacify (pb, tolerance)
	call pacify (r, tolerance)
	call pacify (rb, tolerance)
	write (u, "(3x,A,9(1x," // fmt_p // "))") "p =", p
	write (u, "(3x,A,9(1x," // fmt_p // "))") "pb=", pb
	write (u, "(3x,A,9(1x," // fmt_p // "))") "r =", r
	write (u, "(3x,A,9(1x," // fmt_p // "))") "rb=", rb
	if (present (fmt_f)) then
	write (u, "(3x,A,9(1x," // fmt_f // "))") "f =", f
	else
	write (u, "(3x,A,9(1x," // fmt_p // "))") "f =", f
	end if
	write (u, *)
	call mapping%inverse (r, rb, f, p, pb)
	call pacify (p, tolerance)
	call pacify (pb, tolerance)
	call pacify (r, tolerance)
	call pacify (rb, tolerance)
	write (u, "(3x,A,9(1x," // fmt_p // "))") "p =", p
	write (u, "(3x,A,9(1x," // fmt_p // "))") "pb=", pb
	write (u, "(3x,A,9(1x," // fmt_p // "))") "r =", r
	write (u, "(3x,A,9(1x," // fmt_p // "))") "rb=", rb
	if (present (fmt_f)) then
	write (u, "(3x,A,9(1x," // fmt_f // "))") "f =", f
	else
	write (u, "(3x,A,9(1x," // fmt_p // "))") "f =", f
	end if
	write (u, *)
	write (u, "(3x,A,9(1x," // fmt_p // "))") "*r=", product (r)
	end subroutine sf_mapping_check

	@ %def sf_mapping_check
	@ This is a consistency check for the self-tests: the integral over the unit
	square should be unity. We estimate this by a simple binning and adding up
	the values; this should be sufficient for a self-test.

	The argument is the requested number of sampling points. We take the square
	root for binning in both dimensions, so the precise number might be
	different.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: integral => sf_mapping_integral
	<<SF mappings: procedures>>=
	function sf_mapping_integral (mapping, n_calls) result (integral)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: n_calls
	real(default) :: integral
	integer :: n_dim, n_bin, k
	real(default), dimension(:), allocatable :: p, pb, r, rb
	integer, dimension(:), allocatable :: ii
	real(default) :: dx, f, s

	n_dim = mapping%get_n_dim ()
	allocate (p (n_dim))
	allocate (pb(n_dim))
	allocate (r (n_dim))
	allocate (rb(n_dim))
	allocate (ii(n_dim))
	n_bin = nint (real (n_calls, default) ** (1._default / n_dim))
	dx = 1._default / n_bin
	s = 0
	ii = 1

	SAMPLE: do
	do k = 1, n_dim
	p(k) = ii(k) * dx - dx/2
	pb(k) = (n_bin - ii(k)) * dx + dx/2
	end do
	call mapping%compute (r, rb, f, p, pb)
	s = s + f
	INCR: do k = 1, n_dim
	ii(k) = ii(k) + 1
	if (ii(k) <= n_bin) then
	exit INCR
	else if (k < n_dim) then
	ii(k) = 1
	else
	exit SAMPLE
	end if
	end do INCR
	end do SAMPLE

	integral = s / real (n_bin, default) ** n_dim

	end function sf_mapping_integral

	@ %def sf_mapping_integral
	@
	\subsection{Implementation: standard mapping}
	This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
	while $p_2$ is related to the ratio.
	<<SF mappings: public>>=
	public :: sf_s_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_s_mapping_t
	logical :: power_set = .false.
	real(default) :: power = 1
	contains
	<<SF mappings: sf standard mapping: TBP>>
	end type sf_s_mapping_t

	@ %def sf_s_mapping_t
	@ Output.
	<<SF mappings: sf standard mapping: TBP>>=
	procedure :: write => sf_s_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_s_mapping_write (object, unit)
	class(sf_s_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A)") ": standard (", object%power, ")"
	end subroutine sf_s_mapping_write

	@ %def sf_s_mapping_write
	@ Initialize: index pair and power parameter.
	<<SF mappings: sf standard mapping: TBP>>=
	procedure :: init => sf_s_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_s_mapping_init (mapping, power)
	class(sf_s_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: power
	call mapping%base_init (2)
	if (present (power)) then
	mapping%power_set = .true.
	mapping%power = power
	end if
	end subroutine sf_s_mapping_init

	@ %def sf_s_mapping_init
	@ Apply mapping.
	<<SF mappings: sf standard mapping: TBP>>=
	procedure :: compute => sf_s_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_s_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_s_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2
	integer :: j
	if (mapping%power_set) then
	call map_unit_square (r2, f, p(mapping%i), mapping%power)
	else
	call map_unit_square (r2, f, p(mapping%i))
	end if
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_s_mapping_compute

	@ %def sf_s_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf standard mapping: TBP>>=
	procedure :: inverse => sf_s_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_s_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_s_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: p2
	integer :: j
	if (mapping%power_set) then
	call map_unit_square_inverse (r(mapping%i), f, p2, mapping%power)
	else
	call map_unit_square_inverse (r(mapping%i), f, p2)
	end if
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = 1 - p2(j)
	end do
	end subroutine sf_s_mapping_inverse

	@ %def sf_s_mapping_inverse
	@
	\subsection{Implementation: resonance pair mapping}
	This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
	while $p_2$ is related to the ratio, then it maps $p_1$ to itself
	according to a Breit-Wigner shape, i.e., a flat prior distribution in $p_1$
	results in a Breit-Wigner distribution. Mass and width of the BW are
	rescaled by the energy, thus dimensionless fractions.
	<<SF mappings: public>>=
	public :: sf_res_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_res_mapping_t
	real(default) :: m = 0
	real(default) :: w = 0
	contains
	<<SF mappings: sf resonance mapping: TBP>>
	end type sf_res_mapping_t

	@ %def sf_res_mapping_t
	@ Output.
	<<SF mappings: sf resonance mapping: TBP>>=
	procedure :: write => sf_res_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_res_mapping_write (object, unit)
	class(sf_res_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,', ',F7.5,A)") ": resonance (", object%m, object%w, ")"
	end subroutine sf_res_mapping_write

	@ %def sf_res_mapping_write
	@ Initialize: index pair and dimensionless mass and width parameters.
	<<SF mappings: sf resonance mapping: TBP>>=
	procedure :: init => sf_res_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_res_mapping_init (mapping, m, w)
	class(sf_res_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: m, w
	call mapping%base_init (2)
	mapping%m = m
	mapping%w = w
	end subroutine sf_res_mapping_init

	@ %def sf_res_mapping_init
	@ Apply mapping.
	<<SF mappings: sf resonance mapping: TBP>>=
	procedure :: compute => sf_res_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_res_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, p2
	real(default) :: fbw, f2, p1m
	integer :: j
	p2 = p(mapping%i)
	call map_breit_wigner &
	(p1m, fbw, p2(1), mapping%m, mapping%w, x_free)
	call map_unit_square (r2, f2, [p1m, p2(2)])
	f = fbw * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_res_mapping_compute

	@ %def sf_res_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf resonance mapping: TBP>>=
	procedure :: inverse => sf_res_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_res_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: p2
	real(default) :: fbw, f2, p1m
	call map_unit_square_inverse (r(mapping%i), f2, p2)
	call map_breit_wigner_inverse &
	(p2(1), fbw, p1m, mapping%m, mapping%w, x_free)
	p = r
	pb= rb
	p (mapping%i(1)) = p1m
	pb(mapping%i(1)) = 1 - p1m
	p (mapping%i(2)) = p2(2)
	pb(mapping%i(2)) = 1 - p2(2)
	f = fbw * f2
	end subroutine sf_res_mapping_inverse

	@ %def sf_res_mapping_inverse
	@
	\subsection{Implementation: resonance single mapping}
	While simpler, this is needed for structure-function setups only in
	exceptional cases.

	This maps the unit interval ($r_1$) to itself
	according to a Breit-Wigner shape, i.e., a flat prior distribution in $r_1$
	results in a Breit-Wigner distribution. Mass and width of the BW are
	rescaled by the energy, thus dimensionless fractions.
	<<SF mappings: public>>=
	public :: sf_res_mapping_single_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_res_mapping_single_t
	real(default) :: m = 0
	real(default) :: w = 0
	contains
	<<SF mappings: sf resonance single mapping: TBP>>
	end type sf_res_mapping_single_t

	@ %def sf_res_mapping_single_t
	@ Output.
	<<SF mappings: sf resonance single mapping: TBP>>=
	procedure :: write => sf_res_mapping_single_write
	<<SF mappings: procedures>>=
	subroutine sf_res_mapping_single_write (object, unit)
	class(sf_res_mapping_single_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,', ',F7.5,A)") ": resonance (", object%m, object%w, ")"
	end subroutine sf_res_mapping_single_write

	@ %def sf_res_mapping_single_write
	@ Initialize: single index (!) and dimensionless mass and width parameters.
	<<SF mappings: sf resonance single mapping: TBP>>=
	procedure :: init => sf_res_mapping_single_init
	<<SF mappings: procedures>>=
	subroutine sf_res_mapping_single_init (mapping, m, w)
	class(sf_res_mapping_single_t), intent(out) :: mapping
	real(default), intent(in) :: m, w
	call mapping%base_init (1)
	mapping%m = m
	mapping%w = w
	end subroutine sf_res_mapping_single_init

	@ %def sf_res_mapping_single_init
	@ Apply mapping.
	<<SF mappings: sf resonance single mapping: TBP>>=
	procedure :: compute => sf_res_mapping_single_compute
	<<SF mappings: procedures>>=
	subroutine sf_res_mapping_single_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(1) :: r2, p2
	real(default) :: fbw
	integer :: j
	p2 = p(mapping%i)
	call map_breit_wigner &
	(r2(1), fbw, p2(1), mapping%m, mapping%w, x_free)
	f = fbw
	r = p
	rb= pb
	r (mapping%i(1)) = r2(1)
	rb(mapping%i(1)) = 1 - r2(1)
	end subroutine sf_res_mapping_single_compute

	@ %def sf_res_mapping_single_compute
	@ Apply inverse.
	<<SF mappings: sf resonance single mapping: TBP>>=
	procedure :: inverse => sf_res_mapping_single_inverse
	<<SF mappings: procedures>>=
	subroutine sf_res_mapping_single_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(1) :: p2
	real(default) :: fbw
	call map_breit_wigner_inverse &
	(r(mapping%i(1)), fbw, p2(1), mapping%m, mapping%w, x_free)
	p = r
	pb= rb
	p (mapping%i(1)) = p2(1)
	pb(mapping%i(1)) = 1 - p2(1)
	f = fbw
	end subroutine sf_res_mapping_single_inverse

	@ %def sf_res_mapping_single_inverse
	@
	\subsection{Implementation: on-shell mapping}
	This is a degenerate version of the unit-square mapping where the
	product $r_1r_2$ is constant. This product is given by the rescaled
	squared mass. We introduce an artificial first parameter $p_1$ to
	keep the counting, but nothing depends on it. The second parameter is
	the same $p_2$ as for the standard unit-square mapping for $\alpha=1$,
	it parameterizes the ratio of $r_1$ and $r_2$.
	<<SF mappings: public>>=
	public :: sf_os_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_os_mapping_t
	real(default) :: m = 0
	real(default) :: lm2 = 0
	contains
	<<SF mappings: sf on-shell mapping: TBP>>
	end type sf_os_mapping_t

	@ %def sf_os_mapping_t
	@ Output.
	<<SF mappings: sf on-shell mapping: TBP>>=
	procedure :: write => sf_os_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_os_mapping_write (object, unit)
	class(sf_os_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A)") ": on-shell (", object%m, ")"
	end subroutine sf_os_mapping_write

	@ %def sf_os_mapping_write
	@ Initialize: index pair and dimensionless mass parameter.
	<<SF mappings: sf on-shell mapping: TBP>>=
	procedure :: init => sf_os_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_os_mapping_init (mapping, m)
	class(sf_os_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: m
	call mapping%base_init (2)
	mapping%m = m
	mapping%lm2 = abs (2 * log (mapping%m))
	end subroutine sf_os_mapping_init

	@ %def sf_os_mapping_init
	@ Apply mapping. The [[x_free]] parameter rescales the total energy,
	which must be accounted for in the enclosed mapping.
	<<SF mappings: sf on-shell mapping: TBP>>=
	procedure :: compute => sf_os_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_os_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, p2
	integer :: j
	p2 = p(mapping%i)
	call map_on_shell (r2, f, p2, mapping%lm2, x_free)
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_os_mapping_compute

	@ %def sf_os_mapping_compute
	@ Apply inverse. The irrelevant parameter $p_1$ is always set zero.
	<<SF mappings: sf on-shell mapping: TBP>>=
	procedure :: inverse => sf_os_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_os_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: p2, r2
	r2 = r(mapping%i)
	call map_on_shell_inverse (r2, f, p2, mapping%lm2, x_free)
	p = r
	pb= rb
	p (mapping%i(1)) = p2(1)
	pb(mapping%i(1)) = 1 - p2(1)
	p (mapping%i(2)) = p2(2)
	pb(mapping%i(2)) = 1 - p2(2)
	end subroutine sf_os_mapping_inverse

	@ %def sf_os_mapping_inverse
	@
	\subsection{Implementation: on-shell single mapping}
	This is a degenerate version of the unit-interval mapping where the
	result $r$ is constant. The value is given by the rescaled squared
	mass. The input parameter $p_1$ is actually ignored, nothing depends
	on it.
	<<SF mappings: public>>=
	public :: sf_os_mapping_single_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_os_mapping_single_t
	real(default) :: m = 0
	real(default) :: lm2 = 0
	contains
	<<SF mappings: sf on-shell mapping single: TBP>>
	end type sf_os_mapping_single_t

	@ %def sf_os_mapping_single_t
	@ Output.
	<<SF mappings: sf on-shell mapping single: TBP>>=
	procedure :: write => sf_os_mapping_single_write
	<<SF mappings: procedures>>=
	subroutine sf_os_mapping_single_write (object, unit)
	class(sf_os_mapping_single_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A)") ": on-shell (", object%m, ")"
	end subroutine sf_os_mapping_single_write

	@ %def sf_os_mapping_single_write
	@ Initialize: index pair and dimensionless mass parameter.
	<<SF mappings: sf on-shell mapping single: TBP>>=
	procedure :: init => sf_os_mapping_single_init
	<<SF mappings: procedures>>=
	subroutine sf_os_mapping_single_init (mapping, m)
	class(sf_os_mapping_single_t), intent(out) :: mapping
	real(default), intent(in) :: m
	call mapping%base_init (1)
	mapping%m = m
	mapping%lm2 = abs (2 * log (mapping%m))
	end subroutine sf_os_mapping_single_init

	@ %def sf_os_mapping_single_init
	@ Apply mapping. The [[x_free]] parameter rescales the total energy,
	which must be accounted for in the enclosed mapping.
	<<SF mappings: sf on-shell mapping single: TBP>>=
	procedure :: compute => sf_os_mapping_single_compute
	<<SF mappings: procedures>>=
	subroutine sf_os_mapping_single_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(1) :: r2, p2
	integer :: j
	p2 = p(mapping%i)
	call map_on_shell_single (r2, f, p2, mapping%lm2, x_free)
	r = p
	rb= pb
	r (mapping%i(1)) = r2(1)
	rb(mapping%i(1)) = 1 - r2(1)
	end subroutine sf_os_mapping_single_compute

	@ %def sf_os_mapping_single_compute
	@ Apply inverse. The irrelevant parameter $p_1$ is always set zero.
	<<SF mappings: sf on-shell mapping single: TBP>>=
	procedure :: inverse => sf_os_mapping_single_inverse
	<<SF mappings: procedures>>=
	subroutine sf_os_mapping_single_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(1) :: p2, r2
	r2 = r(mapping%i)
	call map_on_shell_single_inverse (r2, f, p2, mapping%lm2, x_free)
	p = r
	pb= rb
	p (mapping%i(1)) = p2(1)
	pb(mapping%i(1)) = 1 - p2(1)
	end subroutine sf_os_mapping_single_inverse

	@ %def sf_os_mapping_single_inverse
	@
	\subsection{Implementation: endpoint mapping}
	This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
	while $p_2$ is related to the ratio. Furthermore, we enhance the
	region at $r_1=1$ and $r_2=1$, which translates into $p_1=1$ and
	$p_2=0,1$. The enhancement is such that any power-like singularity is
	caught. This is useful for beamstrahlung spectra.

	In addition, we allow for a delta-function singularity in $r_1$ and/or
	$r_2$. The singularity is smeared to an interval of width
	$\epsilon$. If nonzero, we distinguish the kinematical momentum
	fractions $r_i$ from effective values $x_i$, which should go into the
	structure-function evaluation. A bin of width $\epsilon$ in $r$ is
	mapped to $x=1$ exactly, while the interval $(0,1-\epsilon)$ is mapped
	to $(0,1)$ in $x$. The Jacobian reflects this distinction, and the
	logical [[in_peak]] allows for an unambiguous distinction.

	The delta-peak fraction is used only for the integration self-test.
	<<SF mappings: public>>=
	public :: sf_ep_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_ep_mapping_t
	real(default) :: a = 1
	contains
	<<SF mappings: sf endpoint mapping: TBP>>
	end type sf_ep_mapping_t

	@ %def sf_ep_mapping_t
	@ Output.
	<<SF mappings: sf endpoint mapping: TBP>>=
	procedure :: write => sf_ep_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_ep_mapping_write (object, unit)
	class(sf_ep_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,ES12.5,A)") ": endpoint (a =", object%a, ")"
	end subroutine sf_ep_mapping_write

	@ %def sf_ep_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf endpoint mapping: TBP>>=
	procedure :: init => sf_ep_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_ep_mapping_init (mapping, a)
	class(sf_ep_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: a
	call mapping%base_init (2)
	if (present (a)) mapping%a = a
	end subroutine sf_ep_mapping_init

	@ %def sf_ep_mapping_init
	@ Apply mapping.
	<<SF mappings: sf endpoint mapping: TBP>>=
	procedure :: compute => sf_ep_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_ep_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ep_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, r2
	real(default) :: f1, f2
	integer :: j
	call map_endpoint_1 (px(1), f1, p(mapping%i(1)), mapping%a)
	call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
	call map_unit_square (r2, f, px)
	f = f * f1 * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_ep_mapping_compute

	@ %def sf_ep_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf endpoint mapping: TBP>>=
	procedure :: inverse => sf_ep_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_ep_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ep_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, px, p2
	real(default) :: f1, f2
	integer :: j
	do j = 1, 2
	r2(j) = r(mapping%i(j))
	end do
	call map_unit_square_inverse (r2, f, px)
	call map_endpoint_inverse_1 (px(1), f1, p2(1), mapping%a)
	call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
	f = f * f1 * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = 1 - p2(j)
	end do
	end subroutine sf_ep_mapping_inverse

	@ %def sf_ep_mapping_inverse
	@
	\subsection{Implementation: endpoint mapping with resonance}
	Like the endpoint mapping for $p_2$, but replace the endpoint mapping
	by a Breit-Wigner mapping for $p_1$. This covers resonance production
	in the presence of beamstrahlung.

	If the flag [[resonance]] is unset, we skip the resonance mapping, so
	the parameter $p_1$ remains equal to $r_1r_2$, as in the standard
	s-channel mapping.
	<<SF mappings: public>>=
	public :: sf_epr_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_epr_mapping_t
	real(default) :: a = 1
	real(default) :: m = 0
	real(default) :: w = 0
	logical :: resonance = .true.
	contains
	<<SF mappings: sf endpoint/res mapping: TBP>>
	end type sf_epr_mapping_t

	@ %def sf_epr_mapping_t
	@ Output.
	<<SF mappings: sf endpoint/res mapping: TBP>>=
	procedure :: write => sf_epr_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_epr_mapping_write (object, unit)
	class(sf_epr_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	if (object%resonance) then
	write (u, "(A,F7.5,A,F7.5,', ',F7.5,A)") ": ep/res (a = ", object%a, &
	" \| ", object%m, object%w, ")"
	else
	write (u, "(A,F7.5,A)") ": ep/nores (a = ", object%a, ")"
	end if
	end subroutine sf_epr_mapping_write

	@ %def sf_epr_mapping_write
	@ Initialize: if mass and width are not given, we initialize a
	non-resonant version of the mapping.
	<<SF mappings: sf endpoint/res mapping: TBP>>=
	procedure :: init => sf_epr_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_epr_mapping_init (mapping, a, m, w)
	class(sf_epr_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: a
	real(default), intent(in), optional :: m, w
	call mapping%base_init (2)
	mapping%a = a
	if (present (m) .and. present (w)) then
	mapping%m = m
	mapping%w = w
	else
	mapping%resonance = .false.
	end if
	end subroutine sf_epr_mapping_init

	@ %def sf_epr_mapping_init
	@ Apply mapping.
	<<SF mappings: sf endpoint/res mapping: TBP>>=
	procedure :: compute => sf_epr_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_epr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_epr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, r2
	real(default) :: f1, f2
	integer :: j
	if (mapping%resonance) then
	call map_breit_wigner &
	(px(1), f1, p(mapping%i(1)), mapping%m, mapping%w, x_free)
	else
	px(1) = p(mapping%i(1))
	f1 = 1
	end if
	call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
	call map_unit_square (r2, f, px)
	f = f * f1 * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_epr_mapping_compute

	@ %def sf_epr_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf endpoint/res mapping: TBP>>=
	procedure :: inverse => sf_epr_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_epr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_epr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, p2
	real(default) :: f1, f2
	integer :: j
	call map_unit_square_inverse (r(mapping%i), f, px)
	if (mapping%resonance) then
	call map_breit_wigner_inverse &
	(px(1), f1, p2(1), mapping%m, mapping%w, x_free)
	else
	p2(1) = px(1)
	f1 = 1
	end if
	call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
	f = f * f1 * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = 1 - p2(j)
	end do
	end subroutine sf_epr_mapping_inverse

	@ %def sf_epr_mapping_inverse
	@
	\subsection{Implementation: endpoint mapping for on-shell particle}
	Analogous to the resonance mapping, but the $p_1$ input is ignored
	altogether. This covers on-shell particle production
	in the presence of beamstrahlung.
	<<SF mappings: public>>=
	public :: sf_epo_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_epo_mapping_t
	real(default) :: a = 1
	real(default) :: m = 0
	real(default) :: lm2 = 0
	contains
	<<SF mappings: sf endpoint/os mapping: TBP>>
	end type sf_epo_mapping_t

	@ %def sf_epo_mapping_t
	@ Output.
	<<SF mappings: sf endpoint/os mapping: TBP>>=
	procedure :: write => sf_epo_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_epo_mapping_write (object, unit)
	class(sf_epo_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A,F7.5,A)") ": ep/on-shell (a = ", object%a, &
	" \| ", object%m, ")"
	end subroutine sf_epo_mapping_write

	@ %def sf_epo_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf endpoint/os mapping: TBP>>=
	procedure :: init => sf_epo_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_epo_mapping_init (mapping, a, m)
	class(sf_epo_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: a, m
	call mapping%base_init (2)
	mapping%a = a
	mapping%m = m
	mapping%lm2 = abs (2 * log (mapping%m))
	end subroutine sf_epo_mapping_init

	@ %def sf_epo_mapping_init
	@ Apply mapping.
	<<SF mappings: sf endpoint/os mapping: TBP>>=
	procedure :: compute => sf_epo_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_epo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_epo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, r2
	real(default) :: f2
	integer :: j
	px(1) = 0
	call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
	call map_on_shell (r2, f, px, mapping%lm2)
	f = f * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_epo_mapping_compute

	@ %def sf_epo_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf endpoint/os mapping: TBP>>=
	procedure :: inverse => sf_epo_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_epo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_epo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, p2
	real(default) :: f2
	integer :: j
	call map_on_shell_inverse (r(mapping%i), f, px, mapping%lm2)
	p2(1) = 0
	call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
	f = f * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = 1 - p2(j)
	end do
	end subroutine sf_epo_mapping_inverse

	@ %def sf_epo_mapping_inverse
	@
	\subsection{Implementation: ISR endpoint mapping}
	Similar to the endpoint mapping above: This maps the unit square
	($r_1,r_2$) such that $p_1$ is the product $r_1r_2$, while $p_2$ is
	related to the ratio. Furthermore, we enhance the region at $r_1=1$
	and $r_2=1$, which translates into $p_1=1$ and $p_2=0,1$.

	The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
	flattened. This would be easy in one dimension, but becomes
	nontrivial in two dimensions.
	<<SF mappings: public>>=
	public :: sf_ip_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_ip_mapping_t
	real(default) :: eps = 0
	contains
	<<SF mappings: sf power mapping: TBP>>
	end type sf_ip_mapping_t

	@ %def sf_ip_mapping_t
	@ Output.
	<<SF mappings: sf power mapping: TBP>>=
	procedure :: write => sf_ip_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_ip_mapping_write (object, unit)
	class(sf_ip_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,ES12.5,A)") ": isr (eps =", object%eps, ")"
	end subroutine sf_ip_mapping_write

	@ %def sf_ip_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf power mapping: TBP>>=
	procedure :: init => sf_ip_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_ip_mapping_init (mapping, eps)
	class(sf_ip_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: eps
	call mapping%base_init (2)
	if (present (eps)) mapping%eps = eps
	if (mapping%eps <= 0) &
	call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
	end subroutine sf_ip_mapping_init

	@ %def sf_ip_mapping_init
	@ Apply mapping.
	<<SF mappings: sf power mapping: TBP>>=
	procedure :: compute => sf_ip_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_ip_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ip_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, pxb, r2, r2b
	real(default) :: f1, f2, xb, y, yb
	integer :: j
	call map_power_1 (xb, f1, pb(mapping%i(1)), 2 * mapping%eps)
	call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
	px(1) = 1 - xb
	pxb(1) = xb
	px(2) = y
	pxb(2) = yb
	call map_unit_square_prec (r2, r2b, f, px, pxb)
	f = f * f1 * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2 (j)
	rb(mapping%i(j)) = r2b(j)
	end do
	end subroutine sf_ip_mapping_compute

	@ %def sf_ip_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf power mapping: TBP>>=
	procedure :: inverse => sf_ip_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_ip_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ip_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
	real(default) :: f1, f2, xb, y, yb
	integer :: j
	do j = 1, 2
	r2 (j) = r (mapping%i(j))
	r2b(j) = rb(mapping%i(j))
	end do
	call map_unit_square_inverse_prec (r2, r2b, f, px, pxb)
	xb = pxb(1)
	if (px(1) > 0) then
	y = px(2)
	yb = pxb(2)
	else
	y = 0.5_default
	yb = 0.5_default
	end if
	call map_power_inverse_1 (xb, f1, p2b(1), 2 * mapping%eps)
	call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
	p2 = 1 - p2b
	f = f * f1 * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = p2b(j)
	end do
	end subroutine sf_ip_mapping_inverse

	@ %def sf_ip_mapping_inverse
	@
	\subsection{Implementation: ISR endpoint mapping, resonant}
	Similar to the endpoint mapping above: This maps the unit square
	($r_1,r_2$) such that $p_1$ is the product $r_1r_2$, while $p_2$ is
	related to the ratio. Furthermore, we enhance the region at $r_1=1$
	and $r_2=1$, which translates into $p_1=1$ and $p_2=0,1$.

	The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
	flattened. This would be easy in one dimension, but becomes
	nontrivial in two dimensions.

	The resonance can be turned off by the flag [[resonance]].
	<<SF mappings: public>>=
	public :: sf_ipr_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_ipr_mapping_t
	real(default) :: eps = 0
	real(default) :: m = 0
	real(default) :: w = 0
	logical :: resonance = .true.
	contains
	<<SF mappings: sf power/res mapping: TBP>>
	end type sf_ipr_mapping_t

	@ %def sf_ipr_mapping_t
	@ Output.
	<<SF mappings: sf power/res mapping: TBP>>=
	procedure :: write => sf_ipr_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_ipr_mapping_write (object, unit)
	class(sf_ipr_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	if (object%resonance) then
	write (u, "(A,F7.5,A,F7.5,', ',F7.5,A)") ": isr/res (eps = ", &
	object%eps, " \| ", object%m, object%w, ")"
	else
	write (u, "(A,F7.5,A)") ": isr/res (eps = ", object%eps, ")"
	end if
	end subroutine sf_ipr_mapping_write

	@ %def sf_ipr_mapping_write
	@ Initialize:
	<<SF mappings: sf power/res mapping: TBP>>=
	procedure :: init => sf_ipr_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_ipr_mapping_init (mapping, eps, m, w)
	class(sf_ipr_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: eps, m, w
	call mapping%base_init (2)
	if (present (eps)) mapping%eps = eps
	if (mapping%eps <= 0) &
	call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
	if (present (m) .and. present (w)) then
	mapping%m = m
	mapping%w = w
	else
	mapping%resonance = .false.
	end if
	end subroutine sf_ipr_mapping_init

	@ %def sf_ipr_mapping_init
	@ Apply mapping.
	<<SF mappings: sf power/res mapping: TBP>>=
	procedure :: compute => sf_ipr_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_ipr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, pxb, r2, r2b
	real(default) :: f1, f2, y, yb
	integer :: j
	if (mapping%resonance) then
	call map_breit_wigner &
	(px(1), f1, p(mapping%i(1)), mapping%m, mapping%w, x_free)
	else
	px(1) = p(mapping%i(1))
	f1 = 1
	end if
	call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
	pxb(1) = 1 - px(1)
	px(2) = y
	pxb(2) = yb
	call map_unit_square_prec (r2, r2b, f, px, pxb)
	f = f * f1 * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2 (j)
	rb(mapping%i(j)) = r2b(j)
	end do
	end subroutine sf_ipr_mapping_compute

	@ %def sf_ipr_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf power/res mapping: TBP>>=
	procedure :: inverse => sf_ipr_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_ipr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
	real(default) :: f1, f2, y, yb
	integer :: j
	do j = 1, 2
	r2 (j) = r (mapping%i(j))
	r2b(j) = rb(mapping%i(j))
	end do
	call map_unit_square_inverse_prec (r2, r2b, f, px, pxb)
	if (px(1) > 0) then
	y = px(2)
	yb = pxb(2)
	else
	y = 0.5_default
	yb = 0.5_default
	end if
	if (mapping%resonance) then
	call map_breit_wigner_inverse &
	(px(1), f1, p2(1), mapping%m, mapping%w, x_free)
	else
	p2(1) = px(1)
	f1 = 1
	end if
	call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
	p2b(1) = 1 - p2(1)
	p2 (2) = 1 - p2b(2)
	f = f * f1 * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = p2b(j)
	end do
	end subroutine sf_ipr_mapping_inverse

	@ %def sf_ipr_mapping_inverse
	@
	\subsection{Implementation: ISR on-shell mapping}
	Similar to the endpoint mapping above: This maps the unit square
	($r_1,r_2$) such that $p_1$ is ignored while the product $r_1r_2$ is
	constant. $p_2$ is related to the ratio. Furthermore, we enhance the
	region at $r_1=1$ and $r_2=1$, which translates into $p_1=1$ and
	$p_2=0,1$.

	The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
	flattened. This would be easy in one dimension, but becomes
	nontrivial in two dimensions.
	<<SF mappings: public>>=
	public :: sf_ipo_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_ipo_mapping_t
	real(default) :: eps = 0
	real(default) :: m = 0
	contains
	<<SF mappings: sf power/os mapping: TBP>>
	end type sf_ipo_mapping_t

	@ %def sf_ipo_mapping_t
	@ Output.
	<<SF mappings: sf power/os mapping: TBP>>=
	procedure :: write => sf_ipo_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_ipo_mapping_write (object, unit)
	class(sf_ipo_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A,F7.5,A)") ": isr/os (eps = ", object%eps, &
	" \| ", object%m, ")"
	end subroutine sf_ipo_mapping_write

	@ %def sf_ipo_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf power/os mapping: TBP>>=
	procedure :: init => sf_ipo_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_ipo_mapping_init (mapping, eps, m)
	class(sf_ipo_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: eps, m
	call mapping%base_init (2)
	if (present (eps)) mapping%eps = eps
	if (mapping%eps <= 0) &
	call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
	mapping%m = m
	end subroutine sf_ipo_mapping_init

	@ %def sf_ipo_mapping_init
	@ Apply mapping.
	<<SF mappings: sf power/os mapping: TBP>>=
	procedure :: compute => sf_ipo_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_ipo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, pxb, r2, r2b
	real(default) :: f1, f2, y, yb
	integer :: j
	call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
	px(1) = mapping%m ** 2
	if (present (x_free)) px(1) = px(1) / x_free
	pxb(1) = 1 - px(1)
	px(2) = y
	pxb(2) = yb
	call map_unit_square_prec (r2, r2b, f1, px, pxb)
	f = f1 * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2 (j)
	rb(mapping%i(j)) = r2b(j)
	end do
	end subroutine sf_ipo_mapping_compute

	@ %def sf_ipo_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf power/os mapping: TBP>>=
	procedure :: inverse => sf_ipo_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_ipo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
	real(default) :: f1, f2, y, yb
	integer :: j
	do j = 1, 2
	r2 (j) = r (mapping%i(j))
	r2b(j) = rb(mapping%i(j))
	end do
	call map_unit_square_inverse_prec (r2, r2b, f1, px, pxb)
	y = px(2)
	yb = pxb(2)
	call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
	p2(1) = 0
	p2b(1)= 1
	p2(2) = 1 - p2b(2)
	f = f1 * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = p2b(j)
	end do
	end subroutine sf_ipo_mapping_inverse

	@ %def sf_ipo_mapping_inverse
	@
	\subsection{Implementation: Endpoint + ISR power mapping}
	This is a combination of endpoint (i.e., beamstrahlung) and ISR power
	mapping. The first two parameters apply to the beamstrahlung
	spectrum, the last two to the ISR function for the first and second
	beam, respectively.
	<<SF mappings: public>>=
	public :: sf_ei_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_ei_mapping_t
	type(sf_ep_mapping_t) :: ep
	type(sf_ip_mapping_t) :: ip
	contains
	<<SF mappings: sf ep-ip mapping: TBP>>
	end type sf_ei_mapping_t

	@ %def sf_ei_mapping_t
	@ Output.
	<<SF mappings: sf ep-ip mapping: TBP>>=
	procedure :: write => sf_ei_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_ei_mapping_write (object, unit)
	class(sf_ei_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,3(',',I0),')')", advance="no") object%i
	end if
	write (u, "(A,ES12.5,A,ES12.5,A)") ": ep/isr (a =", object%ep%a, &
	", eps =", object%ip%eps, ")"
	end subroutine sf_ei_mapping_write

	@ %def sf_ei_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf ep-ip mapping: TBP>>=
	procedure :: init => sf_ei_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_ei_mapping_init (mapping, a, eps)
	class(sf_ei_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: a, eps
	call mapping%base_init (4)
	call mapping%ep%init (a)
	call mapping%ip%init (eps)
	end subroutine sf_ei_mapping_init

	@ %def sf_ei_mapping_init
	@ Set an index value. We should communicate the appropriate indices to the
	enclosed sub-mappings, therefore override the method.
	<<SF mappings: sf ep-ip mapping: TBP>>=
	procedure :: set_index => sf_ei_mapping_set_index
	<<SF mappings: procedures>>=
	subroutine sf_ei_mapping_set_index (mapping, j, i)
	class(sf_ei_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	mapping%i(j) = i
	select case (j)
	case (1:2); call mapping%ep%set_index (j, i)
	case (3:4); call mapping%ip%set_index (j-2, i)
	end select
	end subroutine sf_ei_mapping_set_index

	@ %def sf_mapping_set_index
	@ Apply mapping. Now, the beamstrahlung and ISR mappings are
	independent of each other. The parameter subsets that are actually
	used should not overlap. The Jacobians are multiplied.
	<<SF mappings: sf ep-ip mapping: TBP>>=
	procedure :: compute => sf_ei_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_ei_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ei_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: q, qb
	real(default) :: f1, f2
	call mapping%ep%compute (q, qb, f1, p, pb, x_free)
	call mapping%ip%compute (r, rb, f2, q, qb, x_free)
	f = f1 * f2
	end subroutine sf_ei_mapping_compute

	@ %def sf_ei_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf ep-ip mapping: TBP>>=
	procedure :: inverse => sf_ei_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_ei_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ei_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: q, qb
	real(default) :: f1, f2
	call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
	call mapping%ep%inverse (q, qb, f1, p, pb, x_free)
	f = f1 * f2
	end subroutine sf_ei_mapping_inverse

	@ %def sf_ei_mapping_inverse
	@
	\subsection{Implementation: Endpoint + ISR + resonance}
	This is a combination of endpoint (i.e., beamstrahlung) and ISR power
	mapping, adapted for an s-channel resonance. The first two internal
	parameters apply to the beamstrahlung spectrum, the last two to the
	ISR function for the first and second beam, respectively. The first
	and third parameters are the result of an overall resonance mapping,
	so on the outside, the first parameter is the total momentum fraction,
	the third one describes the distribution between beamstrahlung and ISR.
	<<SF mappings: public>>=
	public :: sf_eir_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_eir_mapping_t
	type(sf_res_mapping_t) :: res
	type(sf_epr_mapping_t) :: ep
	type(sf_ipr_mapping_t) :: ip
	contains
	<<SF mappings: sf ep-ip-res mapping: TBP>>
	end type sf_eir_mapping_t

	@ %def sf_eir_mapping_t
	@ Output.
	<<SF mappings: sf ep-ip-res mapping: TBP>>=
	procedure :: write => sf_eir_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_eir_mapping_write (object, unit)
	class(sf_eir_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,3(',',I0),')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A,F7.5,A,F7.5,', ',F7.5,A)") &
	": ep/isr/res (a =", object%ep%a, &
	", eps =", object%ip%eps, " \| ", object%res%m, object%res%w, ")"
	end subroutine sf_eir_mapping_write

	@ %def sf_eir_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf ep-ip-res mapping: TBP>>=
	procedure :: init => sf_eir_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_eir_mapping_init (mapping, a, eps, m, w)
	class(sf_eir_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: a, eps, m, w
	call mapping%base_init (4)
	call mapping%res%init (m, w)
	call mapping%ep%init (a)
	call mapping%ip%init (eps)
	end subroutine sf_eir_mapping_init

	@ %def sf_eir_mapping_init
	@ Set an index value. We should communicate the appropriate indices to the
	enclosed sub-mappings, therefore override the method.
	<<SF mappings: sf ep-ip-res mapping: TBP>>=
	procedure :: set_index => sf_eir_mapping_set_index
	<<SF mappings: procedures>>=
	subroutine sf_eir_mapping_set_index (mapping, j, i)
	class(sf_eir_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	mapping%i(j) = i
	select case (j)
	case (1); call mapping%res%set_index (1, i)
	case (3); call mapping%res%set_index (2, i)
	end select
	select case (j)
	case (1:2); call mapping%ep%set_index (j, i)
	case (3:4); call mapping%ip%set_index (j-2, i)
	end select
	end subroutine sf_eir_mapping_set_index

	@ %def sf_mapping_set_index
	@ Apply mapping. Now, the beamstrahlung and ISR mappings are
	independent of each other. The parameter subsets that are actually
	used should not overlap. The Jacobians are multiplied.
	<<SF mappings: sf ep-ip-res mapping: TBP>>=
	procedure :: compute => sf_eir_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_eir_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_eir_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: px, pxb, q, qb
	real(default) :: f0, f1, f2
	call mapping%res%compute (px, pxb, f0, p, pb, x_free)
	call mapping%ep%compute (q, qb, f1, px, pxb, x_free)
	call mapping%ip%compute (r, rb, f2, q, qb, x_free)
	f = f0 * f1 * f2
	end subroutine sf_eir_mapping_compute

	@ %def sf_eir_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf ep-ip-res mapping: TBP>>=
	procedure :: inverse => sf_eir_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_eir_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_eir_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: px, pxb, q, qb
	real(default) :: f0, f1, f2
	call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
	call mapping%ep%inverse (q, qb, f1, px, pxb, x_free)
	call mapping%res%inverse (px, pxb, f0, p, pb, x_free)
	f = f0 * f1 * f2
	end subroutine sf_eir_mapping_inverse

	@ %def sf_eir_mapping_inverse
	@
	\subsection{Implementation: Endpoint + ISR power mapping, on-shell}
	This is a combination of endpoint (i.e., beamstrahlung) and ISR power
	mapping. The first two parameters apply to the beamstrahlung
	spectrum, the last two to the ISR function for the first and second
	beam, respectively. On top of that, we map the first and third parameter
	such that the product is constant. From the outside, the first
	parameter is irrelevant while the third parameter describes the
	distribution of energy (loss) among beamstrahlung and ISR.
	<<SF mappings: public>>=
	public :: sf_eio_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_eio_mapping_t
	type(sf_os_mapping_t) :: os
	type(sf_epr_mapping_t) :: ep
	type(sf_ipr_mapping_t) :: ip
	contains
	<<SF mappings: sf ep-ip-os mapping: TBP>>
	end type sf_eio_mapping_t

	@ %def sf_eio_mapping_t
	@ Output.
	<<SF mappings: sf ep-ip-os mapping: TBP>>=
	procedure :: write => sf_eio_mapping_write
	<<SF mappings: procedures>>=
	subroutine sf_eio_mapping_write (object, unit)
	class(sf_eio_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,3(',',I0),')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A,F7.5,A,F7.5,A)") ": ep/isr/os (a =", object%ep%a, &
	", eps =", object%ip%eps, " \| ", object%os%m, ")"
	end subroutine sf_eio_mapping_write

	@ %def sf_eio_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf ep-ip-os mapping: TBP>>=
	procedure :: init => sf_eio_mapping_init
	<<SF mappings: procedures>>=
	subroutine sf_eio_mapping_init (mapping, a, eps, m)
	class(sf_eio_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: a, eps, m
	call mapping%base_init (4)
	call mapping%os%init (m)
	call mapping%ep%init (a)
	call mapping%ip%init (eps)
	end subroutine sf_eio_mapping_init

	@ %def sf_eio_mapping_init
	@ Set an index value. We should communicate the appropriate indices to the
	enclosed sub-mappings, therefore override the method.
	<<SF mappings: sf ep-ip-os mapping: TBP>>=
	procedure :: set_index => sf_eio_mapping_set_index
	<<SF mappings: procedures>>=
	subroutine sf_eio_mapping_set_index (mapping, j, i)
	class(sf_eio_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	mapping%i(j) = i
	select case (j)
	case (1); call mapping%os%set_index (1, i)
	case (3); call mapping%os%set_index (2, i)
	end select
	select case (j)
	case (1:2); call mapping%ep%set_index (j, i)
	case (3:4); call mapping%ip%set_index (j-2, i)
	end select
	end subroutine sf_eio_mapping_set_index

	@ %def sf_mapping_set_index
	@ Apply mapping. Now, the beamstrahlung and ISR mappings are
	independent of each other. The parameter subsets that are actually
	used should not overlap. The Jacobians are multiplied.
	<<SF mappings: sf ep-ip-os mapping: TBP>>=
	procedure :: compute => sf_eio_mapping_compute
	<<SF mappings: procedures>>=
	subroutine sf_eio_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_eio_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: px, pxb, q, qb
	real(default) :: f0, f1, f2
	call mapping%os%compute (px, pxb, f0, p, pb, x_free)
	call mapping%ep%compute (q, qb, f1, px, pxb, x_free)
	call mapping%ip%compute (r, rb, f2, q, qb, x_free)
	f = f0 * f1 * f2
	end subroutine sf_eio_mapping_compute

	@ %def sf_eio_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf ep-ip-os mapping: TBP>>=
	procedure :: inverse => sf_eio_mapping_inverse
	<<SF mappings: procedures>>=
	subroutine sf_eio_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_eio_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: px, pxb, q, qb
	real(default) :: f0, f1, f2
	call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
	call mapping%ep%inverse (q, qb, f1, px, pxb, x_free)
	call mapping%os%inverse (px, pxb, f0, p, pb, x_free)
	f = f0 * f1 * f2
	end subroutine sf_eio_mapping_inverse

	@ %def sf_eio_mapping_inverse
	@
	\subsection{Basic formulas}
	\subsubsection{Standard mapping of the unit square}
	This mapping of the unit square is appropriate in particular for
	structure functions which are concentrated at the lower end. Instead
	of a rectangular grid, one set of grid lines corresponds to constant
	parton c.m. energy. The other set is chosen such that the jacobian is
	only mildly singular ($\ln x$ which is zero at $x=1$), corresponding
	to an initial concentration of sampling points at the maximum energy.
	If [[power]] is greater than one (the default), points are also
	concentrated at the lower end.

	The formula is ([[power]]=$\alpha$):
	\begin{align}
	r_1 &= (p_1 ^ {p_2})^\alpha \\
	r_2 &= (p_1 ^ {1 - p_2})^\alpha\\
	f &= \alpha^2 p_1 ^ {\alpha - 1} \|\log p_1\|
	\end{align}
	and for the default case $\alpha=1$:
	\begin{align}
	r_1 &= p_1 ^ {p_2} \\
	r_2 &= p_1 ^ {1 - p_2} \\
	f &= \|\log p_1\|
	\end{align}
	<<SF mappings: procedures>>=
	subroutine map_unit_square (r, factor, p, power)
	real(default), dimension(2), intent(out) :: r
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(in) :: p
	real(default), intent(in), optional :: power
	real(default) :: xx, yy
	factor = 1
	xx = p(1)
	yy = p(2)
	if (present(power)) then
	if (p(1) > 0 .and. power > 1) then
	xx = p(1)**power
	factor = factor * power * xx / p(1)
	end if
	end if
	if (.not. vanishes (xx)) then
	r(1) = xx ** yy
	r(2) = xx / r(1)
	factor = factor * abs (log (xx))
	else
	r = 0
	end if
	end subroutine map_unit_square

	@ %def map_unit_square
	@ This is the inverse mapping.
	<<SF mappings: procedures>>=
	subroutine map_unit_square_inverse (r, factor, p, power)
	real(kind=default), dimension(2), intent(in) :: r
	real(kind=default), intent(out) :: factor
	real(kind=default), dimension(2), intent(out) :: p
	real(kind=default), intent(in), optional :: power
	real(kind=default) :: lg, xx, yy
	factor = 1
	xx = r(1) * r(2)
	if (.not. vanishes (xx)) then
	lg = log (xx)
	if (.not. vanishes (lg)) then
	yy = log (r(1)) / lg
	else
	yy = 0
	end if
	p(2) = yy
	factor = factor * abs (lg)
	if (present(power)) then
	p(1) = xx**(1._default/power)
	factor = factor * power * xx / p(1)
	else
	p(1) = xx
	end if
	else
	p = 0
	end if
	end subroutine map_unit_square_inverse

	@ %def map_unit_square_inverse
	@
	\subsubsection{Precise mapping of the unit square}
	A more precise version (with unit power parameter). This version
	should be numerically stable near $x=1$ and $y=0,1$. The formulas are again
	\begin{equation}
	r_1 = p_1^{p_2}, \qquad
	r_2 = p_1^{\bar p_2}, \qquad
	f = - \log p_1
	\end{equation}
	but we compute both $r_i$ and $\bar r_i$ simultaneously and make
	direct use of both $p_i$ and $\bar p_i$ as appropriate.
	<<SF mappings: procedures>>=
	subroutine map_unit_square_prec (r, rb, factor, p, pb)
	real(default), dimension(2), intent(out) :: r
	real(default), dimension(2), intent(out) :: rb
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(in) :: p
	real(default), dimension(2), intent(in) :: pb
	if (p(1) > 0.5_default) then
	call compute_prec_xy_1 (r(1), rb(1), p(1), pb(1), p (2))
	call compute_prec_xy_1 (r(2), rb(2), p(1), pb(1), pb(2))
	factor = - log_prec (p(1), pb(1))
	else if (.not. vanishes (p(1))) then
	call compute_prec_xy_0 (r(1), rb(1), p(1), pb(1), p (2))
	call compute_prec_xy_0 (r(2), rb(2), p(1), pb(1), pb(2))
	factor = - log_prec (p(1), pb(1))
	else
	r = 0
	rb = 1
	factor = 0
	end if
	end subroutine map_unit_square_prec

	@ %def map_unit_square_prec
	@ This is the inverse mapping.
	<<SF mappings: procedures>>=
	subroutine map_unit_square_inverse_prec (r, rb, factor, p, pb)
	real(default), dimension(2), intent(in) :: r
	real(default), dimension(2), intent(in) :: rb
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(out) :: p
	real(default), dimension(2), intent(out) :: pb
	call inverse_prec_x (r, rb, p(1), pb(1))
	if (all (r > 0)) then
	if (rb(1) < rb(2)) then
	call inverse_prec_y (r, rb, p(2), pb(2))
	else
	call inverse_prec_y ([r(2),r(1)], [rb(2),rb(1)], pb(2), p(2))
	end if
	factor = - log_prec (p(1), pb(1))
	else
	p(1) = 0
	pb(1) = 1
	p(2) = 0.5_default
	pb(2) = 0.5_default
	factor = 0
	end if
	end subroutine map_unit_square_inverse_prec

	@ %def map_unit_square_prec_inverse
	@ This is an auxiliary function: evaluate the expression $\bar z = 1 -
	x^y$ in a numerically stable way. Instabilities occur for $y=0$ and
	$x=1$. The idea is to replace the bracket by the first terms of its
	Taylor expansion around $x=1$ (read $\bar x\equiv 1 -x$)
	\begin{equation}
	1 - x^y = y\bar x\left(1 + \frac12(1-y)\bar x +
	\frac16(2-y)(1-y)\bar x^2\right)
	\end{equation}
	whenever this is the better approximation. Actually, the relative
	numerical error of the exact formula is about $\eta/(y\bar x)$ where
	$\eta$ is given by [[epsilon(KIND)]] in Fortran. The relative error
	of the approximation is better than the last included term divided by
	$(y\bar x)$.

	The first subroutine computes $z$ and $\bar z$ near $x=1$ where $\log
	x$ should be expanded, the second one near $x=0$ where $\log x$ can be
	kept.
	<<SF mappings: procedures>>=
	subroutine compute_prec_xy_1 (z, zb, x, xb, y)
	real(default), intent(out) :: z, zb
	real(default), intent(in) :: x, xb, y
	real(default) :: a1, a2, a3
	a1 = y * xb
	a2 = a1 * (1 - y) * xb / 2
	a3 = a2 * (2 - y) * xb / 3
	if (abs (a3) < epsilon (a3)) then
	zb = a1 + a2 + a3
	z = 1 - zb
	else
	z = x ** y
	zb = 1 - z
	end if
	end subroutine compute_prec_xy_1

	subroutine compute_prec_xy_0 (z, zb, x, xb, y)
	real(default), intent(out) :: z, zb
	real(default), intent(in) :: x, xb, y
	real(default) :: a1, a2, a3, lx
	lx = -log (x)
	a1 = y * lx
	a2 = a1 * y * lx / 2
	a3 = a2 * y * lx / 3
	if (abs (a3) < epsilon (a3)) then
	zb = a1 + a2 + a3
	z = 1 - zb
	else
	z = x ** y
	zb = 1 - z
	end if
	end subroutine compute_prec_xy_0

	@ %def compute_prec_xy_1
	@ %def compute_prec_xy_0
	@ For the inverse calculation, we evaluate $x=r_1r_2$ in a stable way.
	Since it is just a polynomial, the expansion near $x=1$ is
	analytically exact, and we don't need to choose based on precision.
	<<SF mappings: procedures>>=
	subroutine inverse_prec_x (r, rb, x, xb)
	real(default), dimension(2), intent(in) :: r, rb
	real(default), intent(out) :: x, xb
	real(default) :: a0, a1
	a0 = rb(1) + rb(2)
	a1 = rb(1) * rb(2)
	if (a0 > 0.5_default) then
	xb = a0 - a1
	x = 1 - xb
	else
	x = r(1) * r(2)
	xb = 1 - x
	end if
	end subroutine inverse_prec_x

	@ %def inverse_prec_x
	@ The inverse calculation for the relative momentum fraction
	\begin{equation}
	y = \frac{1}{1 + \frac{\log{r_2}}{\log{r_1}}}
	\end{equation}
	is slightly more complicated. We should take the precise form of the
	logarithm, so we are safe near $r_i=1$. A series expansion is
	required if $r_1\ll r_2$, since then $y$ becomes small. (We assume
	$r_1<r_2$ here; for the opposite case, the arguments can be
	exchanged.)
	<<SF mappings: procedures>>=
	subroutine inverse_prec_y (r, rb, y, yb)
	real(default), dimension(2), intent(in) :: r, rb
	real(default), intent(out) :: y, yb
	real(default) :: log1, log2, a1, a2, a3
	log1 = log_prec (r(1), rb(1))
	log2 = log_prec (r(2), rb(2))
	if (abs (log2**3) < epsilon (one)) then
	if (abs(log1) < epsilon (one)) then
	y = zero
	else
	y = one / (one + log2 / log1)
	end if
	if (abs(log2) < epsilon (one)) then
	yb = zero
	else
	yb = one / (one + log1 / log2)
	end if
	return
	end if
	a1 = - rb(1) / log2
	a2 = - rb(1) ** 2 * (one / log2*2 + one / (2 log2))
	a3 = - rb(1) ** 3 * (one / log23 + one / log22 + one/(3 * log2))
	if (abs (a3) < epsilon (a3)) then
	y = a1 + a2 + a3
	yb = one - y
	else
	y = one / (one + log2 / log1)
	yb = one / (one + log1 / log2)
	end if
	end subroutine inverse_prec_y

	@ %def inverse_prec_y
	@
	\subsubsection{Mapping for on-shell s-channel}
	The limiting case, if the product $r_1r_2$ is fixed for on-shell
	production. The parameter $p_1$ is ignored. In the inverse mapping,
	it is returned zero.

	The parameter [[x_free]], if present, rescales the total energy. If
	it is less than one, the rescaled mass parameter $m^2$ should be increased
	accordingly.

	Public for access in unit test.
	<<SF mappings: public>>=
	public :: map_on_shell
	public :: map_on_shell_inverse
	<<SF mappings: procedures>>=
	subroutine map_on_shell (r, factor, p, lm2, x_free)
	real(default), dimension(2), intent(out) :: r
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(in) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	real(default) :: lx
	lx = lm2; if (present (x_free)) lx = lx + log (x_free)
	r(1) = exp (- p(2) * lx)
	r(2) = exp (- (1 - p(2)) * lx)
	factor = lx
	end subroutine map_on_shell

	subroutine map_on_shell_inverse (r, factor, p, lm2, x_free)
	real(default), dimension(2), intent(in) :: r
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(out) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	real(default) :: lx
	lx = lm2; if (present (x_free)) lx = lx + log (x_free)
	p(1) = 0
	p(2) = abs (log (r(1))) / lx
	factor = lx
	end subroutine map_on_shell_inverse

	@ %def map_on_shell
	@ %def map_on_shell_inverse
	@
	\subsubsection{Mapping for on-shell s-channel, single parameter}
	This is a pseudo-mapping which applies if there is actually just one
	parameter [[p]]. The output parameter [[r]] is fixed for on-shell
	production. The lone parameter $p_1$ is ignored. In the inverse mapping,
	it is returned zero.

	The parameter [[x_free]], if present, rescales the total energy. If
	it is less than one, the rescaled mass parameter $m^2$ should be increased
	accordingly.

	Public for access in unit test.
	<<SF mappings: public>>=
	public :: map_on_shell_single
	public :: map_on_shell_single_inverse
	<<SF mappings: procedures>>=
	subroutine map_on_shell_single (r, factor, p, lm2, x_free)
	real(default), dimension(1), intent(out) :: r
	real(default), intent(out) :: factor
	real(default), dimension(1), intent(in) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	real(default) :: lx
	lx = lm2; if (present (x_free)) lx = lx + log (x_free)
	r(1) = exp (- lx)
	factor = 1
	end subroutine map_on_shell_single

	subroutine map_on_shell_single_inverse (r, factor, p, lm2, x_free)
	real(default), dimension(1), intent(in) :: r
	real(default), intent(out) :: factor
	real(default), dimension(1), intent(out) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	real(default) :: lx
	lx = lm2; if (present (x_free)) lx = lx + log (x_free)
	p(1) = 0
	factor = 1
	end subroutine map_on_shell_single_inverse

	@ %def map_on_shell_single
	@ %def map_on_shell_single_inverse
	@
	\subsubsection{Mapping for a Breit-Wigner resonance}
	This is the standard Breit-Wigner mapping. We apply it to a single
	variable, independently of or in addition to a unit-square mapping. We
	assume here that the limits for the variable are 0 and 1, and that the
	mass $m$ and width $w$ are rescaled appropriately, so they are
	dimensionless and usually between 0 and 1.

	If [[x_free]] is set, it rescales the total energy and thus mass and
	width, since these are defined with respect to the total energy.
	<<SF mappings: procedures>>=
	subroutine map_breit_wigner (r, factor, p, m, w, x_free)
	real(default), intent(out) :: r
	real(default), intent(out) :: factor
	real(default), intent(in) :: p
	real(default), intent(in) :: m
	real(default), intent(in) :: w
	real(default), intent(in), optional :: x_free
	real(default) :: m2, mw, a1, a2, a3, z, tmp
	m2 = m ** 2
	mw = m * w
	if (present (x_free)) then
	m2 = m2 / x_free
	mw = mw / x_free
	end if
	a1 = atan (- m2 / mw)
	a2 = atan ((1 - m2) / mw)
	a3 = (a2 - a1) * mw
	z = (1-p) * a1 + p * a2
	if (-pi/2 < z .and. z < pi/2) then
	tmp = tan (z)
	r = max (m2 + mw * tmp, 0._default)
	factor = a3 * (1 + tmp ** 2)
	else
	r = 0
	factor = 0
	end if
	end subroutine map_breit_wigner

	subroutine map_breit_wigner_inverse (r, factor, p, m, w, x_free)
	real(default), intent(in) :: r
	real(default), intent(out) :: factor
	real(default), intent(out) :: p
	real(default), intent(in) :: m
	real(default), intent(in) :: w
	real(default) :: m2, mw, a1, a2, a3, tmp
	real(default), intent(in), optional :: x_free
	m2 = m ** 2
	mw = m * w
	if (present (x_free)) then
	m2 = m2 / x_free
	mw = mw / x_free
	end if
	a1 = atan (- m2 / mw)
	a2 = atan ((1 - m2) / mw)
	a3 = (a2 - a1) * mw
	tmp = (r - m2) / mw
	p = (atan (tmp) - a1) / (a2 - a1)
	factor = a3 * (1 + tmp ** 2)
	end subroutine map_breit_wigner_inverse

	@ %def map_breit_wigner
	@ %def map_breit_wigner_inverse
	@
	\subsubsection{Mapping with endpoint enhancement}
	This is a mapping which is close to the unit mapping, except that at
	the endpoint(s), the output values are exponentially enhanced.
	\begin{equation}
	y = \tanh (a \tan (\frac{\pi}{2}x))
	\end{equation}
	We have two variants: one covers endpoints at $0$ and $1$
	symmetrically, while the other one (which essentially maps one-half of
	the range), covers only the endpoint at $1$.
	<<SF mappings: procedures>>=
	subroutine map_endpoint_1 (x3, factor, x1, a)
	real(default), intent(out) :: x3, factor
	real(default), intent(in) :: x1
	real(default), intent(in) :: a
	real(default) :: x2
	if (abs (x1) < 1) then
	x2 = tan (x1 * pi / 2)
	x3 = tanh (a * x2)
	factor = a * pi/2 * (1 + x2 ** 2) * (1 - x3 ** 2)
	else
	x3 = x1
	factor = 0
	end if
	end subroutine map_endpoint_1

	subroutine map_endpoint_inverse_1 (x3, factor, x1, a)
	real(default), intent(in) :: x3
	real(default), intent(out) :: x1, factor
	real(default), intent(in) :: a
	real(default) :: x2
	if (abs (x3) < 1) then
	x2 = atanh (x3) / a
	x1 = 2 / pi * atan (x2)
	factor = a * pi/2 * (1 + x2 ** 2) * (1 - x3 ** 2)
	else
	x1 = x3
	factor = 0
	end if
	end subroutine map_endpoint_inverse_1

	subroutine map_endpoint_01 (x4, factor, x0, a)
	real(default), intent(out) :: x4, factor
	real(default), intent(in) :: x0
	real(default), intent(in) :: a
	real(default) :: x1, x3
	x1 = 2 * x0 - 1
	call map_endpoint_1 (x3, factor, x1, a)
	x4 = (x3 + 1) / 2
	end subroutine map_endpoint_01

	subroutine map_endpoint_inverse_01 (x4, factor, x0, a)
	real(default), intent(in) :: x4
	real(default), intent(out) :: x0, factor
	real(default), intent(in) :: a
	real(default) :: x1, x3
	x3 = 2 * x4 - 1
	call map_endpoint_inverse_1 (x3, factor, x1, a)
	x0 = (x1 + 1) / 2
	end subroutine map_endpoint_inverse_01

	@ %def map_endpoint_1
	@ %def map_endpoint_inverse_1
	@ %def map_endpoint_01
	@ %def map_endpoint_inverse_01
	@
	\subsubsection{Mapping with endpoint enhancement (ISR)}
	This is another endpoint mapping. It is designed to flatten the ISR
	singularity which is of power type at $x=1$, i.e., if
	\begin{equation}
	\sigma = \int_0^1 dx\,f(x)\,G(x)
	= \int_0^1 dx\,\epsilon(1-x)^{-1+\epsilon} G(x),
	\end{equation}
	we replace this by
	\begin{equation}
	r = x^\epsilon \quad\Longrightarrow\quad
	\sigma = \int_0^1 dr\,G(1- (1-r)^{1/\epsilon}).
	\end{equation}
	We expect that $\epsilon$ is small.

	The actual mapping is $r\to x$ (so $x$ emerges closer to $1$). The
	Jacobian that we return is thus $1/f(x)$. We compute the mapping in
	terms of $\bar x\equiv 1 - x$, so we can achieve the required precision.
	Because some compilers show quite wild numeric fluctuations, we
	internally convert numeric types to explicit [[double]] precision.
	<<SF mappings: public>>=
	public :: map_power_1
	public :: map_power_inverse_1
	<<SF mappings: procedures>>=
	subroutine map_power_1 (xb, factor, rb, eps)
	real(default), intent(out) :: xb, factor
	real(default), intent(in) :: rb
	real(double) :: rb_db, factor_db, eps_db, xb_db
	real(default), intent(in) :: eps
	rb_db = real (rb, kind=double)
	eps_db = real (eps, kind=double)
	xb_db = rb_db ** (1 / eps_db)
	if (rb_db > 0) then
	factor_db = xb_db / rb_db / eps_db
	factor = real (factor_db, kind=default)
	else
	factor = 0
	end if
	xb = real (xb_db, kind=default)
	end subroutine map_power_1

	subroutine map_power_inverse_1 (xb, factor, rb, eps)
	real(default), intent(in) :: xb
	real(default), intent(out) :: rb, factor
	real(double) :: xb_db, factor_db, eps_db, rb_db
	real(default), intent(in) :: eps
	xb_db = real (xb, kind=double)
	eps_db = real (eps, kind=double)
	rb_db = xb_db ** eps_db
	if (xb_db > 0) then
	factor_db = xb_db / rb_db / eps_db
	factor = real (factor_db, kind=default)
	else
	factor = 0
	end if
	rb = real (rb_db, kind=default)
	end subroutine map_power_inverse_1

	@ %def map_power_1
	@ %def map_power_inverse_1
	@ Here we apply a power mapping to both endpoints. We divide the
	interval in two equal halves and apply the power mapping for the
	nearest endpoint, either $0$ or $1$.
	<<SF mappings: procedures>>=
	subroutine map_power_01 (y, yb, factor, r, eps)
	real(default), intent(out) :: y, yb, factor
	real(default), intent(in) :: r
	real(default), intent(in) :: eps
	real(default) :: u, ub, zp, zm
	u = 2 * r - 1
	if (u > 0) then
	ub = 2 * (1 - r)
	call map_power_1 (zm, factor, ub, eps)
	zp = 2 - zm
	else if (u < 0) then
	ub = 2 * r
	call map_power_1 (zp, factor, ub, eps)
	zm = 2 - zp
	else
	factor = 1 / eps
	zp = 1
	zm = 1
	end if
	y = zp / 2
	yb = zm / 2
	end subroutine map_power_01

	subroutine map_power_inverse_01 (y, yb, factor, r, eps)
	real(default), intent(in) :: y, yb
	real(default), intent(out) :: r, factor
	real(default), intent(in) :: eps
	real(default) :: ub, zp, zm
	zp = 2 * y
	zm = 2 * yb
	if (zm < zp) then
	call map_power_inverse_1 (zm, factor, ub, eps)
	r = 1 - ub / 2
	else if (zp < zm) then
	call map_power_inverse_1 (zp, factor, ub, eps)
	r = ub / 2
	else
	factor = 1 / eps
	ub = 1
	r = ub / 2
	end if
	end subroutine map_power_inverse_01

	@ %def map_power_01
	@ %def map_power_inverse_01
	@
	\subsubsection{Structure-function channels}
	A structure-function chain parameterization (channel) may contain a
	mapping that applies to multiple structure functions. This is
	described by an extension of the [[sf_mapping_t]] type. In addition,
	it may contain mappings that apply to (other) individual structure
	functions. The details of these mappings are implementation-specific.

	The [[sf_channel_t]] type combines this information. It contains an
	array of map codes, one for each structure-function entry. The code
	values are:
	\begin{description}
	\item[none] MC input parameters $r$ directly become energy fractions $x$
	\item[single] default mapping for a single structure-function entry
	\item[multi/s] map $r\to x$ such that one MC input parameter is $\hat s/s$
	\item[multi/resonance] as before, adapted to s-channel resonance
	\item[multi/on-shell] as before, adapted to an on-shell particle in
	the s channel
	\item[multi/endpoint] like multi/s, but enhance the region near $r_i=1$
	\item[multi/endpoint/res] endpoint mapping with resonance
	\item[multi/endpoint/os] endpoint mapping for on-shell
	\item[multi/power/os] like multi/endpoint, regulating a power singularity
	\end{description}
	<<SF mappings: parameters>>=
	integer, parameter :: SFMAP_NONE = 0
	integer, parameter :: SFMAP_SINGLE = 1
	integer, parameter :: SFMAP_MULTI_S = 2
	integer, parameter :: SFMAP_MULTI_RES = 3
	integer, parameter :: SFMAP_MULTI_ONS = 4
	integer, parameter :: SFMAP_MULTI_EP = 5
	integer, parameter :: SFMAP_MULTI_EPR = 6
	integer, parameter :: SFMAP_MULTI_EPO = 7
	integer, parameter :: SFMAP_MULTI_IP = 8
	integer, parameter :: SFMAP_MULTI_IPR = 9
	integer, parameter :: SFMAP_MULTI_IPO = 10
	integer, parameter :: SFMAP_MULTI_EI = 11
	integer, parameter :: SFMAP_MULTI_SRS = 13
	integer, parameter :: SFMAP_MULTI_SON = 14

	@ %def SFMAP_NONE SFMAP_SINGLE
	@ %def SFMAP_MULTI_S SFMAP_MULTI_RES SFMAP_MULTI_ONS
	@ %def SFMAP_MULTI_EP SFMAP_MULTI_EPR SFMAP_MULTI_EPO
	@ %def SFMAP_MULTI_IP SFMAP_MULTI_IPR SFMAP_MULTI_IPO
	@ %def SFMAP_MULTI_EI
	@ %def SFMAP_MULTI_SRS SFMAP_MULTI_SON
	@ Then, it contains an allocatable entry for the multi mapping. This
	entry holds the MC-parameter indices on which the mapping applies
	(there may be more than one MC parameter per structure-function entry)
	and any parameters associated with the mapping.

	There can be only one multi-mapping per channel.
	<<SF mappings: public>>=
	public :: sf_channel_t
	<<SF mappings: types>>=
	type :: sf_channel_t
	integer, dimension(:), allocatable :: map_code
	class(sf_mapping_t), allocatable :: multi_mapping
	contains
	<<SF mappings: sf channel: TBP>>
	end type sf_channel_t

	@ %def sf_channel_t
	@ The output format prints a single character for each
	structure-function entry and, if applicable, an account of the mapping
	parameters.
	<<SF mappings: sf channel: TBP>>=
	procedure :: write => sf_channel_write
	<<SF mappings: procedures>>=
	subroutine sf_channel_write (object, unit)
	class(sf_channel_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	if (allocated (object%map_code)) then
	do i = 1, size (object%map_code)
	select case (object%map_code (i))
	case (SFMAP_NONE)
	write (u, "(1x,A)", advance="no") "-"
	case (SFMAP_SINGLE)
	write (u, "(1x,A)", advance="no") "+"
	case (SFMAP_MULTI_S)
	write (u, "(1x,A)", advance="no") "s"
	case (SFMAP_MULTI_RES, SFMAP_MULTI_SRS)
	write (u, "(1x,A)", advance="no") "r"
	case (SFMAP_MULTI_ONS, SFMAP_MULTI_SON)
	write (u, "(1x,A)", advance="no") "o"
	case (SFMAP_MULTI_EP)
	write (u, "(1x,A)", advance="no") "e"
	case (SFMAP_MULTI_EPR)
	write (u, "(1x,A)", advance="no") "p"
	case (SFMAP_MULTI_EPO)
	write (u, "(1x,A)", advance="no") "q"
	case (SFMAP_MULTI_IP)
	write (u, "(1x,A)", advance="no") "i"
	case (SFMAP_MULTI_IPR)
	write (u, "(1x,A)", advance="no") "i"
	case (SFMAP_MULTI_IPO)
	write (u, "(1x,A)", advance="no") "i"
	case (SFMAP_MULTI_EI)
	write (u, "(1x,A)", advance="no") "i"
	case default
	write (u, "(1x,A)", advance="no") "?"
	end select
	end do
	else
	write (u, "(1x,A)", advance="no") "-"
	end if
	if (allocated (object%multi_mapping)) then
	write (u, "(1x,'/')", advance="no")
	call object%multi_mapping%write (u)
	else
	write (u, *)
	end if
	end subroutine sf_channel_write

	@ %def sf_channel_write
	@ Initializer for a single [[sf_channel]] object.
	<<SF mappings: sf channel: TBP>>=
	procedure :: init => sf_channel_init
	<<SF mappings: procedures>>=
	subroutine sf_channel_init (channel, n_strfun)
	class(sf_channel_t), intent(out) :: channel
	integer, intent(in) :: n_strfun
	allocate (channel%map_code (n_strfun))
	channel%map_code = SFMAP_NONE
	end subroutine sf_channel_init

	@ %def sf_channel_init
	@ Assignment. This merely copies intrinsic assignment, but apparently
	the latter is bugged in gfortran 4.6.3, causing memory corruption.
	<<SF mappings: sf channel: TBP>>=
	generic :: assignment (=) => sf_channel_assign
	procedure :: sf_channel_assign
	<<SF mappings: procedures>>=
	subroutine sf_channel_assign (copy, original)
	class(sf_channel_t), intent(out) :: copy
	type(sf_channel_t), intent(in) :: original
	allocate (copy%map_code (size (original%map_code)))
	copy%map_code = original%map_code
	if (allocated (original%multi_mapping)) then
	allocate (copy%multi_mapping, source = original%multi_mapping)
	end if
	end subroutine sf_channel_assign

	@ %def sf_channel_assign
	@ This initializer allocates an array of channels with common number of
	structure-function entries, therefore it is not a type-bound procedure.
	<<SF mappings: public>>=
	public :: allocate_sf_channels
	<<SF mappings: procedures>>=
	subroutine allocate_sf_channels (channel, n_channel, n_strfun)
	type(sf_channel_t), dimension(:), intent(out), allocatable :: channel
	integer, intent(in) :: n_channel
	integer, intent(in) :: n_strfun
	integer :: c
	allocate (channel (n_channel))
	do c = 1, n_channel
	call channel(c)%init (n_strfun)
	end do
	end subroutine allocate_sf_channels

	@ %def allocate_sf_channels
	@ This marks a given subset of indices as single-mapping.
	<<SF mappings: sf channel: TBP>>=
	procedure :: activate_mapping => sf_channel_activate_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_activate_mapping (channel, i_sf)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	channel%map_code(i_sf) = SFMAP_SINGLE
	end subroutine sf_channel_activate_mapping

	@ %def sf_channel_activate_mapping
	@ This sets an s-channel multichannel mapping. The parameter indices
	are not yet set.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_s_mapping => sf_channel_set_s_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_s_mapping (channel, i_sf, power)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: power
	channel%map_code(i_sf) = SFMAP_MULTI_S
	allocate (sf_s_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_s_mapping_t)
	call mapping%init (power)
	end select
	end subroutine sf_channel_set_s_mapping

	@ %def sf_channel_set_s_mapping
	@ This sets an s-channel resonance multichannel mapping.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_res_mapping => sf_channel_set_res_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_res_mapping (channel, i_sf, m, w, single)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in) :: m, w
	logical, intent(in) :: single
	if (single) then
	channel%map_code(i_sf) = SFMAP_MULTI_SRS
	allocate (sf_res_mapping_single_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_res_mapping_single_t)
	call mapping%init (m, w)
	end select
	else
	channel%map_code(i_sf) = SFMAP_MULTI_RES
	allocate (sf_res_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_res_mapping_t)
	call mapping%init (m, w)
	end select
	end if
	end subroutine sf_channel_set_res_mapping

	@ %def sf_channel_set_res_mapping
	@ This sets an s-channel on-shell multichannel mapping. The length of the
	[[i_sf]] array must be 2. (The first parameter actually becomes an
	irrelevant dummy.)
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_os_mapping => sf_channel_set_os_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_os_mapping (channel, i_sf, m, single)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in) :: m
	logical, intent(in) :: single
	if (single) then
	channel%map_code(i_sf) = SFMAP_MULTI_SON
	allocate (sf_os_mapping_single_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_os_mapping_single_t)
	call mapping%init (m)
	end select
	else
	channel%map_code(i_sf) = SFMAP_MULTI_ONS
	allocate (sf_os_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_os_mapping_t)
	call mapping%init (m)
	end select
	end if
	end subroutine sf_channel_set_os_mapping

	@ %def sf_channel_set_os_mapping
	@ This sets an s-channel endpoint mapping. The parameter $a$ is the
	slope parameter (default 1); increasing it moves the endpoint region
	(at $x=1$ to lower values in the input parameter.
	region even more.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_ep_mapping => sf_channel_set_ep_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_ep_mapping (channel, i_sf, a)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: a
	channel%map_code(i_sf) = SFMAP_MULTI_EP
	allocate (sf_ep_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_ep_mapping_t)
	call mapping%init (a = a)
	end select
	end subroutine sf_channel_set_ep_mapping

	@ %def sf_channel_set_ep_mapping
	@ This sets a resonant endpoint mapping.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_epr_mapping => sf_channel_set_epr_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_epr_mapping (channel, i_sf, a, m, w)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in) :: a, m, w
	channel%map_code(i_sf) = SFMAP_MULTI_EPR
	allocate (sf_epr_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_epr_mapping_t)
	call mapping%init (a, m, w)
	end select
	end subroutine sf_channel_set_epr_mapping

	@ %def sf_channel_set_epr_mapping
	@ This sets an on-shell endpoint mapping.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_epo_mapping => sf_channel_set_epo_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_epo_mapping (channel, i_sf, a, m)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in) :: a, m
	channel%map_code(i_sf) = SFMAP_MULTI_EPO
	allocate (sf_epo_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_epo_mapping_t)
	call mapping%init (a, m)
	end select
	end subroutine sf_channel_set_epo_mapping

	@ %def sf_channel_set_epo_mapping
	@ This sets an s-channel power mapping, regulating a singularity of
	type $(1-x)^{-1+\epsilon}$. The parameter $\epsilon$ depends on the
	structure function.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_ip_mapping => sf_channel_set_ip_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_ip_mapping (channel, i_sf, eps)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: eps
	channel%map_code(i_sf) = SFMAP_MULTI_IP
	allocate (sf_ip_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_ip_mapping_t)
	call mapping%init (eps)
	end select
	end subroutine sf_channel_set_ip_mapping

	@ %def sf_channel_set_ip_mapping
	@ This sets an s-channel resonant power mapping, regulating a
	singularity of type $(1-x)^{-1+\epsilon}$ in the presence of an
	s-channel resonance. The parameter $\epsilon$ depends on the
	structure function.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_ipr_mapping => sf_channel_set_ipr_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_ipr_mapping (channel, i_sf, eps, m, w)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: eps, m, w
	channel%map_code(i_sf) = SFMAP_MULTI_IPR
	allocate (sf_ipr_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_ipr_mapping_t)
	call mapping%init (eps, m, w)
	end select
	end subroutine sf_channel_set_ipr_mapping

	@ %def sf_channel_set_ipr_mapping
	@ This sets an on-shell power mapping, regulating a
	singularity of type $(1-x)^{-1+\epsilon}$ for the production of a
	single on-shell particle.. The parameter $\epsilon$ depends on the
	structure function.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_ipo_mapping => sf_channel_set_ipo_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_ipo_mapping (channel, i_sf, eps, m)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: eps, m
	channel%map_code(i_sf) = SFMAP_MULTI_IPO
	allocate (sf_ipo_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_ipo_mapping_t)
	call mapping%init (eps, m)
	end select
	end subroutine sf_channel_set_ipo_mapping

	@ %def sf_channel_set_ipo_mapping
	@ This sets a combined endpoint/ISR mapping.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_ei_mapping => sf_channel_set_ei_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_ei_mapping (channel, i_sf, a, eps)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: a, eps
	channel%map_code(i_sf) = SFMAP_MULTI_EI
	allocate (sf_ei_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_ei_mapping_t)
	call mapping%init (a, eps)
	end select
	end subroutine sf_channel_set_ei_mapping

	@ %def sf_channel_set_ei_mapping
	@ This sets a combined endpoint/ISR mapping with resonance.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_eir_mapping => sf_channel_set_eir_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_eir_mapping (channel, i_sf, a, eps, m, w)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: a, eps, m, w
	channel%map_code(i_sf) = SFMAP_MULTI_EI
	allocate (sf_eir_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_eir_mapping_t)
	call mapping%init (a, eps, m, w)
	end select
	end subroutine sf_channel_set_eir_mapping

	@ %def sf_channel_set_eir_mapping
	@ This sets a combined endpoint/ISR mapping, on-shell.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_eio_mapping => sf_channel_set_eio_mapping
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_eio_mapping (channel, i_sf, a, eps, m)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: a, eps, m
	channel%map_code(i_sf) = SFMAP_MULTI_EI
	allocate (sf_eio_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_eio_mapping_t)
	call mapping%init (a, eps, m)
	end select
	end subroutine sf_channel_set_eio_mapping

	@ %def sf_channel_set_eio_mapping
	@ Return true if the mapping code at position [[i_sf]] is [[SFMAP_SINGLE]].
	<<SF mappings: sf channel: TBP>>=
	procedure :: is_single_mapping => sf_channel_is_single_mapping
	<<SF mappings: procedures>>=
	function sf_channel_is_single_mapping (channel, i_sf) result (flag)
	class(sf_channel_t), intent(in) :: channel
	integer, intent(in) :: i_sf
	logical :: flag
	flag = channel%map_code(i_sf) == SFMAP_SINGLE
	end function sf_channel_is_single_mapping

	@ %def sf_channel_is_single_mapping
	@ Return true if the mapping code at position [[i_sf]] is any of the
	[[SFMAP_MULTI]] mappings.
	<<SF mappings: sf channel: TBP>>=
	procedure :: is_multi_mapping => sf_channel_is_multi_mapping
	<<SF mappings: procedures>>=
	function sf_channel_is_multi_mapping (channel, i_sf) result (flag)
	class(sf_channel_t), intent(in) :: channel
	integer, intent(in) :: i_sf
	logical :: flag
	select case (channel%map_code(i_sf))
	case (SFMAP_NONE, SFMAP_SINGLE)
	flag = .false.
	case default
	flag = .true.
	end select
	end function sf_channel_is_multi_mapping

	@ %def sf_channel_is_multi_mapping
	@ Return the number of parameters that the multi-mapping requires. The
	mapping object must be allocated.
	<<SF mappings: sf channel: TBP>>=
	procedure :: get_multi_mapping_n_par => sf_channel_get_multi_mapping_n_par
	<<SF mappings: procedures>>=
	function sf_channel_get_multi_mapping_n_par (channel) result (n_par)
	class(sf_channel_t), intent(in) :: channel
	integer :: n_par
	if (allocated (channel%multi_mapping)) then
	n_par = channel%multi_mapping%get_n_dim ()
	else
	n_par = 0
	end if
	end function sf_channel_get_multi_mapping_n_par

	@ %def sf_channel_is_multi_mapping
	@ Return true if there is any nontrivial mapping in any of the channels.

	Note: we provide an explicit public function. gfortran 4.6.3 has
	problems with the alternative implementation as a type-bound
	procedure for an array base object.
	<<SF mappings: public>>=
	public :: any_sf_channel_has_mapping
	<<SF mappings: procedures>>=
	function any_sf_channel_has_mapping (channel) result (flag)
	type(sf_channel_t), dimension(:), intent(in) :: channel
	logical :: flag
	integer :: c
	flag = .false.
	do c = 1, size (channel)
	flag = flag .or. any (channel(c)%map_code /= SFMAP_NONE)
	end do
	end function any_sf_channel_has_mapping

	@ %def any_sf_channel_has_mapping
	@ Set a parameter index for an active multi mapping. We assume that
	the index array is allocated properly.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_par_index => sf_channel_set_par_index
	<<SF mappings: procedures>>=
	subroutine sf_channel_set_par_index (channel, j, i_par)
	class(sf_channel_t), intent(inout) :: channel
	integer, intent(in) :: j
	integer, intent(in) :: i_par
	associate (mapping => channel%multi_mapping)
	if (j >= 1 .and. j <= mapping%get_n_dim ()) then
	if (mapping%get_index (j) == 0) then
	call channel%multi_mapping%set_index (j, i_par)
	else
	call msg_bug ("Structure-function setup: mapping index set twice")
	end if
	else
	call msg_bug ("Structure-function setup: mapping index out of range")
	end if
	end associate
	end subroutine sf_channel_set_par_index

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

	module sf_mappings_ut
	use unit_tests
	use sf_mappings_uti

	<<Standard module head>>

	<<SF mappings: public test>>

	contains

	<<SF mappings: test driver>>

	end module sf_mappings_ut
	@ %def sf_mappings_ut
	@
	<<[[sf_mappings_uti.f90]]>>=
	<<File header>>

	module sf_mappings_uti

	<<Use kinds>>
	use format_defs, only: FMT_11, FMT_12, FMT_13, FMT_14, FMT_15, FMT_16

	use sf_mappings

	<<Standard module head>>

	<<SF mappings: test declarations>>

	contains

	<<SF mappings: tests>>

	end module sf_mappings_uti
	@ %def sf_mappings_ut
	@ API: driver for the unit tests below.
	<<SF mappings: public test>>=
	public :: sf_mappings_test
	<<SF mappings: test driver>>=
	subroutine sf_mappings_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF mappings: execute tests>>
	end subroutine sf_mappings_test

	@ %def sf_mappings_test
	@
	\subsubsection{Check standard mapping}
	Probe the standard mapping of the unit square for different parameter
	values. Also calculates integrals. For a finite number of bins, they differ
	slightly from $1$, but the result is well-defined because we are not using
	random points.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_1, "sf_mappings_1", &
	"standard pair mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_1
	<<SF mappings: tests>>=
	subroutine sf_mappings_1 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_1"
	write (u, "(A)") "* Purpose: probe standard mapping"
	write (u, "(A)")

	allocate (sf_s_mapping_t :: mapping)
	select type (mapping)
	type is (sf_s_mapping_t)
	call mapping%init ()
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.1):"
	p = [0.1_default, 0.1_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)
	allocate (sf_s_mapping_t :: mapping)
	select type (mapping)
	type is (sf_s_mapping_t)
	call mapping%init (power=2._default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

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

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.1):"
	p = [0.1_default, 0.1_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

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

	end subroutine sf_mappings_1

	@ %def sf_mappings_1
	@
	\subsubsection{Channel entries}
	Construct channel entries and print them.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_2, "sf_mappings_2", &
	"structure-function mapping channels", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_2
	<<SF mappings: tests>>=
	subroutine sf_mappings_2 (u)
	integer, intent(in) :: u
	type(sf_channel_t), dimension(:), allocatable :: channel
	integer :: c

	write (u, "(A)") "* Test output: sf_mappings_2"
	write (u, "(A)") "* Purpose: construct and display &
	&mapping-channel objects"
	write (u, "(A)")

	call allocate_sf_channels (channel, n_channel = 8, n_strfun = 2)
	call channel(2)%activate_mapping ([1])
	call channel(3)%set_s_mapping ([1,2])
	call channel(4)%set_s_mapping ([1,2], power=2._default)
	call channel(5)%set_res_mapping ([1,2], m = 0.5_default, w = 0.1_default, single = .false.)
	call channel(6)%set_os_mapping ([1,2], m = 0.5_default, single = .false.)
	call channel(7)%set_res_mapping ([1], m = 0.5_default, w = 0.1_default, single = .true.)
	call channel(8)%set_os_mapping ([1], m = 0.5_default, single = .true.)

	call channel(3)%set_par_index (1, 1)
	call channel(3)%set_par_index (2, 4)

	call channel(4)%set_par_index (1, 1)
	call channel(4)%set_par_index (2, 4)

	call channel(5)%set_par_index (1, 1)
	call channel(5)%set_par_index (2, 3)

	call channel(6)%set_par_index (1, 1)
	call channel(6)%set_par_index (2, 2)

	call channel(7)%set_par_index (1, 1)

	call channel(8)%set_par_index (1, 1)

	do c = 1, size (channel)
	write (u, "(I0,':')", advance="no") c
	call channel(c)%write (u)
	end do

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

	end subroutine sf_mappings_2

	@ %def sf_mappings_2
	@
	\subsubsection{Check resonance mapping}
	Probe the resonance mapping of the unit square for different parameter
	values. Also calculates integrals. For a finite number of bins, they differ
	slightly from $1$, but the result is well-defined because we are not using
	random points.

	The resonance mass is at $1/2$ the energy, the width is $1/10$.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_3, "sf_mappings_3", &
	"resonant pair mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_3
	<<SF mappings: tests>>=
	subroutine sf_mappings_3 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_3"
	write (u, "(A)") "* Purpose: probe resonance pair mapping"
	write (u, "(A)")

	allocate (sf_res_mapping_t :: mapping)
	select type (mapping)
	type is (sf_res_mapping_t)
	call mapping%init (0.5_default, 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.1):"
	p = [0.1_default, 0.1_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_3

	@ %def sf_mappings_3
	@
	\subsubsection{Check on-shell mapping}
	Probe the on-shell mapping of the unit square for different parameter
	values. Also calculates integrals. In this case, the Jacobian is
	constant and given by $\|\log m^2\|$, so this is also the value of the
	integral. The factor results from the variable change in the $\delta$
	function $\delta (m^2 - x_1x_2)$ which multiplies the cross section
	for the case at hand.

	For the test, the (rescaled) resonance mass is set at $1/2$ the
	energy.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_4, "sf_mappings_4", &
	"on-shell pair mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_4
	<<SF mappings: tests>>=
	subroutine sf_mappings_4 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_4"
	write (u, "(A)") "* Purpose: probe on-shell pair mapping"
	write (u, "(A)")

	allocate (sf_os_mapping_t :: mapping)
	select type (mapping)
	type is (sf_os_mapping_t)
	call mapping%init (0.5_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0,0.1):"
	p = [0._default, 0.1_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0,1.0):"
	p = [0._default, 1.0_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_4

	@ %def sf_mappings_4
	@
	\subsubsection{Check endpoint mapping}
	Probe the endpoint mapping of the unit square for different parameter
	values. Also calculates integrals. For a finite number of bins, they differ
	slightly from $1$, but the result is well-defined because we are not using
	random points.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_5, "sf_mappings_5", &
	"endpoint pair mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_5
	<<SF mappings: tests>>=
	subroutine sf_mappings_5 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_5"
	write (u, "(A)") "* Purpose: probe endpoint pair mapping"
	write (u, "(A)")

	allocate (sf_ep_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ep_mapping_t)
	call mapping%init ()
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_5

	@ %def sf_mappings_5
	@
	\subsubsection{Check endpoint resonant mapping}
	Probe the endpoint mapping with resonance. Also calculates integrals.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_6, "sf_mappings_6", &
	"endpoint resonant mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_6
	<<SF mappings: tests>>=
	subroutine sf_mappings_6 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_6"
	write (u, "(A)") "* Purpose: probe endpoint resonant mapping"
	write (u, "(A)")

	allocate (sf_epr_mapping_t :: mapping)
	select type (mapping)
	type is (sf_epr_mapping_t)
	call mapping%init (a = 1._default, m = 0.5_default, w = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

	write (u, "(A)")
	write (u, "(A)") "* Same mapping without resonance:"
	write (u, "(A)")

	allocate (sf_epr_mapping_t :: mapping)
	select type (mapping)
	type is (sf_epr_mapping_t)
	call mapping%init (a = 1._default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_6

	@ %def sf_mappings_6
	@
	\subsubsection{Check endpoint on-shell mapping}
	Probe the endpoint mapping with an on-shell particle. Also calculates
	integrals.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_7, "sf_mappings_7", &
	"endpoint on-shell mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_7
	<<SF mappings: tests>>=
	subroutine sf_mappings_7 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_7"
	write (u, "(A)") "* Purpose: probe endpoint on-shell mapping"
	write (u, "(A)")

	allocate (sf_epo_mapping_t :: mapping)
	select type (mapping)
	type is (sf_epo_mapping_t)
	call mapping%init (a = 1._default, m = 0.5_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_7

	@ %def sf_mappings_7
	@
	\subsubsection{Check power mapping}
	Probe the power mapping of the unit square for different parameter
	values. Also calculates integrals. For a finite number of bins, they differ
	slightly from $1$, but the result is well-defined because we are not using
	random points.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_8, "sf_mappings_8", &
	"power pair mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_8
	<<SF mappings: tests>>=
	subroutine sf_mappings_8 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_8"
	write (u, "(A)") "* Purpose: probe power pair mapping"
	write (u, "(A)")

	allocate (sf_ip_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ip_mapping_t)
	call mapping%init (eps = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.5):"
	p = [0._default, 0.5_default]
	pb= [1._default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9,0.5):"
	p = [0.9_default, 0.5_default]
	pb= [0.1_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	pb= [0.3_default, 0.8_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.8):"
	p = [0.7_default, 0.8_default]
	pb= [0.3_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.99,0.02):"
	p = [0.99_default, 0.02_default]
	pb= [0.01_default, 0.98_default]
	call mapping%check (u, p, pb, FMT_14, FMT_12)

	write (u, *)
	write (u, "(A)") "Probe at (0.99,0.98):"
	p = [0.99_default, 0.98_default]
	pb= [0.01_default, 0.02_default]
	call mapping%check (u, p, pb, FMT_14, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_8

	@ %def sf_mappings_8
	@
	\subsubsection{Check resonant power mapping}
	Probe the power mapping of the unit square, adapted for an s-channel
	resonance, for different parameter values. Also calculates integrals.
	For a finite number of bins, they differ slightly from $1$, but the
	result is well-defined because we are not using random points.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_9, "sf_mappings_9", &
	"power resonance mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_9
	<<SF mappings: tests>>=
	subroutine sf_mappings_9 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_9"
	write (u, "(A)") "* Purpose: probe power resonant pair mapping"
	write (u, "(A)")

	allocate (sf_ipr_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ipr_mapping_t)
	call mapping%init (eps = 0.1_default, m = 0.5_default, w = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.5):"
	p = [0._default, 0.5_default]
	pb= [1._default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9,0.5):"
	p = [0.9_default, 0.5_default]
	pb= [0.1_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	pb= [0.3_default, 0.8_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.8):"
	p = [0.7_default, 0.8_default]
	pb= [0.3_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9999,0.02):"
	p = [0.9999_default, 0.02_default]
	pb= [0.0001_default, 0.98_default]
	call mapping%check (u, p, pb, FMT_11, FMT_12)

	write (u, *)
	write (u, "(A)") "Probe at (0.9999,0.98):"
	p = [0.9999_default, 0.98_default]
	pb= [0.0001_default, 0.02_default]
	call mapping%check (u, p, pb, FMT_11, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

	write (u, "(A)")
	write (u, "(A)") "* Same mapping without resonance:"
	write (u, "(A)")

	allocate (sf_ipr_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ipr_mapping_t)
	call mapping%init (eps = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.5):"
	p = [0._default, 0.5_default]
	pb= [1._default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9,0.5):"
	p = [0.9_default, 0.5_default]
	pb= [0.1_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	pb= [0.3_default, 0.8_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.8):"
	p = [0.7_default, 0.8_default]
	pb= [0.3_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_9

	@ %def sf_mappings_9
	@
	\subsubsection{Check on-shell power mapping}
	Probe the power mapping of the unit square, adapted for
	single-particle production, for different parameter values. Also
	calculates integrals. For a finite number of bins, they differ
	slightly from $1$, but the result is well-defined because we are not
	using random points.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_10, "sf_mappings_10", &
	"power on-shell mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_10
	<<SF mappings: tests>>=
	subroutine sf_mappings_10 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_10"
	write (u, "(A)") "* Purpose: probe power on-shell mapping"
	write (u, "(A)")

	allocate (sf_ipo_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ipo_mapping_t)
	call mapping%init (eps = 0.1_default, m = 0.5_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.5):"
	p = [0._default, 0.5_default]
	pb= [1._default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.02):"
	p = [0._default, 0.02_default]
	pb= [1._default, 0.98_default]
	call mapping%check (u, p, pb, FMT_15, FMT_12)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.98):"
	p = [0._default, 0.98_default]
	pb= [1._default, 0.02_default]
	call mapping%check (u, p, pb, FMT_15, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_10

	@ %def sf_mappings_10
	@
	\subsubsection{Check combined endpoint-power mapping}
	Probe the mapping for the beamstrahlung/ISR combination.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_11, "sf_mappings_11", &
	"endpoint/power combined mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_11
	<<SF mappings: tests>>=
	subroutine sf_mappings_11 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(4) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_11"
	write (u, "(A)") "* Purpose: probe power pair mapping"
	write (u, "(A)")

	allocate (sf_ei_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ei_mapping_t)
	call mapping%init (eps = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	call mapping%set_index (3, 3)
	call mapping%set_index (4, 4)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0.5, 0.5, 0.5, 0.5):"
	p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7, 0.2, 0.4, 0.8):"
	p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
	pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9, 0.06, 0.95, 0.1):"
	p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
	pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
	call mapping%check (u, p, pb, FMT_13, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_11

	@ %def sf_mappings_11
	@
	\subsubsection{Check resonant endpoint-power mapping}
	Probe the mapping for the beamstrahlung/ISR combination.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_12, "sf_mappings_12", &
	"endpoint/power resonant combined mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_12
	<<SF mappings: tests>>=
	subroutine sf_mappings_12 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(4) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_12"
	write (u, "(A)") "* Purpose: probe resonant combined mapping"
	write (u, "(A)")

	allocate (sf_eir_mapping_t :: mapping)
	select type (mapping)
	type is (sf_eir_mapping_t)
	call mapping%init (a = 1._default, &
	eps = 0.1_default, m = 0.5_default, w = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	call mapping%set_index (3, 3)
	call mapping%set_index (4, 4)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0.5, 0.5, 0.5, 0.5):"
	p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7, 0.2, 0.4, 0.8):"
	p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
	pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9, 0.06, 0.95, 0.1):"
	p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
	pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
	call mapping%check (u, p, pb, FMT_15, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_12

	@ %def sf_mappings_12
	@
	\subsubsection{Check on-shell endpoint-power mapping}
	Probe the mapping for the beamstrahlung/ISR combination.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_13, "sf_mappings_13", &
	"endpoint/power on-shell combined mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_13
	<<SF mappings: tests>>=
	subroutine sf_mappings_13 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(4) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_13"
	write (u, "(A)") "* Purpose: probe on-shell combined mapping"
	write (u, "(A)")

	allocate (sf_eio_mapping_t :: mapping)
	select type (mapping)
	type is (sf_eio_mapping_t)
	call mapping%init (a = 1._default, eps = 0.1_default, m = 0.5_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	call mapping%set_index (3, 3)
	call mapping%set_index (4, 4)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0.5, 0.5, 0.5, 0.5):"
	p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7, 0.2, 0.4, 0.8):"
	p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
	pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9, 0.06, 0.95, 0.1):"
	p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
	pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
	call mapping%check (u, p, pb, FMT_14, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_13

	@ %def sf_mappings_13
	@
	\subsubsection{Check rescaling}
	Check the rescaling factor in on-shell basic mapping.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_14, "sf_mappings_14", &
	"rescaled on-shell mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_14
	<<SF mappings: tests>>=
	subroutine sf_mappings_14 (u)
	integer, intent(in) :: u
	real(default), dimension(2) :: p2, r2
	real(default), dimension(1) :: p1, r1
	real(default) :: f, x_free, m2

	write (u, "(A)") "* Test output: sf_mappings_14"
	write (u, "(A)") "* Purpose: probe rescaling in os mapping"
	write (u, "(A)")

	x_free = 0.9_default
	m2 = 0.5_default

	write (u, "(A)") "* Two parameters"
	write (u, "(A)")

	p2 = [0.1_default, 0.2_default]

	call map_on_shell (r2, f, p2, -log (m2), x_free)

	write (u, "(A,9(1x," // FMT_14 // "))") "p =", p2
	write (u, "(A,9(1x," // FMT_14 // "))") "r =", r2
	write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
	write (u, "(A,9(1x," // FMT_14 // "))") "r=", x_free product (r2)

	write (u, *)

	call map_on_shell_inverse (r2, f, p2, -log (m2), x_free)

	write (u, "(A,9(1x," // FMT_14 // "))") "p =", p2
	write (u, "(A,9(1x," // FMT_14 // "))") "r =", r2
	write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
	write (u, "(A,9(1x," // FMT_14 // "))") "r=", x_free product (r2)

	write (u, "(A)")
	write (u, "(A)") "* One parameter"
	write (u, "(A)")

	p1 = [0.1_default]

	call map_on_shell_single (r1, f, p1, -log (m2), x_free)

	write (u, "(A,9(1x," // FMT_14 // "))") "p =", p1
	write (u, "(A,9(1x," // FMT_14 // "))") "r =", r1
	write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
	write (u, "(A,9(1x," // FMT_14 // "))") "r=", x_free product (r1)

	write (u, *)

	call map_on_shell_single_inverse (r1, f, p1, -log (m2), x_free)

	write (u, "(A,9(1x," // FMT_14 // "))") "p =", p1
	write (u, "(A,9(1x," // FMT_14 // "))") "r =", r1
	write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
	write (u, "(A,9(1x," // FMT_14 // "))") "r=", x_free product (r1)

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

	end subroutine sf_mappings_14

	@ %def sf_mappings_14
	@
	\subsubsection{Check single parameter resonance mapping}
	Probe the resonance mapping of the unit interval for different parameter
	values. Also calculates integrals.

	The resonance mass is at $1/2$ the energy, the width is $1/10$.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_15, "sf_mappings_15", &
	"resonant single mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_15
	<<SF mappings: tests>>=
	subroutine sf_mappings_15 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(1) :: p

	write (u, "(A)") "* Test output: sf_mappings_15"
	write (u, "(A)") "* Purpose: probe resonance single mapping"
	write (u, "(A)")

	allocate (sf_res_mapping_single_t :: mapping)
	select type (mapping)
	type is (sf_res_mapping_single_t)
	call mapping%init (0.5_default, 0.1_default)
	call mapping%set_index (1, 1)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0):"
	p = [0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5):"
	p = [0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1):"
	p = [0.1_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_15

	@ %def sf_mappings_15
	@
	\subsubsection{Check single parameter on-shell mapping}
	Probe the on-shell (pseudo) mapping of the unit interval for different parameter
	values. Also calculates integrals.

	The resonance mass is at $1/2$ the energy.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_16, "sf_mappings_16", &
	"on-shell single mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_16
	<<SF mappings: tests>>=
	subroutine sf_mappings_16 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(1) :: p

	write (u, "(A)") "* Test output: sf_mappings_16"
	write (u, "(A)") "* Purpose: probe on-shell single mapping"
	write (u, "(A)")

	allocate (sf_os_mapping_single_t :: mapping)
	select type (mapping)
	type is (sf_os_mapping_single_t)
	call mapping%init (0.5_default)
	call mapping%set_index (1, 1)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0):"
	p = [0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5):"
	p = [0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_16

	@ %def sf_mappings_16
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Structure function base}

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

	module sf_base

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_utils, only: write_separator
	use format_defs, only: FMT_17, FMT_19
	use physics_defs, only: n_beam_structure_int
	use diagnostics
	use lorentz
	use quantum_numbers
	use interactions
	use evaluators
	use pdg_arrays
	use beams
	use sf_aux
	use sf_mappings

	<<Standard module head>>

	<<SF base: public>>

	<<SF base: parameters>>

	<<SF base: types>>

	<<SF base: interfaces>>

	contains

	<<SF base: procedures>>

	end module sf_base
	@ %def sf_base
	@
	\subsection{Abstract rescale data-type}

	NLO calculations involve treatment of initial state parton radiation.
	The radiation of a parton rescale the energy fraction which enters the hard process.
	We allow for different rescale settings by extending the abstract
	[[sf_rescale_t]] data type.
	<<SF base: public>>=
	public :: sf_rescale_t
	<<SF base: types>>=
	type, abstract :: sf_rescale_t
	integer :: i_restricted_beam = -1
	integer :: i_beam = 0
	logical :: gluon = .false.
	contains
	<<SF base: rescaling function: TBP>>
	end type sf_rescale_t

	@ %def sf_rescale_t
	@
	<<SF base: rescaling function: TBP>>=
	procedure (sf_rescale_apply), deferred :: apply
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_rescale_apply (func, x)
	import
	class(sf_rescale_t), intent(in) :: func
	real(default), intent(inout) :: x
	end subroutine sf_rescale_apply
	end interface

	@ %def rescale_apply
	@
	<<SF base: rescaling function: TBP>>=
	procedure :: set_i_beam => sf_rescale_set_i_beam
	<<SF base: procedures>>=
	subroutine sf_rescale_set_i_beam (func, i_beam)
	class(sf_rescale_t), intent(inout) :: func
	integer, intent(in) :: i_beam
	func%i_beam = i_beam
	end subroutine sf_rescale_set_i_beam

	@ %def rescale_set_i_beam
	@ Restrict rescaling to beam with index [[i_beam]].
	<<SF base: rescaling function: TBP>>=
	procedure :: restrict_to_beam => sf_rescale_restrict_to_beam
	<<SF base: procedures>>=
	subroutine sf_rescale_restrict_to_beam (func, i_beam)
	class(sf_rescale_t), intent(inout) :: func
	integer, intent(in) :: i_beam
	if (func%i_restricted_beam > 0) &
	call msg_bug ("[sf_rescale_restrict_to_beam] restricted beam already set.")
	func%i_restricted_beam = i_beam
	end subroutine sf_rescale_restrict_to_beam

	@ %def sf_rescale_set_rescaled_beam
	@ Test on restricted beam momentum rescaling or no restriction.
	<<SF base: rescaling function: TBP>>=
	procedure :: is_restricted => sf_rescale_is_restricted
	<<SF base: procedures>>=
	logical function sf_rescale_is_restricted (func, i_beam) result (yorn)
	class(sf_rescale_t), intent(in) :: func
	integer, intent(in) :: i_beam
	yorn = (func%i_restricted_beam > 0)
	yorn = yorn .and. (func%i_restricted_beam /= i_beam)
	end function sf_rescale_is_restricted

	@ %def sf_rescale_is_restricted
	@ In case, gluon splits into quark/anti-quark, the DGLAP formulas become
	degenerate over flavours. We add subtraction with gluonic pdfs only which are
	convoluted with all quark/anti-quark flavours - hence PDF singlet.
	<<SF base: rescaling function: TBP>>=
	procedure :: set_gluons => sf_rescale_set_gluons
	procedure :: has_gluons => sf_rescale_has_gluons
	<<SF base: procedures>>=
	subroutine sf_rescale_set_gluons (func, yorn)
	class(sf_rescale_t), intent(inout) :: func
	logical, intent(in) :: yorn
	func%gluon = yorn
	end subroutine sf_rescale_set_gluons

	logical function sf_rescale_has_gluons (func) result (yorn)
	class(sf_rescale_t), intent(in) :: func
	yorn = func%gluon
	end function sf_rescale_has_gluons

	@ %def sf_rescale_set_gluons rescale_has_gluons
	@
	\subsection{Abstract structure-function data type}
	This type should hold all configuration data for a specific type of
	structure function. The base object is empty; the implementations
	will fill it.
	<<SF base: public>>=
	public :: sf_data_t
	<<SF base: types>>=
	type, abstract :: sf_data_t
	contains
	<<SF base: sf data: TBP>>
	end type sf_data_t

	@ %def sf_data_t
	@ Output.
	<<SF base: sf data: TBP>>=
	procedure (sf_data_write), deferred :: write
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_data_write (data, unit, verbose)
	import
	class(sf_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine sf_data_write
	end interface

	@ %def sf_data_write
	@ Return true if this structure function is in generator mode. In
	that case, all parameters are free, otherwise bound. (We do not
	support mixed cases.) Default is: no generator.
	<<SF base: sf data: TBP>>=
	procedure :: is_generator => sf_data_is_generator
	<<SF base: procedures>>=
	function sf_data_is_generator (data) result (flag)
	class(sf_data_t), intent(in) :: data
	logical :: flag
	flag = .false.
	end function sf_data_is_generator

	@ %def sf_data_is_generator
	@ Return the number of input parameters that determine the
	structure function.
	<<SF base: sf data: TBP>>=
	procedure (sf_data_get_int), deferred :: get_n_par
	<<SF base: interfaces>>=
	abstract interface
	function sf_data_get_int (data) result (n)
	import
	class(sf_data_t), intent(in) :: data
	integer :: n
	end function sf_data_get_int
	end interface

	@ %def sf_data_get_int
	@ Return the outgoing particle PDG codes for the current setup. The codes can
	be an array of particles, for each beam.
	<<SF base: sf data: TBP>>=
	procedure (sf_data_get_pdg_out), deferred :: get_pdg_out
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_data_get_pdg_out (data, pdg_out)
	import
	class(sf_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine sf_data_get_pdg_out
	end interface

	@ %def sf_data_get_pdg_out
	@ Allocate a matching structure function interaction object and
	properly initialize it.

	<<SF base: sf data: TBP>>=
	procedure (sf_data_allocate_sf_int), deferred :: allocate_sf_int
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_data_allocate_sf_int (data, sf_int)
	import
	class(sf_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	end subroutine sf_data_allocate_sf_int
	end interface

	@ %def sf_data_allocate_sf_int
	@ Return the PDF set index, if applicable. We implement a default
	method which returns zero. The PDF (builtin and LHA) implementations
	will override this.
	<<SF base: sf data: TBP>>=
	procedure :: get_pdf_set => sf_data_get_pdf_set
	<<SF base: procedures>>=
	elemental function sf_data_get_pdf_set (data) result (pdf_set)
	class(sf_data_t), intent(in) :: data
	integer :: pdf_set
	pdf_set = 0
	end function sf_data_get_pdf_set

	@ %def sf_data_get_pdf_set
	@ Return the spectrum file, if applicable. We implement a default
	method which returns zero. CIRCE1, CIRCE2 and the beam spectrum will
	override this.
	<<SF base: sf data: TBP>>=
	procedure :: get_beam_file => sf_data_get_beam_file
	<<SF base: procedures>>=
	function sf_data_get_beam_file (data) result (file)
	class(sf_data_t), intent(in) :: data
	type(string_t) :: file
	file = ""
	end function sf_data_get_beam_file

	@ %def sf_data_get_beam_file
	@
	\subsection{Structure-function chain configuration}
	This is the data type that the [[process]] module uses for setting
	up its structure-function chain. For each structure function described
	by the beam data, there is an entry. The [[i]] array indicates the
	beam(s) to which this structure function applies, and the [[data]]
	object contains the actual configuration data.
	<<SF base: public>>=
	public :: sf_config_t
	<<SF base: types>>=
	type :: sf_config_t
	integer, dimension(:), allocatable :: i
	class(sf_data_t), allocatable :: data
	contains
	<<SF base: sf config: TBP>>
	end type sf_config_t

	@ %def sf_config_t
	@ Output:
	<<SF base: sf config: TBP>>=
	procedure :: write => sf_config_write
	<<SF base: procedures>>=
	subroutine sf_config_write (object, unit)
	class(sf_config_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	if (allocated (object%i)) then
	write (u, "(1x,A,2(1x,I0))") "Structure-function configuration: &
	&beam(s)", object%i
	if (allocated (object%data)) call object%data%write (u)
	else
	write (u, "(1x,A)") "Structure-function configuration: [undefined]"
	end if
	end subroutine sf_config_write

	@ %def sf_config_write
	@ Initialize.
	<<SF base: sf config: TBP>>=
	procedure :: init => sf_config_init
	<<SF base: procedures>>=
	subroutine sf_config_init (sf_config, i_beam, sf_data)
	class(sf_config_t), intent(out) :: sf_config
	integer, dimension(:), intent(in) :: i_beam
	class(sf_data_t), intent(in) :: sf_data
	allocate (sf_config%i (size (i_beam)), source = i_beam)
	allocate (sf_config%data, source = sf_data)
	end subroutine sf_config_init

	@ %def sf_config_init
	@ Return the PDF set, if any.
	<<SF base: sf config: TBP>>=
	procedure :: get_pdf_set => sf_config_get_pdf_set
	<<SF base: procedures>>=
	elemental function sf_config_get_pdf_set (sf_config) result (pdf_set)
	class(sf_config_t), intent(in) :: sf_config
	integer :: pdf_set
	pdf_set = sf_config%data%get_pdf_set ()
	end function sf_config_get_pdf_set

	@ %def sf_config_get_pdf_set
	@ Return the beam spectrum file, if any.
	<<SF base: sf config: TBP>>=
	procedure :: get_beam_file => sf_config_get_beam_file
	<<SF base: procedures>>=
	function sf_config_get_beam_file (sf_config) result (file)
	class(sf_config_t), intent(in) :: sf_config
	type(string_t) :: file
	file = sf_config%data%get_beam_file ()
	end function sf_config_get_beam_file

	@ %def sf_config_get_beam_file
	@
	\subsection{Structure-function instance}
	The [[sf_int_t]] data type contains an [[interaction_t]] object (it is
	an extension of this type) and a pointer to the [[sf_data_t]]
	configuration data. This interaction, or copies of it, is used to
	implement structure-function kinematics and dynamics in the context of
	process evaluation.

	The status code [[status]] tells whether the interaction is undefined,
	has defined kinematics (but matrix elements invalid), or is completely
	defined. There is also a status code for failure. The implementation
	is responsible for updating the status.

	The entries [[mi2]], [[mr2]], and [[mo2]] hold the squared
	invariant masses of the incoming, radiated, and outgoing particle,
	respectively. They are supposed to be set upon initialization, but
	could also be varied event by event.

	If the radiated or outgoing mass is nonzero, we may need to apply an
	on-shell projection. The projection mode is stored as
	[[on_shell_mode]].

	The array [[beam_index]] is the list of beams on which this structure
	function applies ($1$, $2$, or both). The arrays [[incoming]],
	[[radiated]], and [[outgoing]] contain the indices of the respective
	particle sets within the interaction, for convenient lookup. The
	array [[par_index]] indicates the MC input parameters that this entry
	will use up in the structure-function chain. The first parameter (or
	the first two, for a spectrum) in this array determines the momentum
	fraction and is thus subject to global mappings.

	In the abstract base type, we do not implement the data pointer. This
	allows us to restrict its type in the implementations.
	<<SF base: public>>=
	public :: sf_int_t
	<<SF base: types>>=
	type, abstract, extends (interaction_t) :: sf_int_t
	integer :: status = SF_UNDEFINED
	real(default), dimension(:), allocatable :: mi2
	real(default), dimension(:), allocatable :: mr2
	real(default), dimension(:), allocatable :: mo2
	integer :: on_shell_mode = KEEP_ENERGY
	logical :: qmin_defined = .false.
	logical :: qmax_defined = .false.
	real(default), dimension(:), allocatable :: qmin
	real(default), dimension(:), allocatable :: qmax
	integer, dimension(:), allocatable :: beam_index
	integer, dimension(:), allocatable :: incoming
	integer, dimension(:), allocatable :: radiated
	integer, dimension(:), allocatable :: outgoing
	integer, dimension(:), allocatable :: par_index
	integer, dimension(:), allocatable :: par_primary
	contains
	<<SF base: sf int: TBP>>
	end type sf_int_t

	@ %def sf_int_t
	@ Status codes. The codes that refer to links, masks, and
	connections, apply to structure-function chains only.

	The status codes are public.
	<<SF base: parameters>>=
	integer, parameter, public :: SF_UNDEFINED = 0
	integer, parameter, public :: SF_INITIAL = 1
	integer, parameter, public :: SF_DONE_LINKS = 2
	integer, parameter, public :: SF_FAILED_MASK = 3
	integer, parameter, public :: SF_DONE_MASK = 4
	integer, parameter, public :: SF_FAILED_CONNECTIONS = 5
	integer, parameter, public :: SF_DONE_CONNECTIONS = 6
	integer, parameter, public :: SF_SEED_KINEMATICS = 10
	integer, parameter, public :: SF_FAILED_KINEMATICS = 11
	integer, parameter, public :: SF_DONE_KINEMATICS = 12
	integer, parameter, public :: SF_FAILED_EVALUATION = 13
	integer, parameter, public :: SF_EVALUATED = 20

	@ %def SF_UNDEFINED SF_INITIAL
	@ %def SF_DONE_LINKS SF_DONE_MASK SF_DONE_CONNECTIONS
	@ %def SF_DONE_KINEMATICS SF_EVALUATED
	@ %def SF_FAILED_MASK SF_FAILED_CONNECTIONS
	@ %def SF_FAILED_KINEMATICS SF_FAILED_EVALUATION
	@ Write a string version of the status code:
	<<SF base: procedures>>=
	subroutine write_sf_status (status, u)
	integer, intent(in) :: status
	integer, intent(in) :: u
	select case (status)
	case (SF_UNDEFINED)
	write (u, "(1x,'[',A,']')") "undefined"
	case (SF_INITIAL)
	write (u, "(1x,'[',A,']')") "initialized"
	case (SF_DONE_LINKS)
	write (u, "(1x,'[',A,']')") "links set"
	case (SF_FAILED_MASK)
	write (u, "(1x,'[',A,']')") "mask mismatch"
	case (SF_DONE_MASK)
	write (u, "(1x,'[',A,']')") "mask set"
	case (SF_FAILED_CONNECTIONS)
	write (u, "(1x,'[',A,']')") "connections failed"
	case (SF_DONE_CONNECTIONS)
	write (u, "(1x,'[',A,']')") "connections set"
	case (SF_SEED_KINEMATICS)
	write (u, "(1x,'[',A,']')") "incoming momenta set"
	case (SF_FAILED_KINEMATICS)
	write (u, "(1x,'[',A,']')") "kinematics failed"
	case (SF_DONE_KINEMATICS)
	write (u, "(1x,'[',A,']')") "kinematics set"
	case (SF_FAILED_EVALUATION)
	write (u, "(1x,'[',A,']')") "evaluation failed"
	case (SF_EVALUATED)
	write (u, "(1x,'[',A,']')") "evaluated"
	end select
	end subroutine write_sf_status

	@ %def write_sf_status
	@ This is the basic output routine. Display status and interaction.
	<<SF base: sf int: TBP>>=
	procedure :: base_write => sf_int_base_write
	<<SF base: procedures>>=
	subroutine sf_int_base_write (object, unit, testflag)
	class(sf_int_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "SF instance:"
	call write_sf_status (object%status, u)
	if (allocated (object%beam_index)) &
	write (u, "(3x,A,2(1x,I0))") "beam =", object%beam_index
	if (allocated (object%incoming)) &
	write (u, "(3x,A,2(1x,I0))") "incoming =", object%incoming
	if (allocated (object%radiated)) &
	write (u, "(3x,A,2(1x,I0))") "radiated =", object%radiated
	if (allocated (object%outgoing)) &
	write (u, "(3x,A,2(1x,I0))") "outgoing =", object%outgoing
	if (allocated (object%par_index)) &
	write (u, "(3x,A,2(1x,I0))") "parameter =", object%par_index
	if (object%qmin_defined) &
	write (u, "(3x,A,1x," // FMT_19 // ")") "q_min =", object%qmin
	if (object%qmax_defined) &
	write (u, "(3x,A,1x," // FMT_19 // ")") "q_max =", object%qmax
	call object%interaction_t%basic_write (u, testflag = testflag)
	end subroutine sf_int_base_write

	@ %def sf_int_base_write
	@ The type string identifies the structure function class, and possibly more
	details about the structure function.
	<<SF base: sf int: TBP>>=
	procedure (sf_int_type_string), deferred :: type_string
	<<SF base: interfaces>>=
	abstract interface
	function sf_int_type_string (object) result (string)
	import
	class(sf_int_t), intent(in) :: object
	type(string_t) :: string
	end function sf_int_type_string
	end interface

	@ %def sf_int_type_string
	@ Output of the concrete object. We should not forget to call the
	output routine for the base type.
	<<SF base: sf int: TBP>>=
	procedure (sf_int_write), deferred :: write
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_int_write (object, unit, testflag)
	import
	class(sf_int_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine sf_int_write
	end interface

	@ %def sf_int_write
	@ Basic initialization: set the invariant masses for the particles and
	initialize the interaction. The caller should then add states to the
	interaction and freeze it.

	The dimension of the mask should be equal to the sum of the dimensions
	of the mass-squared arrays, which determine incoming, radiated, and
	outgoing particles, respectively.

	Optionally, we can define minimum and maximum values for the momentum
	transfer to the outgoing particle(s). If all masses are zero, this is
	actually required for non-collinear splitting.
	<<SF base: sf int: TBP>>=
	procedure :: base_init => sf_int_base_init
	<<SF base: procedures>>=
	subroutine sf_int_base_init &
	(sf_int, mask, mi2, mr2, mo2, qmin, qmax, hel_lock)
	class(sf_int_t), intent(out) :: sf_int
	type (quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	real(default), dimension(:), intent(in) :: mi2, mr2, mo2
	real(default), dimension(:), intent(in), optional :: qmin, qmax
	integer, dimension(:), intent(in), optional :: hel_lock
	allocate (sf_int%mi2 (size (mi2)))
	sf_int%mi2 = mi2
	allocate (sf_int%mr2 (size (mr2)))
	sf_int%mr2 = mr2
	allocate (sf_int%mo2 (size (mo2)))
	sf_int%mo2 = mo2
	if (present (qmin)) then
	sf_int%qmin_defined = .true.
	allocate (sf_int%qmin (size (qmin)))
	sf_int%qmin = qmin
	end if
	if (present (qmax)) then
	sf_int%qmax_defined = .true.
	allocate (sf_int%qmax (size (qmax)))
	sf_int%qmax = qmax
	end if
	call sf_int%interaction_t%basic_init &
	(size (mi2), 0, size (mr2) + size (mo2), &
	mask = mask, hel_lock = hel_lock, set_relations = .true.)
	end subroutine sf_int_base_init

	@ %def sf_int_base_init
	@ Set the indices of the incoming, radiated, and outgoing particles,
	respectively.
	<<SF base: sf int: TBP>>=
	procedure :: set_incoming => sf_int_set_incoming
	procedure :: set_radiated => sf_int_set_radiated
	procedure :: set_outgoing => sf_int_set_outgoing
	<<SF base: procedures>>=
	subroutine sf_int_set_incoming (sf_int, incoming)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: incoming
	allocate (sf_int%incoming (size (incoming)))
	sf_int%incoming = incoming
	end subroutine sf_int_set_incoming

	subroutine sf_int_set_radiated (sf_int, radiated)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: radiated
	allocate (sf_int%radiated (size (radiated)))
	sf_int%radiated = radiated
	end subroutine sf_int_set_radiated

	subroutine sf_int_set_outgoing (sf_int, outgoing)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: outgoing
	allocate (sf_int%outgoing (size (outgoing)))
	sf_int%outgoing = outgoing
	end subroutine sf_int_set_outgoing

	@ %def sf_int_set_incoming
	@ %def sf_int_set_radiated
	@ %def sf_int_set_outgoing
	@ Initialization. This proceeds via an abstract data object, which
	for the actual implementation should have the matching concrete type.
	Since all implementations have the same signature, we can prepare a
	deferred procedure. The data object will become the target of a
	corresponding pointer within the [[sf_int_t]] implementation.

	This should call the previous procedure.
	<<SF base: sf int: TBP>>=
	procedure (sf_int_init), deferred :: init
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_int_init (sf_int, data)
	import
	class(sf_int_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine sf_int_init
	end interface

	@ %def sf_int_init
	@ Complete initialization. This routine contains initializations that can
	only be performed after the interaction object got its final shape, i.e.,
	redundant helicities have been eliminated by matching with beams and process.

	The default implementation does nothing.

	The [[target]] attribute is formally required since some overriding
	implementations use a temporary pointer (iterator) to the state-matrix
	component. It doesn't appear to make a real difference, though.
	<<SF base: sf int: TBP>>=
	procedure :: setup_constants => sf_int_setup_constants
	<<SF base: procedures>>=
	subroutine sf_int_setup_constants (sf_int)
	class(sf_int_t), intent(inout), target :: sf_int
	end subroutine sf_int_setup_constants

	@ %def sf_int_setup_constants
	@ Set beam indices, i.e., the beam(s) on which
	this structure function applies.
	<<SF base: sf int: TBP>>=
	procedure :: set_beam_index => sf_int_set_beam_index
	<<SF base: procedures>>=
	subroutine sf_int_set_beam_index (sf_int, beam_index)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: beam_index
	allocate (sf_int%beam_index (size (beam_index)))
	sf_int%beam_index = beam_index
	end subroutine sf_int_set_beam_index

	@ %def sf_int_set_beam_index
	@ Set parameter indices, indicating which MC input parameters are to
	be used for evaluating this structure function.
	<<SF base: sf int: TBP>>=
	procedure :: set_par_index => sf_int_set_par_index
	<<SF base: procedures>>=
	subroutine sf_int_set_par_index (sf_int, par_index)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: par_index
	allocate (sf_int%par_index (size (par_index)))
	sf_int%par_index = par_index
	end subroutine sf_int_set_par_index

	@ %def sf_int_set_par_index
	@ Initialize the structure-function kinematics, setting incoming
	momenta. We assume that array shapes match.

	Three versions. The first version relies on the momenta being linked
	to another interaction. The second version sets the momenta
	explicitly. In the third version, we first compute momenta for the
	specified energies and store those.
	<<SF base: sf int: TBP>>=
	generic :: seed_kinematics => sf_int_receive_momenta
	generic :: seed_kinematics => sf_int_seed_momenta
	generic :: seed_kinematics => sf_int_seed_energies
	procedure :: sf_int_receive_momenta
	procedure :: sf_int_seed_momenta
	procedure :: sf_int_seed_energies
	<<SF base: procedures>>=
	subroutine sf_int_receive_momenta (sf_int)
	class(sf_int_t), intent(inout) :: sf_int
	if (sf_int%status >= SF_INITIAL) then
	call sf_int%receive_momenta ()
	sf_int%status = SF_SEED_KINEMATICS
	end if
	end subroutine sf_int_receive_momenta

	subroutine sf_int_seed_momenta (sf_int, k)
	class(sf_int_t), intent(inout) :: sf_int
	type(vector4_t), dimension(:), intent(in) :: k
	if (sf_int%status >= SF_INITIAL) then
	call sf_int%set_momenta (k, outgoing=.false.)
	sf_int%status = SF_SEED_KINEMATICS
	end if
	end subroutine sf_int_seed_momenta

	subroutine sf_int_seed_energies (sf_int, E)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: E
	type(vector4_t), dimension(:), allocatable :: k
	integer :: j
	if (sf_int%status >= SF_INITIAL) then
	allocate (k (size (E)))
	if (all (E**2 >= sf_int%mi2)) then
	do j = 1, size (E)
	k(j) = vector4_moving (E(j), &
	(3-2j) sqrt (E(j)**2 - sf_int%mi2(j)), 3)
	end do
	call sf_int%seed_kinematics (k)
	end if
	end if
	end subroutine sf_int_seed_energies

	@ %def sf_int_seed_momenta
	@ %def sf_int_seed_energies
	@ Tell if in generator mode. By default, this is false. To be
	overridden where appropriate; we may refer to the [[is_generator]]
	method of the [[data]] component in the concrete type.
	<<SF base: sf int: TBP>>=
	procedure :: is_generator => sf_int_is_generator
	<<SF base: procedures>>=
	function sf_int_is_generator (sf_int) result (flag)
	class(sf_int_t), intent(in) :: sf_int
	logical :: flag
	flag = .false.
	end function sf_int_is_generator

	@ %def sf_int_is_generator
	@ Generate free parameters [[r]]. Parameters are free if they do not
	correspond to integration parameters (i.e., are bound), but are
	generated by the structure function object itself. By default, all
	parameters are bound, and the output values of this procedure will be
	discarded. With free parameters, we have to override this procedure.

	The value [[x_free]] is the renormalization factor of the total energy
	that corresponds to the free parameters. If there are no free
	parameters, the procedure will not change its value, which starts as
	unity. Otherwise, the fraction is typically decreased, but may also
	be increased in some cases.
	<<SF base: sf int: TBP>>=
	procedure :: generate_free => sf_int_generate_free
	<<SF base: procedures>>=
	subroutine sf_int_generate_free (sf_int, r, rb, x_free)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	r = 0
	rb= 1
	end subroutine sf_int_generate_free

	@ %def sf_int_generate_free
	@ Complete the structure-function kinematics, derived from an input
	parameter (array) $r$ between 0 and 1. The interaction momenta are
	calculated, and we return $x$ (the momentum fraction), and $f$ (the
	Jacobian factor for the map $r\to x$), if [[map]] is set.

	If the [[map]] flag is unset, $r$ and $x$ values will coincide, and $f$ will
	become unity. If it is set, the structure-function implementation chooses a
	convenient mapping from $r$ to $x$ with Jacobian $f$.

	In the [[inverse_kinematics]] variant, we exchange the intent of [[x]]
	and [[r]]. The momenta are calculated only if the optional flag
	-[[set_momenta]] is present and set.
	+[[set_momenta]] is present and set. Internal parameters of [[sf_int]]
	+are calculated only if the optional flag [[set_x]] is present and set.

	Update 2018-08-22: Throughout this algorithm, we now carry
	[[xb]]=$1-x$ together with [[x]] values, as we did for [[r]] before.
	This allows us to handle unstable endpoint numerics wherever
	necessary. The only place where the changes actually did matter was
	for inverse kinematics in the ISR setup, with a very soft photon, but
	it might be most sensible to apply the extension with [[xb]] everywhere.
	<<SF base: sf int: TBP>>=
	procedure (sf_int_complete_kinematics), deferred :: complete_kinematics
	procedure (sf_int_inverse_kinematics), deferred :: inverse_kinematics
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_int_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	import
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine sf_int_complete_kinematics
	end interface

	abstract interface
	- subroutine sf_int_inverse_kinematics (sf_int, x, xb, f, r, rb, map, &
	- set_momenta)
	+ subroutine sf_int_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	import
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine sf_int_inverse_kinematics
	end interface

	@ %def sf_int_complete_kinematics
	@ %def sf_int_inverse_kinematics
	@ Single splitting: compute momenta, given $x$ input parameters. We
	assume that the incoming momentum is set. The status code is set to
	[[SF_FAILED_KINEMATICS]] if
	the $x$ array does not correspond to a valid momentum configuration.
	Otherwise, it is updated to [[SF_DONE_KINEMATICS]].

	We force the outgoing particle on-shell. The on-shell projection is
	determined by the [[on_shell_mode]]. The radiated particle should already be
	on shell.
	<<SF base: sf int: TBP>>=
	procedure :: split_momentum => sf_int_split_momentum
	<<SF base: procedures>>=
	subroutine sf_int_split_momentum (sf_int, x, xb)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	type(splitting_data_t) :: sd
	real(default) :: E1, E2
	logical :: fail
	if (sf_int%status >= SF_SEED_KINEMATICS) then
	k = sf_int%get_momentum (1)
	call sd%init (k, &
	sf_int%mi2(1), sf_int%mr2(1), sf_int%mo2(1), &
	collinear = size (x) == 1)
	call sd%set_t_bounds (x(1), xb(1))
	select case (size (x))
	case (1)
	case (3)
	if (sf_int%qmax_defined) then
	if (sf_int%qmin_defined) then
	call sd%sample_t (x(2), &
	t0 = - sf_int%qmax(1) 2, t1 = - sf_int%qmin(1) 2)
	else
	call sd%sample_t (x(2), &
	t0 = - sf_int%qmax(1) ** 2)
	end if
	else
	if (sf_int%qmin_defined) then
	call sd%sample_t (x(2), t1 = - sf_int%qmin(1) ** 2)
	else
	call sd%sample_t (x(2))
	end if
	end if
	call sd%sample_phi (x(3))
	case default
	call msg_bug ("Structure function: impossible number of parameters")
	end select
	q = sd%split_momentum (k)
	call on_shell (q, [sf_int%mr2, sf_int%mo2], &
	sf_int%on_shell_mode)
	call sf_int%set_momenta (q, outgoing=.true.)
	E1 = energy (q(1))
	E2 = energy (q(2))
	fail = E1 < 0 .or. E2 < 0 &
	.or. E1 ** 2 < sf_int%mr2(1) &
	.or. E2 ** 2 < sf_int%mo2(1)
	if (fail) then
	sf_int%status = SF_FAILED_KINEMATICS
	else
	sf_int%status = SF_DONE_KINEMATICS
	end if
	end if
	end subroutine sf_int_split_momentum

	@ %def sf_test_split_momentum
	@ Pair splitting: two incoming momenta, two radiated, two outgoing.
	This is simple because we insist on all momenta being collinear.
	<<SF base: sf int: TBP>>=
	procedure :: split_momenta => sf_int_split_momenta
	<<SF base: procedures>>=
	subroutine sf_int_split_momenta (sf_int, x, xb)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(4) :: q
	real(default), dimension(4) :: E
	logical :: fail
	if (sf_int%status >= SF_SEED_KINEMATICS) then
	select case (size (x))
	case (2)
	case default
	call msg_bug ("Pair structure function: recoil requested &
	&but not implemented yet")
	end select
	k(1) = sf_int%get_momentum (1)
	k(2) = sf_int%get_momentum (2)
	q(1:2) = xb * k
	q(3:4) = x * k
	select case (size (sf_int%mr2))
	case (2)
	call on_shell (q, &
	[sf_int%mr2(1), sf_int%mr2(2), &
	sf_int%mo2(1), sf_int%mo2(2)], &
	sf_int%on_shell_mode)
	call sf_int%set_momenta (q, outgoing=.true.)
	E = energy (q)
	fail = any (E < 0) &
	.or. any (E(1:2) ** 2 < sf_int%mr2) &
	.or. any (E(3:4) ** 2 < sf_int%mo2)
	case default; call msg_bug ("split momenta: incorrect use")
	end select
	if (fail) then
	sf_int%status = SF_FAILED_KINEMATICS
	else
	sf_int%status = SF_DONE_KINEMATICS
	end if
	end if
	end subroutine sf_int_split_momenta

	@ %def sf_int_split_momenta
	@ Pair spectrum: the reduced version of the previous splitting,
	without radiated momenta.
	<<SF base: sf int: TBP>>=
	procedure :: reduce_momenta => sf_int_reduce_momenta
	<<SF base: procedures>>=
	subroutine sf_int_reduce_momenta (sf_int, x)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(2) :: q
	real(default), dimension(2) :: E
	logical :: fail
	if (sf_int%status >= SF_SEED_KINEMATICS) then
	select case (size (x))
	case (2)
	case default
	call msg_bug ("Pair spectrum: recoil requested &
	&but not implemented yet")
	end select
	k(1) = sf_int%get_momentum (1)
	k(2) = sf_int%get_momentum (2)
	q = x * k
	call on_shell (q, &
	[sf_int%mo2(1), sf_int%mo2(2)], &
	sf_int%on_shell_mode)
	call sf_int%set_momenta (q, outgoing=.true.)
	E = energy (q)
	fail = any (E < 0) &
	.or. any (E ** 2 < sf_int%mo2)
	if (fail) then
	sf_int%status = SF_FAILED_KINEMATICS
	else
	sf_int%status = SF_DONE_KINEMATICS
	end if
	end if
	end subroutine sf_int_reduce_momenta

	@ %def sf_int_reduce_momenta
	@ The inverse procedure: we compute the [[x]] array from the momentum
	configuration. In an overriding TBP, we may also set internal data
	that depend on this, for convenience.

	NOTE: Here and above, the single-particle case is treated in detail,
	allowing for non-collinearity and non-vanishing masses and nontrivial
	momentum-transfer bounds. For the pair case, we currently implement
	only collinear splitting and assume massless particles. This should
	be improved.

	Update 2017-08-22: recover also [[xb]], using the updated [[recover]]
	method of the splitting-data object. Th
	<<SF base: sf int: TBP>>=
	procedure :: recover_x => sf_int_recover_x
	procedure :: base_recover_x => sf_int_recover_x
	<<SF base: procedures>>=
	subroutine sf_int_recover_x (sf_int, x, xb, x_free)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	type(vector4_t), dimension(:), allocatable :: k
	type(vector4_t), dimension(:), allocatable :: q
	type(splitting_data_t) :: sd
	if (sf_int%status >= SF_SEED_KINEMATICS) then
	allocate (k (sf_int%interaction_t%get_n_in ()))
	allocate (q (sf_int%interaction_t%get_n_out ()))
	k = sf_int%get_momenta (outgoing=.false.)
	q = sf_int%get_momenta (outgoing=.true.)
	select case (size (k))
	case (1)
	call sd%init (k(1), &
	sf_int%mi2(1), sf_int%mr2(1), sf_int%mo2(1), &
	collinear = size (x) == 1)
	call sd%recover (k(1), q, sf_int%on_shell_mode)
	x(1) = sd%get_x ()
	xb(1) = sd%get_xb ()
	select case (size (x))
	case (1)
	case (3)
	if (sf_int%qmax_defined) then
	if (sf_int%qmin_defined) then
	call sd%inverse_t (x(2), &
	t0 = - sf_int%qmax(1) 2, t1 = - sf_int%qmin(1) 2)
	else
	call sd%inverse_t (x(2), &
	t0 = - sf_int%qmax(1) ** 2)
	end if
	else
	if (sf_int%qmin_defined) then
	call sd%inverse_t (x(2), t1 = - sf_int%qmin(1) ** 2)
	else
	call sd%inverse_t (x(2))
	end if
	end if
	call sd%inverse_phi (x(3))
	xb(2:3) = 1 - x(2:3)
	case default
	call msg_bug ("Structure function: impossible number &
	&of parameters")
	end select
	case (2)
	select case (size (x))
	case (2)
	case default
	call msg_bug ("Pair structure function: recoil requested &
	&but not implemented yet")
	end select
	select case (sf_int%on_shell_mode)
	case (KEEP_ENERGY)
	select case (size (q))
	case (4)
	x = energy (q(3:4)) / energy (k)
	xb= energy (q(1:2)) / energy (k)
	case (2)
	x = energy (q) / energy (k)
	xb= 1 - x
	end select
	case (KEEP_MOMENTUM)
	select case (size (q))
	case (4)
	x = longitudinal_part (q(3:4)) / longitudinal_part (k)
	xb= longitudinal_part (q(1:2)) / longitudinal_part (k)
	case (2)
	x = longitudinal_part (q) / longitudinal_part (k)
	xb= 1 - x
	end select
	end select
	end select
	end if
	end subroutine sf_int_recover_x

	@ %def sf_int_recover_x
	@ Apply the structure function, i.e., evaluate the interaction. For
	the calculation, we may use the stored momenta, any further
	information stored inside the [[sf_int]] implementation during
	kinematics setup, and the given energy scale. It may happen that for
	the given kinematics the value is not defined. This should be
	indicated by the status code.
	<<SF base: sf int: TBP>>=
	procedure (sf_int_apply), deferred :: apply
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_int_apply (sf_int, scale, rescale, i_sub, fill_sub)
	import
	class(sf_int_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	end subroutine sf_int_apply
	end interface

	@ %def sf_int_apply
	@
	\subsection{Accessing the structure function}
	Return metadata. Once [[interaction_t]] is rewritten in OO, some of this will
	be inherited.

	The number of outgoing is equal to the number of incoming particles. The
	radiated particles are the difference.
	<<SF base: sf int: TBP>>=
	procedure :: get_n_in => sf_int_get_n_in
	procedure :: get_n_rad => sf_int_get_n_rad
	procedure :: get_n_out => sf_int_get_n_out
	<<SF base: procedures>>=
	pure function sf_int_get_n_in (object) result (n_in)
	class(sf_int_t), intent(in) :: object
	integer :: n_in
	n_in = object%interaction_t%get_n_in ()
	end function sf_int_get_n_in

	pure function sf_int_get_n_rad (object) result (n_rad)
	class(sf_int_t), intent(in) :: object
	integer :: n_rad
	n_rad = object%interaction_t%get_n_out () &
	- object%interaction_t%get_n_in ()
	end function sf_int_get_n_rad

	pure function sf_int_get_n_out (object) result (n_out)
	class(sf_int_t), intent(in) :: object
	integer :: n_out
	n_out = object%interaction_t%get_n_in ()
	end function sf_int_get_n_out

	@ %def sf_int_get_n_in
	@ %def sf_int_get_n_rad
	@ %def sf_int_get_n_out
	@ Number of matrix element entries in the interaction:
	<<SF base: sf int: TBP>>=
	procedure :: get_n_states => sf_int_get_n_states
	<<SF base: procedures>>=
	function sf_int_get_n_states (sf_int) result (n_states)
	class(sf_int_t), intent(in) :: sf_int
	integer :: n_states
	n_states = sf_int%get_n_matrix_elements ()
	end function sf_int_get_n_states

	@ %def sf_int_get_n_states
	@ Return a specific state as a quantum-number array.
	<<SF base: sf int: TBP>>=
	procedure :: get_state => sf_int_get_state
	<<SF base: procedures>>=
	function sf_int_get_state (sf_int, i) result (qn)
	class(sf_int_t), intent(in) :: sf_int
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer, intent(in) :: i
	allocate (qn (sf_int%get_n_tot ()))
	qn = sf_int%get_quantum_numbers (i)
	end function sf_int_get_state

	@ %def sf_int_get_state
	@ Return the matrix-element values for all states. We can assume that
	the matrix elements are real, so we take the real part.
	<<SF base: sf int: TBP>>=
	procedure :: get_values => sf_int_get_values
	<<SF base: procedures>>=
	subroutine sf_int_get_values (sf_int, value)
	class(sf_int_t), intent(in) :: sf_int
	real(default), dimension(:), intent(out) :: value
	integer :: i
	if (sf_int%status >= SF_EVALUATED) then
	do i = 1, size (value)
	value(i) = real (sf_int%get_matrix_element (i))
	end do
	else
	value = 0
	end if
	end subroutine sf_int_get_values

	@ %def sf_int_get_values
	@
	\subsection{Direct calculations}
	Compute a structure function value (array) directly, given an array of $x$
	values and a scale. If the energy is also given, we initialize the
	kinematics for that energy, otherwise take it from a previous run.

	We assume that the [[E]] array has dimension [[n_in]], and the [[x]]
	array has [[n_par]].

	Note: the output x values ([[xx]] and [[xxb]]) are unused in this use case.
	<<SF base: sf int: TBP>>=
	procedure :: compute_values => sf_int_compute_values
	<<SF base: procedures>>=
	subroutine sf_int_compute_values (sf_int, value, x, xb, scale, E)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: value
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(in) :: scale
	real(default), dimension(:), intent(in), optional :: E
	real(default), dimension(size (x)) :: xx, xxb
	real(default) :: f
	if (present (E)) call sf_int%seed_kinematics (E)
	if (sf_int%status >= SF_SEED_KINEMATICS) then
	call sf_int%complete_kinematics (xx, xxb, f, x, xb, map=.false.)
	call sf_int%apply (scale)
	call sf_int%get_values (value)
	value = value * f
	else
	value = 0
	end if
	end subroutine sf_int_compute_values

	@ %def sf_int_compute_values
	@ Compute just a single value for one of the states, i.e., throw the
	others away.
	<<SF base: sf int: TBP>>=
	procedure :: compute_value => sf_int_compute_value
	<<SF base: procedures>>=
	subroutine sf_int_compute_value &
	(sf_int, i_state, value, x, xb, scale, E)
	class(sf_int_t), intent(inout) :: sf_int
	integer, intent(in) :: i_state
	real(default), intent(out) :: value
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(in) :: scale
	real(default), dimension(:), intent(in), optional :: E
	real(default), dimension(:), allocatable :: value_array
	if (sf_int%status >= SF_INITIAL) then
	allocate (value_array (sf_int%get_n_states ()))
	call sf_int%compute_values (value_array, x, xb, scale, E)
	value = value_array(i_state)
	else
	value = 0
	end if
	end subroutine sf_int_compute_value

	@ %def sf_int_compute_value
	@
	\subsection{Structure-function instance}
	This is a wrapper for [[sf_int_t]] objects, such that we can
	build an array with different structure-function types. The
	structure-function contains an array (a sequence) of [[sf_int_t]]
	objects.

	The object, it holds the evaluator that connects the preceding part of the
	structure-function chain to the current interaction.

	It also stores the input and output parameter values for the
	contained structure function. The [[r]] array has a second dimension,
	corresponding to the mapping channels in a multi-channel
	configuration. There is a Jacobian entry [[f]] for each channel. The
	corresponding logical array [[mapping]] tells whether we apply the
	mapping appropriate for the current structure function in this channel.
	The [[x]] parameter values (energy fractions) are common to all
	channels.
	<<SF base: types>>=
	type :: sf_instance_t
	class(sf_int_t), allocatable :: int
	type(evaluator_t) :: eval
	real(default), dimension(:,:), allocatable :: r
	real(default), dimension(:,:), allocatable :: rb
	real(default), dimension(:), allocatable :: f
	logical, dimension(:), allocatable :: m
	real(default), dimension(:), allocatable :: x
	real(default), dimension(:), allocatable :: xb
	end type sf_instance_t

	@ %def sf_instance_t
	@
	\subsection{Structure-function chain}
	A chain is an array of structure functions [[sf]], initiated by a beam setup.
	We do not use this directly for evaluation, but create instances with
	copies of the contained interactions.

	[[n_par]] is the total number of parameters that is necessary for
	completely determining the structure-function chain. [[n_bound]] is
	the number of MC input parameters that are requested from the
	integrator. The difference of [[n_par]] and [[n_bound]] is the number
	of free parameters, which are generated by a structure-function
	object in generator mode.
	<<SF base: public>>=
	public :: sf_chain_t
	<<SF base: types>>=
	type, extends (beam_t) :: sf_chain_t
	type(beam_data_t), pointer :: beam_data => null ()
	integer :: n_in = 0
	integer :: n_strfun = 0
	integer :: n_par = 0
	integer :: n_bound = 0
	type(sf_instance_t), dimension(:), allocatable :: sf
	logical :: trace_enable = .false.
	integer :: trace_unit = 0
	contains
	<<SF base: sf chain: TBP>>
	end type sf_chain_t

	@ %def sf_chain_t
	@ Finalizer.
	<<SF base: sf chain: TBP>>=
	procedure :: final => sf_chain_final
	<<SF base: procedures>>=
	subroutine sf_chain_final (object)
	class(sf_chain_t), intent(inout) :: object
	integer :: i
	call object%final_tracing ()
	if (allocated (object%sf)) then
	do i = 1, size (object%sf, 1)
	associate (sf => object%sf(i))
	if (allocated (sf%int)) then
	call sf%int%final ()
	end if
	end associate
	end do
	end if
	call beam_final (object%beam_t)
	end subroutine sf_chain_final

	@ %def sf_chain_final
	@ Output.
	<<SF base: sf chain: TBP>>=
	procedure :: write => sf_chain_write
	<<SF base: procedures>>=
	subroutine sf_chain_write (object, unit)
	class(sf_chain_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Incoming particles / structure-function chain:"
	if (associated (object%beam_data)) then
	write (u, "(3x,A,I0)") "n_in = ", object%n_in
	write (u, "(3x,A,I0)") "n_strfun = ", object%n_strfun
	write (u, "(3x,A,I0)") "n_par = ", object%n_par
	if (object%n_par /= object%n_bound) then
	write (u, "(3x,A,I0)") "n_bound = ", object%n_bound
	end if
	call object%beam_data%write (u)
	call write_separator (u)
	call beam_write (object%beam_t, u)
	if (allocated (object%sf)) then
	do i = 1, object%n_strfun
	associate (sf => object%sf(i))
	call write_separator (u)
	if (allocated (sf%int)) then
	call sf%int%write (u)
	else
	write (u, "(1x,A)") "SF instance: [undefined]"
	end if
	end associate
	end do
	end if
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine sf_chain_write

	@ %def sf_chain_write
	@ Initialize: setup beams. The [[beam_data]] target must remain valid
	for the lifetime of the chain, since we just establish a pointer. The
	structure-function configuration array is used to initialize the
	individual structure-function entries. The target attribute is needed
	because the [[sf_int]] entries establish pointers to the configuration data.
	<<SF base: sf chain: TBP>>=
	procedure :: init => sf_chain_init
	<<SF base: procedures>>=
	subroutine sf_chain_init (sf_chain, beam_data, sf_config)
	class(sf_chain_t), intent(out) :: sf_chain
	type(beam_data_t), intent(in), target :: beam_data
	type(sf_config_t), dimension(:), intent(in), optional, target :: sf_config
	integer :: i
	sf_chain%beam_data => beam_data
	sf_chain%n_in = beam_data%get_n_in ()
	call beam_init (sf_chain%beam_t, beam_data)
	if (present (sf_config)) then
	sf_chain%n_strfun = size (sf_config)
	allocate (sf_chain%sf (sf_chain%n_strfun))
	do i = 1, sf_chain%n_strfun
	call sf_chain%set_strfun (i, sf_config(i)%i, sf_config(i)%data)
	end do
	end if
	end subroutine sf_chain_init

	@ %def sf_chain_init
	@ Receive the beam momenta from a source to which the beam interaction
	is linked.
	<<SF base: sf chain: TBP>>=
	procedure :: receive_beam_momenta => sf_chain_receive_beam_momenta
	<<SF base: procedures>>=
	subroutine sf_chain_receive_beam_momenta (sf_chain)
	class(sf_chain_t), intent(inout), target :: sf_chain
	type(interaction_t), pointer :: beam_int
	beam_int => sf_chain%get_beam_int_ptr ()
	call beam_int%receive_momenta ()
	end subroutine sf_chain_receive_beam_momenta

	@ %def sf_chain_receive_beam_momenta
	@ Explicitly set the beam momenta.
	<<SF base: sf chain: TBP>>=
	procedure :: set_beam_momenta => sf_chain_set_beam_momenta
	<<SF base: procedures>>=
	subroutine sf_chain_set_beam_momenta (sf_chain, p)
	class(sf_chain_t), intent(inout) :: sf_chain
	type(vector4_t), dimension(:), intent(in) :: p
	call beam_set_momenta (sf_chain%beam_t, p)
	end subroutine sf_chain_set_beam_momenta

	@ %def sf_chain_set_beam_momenta
	@ Set a structure-function entry. We use the [[data]] input to
	allocate the [[int]] structure-function instance with appropriate
	type, then initialize the entry. The entry establishes a pointer to
	[[data]].

	The index [[i]] is the structure-function index in the chain.
	<<SF base: sf chain: TBP>>=
	procedure :: set_strfun => sf_chain_set_strfun
	<<SF base: procedures>>=
	subroutine sf_chain_set_strfun (sf_chain, i, beam_index, data)
	class(sf_chain_t), intent(inout) :: sf_chain
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: beam_index
	class(sf_data_t), intent(in), target :: data
	integer :: n_par, j
	n_par = data%get_n_par ()
	call data%allocate_sf_int (sf_chain%sf(i)%int)
	associate (sf_int => sf_chain%sf(i)%int)
	call sf_int%init (data)
	call sf_int%set_beam_index (beam_index)
	call sf_int%set_par_index &
	([(j, j = sf_chain%n_par + 1, sf_chain%n_par + n_par)])
	sf_chain%n_par = sf_chain%n_par + n_par
	if (.not. data%is_generator ()) then
	sf_chain%n_bound = sf_chain%n_bound + n_par
	end if
	end associate
	end subroutine sf_chain_set_strfun

	@ %def sf_chain_set_strfun
	@ Return the number of structure-function parameters.
	<<SF base: sf chain: TBP>>=
	procedure :: get_n_par => sf_chain_get_n_par
	procedure :: get_n_bound => sf_chain_get_n_bound
	<<SF base: procedures>>=
	function sf_chain_get_n_par (sf_chain) result (n)
	class(sf_chain_t), intent(in) :: sf_chain
	integer :: n
	n = sf_chain%n_par
	end function sf_chain_get_n_par

	function sf_chain_get_n_bound (sf_chain) result (n)
	class(sf_chain_t), intent(in) :: sf_chain
	integer :: n
	n = sf_chain%n_bound
	end function sf_chain_get_n_bound

	@ %def sf_chain_get_n_par
	@ %def sf_chain_get_n_bound
	@ Return a pointer to the beam interaction.
	<<SF base: sf chain: TBP>>=
	procedure :: get_beam_int_ptr => sf_chain_get_beam_int_ptr
	<<SF base: procedures>>=
	function sf_chain_get_beam_int_ptr (sf_chain) result (int)
	type(interaction_t), pointer :: int
	class(sf_chain_t), intent(in), target :: sf_chain
	int => beam_get_int_ptr (sf_chain%beam_t)
	end function sf_chain_get_beam_int_ptr

	@ %def sf_chain_get_beam_int_ptr
	@ Enable the trace feature: record structure function data (input
	parameters, $x$ values, evaluation result) to an external file.
	<<SF base: sf chain: TBP>>=
	procedure :: setup_tracing => sf_chain_setup_tracing
	procedure :: final_tracing => sf_chain_final_tracing
	<<SF base: procedures>>=
	subroutine sf_chain_setup_tracing (sf_chain, file)
	class(sf_chain_t), intent(inout) :: sf_chain
	type(string_t), intent(in) :: file
	if (sf_chain%n_strfun > 0) then
	sf_chain%trace_enable = .true.
	sf_chain%trace_unit = free_unit ()
	open (sf_chain%trace_unit, file = char (file), action = "write", &
	status = "replace")
	call sf_chain%write_trace_header ()
	else
	call msg_error ("Beam structure: no structure functions, tracing &
	&disabled")
	end if
	end subroutine sf_chain_setup_tracing

	subroutine sf_chain_final_tracing (sf_chain)
	class(sf_chain_t), intent(inout) :: sf_chain
	if (sf_chain%trace_enable) then
	close (sf_chain%trace_unit)
	sf_chain%trace_enable = .false.
	end if
	end subroutine sf_chain_final_tracing

	@ %def sf_chain_setup_tracing
	@ %def sf_chain_final_tracing
	@ Write the header for the tracing file.
	<<SF base: sf chain: TBP>>=
	procedure :: write_trace_header => sf_chain_write_trace_header
	<<SF base: procedures>>=
	subroutine sf_chain_write_trace_header (sf_chain)
	class(sf_chain_t), intent(in) :: sf_chain
	integer :: u
	if (sf_chain%trace_enable) then
	u = sf_chain%trace_unit
	write (u, "('# ',A)") "WHIZARD output: &
	&structure-function sampling data"
	write (u, "('# ',A,1x,I0)") "Number of sf records:", sf_chain%n_strfun
	write (u, "('# ',A,1x,I0)") "Number of parameters:", sf_chain%n_par
	write (u, "('# ',A)") "Columns: channel, p(n_par), x(n_par), f, Jac * f"
	end if
	end subroutine sf_chain_write_trace_header

	@ %def sf_chain_write_trace_header
	@ Write a record which collects the structure function data for the
	current data point. For the selected channel, we print first the
	input integration parameters, then the $x$ values, then the
	structure-function value summed over all quantum numbers, then the
	structure function value times the mapping Jacobian.
	<<SF base: sf chain: TBP>>=
	procedure :: trace => sf_chain_trace
	<<SF base: procedures>>=
	subroutine sf_chain_trace (sf_chain, c_sel, p, x, f, sf_sum)
	class(sf_chain_t), intent(in) :: sf_chain
	integer, intent(in) :: c_sel
	real(default), dimension(:,:), intent(in) :: p
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: f
	real(default), intent(in) :: sf_sum
	real(default) :: sf_sum_pac, f_sf_sum_pac
	integer :: u, i
	if (sf_chain%trace_enable) then
	u = sf_chain%trace_unit
	write (u, "(1x,I0)", advance="no") c_sel
	write (u, "(2x)", advance="no")
	do i = 1, sf_chain%n_par
	write (u, "(1x," // FMT_17 // ")", advance="no") p(i,c_sel)
	end do
	write (u, "(2x)", advance="no")
	do i = 1, sf_chain%n_par
	write (u, "(1x," // FMT_17 // ")", advance="no") x(i)
	end do
	write (u, "(2x)", advance="no")
	sf_sum_pac = sf_sum
	f_sf_sum_pac = f(c_sel) * sf_sum
	call pacify (sf_sum_pac, 1.E-28_default)
	call pacify (f_sf_sum_pac, 1.E-28_default)
	write (u, "(2(1x," // FMT_17 // "))") sf_sum_pac, f_sf_sum_pac
	end if
	end subroutine sf_chain_trace

	@ %def sf_chain_trace
	@
	\subsection{Chain instances}
	A structure-function chain instance contains copies of the
	interactions in the configuration chain, suitably linked to each other
	and connected by evaluators.

	After initialization, [[out_sf]] should point, for each beam, to the
	last structure function that affects this beam. [[out_sf_i]] should
	indicate the index of the corresponding outgoing particle within that
	structure-function interaction.

	Analogously, [[out_eval]] is the last evaluator in the
	structure-function chain, which contains the complete set of outgoing
	particles. [[out_eval_i]] should indicate the index of the outgoing
	particles, within that evaluator, which will initiate the collision.

	When calculating actual kinematics, we fill the [[p]], [[r]], and
	[[x]] arrays and the [[f]] factor. The [[p]] array denotes the MC
	input parameters as they come from the random-number generator. The
	[[r]] array results from applying global mappings. The [[x]] array
	results from applying structure-function local mappings. The $x$
	values can be interpreted directly as momentum fractions (or angle
	fractions, where recoil is involved). The [[f]] factor is the
	Jacobian that results from applying all mappings.

	Update 2017-08-22: carry and output all complements ([[pb]], [[rb]],
	[[xb]]). Previously, [[xb]] was not included in the record, and the
	output did not contain either. It does become more verbose, however.

	The [[mapping]] entry may store a global mapping that is applied to a
	combination of $x$ values and structure functions, as opposed to mappings that
	affect only a single structure function. It is applied before the latter
	mappings, in the transformation from the [[p]] array to the [[r]] array. For
	parameters affected by this mapping, we should ensure that they are not
	involved in a local mapping.
	<<SF base: public>>=
	public :: sf_chain_instance_t
	<<SF base: types>>=
	type, extends (beam_t) :: sf_chain_instance_t
	type(sf_chain_t), pointer :: config => null ()
	integer :: status = SF_UNDEFINED
	type(sf_instance_t), dimension(:), allocatable :: sf
	integer, dimension(:), allocatable :: out_sf
	integer, dimension(:), allocatable :: out_sf_i
	integer :: out_eval = 0
	integer, dimension(:), allocatable :: out_eval_i
	integer :: selected_channel = 0
	real(default), dimension(:,:), allocatable :: p, pb
	real(default), dimension(:,:), allocatable :: r, rb
	real(default), dimension(:), allocatable :: f
	real(default), dimension(:), allocatable :: x, xb
	logical, dimension(:), allocatable :: bound
	real(default) :: x_free = 1
	type(sf_channel_t), dimension(:), allocatable :: channel
	contains
	<<SF base: sf chain instance: TBP>>
	end type sf_chain_instance_t

	@ %def sf_chain_instance_t
	@ Finalizer.
	<<SF base: sf chain instance: TBP>>=
	procedure :: final => sf_chain_instance_final
	<<SF base: procedures>>=
	subroutine sf_chain_instance_final (object)
	class(sf_chain_instance_t), intent(inout) :: object
	integer :: i
	if (allocated (object%sf)) then
	do i = 1, size (object%sf, 1)
	associate (sf => object%sf(i))
	if (allocated (sf%int)) then
	call sf%eval%final ()
	call sf%int%final ()
	end if
	end associate
	end do
	end if
	call beam_final (object%beam_t)
	end subroutine sf_chain_instance_final

	@ %def sf_chain_instance_final
	@ Output.

	Note: nagfor 5.3.1 appears to be slightly confused with the allocation
	status. We check both for allocation and nonzero size.
	<<SF base: sf chain instance: TBP>>=
	procedure :: write => sf_chain_instance_write
	<<SF base: procedures>>=
	subroutine sf_chain_instance_write (object, unit, col_verbose)
	class(sf_chain_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: col_verbose
	integer :: u, i, c
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "Structure-function chain instance:"
	call write_sf_status (object%status, u)
	if (allocated (object%out_sf)) then
	write (u, "(3x,A)", advance="no") "outgoing (interactions) ="
	do i = 1, size (object%out_sf)
	write (u, "(1x,I0,':',I0)", advance="no") &
	object%out_sf(i), object%out_sf_i(i)
	end do
	write (u, *)
	end if
	if (object%out_eval /= 0) then
	write (u, "(3x,A)", advance="no") "outgoing (evaluators) ="
	do i = 1, size (object%out_sf)
	write (u, "(1x,I0,':',I0)", advance="no") &
	object%out_eval, object%out_eval_i(i)
	end do
	write (u, *)
	end if
	if (allocated (object%sf)) then
	if (size (object%sf) /= 0) then
	write (u, "(1x,A)") "Structure-function parameters:"
	do c = 1, size (object%f)
	write (u, "(1x,A,I0,A)", advance="no") "Channel #", c, ":"
	if (c == object%selected_channel) then
	write (u, "(1x,A)") "[selected]"
	else
	write (u, *)
	end if
	write (u, "(3x,A,9(1x,F9.7))") "p =", object%p(:,c)
	write (u, "(3x,A,9(1x,F9.7))") "pb=", object%pb(:,c)
	write (u, "(3x,A,9(1x,F9.7))") "r =", object%r(:,c)
	write (u, "(3x,A,9(1x,F9.7))") "rb=", object%rb(:,c)
	write (u, "(3x,A,9(1x,ES13.7))") "f =", object%f(c)
	write (u, "(3x,A)", advance="no") "m ="
	call object%channel(c)%write (u)
	end do
	write (u, "(3x,A,9(1x,F9.7))") "x =", object%x
	write (u, "(3x,A,9(1x,F9.7))") "xb=", object%xb
	if (.not. all (object%bound)) then
	write (u, "(3x,A,9(1x,L1))") "bound =", object%bound
	end if
	end if
	end if
	call write_separator (u)
	call beam_write (object%beam_t, u, col_verbose = col_verbose)
	if (allocated (object%sf)) then
	do i = 1, size (object%sf)
	associate (sf => object%sf(i))
	call write_separator (u)
	if (allocated (sf%int)) then
	if (allocated (sf%r)) then
	write (u, "(1x,A)") "Structure-function parameters:"
	do c = 1, size (sf%f)
	write (u, "(1x,A,I0,A)", advance="no") "Channel #", c, ":"
	if (c == object%selected_channel) then
	write (u, "(1x,A)") "[selected]"
	else
	write (u, *)
	end if
	write (u, "(3x,A,9(1x,F9.7))") "r =", sf%r(:,c)
	write (u, "(3x,A,9(1x,F9.7))") "rb=", sf%rb(:,c)
	write (u, "(3x,A,9(1x,ES13.7))") "f =", sf%f(c)
	write (u, "(3x,A,9(1x,L1,7x))") "m =", sf%m(c)
	end do
	write (u, "(3x,A,9(1x,F9.7))") "x =", sf%x
	write (u, "(3x,A,9(1x,F9.7))") "xb=", sf%xb
	end if
	call sf%int%write(u)
	if (.not. sf%eval%is_empty ()) then
	call sf%eval%write (u, col_verbose = col_verbose)
	end if
	end if
	end associate
	end do
	end if
	end subroutine sf_chain_instance_write

	@ %def sf_chain_instance_write
	@ Initialize. This creates a copy of the interactions in the
	configuration chain, assumed to be properly initialized. In the copy,
	we allocate the [[p]] etc.\ arrays.

	The brute-force assignment of the [[sf]] component would be
	straightforward, but at least gfortran 4.6.3 would like a more
	fine-grained copy. In any case, the copy is deep
	as far as allocatables are concerned, but for the contained
	[[interaction_t]] objects the copy is shallow, as long as we do not
	bind defined assignment to the type. Therefore, we have to re-assign
	the [[interaction_t]] components explicitly, this time calling the
	proper defined assignment. Furthermore, we allocate the parameter
	arrays for each structure function.
	<<SF base: sf chain instance: TBP>>=
	procedure :: init => sf_chain_instance_init
	<<SF base: procedures>>=
	subroutine sf_chain_instance_init (chain, config, n_channel)
	class(sf_chain_instance_t), intent(out), target :: chain
	type(sf_chain_t), intent(in), target :: config
	integer, intent(in) :: n_channel
	integer :: i, j
	integer :: n_par_tot, n_par, n_strfun
	chain%config => config
	n_strfun = config%n_strfun
	chain%beam_t = config%beam_t
	allocate (chain%out_sf (config%n_in), chain%out_sf_i (config%n_in))
	allocate (chain%out_eval_i (config%n_in))
	chain%out_sf = 0
	chain%out_sf_i = [(i, i = 1, config%n_in)]
	chain%out_eval_i = chain%out_sf_i
	n_par_tot = 0
	if (n_strfun /= 0) then
	allocate (chain%sf (n_strfun))
	do i = 1, n_strfun
	associate (sf => chain%sf(i))
	allocate (sf%int, source=config%sf(i)%int)
	sf%int%interaction_t = config%sf(i)%int%interaction_t
	n_par = size (sf%int%par_index)
	allocate (sf%r (n_par, n_channel)); sf%r = 0
	allocate (sf%rb(n_par, n_channel)); sf%rb= 0
	allocate (sf%f (n_channel)); sf%f = 0
	allocate (sf%m (n_channel)); sf%m = .false.
	allocate (sf%x (n_par)); sf%x = 0
	allocate (sf%xb(n_par)); sf%xb= 0
	n_par_tot = n_par_tot + n_par
	end associate
	end do
	allocate (chain%p (n_par_tot, n_channel)); chain%p = 0
	allocate (chain%pb(n_par_tot, n_channel)); chain%pb= 0
	allocate (chain%r (n_par_tot, n_channel)); chain%r = 0
	allocate (chain%rb(n_par_tot, n_channel)); chain%rb= 0
	allocate (chain%f (n_channel)); chain%f = 0
	allocate (chain%x (n_par_tot)); chain%x = 0
	allocate (chain%xb(n_par_tot)); chain%xb= 0
	call allocate_sf_channels &
	(chain%channel, n_channel=n_channel, n_strfun=n_strfun)
	end if
	allocate (chain%bound (n_par_tot), source = .true.)
	do i = 1, n_strfun
	associate (sf => chain%sf(i))
	if (sf%int%is_generator ()) then
	do j = 1, size (sf%int%par_index)
	chain%bound(sf%int%par_index(j)) = .false.
	end do
	end if
	end associate
	end do
	chain%status = SF_INITIAL
	end subroutine sf_chain_instance_init

	@ %def sf_chain_instance_init
	@ Manually select a channel.
	<<SF base: sf chain instance: TBP>>=
	procedure :: select_channel => sf_chain_instance_select_channel
	<<SF base: procedures>>=
	subroutine sf_chain_instance_select_channel (chain, channel)
	class(sf_chain_instance_t), intent(inout) :: chain
	integer, intent(in), optional :: channel
	if (present (channel)) then
	chain%selected_channel = channel
	else
	chain%selected_channel = 0
	end if
	end subroutine sf_chain_instance_select_channel

	@ %def sf_chain_instance_select_channel
	@ Copy a channel-mapping object to the structure-function
	chain instance. We assume that assignment is sufficient, i.e., any
	non-static components of the [[channel]] object are allocatable und
	thus recursively copied.

	After the copy, we extract the single-entry mappings and activate them
	for the individual structure functions. If there is a multi-entry
	mapping, we obtain the corresponding MC parameter indices and set them
	in the copy of the channel object.
	<<SF base: sf chain instance: TBP>>=
	procedure :: set_channel => sf_chain_instance_set_channel
	<<SF base: procedures>>=
	subroutine sf_chain_instance_set_channel (chain, c, channel)
	class(sf_chain_instance_t), intent(inout) :: chain
	integer, intent(in) :: c
	type(sf_channel_t), intent(in) :: channel
	integer :: i, j, k
	if (chain%status >= SF_INITIAL) then
	chain%channel(c) = channel
	j = 0
	do i = 1, chain%config%n_strfun
	associate (sf => chain%sf(i))
	sf%m(c) = channel%is_single_mapping (i)
	if (channel%is_multi_mapping (i)) then
	do k = 1, size (sf%int%beam_index)
	j = j + 1
	call chain%channel(c)%set_par_index &
	(j, sf%int%par_index(k))
	end do
	end if
	end associate
	end do
	if (j /= chain%channel(c)%get_multi_mapping_n_par ()) then
	print *, "index last filled = ", j
	print *, "number of parameters = ", &
	chain%channel(c)%get_multi_mapping_n_par ()
	call msg_bug ("Structure-function setup: mapping index mismatch")
	end if
	chain%status = SF_INITIAL
	end if
	end subroutine sf_chain_instance_set_channel

	@ %def sf_chain_instance_set_channel
	@ Link the interactions in the chain. First, link the beam instance
	to its template in the configuration chain, which should have the
	appropriate momenta fixed.

	Then, we follow the chain via the
	arrays [[out_sf]] and [[out_sf_i]]. The arrays are (up to)
	two-dimensional, the entries correspond to the beam particle(s).
	For each beam, the entry [[out_sf]] points to the last interaction
	that affected this beam, and [[out_sf_i]] is the
	out-particle index within that interaction. For the initial beam,
	[[out_sf]] is zero by definition.

	For each entry in the chain, we scan the affected beams (one or two).
	We look for [[out_sf]] and link the out-particle there to the
	corresponding in-particle in the current interaction. Then, we update
	the entry in [[out_sf]] and [[out_sf_i]] to point to the current
	interaction.
	<<SF base: sf chain instance: TBP>>=
	procedure :: link_interactions => sf_chain_instance_link_interactions
	<<SF base: procedures>>=
	subroutine sf_chain_instance_link_interactions (chain)
	class(sf_chain_instance_t), intent(inout), target :: chain
	type(interaction_t), pointer :: int
	integer :: i, j, b
	if (chain%status >= SF_INITIAL) then
	do b = 1, chain%config%n_in
	int => beam_get_int_ptr (chain%beam_t)
	call interaction_set_source_link (int, b, &
	chain%config%beam_t, b)
	end do
	if (allocated (chain%sf)) then
	do i = 1, size (chain%sf)
	associate (sf_int => chain%sf(i)%int)
	do j = 1, size (sf_int%beam_index)
	b = sf_int%beam_index(j)
	call link (sf_int%interaction_t, b, sf_int%incoming(j))
	chain%out_sf(b) = i
	chain%out_sf_i(b) = sf_int%outgoing(j)
	end do
	end associate
	end do
	end if
	chain%status = SF_DONE_LINKS
	end if
	contains
	subroutine link (int, b, in_index)
	type(interaction_t), intent(inout) :: int
	integer, intent(in) :: b, in_index
	integer :: i
	i = chain%out_sf(b)
	select case (i)
	case (0)
	call interaction_set_source_link (int, in_index, &
	chain%beam_t, chain%out_sf_i(b))
	case default
	call int%set_source_link (in_index, &
	chain%sf(i)%int, chain%out_sf_i(b))
	end select
	end subroutine link
	end subroutine sf_chain_instance_link_interactions

	@ %def sf_chain_instance_link_interactions
	@ Exchange the quantum-number masks between the interactions in the
	chain, so we can combine redundant entries and detect any obvious mismatch.

	We proceed first in the forward direction and then backwards again.

	After this is finished, we finalize initialization by calling the
	[[setup_constants]] method, which prepares constant data that depend on the
	matrix element structure.
	<<SF base: sf chain instance: TBP>>=
	procedure :: exchange_mask => sf_chain_exchange_mask
	<<SF base: procedures>>=
	subroutine sf_chain_exchange_mask (chain)
	class(sf_chain_instance_t), intent(inout), target :: chain
	type(interaction_t), pointer :: int
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
	integer :: i
	if (chain%status >= SF_DONE_LINKS) then
	if (allocated (chain%sf)) then
	int => beam_get_int_ptr (chain%beam_t)
	allocate (mask (int%get_n_out ()))
	mask = int%get_mask ()
	if (size (chain%sf) /= 0) then
	do i = 1, size (chain%sf) - 1
	call interaction_exchange_mask (chain%sf(i)%int%interaction_t)
	end do
	do i = size (chain%sf), 1, -1
	call interaction_exchange_mask (chain%sf(i)%int%interaction_t)
	end do
	if (any (mask .neqv. int%get_mask ())) then
	chain%status = SF_FAILED_MASK
	return
	end if
	do i = 1, size (chain%sf)
	call chain%sf(i)%int%setup_constants ()
	end do
	end if
	end if
	chain%status = SF_DONE_MASK
	end if
	end subroutine sf_chain_exchange_mask

	@ %def sf_chain_exchange_mask
	@ Initialize the evaluators that connect the interactions in the
	chain.
	<<SF base: sf chain instance: TBP>>=
	procedure :: init_evaluators => sf_chain_instance_init_evaluators
	<<SF base: procedures>>=
	subroutine sf_chain_instance_init_evaluators (chain, extended_sf)
	class(sf_chain_instance_t), intent(inout), target :: chain
	logical, intent(in), optional :: extended_sf
	type(interaction_t), pointer :: int
	type(quantum_numbers_mask_t) :: mask
	integer :: i
	logical :: yorn
	yorn = .false.; if (present (extended_sf)) yorn = extended_sf
	if (chain%status >= SF_DONE_MASK) then
	if (allocated (chain%sf)) then
	if (size (chain%sf) /= 0) then
	mask = quantum_numbers_mask (.false., .false., .true.)
	int => beam_get_int_ptr (chain%beam_t)
	do i = 1, size (chain%sf)
	associate (sf => chain%sf(i))
	if (yorn) then
	if (int%get_n_sub () == 0) then
	call int%declare_subtraction (n_beam_structure_int)
	end if
	if (sf%int%interaction_t%get_n_sub () == 0) then
	call sf%int%interaction_t%declare_subtraction &
	(n_beam_structure_int)
	end if
	end if
	call sf%eval%init_product (int, sf%int%interaction_t, mask,&
	& ignore_sub = .true.)
	if (sf%eval%is_empty ()) then
	chain%status = SF_FAILED_CONNECTIONS
	return
	end if
	int => sf%eval%interaction_t
	end associate
	end do
	call find_outgoing_particles ()
	end if
	else if (chain%out_eval == 0) then
	int => beam_get_int_ptr (chain%beam_t)
	call int%tag_hard_process ()
	end if
	chain%status = SF_DONE_CONNECTIONS
	end if
	contains
	<<SF base: init evaluators: find outgoing particles>>
	end subroutine sf_chain_instance_init_evaluators

	@ %def sf_chain_instance_init_evaluators
	@ For debug purposes
	<<SF base: sf chain instance: TBP>>=
	procedure :: write_interaction => sf_chain_instance_write_interaction
	<<SF base: procedures>>=
	subroutine sf_chain_instance_write_interaction (chain, i_sf, i_int, unit)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: i_sf, i_int
	integer, intent(in) :: unit
	class(interaction_t), pointer :: int_in1 => null ()
	class(interaction_t), pointer :: int_in2 => null ()
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	if (chain%status >= SF_DONE_MASK) then
	if (allocated (chain%sf)) then
	int_in1 => evaluator_get_int_in_ptr (chain%sf(i_sf)%eval, 1)
	int_in2 => evaluator_get_int_in_ptr (chain%sf(i_sf)%eval, 2)
	if (int_in1%get_tag () == i_int) then
	call int_in1%basic_write (u)
	else if (int_in2%get_tag () == i_int) then
	call int_in2%basic_write (u)
	else
	write (u, "(A,1x,I0,1x,A,1x,I0)") 'No tag of sf', i_sf, 'matches' , i_int
	end if
	else
	write (u, "(A)") 'No sf_chain allocated!'
	end if
	else
	write (u, "(A)") 'sf_chain not ready!'
	end if
	end subroutine sf_chain_instance_write_interaction

	@ %def sf_chain_instance_write_interaction
	@ This is an internal subroutine of the previous one: After evaluators
	are set, trace the outgoing particles to the last evaluator. We only
	need the first channel, all channels are equivalent for this purpose.

	For each beam, the outgoing particle is located by [[out_sf]] (the
	structure-function object where it originates) and [[out_sf_i]] (the
	index within that object). This particle is referenced by the
	corresponding evaluator, which in turn is referenced by the next
	evaluator, until we are at the end of the chain. We can trace back
	references by [[interaction_find_link]]. Knowing that [[out_eval]] is
	the index of the last evaluator, we thus determine [[out_eval_i]], the
	index of the outgoing particle within that evaluator.
	<<SF base: init evaluators: find outgoing particles>>=
	subroutine find_outgoing_particles ()
	type(interaction_t), pointer :: int, int_next
	integer :: i, j, out_sf, out_i
	chain%out_eval = size (chain%sf)
	do j = 1, size (chain%out_eval_i)
	out_sf = chain%out_sf(j)
	out_i = chain%out_sf_i(j)
	if (out_sf == 0) then
	int => beam_get_int_ptr (chain%beam_t)
	out_sf = 1
	else
	int => chain%sf(out_sf)%int%interaction_t
	end if
	do i = out_sf, chain%out_eval
	int_next => chain%sf(i)%eval%interaction_t
	out_i = interaction_find_link (int_next, int, out_i)
	int => int_next
	end do
	chain%out_eval_i(j) = out_i
	end do
	call int%tag_hard_process (chain%out_eval_i)
	end subroutine find_outgoing_particles

	@ %def find_outgoing_particles
	@ Compute the kinematics in the chain instance. We can assume that
	the seed momenta are set in the configuration beams. Scanning the
	chain, we first transfer the incoming momenta. Then, the use up the MC input
	parameter array [[p]] to compute the radiated and outgoing momenta.

	In the multi-channel case, [[c_sel]] is the channel which we use for
	computing the kinematics and the [[x]] values. In the other channels,
	we invert the kinematics in order to recover the corresponding rows in
	the [[r]] array, and the Jacobian [[f]].

	We first apply any global mapping to transform the input [[p]] into
	the array [[r]]. This is then given to the structure functions which
	compute the final array [[x]] and Jacobian factors [[f]], which we
	multiply to obtain the overall Jacobian.
	<<SF base: sf chain instance: TBP>>=
	procedure :: compute_kinematics => sf_chain_instance_compute_kinematics
	<<SF base: procedures>>=
	subroutine sf_chain_instance_compute_kinematics (chain, c_sel, p_in)
	class(sf_chain_instance_t), intent(inout), target :: chain
	integer, intent(in) :: c_sel
	real(default), dimension(:), intent(in) :: p_in
	type(interaction_t), pointer :: int
	real(default) :: f_mapping
	logical, dimension(size (chain%bound)) :: bound
	integer :: i, j, c
	if (chain%status >= SF_DONE_CONNECTIONS) then
	call chain%select_channel (c_sel)
	int => beam_get_int_ptr (chain%beam_t)
	call int%receive_momenta ()
	if (allocated (chain%sf)) then
	if (size (chain%sf) /= 0) then
	forall (i = 1:size (chain%sf)) chain%sf(i)%int%status = SF_INITIAL
	!!! Bug in nagfor 5.3.1(907), fixed in 5.3.1(982)
	! chain%p (:,c_sel) = unpack (p_in, chain%bound, 0._default)
	!!! Workaround:
	bound = chain%bound
	chain%p (:,c_sel) = unpack (p_in, bound, 0._default)
	chain%pb(:,c_sel) = 1 - chain%p(:,c_sel)
	chain%f = 1
	chain%x_free = 1
	do i = 1, size (chain%sf)
	associate (sf => chain%sf(i))
	call sf%int%generate_free (sf%r(:,c_sel), sf%rb(:,c_sel), &
	chain%x_free)
	do j = 1, size (sf%x)
	if (.not. chain%bound(sf%int%par_index(j))) then
	chain%p (sf%int%par_index(j),c_sel) = sf%r (j,c_sel)
	chain%pb(sf%int%par_index(j),c_sel) = sf%rb(j,c_sel)
	end if
	end do
	end associate
	end do
	if (allocated (chain%channel(c_sel)%multi_mapping)) then
	call chain%channel(c_sel)%multi_mapping%compute &
	(chain%r(:,c_sel), chain%rb(:,c_sel), &
	f_mapping, &
	chain%p(:,c_sel), chain%pb(:,c_sel), &
	chain%x_free)
	chain%f(c_sel) = f_mapping
	else
	chain%r (:,c_sel) = chain%p (:,c_sel)
	chain%rb(:,c_sel) = chain%pb(:,c_sel)
	chain%f(c_sel) = 1
	end if
	do i = 1, size (chain%sf)
	associate (sf => chain%sf(i))
	call sf%int%seed_kinematics ()
	do j = 1, size (sf%x)
	sf%r (j,c_sel) = chain%r (sf%int%par_index(j),c_sel)
	sf%rb(j,c_sel) = chain%rb(sf%int%par_index(j),c_sel)
	end do
	call sf%int%complete_kinematics &
	(sf%x, sf%xb, sf%f(c_sel), sf%r(:,c_sel), sf%rb(:,c_sel), &
	sf%m(c_sel))
	do j = 1, size (sf%x)
	chain%x(sf%int%par_index(j)) = sf%x(j)
	chain%xb(sf%int%par_index(j)) = sf%xb(j)
	end do
	if (sf%int%status <= SF_FAILED_KINEMATICS) then
	chain%status = SF_FAILED_KINEMATICS
	return
	end if
	do c = 1, size (sf%f)
	if (c /= c_sel) then
	call sf%int%inverse_kinematics &
	(sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c))
	do j = 1, size (sf%x)
	chain%r (sf%int%par_index(j),c) = sf%r (j,c)
	chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
	end do
	end if
	chain%f(c) = chain%f(c) * sf%f(c)
	end do
	if (.not. sf%eval%is_empty ()) then
	call sf%eval%receive_momenta ()
	end if
	end associate
	end do
	do c = 1, size (chain%f)
	if (c /= c_sel) then
	if (allocated (chain%channel(c)%multi_mapping)) then
	call chain%channel(c)%multi_mapping%inverse &
	(chain%r(:,c), chain%rb(:,c), &
	f_mapping, &
	chain%p(:,c), chain%pb(:,c), &
	chain%x_free)
	chain%f(c) = chain%f(c) * f_mapping
	else
	chain%p (:,c) = chain%r (:,c)
	chain%pb(:,c) = chain%rb(:,c)
	end if
	end if
	end do
	end if
	end if
	chain%status = SF_DONE_KINEMATICS
	end if
	end subroutine sf_chain_instance_compute_kinematics

	@ %def sf_chain_instance_compute_kinematics
	@ This is a variant of the previous procedure. We know the $x$ parameters and
	reconstruct the momenta and the MC input parameters [[p]]. We do not need to
	select a channel.

	Note: this is probably redundant, since the method we actually want
	starts from the momenta, recovers all $x$ parameters, and then
	inverts mappings. See below [[recover_kinematics]].
	<<SF base: sf chain instance: TBP>>=
	procedure :: inverse_kinematics => sf_chain_instance_inverse_kinematics
	<<SF base: procedures>>=
	subroutine sf_chain_instance_inverse_kinematics (chain, x, xb)
	class(sf_chain_instance_t), intent(inout), target :: chain
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	type(interaction_t), pointer :: int
	real(default) :: f_mapping
	integer :: i, j, c
	if (chain%status >= SF_DONE_CONNECTIONS) then
	call chain%select_channel ()
	int => beam_get_int_ptr (chain%beam_t)
	call int%receive_momenta ()
	if (allocated (chain%sf)) then
	chain%f = 1
	if (size (chain%sf) /= 0) then
	forall (i = 1:size (chain%sf)) chain%sf(i)%int%status = SF_INITIAL
	chain%x = x
	chain%xb= xb
	do i = 1, size (chain%sf)
	associate (sf => chain%sf(i))
	call sf%int%seed_kinematics ()
	do j = 1, size (sf%x)
	sf%x(j) = chain%x(sf%int%par_index(j))
	sf%xb(j) = chain%xb(sf%int%par_index(j))
	end do
	do c = 1, size (sf%f)
	call sf%int%inverse_kinematics &
	- (sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c), c==1)
	+ (sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c), &
	+ set_momenta = c==1)
	chain%f(c) = chain%f(c) * sf%f(c)
	do j = 1, size (sf%x)
	chain%r (sf%int%par_index(j),c) = sf%r (j,c)
	chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
	end do
	end do
	if (.not. sf%eval%is_empty ()) then
	call sf%eval%receive_momenta ()
	end if
	end associate
	end do
	do c = 1, size (chain%f)
	if (allocated (chain%channel(c)%multi_mapping)) then
	call chain%channel(c)%multi_mapping%inverse &
	(chain%r(:,c), chain%rb(:,c), &
	f_mapping, &
	chain%p(:,c), chain%pb(:,c), &
	chain%x_free)
	chain%f(c) = chain%f(c) * f_mapping
	else
	chain%p (:,c) = chain%r (:,c)
	chain%pb(:,c) = chain%rb(:,c)
	end if
	end do
	end if
	end if
	chain%status = SF_DONE_KINEMATICS
	end if
	end subroutine sf_chain_instance_inverse_kinematics

	@ %def sf_chain_instance_inverse_kinematics
	@ Recover the kinematics: assuming that the last evaluator has
	been filled with a valid set of momenta, we travel the momentum links
	backwards and fill the preceding evaluators and, as a side effect,
	interactions. We stop at the beam interaction.

	After all momenta are set, apply the [[inverse_kinematics]] procedure
	above, suitably modified, to recover the $x$ and $p$ parameters and
	the Jacobian factors.

	The [[c_sel]] (channel) argument is just used to mark a selected
	channel for the records, otherwise the recovery procedure is
	independent of this.
	<<SF base: sf chain instance: TBP>>=
	procedure :: recover_kinematics => sf_chain_instance_recover_kinematics
	<<SF base: procedures>>=
	subroutine sf_chain_instance_recover_kinematics (chain, c_sel)
	class(sf_chain_instance_t), intent(inout), target :: chain
	integer, intent(in) :: c_sel
	real(default) :: f_mapping
	integer :: i, j, c
	if (chain%status >= SF_DONE_CONNECTIONS) then
	call chain%select_channel (c_sel)
	if (allocated (chain%sf)) then
	do i = size (chain%sf), 1, -1
	associate (sf => chain%sf(i))
	if (.not. sf%eval%is_empty ()) then
	call interaction_send_momenta (sf%eval%interaction_t)
	end if
	end associate
	end do
	chain%f = 1
	if (size (chain%sf) /= 0) then
	forall (i = 1:size (chain%sf)) chain%sf(i)%int%status = SF_INITIAL
	chain%x_free = 1
	do i = 1, size (chain%sf)
	associate (sf => chain%sf(i))
	call sf%int%seed_kinematics ()
	call sf%int%recover_x (sf%x, sf%xb, chain%x_free)
	do j = 1, size (sf%x)
	chain%x(sf%int%par_index(j)) = sf%x(j)
	chain%xb(sf%int%par_index(j)) = sf%xb(j)
	end do
	do c = 1, size (sf%f)
	call sf%int%inverse_kinematics &
	- (sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c), c==1)
	+ (sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c), &
	+ set_momenta = .false.)
	chain%f(c) = chain%f(c) * sf%f(c)
	do j = 1, size (sf%x)
	chain%r (sf%int%par_index(j),c) = sf%r (j,c)
	chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
	end do
	end do
	end associate
	end do
	do c = 1, size (chain%f)
	if (allocated (chain%channel(c)%multi_mapping)) then
	call chain%channel(c)%multi_mapping%inverse &
	(chain%r(:,c), chain%rb(:,c), &
	f_mapping, &
	chain%p(:,c), chain%pb(:,c), &
	chain%x_free)
	chain%f(c) = chain%f(c) * f_mapping
	else
	chain%p (:,c) = chain%r (:,c)
	chain%pb(:,c) = chain%rb(:,c)
	end if
	end do
	end if
	end if
	chain%status = SF_DONE_KINEMATICS
	end if
	end subroutine sf_chain_instance_recover_kinematics

	@ %def sf_chain_instance_recover_kinematics
	@ Return the initial beam momenta to their source, thus completing
	kinematics recovery. Obviously, this works as a side effect.
	<<SF base: sf chain instance: TBP>>=
	procedure :: return_beam_momenta => sf_chain_instance_return_beam_momenta
	<<SF base: procedures>>=
	subroutine sf_chain_instance_return_beam_momenta (chain)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(interaction_t), pointer :: int
	if (chain%status >= SF_DONE_KINEMATICS) then
	int => beam_get_int_ptr (chain%beam_t)
	call interaction_send_momenta (int)
	end if
	end subroutine sf_chain_instance_return_beam_momenta

	@ %def sf_chain_instance_return_beam_momenta
	@ Evaluate all interactions in the chain and the product evaluators.
	We provide a [[scale]] argument that is given to all structure
	functions in the chain.

	Hadronic NLO calculations involve rescaled fractions of the original beam
	momentum and PDF singlets (sums over flavors). In particular, we have to handle the following cases:
	\begin{itemize}
	\item normal evaluation (where [[n_sub = 0]]) for Born and Virtual processes,
	\item rescaled momentum fraction for matching [[i_beam == i_sub]], [[n_sub > 0]] and
	[[sf_rescale]] present, the other beam is kept at born kinematics,
	\item filling the subtraction terms with values from the current evaluation
	[[fill_sub = .true.]], used for the non-rescaled beam,
	\item restricted rescaling to only one beam with [[sf_rescale%is_restricted]].
	\end{itemize}
	For the collinear final or intial state counter terms, we apply a rescaling to
	one beam, and keep the other beam as is. We redo it then vice versa having now two subtractions.
	We add two more subtraction where we apply the rescaled gluonic PDF to
	\textit{all} flavors for the PDF singlet calculations.
	For the real rescalation, we have only one rescaled beams, therefore, we have only one
	subtraction.
	<<SF base: sf chain instance: TBP>>=
	procedure :: evaluate => sf_chain_instance_evaluate
	<<SF base: procedures>>=
	subroutine sf_chain_instance_evaluate (chain, scale, sf_rescale)
	class(sf_chain_instance_t), intent(inout), target :: chain
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(inout), optional :: sf_rescale
	type(interaction_t), pointer :: out_int
	real(default) :: sf_sum
	integer :: i_beam, i_sub, n_sub
	if (chain%status >= SF_DONE_KINEMATICS) then
	if (allocated (chain%sf)) then
	if (size (chain%sf) /= 0) then
	do i_beam = 1, size (chain%sf)
	associate (sf => chain%sf(i_beam))
	n_sub = 0 ! default: no looping over rescaled beams
	if (present (sf_rescale)) then
	! TODO sbrass cache n_sub as it is computed from the state matrix
	n_sub = sf%int%get_n_sub ()
	call sf_rescale%set_i_beam (i_beam)
	end if
	SUB: do i_sub = 0, n_sub
	select case (i_sub)
	case (0)
	if (n_sub == 0) then
	call sf%int%apply (scale, sf_rescale)
	else
	call sf%int%apply (scale, fill_sub = .true.)
	end if
	case (1:2)
	if (present (sf_rescale)) then
	if (sf_rescale%is_restricted (i_beam)) cycle SUB
	end if
	if (i_sub == i_beam) then
	call sf%int%apply(scale, sf_rescale, i_sub)
	end if
	case (3:4)
	! dummy : handled more appropriately on a lower level (sf%int%apply ())
	case default
	call msg_bug ("sf_chain_instance_evaluate: more than 2&
	& subtraction indices are curently not handled.")
	end select
	if (sf%int%status <= SF_FAILED_EVALUATION) then
	chain%status = SF_FAILED_EVALUATION
	return
	end if
	end do SUB
	if (.not. sf%eval%is_empty ()) call sf%eval%evaluate ()
	end associate
	end do
	out_int => chain%get_out_int_ptr ()
	sf_sum = real (out_int%sum ())
	call chain%config%trace &
	(chain%selected_channel, chain%p, chain%x, chain%f, sf_sum)
	end if
	end if
	chain%status = SF_EVALUATED
	end if
	end subroutine sf_chain_instance_evaluate

	@ %def sf_chain_instance_evaluate
	@
	\subsection{Access to the chain instance}
	Transfer the outgoing momenta to the array [[p]]. We assume that
	array sizes match.
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_out_momenta => sf_chain_instance_get_out_momenta
	<<SF base: procedures>>=
	subroutine sf_chain_instance_get_out_momenta (chain, p)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(vector4_t), dimension(:), intent(out) :: p
	type(interaction_t), pointer :: int
	integer :: i, j
	if (chain%status >= SF_DONE_KINEMATICS) then
	do j = 1, size (chain%out_sf)
	i = chain%out_sf(j)
	select case (i)
	case (0)
	int => beam_get_int_ptr (chain%beam_t)
	case default
	int => chain%sf(i)%int%interaction_t
	end select
	p(j) = int%get_momentum (chain%out_sf_i(j))
	end do
	end if
	end subroutine sf_chain_instance_get_out_momenta

	@ %def sf_chain_instance_get_out_momenta
	@ Return a pointer to the last evaluator in the chain (to the interaction).
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_out_int_ptr => sf_chain_instance_get_out_int_ptr
	<<SF base: procedures>>=
	function sf_chain_instance_get_out_int_ptr (chain) result (int)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(interaction_t), pointer :: int
	if (chain%out_eval == 0) then
	int => beam_get_int_ptr (chain%beam_t)
	else
	int => chain%sf(chain%out_eval)%eval%interaction_t
	end if
	end function sf_chain_instance_get_out_int_ptr

	@ %def sf_chain_instance_get_out_int_ptr
	@ Return the index of the [[j]]-th outgoing particle, within the last
	evaluator.
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_out_i => sf_chain_instance_get_out_i
	<<SF base: procedures>>=
	function sf_chain_instance_get_out_i (chain, j) result (i)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: j
	integer :: i
	i = chain%out_eval_i(j)
	end function sf_chain_instance_get_out_i

	@ %def sf_chain_instance_get_out_i
	@ Return the mask for the outgoing particle(s), within the last evaluator.
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_out_mask => sf_chain_instance_get_out_mask
	<<SF base: procedures>>=
	function sf_chain_instance_get_out_mask (chain) result (mask)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
	type(interaction_t), pointer :: int
	allocate (mask (chain%config%n_in))
	int => chain%get_out_int_ptr ()
	mask = int%get_mask (chain%out_eval_i)
	end function sf_chain_instance_get_out_mask

	@ %def sf_chain_instance_get_out_mask
	@ Return the array of MC input parameters that corresponds to channel [[c]].
	This is the [[p]] array, the parameters before all mappings.

	The [[p]] array may be deallocated. This should correspond to a
	zero-size [[r]] argument, so nothing to do then.
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_mcpar => sf_chain_instance_get_mcpar
	<<SF base: procedures>>=
	subroutine sf_chain_instance_get_mcpar (chain, c, r)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: c
	real(default), dimension(:), intent(out) :: r
	if (allocated (chain%p)) r = pack (chain%p(:,c), chain%bound)
	end subroutine sf_chain_instance_get_mcpar

	@ %def sf_chain_instance_get_mcpar
	@ Return the Jacobian factor that corresponds to channel [[c]].
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_f => sf_chain_instance_get_f
	<<SF base: procedures>>=
	function sf_chain_instance_get_f (chain, c) result (f)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: c
	real(default) :: f
	if (allocated (chain%f)) then
	f = chain%f(c)
	else
	f = 1
	end if
	end function sf_chain_instance_get_f

	@ %def sf_chain_instance_get_f
	@ Return the evaluation status.
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_status => sf_chain_instance_get_status
	<<SF base: procedures>>=
	function sf_chain_instance_get_status (chain) result (status)
	class(sf_chain_instance_t), intent(in) :: chain
	integer :: status
	status = chain%status
	end function sf_chain_instance_get_status

	@ %def sf_chain_instance_get_status
	@
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_matrix_elements => sf_chain_instance_get_matrix_elements
	<<SF base: procedures>>=
	subroutine sf_chain_instance_get_matrix_elements (chain, i, ff)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: i
	real(default), intent(out), dimension(:), allocatable :: ff

	associate (sf => chain%sf(i))
	ff = real (sf%int%get_matrix_element ())
	end associate
	end subroutine sf_chain_instance_get_matrix_elements

	@ %def sf_chain_instance_get_matrix_elements
	@
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_beam_int_ptr => sf_chain_instance_get_beam_int_ptr
	<<SF base: procedures>>=
	function sf_chain_instance_get_beam_int_ptr (chain) result (int)
	type(interaction_t), pointer :: int
	class(sf_chain_instance_t), intent(in), target :: chain
	int => beam_get_int_ptr (chain%beam_t)
	end function sf_chain_instance_get_beam_int_ptr

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

	module sf_base_ut
	use unit_tests
	use sf_base_uti

	<<Standard module head>>

	<<SF base: public test auxiliary>>

	<<SF base: public test>>

	contains

	<<SF base: test driver>>

	end module sf_base_ut
	@ %def sf_base_ut
	@
	<<[[sf_base_uti.f90]]>>=
	<<File header>>

	module sf_base_uti

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_19
	use format_utils, only: write_separator
	use diagnostics
	use lorentz
	use pdg_arrays
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices, only: FM_IGNORE_HELICITY
	use interactions
	use particles
	use model_data
	use beams
	use sf_aux
	use sf_mappings

	use sf_base

	<<Standard module head>>

	<<SF base: test declarations>>

	<<SF base: public test auxiliary>>

	<<SF base: test types>>

	contains

	<<SF base: tests>>

	<<SF base: test auxiliary>>

	end module sf_base_uti
	@ %def sf_base_ut
	@ API: driver for the unit tests below.
	<<SF base: public test>>=
	public :: sf_base_test
	<<SF base: test driver>>=
	subroutine sf_base_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF base: execute tests>>
	end subroutine sf_base_test

	@ %def sf_base_test
	@
	\subsection{Test implementation: structure function}
	This is a template for the actual structure-function implementation
	which will be defined in separate modules.

	\subsubsection{Configuration data}
	The test structure function uses the [[Test]] model. It describes a
	scalar within an arbitrary initial particle, which is given in the
	initialization. The radiated particle is also a scalar, the same one,
	but we set its mass artificially to zero.
	<<SF base: public test auxiliary>>=
	public :: sf_test_data_t
	<<SF base: test types>>=
	type, extends (sf_data_t) :: sf_test_data_t
	class(model_data_t), pointer :: model => null ()
	integer :: mode = 0
	type(flavor_t) :: flv_in
	type(flavor_t) :: flv_out
	type(flavor_t) :: flv_rad
	real(default) :: m = 0
	logical :: collinear = .true.
	real(default), dimension(:), allocatable :: qbounds
	contains
	<<SF base: sf test data: TBP>>
	end type sf_test_data_t

	@ %def sf_test_data_t
	@ Output.
	<<SF base: sf test data: TBP>>=
	procedure :: write => sf_test_data_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_data_write (data, unit, verbose)
	class(sf_test_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "SF test data:"
	write (u, "(3x,A,A)") "model = ", char (data%model%get_name ())
	write (u, "(3x,A)", advance="no") "incoming = "
	call data%flv_in%write (u); write (u, *)
	write (u, "(3x,A)", advance="no") "outgoing = "
	call data%flv_out%write (u); write (u, *)
	write (u, "(3x,A)", advance="no") "radiated = "
	call data%flv_rad%write (u); write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") "mass = ", data%m
	write (u, "(3x,A,L1)") "collinear = ", data%collinear
	if (.not. data%collinear .and. allocated (data%qbounds)) then
	write (u, "(3x,A," // FMT_19 // ")") "qmin = ", data%qbounds(1)
	write (u, "(3x,A," // FMT_19 // ")") "qmax = ", data%qbounds(2)
	end if
	end subroutine sf_test_data_write

	@ %def sf_test_data_write
	@ Initialization.
	<<SF base: sf test data: TBP>>=
	procedure :: init => sf_test_data_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_data_init (data, model, pdg_in, collinear, qbounds, mode)
	class(sf_test_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	logical, intent(in), optional :: collinear
	real(default), dimension(2), intent(in), optional :: qbounds
	integer, intent(in), optional :: mode
	data%model => model
	if (present (mode)) data%mode = mode
	if (pdg_array_get (pdg_in, 1) /= 25) then
	call msg_fatal ("Test spectrum function: input flavor must be 's'")
	end if
	call data%flv_in%init (25, model)
	data%m = data%flv_in%get_mass ()
	if (present (collinear)) data%collinear = collinear
	call data%flv_out%init (25, model)
	call data%flv_rad%init (25, model)
	if (present (qbounds)) then
	allocate (data%qbounds (2))
	data%qbounds = qbounds
	end if
	end subroutine sf_test_data_init

	@ %def sf_test_data_init
	@ Return the number of parameters: 1 if only consider collinear
	splitting, 3 otherwise.
	<<SF base: sf test data: TBP>>=
	procedure :: get_n_par => sf_test_data_get_n_par
	<<SF base: test auxiliary>>=
	function sf_test_data_get_n_par (data) result (n)
	class(sf_test_data_t), intent(in) :: data
	integer :: n
	if (data%collinear) then
	n = 1
	else
	n = 3
	end if
	end function sf_test_data_get_n_par

	@ %def sf_test_data_get_n_par
	@ Return the outgoing particle PDG code: 25
	<<SF base: sf test data: TBP>>=
	procedure :: get_pdg_out => sf_test_data_get_pdg_out
	<<SF base: test auxiliary>>=
	subroutine sf_test_data_get_pdg_out (data, pdg_out)
	class(sf_test_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	pdg_out(1) = 25
	end subroutine sf_test_data_get_pdg_out

	@ %def sf_test_data_get_pdg_out
	@ Allocate the matching interaction.
	<<SF base: sf test data: TBP>>=
	procedure :: allocate_sf_int => sf_test_data_allocate_sf_int
	<<SF base: test auxiliary>>=
	subroutine sf_test_data_allocate_sf_int (data, sf_int)
	class(sf_test_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	if (allocated (sf_int)) deallocate (sf_int)
	allocate (sf_test_t :: sf_int)
	end subroutine sf_test_data_allocate_sf_int

	@ %def sf_test_data_allocate_sf_int
	@
	\subsubsection{Interaction}
	<<SF base: test types>>=
	type, extends (sf_int_t) :: sf_test_t
	type(sf_test_data_t), pointer :: data => null ()
	real(default) :: x = 0
	contains
	<<SF base: sf test int: TBP>>
	end type sf_test_t

	@ %def sf_test_t
	@ Type string: constant
	<<SF base: sf test int: TBP>>=
	procedure :: type_string => sf_test_type_string
	<<SF base: test auxiliary>>=
	function sf_test_type_string (object) result (string)
	class(sf_test_t), intent(in) :: object
	type(string_t) :: string
	string = "Test"
	end function sf_test_type_string

	@ %def sf_test_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF base: sf test int: TBP>>=
	procedure :: write => sf_test_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_write (object, unit, testflag)
	class(sf_test_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "SF test data: [undefined]"
	end if
	end subroutine sf_test_write

	@ %def sf_test_write
	@ Initialize. We know that [[data]] will be of concrete type
	[[sf_test_data_t]], but we have to cast this explicitly.

	For this implementation, we set the incoming and outgoing masses equal
	to the physical particle mass, but keep the radiated mass zero.

	Optionally, we can provide minimum and maximum values for the momentum
	transfer.
	<<SF base: sf test int: TBP>>=
	procedure :: init => sf_test_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_init (sf_int, data)
	class(sf_test_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	type(helicity_t) :: hel0
	type(color_t) :: col0
	type(quantum_numbers_t), dimension(3) :: qn
	mask = quantum_numbers_mask (.false., .false., .false.)
	select type (data)
	type is (sf_test_data_t)
	if (allocated (data%qbounds)) then
	call sf_int%base_init (mask, &
	[data%m2], [0._default], [data%m2], &
	[data%qbounds(1)], [data%qbounds(2)])
	else
	call sf_int%base_init (mask, &
	[data%m2], [0._default], [data%m2])
	end if
	sf_int%data => data
	call hel0%init (0)
	call col0%init ()
	call qn(1)%init (data%flv_in, col0, hel0)
	call qn(2)%init (data%flv_rad, col0, hel0)
	call qn(3)%init (data%flv_out, col0, hel0)
	call sf_int%add_state (qn)
	call sf_int%freeze ()
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	end select
	sf_int%status = SF_INITIAL
	end subroutine sf_test_init

	@ %def sf_test_init
	@ Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ is trivial.

	If [[map]] is set, we are asked to provide an efficient mapping.
	For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
	<<SF base: sf test int: TBP>>=
	procedure :: complete_kinematics => sf_test_complete_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(sf_test_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	x(1) = r(1)**2
	f = 2 * r(1)
	else
	x(1) = r(1)
	f = 1
	end if
	xb(1) = 1 - x(1)
	if (size (x) == 3) then
	x(2:3) = r(2:3)
	xb(2:3) = rb(2:3)
	end if
	call sf_int%split_momentum (x, xb)
	sf_int%x = x(1)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end subroutine sf_test_complete_kinematics

	@ %def sf_test_complete_kinematics
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF base: sf test int: TBP>>=
	procedure :: inverse_kinematics => sf_test_inverse_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	class(sf_test_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	r(1) = sqrt (x(1))
	f = 2 * r(1)
	else
	r(1) = x(1)
	f = 1
	end if
	if (size (x) == 3) r(2:3) = x(2:3)
	rb = 1 - r
	sf_int%x = x(1)
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine sf_test_inverse_kinematics

	@ %def sf_test_inverse_kinematics
	@ Apply the structure function. The matrix element becomes unity and
	the application always succeeds.

	If the [[mode]] indicator is one, the matrix element is equal to the
	parameter~$x$.
	<<SF base: sf test int: TBP>>=
	procedure :: apply => sf_test_apply
	<<SF base: test auxiliary>>=
	subroutine sf_test_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(sf_test_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	select case (sf_int%data%mode)
	case (0)
	call sf_int%set_matrix_element &
	(cmplx (1._default, kind=default))
	case (1)
	call sf_int%set_matrix_element &
	(cmplx (sf_int%x, kind=default))
	end select
	sf_int%status = SF_EVALUATED
	end subroutine sf_test_apply

	@ %def sf_test_apply
	@
	\subsection{Test implementation: pair spectrum}
	Another template, this time for a incoming particle pair, splitting
	into two radiated and two outgoing particles.

	\subsubsection{Configuration data}
	For simplicity, the spectrum contains two mirror images of the
	previous structure-function configuration: the incoming and all
	outgoing particles are test scalars.

	We have two versions, one with radiated particles, one without.
	<<SF base: test types>>=
	type, extends (sf_data_t) :: sf_test_spectrum_data_t
	class(model_data_t), pointer :: model => null ()
	type(flavor_t) :: flv_in
	type(flavor_t) :: flv_out
	type(flavor_t) :: flv_rad
	logical :: with_radiation = .true.
	real(default) :: m = 0
	contains
	<<SF base: sf test spectrum data: TBP>>
	end type sf_test_spectrum_data_t

	@ %def sf_test_spectrum_data_t
	@ Output.
	<<SF base: sf test spectrum data: TBP>>=
	procedure :: write => sf_test_spectrum_data_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_data_write (data, unit, verbose)
	class(sf_test_spectrum_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "SF test spectrum data:"
	write (u, "(3x,A,A)") "model = ", char (data%model%get_name ())
	write (u, "(3x,A)", advance="no") "incoming = "
	call data%flv_in%write (u); write (u, *)
	write (u, "(3x,A)", advance="no") "outgoing = "
	call data%flv_out%write (u); write (u, *)
	write (u, "(3x,A)", advance="no") "radiated = "
	call data%flv_rad%write (u); write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") "mass = ", data%m
	end subroutine sf_test_spectrum_data_write

	@ %def sf_test_spectrum_data_write
	@ Initialization.
	<<SF base: sf test spectrum data: TBP>>=
	procedure :: init => sf_test_spectrum_data_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_data_init (data, model, pdg_in, with_radiation)
	class(sf_test_spectrum_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	logical, intent(in) :: with_radiation
	data%model => model
	data%with_radiation = with_radiation
	if (pdg_array_get (pdg_in, 1) /= 25) then
	call msg_fatal ("Test structure function: input flavor must be 's'")
	end if
	call data%flv_in%init (25, model)
	data%m = data%flv_in%get_mass ()
	call data%flv_out%init (25, model)
	if (with_radiation) then
	call data%flv_rad%init (25, model)
	end if
	end subroutine sf_test_spectrum_data_init

	@ %def sf_test_spectrum_data_init
	@ Return the number of parameters: 2, since we have only collinear
	splitting here.
	<<SF base: sf test spectrum data: TBP>>=
	procedure :: get_n_par => sf_test_spectrum_data_get_n_par
	<<SF base: test auxiliary>>=
	function sf_test_spectrum_data_get_n_par (data) result (n)
	class(sf_test_spectrum_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function sf_test_spectrum_data_get_n_par

	@ %def sf_test_spectrum_data_get_n_par
	@ Return the outgoing particle PDG codes: 25
	<<SF base: sf test spectrum data: TBP>>=
	procedure :: get_pdg_out => sf_test_spectrum_data_get_pdg_out
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_data_get_pdg_out (data, pdg_out)
	class(sf_test_spectrum_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	pdg_out(1) = 25
	pdg_out(2) = 25
	end subroutine sf_test_spectrum_data_get_pdg_out

	@ %def sf_test_spectrum_data_get_pdg_out
	@ Allocate the matching interaction.
	<<SF base: sf test spectrum data: TBP>>=
	procedure :: allocate_sf_int => &
	sf_test_spectrum_data_allocate_sf_int
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_data_allocate_sf_int (data, sf_int)
	class(sf_test_spectrum_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (sf_test_spectrum_t :: sf_int)
	end subroutine sf_test_spectrum_data_allocate_sf_int

	@ %def sf_test_spectrum_data_allocate_sf_int
	@
	\subsubsection{Interaction}
	<<SF base: test types>>=
	type, extends (sf_int_t) :: sf_test_spectrum_t
	type(sf_test_spectrum_data_t), pointer :: data => null ()
	contains
	<<SF base: sf test spectrum: TBP>>
	end type sf_test_spectrum_t

	@ %def sf_test_spectrum_t
	<<SF base: sf test spectrum: TBP>>=
	procedure :: type_string => sf_test_spectrum_type_string
	<<SF base: test auxiliary>>=
	function sf_test_spectrum_type_string (object) result (string)
	class(sf_test_spectrum_t), intent(in) :: object
	type(string_t) :: string
	string = "Test Spectrum"
	end function sf_test_spectrum_type_string

	@ %def sf_test_spectrum_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF base: sf test spectrum: TBP>>=
	procedure :: write => sf_test_spectrum_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_write (object, unit, testflag)
	class(sf_test_spectrum_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "SF test spectrum data: [undefined]"
	end if
	end subroutine sf_test_spectrum_write

	@ %def sf_test_spectrum_write
	@ Initialize. We know that [[data]] will be of concrete type
	[[sf_test_spectrum_data_t]], but we have to cast this explicitly.

	For this implementation, we set the incoming and outgoing masses equal
	to the physical particle mass, but keep the radiated mass zero.

	Optionally, we can provide minimum and maximum values for the momentum
	transfer.
	<<SF base: sf test spectrum: TBP>>=
	procedure :: init => sf_test_spectrum_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_init (sf_int, data)
	class(sf_test_spectrum_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(6) :: mask
	type(helicity_t) :: hel0
	type(color_t) :: col0
	type(quantum_numbers_t), dimension(6) :: qn
	mask = quantum_numbers_mask (.false., .false., .false.)
	select type (data)
	type is (sf_test_spectrum_data_t)
	if (data%with_radiation) then
	call sf_int%base_init (mask(1:6), &
	[data%m2, data%m2], &
	[0._default, 0._default], &
	[data%m2, data%m2])
	sf_int%data => data
	call hel0%init (0)
	call col0%init ()
	call qn(1)%init (data%flv_in, col0, hel0)
	call qn(2)%init (data%flv_in, col0, hel0)
	call qn(3)%init (data%flv_rad, col0, hel0)
	call qn(4)%init (data%flv_rad, col0, hel0)
	call qn(5)%init (data%flv_out, col0, hel0)
	call qn(6)%init (data%flv_out, col0, hel0)
	call sf_int%add_state (qn(1:6))
	call sf_int%set_incoming ([1,2])
	call sf_int%set_radiated ([3,4])
	call sf_int%set_outgoing ([5,6])
	else
	call sf_int%base_init (mask(1:4), &
	[data%m2, data%m2], &
	[real(default) :: ], &
	[data%m2, data%m2])
	sf_int%data => data
	call hel0%init (0)
	call col0%init ()
	call qn(1)%init (data%flv_in, col0, hel0)
	call qn(2)%init (data%flv_in, col0, hel0)
	call qn(3)%init (data%flv_out, col0, hel0)
	call qn(4)%init (data%flv_out, col0, hel0)
	call sf_int%add_state (qn(1:4))
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	end if
	call sf_int%freeze ()
	end select
	sf_int%status = SF_INITIAL
	end subroutine sf_test_spectrum_init

	@ %def sf_test_spectrum_init
	@ Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ is trivial.

	If [[map]] is set, we are asked to provide an efficient mapping.
	For the test case, we set $x=r^2$ (as above) for both $x$ parameters
	and consequently $f(r)=4r_1r_2$.

	<<SF base: sf test spectrum: TBP>>=
	procedure :: complete_kinematics => sf_test_spectrum_complete_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(sf_test_spectrum_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	real(default), dimension(2) :: xb1
	if (map) then
	x = r**2
	f = 4 * r(1) * r(2)
	else
	x = r
	f = 1
	end if
	xb = 1 - x
	if (sf_int%data%with_radiation) then
	call sf_int%split_momenta (x, xb)
	else
	call sf_int%reduce_momenta (x)
	end if
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end subroutine sf_test_spectrum_complete_kinematics

	@ %def sf_test_spectrum_complete_kinematics
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF base: sf test spectrum: TBP>>=
	procedure :: inverse_kinematics => sf_test_spectrum_inverse_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(sf_test_spectrum_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	real(default), dimension(2) :: xb1
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	r = sqrt (x)
	f = 4 * r(1) * r(2)
	else
	r = x
	f = 1
	end if
	rb = 1 - r
	if (set_mom) then
	if (sf_int%data%with_radiation) then
	call sf_int%split_momenta (x, xb)
	else
	call sf_int%reduce_momenta (x)
	end if
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine sf_test_spectrum_inverse_kinematics

	@ %def sf_test_spectrum_inverse_kinematics
	@ Apply the structure function. The matrix element becomes unity and
	the application always succeeds.
	<<SF base: sf test spectrum: TBP>>=
	procedure :: apply => sf_test_spectrum_apply
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(sf_test_spectrum_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	call sf_int%set_matrix_element &
	(cmplx (1._default, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine sf_test_spectrum_apply

	@ %def sf_test_spectrum_apply
	@
	\subsection{Test implementation: generator spectrum}
	A generator for two beams, no radiation (for simplicity).

	\subsubsection{Configuration data}
	For simplicity, the spectrum contains two mirror images of the
	previous structure-function configuration: the incoming and all
	outgoing particles are test scalars.

	We have two versions, one with radiated particles, one without.
	<<SF base: test types>>=
	type, extends (sf_data_t) :: sf_test_generator_data_t
	class(model_data_t), pointer :: model => null ()
	type(flavor_t) :: flv_in
	type(flavor_t) :: flv_out
	type(flavor_t) :: flv_rad
	real(default) :: m = 0
	contains
	<<SF base: sf test generator data: TBP>>
	end type sf_test_generator_data_t

	@ %def sf_test_generator_data_t
	@ Output.
	<<SF base: sf test generator data: TBP>>=
	procedure :: write => sf_test_generator_data_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_data_write (data, unit, verbose)
	class(sf_test_generator_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "SF test generator data:"
	write (u, "(3x,A,A)") "model = ", char (data%model%get_name ())
	write (u, "(3x,A)", advance="no") "incoming = "
	call data%flv_in%write (u); write (u, *)
	write (u, "(3x,A)", advance="no") "outgoing = "
	call data%flv_out%write (u); write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") "mass = ", data%m
	end subroutine sf_test_generator_data_write

	@ %def sf_test_generator_data_write
	@ Initialization.
	<<SF base: sf test generator data: TBP>>=
	procedure :: init => sf_test_generator_data_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_data_init (data, model, pdg_in)
	class(sf_test_generator_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	data%model => model
	if (pdg_array_get (pdg_in, 1) /= 25) then
	call msg_fatal ("Test generator: input flavor must be 's'")
	end if
	call data%flv_in%init (25, model)
	data%m = data%flv_in%get_mass ()
	call data%flv_out%init (25, model)
	end subroutine sf_test_generator_data_init

	@ %def sf_test_generator_data_init
	@ This structure function is a generator.
	<<SF base: sf test generator data: TBP>>=
	procedure :: is_generator => sf_test_generator_data_is_generator
	<<SF base: test auxiliary>>=
	function sf_test_generator_data_is_generator (data) result (flag)
	class(sf_test_generator_data_t), intent(in) :: data
	logical :: flag
	flag = .true.
	end function sf_test_generator_data_is_generator

	@ %def sf_test_generator_data_is_generator
	@ Return the number of parameters: 2, since we have only collinear
	splitting here.
	<<SF base: sf test generator data: TBP>>=
	procedure :: get_n_par => sf_test_generator_data_get_n_par
	<<SF base: test auxiliary>>=
	function sf_test_generator_data_get_n_par (data) result (n)
	class(sf_test_generator_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function sf_test_generator_data_get_n_par

	@ %def sf_test_generator_data_get_n_par
	@ Return the outgoing particle PDG codes: 25
	<<SF base: sf test generator data: TBP>>=
	procedure :: get_pdg_out => sf_test_generator_data_get_pdg_out
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_data_get_pdg_out (data, pdg_out)
	class(sf_test_generator_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	pdg_out(1) = 25
	pdg_out(2) = 25
	end subroutine sf_test_generator_data_get_pdg_out

	@ %def sf_test_generator_data_get_pdg_out
	@ Allocate the matching interaction.
	<<SF base: sf test generator data: TBP>>=
	procedure :: allocate_sf_int => &
	sf_test_generator_data_allocate_sf_int
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_data_allocate_sf_int (data, sf_int)
	class(sf_test_generator_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (sf_test_generator_t :: sf_int)
	end subroutine sf_test_generator_data_allocate_sf_int

	@ %def sf_test_generator_data_allocate_sf_int
	@
	\subsubsection{Interaction}
	<<SF base: test types>>=
	type, extends (sf_int_t) :: sf_test_generator_t
	type(sf_test_generator_data_t), pointer :: data => null ()
	contains
	<<SF base: sf test generator: TBP>>
	end type sf_test_generator_t

	@ %def sf_test_generator_t
	<<SF base: sf test generator: TBP>>=
	procedure :: type_string => sf_test_generator_type_string
	<<SF base: test auxiliary>>=
	function sf_test_generator_type_string (object) result (string)
	class(sf_test_generator_t), intent(in) :: object
	type(string_t) :: string
	string = "Test Generator"
	end function sf_test_generator_type_string

	@ %def sf_test_generator_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF base: sf test generator: TBP>>=
	procedure :: write => sf_test_generator_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_write (object, unit, testflag)
	class(sf_test_generator_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "SF test generator data: [undefined]"
	end if
	end subroutine sf_test_generator_write

	@ %def sf_test_generator_write
	@ Initialize. We know that [[data]] will be of concrete type
	[[sf_test_generator_data_t]], but we have to cast this explicitly.

	For this implementation, we set the incoming and outgoing masses equal
	to the physical particle mass. No radiation.
	<<SF base: sf test generator: TBP>>=
	procedure :: init => sf_test_generator_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_init (sf_int, data)
	class(sf_test_generator_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(4) :: mask
	type(helicity_t) :: hel0
	type(color_t) :: col0
	type(quantum_numbers_t), dimension(4) :: qn
	mask = quantum_numbers_mask (.false., .false., .false.)
	select type (data)
	type is (sf_test_generator_data_t)
	call sf_int%base_init (mask(1:4), &
	[data%m2, data%m2], &
	[real(default) :: ], &
	[data%m2, data%m2])
	sf_int%data => data
	call hel0%init (0)
	call col0%init ()
	call qn(1)%init (data%flv_in, col0, hel0)
	call qn(2)%init (data%flv_in, col0, hel0)
	call qn(3)%init (data%flv_out, col0, hel0)
	call qn(4)%init (data%flv_out, col0, hel0)
	call sf_int%add_state (qn(1:4))
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	call sf_int%freeze ()
	end select
	sf_int%status = SF_INITIAL
	end subroutine sf_test_generator_init

	@ %def sf_test_generator_init
	@ This structure function is a generator.
	<<SF base: sf test generator: TBP>>=
	procedure :: is_generator => sf_test_generator_is_generator
	<<SF base: test auxiliary>>=
	function sf_test_generator_is_generator (sf_int) result (flag)
	class(sf_test_generator_t), intent(in) :: sf_int
	logical :: flag
	flag = sf_int%data%is_generator ()
	end function sf_test_generator_is_generator

	@ %def sf_test_generator_is_generator
	@ Generate free parameters. This mock generator always produces the
	nubmers 0.8 and 0.5.
	<<SF base: sf test generator: TBP>>=
	procedure :: generate_free => sf_test_generator_generate_free
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_generate_free (sf_int, r, rb, x_free)
	class(sf_test_generator_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	r = [0.8, 0.5]
	rb= 1 - r
	x_free = x_free * product (r)
	end subroutine sf_test_generator_generate_free

	@ %def sf_test_generator_generate_free
	@ Recover momentum fractions. Since the x values are free, we also set the [[x_free]] parameter.
	<<SF base: sf test generator: TBP>>=
	procedure :: recover_x => sf_test_generator_recover_x
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_recover_x (sf_int, x, xb, x_free)
	class(sf_test_generator_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	call sf_int%base_recover_x (x, xb)
	if (present (x_free)) x_free = x_free * product (x)
	end subroutine sf_test_generator_recover_x

	@ %def sf_test_generator_recover_x
	@ Set kinematics. Since this is a generator, just transfer input to output.
	<<SF base: sf test generator: TBP>>=
	procedure :: complete_kinematics => sf_test_generator_complete_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(sf_test_generator_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	x = r
	xb= rb
	f = 1
	call sf_int%reduce_momenta (x)
	end subroutine sf_test_generator_complete_kinematics

	@ %def sf_test_generator_complete_kinematics
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF base: sf test generator: TBP>>=
	procedure :: inverse_kinematics => sf_test_generator_inverse_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(sf_test_generator_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	r = x
	rb= xb
	f = 1
	if (set_mom) call sf_int%reduce_momenta (x)
	end subroutine sf_test_generator_inverse_kinematics

	@ %def sf_test_generator_inverse_kinematics
	@ Apply the structure function. The matrix element becomes unity and
	the application always succeeds.
	<<SF base: sf test generator: TBP>>=
	procedure :: apply => sf_test_generator_apply
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(sf_test_generator_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	call sf_int%set_matrix_element &
	(cmplx (1._default, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine sf_test_generator_apply

	@ %def sf_test_generator_apply
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF base: execute tests>>=
	call test (sf_base_1, "sf_base_1", &
	"structure function configuration", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_1
	<<SF base: tests>>=
	subroutine sf_base_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_base_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	call model%init_test ()
	pdg_in = 25

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle code:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_base_1

	@ %def sf_base_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the test
	structure function.
	<<SF base: execute tests>>=
	call test (sf_base_2, "sf_base_2", &
	"structure function instance", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_2
	<<SF base: tests>>=
	subroutine sf_base_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_base_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_test ()
	pdg_in = 25
	call flv%init (25, model)

	call reset_interaction_counter ()

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=1"
	write (u, "(A)")

	r = 1
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics with mapping for r=0.8"
	write (u, "(A)")

	r = 0.8_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

	write (u, "(A)")
	write (u, "(A)") "* Compute inverse kinematics for x=0.64 and evaluate"
	write (u, "(A)")

	x = 0.64_default
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%apply (scale=0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "f =", f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_2

	@ %def sf_base_2
	@
	\subsubsection{Collinear kinematics}
	Scan over the possibilities for mass assignment and on-shell
	projections, collinear case.
	<<SF base: execute tests>>=
	call test (sf_base_3, "sf_base_3", &
	"alternatives for collinear kinematics", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_3
	<<SF base: tests>>=
	subroutine sf_base_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_base_3"
	write (u, "(A)") "* Purpose: check various kinematical setups"
	write (u, "(A)") "* for collinear structure-function splitting."
	write (u, "(A)") " (two masses equal, one zero)"
	write (u, "(A)")

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

	call model%init_test ()
	pdg_in = 25
	call flv%init (25, model)

	call reset_interaction_counter ()

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%write (u)

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"

	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set radiated mass to zero"

	sf_int%mr2 = 0
	sf_int%mo2 = sf_int%mi2

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set outgoing mass to zero"

	sf_int%mr2 = sf_int%mi2
	sf_int%mo2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set incoming mass to zero"

	k = vector4_moving (E, E, 3)
	call sf_int%seed_kinematics ([k])

	sf_int%mr2 = sf_int%mi2
	sf_int%mo2 = sf_int%mi2
	sf_int%mi2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set all masses to zero"

	sf_int%mr2 = 0
	sf_int%mo2 = 0
	sf_int%mi2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_3

	@ %def sf_base_3
	@
	\subsubsection{Non-collinear kinematics}
	Scan over the possibilities for mass assignment and on-shell
	projections, non-collinear case.
	<<SF base: execute tests>>=
	call test (sf_base_4, "sf_base_4", &
	"alternatives for non-collinear kinematics", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_4
	<<SF base: tests>>=
	subroutine sf_base_4 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_base_4"
	write (u, "(A)") "* Purpose: check various kinematical setups"
	write (u, "(A)") "* for free structure-function splitting."
	write (u, "(A)") " (two masses equal, one zero)"
	write (u, "(A)")

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

	call model%init_test ()
	pdg_in = 25
	call flv%init (25, model)

	call reset_interaction_counter ()

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in, collinear=.false.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%write (u)

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"

	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set radiated mass to zero"

	sf_int%mr2 = 0
	sf_int%mo2 = sf_int%mi2

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set outgoing mass to zero"

	sf_int%mr2 = sf_int%mi2
	sf_int%mo2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set incoming mass to zero"

	k = vector4_moving (E, E, 3)
	call sf_int%seed_kinematics ([k])

	sf_int%mr2 = sf_int%mi2
	sf_int%mo2 = sf_int%mi2
	sf_int%mi2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set all masses to zero"

	sf_int%mr2 = 0
	sf_int%mo2 = 0
	sf_int%mi2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Re-Initialize structure-function object with Q bounds"

	call reset_interaction_counter ()

	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in, collinear=.false., &
	qbounds = [1._default, 100._default])
	end select

	call sf_int%init (data)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_4

	@ %def sf_base_4
	@
	\subsubsection{Pair spectrum}
	Construct and display a structure function object for a pair spectrum
	(a structure function involving two particles simultaneously).
	<<SF base: execute tests>>=
	call test (sf_base_5, "sf_base_5", &
	"pair spectrum with radiation", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_5
	<<SF base: tests>>=
	subroutine sf_base_5 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(4) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_base_5"
	write (u, "(A)") "* Purpose: initialize and fill &
	&a pair spectrum object"
	write (u, "(A)")

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

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	allocate (sf_test_spectrum_data_t :: data)
	select type (data)
	type is (sf_test_spectrum_data_t)
	call data%init (model, pdg_in, with_radiation=.true.)
	end select

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

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

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momenta with sqrts=1000"

	E = 500
	k(1) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	k(2) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call sf_int%seed_kinematics (k)

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.4,0.8"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.4_default, 0.8_default]
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics with mapping for r=0.6,0.8"
	write (u, "(A)")

	r = [0.6_default, 0.8_default]
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call reset_interaction_counter ()
	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%seed_kinematics (k)
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

	write (u, "(A)")
	write (u, "(A)") "* Compute inverse kinematics for x=0.36,0.64 &
	&and evaluate"
	write (u, "(A)")

	x = [0.36_default, 0.64_default]
	xb = 1 - x
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%apply (scale=0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "f =", f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_5

	@ %def sf_base_5
	@
	\subsubsection{Pair spectrum without radiation}
	Construct and display a structure function object for a pair spectrum
	(a structure function involving two particles simultaneously).
	<<SF base: execute tests>>=
	call test (sf_base_6, "sf_base_6", &
	"pair spectrum without radiation", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_6
	<<SF base: tests>>=
	subroutine sf_base_6 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_base_6"
	write (u, "(A)") "* Purpose: initialize and fill &
	&a pair spectrum object"
	write (u, "(A)")

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

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	allocate (sf_test_spectrum_data_t :: data)
	select type (data)
	type is (sf_test_spectrum_data_t)
	call data%init (model, pdg_in, with_radiation=.false.)
	end select

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

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	write (u, "(A)") "* Initialize incoming momenta with sqrts=1000"

	E = 500
	k(1) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	k(2) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call sf_int%seed_kinematics (k)

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.4,0.8"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.4_default, 0.8_default]
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call reset_interaction_counter ()
	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%seed_kinematics (k)
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

	write (u, "(A)")
	write (u, "(A)") "* Compute inverse kinematics for x=0.4,0.8 &
	&and evaluate"
	write (u, "(A)")

	x = [0.4_default, 0.8_default]
	xb = 1 - x
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%apply (scale=0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "f =", f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_6

	@ %def sf_base_6
	@
	\subsubsection{Direct access to structure function}
	Probe a structure function directly.
	<<SF base: execute tests>>=
	call test (sf_base_7, "sf_base_7", &
	"direct access", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_7
	<<SF base: tests>>=
	subroutine sf_base_7 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	real(default), dimension(:), allocatable :: value

	write (u, "(A)") "* Test output: sf_base_7"
	write (u, "(A)") "* Purpose: check direct access method"
	write (u, "(A)")

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

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in)
	end select

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	write (u, "(A)") "* Probe structure function: states"
	write (u, "(A)")

	write (u, "(A,I0)") "n_states = ", sf_int%get_n_states ()
	write (u, "(A,I0)") "n_in = ", sf_int%get_n_in ()
	write (u, "(A,I0)") "n_rad = ", sf_int%get_n_rad ()
	write (u, "(A,I0)") "n_out = ", sf_int%get_n_out ()
	write (u, "(A)")
	write (u, "(A)", advance="no") "state(1) = "
	call quantum_numbers_write (sf_int%get_state (1), u)
	write (u, *)

	allocate (value (sf_int%get_n_states ()))
	call sf_int%compute_values (value, &
	E=[500._default], x=[0.5_default], xb=[0.5_default], scale=0._default)

	write (u, "(A)")
	write (u, "(A)", advance="no") "value (E=500, x=0.5) ="
	write (u, "(9(1x," // FMT_19 // "))") value

	call sf_int%compute_values (value, &
	x=[0.1_default], xb=[0.9_default], scale=0._default)

	write (u, "(A)")
	write (u, "(A)", advance="no") "value (E=500, x=0.1) ="
	write (u, "(9(1x," // FMT_19 // "))") value


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

	deallocate (value)
	call sf_int%final ()
	deallocate (sf_int)
	deallocate (data)

	allocate (sf_test_spectrum_data_t :: data)
	select type (data)
	type is (sf_test_spectrum_data_t)
	call data%init (model, pdg_in, with_radiation=.false.)
	end select

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	write (u, "(A)") "* Probe spectrum: states"
	write (u, "(A)")

	write (u, "(A,I0)") "n_states = ", sf_int%get_n_states ()
	write (u, "(A,I0)") "n_in = ", sf_int%get_n_in ()
	write (u, "(A,I0)") "n_rad = ", sf_int%get_n_rad ()
	write (u, "(A,I0)") "n_out = ", sf_int%get_n_out ()
	write (u, "(A)")
	write (u, "(A)", advance="no") "state(1) = "
	call quantum_numbers_write (sf_int%get_state (1), u)
	write (u, *)

	allocate (value (sf_int%get_n_states ()))
	call sf_int%compute_value (1, value(1), &
	E = [500._default, 500._default], &
	x = [0.5_default, 0.6_default], &
	xb= [0.5_default, 0.4_default], &
	scale = 0._default)

	write (u, "(A)")
	write (u, "(A)", advance="no") "value (E=500,500, x=0.5,0.6) ="
	write (u, "(9(1x," // FMT_19 // "))") value

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_7

	@ %def sf_base_7
	@
	\subsubsection{Structure function chain configuration}
	<<SF base: execute tests>>=
	call test (sf_base_8, "sf_base_8", &
	"structure function chain configuration", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_8
	<<SF base: tests>>=
	subroutine sf_base_8 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data_strfun
	class(sf_data_t), allocatable, target :: data_spectrum
	type(sf_config_t), dimension(:), allocatable :: sf_config
	type(sf_chain_t) :: sf_chain

	write (u, "(A)") "* Test output: sf_base_8"
	write (u, "(A)") "* Purpose: set up a structure-function chain"
	write (u, "(A)")

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

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data_strfun)
	select type (data_strfun)
	type is (sf_test_data_t)
	call data_strfun%init (model, pdg_in)
	end select

	allocate (sf_test_spectrum_data_t :: data_spectrum)
	select type (data_spectrum)
	type is (sf_test_spectrum_data_t)
	call data_spectrum%init (model, pdg_in, with_radiation=.true.)
	end select

	write (u, "(A)") "* Set up chain with beams only"
	write (u, "(A)")

	call sf_chain%init (beam_data)
	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)") "* Set up chain with structure function"
	write (u, "(A)")

	allocate (sf_config (1))
	call sf_config(1)%init ([1], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)") "* Set up chain with spectrum and structure function"
	write (u, "(A)")

	deallocate (sf_config)
	allocate (sf_config (2))
	call sf_config(1)%init ([1,2], data_spectrum)
	call sf_config(2)%init ([2], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain%final ()

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

	call model%final ()

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

	end subroutine sf_base_8

	@ %def sf_base_8
	@
	\subsubsection{Structure function instance configuration}
	We create a structure-function chain instance which implements a
	configured structure-function chain. We link the momentum entries in
	the interactions and compute kinematics.

	We do not actually connect the interactions and create evaluators. We
	skip this step and manually advance the status of the chain instead.
	<<SF base: execute tests>>=
	call test (sf_base_9, "sf_base_9", &
	"structure function chain instance", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_9
	<<SF base: tests>>=
	subroutine sf_base_9 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data_strfun
	class(sf_data_t), allocatable, target :: data_spectrum
	type(sf_config_t), dimension(:), allocatable, target :: sf_config
	type(sf_chain_t), target :: sf_chain
	type(sf_chain_instance_t), target :: sf_chain_instance
	type(sf_channel_t), dimension(2) :: sf_channel
	type(vector4_t), dimension(2) :: p
	integer :: j

	write (u, "(A)") "* Test output: sf_base_9"
	write (u, "(A)") "* Purpose: set up a structure-function chain &
	&and create an instance"
	write (u, "(A)") "* compute kinematics"
	write (u, "(A)")

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

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data_strfun)
	select type (data_strfun)
	type is (sf_test_data_t)
	call data_strfun%init (model, pdg_in)
	end select

	allocate (sf_test_spectrum_data_t :: data_spectrum)
	select type (data_spectrum)
	type is (sf_test_spectrum_data_t)
	call data_spectrum%init (model, pdg_in, with_radiation=.true.)
	end select

	write (u, "(A)") "* Set up chain with beams only"
	write (u, "(A)")

	call sf_chain%init (beam_data)

	call sf_chain_instance%init (sf_chain, n_channel = 1)

	call sf_chain_instance%link_interactions ()
	sf_chain_instance%status = SF_DONE_CONNECTIONS
	call sf_chain_instance%compute_kinematics (1, [real(default) ::])

	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call sf_chain_instance%get_out_momenta (p)

	write (u, "(A)")
	write (u, "(A)") "* Outgoing momenta:"

	do j = 1, 2
	write (u, "(A)")
	call vector4_write (p(j), u)
	end do

	call sf_chain_instance%final ()
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)") "* Set up chain with structure function"
	write (u, "(A)")

	allocate (sf_config (1))
	call sf_config(1)%init ([1], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)

	call sf_channel(1)%init (1)
	call sf_channel(1)%activate_mapping ([1])
	call sf_chain_instance%set_channel (1, sf_channel(1))

	call sf_chain_instance%link_interactions ()
	sf_chain_instance%status = SF_DONE_CONNECTIONS
	call sf_chain_instance%compute_kinematics (1, [0.8_default])

	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call sf_chain_instance%get_out_momenta (p)

	write (u, "(A)")
	write (u, "(A)") "* Outgoing momenta:"

	do j = 1, 2
	write (u, "(A)")
	call vector4_write (p(j), u)
	end do

	call sf_chain_instance%final ()
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)") "* Set up chain with spectrum and structure function"
	write (u, "(A)")

	deallocate (sf_config)
	allocate (sf_config (2))
	call sf_config(1)%init ([1,2], data_spectrum)
	call sf_config(2)%init ([2], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)

	call sf_channel(2)%init (2)
	call sf_channel(2)%activate_mapping ([2])
	call sf_chain_instance%set_channel (1, sf_channel(2))

	call sf_chain_instance%link_interactions ()
	sf_chain_instance%status = SF_DONE_CONNECTIONS
	call sf_chain_instance%compute_kinematics &
	(1, [0.5_default, 0.6_default, 0.8_default])

	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call sf_chain_instance%get_out_momenta (p)

	write (u, "(A)")
	write (u, "(A)") "* Outgoing momenta:"

	do j = 1, 2
	write (u, "(A)")
	call vector4_write (p(j), u)
	end do

	call sf_chain_instance%final ()
	call sf_chain%final ()

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

	call model%final ()

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

	end subroutine sf_base_9

	@ %def sf_base_9
	@
	\subsubsection{Structure function chain mappings}
	Set up a structure function chain instance with a pair of
	single-particle structure functions. We test different global
	mappings for this setup.

	Again, we skip evaluators.
	<<SF base: execute tests>>=
	call test (sf_base_10, "sf_base_10", &
	"structure function chain mapping", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_10
	<<SF base: tests>>=
	subroutine sf_base_10 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data_strfun
	type(sf_config_t), dimension(:), allocatable, target :: sf_config
	type(sf_chain_t), target :: sf_chain
	type(sf_chain_instance_t), target :: sf_chain_instance
	type(sf_channel_t), dimension(2) :: sf_channel
	real(default), dimension(2) :: x_saved

	write (u, "(A)") "* Test output: sf_base_10"
	write (u, "(A)") "* Purpose: set up a structure-function chain"
	write (u, "(A)") "* and check mappings"
	write (u, "(A)")

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

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data_strfun)
	select type (data_strfun)
	type is (sf_test_data_t)
	call data_strfun%init (model, pdg_in)
	end select

	write (u, "(A)") "* Set up chain with structure function pair &
	&and standard mapping"
	write (u, "(A)")

	allocate (sf_config (2))
	call sf_config(1)%init ([1], data_strfun)
	call sf_config(2)%init ([2], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)

	call sf_channel(1)%init (2)
	call sf_channel(1)%set_s_mapping ([1,2])
	call sf_chain_instance%set_channel (1, sf_channel(1))

	call sf_chain_instance%link_interactions ()
	sf_chain_instance%status = SF_DONE_CONNECTIONS
	call sf_chain_instance%compute_kinematics (1, [0.8_default, 0.6_default])

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Invert the kinematics calculation"
	write (u, "(A)")

	x_saved = sf_chain_instance%x

	call sf_chain_instance%init (sf_chain, n_channel = 1)

	call sf_channel(2)%init (2)
	call sf_channel(2)%set_s_mapping ([1, 2])
	call sf_chain_instance%set_channel (1, sf_channel(2))

	call sf_chain_instance%link_interactions ()
	sf_chain_instance%status = SF_DONE_CONNECTIONS
	call sf_chain_instance%inverse_kinematics (x_saved, 1 - x_saved)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)


	call sf_chain_instance%final ()
	call sf_chain%final ()

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

	call model%final ()

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

	end subroutine sf_base_10

	@ %def sf_base_10
	@
	\subsubsection{Structure function chain evaluation}
	Here, we test the complete workflow for structure-function chains.
	First, we create the template chain, then initialize an instance. We
	set up links, mask, and evaluators. Finally, we set kinematics and
	evaluate the matrix elements and their products.
	<<SF base: execute tests>>=
	call test (sf_base_11, "sf_base_11", &
	"structure function chain evaluation", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_11
	<<SF base: tests>>=
	subroutine sf_base_11 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data_strfun
	class(sf_data_t), allocatable, target :: data_spectrum
	type(sf_config_t), dimension(:), allocatable, target :: sf_config
	type(sf_chain_t), target :: sf_chain
	type(sf_chain_instance_t), target :: sf_chain_instance
	type(sf_channel_t), dimension(2) :: sf_channel
	type(particle_set_t) :: pset
	type(interaction_t), pointer :: int
	logical :: ok

	write (u, "(A)") "* Test output: sf_base_11"
	write (u, "(A)") "* Purpose: set up a structure-function chain"
	write (u, "(A)") "* create an instance and evaluate"
	write (u, "(A)")

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

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data_strfun)
	select type (data_strfun)
	type is (sf_test_data_t)
	call data_strfun%init (model, pdg_in)
	end select

	allocate (sf_test_spectrum_data_t :: data_spectrum)
	select type (data_spectrum)
	type is (sf_test_spectrum_data_t)
	call data_spectrum%init (model, pdg_in, with_radiation=.true.)
	end select

	write (u, "(A)") "* Set up chain with beams only"
	write (u, "(A)")

	call sf_chain%init (beam_data)

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	call sf_chain_instance%compute_kinematics (1, [real(default) ::])
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
	[0._default, 0._default], .false., .true.)
	call sf_chain_instance%final ()

	write (u, "(A)")
	write (u, "(A)") "* Particle content:"
	write (u, "(A)")

	call write_separator (u)
	call pset%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover chain:"
	write (u, "(A)")

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%fill_interaction (int, 2, check_match=.false.)

	call sf_chain_instance%recover_kinematics (1)
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call pset%final ()
	call sf_chain_instance%final ()
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)")
	write (u, "(A)")
	write (u, "(A)") "* Set up chain with structure function"
	write (u, "(A)")

	allocate (sf_config (1))
	call sf_config(1)%init ([1], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_channel(1)%init (1)
	call sf_channel(1)%activate_mapping ([1])
	call sf_chain_instance%set_channel (1, sf_channel(1))
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	call sf_chain_instance%compute_kinematics (1, [0.8_default])
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
	[0._default, 0._default], .false., .true.)
	call sf_chain_instance%final ()

	write (u, "(A)")
	write (u, "(A)") "* Particle content:"
	write (u, "(A)")

	call write_separator (u)
	call pset%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover chain:"
	write (u, "(A)")

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_channel(1)%init (1)
	call sf_channel(1)%activate_mapping ([1])
	call sf_chain_instance%set_channel (1, sf_channel(1))
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%fill_interaction (int, 2, check_match=.false.)

	call sf_chain_instance%recover_kinematics (1)
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call pset%final ()
	call sf_chain_instance%final ()
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)")
	write (u, "(A)")
	write (u, "(A)") "* Set up chain with spectrum and structure function"
	write (u, "(A)")

	deallocate (sf_config)
	allocate (sf_config (2))
	call sf_config(1)%init ([1,2], data_spectrum)
	call sf_config(2)%init ([2], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_channel(2)%init (2)
	call sf_channel(2)%activate_mapping ([2])
	call sf_chain_instance%set_channel (1, sf_channel(2))
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	call sf_chain_instance%compute_kinematics &
	(1, [0.5_default, 0.6_default, 0.8_default])
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
	[0._default, 0._default], .false., .true.)
	call sf_chain_instance%final ()

	write (u, "(A)")
	write (u, "(A)") "* Particle content:"
	write (u, "(A)")

	call write_separator (u)
	call pset%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover chain:"
	write (u, "(A)")

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_channel(2)%init (2)
	call sf_channel(2)%activate_mapping ([2])
	call sf_chain_instance%set_channel (1, sf_channel(2))
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%fill_interaction (int, 2, check_match=.false.)

	call sf_chain_instance%recover_kinematics (1)
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call pset%final ()
	call sf_chain_instance%final ()
	call sf_chain%final ()

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

	call model%final ()

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

	end subroutine sf_base_11

	@ %def sf_base_11
	@
	\subsubsection{Multichannel case}
	We set up a structure-function chain as before, but with three
	different parameterizations. The first instance is without mappings,
	the second one with single-particle mappings, and the third one with
	two-particle mappings.
	<<SF base: execute tests>>=
	call test (sf_base_12, "sf_base_12", &
	"multi-channel structure function chain", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_12
	<<SF base: tests>>=
	subroutine sf_base_12 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data
	type(sf_config_t), dimension(:), allocatable, target :: sf_config
	type(sf_chain_t), target :: sf_chain
	type(sf_chain_instance_t), target :: sf_chain_instance
	real(default), dimension(2) :: x_saved
	real(default), dimension(2,3) :: p_saved
	type(sf_channel_t), dimension(:), allocatable :: sf_channel

	write (u, "(A)") "* Test output: sf_base_12"
	write (u, "(A)") "* Purpose: set up and evaluate a multi-channel &
	&structure-function chain"
	write (u, "(A)")

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

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in)
	end select

	write (u, "(A)") "* Set up chain with structure function pair &
	&and three different mappings"
	write (u, "(A)")

	allocate (sf_config (2))
	call sf_config(1)%init ([1], data)
	call sf_config(2)%init ([2], data)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 3)

	call allocate_sf_channels (sf_channel, n_channel = 3, n_strfun = 2)

	! channel 1: no mapping
	call sf_chain_instance%set_channel (1, sf_channel(1))

	! channel 2: single-particle mappings
	call sf_channel(2)%activate_mapping ([1,2])
	! call sf_chain_instance%activate_mapping (2, [1,2])
	call sf_chain_instance%set_channel (2, sf_channel(2))

	! channel 3: two-particle mapping
	call sf_channel(3)%set_s_mapping ([1,2])
	! call sf_chain_instance%set_s_mapping (3, [1, 2])
	call sf_chain_instance%set_channel (3, sf_channel(3))

	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	write (u, "(A)") "* Compute kinematics in channel 1 and evaluate"
	write (u, "(A)")

	call sf_chain_instance%compute_kinematics (1, [0.8_default, 0.6_default])
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Invert the kinematics calculation"
	write (u, "(A)")

	x_saved = sf_chain_instance%x

	call sf_chain_instance%inverse_kinematics (x_saved, 1 - x_saved)
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Compute kinematics in channel 2 and evaluate"
	write (u, "(A)")

	p_saved = sf_chain_instance%p

	call sf_chain_instance%compute_kinematics (2, p_saved(:,2))
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Compute kinematics in channel 3 and evaluate"
	write (u, "(A)")

	call sf_chain_instance%compute_kinematics (3, p_saved(:,3))
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

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

	call sf_chain_instance%final ()
	call sf_chain%final ()

	call model%final ()

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

	end subroutine sf_base_12

	@ %def sf_base_12
	@
	\subsubsection{Generated spectrum}
	Construct and evaluate a structure function object for a pair spectrum
	which is evaluated as a beam-event generator.
	<<SF base: execute tests>>=
	call test (sf_base_13, "sf_base_13", &
	"pair spectrum generator", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_13
	<<SF base: tests>>=
	subroutine sf_base_13 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, x_free

	write (u, "(A)") "* Test output: sf_base_13"
	write (u, "(A)") "* Purpose: initialize and fill &
	&a pair generator object"
	write (u, "(A)")

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

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	allocate (sf_test_generator_data_t :: data)
	select type (data)
	type is (sf_test_generator_data_t)
	call data%init (model, pdg_in)
	end select

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

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	write (u, "(A)") "* Generate free r values"
	write (u, "(A)")

	x_free = 1
	call sf_int%generate_free (r, rb, x_free)

	write (u, "(A)") "* Initialize incoming momenta with sqrts=1000"

	E = 500
	k(1) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	k(2) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call sf_int%seed_kinematics (k)

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

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call reset_interaction_counter ()
	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%seed_kinematics (k)
	call sf_int%set_momenta (q, outgoing=.true.)
	x_free = 1
	call sf_int%recover_x (x, xb, x_free)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

	write (u, "(A)")
	write (u, "(A)") "* Compute inverse kinematics &
	&and evaluate"
	write (u, "(A)")

	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%apply (scale=0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "f =", f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_13

	@ %def sf_base_13
	@
	\subsubsection{Structure function chain evaluation}
	Here, we test the complete workflow for a structure-function chain
	with generator. First, we create the template chain, then initialize
	an instance. We set up links, mask, and evaluators. Finally, we set
	kinematics and evaluate the matrix elements and their products.
	<<SF base: execute tests>>=
	call test (sf_base_14, "sf_base_14", &
	"structure function generator evaluation", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_14
	<<SF base: tests>>=
	subroutine sf_base_14 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data_strfun
	class(sf_data_t), allocatable, target :: data_generator
	type(sf_config_t), dimension(:), allocatable, target :: sf_config
	real(default), dimension(:), allocatable :: p_in
	type(sf_chain_t), target :: sf_chain
	type(sf_chain_instance_t), target :: sf_chain_instance

	write (u, "(A)") "* Test output: sf_base_14"
	write (u, "(A)") "* Purpose: set up a structure-function chain"
	write (u, "(A)") "* create an instance and evaluate"
	write (u, "(A)")

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

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data_strfun)
	select type (data_strfun)
	type is (sf_test_data_t)
	call data_strfun%init (model, pdg_in)
	end select

	allocate (sf_test_generator_data_t :: data_generator)
	select type (data_generator)
	type is (sf_test_generator_data_t)
	call data_generator%init (model, pdg_in)
	end select

	write (u, "(A)") "* Set up chain with generator and structure function"
	write (u, "(A)")

	allocate (sf_config (2))
	call sf_config(1)%init ([1,2], data_generator)
	call sf_config(2)%init ([2], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	write (u, "(A)") "* Inject integration parameter"
	write (u, "(A)")

	allocate (p_in (sf_chain%get_n_bound ()), source = 0.9_default)
	write (u, "(A,9(1x,F10.7))") "p_in =", p_in

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

	call sf_chain_instance%compute_kinematics (1, p_in)
	call sf_chain_instance%evaluate (scale=0._default)

	call sf_chain_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Extract integration parameter"
	write (u, "(A)")

	call sf_chain_instance%get_mcpar (1, p_in)
	write (u, "(A,9(1x,F10.7))") "p_in =", p_in

	call sf_chain_instance%final ()
	call sf_chain%final ()

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

	call model%final ()

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

	end subroutine sf_base_14

	@ %def sf_base_14
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Photon radiation: ISR}

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

	module sf_isr

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use constants, only: pi
	use format_defs, only: FMT_15, FMT_19
	use numeric_utils
	use diagnostics
	use physics_defs, only: PHOTON
	use lorentz
	use sm_physics, only: Li2
	use pdg_arrays
	use model_data
	use flavors
	use colors
	use quantum_numbers
	use polarizations
	use sf_aux
	use sf_mappings
	use sf_base
	use electron_pdfs

	<<Standard module head>>

	<<SF isr: public>>

	<<SF isr: parameters>>

	<<SF isr: types>>

	contains

	<<SF isr: procedures>>

	end module sf_isr
	@ %def sf_isr
	@
	\subsection{Physics}
	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.

	In $f_0(x)$, there is an integrable singularity at $x=1$ which does
	not spoil the integration, but would lead to an unbounded $f_{\rm
	max}$. Therefore, we map this singularity like
	\begin{equation}\label{ISR-mapping}
	x = 1 - (1-x')^{1/\epsilon}
	\end{equation}
	such that
	\begin{equation}
	\int dx\,f_0(x) = \int dx'
	\end{equation}

	For the detailed form of the QED ISR structure function
	cf. Chap.~\ref{chap:qed_pdf}.

	\subsection{Implementation}

	In the concrete implementation, the zeroth order mapping
	(\ref{ISR-mapping}) is implemented, and the Jacobian is equal to
	$f_i(x)/f_0(x)$. This can be written as
	\begin{align}
	\frac{f_0(x)}{f_0(x)} &= 1 \\
	\frac{f_1(x)}{f_0(x)} &= 1 + \frac34\epsilon - \frac{1-x^2}{2(1-x')} \\
	\begin{split}\label{ISR-f2}
	\frac{f_2(x)}{f_0(x)} &= 1 + \frac34\epsilon
	+ \frac{27 - 8\pi^2}{96}\epsilon^2
	- \frac{1-x^2}{2(1-x')} \\
	&\quad - \frac{(1+3x^2)\ln x
	+ (1-x)\left(4(1+x)\ln(1-x) + 5 + x\right)}{8(1-x')}\epsilon
	\end{split}
	\end{align}
	%'
	For $x=1$ (i.e., numerically indistinguishable from $1$), this reduces to
	\begin{align}
	\frac{f_0(x)}{f_0(x)} &= 1 \\
	\frac{f_1(x)}{f_0(x)} &= 1 + \frac34\epsilon \\
	\frac{f_2(x)}{f_0(x)} &= 1 + \frac34\epsilon
	+ \frac{27 - 8\pi^2}{96}\epsilon^2
	\end{align}
	The last line in (\ref{ISR-f2}) is zero for
	\begin{equation}
	x_{\rm min} = 0.00714053329734592839549879772019
	\end{equation}
	(Mathematica result), independent of $\epsilon$. For $x$ values less
	than this we ignore this correction because of the logarithmic
	singularity which should in principle be resummed.


	\subsection{The ISR data block}
	<<SF isr: public>>=
	public :: isr_data_t
	<<SF isr: types>>=
	type, extends (sf_data_t) :: isr_data_t
	private
	class(model_data_t), pointer :: model => null ()
	type(flavor_t), dimension(:), allocatable :: flv_in
	type(qed_pdf_t) :: pdf
	real(default) :: alpha = 0
	real(default) :: q_max = 0
	real(default) :: real_mass = 0
	real(default) :: mass = 0
	real(default) :: eps = 0
	real(default) :: log = 0
	logical :: recoil = .false.
	logical :: keep_energy = .true.
	integer :: order = 3
	integer :: error = NONE
	contains
	<<SF isr: isr data: TBP>>
	end type isr_data_t

	@ %def isr_data_t
	@ Error codes
	<<SF isr: parameters>>=
	integer, parameter :: NONE = 0
	integer, parameter :: ZERO_MASS = 1
	integer, parameter :: Q_MAX_TOO_SMALL = 2
	integer, parameter :: EPS_TOO_LARGE = 3
	integer, parameter :: INVALID_ORDER = 4
	integer, parameter :: CHARGE_MIX = 5
	integer, parameter :: CHARGE_ZERO = 6
	integer, parameter :: MASS_MIX = 7
	@ Generate flavor-dependent ISR data:
	<<SF isr: isr data: TBP>>=
	procedure :: init => isr_data_init
	<<SF isr: procedures>>=
	subroutine isr_data_init (data, model, pdg_in, alpha, q_max, &
	mass, order, recoil, keep_energy)
	class(isr_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	real(default), intent(in) :: alpha
	real(default), intent(in) :: q_max
	real(default), intent(in), optional :: mass
	integer, intent(in), optional :: order
	logical, intent(in), optional :: recoil
	logical, intent(in), optional :: keep_energy
	integer :: i, n_flv
	real(default) :: charge
	data%model => model
	n_flv = pdg_array_get_length (pdg_in)
	allocate (data%flv_in (n_flv))
	do i = 1, n_flv
	call data%flv_in(i)%init (pdg_array_get (pdg_in, i), model)
	end do
	data%alpha = alpha
	data%q_max = q_max
	if (present (order)) then
	call data%set_order (order)
	end if
	if (present (recoil)) then
	data%recoil = recoil
	end if
	if (present (keep_energy)) then
	data%keep_energy = keep_energy
	end if
	data%real_mass = data%flv_in(1)%get_mass ()
	if (present (mass)) then
	if (mass > 0) then
	data%mass = mass
	else
	data%mass = data%real_mass
	if (any (data%flv_in%get_mass () /= data%mass)) then
	data%error = MASS_MIX; return
	end if
	end if
	else
	data%mass = data%real_mass
	if (any (data%flv_in%get_mass () /= data%mass)) then
	data%error = MASS_MIX; return
	end if
	end if
	if (vanishes (data%mass)) then
	data%error = ZERO_MASS; return
	else if (data%mass >= data%q_max) then
	data%error = Q_MAX_TOO_SMALL; return
	end if
	data%log = log (1 + (data%q_max / data%mass)**2)
	charge = data%flv_in(1)%get_charge ()
	if (any (abs (data%flv_in%get_charge ()) /= abs (charge))) then
	data%error = CHARGE_MIX; return
	else if (charge == 0) then
	data%error = CHARGE_ZERO; return
	end if
	data%eps = data%alpha / pi * charge ** 2 &
	* (2 * log (data%q_max / data%mass) - 1)
	if (data%eps > 1) then
	data%error = EPS_TOO_LARGE; return
	end if
	call data%pdf%init &
	(data%mass, data%alpha, charge, data%q_max, data%order)
	end subroutine isr_data_init

	@ %def isr_data_init
	@ Explicitly set ISR order
	<<SF isr: isr data: TBP>>=
	procedure :: set_order => isr_data_set_order
	<<SF isr: procedures>>=
	elemental subroutine isr_data_set_order (data, order)
	class(isr_data_t), intent(inout) :: data
	integer, intent(in) :: order
	if (order < 0 .or. order > 3) then
	data%error = INVALID_ORDER
	else
	data%order = order
	end if
	end subroutine isr_data_set_order

	@ %def isr_data_set_order
	@ Handle error conditions. Should always be done after
	initialization, unless we are sure everything is ok.
	<<SF isr: isr data: TBP>>=
	procedure :: check => isr_data_check
	<<SF isr: procedures>>=
	subroutine isr_data_check (data)
	class(isr_data_t), intent(in) :: data
	select case (data%error)
	case (ZERO_MASS)
	call msg_fatal ("ISR: Particle mass is zero")
	case (Q_MAX_TOO_SMALL)
	call msg_fatal ("ISR: Particle mass exceeds Qmax")
	case (EPS_TOO_LARGE)
	call msg_fatal ("ISR: Expansion parameter too large, " // &
	"perturbative expansion breaks down")
	case (INVALID_ORDER)
	call msg_error ("ISR: LLA order invalid (valid values are 0,1,2,3)")
	case (MASS_MIX)
	call msg_fatal ("ISR: Incoming particle masses must be uniform")
	case (CHARGE_MIX)
	call msg_fatal ("ISR: Incoming particle charges must be uniform")
	case (CHARGE_ZERO)
	call msg_fatal ("ISR: Incoming particle must be charged")
	end select
	end subroutine isr_data_check

	@ %def isr_data_check
	@ Output
	<<SF isr: isr data: TBP>>=
	procedure :: write => isr_data_write
	<<SF isr: procedures>>=
	subroutine isr_data_write (data, unit, verbose)
	class(isr_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "ISR data:"
	if (allocated (data%flv_in)) then
	write (u, "(3x,A)", advance="no") " flavor = "
	do i = 1, size (data%flv_in)
	if (i > 1) write (u, "(',',1x)", advance="no")
	call data%flv_in(i)%write (u)
	end do
	write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") " alpha = ", data%alpha
	write (u, "(3x,A," // FMT_19 // ")") " q_max = ", data%q_max
	write (u, "(3x,A," // FMT_19 // ")") " mass = ", data%mass
	write (u, "(3x,A," // FMT_19 // ")") " eps = ", data%eps
	write (u, "(3x,A," // FMT_19 // ")") " log = ", data%log
	write (u, "(3x,A,I2)") " order = ", data%order
	write (u, "(3x,A,L2)") " recoil = ", data%recoil
	write (u, "(3x,A,L2)") " keep en. = ", data%keep_energy
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine isr_data_write

	@ %def isr_data_write
	@ For ISR, there is the option to generate transverse momentum is
	generated. Hence, there can be up to three parameters, $x$, and two
	angles.
	<<SF isr: isr data: TBP>>=
	procedure :: get_n_par => isr_data_get_n_par
	<<SF isr: procedures>>=
	function isr_data_get_n_par (data) result (n)
	class(isr_data_t), intent(in) :: data
	integer :: n
	if (data%recoil) then
	n = 3
	else
	n = 1
	end if
	end function isr_data_get_n_par

	@ %def isr_data_get_n_par
	@ Return the outgoing particles PDG codes. For ISR, these are
	identical to the incoming particles.
	<<SF isr: isr data: TBP>>=
	procedure :: get_pdg_out => isr_data_get_pdg_out
	<<SF isr: procedures>>=
	subroutine isr_data_get_pdg_out (data, pdg_out)
	class(isr_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	pdg_out(1) = data%flv_in%get_pdg ()
	end subroutine isr_data_get_pdg_out

	@ %def isr_data_get_pdg_out
	@ Return the [[eps]] value. We need it for an appropriate mapping of
	structure-function parameters.
	<<SF isr: isr data: TBP>>=
	procedure :: get_eps => isr_data_get_eps
	<<SF isr: procedures>>=
	function isr_data_get_eps (data) result (eps)
	class(isr_data_t), intent(in) :: data
	real(default) :: eps
	eps = data%eps
	end function isr_data_get_eps

	@ %def isr_data_get_eps
	@ Allocate the interaction record.
	<<SF isr: isr data: TBP>>=
	procedure :: allocate_sf_int => isr_data_allocate_sf_int
	<<SF isr: procedures>>=
	subroutine isr_data_allocate_sf_int (data, sf_int)
	class(isr_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (isr_t :: sf_int)
	end subroutine isr_data_allocate_sf_int

	@ %def isr_data_allocate_sf_int
	@
	\subsection{The ISR object}
	The [[isr_t]] data type is a $1\to 2$ interaction, i.e., we allow for
	single-photon emission only (but use the multi-photon resummed
	radiator function). The particles are ordered as (incoming, photon,
	outgoing).

	There is no need to handle several flavors (and data blocks) in
	parallel, since ISR is always applied immediately after beam
	collision. (ISR for partons is accounted for by the PDFs themselves.)
	Polarization is carried through, i.e., we retain the polarization of
	the incoming particle and treat the emitted photon as unpolarized.
	Color is trivially carried through. This implies that particles 1 and
	3 should be locked together. For ISR we don't need the q variable.
	<<SF isr: public>>=
	public :: isr_t
	<<SF isr: types>>=
	type, extends (sf_int_t) :: isr_t
	private
	type(isr_data_t), pointer :: data => null ()
	real(default) :: x = 0
	real(default) :: xb= 0
	contains
	<<SF isr: isr: TBP>>
	end type isr_t

	@ %def isr_t
	@ Type string: has to be here, but there is no string variable on which ISR
	depends. Hence, a dummy routine.
	<<SF isr: isr: TBP>>=
	procedure :: type_string => isr_type_string
	<<SF isr: procedures>>=
	function isr_type_string (object) result (string)
	class(isr_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "ISR: e+ e- ISR spectrum"
	else
	string = "ISR: [undefined]"
	end if
	end function isr_type_string

	@ %def isr_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF isr: isr: TBP>>=
	procedure :: write => isr_write
	<<SF isr: procedures>>=
	subroutine isr_write (object, unit, testflag)
	class(isr_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(1x,A)") "SF parameters:"
	write (u, "(3x,A," // FMT_15 // ")") "x =", object%x
	write (u, "(3x,A," // FMT_15 // ")") "xb=", object%xb
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "ISR data: [undefined]"
	end if
	end subroutine isr_write

	@ %def isr_write
	@ Explicitly set ISR order (for unit test).
	<<SF isr: isr: TBP>>=
	procedure :: set_order => isr_set_order
	<<SF isr: procedures>>=
	subroutine isr_set_order (object, order)
	class(isr_t), intent(inout) :: object
	integer, intent(in) :: order
	call object%data%set_order (order)
	call object%data%pdf%set_order (order)
	end subroutine isr_set_order

	@ %def isr_set_order
	@
	\subsection{Kinematics}
	Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ were trivial. The ISR structure
	function allows for a straightforward mapping of the unit interval.
	So, to leading order, the structure function value is unity, but the
	$x$ value is transformed. Higher orders affect the function value.

	The structure function implementation applies the above mapping to the
	input (random) number [[r]] to generate the momentum fraction [[x]]
	and the function value [[f]]. For numerical stability reasons, we
	also output [[xb]], which is $\bar x=1-x$.

	For the ISR structure function, the mapping Jacobian cancels the
	structure function (to order zero). We apply the cancellation
	explicitly, therefore both the Jacobian [[f]] and the zeroth-order value
	(see the [[apply]] method) are unity if mapping is turned on. If
	mapping is turned off, the Jacobian [[f]] includes the value of the
	(zeroth-order) structure function, and strongly peaked.
	<<SF isr: isr: TBP>>=
	procedure :: complete_kinematics => isr_complete_kinematics
	<<SF isr: procedures>>=
	subroutine isr_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(isr_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	real(default) :: eps
	eps = sf_int%data%eps
	if (map) then
	call map_power_1 (sf_int%xb, f, rb(1), eps)
	else
	sf_int%xb = rb(1)
	if (rb(1) > 0) then
	f = 1
	else
	f = 0
	end if
	end if
	sf_int%x = 1 - sf_int%xb
	x(1) = sf_int%x
	xb(1) = sf_int%xb
	if (size (x) == 3) then
	x(2:3) = r(2:3)
	xb(2:3) = rb(2:3)
	end if
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS)
	sf_int%x = 0
	sf_int%xb= 0
	f = 0
	end select
	end subroutine isr_complete_kinematics

	@ %def isr_complete_kinematics
	@ Overriding the default method: we compute the [[x]] array from the
	momentum configuration. In the specific case of ISR, we also set the
	internally stored $x$ and $\bar x$ values, so they can be used in the
	following routine.
	<<SF isr: isr: TBP>>=
	procedure :: recover_x => sf_isr_recover_x
	<<SF isr: procedures>>=
	subroutine sf_isr_recover_x (sf_int, x, xb, x_free)
	class(isr_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	call sf_int%base_recover_x (x, xb, x_free)
	sf_int%x = x(1)
	sf_int%xb = xb(1)
	end subroutine sf_isr_recover_x

	@ %def sf_isr_recover_x
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.

	For extracting $x$, we rely on the stored $\bar x$ value, since the
	$x$ value in the argument is likely imprecise. This means that either
	[[complete_kinematics]] or [[recover_x]] must be called first, for the
	current sampling point (but maybe another channel).
	<<SF isr: isr: TBP>>=
	procedure :: inverse_kinematics => isr_inverse_kinematics
	<<SF isr: procedures>>=
	subroutine isr_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	class(isr_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	real(default) :: eps
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	eps = sf_int%data%eps
	if (map) then
	call map_power_inverse_1 (xb(1), f, rb(1), eps)
	else
	rb(1) = xb(1)
	if (rb(1) > 0) then
	f = 1
	else
	f = 0
	end if
	end if
	r(1) = 1 - rb(1)
	if (size(r) == 3) then
	r(2:3) = x(2:3)
	rb(2:3)= xb(2:3)
	end if
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS)
	r = 0
	rb= 0
	f = 0
	end select
	end if
	end subroutine isr_inverse_kinematics

	@ %def isr_inverse_kinematics
	@
	<<SF isr: isr: TBP>>=
	procedure :: init => isr_init
	<<SF isr: procedures>>=
	subroutine isr_init (sf_int, data)
	class(isr_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	integer, dimension(3) :: hel_lock
	type(polarization_t), target :: pol
	type(quantum_numbers_t), dimension(1) :: qn_fc
	type(flavor_t) :: flv_photon
	type(color_t) :: col_photon
	type(quantum_numbers_t) :: qn_hel, qn_photon, qn
	type(polarization_iterator_t) :: it_hel
	real(default) :: m2
	integer :: i
	mask = quantum_numbers_mask (.false., .false., &
	mask_h = [.false., .true., .false.])
	hel_lock = [3, 0, 1]
	select type (data)
	type is (isr_data_t)
	m2 = data%mass**2
	call sf_int%base_init (mask, [m2], [0._default], [m2], &
	hel_lock = hel_lock)
	sf_int%data => data
	call flv_photon%init (PHOTON, data%model)
	call col_photon%init ()
	call qn_photon%init (flv_photon, col_photon)
	call qn_photon%tag_radiated ()
	do i = 1, size (data%flv_in)
	call pol%init_generic (data%flv_in(i))
	call qn_fc(1)%init (&
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i), 1))
	call it_hel%init (pol)
	do while (it_hel%is_valid ())
	qn_hel = it_hel%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc(1)
	call sf_int%add_state ([qn, qn_photon, qn])
	call it_hel%advance ()
	end do
	! call pol%final () !!! Obsolete
	end do
	call sf_int%freeze ()
	if (data%keep_energy) then
	sf_int%on_shell_mode = KEEP_ENERGY
	else
	sf_int%on_shell_mode = KEEP_MOMENTUM
	end if
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	sf_int%status = SF_INITIAL
	end select
	end subroutine isr_init

	@ %def isr_init
	@
	\subsection{ISR application}
	For ISR, we could in principle compute kinematics and function value
	in a single step. In order to be able to reweight matrix elements
	including structure functions we split kinematics and structure
	function calculation. The structure function works on a single beam,
	assuming that the input momentum has been set.

	For the structure-function evaluation, we rely on the fact that the
	power mapping, which we apply in the kinematics method (if the [[map]]
	flag is set), has a Jacobian which is just the inverse lowest-order
	structure function. With mapping active, the two should cancel
	exactly.

	After splitting momenta, we set the outgoing momenta on-shell. We
	choose to conserve momentum, so energy conservation may be violated.
	<<SF isr: isr: TBP>>=
	procedure :: apply => isr_apply
	<<SF isr: procedures>>=
	subroutine isr_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(isr_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	real(default) :: f, finv, x, xb, eps, rb
	real(default) :: log_x, log_xb, x_2
	associate (data => sf_int%data)
	eps = sf_int%data%eps
	x = sf_int%x
	xb = sf_int%xb
	call map_power_inverse_1 (xb, finv, rb, eps)
	if (finv > 0) then
	f = 1 / finv
	else
	f = 0
	end if
	call data%pdf%evolve_qed_pdf (x, xb, rb, f)
	end associate
	call sf_int%set_matrix_element (cmplx (f, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine isr_apply

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

	module sf_isr_ut
	use unit_tests
	use sf_isr_uti

	<<Standard module head>>

	<<SF isr: public test>>

	contains

	<<SF isr: test driver>>

	end module sf_isr_ut
	@ %def sf_isr_ut
	@
	<<[[sf_isr_uti.f90]]>>=
	<<File header>>

	module sf_isr_uti

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_12
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use interactions, only: interaction_pacify_momenta
	use model_data
	use sf_aux, only: KEEP_ENERGY
	use sf_mappings
	use sf_base

	use sf_isr

	<<Standard module head>>

	<<SF isr: test declarations>>

	contains

	<<SF isr: tests>>

	end module sf_isr_uti
	@ %def sf_isr_ut
	@ API: driver for the unit tests below.
	<<SF isr: public test>>=
	public :: sf_isr_test
	<<SF isr: test driver>>=
	subroutine sf_isr_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF isr: execute tests>>
	end subroutine sf_isr_test

	@ %def sf_isr_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF isr: execute tests>>=
	call test (sf_isr_1, "sf_isr_1", &
	"structure function configuration", &
	u, results)
	<<SF isr: test declarations>>=
	public :: sf_isr_1
	<<SF isr: tests>>=
	subroutine sf_isr_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_isr_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in = ELECTRON

	allocate (isr_data_t :: data)
	call data%write (u)

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

	select type (data)
	type is (isr_data_t)
	call data%init (model, pdg_in, 1./137._default, 10._default, &
	0.000511_default, order = 3, recoil = .false.)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_isr_1

	@ %def sf_isr_1
	@
	\subsubsection{Structure function without mapping}
	Direct ISR evaluation. This is the use case for a double-beam
	structure function. The parameter pair is mapped in the calling program.
	<<SF isr: execute tests>>=
	call test (sf_isr_2, "sf_isr_2", &
	"no ISR mapping", &
	u, results)
	<<SF isr: test declarations>>=
	public :: sf_isr_2
	<<SF isr: tests>>=
	subroutine sf_isr_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, f_isr

	write (u, "(A)") "* Test output: sf_isr_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_qed_test ()
	pdg_in = ELECTRON
	call flv%init (ELECTRON, model)

	call reset_interaction_counter ()

	allocate (isr_data_t :: data)
	select type (data)
	type is (isr_data_t)
	call data%init (model, pdg_in, 1./137._default, 500._default, &
	0.000511_default, order = 3, recoil = .false.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.9, no ISR mapping, &
	&collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.9_default
	rb = 1 - r
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A)")
	write (u, "(A,9(1x," // FMT_12 // "))") "x =", x
	write (u, "(A,9(1x," // FMT_12 // "))") "xb=", xb
	write (u, "(A,9(1x," // FMT_12 // "))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Invert kinematics"
	write (u, "(A)")

	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
	write (u, "(A,9(1x," // FMT_12 // "))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate ISR structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Structure-function value, default order"
	write (u, "(A)")

	f_isr = sf_int%get_matrix_element (1)

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f

	write (u, "(A)")
	write (u, "(A)") "* Re-evaluate structure function, leading order"
	write (u, "(A)")

	select type (sf_int)
	type is (isr_t)
	call sf_int%set_order (0)
	end select
	call sf_int%apply (scale = 100._default)
	f_isr = sf_int%get_matrix_element (1)

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_isr_2

	@ %def sf_isr_2
	@
	\subsubsection{Structure function with mapping}
	Apply the optimal ISR mapping. This is the use case for a single-beam
	structure function.
	<<SF isr: execute tests>>=
	call test (sf_isr_3, "sf_isr_3", &
	"ISR mapping", &
	u, results)
	<<SF isr: test declarations>>=
	public :: sf_isr_3
	<<SF isr: tests>>=
	subroutine sf_isr_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, f_isr

	write (u, "(A)") "* Test output: sf_isr_3"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	allocate (isr_data_t :: data)
	select type (data)
	type is (isr_data_t)
	call data%init (model, pdg_in, 1./137._default, 500._default, &
	0.000511_default, order = 3, recoil = .false.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.7, with ISR mapping, &
	&collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.7_default
	rb = 1 - r
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)

	write (u, "(A)")
	write (u, "(A,9(1x," // FMT_12 // "))") "x =", x
	write (u, "(A,9(1x," // FMT_12 // "))") "xb=", xb
	write (u, "(A,9(1x," // FMT_12 // "))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Invert kinematics"
	write (u, "(A)")

	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
	write (u, "(A,9(1x," // FMT_12 // "))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate ISR structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Structure-function value, default order"
	write (u, "(A)")

	f_isr = sf_int%get_matrix_element (1)

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f

	write (u, "(A)")
	write (u, "(A)") "* Re-evaluate structure function, leading order"
	write (u, "(A)")

	select type (sf_int)
	type is (isr_t)
	call sf_int%set_order (0)
	end select
	call sf_int%apply (scale = 100._default)
	f_isr = sf_int%get_matrix_element (1)

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_isr_3

	@ %def sf_isr_3
	@
	\subsubsection{Non-collinear ISR splitting}
	Construct and display a structure function object based on the ISR
	structure function. We blank out numerical fluctuations for 32bit.
	<<SF isr: execute tests>>=
	call test (sf_isr_4, "sf_isr_4", &
	"ISR non-collinear", &
	u, results)
	<<SF isr: test declarations>>=
	public :: sf_isr_4
	<<SF isr: tests>>=
	subroutine sf_isr_4 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, f_isr
	character(len=80) :: buffer
	integer :: u_scratch, iostat

	write (u, "(A)") "* Test output: sf_isr_4"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	write (u, "(A)")
	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	allocate (isr_data_t :: data)
	select type (data)
	type is (isr_data_t)
	call data%init (model, pdg_in, 1./137._default, 500._default, &
	0.000511_default, order = 3, recoil = .true.)
	end select

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.25, with ISR mapping, "
	write (u, "(A)") " non-coll., keeping energy"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.5_default, 0.5_default, 0.25_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r

	write (u, "(A)")
	write (u, "(A)") "* Evaluate ISR structure function"
	write (u, "(A)")

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)
	call sf_int%apply (scale = 10._default)
	u_scratch = free_unit ()
	open (u_scratch, status="scratch", action = "readwrite")
	call sf_int%write (u_scratch, testflag = .true.)
	rewind (u_scratch)
	do
	read (u_scratch, "(A)", iostat=iostat) buffer
	if (iostat /= 0) exit
	if (buffer(1:25) == " P = 0.000000E+00 9.57") then
	buffer = replace (buffer, 26, "XXXX")
	end if
	if (buffer(1:25) == " P = 0.000000E+00 -9.57") then
	buffer = replace (buffer, 26, "XXXX")
	end if
	write (u, "(A)") buffer
	end do
	close (u_scratch)

	write (u, "(A)")
	write (u, "(A)") "* Structure-function value"
	write (u, "(A)")

	f_isr = sf_int%get_matrix_element (1)

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_isr_4

	@ %def sf_isr_4
	@
	\subsubsection{Structure function pair with mapping}
	Apply the ISR mapping for a ISR pair.
	structure function.
	<<SF isr: execute tests>>=
	call test (sf_isr_5, "sf_isr_5", &
	"ISR pair mapping", &
	u, results)
	<<SF isr: test declarations>>=
	public :: sf_isr_5
	<<SF isr: tests>>=
	subroutine sf_isr_5 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_mapping_t), allocatable :: mapping
	class(sf_int_t), dimension(:), allocatable :: sf_int
	type(vector4_t), dimension(2) :: k
	real(default) :: E, f_map
	real(default), dimension(:), allocatable :: p, pb, r, rb, x, xb
	real(default), dimension(2) :: f, f_isr
	integer :: i

	write (u, "(A)") "* Test output: sf_isr_5"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	allocate (isr_data_t :: data)
	select type (data)
	type is (isr_data_t)
	call data%init (model, pdg_in, 1./137._default, 500._default, &
	0.000511_default, order = 3, recoil = .false.)
	end select

	allocate (sf_ip_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ip_mapping_t)
	select type (data)
	type is (isr_data_t)
	call mapping%init (eps = data%get_eps ())
	end select
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	allocate (isr_t :: sf_int (2))

	do i = 1, 2
	call sf_int(i)%init (data)
	call sf_int(i)%set_beam_index ([i])
	end do

	write (u, "(A)") "* Initialize incoming momenta with E=500"
	write (u, "(A)")
	E = 500
	k(1) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	k(2) = vector4_moving (E, - sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	do i = 1, 2
	call vector4_write (k(i), u)
	call sf_int(i)%seed_kinematics (k(i:i))
	end do

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for p=[0.7,0.4], collinear"
	write (u, "(A)")

	allocate (p (2 * data%get_n_par ()))
	allocate (pb(size (p)))
	allocate (r (size (p)))
	allocate (rb(size (p)))
	allocate (x (size (p)))
	allocate (xb(size (p)))

	p = [0.7_default, 0.4_default]
	pb= 1 - p
	call mapping%compute (r, rb, f_map, p, pb)

	write (u, "(A,9(1x," // FMT_12 // "))") "p =", p
	write (u, "(A,9(1x," // FMT_12 // "))") "pb=", pb
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
	write (u, "(A,9(1x," // FMT_12 // "))") "fm=", f_map

	do i = 1, 2
	call sf_int(i)%complete_kinematics (x(i:i), xb(i:i), f(i), r(i:i), rb(i:i), &
	map=.false.)
	end do

	write (u, "(A)")
	write (u, "(A,9(1x," // FMT_12 // "))") "x =", x
	write (u, "(A,9(1x," // FMT_12 // "))") "xb=", xb
	write (u, "(A,9(1x," // FMT_12 // "))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Invert kinematics"
	write (u, "(A)")

	do i = 1, 2
	call sf_int(i)%inverse_kinematics (x(i:i), xb(i:i), f(i), r(i:i), rb(i:i), &
	map=.false.)
	end do
	call mapping%inverse (r, rb, f_map, p, pb)

	write (u, "(A,9(1x," // FMT_12 // "))") "p =", p
	write (u, "(A,9(1x," // FMT_12 // "))") "pb=", pb
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
	write (u, "(A,9(1x," // FMT_12 // "))") "fm=", f_map

	write (u, "(A)")
	write (u, "(A)") "* Evaluate ISR structure function"

	call sf_int(1)%apply (scale = 100._default)
	call sf_int(2)%apply (scale = 100._default)

	write (u, "(A)")
	write (u, "(A)") "* Structure function #1"
	write (u, "(A)")
	call sf_int(1)%write (u, testflag = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Structure function #2"
	write (u, "(A)")
	call sf_int(2)%write (u, testflag = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Structure-function value, default order"
	write (u, "(A)")

	do i = 1, 2
	f_isr(i) = sf_int(i)%get_matrix_element (1)
	end do

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", &
	product (f_isr)
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", &
	product (f_isr * f) * f_map

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

	do i = 1, 2
	call sf_int(i)%final ()
	end do
	call model%final ()

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

	end subroutine sf_isr_5

	@ %def sf_isr_5
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{EPA}

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

	module sf_epa

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use constants, only: pi
	use format_defs, only: FMT_17, FMT_19
	use numeric_utils
	use diagnostics
	use physics_defs, only: PHOTON
	use lorentz
	use pdg_arrays
	use model_data
	use flavors
	use colors
	use quantum_numbers
	use state_matrices
	use polarizations
	use interactions
	use sf_aux
	use sf_base

	<<Standard module head>>

	<<SF epa: public>>

	<<SF epa: parameters>>

	<<SF epa: types>>

	contains

	<<SF epa: procedures>>

	end module sf_epa
	@ %def sf_epa
	@
	\subsection{Physics}
	The EPA structure function for a photon inside an (elementary)
	particle $p$ with energy $E$, mass $m$ and charge $q_p$ (e.g.,
	electron) is given by ($\bar x \equiv 1-x$)
	%% %\cite{Budnev:1974de}
	%% \bibitem{Budnev:1974de}
	%% V.~M.~Budnev, I.~F.~Ginzburg, G.~V.~Meledin and V.~G.~Serbo,
	%% %``The Two photon particle production mechanism. Physical problems.
	%% %Applications. Equivalent photon approximation,''
	%% Phys.\ Rept.\ {\bf 15} (1974) 181.
	%% %%CITATION = PRPLC,15,181;%%
	\begin{multline}
	\label{EPA}
	f(x) =
	\frac{\alpha}{\pi}\,q_p^2\,
	\frac{1}{x}\,
	\biggl[\left(\bar x + \frac{x^2}{2}\right)
	\ln\frac{Q^2_{\rm max}}{Q^2_{\rm min}}
	\\
	- \left(1 - \frac{x}{2}\right)^2
	\ln\frac{x^2+\frac{Q^2_{\rm max}}{E^2}}
	{x^2+\frac{Q^2_{\rm min}}{E^2}}
	- x^2\frac{m^2}{Q^2_{\rm min}}
	\left(1 - \frac{Q^2_{\rm min}}{Q^2_{\rm max}}\right)
	\biggr].
	\end{multline}
	If no explicit $Q$ bounds are provided, the kinematical bounds are
	\begin{align}
	-Q^2_{\rm max} &= t_0 = -2\bar x(E^2+p\bar p) + 2m^2 \approx -4\bar x E^2,
	\\
	-Q^2_{\rm min} &= t_1 = -2\bar x(E^2-p\bar p) + 2m^2
	\approx
	-\frac{x^2}{\bar x}m^2.
	\end{align}

	The second and third terms in (\ref{EPA}) are negative definite (and
	subleading). Noting that $\bar x + x^2/2$ is bounded between
	$1/2$ and $1$, we derive that $f(x)$ is always smaller than
	\begin{equation}
	\bar f(x) = \frac{\alpha}{\pi}\,q_p^2\,\frac{L - 2\ln x}{x}
	\qquad\text{where}\qquad
	L = \ln\frac{\min(4E_{\rm max}^2,Q^2_{\rm max})}{\max(m^2,Q_{\rm min}^2)},
	\end{equation}
	where we allow for explicit $Q$ bounds that narrow the kinematical range.
	Therefore, we generate this distribution:
	\begin{equation}\label{EPA-subst}
	\int_{x_0}^{x_1} dx\,\bar f(x) = C(x_0,x_1)\int_0^1 dx'
	\end{equation}
	We set
	\begin{equation}\label{EPA-x(x')}
	\ln x = \frac12\left\{ L - \sqrt{L^2 - 4\left[ x'\ln x_1(L-\ln x_1)
	+ \bar x'\ln x_0(L-\ln x_0) \right]} \right\}
	\end{equation}
	such that $x(0)=x_0$ and $x(1)=x_1$ and
	\begin{equation}
	\frac{dx}{dx'} = \left(\frac{\alpha}{\pi} q_p^2 \right)^{-1}
	x\frac{C(x_0,x_1)}{L - 2\ln x}
	\end{equation}
	with
	\begin{equation}
	C(x_0,x_1) = \frac{\alpha}{\pi} q_p^2\,\left[\ln x_1(L-\ln x_1) - \ln
	x_0(L-\ln x_0)\right]
	\end{equation}
	such that (\ref{EPA-subst}) is satisfied. Finally, we have
	\begin{equation}
	\int_{x_0}^{x_1} dx\,f(x) = C(x_0,x_1)\int_0^1 dx'\,
	\frac{f(x(x'))}{\bar f(x(x'))}
	\end{equation}
	where $x'$ is calculated from $x$ via (\ref{EPA-x(x')}).

	The structure of the mapping is most obvious from:
	\begin{equation}
	x'(x) = \frac{\log x ( L - \log x) - \log x_0 (L - \log x_0)}
	{\log x_1 ( L - \log x_1) - \log x_0 (L - \log x_0)} \; .
	\end{equation}



	\subsection{The EPA data block}
	The EPA parameters are: $\alpha$, $E_{\rm max}$, $m$, $Q_{\rm min}$, and
	$x_{\rm min}$. Instead of $m$ we can use the incoming particle PDG
	code as input; from this we can deduce the mass and charge.

	Internally we store in addition $C_{0/1} = \frac{\alpha}{\pi}q_e^2\ln
	x_{0/1} (L - \ln x_{0/1})$, the c.m. energy squared and the incoming
	particle mass.
	<<SF epa: public>>=
	public :: epa_data_t
	<<SF epa: types>>=
	type, extends(sf_data_t) :: epa_data_t
	private
	class(model_data_t), pointer :: model => null ()
	type(flavor_t), dimension(:), allocatable :: flv_in
	real(default) :: alpha
	real(default) :: x_min
	real(default) :: x_max
	real(default) :: q_min
	real(default) :: q_max
	real(default) :: E_max
	real(default) :: mass
	real(default) :: log
	real(default) :: a
	real(default) :: c0
	real(default) :: c1
	real(default) :: dc
	integer :: error = NONE
	logical :: recoil = .false.
	logical :: keep_energy = .true.
	contains
	<<SF epa: epa data: TBP>>
	end type epa_data_t

	@ %def epa_data_t
	@ Error codes
	<<SF epa: parameters>>=
	integer, parameter :: NONE = 0
	integer, parameter :: ZERO_QMIN = 1
	integer, parameter :: Q_MAX_TOO_SMALL = 2
	integer, parameter :: ZERO_XMIN = 3
	integer, parameter :: MASS_MIX = 4
	integer, parameter :: NO_EPA = 5
	<<SF epa: epa data: TBP>>=
	procedure :: init => epa_data_init
	<<SF epa: procedures>>=
	subroutine epa_data_init (data, model, pdg_in, alpha, &
	x_min, q_min, E_max, mass, recoil, keep_energy)
	class(epa_data_t), intent(inout) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	real(default), intent(in) :: alpha, x_min, q_min, E_max
	real(default), intent(in), optional :: mass
	logical, intent(in), optional :: recoil
	logical, intent(in), optional :: keep_energy
	integer :: n_flv, i
	data%model => model
	n_flv = pdg_array_get_length (pdg_in)
	allocate (data%flv_in (n_flv))
	do i = 1, n_flv
	call data%flv_in(i)%init (pdg_array_get (pdg_in, i), model)
	end do
	data%alpha = alpha
	data%E_max = E_max
	data%x_min = x_min
	data%x_max = 1
	if (vanishes (data%x_min)) then
	data%error = ZERO_XMIN; return
	end if
	data%q_min = q_min
	data%q_max = 2 * data%E_max
	select case (char (data%model%get_name ()))
	case ("QCD","Test")
	data%error = NO_EPA; return
	end select
	if (present (recoil)) then
	data%recoil = recoil
	end if
	if (present (keep_energy)) then
	data%keep_energy = keep_energy
	end if
	if (present (mass)) then
	data%mass = mass
	else
	data%mass = data%flv_in(1)%get_mass ()
	if (any (data%flv_in%get_mass () /= data%mass)) then
	data%error = MASS_MIX; return
	end if
	end if
	if (max (data%mass, data%q_min) == 0) then
	data%error = ZERO_QMIN; return
	else if (max (data%mass, data%q_min) >= data%E_max) then
	data%error = Q_MAX_TOO_SMALL; return
	end if
	data%log = log (4 * (data%E_max / max (data%mass, data%q_min)) ** 2 )
	data%a = data%alpha / pi
	data%c0 = log (data%x_min) * (data%log - log (data%x_min))
	data%c1 = log (data%x_max) * (data%log - log (data%x_max))
	data%dc = data%c1 - data%c0
	end subroutine epa_data_init

	@ %def epa_data_init
	@ Handle error conditions. Should always be done after
	initialization, unless we are sure everything is ok.
	<<SF epa: epa data: TBP>>=
	procedure :: check => epa_data_check
	<<SF epa: procedures>>=
	subroutine epa_data_check (data)
	class(epa_data_t), intent(in) :: data
	select case (data%error)
	case (NO_EPA)
	call msg_fatal ("EPA structure function not available for model " &
	// char (data%model%get_name ()) // ".")
	case (ZERO_QMIN)
	call msg_fatal ("EPA: Particle mass is zero")
	case (Q_MAX_TOO_SMALL)
	call msg_fatal ("EPA: Particle mass exceeds Qmax")
	case (ZERO_XMIN)
	call msg_fatal ("EPA: x_min must be larger than zero")
	case (MASS_MIX)
	call msg_fatal ("EPA: incoming particle masses must be uniform")
	end select
	end subroutine epa_data_check

	@ %def epa_data_check
	@ Output
	<<SF epa: epa data: TBP>>=
	procedure :: write => epa_data_write
	<<SF epa: procedures>>=
	subroutine epa_data_write (data, unit, verbose)
	class(epa_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "EPA data:"
	if (allocated (data%flv_in)) then
	write (u, "(3x,A)", advance="no") " flavor = "
	do i = 1, size (data%flv_in)
	if (i > 1) write (u, "(',',1x)", advance="no")
	call data%flv_in(i)%write (u)
	end do
	write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") " alpha = ", data%alpha
	write (u, "(3x,A," // FMT_19 // ")") " x_min = ", data%x_min
	write (u, "(3x,A," // FMT_19 // ")") " x_max = ", data%x_max
	write (u, "(3x,A," // FMT_19 // ")") " q_min = ", data%q_min
	write (u, "(3x,A," // FMT_19 // ")") " q_max = ", data%q_max
	write (u, "(3x,A," // FMT_19 // ")") " E_max = ", data%e_max
	write (u, "(3x,A," // FMT_19 // ")") " mass = ", data%mass
	write (u, "(3x,A," // FMT_19 // ")") " a = ", data%a
	write (u, "(3x,A," // FMT_19 // ")") " c0 = ", data%c0
	write (u, "(3x,A," // FMT_19 // ")") " c1 = ", data%c1
	write (u, "(3x,A," // FMT_19 // ")") " log = ", data%log
	write (u, "(3x,A,L2)") " recoil = ", data%recoil
	write (u, "(3x,A,L2)") " keep en. = ", data%keep_energy
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine epa_data_write

	@ %def epa_data_write
	@ The number of kinematic parameters.
	<<SF epa: epa data: TBP>>=
	procedure :: get_n_par => epa_data_get_n_par
	<<SF epa: procedures>>=
	function epa_data_get_n_par (data) result (n)
	class(epa_data_t), intent(in) :: data
	integer :: n
	if (data%recoil) then
	n = 3
	else
	n = 1
	end if
	end function epa_data_get_n_par

	@ %def epa_data_get_n_par
	@ Return the outgoing particles PDG codes. The outgoing particle is always
	the photon while the radiated particle is identical to the incoming one.
	<<SF epa: epa data: TBP>>=
	procedure :: get_pdg_out => epa_data_get_pdg_out
	<<SF epa: procedures>>=
	subroutine epa_data_get_pdg_out (data, pdg_out)
	class(epa_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	pdg_out(1) = PHOTON
	end subroutine epa_data_get_pdg_out

	@ %def epa_data_get_pdg_out
	@ Allocate the interaction record.
	<<SF epa: epa data: TBP>>=
	procedure :: allocate_sf_int => epa_data_allocate_sf_int
	<<SF epa: procedures>>=
	subroutine epa_data_allocate_sf_int (data, sf_int)
	class(epa_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (epa_t :: sf_int)
	end subroutine epa_data_allocate_sf_int

	@ %def epa_data_allocate_sf_int
	@
	\subsection{The EPA object}
	The [[epa_t]] data type is a $1\to 2$ interaction. We should be able
	to handle several flavors in parallel, since EPA is not necessarily
	applied immediately after beam collision: Photons may be radiated
	from quarks. In that case, the partons are massless and $q_{\rm min}$
	applies instead, so we do not need to generate several kinematical
	configurations in parallel.

	The squared charge values multiply the matrix elements, depending on the
	flavour. We scan the interaction after building it, so we have the correct
	assignments.

	The particles are ordered as (incoming, radiated, photon), where the
	photon initiates the hard interaction.

	We generate an unpolarized photon and transfer initial polarization to
	the radiated parton. Color is transferred in the same way.
	<<SF epa: types>>=
	type, extends (sf_int_t) :: epa_t
	type(epa_data_t), pointer :: data => null ()
	real(default) :: x = 0
	real(default) :: xb = 0
	real(default) :: E = 0
	real(default), dimension(:), allocatable :: charge2
	contains
	<<SF epa: epa: TBP>>
	end type epa_t

	@ %def epa_t
	@ Type string: has to be here, but there is no string variable on which EPA
	depends. Hence, a dummy routine.
	<<SF epa: epa: TBP>>=
	procedure :: type_string => epa_type_string
	<<SF epa: procedures>>=
	function epa_type_string (object) result (string)
	class(epa_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "EPA: equivalent photon approx."
	else
	string = "EPA: [undefined]"
	end if
	end function epa_type_string

	@ %def epa_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF epa: epa: TBP>>=
	procedure :: write => epa_write
	<<SF epa: procedures>>=
	subroutine epa_write (object, unit, testflag)
	class(epa_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(1x,A)") "SF parameters:"
	write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
	if (object%status >= SF_FAILED_EVALUATION) then
	write (u, "(3x,A," // FMT_17 // ")") "E =", object%E
	end if
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "EPA data: [undefined]"
	end if
	end subroutine epa_write

	@ %def epa_write
	@ Prepare the interaction object. We have to construct transition matrix
	elements for all flavor and helicity combinations.
	<<SF epa: epa: TBP>>=
	procedure :: init => epa_init
	<<SF epa: procedures>>=
	subroutine epa_init (sf_int, data)
	class(epa_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	integer, dimension(3) :: hel_lock
	type(polarization_t), target :: pol
	type(quantum_numbers_t), dimension(1) :: qn_fc
	type(flavor_t) :: flv_photon
	type(color_t) :: col_photon
	type(quantum_numbers_t) :: qn_hel, qn_photon, qn, qn_rad
	type(polarization_iterator_t) :: it_hel
	integer :: i
	mask = quantum_numbers_mask (.false., .false., &
	mask_h = [.false., .false., .true.])
	hel_lock = [2, 1, 0]
	select type (data)
	type is (epa_data_t)
	call sf_int%base_init (mask, [data%mass**2], &
	[data%mass**2], [0._default], hel_lock = hel_lock)
	sf_int%data => data
	call flv_photon%init (PHOTON, data%model)
	call col_photon%init ()
	call qn_photon%init (flv_photon, col_photon)
	do i = 1, size (data%flv_in)
	call pol%init_generic (data%flv_in(i))
	call qn_fc(1)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i), 1))
	call it_hel%init (pol)
	do while (it_hel%is_valid ())
	qn_hel = it_hel%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc(1)
	qn_rad = qn
	call qn_rad%tag_radiated ()
	call sf_int%add_state ([qn, qn_rad, qn_photon])
	call it_hel%advance ()
	end do
	! call pol%final ()
	end do
	call sf_int%freeze ()
	if (data%keep_energy) then
	sf_int%on_shell_mode = KEEP_ENERGY
	else
	sf_int%on_shell_mode = KEEP_MOMENTUM
	end if
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	end select
	end subroutine epa_init

	@ %def epa_init
	@ Prepare the charge array. This is separate from the previous routine since
	the state matrix may be helicity-contracted.
	<<SF epa: epa: TBP>>=
	procedure :: setup_constants => epa_setup_constants
	<<SF epa: procedures>>=
	subroutine epa_setup_constants (sf_int)
	class(epa_t), intent(inout), target :: sf_int
	type(state_iterator_t) :: it
	type(flavor_t) :: flv
	integer :: i, n_me
	n_me = sf_int%get_n_matrix_elements ()
	allocate (sf_int%charge2 (n_me))
	call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
	do while (it%is_valid ())
	i = it%get_me_index ()
	flv = it%get_flavor (1)
	sf_int%charge2(i) = flv%get_charge () ** 2
	call it%advance ()
	end do
	sf_int%status = SF_INITIAL
	end subroutine epa_setup_constants

	@ %def epa_setup_constants
	@
	\subsection{Kinematics}
	Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ is trivial.

	The EPA structure function allows for a straightforward mapping of the
	unit interval. The $x$ value is transformed, and the mapped structure
	function becomes unity at its upper boundary.

	The structure function implementation applies the above mapping to the
	input (random) number [[r]] to generate the momentum fraction [[x]]
	and the function value [[f]]. For numerical stability reasons, we
	also output [[xb]], which is $\bar x=1-x$.
	<<SF epa: epa: TBP>>=
	procedure :: complete_kinematics => epa_complete_kinematics
	<<SF epa: procedures>>=
	subroutine epa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(epa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	real(default) :: delta, sqrt_delta, lx
	if (map) then
	associate (data => sf_int%data)
	delta = data%log ** 2 - 4 * (r(1) * data%c1 + rb(1) * data%c0)
	if (delta > 0) then
	sqrt_delta = sqrt (delta)
	lx = (data%log - sqrt_delta) / 2
	else
	sf_int%status = SF_FAILED_KINEMATICS
	f = 0
	return
	end if
	x(1) = exp (lx)
	f = x(1) * data%dc / sqrt_delta
	end associate
	else
	x(1) = r(1)
	if (sf_int%data%x_min < x(1) .and. x(1) < sf_int%data%x_max) then
	f = 1
	else
	sf_int%status = SF_FAILED_KINEMATICS
	f = 0
	return
	end if
	end if
	xb(1) = 1 - x(1)
	if (size(x) == 3) then
	x(2:3) = r(2:3)
	xb(2:3) = rb(2:3)
	end if
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_DONE_KINEMATICS)
	sf_int%x = x(1)
	sf_int%xb= xb(1)
	sf_int%E = energy (sf_int%get_momentum (1))
	case (SF_FAILED_KINEMATICS)
	sf_int%x = 0
	sf_int%xb= 0
	f = 0
	end select
	end subroutine epa_complete_kinematics

	@ %def epa_complete_kinematics
	+@ Overriding the default method: we compute the [[x]] array from the
	+momentum configuration. In the specific case of EPA, we also set the
	+internally stored $x$ and $\bar x$ values, so they can be used in the
	+following routine.
	+
	+Note: the extraction of $\bar x$ is not numerically safe, but it cannot
	+be as long as the base [[recover_x]] is not.
	+<<SF epa: epa: TBP>>=
	+ procedure :: recover_x => sf_epa_recover_x
	+<<SF epa: procedures>>=
	+ subroutine sf_epa_recover_x (sf_int, x, xb, x_free)
	+ class(epa_t), intent(inout) :: sf_int
	+ real(default), dimension(:), intent(out) :: x
	+ real(default), dimension(:), intent(out) :: xb
	+ real(default), intent(inout), optional :: x_free
	+ call sf_int%base_recover_x (x, xb, x_free)
	+ sf_int%x = x(1)
	+ sf_int%xb = xb(1)
	+ end subroutine sf_epa_recover_x
	+
	+@ %def sf_epa_recover_x
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF epa: epa: TBP>>=
	procedure :: inverse_kinematics => epa_inverse_kinematics
	<<SF epa: procedures>>=
	subroutine epa_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	class(epa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	real(default) :: lx, delta, sqrt_delta, c
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	associate (data => sf_int%data)
	lx = log (x(1))
	sqrt_delta = data%log - 2 * lx
	delta = sqrt_delta ** 2
	c = (data%log ** 2 - delta) / 4
	r (1) = (c - data%c0) / data%dc
	rb(1) = (data%c1 - c) / data%dc
	f = x(1) * data%dc / sqrt_delta
	end associate
	else
	r (1) = x(1)
	rb(1) = xb(1)
	if (sf_int%data%x_min < x(1) .and. x(1) < sf_int%data%x_max) then
	f = 1
	else
	f = 0
	end if
	end if
	if (size(r) == 3) then
	r (2:3) = x(2:3)
	rb(2:3) = xb(2:3)
	end if
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	- case (SF_DONE_KINEMATICS)
	- sf_int%x = x(1)
	- sf_int%xb = xb(1)
	- sf_int%E = energy (sf_int%get_momentum (1))
	- case (SF_FAILED_KINEMATICS)
	- sf_int%x = 0
	- f = 0
	+ case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	+ sf_int%E = energy (sf_int%get_momentum (1))
	end subroutine epa_inverse_kinematics

	@ %def epa_inverse_kinematics
	-@ Overriding the default method: we compute the [[x]] array from the
	-momentum configuration. In the specific case of EPA, we also set the
	-internally stored $x$ and $\bar x$ values, so they can be used in the
	-following routine.
	-
	-Note: the extraction of $\bar x$ is not numerically safe, but it can't
	-be as long as the base [[recover_x]] isn't.
	-<<SF epa: epa: TBP>>=
	- procedure :: recover_x => sf_epa_recover_x
	-<<SF epa: procedures>>=
	- subroutine sf_epa_recover_x (sf_int, x, xb, x_free)
	- class(epa_t), intent(inout) :: sf_int
	- real(default), dimension(:), intent(out) :: x
	- real(default), dimension(:), intent(out) :: xb
	- real(default), intent(inout), optional :: x_free
	- call sf_int%base_recover_x (x, xb, x_free)
	- sf_int%x = x(1)
	- sf_int%xb = xb(1)
	- end subroutine sf_epa_recover_x
	-
	-@ %def sf_epa_recover_x
	@
	\subsection{EPA application}
	For EPA, we can in principle compute kinematics and function value in
	a single step. In order to be able to reweight events, kinematics and
	structure function application are separated. This function works on a
	single beam, assuming that the input momentum has been set. We need
	three random numbers as input: one for $x$, and two for the polar and
	azimuthal angles. Alternatively, for the no-recoil case, we can skip
	$p_T$ generation; in this case, we only need one.

	For obtaining splitting kinematics, we rely on the assumption that all
	in-particles are mass-degenerate (or there is only one), so the
	generated $x$ values are identical.
	<<SF epa: epa: TBP>>=
	procedure :: apply => epa_apply
	<<SF epa: procedures>>=
	subroutine epa_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(epa_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	real(default) :: x, xb, qminsq, qmaxsq, f, E
	associate (data => sf_int%data)
	x = sf_int%x
	xb= sf_int%xb
	E = sf_int%E
	qminsq = max (x ** 2 / xb * data%mass 2, data%q_min 2)
	qmaxsq = min (4 * xb * E 2, data%q_max 2)
	if (qminsq < qmaxsq) then
	f = data%a / x &
	* ((xb + x ** 2 / 2) * log (qmaxsq / qminsq) &
	- (1 - x / 2) ** 2 &
	* log ((x2 + qmaxsq / E 2) / (x2 + qminsq / E 2)) &
	- x ** 2 * data%mass ** 2 / qminsq * (1 - qminsq / qmaxsq))
	else
	f = 0
	end if
	call sf_int%set_matrix_element &
	(cmplx (f, kind=default) * sf_int%charge2)
	end associate
	sf_int%status = SF_EVALUATED
	end subroutine epa_apply

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

	module sf_epa_ut
	use unit_tests
	use sf_epa_uti

	<<Standard module head>>

	<<SF epa: public test>>

	contains

	<<SF epa: test driver>>

	end module sf_epa_ut
	@ %def sf_epa_ut
	@
	<<[[sf_epa_uti.f90]]>>=
	<<File header>>

	module sf_epa_uti

	<<Use kinds>>
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use interactions, only: interaction_pacify_momenta
	use model_data
	use sf_aux
	use sf_base

	use sf_epa

	<<Standard module head>>

	<<SF epa: test declarations>>

	contains

	<<SF epa: tests>>

	end module sf_epa_uti
	@ %def sf_epa_ut
	@ API: driver for the unit tests below.
	<<SF epa: public test>>=
	public :: sf_epa_test
	<<SF epa: test driver>>=
	subroutine sf_epa_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF epa: execute tests>>
	end subroutine sf_epa_test

	@ %def sf_epa_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF epa: execute tests>>=
	call test (sf_epa_1, "sf_epa_1", &
	"structure function configuration", &
	u, results)
	<<SF epa: test declarations>>=
	public :: sf_epa_1
	<<SF epa: tests>>=
	subroutine sf_epa_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_epa_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in = ELECTRON

	allocate (epa_data_t :: data)
	call data%write (u)

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

	select type (data)
	type is (epa_data_t)
	call data%init (model, pdg_in, 1./137._default, 0.01_default, &
	10._default, 50._default, 0.000511_default, recoil = .false.)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_epa_1

	@ %def sf_epa_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the EPA
	structure function.
	<<SF epa: execute tests>>=
	call test (sf_epa_2, "sf_epa_2", &
	"structure function instance", &
	u, results)
	<<SF epa: test declarations>>=
	public :: sf_epa_2
	<<SF epa: tests>>=
	subroutine sf_epa_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_epa_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	allocate (epa_data_t :: data)
	select type (data)
	type is (epa_data_t)
	call data%init (model, pdg_in, 1./137._default, 0.01_default, &
	10._default, 50._default, 0.000511_default, recoil = .false.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, no EPA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false., &
	set_momenta=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EPA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_epa_2

	@ %def sf_epa_2
	@
	\subsubsection{Standard mapping}
	Construct and display a structure function object based on the EPA
	structure function, applying the standard single-particle mapping.
	<<SF epa: execute tests>>=
	call test (sf_epa_3, "sf_epa_3", &
	"apply mapping", &
	u, results)
	<<SF epa: test declarations>>=
	public :: sf_epa_3
	<<SF epa: tests>>=
	subroutine sf_epa_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_epa_3"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	allocate (epa_data_t :: data)
	select type (data)
	type is (epa_data_t)
	call data%init (model, pdg_in, 1./137._default, 0.01_default, &
	10._default, 50._default, 0.000511_default, recoil = .false.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, with EPA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
	set_momenta=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EPA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_epa_3

	@ %def sf_epa_3
	@
	\subsubsection{Non-collinear case}
	Construct and display a structure function object based on the EPA
	structure function.
	<<SF epa: execute tests>>=
	call test (sf_epa_4, "sf_epa_4", &
	"non-collinear", &
	u, results)
	<<SF epa: test declarations>>=
	public :: sf_epa_4
	<<SF epa: tests>>=
	subroutine sf_epa_4 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E, m
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_epa_4"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	allocate (epa_data_t :: data)
	select type (data)
	type is (epa_data_t)
	call data%init (model, pdg_in, 1./137._default, 0.01_default, &
	10._default, 50._default, 5.0_default, recoil = .true.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	write (u, "(A)") "* Initialize incoming momentum with E=500, me = 5 GeV"
	write (u, "(A)")
	E = 500
	m = 5
	k = vector4_moving (E, sqrt (E2 - m2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.5/0.5/0.25, with EPA mapping, "
	write (u, "(A)") " non-coll., keeping energy, me = 5 GeV"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.5_default, 0.5_default, 0.25_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
	set_momenta=.true.)
	call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EPA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u, testflag = .true.)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_epa_4

	@ %def sf_epa_4
	@
	\subsubsection{Structure function for multiple flavors}
	Construct and display a structure function object based on the EPA
	structure function. The incoming state has multiple particles with
	non-uniform charge.
	<<SF epa: execute tests>>=
	call test (sf_epa_5, "sf_epa_5", &
	"multiple flavors", &
	u, results)
	<<SF epa: test declarations>>=
	public :: sf_epa_5
	<<SF epa: tests>>=
	subroutine sf_epa_5 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_epa_5"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_sm_test ()
	call flv%init (1, model)
	pdg_in = [1, 2, -1, -2]

	call reset_interaction_counter ()

	allocate (epa_data_t :: data)
	select type (data)
	type is (epa_data_t)
	call data%init (model, pdg_in, 1./137._default, 0.01_default, &
	10._default, 50._default, 0.000511_default, recoil = .false.)
	call data%check ()
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, no EPA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EPA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_epa_5

	@ %def sf_epa_5
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{EWA}

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

	module sf_ewa

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use constants, only: pi
	use format_defs, only: FMT_17, FMT_19
	use numeric_utils
	use diagnostics
	use physics_defs, only: W_BOSON, Z_BOSON
	use lorentz
	use pdg_arrays
	use model_data
	use flavors
	use colors
	use quantum_numbers
	use state_matrices
	use polarizations
	use interactions
	use sf_aux
	use sf_base

	<<Standard module head>>

	<<SF ewa: public>>

	<<SF ewa: parameters>>

	<<SF ewa: types>>

	contains

	<<SF ewa: procedures>>

	end module sf_ewa
	@ %def sf_ewa
	@
	\subsection{Physics}
	The EWA structure function for a $Z$ or $W$ inside a fermion (lepton
	or quark) depends on the vector-boson polarization. We distinguish
	transversal ($\pm$) and longitudinal ($0$) polarization.
	\begin{align}
	F_{+}(x) &= \frac{1}{16\pi^2}\,\frac{(v-a)^2 + (v+a)^2\bar x^2}{x}
	\left[
	\ln\left(\frac{p_{\perp,\textrm{max}}^2 + \bar x M^2}{\bar x M^2}\right)
	-
	\frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
	\right]
	\\
	F_{-}(x) &= \frac{1}{16\pi^2}\,\frac{(v+a)^2 + (v-a)^2\bar x^2}{x}
	\left[
	\ln\left(\frac{p_{\perp,\textrm{max}}^2 + \bar x M^2}{\bar x M^2}\right)
	-
	\frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
	\right]
	\\
	F_0(x) &= \frac{v^2+a^2}{8\pi^2}\,\frac{2\bar x}{x}\,
	\frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
	\end{align}
	where $p_{\perp,\textrm{max}}$ is the cutoff in transversal momentum, $M$ is
	the vector-boson mass, $v$ and $a$ are the vector and axial-vector
	couplings, and $\bar x\equiv 1-x$. Note that the longitudinal
	structure function is finite for large cutoff, while the transversal
	structure function is logarithmically divergent.

	The maximal transverse momentum is given by the kinematical limit, it is
	\begin{equation}
	p_{\perp,\textrm{max}} = \bar x \sqrt{s}/2.
	\end{equation}
	The vector and axial couplings for a fermion branching into a $W$ are
	\begin{align}
	v_W &= \frac{g}{2\sqrt 2},
	& a_W &= \frac{g}{2\sqrt 2}.
	\end{align}
	For $Z$ emission, this is replaced by
	\begin{align}
	v_Z &= \frac{g}{2\cos\theta_w}\left(t_3 - 2q\sin^2\theta_w\right),
	& a_Z &= \frac{g}{2\cos\theta_w}t_3,
	\end{align}
	where $t_3=\pm\frac12$ is the fermion isospin, and $q$ its charge.

	For an initial antifermion, the signs of the axial couplings are
	inverted. Note that a common sign change of $v$ and $a$ is
	irrelevant.

	%% Differentiating with respect to the cutoff, we get structure functions
	%% \begin{align}
	%% f_{W,\pm}(x,p_T) &= \frac{g^2}{16\pi^2}\,
	%% \frac{1+\bar x^2}{x}
	%% \frac{p_\perp}{p_\perp^2 + \bar x M^2}
	%% \\
	%% f_{W,0}(x,p_T) &= \frac{g^2}{16\pi^2}\,
	%% \frac{2\bar x}{x}\,
	%% \frac{p_\perp \bar xM^2}{(p_\perp^2 + \bar x M^2)^2}
	%% \\
	%% F_{Z,\pm}(x,p_T) &= \frac{g^2}{16\pi^2\cos\theta_w^2}
	%% \left[(t_3^f-2q^2\sin\theta_w^2)^2 + (t_3^f)^2\right]\,
	%% \frac{1+\bar x^2}{x}
	%% \frac{p_\perp}{p_\perp^2 + \bar x M^2}
	%% \\
	%% F_{Z,0}(x,p_T) &= \frac{g^2}{16\pi^2\cos\theta_w^2}\,
	%% \left[(t_3^f-2q^2\sin\theta_w^2)^2 + (t_3^f)^2\right]\,
	%% \frac{2\bar x}{x}\,
	%% \frac{p_\perp \bar xM^2}{(p_\perp^2 + \bar x M^2)^2}
	%% \end{align}
	%% Here, $t_3^f$ is the $SU(2)_L$ quantum number of the fermion
	%% $(\pm\frac12)$, and $q^f$ is the fermion charge in units of the
	%% positron charge.

	The EWA depends on the parameters $g$, $\sin^2\theta_w$, $M_W$, and
	$M_Z$. These can all be taken from the SM input, and the prefactors
	are calculated from those and the incoming particle type.

	Since these structure functions have a $1/x$ singularity (which is not
	really relevant in practice, however, since the vector boson mass is
	finite), we map this singularity allowing for nontrivial $x$ bounds:
	\begin{equation}
	x = \exp(\bar r\ln x_0 + r\ln x_1)
	\end{equation}
	such that
	\begin{equation}
	\int_{x_0}^{x_1}\frac{dx}{x} = (\ln x_1 - \ln x_0)\int_0^1 dr.
	\end{equation}

	As a user parameter, we have the cutoff $p_{\perp,\textrm{max}}$.
	The divergence $1/x$ also requires a $x_0$ cutoff; and for
	completeness we introduce a corresponding $x_1$. Physically, the
	minimal sensible value of $x$ is $M^2/s$, although the approximation
	loses its value already at higher $x$ values.


	\subsection{The EWA data block}
	The EWA parameters are: $p_{T,\rm max}$, $c_V$, $c_A$, and
	$m$. Instead of $m$ we can use the incoming particle PDG code as
	input; from this we can deduce the mass and charges. In the
	initialization phase it is not yet determined whether a $W$ or a $Z$
	is radiated, hence we set the vector and axial-vector couplings equal
	to the common prefactors $g/2 = e/2/\sin\theta_W$.

	In principle, for EWA it would make sense to allow the user to also
	set the upper bound for $x$, $x_{\rm max}$, but we fix it to one here.
	<<SF ewa: public>>=
	public :: ewa_data_t
	<<SF ewa: types>>=
	type, extends(sf_data_t) :: ewa_data_t
	private
	class(model_data_t), pointer :: model => null ()
	type(flavor_t), dimension(:), allocatable :: flv_in
	type(flavor_t), dimension(:), allocatable :: flv_out
	real(default) :: pt_max
	real(default) :: sqrts
	real(default) :: x_min
	real(default) :: x_max
	real(default) :: mass
	real(default) :: m_out
	real(default) :: q_min
	real(default) :: cv
	real(default) :: ca
	real(default) :: costhw
	real(default) :: sinthw
	real(default) :: mW
	real(default) :: mZ
	real(default) :: coeff
	logical :: mass_set = .false.
	logical :: recoil = .false.
	logical :: keep_energy = .false.
	integer :: id = 0
	integer :: error = NONE
	contains
	<<SF ewa: ewa data: TBP>>
	end type ewa_data_t

	@ %def ewa_data_t
	@ Error codes
	<<SF ewa: parameters>>=
	integer, parameter :: NONE = 0
	integer, parameter :: ZERO_QMIN = 1
	integer, parameter :: Q_MAX_TOO_SMALL = 2
	integer, parameter :: ZERO_XMIN = 3
	integer, parameter :: MASS_MIX = 4
	integer, parameter :: ZERO_SW = 5
	integer, parameter :: ISOSPIN_MIX = 6
	integer, parameter :: WRONG_PRT = 7
	integer, parameter :: MASS_MIX_OUT = 8
	integer, parameter :: NO_EWA = 9
	<<SF ewa: ewa data: TBP>>=
	procedure :: init => ewa_data_init
	<<SF ewa: procedures>>=
	subroutine ewa_data_init (data, model, pdg_in, x_min, pt_max, &
	sqrts, recoil, keep_energy, mass)
	class(ewa_data_t), intent(inout) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	real(default), intent(in) :: x_min, pt_max, sqrts
	logical, intent(in) :: recoil, keep_energy
	real(default), intent(in), optional :: mass
	real(default) :: g, ee
	integer :: n_flv, i
	data%model => model
	if (.not. any (pdg_in .match. &
	[1,2,3,4,5,6,11,13,15,-1,-2,-3,-4,-5,-6,-11,-13,-15])) then
	data%error = WRONG_PRT; return
	end if
	n_flv = pdg_array_get_length (pdg_in)
	allocate (data%flv_in (n_flv))
	allocate (data%flv_out(n_flv))
	do i = 1, n_flv
	call data%flv_in(i)%init (pdg_array_get (pdg_in, i), model)
	end do
	data%pt_max = pt_max
	data%sqrts = sqrts
	data%x_min = x_min
	data%x_max = 1
	if (vanishes (data%x_min)) then
	data%error = ZERO_XMIN; return
	end if
	select case (char (data%model%get_name ()))
	case ("QCD","QED","Test")
	data%error = NO_EWA; return
	end select
	ee = data%model%get_real (var_str ("ee"))
	data%sinthw = data%model%get_real (var_str ("sw"))
	data%costhw = data%model%get_real (var_str ("cw"))
	data%mZ = data%model%get_real (var_str ("mZ"))
	data%mW = data%model%get_real (var_str ("mW"))
	if (data%sinthw /= 0) then
	g = ee / data%sinthw
	else
	data%error = ZERO_SW; return
	end if
	data%cv = g / 2._default
	data%ca = g / 2._default
	data%coeff = 1._default / (8._default * PI**2)
	data%recoil = recoil
	data%keep_energy = keep_energy
	if (present (mass)) then
	data%mass = mass
	data%m_out = mass
	data%mass_set = .true.
	else
	data%mass = data%flv_in(1)%get_mass ()
	if (any (data%flv_in%get_mass () /= data%mass)) then
	data%error = MASS_MIX; return
	end if
	end if
	end subroutine ewa_data_init

	@ %def ewa_data_init
	@ Set the vector boson ID for distinguishing $W$ and $Z$ bosons.
	<<SF ewa: ewa data: TBP>>=
	procedure :: set_id => ewa_set_id
	<<SF ewa: procedures>>=
	subroutine ewa_set_id (data, id)
	class(ewa_data_t), intent(inout) :: data
	integer, intent(in) :: id
	integer :: i, isospin, pdg
	if (.not. allocated (data%flv_in)) &
	call msg_bug ("EWA: incoming particles not set")
	data%id = id
	select case (data%id)
	case (23)
	data%m_out = data%mass
	data%flv_out = data%flv_in
	case (24)
	do i = 1, size (data%flv_in)
	pdg = data%flv_in(i)%get_pdg ()
	isospin = data%flv_in(i)%get_isospin_type ()
	if (isospin > 0) then
	!!! up-type quark or neutrinos
	if (data%flv_in(i)%is_antiparticle ()) then
	call data%flv_out(i)%init (pdg + 1, data%model)
	else
	call data%flv_out(i)%init (pdg - 1, data%model)
	end if
	else
	!!! down-type quark or lepton
	if (data%flv_in(i)%is_antiparticle ()) then
	call data%flv_out(i)%init (pdg - 1, data%model)
	else
	call data%flv_out(i)%init (pdg + 1, data%model)
	end if
	end if
	end do
	if (.not. data%mass_set) then
	data%m_out = data%flv_out(1)%get_mass ()
	if (any (data%flv_out%get_mass () /= data%m_out)) then
	data%error = MASS_MIX_OUT; return
	end if
	end if
	end select
	end subroutine ewa_set_id

	@ %def ewa_set_id
	@ Handle error conditions. Should always be done after
	initialization, unless we are sure everything is ok.
	<<SF ewa: ewa data: TBP>>=
	procedure :: check => ewa_data_check
	<<SF ewa: procedures>>=
	subroutine ewa_data_check (data)
	class(ewa_data_t), intent(in) :: data
	select case (data%error)
	case (WRONG_PRT)
	call msg_fatal ("EWA structure function only accessible for " &
	// "SM quarks and leptons.")
	case (NO_EWA)
	call msg_fatal ("EWA structure function not available for model " &
	// char (data%model%get_name ()))
	case (ZERO_SW)
	call msg_fatal ("EWA: Vanishing value of sin(theta_w)")
	case (ZERO_QMIN)
	call msg_fatal ("EWA: Particle mass is zero")
	case (Q_MAX_TOO_SMALL)
	call msg_fatal ("EWA: Particle mass exceeds Qmax")
	case (ZERO_XMIN)
	call msg_fatal ("EWA: x_min must be larger than zero")
	case (MASS_MIX)
	call msg_fatal ("EWA: incoming particle masses must be uniform")
	case (MASS_MIX_OUT)
	call msg_fatal ("EWA: outgoing particle masses must be uniform")
	case (ISOSPIN_MIX)
	call msg_fatal ("EWA: incoming particle isospins must be uniform")
	end select
	end subroutine ewa_data_check

	@ %def ewa_data_check
	@ Output
	<<SF ewa: ewa data: TBP>>=
	procedure :: write => ewa_data_write
	<<SF ewa: procedures>>=
	subroutine ewa_data_write (data, unit, verbose)
	class(ewa_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "EWA data:"
	if (allocated (data%flv_in) .and. allocated (data%flv_out)) then
	write (u, "(3x,A)", advance="no") " flavor(in) = "
	do i = 1, size (data%flv_in)
	if (i > 1) write (u, "(',',1x)", advance="no")
	call data%flv_in(i)%write (u)
	end do
	write (u, *)
	write (u, "(3x,A)", advance="no") " flavor(out) = "
	do i = 1, size (data%flv_out)
	if (i > 1) write (u, "(',',1x)", advance="no")
	call data%flv_out(i)%write (u)
	end do
	write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") " x_min = ", data%x_min
	write (u, "(3x,A," // FMT_19 // ")") " x_max = ", data%x_max
	write (u, "(3x,A," // FMT_19 // ")") " pt_max = ", data%pt_max
	write (u, "(3x,A," // FMT_19 // ")") " sqrts = ", data%sqrts
	write (u, "(3x,A," // FMT_19 // ")") " mass = ", data%mass
	write (u, "(3x,A," // FMT_19 // ")") " cv = ", data%cv
	write (u, "(3x,A," // FMT_19 // ")") " ca = ", data%ca
	write (u, "(3x,A," // FMT_19 // ")") " coeff = ", data%coeff
	write (u, "(3x,A," // FMT_19 // ")") " costhw = ", data%costhw
	write (u, "(3x,A," // FMT_19 // ")") " sinthw = ", data%sinthw
	write (u, "(3x,A," // FMT_19 // ")") " mZ = ", data%mZ
	write (u, "(3x,A," // FMT_19 // ")") " mW = ", data%mW
	write (u, "(3x,A,L2)") " recoil = ", data%recoil
	write (u, "(3x,A,L2)") " keep en. = ", data%keep_energy
	write (u, "(3x,A,I2)") " PDG (VB) = ", data%id
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine ewa_data_write

	@ %def ewa_data_write
	@ The number of parameters is one for collinear splitting, in case the
	[[recoil]] option is set, we take the recoil into account.
	<<SF ewa: ewa data: TBP>>=
	procedure :: get_n_par => ewa_data_get_n_par
	<<SF ewa: procedures>>=
	function ewa_data_get_n_par (data) result (n)
	class(ewa_data_t), intent(in) :: data
	integer :: n
	if (data%recoil) then
	n = 3
	else
	n = 1
	end if
	end function ewa_data_get_n_par

	@ %def ewa_data_get_n_par
	@ Return the outgoing particles PDG codes. This depends, whether this
	is a charged-current or neutral-current interaction.
	<<SF ewa: ewa data: TBP>>=
	procedure :: get_pdg_out => ewa_data_get_pdg_out
	<<SF ewa: procedures>>=
	subroutine ewa_data_get_pdg_out (data, pdg_out)
	class(ewa_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	integer :: i, n_flv
	if (allocated (data%flv_out)) then
	n_flv = size (data%flv_out)
	else
	n_flv = 0
	end if
	allocate (pdg1 (n_flv))
	do i = 1, n_flv
	pdg1(i) = data%flv_out(i)%get_pdg ()
	end do
	pdg_out(1) = pdg1
	end subroutine ewa_data_get_pdg_out

	@ %def ewa_data_get_pdg_out
	@ Allocate the interaction record.
	<<SF ewa: ewa data: TBP>>=
	procedure :: allocate_sf_int => ewa_data_allocate_sf_int
	<<SF ewa: procedures>>=
	subroutine ewa_data_allocate_sf_int (data, sf_int)
	class(ewa_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (ewa_t :: sf_int)
	end subroutine ewa_data_allocate_sf_int

	@ %def ewa_data_allocate_sf_int
	@
	\subsection{The EWA object}
	The [[ewa_t]] data type is a $1\to 2$ interaction. We should be able
	to handle several flavors in parallel, since EWA is not necessarily
	applied immediately after beam collision: $W/Z$ bosons may be radiated
	from quarks. In that case, the partons are massless and $q_{\rm min}$
	applies instead, so we do not need to generate several kinematical
	configurations in parallel.

	The particles are ordered as (incoming, radiated, W/Z), where the
	W/Z initiates the hard interaction.

	In the case of EPA, we generated an unpolarized photon and transferred
	initial polarization to the radiated parton. Color is transferred in
	the same way. I do not know whether the same can/should be done for
	EWA, as the structure functions depend on the W/Z polarization. If we
	are having $Z$ bosons, both up- and down-type fermions can
	participate. Otherwise, with a $W^+$ an up-type fermion is transferred
	to a down-type fermion, and the other way round.
	<<SF ewa: types>>=
	type, extends (sf_int_t) :: ewa_t
	type(ewa_data_t), pointer :: data => null ()
	real(default) :: x = 0
	real(default) :: xb = 0
	integer :: n_me = 0
	real(default), dimension(:), allocatable :: cv
	real(default), dimension(:), allocatable :: ca
	contains
	<<SF ewa: ewa: TBP>>
	end type ewa_t

	@ %def ewa_t
	@ Type string: has to be here, but there is no string variable on which EWA
	depends. Hence, a dummy routine.
	<<SF ewa: ewa: TBP>>=
	procedure :: type_string => ewa_type_string
	<<SF ewa: procedures>>=
	function ewa_type_string (object) result (string)
	class(ewa_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "EWA: equivalent W/Z approx."
	else
	string = "EWA: [undefined]"
	end if
	end function ewa_type_string

	@ %def ewa_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF ewa: ewa: TBP>>=
	procedure :: write => ewa_write
	<<SF ewa: procedures>>=
	subroutine ewa_write (object, unit, testflag)
	class(ewa_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(1x,A)") "SF parameters:"
	write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
	write (u, "(3x,A," // FMT_17 // ")") "xb=", object%xb
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "EWA data: [undefined]"
	end if
	end subroutine ewa_write

	@ %def ewa_write
	@ The current implementation requires uniform isospin for all incoming
	particles, therefore we need to probe only the first one.
	<<SF ewa: ewa: TBP>>=
	procedure :: init => ewa_init
	<<SF ewa: procedures>>=
	subroutine ewa_init (sf_int, data)
	class(ewa_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	integer, dimension(3) :: hel_lock
	type(polarization_t), target :: pol
	type(quantum_numbers_t), dimension(1) :: qn_fc, qn_fc_fin
	type(flavor_t) :: flv_z, flv_wp, flv_wm
	type(color_t) :: col0
	type(quantum_numbers_t) :: qn_hel, qn_z, qn_wp, qn_wm, qn, qn_rad, qn_w
	type(polarization_iterator_t) :: it_hel
	integer :: i, isospin
	select type (data)
	type is (ewa_data_t)
	mask = quantum_numbers_mask (.false., .false., &
	mask_h = [.false., .false., .true.])
	hel_lock = [2, 1, 0]
	call col0%init ()
	select case (data%id)
	case (23)
	!!! Z boson, flavor is not changing
	call sf_int%base_init (mask, [data%mass2], [data%mass2], &
	[data%mZ**2], hel_lock = hel_lock)
	sf_int%data => data
	call flv_z%init (Z_BOSON, data%model)
	call qn_z%init (flv_z, col0)
	do i = 1, size (data%flv_in)
	call pol%init_generic (data%flv_in(i))
	call qn_fc(1)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i), 1))
	call it_hel%init (pol)
	do while (it_hel%is_valid ())
	qn_hel = it_hel%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc(1)
	qn_rad = qn
	call qn_rad%tag_radiated ()
	call sf_int%add_state ([qn, qn_rad, qn_z])
	call it_hel%advance ()
	end do
	! call pol%final ()
	end do
	case (24)
	call sf_int%base_init (mask, [data%mass2], [data%m_out2], &
	[data%mW**2], hel_lock = hel_lock)
	sf_int%data => data
	call flv_wp%init (W_BOSON, data%model)
	call flv_wm%init (- W_BOSON, data%model)
	call qn_wp%init (flv_wp, col0)
	call qn_wm%init (flv_wm, col0)
	do i = 1, size (data%flv_in)
	isospin = data%flv_in(i)%get_isospin_type ()
	if (isospin > 0) then
	!!! up-type quark or neutrinos
	if (data%flv_in(i)%is_antiparticle ()) then
	qn_w = qn_wm
	else
	qn_w = qn_wp
	end if
	else
	!!! down-type quark or lepton
	if (data%flv_in(i)%is_antiparticle ()) then
	qn_w = qn_wp
	else
	qn_w = qn_wm
	end if
	end if
	call pol%init_generic (data%flv_in(i))
	call qn_fc(1)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i), 1))
	call qn_fc_fin(1)%init ( &
	flv = data%flv_out(i), &
	col = color_from_flavor (data%flv_out(i), 1))
	call it_hel%init (pol)
	do while (it_hel%is_valid ())
	qn_hel = it_hel%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc(1)
	qn_rad = qn_hel .merge. qn_fc_fin(1)
	call qn_rad%tag_radiated ()
	call sf_int%add_state ([qn, qn_rad, qn_w])
	call it_hel%advance ()
	end do
	! call pol%final ()
	end do
	case default
	call msg_fatal ("EWA initialization failed: wrong particle type.")
	end select
	call sf_int%freeze ()
	if (data%keep_energy) then
	sf_int%on_shell_mode = KEEP_ENERGY
	else
	sf_int%on_shell_mode = KEEP_MOMENTUM
	end if
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	end select
	end subroutine ewa_init

	@ %def ewa_init
	@ Prepare the coupling arrays. This is separate from the previous routine since
	the state matrix may be helicity-contracted.
	<<SF ewa: ewa: TBP>>=
	procedure :: setup_constants => ewa_setup_constants
	<<SF ewa: procedures>>=
	subroutine ewa_setup_constants (sf_int)
	class(ewa_t), intent(inout), target :: sf_int
	type(state_iterator_t) :: it
	type(flavor_t) :: flv
	real(default) :: q, t3
	integer :: i
	sf_int%n_me = sf_int%get_n_matrix_elements ()
	allocate (sf_int%cv (sf_int%n_me))
	allocate (sf_int%ca (sf_int%n_me))
	associate (data => sf_int%data)
	select case (data%id)
	case (23)
	call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
	do while (it%is_valid ())
	i = it%get_me_index ()
	flv = it%get_flavor (1)
	q = flv%get_charge ()
	t3 = flv%get_isospin ()
	if (flv%is_antiparticle ()) then
	sf_int%cv(i) = - data%cv &
	* (t3 - 2._default * q * data%sinthw**2) / data%costhw
	sf_int%ca(i) = data%ca * t3 / data%costhw
	else
	sf_int%cv(i) = data%cv &
	* (t3 - 2._default * q * data%sinthw**2) / data%costhw
	sf_int%ca(i) = data%ca * t3 / data%costhw
	end if
	call it%advance ()
	end do
	case (24)
	call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
	do while (it%is_valid ())
	i = it%get_me_index ()
	flv = it%get_flavor (1)
	if (flv%is_antiparticle ()) then
	sf_int%cv(i) = data%cv / sqrt(2._default)
	sf_int%ca(i) = - data%ca / sqrt(2._default)
	else
	sf_int%cv(i) = data%cv / sqrt(2._default)
	sf_int%ca(i) = data%ca / sqrt(2._default)
	end if
	call it%advance ()
	end do
	end select
	end associate
	sf_int%status = SF_INITIAL
	end subroutine ewa_setup_constants

	@ %def ewa_setup_constants
	@
	\subsection{Kinematics}
	Set kinematics. The EWA structure function allows for a
	straightforward mapping of the unit interval. So, to leading order,
	the structure function value is unity, but the $x$ value is
	transformed. Higher orders affect the function value.
	If [[map]] is unset, the $r$ and $x$ values coincide, and the Jacobian
	$f(r)$ is trivial.

	If [[map]] is set, the exponential mapping for the $1/x$ singularity
	discussed above is applied.
	<<SF ewa: ewa: TBP>>=
	procedure :: complete_kinematics => ewa_complete_kinematics
	<<SF ewa: procedures>>=
	subroutine ewa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(ewa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	real(default) :: e_1
	real(default) :: x0, x1, lx0, lx1, lx
	e_1 = energy (sf_int%get_momentum (1))
	if (sf_int%data%recoil) then
	select case (sf_int%data%id)
	case (23)
	x0 = max (sf_int%data%x_min, sf_int%data%mz / e_1)
	case (24)
	x0 = max (sf_int%data%x_min, sf_int%data%mw / e_1)
	end select
	else
	x0 = sf_int%data%x_min
	end if
	x1 = sf_int%data%x_max
	if ( x0 >= x1) then
	f = 0
	sf_int%status = SF_FAILED_KINEMATICS
	return
	end if
	if (map) then
	lx0 = log (x0)
	lx1 = log (x1)
	lx = lx1 * r(1) + lx0 * rb(1)
	x(1) = exp(lx)
	f = x(1) * (lx1 - lx0)
	else
	x(1) = r(1)
	if (x0 < x(1) .and. x(1) < x1) then
	f = 1
	else
	sf_int%status = SF_FAILED_KINEMATICS
	f = 0
	return
	end if
	end if
	xb(1) = 1 - x(1)
	if (size(x) == 3) then
	x(2:3) = r(2:3)
	xb(2:3) = rb(2:3)
	end if
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_DONE_KINEMATICS)
	sf_int%x = x(1)
	sf_int%xb = xb(1)
	case (SF_FAILED_KINEMATICS)
	sf_int%x = 0
	sf_int%xb = 0
	f = 0
	end select
	end subroutine ewa_complete_kinematics

	@ %def ewa_complete_kinematics
	+@ Overriding the default method: we compute the [[x]] array from the
	+momentum configuration. In the specific case of EWA, we also set the
	+internally stored $x$ and $\bar x$ values, so they can be used in the
	+following routine.
	+<<SF ewa: ewa: TBP>>=
	+ procedure :: recover_x => sf_ewa_recover_x
	+<<SF ewa: procedures>>=
	+ subroutine sf_ewa_recover_x (sf_int, x, xb, x_free)
	+ class(ewa_t), intent(inout) :: sf_int
	+ real(default), dimension(:), intent(out) :: x
	+ real(default), dimension(:), intent(out) :: xb
	+ real(default), intent(inout), optional :: x_free
	+ call sf_int%base_recover_x (x, xb, x_free)
	+ sf_int%x = x(1)
	+ sf_int%xb = xb(1)
	+ end subroutine sf_ewa_recover_x
	+
	+@ %def sf_ewa_recover_x
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF ewa: ewa: TBP>>=
	procedure :: inverse_kinematics => ewa_inverse_kinematics
	<<SF ewa: procedures>>=
	subroutine ewa_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	class(ewa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	real(default) :: x0, x1, lx0, lx1, lx, e_1
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	e_1 = energy (sf_int%get_momentum (1))
	if (sf_int%data%recoil) then
	select case (sf_int%data%id)
	case (23)
	x0 = max (sf_int%data%x_min, sf_int%data%mz / e_1)
	case (24)
	x0 = max (sf_int%data%x_min, sf_int%data%mw / e_1)
	end select
	else
	x0 = sf_int%data%x_min
	end if
	x1 = sf_int%data%x_max
	if (map) then
	lx0 = log (x0)
	lx1 = log (x1)
	lx = log (x(1))
	r(1) = (lx - lx0) / (lx1 - lx0)
	rb(1) = (lx1 - lx) / (lx1 - lx0)
	f = x(1) * (lx1 - lx0)
	else
	r (1) = x(1)
	rb(1) = 1 - x(1)
	if (x0 < x(1) .and. x(1) < x1) then
	f = 1
	else
	f = 0
	end if
	end if
	if (size(r) == 3) then
	r (2:3) = x(2:3)
	rb(2:3) = xb(2:3)
	end if
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	- case (SF_DONE_KINEMATICS)
	- sf_int%x = x(1)
	- sf_int%xb= xb(1)
	- case (SF_FAILED_KINEMATICS)
	- sf_int%x = 0
	- sf_int%xb= 0
	- f = 0
	+ case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine ewa_inverse_kinematics

	@ %def ewa_inverse_kinematics
	@
	\subsection{EWA application}
	For EWA, we can compute kinematics and function value in a single
	step. This function works on a single beam, assuming that the input
	momentum has been set. We need four random numbers as input: one for
	$x$, one for $Q^2$, and two for the polar and azimuthal angles.
	Alternatively, we can skip $p_T$ generation; in this case, we only
	need one.

	For obtaining splitting kinematics, we rely on the assumption that all
	in-particles are mass-degenerate (or there is only one), so the
	generated $x$ values are identical.
	<<SF ewa: ewa: TBP>>=
	procedure :: apply => ewa_apply
	<<SF ewa: procedures>>=
	subroutine ewa_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(ewa_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	real(default) :: x, xb, pt2, c1, c2
	real(default) :: cv, ca
	real(default) :: f, fm, fp, fL
	integer :: i
	associate (data => sf_int%data)
	x = sf_int%x
	xb = sf_int%xb
	pt2 = min ((data%pt_max)*2, (xb data%sqrts / 2)**2)
	select case (data%id)
	case (23)
	!!! Z boson structure function
	c1 = log (1 + pt2 / (xb * (data%mZ)**2))
	c2 = 1 / (1 + (xb * (data%mZ)**2) / pt2)
	case (24)
	!!! W boson structure function
	c1 = log (1 + pt2 / (xb * (data%mW)**2))
	c2 = 1 / (1 + (xb * (data%mW)**2) / pt2)
	end select
	do i = 1, sf_int%n_me
	cv = sf_int%cv(i)
	ca = sf_int%ca(i)
	fm = data%coeff * &
	((cv + ca)*2 + ((cv - ca) xb)*2) (c1 - c2) / (2 * x)
	fp = data%coeff * &
	((cv - ca)*2 + ((cv + ca) xb)*2) (c1 - c2) / (2 * x)
	fL = data%coeff * &
	(cv2 + ca2) * (2 * xb / x) * c2
	f = fp + fm + fL
	if (.not. vanishes (f)) then
	fp = fp / f
	fm = fm / f
	fL = fL / f
	end if
	call sf_int%set_matrix_element (i, cmplx (f, kind=default))
	end do
	end associate
	sf_int%status = SF_EVALUATED
	end subroutine ewa_apply

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

	module sf_ewa_ut
	use unit_tests
	use sf_ewa_uti

	<<Standard module head>>

	<<SF ewa: public test>>

	contains

	<<SF ewa: test driver>>

	end module sf_ewa_ut
	@ %def sf_ewa_ut
	@
	<<[[sf_ewa_uti.f90]]>>=
	<<File header>>

	module sf_ewa_uti

	<<Use kinds>>
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use interactions, only: interaction_pacify_momenta
	use model_data
	use sf_aux
	use sf_base

	use sf_ewa

	<<Standard module head>>

	<<SF ewa: test declarations>>

	contains

	<<SF ewa: tests>>

	end module sf_ewa_uti
	@ %def sf_ewa_ut
	@ API: driver for the unit tests below.
	<<SF ewa: public test>>=
	public :: sf_ewa_test
	<<SF ewa: test driver>>=
	subroutine sf_ewa_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF ewa: execute tests>>
	end subroutine sf_ewa_test

	@ %def sf_ewa_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF ewa: execute tests>>=
	call test (sf_ewa_1, "sf_ewa_1", &
	"structure function configuration", &
	u, results)
	<<SF ewa: test declarations>>=
	public :: sf_ewa_1
	<<SF ewa: tests>>=
	subroutine sf_ewa_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_ewa_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call model%init_sm_test ()
	pdg_in = 2

	allocate (ewa_data_t :: data)
	call data%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize for Z boson"
	write (u, "(A)")

	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 5000._default, .false., .false.)
	call data%set_id (23)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	write (u, "(A)")
	write (u, "(A)") "* Initialize for W boson"
	write (u, "(A)")

	deallocate (data)
	allocate (ewa_data_t :: data)
	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 5000._default, .false., .false.)
	call data%set_id (24)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_ewa_1

	@ %def sf_ewa_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the EWA
	structure function.
	<<SF ewa: execute tests>>=
	call test (sf_ewa_2, "sf_ewa_2", &
	"structure function instance", &
	u, results)
	<<SF ewa: test declarations>>=
	public :: sf_ewa_2
	<<SF ewa: tests>>=
	subroutine sf_ewa_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_ewa_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_sm_test ()
	call flv%init (2, model)
	pdg_in = 2

	call reset_interaction_counter ()

	allocate (ewa_data_t :: data)
	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 3000._default, .false., .true.)
	call data%set_id (24)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=1500"
	write (u, "(A)")
	E = 1500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, no EWA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false., &
	set_momenta=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EWA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_ewa_2

	@ %def sf_ewa_2
	@
	\subsubsection{Standard mapping}
	Construct and display a structure function object based on the EWA
	structure function, applying the standard single-particle mapping.
	<<SF ewa: execute tests>>=
	call test (sf_ewa_3, "sf_ewa_3", &
	"apply mapping", &
	u, results)
	<<SF ewa: test declarations>>=
	public :: sf_ewa_3
	<<SF ewa: tests>>=
	subroutine sf_ewa_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_ewa_3"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_sm_test ()
	call flv%init (2, model)
	pdg_in = 2

	call reset_interaction_counter ()

	allocate (ewa_data_t :: data)
	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 3000._default, .false., .true.)
	call data%set_id (24)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=1500"
	write (u, "(A)")
	E = 1500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, with EWA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
	set_momenta=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EWA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_ewa_3

	@ %def sf_ewa_3
	@
	\subsubsection{Non-collinear case}
	Construct and display a structure function object based on the EPA
	structure function.
	<<SF ewa: execute tests>>=
	call test (sf_ewa_4, "sf_ewa_4", &
	"non-collinear", &
	u, results)
	<<SF ewa: test declarations>>=
	public :: sf_ewa_4
	<<SF ewa: tests>>=
	subroutine sf_ewa_4 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_ewa_4"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call modeL%init_sm_test ()
	call flv%init (2, model)
	pdg_in = 2

	call reset_interaction_counter ()

	allocate (ewa_data_t :: data)
	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 3000.0_default, .true., .true.)
	call data%set_id (24)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	write (u, "(A)") "* Initialize incoming momentum with E=1500"
	write (u, "(A)")
	E = 1500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.5/0.5/0.25, with EWA mapping, "
	write (u, "(A)") " non-coll., keeping energy"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.5_default, 0.5_default, 0.25_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
	set_momenta=.true.)
	call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EWA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 1500._default)
	call sf_int%write (u, testflag = .true.)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_ewa_4

	@ %def sf_ewa_4
	@
	\subsubsection{Structure function for multiple flavors}
	Construct and display a structure function object based on the EWA
	structure function. The incoming state has multiple particles with
	non-uniform quantum numbers.
	<<SF ewa: execute tests>>=
	call test (sf_ewa_5, "sf_ewa_5", &
	"structure function instance", &
	u, results)
	<<SF ewa: test declarations>>=
	public :: sf_ewa_5
	<<SF ewa: tests>>=
	subroutine sf_ewa_5 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_ewa_5"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_sm_test ()
	call flv%init (2, model)
	pdg_in = [1, 2, -1, -2]

	call reset_interaction_counter ()

	allocate (ewa_data_t :: data)
	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 3000._default, .false., .true.)
	call data%set_id (24)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=1500"
	write (u, "(A)")
	E = 1500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, no EWA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EWA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_ewa_5

	@ %def sf_ewa_5
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{Energy-scan spectrum}

	This spectrum is actually a trick that allows us to plot the c.m.\ energy
	dependence of a cross section without scanning the input energy. We
	start with the observation that a spectrum $f(x)$, applied to one of
	the incoming beams only, results in a cross section
	\begin{equation}
	\sigma = \int dx\,f(x)\,\hat\sigma(xs).
	\end{equation}
	We want to compute the distribution of $E=\sqrt{\hat s}=\sqrt{xs}$, i.e.,
	\begin{equation}
	\frac{d\sigma}{dE} = \frac{2\sqrt{x}}{\sqrt{s}}\,\frac{d\sigma}{dx}
	= \frac{2\sqrt{x}}{\sqrt{s}}\,f(x)\,\hat\sigma(xs),
	\end{equation}
	so if we set
	\begin{equation}
	f(x) = \frac{\sqrt{s}}{2\sqrt{x}},
	\end{equation}
	we get the distribution
	\begin{equation}
	\frac{d\sigma}{dE} = \hat\sigma(\hat s=E^2).
	\end{equation}
	We implement this as a spectrum with a single parameter $x$. The
	parameters for the individual beams are computed as $x_i=\sqrt{x}$, so
	they are equal and the kinematics is always symmetric.
	<<[[sf_escan.f90]]>>=
	<<File header>>

	module sf_escan

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_12
	use numeric_utils
	use diagnostics
	use lorentz
	use pdg_arrays
	use model_data
	use flavors
	use quantum_numbers
	use state_matrices
	use polarizations
	use sf_base

	<<Standard module head>>

	<<SF escan: public>>

	<<SF escan: types>>

	contains

	<<SF escan: procedures>>

	end module sf_escan
	@ %def sf_escan
	@
	\subsection{Data type}
	The [[norm]] is unity if the total cross section should be normalized
	to one, and $\sqrt{s}$ if it should be normalized to the total
	energy. In the latter case, the differential distribution
	$d\sigma/d\sqrt{\hat s}$ coincides with the partonic cross section
	$\hat\sigma$ as a function of $\sqrt{\hat s}$.
	<<SF escan: public>>=
	public :: escan_data_t
	<<SF escan: types>>=
	type, extends(sf_data_t) :: escan_data_t
	private
	type(flavor_t), dimension(:,:), allocatable :: flv_in
	integer, dimension(2) :: n_flv = 0
	real(default) :: norm = 1
	contains
	<<SF escan: escan data: TBP>>
	end type escan_data_t

	@ %def escan_data_t
	<<SF escan: escan data: TBP>>=
	procedure :: init => escan_data_init
	<<SF escan: procedures>>=
	subroutine escan_data_init (data, model, pdg_in, norm)
	class(escan_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), intent(in), optional :: norm
	real(default), dimension(2) :: m2
	integer :: i, j
	data%n_flv = pdg_array_get_length (pdg_in)
	allocate (data%flv_in (maxval (data%n_flv), 2))
	do i = 1, 2
	do j = 1, data%n_flv(i)
	call data%flv_in(j, i)%init (pdg_array_get (pdg_in(i), j), model)
	end do
	end do
	m2 = data%flv_in(1,:)%get_mass ()
	do i = 1, 2
	if (.not. any (nearly_equal (data%flv_in(1:data%n_flv(i),i)%get_mass (), m2(i)))) then
	call msg_fatal ("Energy scan: incoming particle mass must be uniform")
	end if
	end do
	if (present (norm)) data%norm = norm
	end subroutine escan_data_init

	@ %def escan_data_init
	@ Output
	<<SF escan: escan data: TBP>>=
	procedure :: write => escan_data_write
	<<SF escan: procedures>>=
	subroutine escan_data_write (data, unit, verbose)
	class(escan_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u, i, j
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "Energy-scan data:"
	write (u, "(3x,A)", advance="no") "prt_in = "
	do i = 1, 2
	if (i > 1) write (u, "(',',1x)", advance="no")
	do j = 1, data%n_flv(i)
	if (j > 1) write (u, "(':')", advance="no")
	write (u, "(A)", advance="no") char (data%flv_in(j,i)%get_name ())
	end do
	end do
	write (u, *)
	write (u, "(3x,A," // FMT_12 // ")") "norm =", data%norm
	end subroutine escan_data_write

	@ %def escan_data_write
	@ Kinematics is completely collinear, hence there is only one
	parameter for a pair spectrum.
	<<SF escan: escan data: TBP>>=
	procedure :: get_n_par => escan_data_get_n_par
	<<SF escan: procedures>>=
	function escan_data_get_n_par (data) result (n)
	class(escan_data_t), intent(in) :: data
	integer :: n
	n = 1
	end function escan_data_get_n_par

	@ %def escan_data_get_n_par
	@ Return the outgoing particles PDG codes. This is always the same as
	the incoming particle, where we use two indices for the two beams.
	<<SF escan: escan data: TBP>>=
	procedure :: get_pdg_out => escan_data_get_pdg_out
	<<SF escan: procedures>>=
	subroutine escan_data_get_pdg_out (data, pdg_out)
	class(escan_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer :: i, n
	n = 2
	do i = 1, n
	pdg_out(i) = data%flv_in(1:data%n_flv(i),i)%get_pdg ()
	end do
	end subroutine escan_data_get_pdg_out

	@ %def escan_data_get_pdg_out
	@ Allocate the interaction record.
	<<SF escan: escan data: TBP>>=
	procedure :: allocate_sf_int => escan_data_allocate_sf_int
	<<SF escan: procedures>>=
	subroutine escan_data_allocate_sf_int (data, sf_int)
	class(escan_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (escan_t :: sf_int)
	end subroutine escan_data_allocate_sf_int

	@ %def escan_data_allocate_sf_int
	@
	\subsection{The Energy-scan object}
	This is a spectrum, not a radiation. We create an interaction with
	two incoming and two outgoing particles, flavor, color, and helicity
	being carried through. $x$ nevertheless is only one-dimensional, as we
	are always using only one beam parameter.
	<<SF escan: types>>=
	type, extends (sf_int_t) :: escan_t
	type(escan_data_t), pointer :: data => null ()
	contains
	<<SF escan: escan: TBP>>
	end type escan_t

	@ %def escan_t
	@ Type string: for the energy scan this is just a dummy function.
	<<SF escan: escan: TBP>>=
	procedure :: type_string => escan_type_string
	<<SF escan: procedures>>=
	function escan_type_string (object) result (string)
	class(escan_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "Escan: energy scan"
	else
	string = "Escan: [undefined]"
	end if
	end function escan_type_string

	@ %def escan_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF escan: escan: TBP>>=
	procedure :: write => escan_write
	<<SF escan: procedures>>=
	subroutine escan_write (object, unit, testflag)
	class(escan_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "Energy scan data: [undefined]"
	end if
	end subroutine escan_write

	@ %def escan_write
	@
	<<SF escan: escan: TBP>>=
	procedure :: init => escan_init
	<<SF escan: procedures>>=
	subroutine escan_init (sf_int, data)
	class(escan_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(4) :: mask
	integer, dimension(4) :: hel_lock
	real(default), dimension(2) :: m2
	real(default), dimension(0) :: mr2
	type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
	type(polarization_t), target :: pol1, pol2
	type(polarization_iterator_t) :: it_hel1, it_hel2
	integer :: j1, j2
	select type (data)
	type is (escan_data_t)
	hel_lock = [3, 4, 1, 2]
	m2 = data%flv_in(1,:)%get_mass ()
	call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
	sf_int%data => data
	do j1 = 1, data%n_flv(1)
	call qn_fc(1)%init ( &
	flv = data%flv_in(j1,1), &
	col = color_from_flavor (data%flv_in(j1,1)))
	call qn_fc(3)%init ( &
	flv = data%flv_in(j1,1), &
	col = color_from_flavor (data%flv_in(j1,1)))
	call pol1%init_generic (data%flv_in(j1,1))
	do j2 = 1, data%n_flv(2)
	call qn_fc(2)%init ( &
	flv = data%flv_in(j2,2), &
	col = color_from_flavor (data%flv_in(j2,2)))
	call qn_fc(4)%init ( &
	flv = data%flv_in(j2,2), &
	col = color_from_flavor (data%flv_in(j2,2)))
	call pol2%init_generic (data%flv_in(j2,2))
	call it_hel1%init (pol1)
	do while (it_hel1%is_valid ())
	qn_hel(1) = it_hel1%get_quantum_numbers ()
	qn_hel(3) = it_hel1%get_quantum_numbers ()
	call it_hel2%init (pol2)
	do while (it_hel2%is_valid ())
	qn_hel(2) = it_hel2%get_quantum_numbers ()
	qn_hel(4) = it_hel2%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc
	call sf_int%add_state (qn)
	call it_hel2%advance ()
	end do
	call it_hel1%advance ()
	end do
	! call pol2%final ()
	end do
	! call pol1%final ()
	end do
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	call sf_int%freeze ()
	sf_int%status = SF_INITIAL
	end select
	end subroutine escan_init

	@ %def escan_init
	@
	\subsection{Kinematics}
	Set kinematics. We have a single parameter, but reduce both beams.
	The [[map]] flag is ignored.
	<<SF escan: escan: TBP>>=
	procedure :: complete_kinematics => escan_complete_kinematics
	<<SF escan: procedures>>=
	subroutine escan_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(escan_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default) :: sqrt_x
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	x = r
	xb= rb
	sqrt_x = sqrt (x(1))
	if (sqrt_x > 0) then
	f = 1 / (2 * sqrt_x)
	else
	f = 0
	sf_int%status = SF_FAILED_KINEMATICS
	return
	end if
	call sf_int%reduce_momenta ([sqrt_x, sqrt_x])
	end subroutine escan_complete_kinematics

	@ %def escan_complete_kinematics
	@ Recover $x$. The base procedure should return two momentum
	fractions for the two beams, while we have only one parameter. This
	is the product of the extracted momentum fractions.
	<<SF escan: escan: TBP>>=
	procedure :: recover_x => escan_recover_x
	<<SF escan: procedures>>=
	subroutine escan_recover_x (sf_int, x, xb, x_free)
	class(escan_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: xi, xib
	call sf_int%base_recover_x (xi, xib, x_free)
	x = product (xi)
	xb= 1 - x
	end subroutine escan_recover_x

	@ %def escan_recover_x
	@ Compute inverse kinematics.
	<<SF escan: escan: TBP>>=
	procedure :: inverse_kinematics => escan_inverse_kinematics
	<<SF escan: procedures>>=
	subroutine escan_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	class(escan_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	real(default) :: sqrt_x
	logical :: set_mom

	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	sqrt_x = sqrt (x(1))
	if (sqrt_x > 0) then
	f = 1 / (2 * sqrt_x)
	else
	f = 0
	sf_int%status = SF_FAILED_KINEMATICS
	return
	end if
	r = x
	rb = xb
	if (set_mom) then
	call sf_int%reduce_momenta ([sqrt_x, sqrt_x])
	end if
	end subroutine escan_inverse_kinematics

	@ %def escan_inverse_kinematics
	@
	\subsection{Energy scan application}
	Here, we insert the predefined norm.
	<<SF escan: escan: TBP>>=
	procedure :: apply => escan_apply
	<<SF escan: procedures>>=
	subroutine escan_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(escan_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	real(default) :: f
	associate (data => sf_int%data)
	f = data%norm
	end associate
	call sf_int%set_matrix_element (cmplx (f, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine escan_apply

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

	module sf_escan_ut
	use unit_tests
	use sf_escan_uti

	<<Standard module head>>

	<<SF escan: public test>>

	contains

	<<SF escan: test driver>>

	end module sf_escan_ut
	@ %def sf_escan_ut
	@
	<<[[sf_escan_uti.f90]]>>=
	<<File header>>

	module sf_escan_uti

	<<Use kinds>>
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use sf_aux
	use sf_base

	use sf_escan

	<<Standard module head>>

	<<SF escan: test declarations>>

	contains

	<<SF escan: tests>>

	end module sf_escan_uti
	@ %def sf_escan_ut
	@ API: driver for the unit tests below.
	<<SF escan: public test>>=
	public :: sf_escan_test
	<<SF escan: test driver>>=
	subroutine sf_escan_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF escan: execute tests>>
	end subroutine sf_escan_test

	@ %def sf_escan_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF escan: execute tests>>=
	call test (sf_escan_1, "sf_escan_1", &
	"structure function configuration", &
	u, results)
	<<SF escan: test declarations>>=
	public :: sf_escan_1
	<<SF escan: tests>>=
	subroutine sf_escan_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t), dimension(2) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_escan_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&energy-scan structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	allocate (escan_data_t :: data)
	select type (data)
	type is (escan_data_t)
	call data%init (model, pdg_in, norm = 2._default)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

	call model%final ()

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

	end subroutine sf_escan_1

	@ %def sf_escan_1
	g@
	\subsubsection{Probe the structure-function object}
	Active the beam event reader, generate an event.
	<<SF escan: execute tests>>=
	call test (sf_escan_2, "sf_escan_2", &
	"generate event", &
	u, results)
	<<SF escan: test declarations>>=
	public :: sf_escan_2
	<<SF escan: tests>>=
	subroutine sf_escan_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: x_free, f

	write (u, "(A)") "* Test output: sf_escan_2"
	write (u, "(A)") "* Purpose: initialize and display &
	&beam-events structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv(1)%init (ELECTRON, model)
	call flv(2)%init (-ELECTRON, model)
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	call reset_interaction_counter ()

	allocate (escan_data_t :: data)
	select type (data)
	type is (escan_data_t)
	call data%init (model, pdg_in)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Set dummy parameters and generate x"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.8
	rb = 1 - r
	x_free = 1

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

	write (u, "(A)")
	write (u, "(A)") "* Inverse kinematics"
	write (u, "(A)")

	call sf_int%recover_x (x, xb, x_free)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_escan_2

	@ %def sf_escan_2
	@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Gaussian beam spread}

	Instead of an analytic beam description, beam data may be provided in
	form of an event file. In its most simple form, the event file
	contains pairs of $x$ values, relative to nominal beam energies. More
	advanced formats may include polarization, etc. The current
	implementation carries beam polarization through, if specified.

	The code is very similar to the energy scan described above.

	However, we must include a file-handle manager for the beam-event
	files. Two different processes may access a given beam-event file at
	the same time (i.e., serially but alternating). Accessing an open
	file from two different units is non-standard and not supported by all
	compilers. Therefore, we keep a global registry of open files,
	associated units, and reference counts. The [[gaussian_t]] objects
	act as proxies to this registry.
	<<[[sf_gaussian.f90]]>>=
	<<File header>>

	module sf_gaussian

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_12
	use file_registries
	use diagnostics
	use lorentz
	use rng_base
	use pdg_arrays
	use model_data
	use flavors
	use quantum_numbers
	use state_matrices
	use polarizations
	use sf_base

	<<Standard module head>>

	<<SF gaussian: public>>

	<<SF gaussian: types>>

	contains

	<<SF gaussian: procedures>>

	end module sf_gaussian
	@ %def sf_gaussian
	@
	\subsection{The beam-data file registry}
	We manage data files via the [[file_registries]] module. To this end,
	we keep the registry as a private module variable here.
	<<CCC SF gaussian: variables>>=
	type(file_registry_t), save :: beam_file_registry

	@ %def beam_file_registry
	@
	\subsection{Data type}
	We store the spread for each beam, as a relative number related to the beam
	energy. For the actual generation, we include an (abstract) random-number
	generator factory.
	<<SF gaussian: public>>=
	public :: gaussian_data_t
	<<SF gaussian: types>>=
	type, extends(sf_data_t) :: gaussian_data_t
	private
	type(flavor_t), dimension(2) :: flv_in
	real(default), dimension(2) :: spread
	class(rng_factory_t), allocatable :: rng_factory
	contains
	<<SF gaussian: gaussian data: TBP>>
	end type gaussian_data_t

	@ %def gaussian_data_t
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: init => gaussian_data_init
	<<SF gaussian: procedures>>=
	subroutine gaussian_data_init (data, model, pdg_in, spread, rng_factory)
	class(gaussian_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), dimension(2), intent(in) :: spread
	class(rng_factory_t), intent(inout), allocatable :: rng_factory
	if (any (spread < 0)) then
	call msg_fatal ("Gaussian beam spread: must not be negative")
	end if
	call data%flv_in(1)%init (pdg_array_get (pdg_in(1), 1), model)
	call data%flv_in(2)%init (pdg_array_get (pdg_in(2), 1), model)
	data%spread = spread
	call move_alloc (from = rng_factory, to = data%rng_factory)
	end subroutine gaussian_data_init

	@ %def gaussian_data_init
	@ Return true since this spectrum is always in generator mode.
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: is_generator => gaussian_data_is_generator
	<<SF gaussian: procedures>>=
	function gaussian_data_is_generator (data) result (flag)
	class(gaussian_data_t), intent(in) :: data
	logical :: flag
	flag = .true.
	end function gaussian_data_is_generator

	@ %def gaussian_data_is_generator
	@ The number of parameters is two. They are free parameters.
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: get_n_par => gaussian_data_get_n_par
	<<SF gaussian: procedures>>=
	function gaussian_data_get_n_par (data) result (n)
	class(gaussian_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function gaussian_data_get_n_par

	@ %def gaussian_data_get_n_par
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: get_pdg_out => gaussian_data_get_pdg_out
	<<SF gaussian: procedures>>=
	subroutine gaussian_data_get_pdg_out (data, pdg_out)
	class(gaussian_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer :: i, n
	n = 2
	do i = 1, n
	pdg_out(i) = data%flv_in(i)%get_pdg ()
	end do
	end subroutine gaussian_data_get_pdg_out

	@ %def gaussian_data_get_pdg_out
	@ Allocate the interaction record.
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: allocate_sf_int => gaussian_data_allocate_sf_int
	<<SF gaussian: procedures>>=
	subroutine gaussian_data_allocate_sf_int (data, sf_int)
	class(gaussian_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (gaussian_t :: sf_int)
	end subroutine gaussian_data_allocate_sf_int

	@ %def gaussian_data_allocate_sf_int
	@ Output
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: write => gaussian_data_write
	<<SF gaussian: procedures>>=
	subroutine gaussian_data_write (data, unit, verbose)
	class(gaussian_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "Gaussian beam spread data:"
	write (u, "(3x,A,A,A,A)") "prt_in = ", &
	char (data%flv_in(1)%get_name ()), &
	", ", char (data%flv_in(2)%get_name ())
	write (u, "(3x,A,2(1x," // FMT_12 // "))") "spread =", data%spread
	call data%rng_factory%write (u)
	end subroutine gaussian_data_write

	@ %def gaussian_data_write
	@
	\subsection{The gaussian object}
	Flavor and polarization carried through, no radiated particles. The generator
	needs a random-number generator, obviously.
	<<SF gaussian: public>>=
	public :: gaussian_t
	<<SF gaussian: types>>=
	type, extends (sf_int_t) :: gaussian_t
	type(gaussian_data_t), pointer :: data => null ()
	class(rng_t), allocatable :: rng
	contains
	<<SF gaussian: gaussian: TBP>>
	end type gaussian_t

	@ %def gaussian_t
	@ Type string: show gaussian file.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: type_string => gaussian_type_string
	<<SF gaussian: procedures>>=
	function gaussian_type_string (object) result (string)
	class(gaussian_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "Gaussian: gaussian beam-energy spread"
	else
	string = "Gaussian: [undefined]"
	end if
	end function gaussian_type_string

	@ %def gaussian_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: write => gaussian_write
	<<SF gaussian: procedures>>=
	subroutine gaussian_write (object, unit, testflag)
	class(gaussian_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%rng%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "gaussian data: [undefined]"
	end if
	end subroutine gaussian_write

	@ %def gaussian_write
	@
	<<SF gaussian: gaussian: TBP>>=
	procedure :: init => gaussian_init
	<<SF gaussian: procedures>>=
	subroutine gaussian_init (sf_int, data)
	class(gaussian_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	real(default), dimension(2) :: m2
	real(default), dimension(0) :: mr2
	type(quantum_numbers_mask_t), dimension(4) :: mask
	integer, dimension(4) :: hel_lock
	type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
	type(polarization_t), target :: pol1, pol2
	type(polarization_iterator_t) :: it_hel1, it_hel2
	integer :: i
	select type (data)
	type is (gaussian_data_t)
	m2 = data%flv_in%get_mass () ** 2
	hel_lock = [3, 4, 1, 2]
	mask = quantum_numbers_mask (.false., .false., .false.)
	call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
	sf_int%data => data
	do i = 1, 2
	call qn_fc(i)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i)))
	call qn_fc(i+2)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i)))
	end do
	call pol1%init_generic (data%flv_in(1))
	call it_hel1%init (pol1)
	do while (it_hel1%is_valid ())
	qn_hel(1) = it_hel1%get_quantum_numbers ()
	qn_hel(3) = it_hel1%get_quantum_numbers ()
	call pol2%init_generic (data%flv_in(2))
	call it_hel2%init (pol2)
	do while (it_hel2%is_valid ())
	qn_hel(2) = it_hel2%get_quantum_numbers ()
	qn_hel(4) = it_hel2%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc
	call sf_int%add_state (qn)
	call it_hel2%advance ()
	end do
	! call pol2%final ()
	call it_hel1%advance ()
	end do
	! call pol1%final ()
	call sf_int%freeze ()
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	sf_int%status = SF_INITIAL
	end select
	call sf_int%data%rng_factory%make (sf_int%rng)
	end subroutine gaussian_init

	@ %def gaussian_init
	@ This spectrum type needs a finalizer, which closes the data file.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: final => sf_gaussian_final
	<<SF gaussian: procedures>>=
	subroutine sf_gaussian_final (object)
	class(gaussian_t), intent(inout) :: object
	call object%interaction_t%final ()
	end subroutine sf_gaussian_final

	@ %def sf_gaussian_final
	@
	\subsection{Kinematics}
	Refer to the [[data]] component.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: is_generator => gaussian_is_generator
	<<SF gaussian: procedures>>=
	function gaussian_is_generator (sf_int) result (flag)
	class(gaussian_t), intent(in) :: sf_int
	logical :: flag
	flag = sf_int%data%is_generator ()
	end function gaussian_is_generator

	@ %def gaussian_is_generator
	@ Generate free parameters. The $x$ value should be distributed with mean $1$
	and $\sigma$ given by the spread. We reject negative $x$ values. (This
	cut slightly biases the distribution, but for reasonable (small)
	spreads negative $r$ should not occur.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: generate_free => gaussian_generate_free
	<<SF gaussian: procedures>>=
	subroutine gaussian_generate_free (sf_int, r, rb, x_free)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	real(default), dimension(size(r)) :: z
	associate (data => sf_int%data)
	do
	call sf_int%rng%generate_gaussian (z)
	rb = z * data%spread
	r = 1 - rb
	x_free = x_free * product (r)
	if (all (r > 0)) exit
	end do
	end associate
	end subroutine gaussian_generate_free

	@ %def gaussian_generate_free
	@ Set kinematics. Trivial transfer since this is a pure generator.
	The [[map]] flag doesn't apply.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: complete_kinematics => gaussian_complete_kinematics
	<<SF gaussian: procedures>>=
	subroutine gaussian_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	call msg_fatal ("gaussian: map flag not supported")
	else
	x = r
	xb= rb
	f = 1
	end if
	call sf_int%reduce_momenta (x)
	end subroutine gaussian_complete_kinematics

	@ %def gaussian_complete_kinematics
	@ Compute inverse kinematics. Trivial in this case.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: inverse_kinematics => gaussian_inverse_kinematics
	<<SF gaussian: procedures>>=
	subroutine gaussian_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	call msg_fatal ("gaussian: map flag not supported")
	else
	r = x
	rb= xb
	f = 1
	end if
	if (set_mom) then
	call sf_int%reduce_momenta (x)
	end if
	end subroutine gaussian_inverse_kinematics

	@ %def gaussian_inverse_kinematics
	@
	\subsection{gaussian application}
	Trivial, just set the unit weight.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: apply => gaussian_apply
	<<SF gaussian: procedures>>=
	subroutine gaussian_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	real(default) :: f
	f = 1
	call sf_int%set_matrix_element (cmplx (f, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine gaussian_apply

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

	module sf_gaussian_ut
	use unit_tests
	use sf_gaussian_uti

	<<Standard module head>>

	<<SF gaussian: public test>>

	contains

	<<SF gaussian: test driver>>

	end module sf_gaussian_ut
	@ %def sf_gaussian_ut
	@
	<<[[sf_gaussian_uti.f90]]>>=
	<<File header>>

	module sf_gaussian_uti

	<<Use kinds>>
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use rng_base
	use sf_aux
	use sf_base

	use sf_gaussian

	use rng_base_ut, only: rng_test_factory_t

	<<Standard module head>>

	<<SF gaussian: test declarations>>

	contains

	<<SF gaussian: tests>>

	end module sf_gaussian_uti
	@ %def sf_gaussian_ut
	@ API: driver for the unit tests below.
	<<SF gaussian: public test>>=
	public :: sf_gaussian_test
	<<SF gaussian: test driver>>=
	subroutine sf_gaussian_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF gaussian: execute tests>>
	end subroutine sf_gaussian_test

	@ %def sf_gaussian_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF gaussian: execute tests>>=
	call test (sf_gaussian_1, "sf_gaussian_1", &
	"structure function configuration", &
	u, results)
	<<SF gaussian: test declarations>>=
	public :: sf_gaussian_1
	<<SF gaussian: tests>>=
	subroutine sf_gaussian_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t), dimension(2) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	class(sf_data_t), allocatable :: data
	class(rng_factory_t), allocatable :: rng_factory

	write (u, "(A)") "* Test output: sf_gaussian_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&gaussian-spread structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	allocate (gaussian_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)
	select type (data)
	type is (gaussian_data_t)
	call data%init (model, pdg_in, [1e-2_default, 2e-2_default], rng_factory)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

	call model%final ()

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

	end subroutine sf_gaussian_1

	@ %def sf_gaussian_1
	@
	\subsubsection{Probe the structure-function object}
	Active the beam event reader, generate an event.
	<<SF gaussian: execute tests>>=
	call test (sf_gaussian_2, "sf_gaussian_2", &
	"generate event", &
	u, results)
	<<SF gaussian: test declarations>>=
	public :: sf_gaussian_2
	<<SF gaussian: tests>>=
	subroutine sf_gaussian_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(rng_factory_t), allocatable :: rng_factory
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: x_free, f
	integer :: i

	write (u, "(A)") "* Test output: sf_gaussian_2"
	write (u, "(A)") "* Purpose: initialize and display &
	&gaussian-spread structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv(1)%init (ELECTRON, model)
	call flv(2)%init (-ELECTRON, model)
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	call reset_interaction_counter ()

	allocate (gaussian_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)
	select type (data)
	type is (gaussian_data_t)
	call data%init (model, pdg_in, [1e-2_default, 2e-2_default], rng_factory)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Set dummy parameters and generate x."
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 0
	x_free = 1
	call sf_int%generate_free (r, rb, x_free)
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call pacify (rb, 1.e-8_default)
	call pacify (xb, 1.e-8_default)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate more events"
	write (u, "(A)")

	select type (sf_int)
	type is (gaussian_t)
	do i = 1, 3
	call sf_int%generate_free (r, rb, x_free)
	write (u, "(A,9(1x,F10.7))") "r =", r
	end do
	end select

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_gaussian_2

	@ %def sf_gaussian_2
	@
	\clearpage
	@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Using beam event data}

	Instead of an analytic beam description, beam data may be provided in
	form of an event file. In its most simple form, the event file
	contains pairs of $x$ values, relative to nominal beam energies. More
	advanced formats may include polarization, etc. The current
	implementation carries beam polarization through, if specified.

	The code is very similar to the energy scan described above.

	However, we must include a file-handle manager for the beam-event
	files. Two different processes may access a given beam-event file at
	the same time (i.e., serially but alternating). Accessing an open
	file from two different units is non-standard and not supported by all
	compilers. Therefore, we keep a global registry of open files,
	associated units, and reference counts. The [[beam_events_t]] objects
	act as proxies to this registry.
	<<[[sf_beam_events.f90]]>>=
	<<File header>>

	module sf_beam_events

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use file_registries
	use diagnostics
	use lorentz
	use pdg_arrays
	use model_data
	use flavors
	use quantum_numbers
	use state_matrices
	use polarizations
	use sf_base

	<<Standard module head>>

	<<SF beam events: public>>

	<<SF beam events: types>>

	<<SF beam events: variables>>

	contains

	<<SF beam events: procedures>>

	end module sf_beam_events
	@ %def sf_beam_events
	@
	\subsection{The beam-data file registry}
	We manage data files via the [[file_registries]] module. To this end,
	we keep the registry as a private module variable here.

	This is public only for the unit tests.
	<<SF beam events: public>>=
	public :: beam_file_registry
	<<SF beam events: variables>>=
	type(file_registry_t), save :: beam_file_registry

	@ %def beam_file_registry
	@
	\subsection{Data type}
	<<SF beam events: public>>=
	public :: beam_events_data_t
	<<SF beam events: types>>=
	type, extends(sf_data_t) :: beam_events_data_t
	private
	type(flavor_t), dimension(2) :: flv_in
	type(string_t) :: dir
	type(string_t) :: file
	type(string_t) :: fqn
	integer :: unit = 0
	logical :: warn_eof = .true.
	contains
	<<SF beam events: beam events data: TBP>>
	end type beam_events_data_t

	@ %def beam_events_data_t
	<<SF beam events: beam events data: TBP>>=
	procedure :: init => beam_events_data_init
	<<SF beam events: procedures>>=
	subroutine beam_events_data_init (data, model, pdg_in, dir, file, warn_eof)
	class(beam_events_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	type(string_t), intent(in) :: dir
	type(string_t), intent(in) :: file
	logical, intent(in), optional :: warn_eof
	if (any (pdg_array_get_length (pdg_in) /= 1)) then
	call msg_fatal ("Beam events: incoming beam particles must be unique")
	end if
	call data%flv_in(1)%init (pdg_array_get (pdg_in(1), 1), model)
	call data%flv_in(2)%init (pdg_array_get (pdg_in(2), 1), model)
	data%dir = dir
	data%file = file
	if (present (warn_eof)) data%warn_eof = warn_eof
	end subroutine beam_events_data_init

	@ %def beam_events_data_init
	@ Return true since this spectrum is always in generator mode.
	<<SF beam events: beam events data: TBP>>=
	procedure :: is_generator => beam_events_data_is_generator
	<<SF beam events: procedures>>=
	function beam_events_data_is_generator (data) result (flag)
	class(beam_events_data_t), intent(in) :: data
	logical :: flag
	flag = .true.
	end function beam_events_data_is_generator

	@ %def beam_events_data_is_generator
	@ The number of parameters is two. They are free parameters.
	<<SF beam events: beam events data: TBP>>=
	procedure :: get_n_par => beam_events_data_get_n_par
	<<SF beam events: procedures>>=
	function beam_events_data_get_n_par (data) result (n)
	class(beam_events_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function beam_events_data_get_n_par

	@ %def beam_events_data_get_n_par
	<<SF beam events: beam events data: TBP>>=
	procedure :: get_pdg_out => beam_events_data_get_pdg_out
	<<SF beam events: procedures>>=
	subroutine beam_events_data_get_pdg_out (data, pdg_out)
	class(beam_events_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer :: i, n
	n = 2
	do i = 1, n
	pdg_out(i) = data%flv_in(i)%get_pdg ()
	end do
	end subroutine beam_events_data_get_pdg_out

	@ %def beam_events_data_get_pdg_out
	@ Allocate the interaction record.
	<<SF beam events: beam events data: TBP>>=
	procedure :: allocate_sf_int => beam_events_data_allocate_sf_int
	<<SF beam events: procedures>>=
	subroutine beam_events_data_allocate_sf_int (data, sf_int)
	class(beam_events_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (beam_events_t :: sf_int)
	end subroutine beam_events_data_allocate_sf_int

	@ %def beam_events_data_allocate_sf_int
	@ Output
	<<SF beam events: beam events data: TBP>>=
	procedure :: write => beam_events_data_write
	<<SF beam events: procedures>>=
	subroutine beam_events_data_write (data, unit, verbose)
	class(beam_events_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "Beam-event file data:"
	write (u, "(3x,A,A,A,A)") "prt_in = ", &
	char (data%flv_in(1)%get_name ()), &
	", ", char (data%flv_in(2)%get_name ())
	write (u, "(3x,A,A,A)") "file = '", char (data%file), "'"
	write (u, "(3x,A,I0)") "unit = ", data%unit
	write (u, "(3x,A,L1)") "warn = ", data%warn_eof
	end subroutine beam_events_data_write

	@ %def beam_events_data_write
	@ The data file needs to be opened and closed explicitly. The
	open/close message is communicated to the file handle registry, which
	does the actual work.

	We determine first whether to look in the local directory or in the
	given system directory.
	<<SF beam events: beam events data: TBP>>=
	procedure :: open => beam_events_data_open
	procedure :: close => beam_events_data_close
	<<SF beam events: procedures>>=
	subroutine beam_events_data_open (data)
	class(beam_events_data_t), intent(inout) :: data
	logical :: exist
	if (data%unit == 0) then
	data%fqn = data%file
	if (data%fqn == "") &
	call msg_fatal ("Beam events: $beam_events_file is not set")
	inquire (file = char (data%fqn), exist = exist)
	if (.not. exist) then
	data%fqn = data%dir // "/" // data%file
	inquire (file = char (data%fqn), exist = exist)
	if (.not. exist) then
	data%fqn = ""
	call msg_fatal ("Beam events: file '" &
	// char (data%file) // "' not found")
	return
	end if
	end if
	call msg_message ("Beam events: reading from file '" &
	// char (data%file) // "'")
	call beam_file_registry%open (data%fqn, data%unit)
	else
	call msg_bug ("Beam events: file '" &
	// char (data%file) // "' is already open")
	end if
	end subroutine beam_events_data_open

	subroutine beam_events_data_close (data)
	class(beam_events_data_t), intent(inout) :: data
	if (data%unit /= 0) then
	call beam_file_registry%close (data%fqn)
	call msg_message ("Beam events: closed file '" &
	// char (data%file) // "'")
	data%unit = 0
	end if
	end subroutine beam_events_data_close

	@ %def beam_events_data_close
	@ Return the beam event file.
	<<SF beam events: beam events data: TBP>>=
	procedure :: get_beam_file => beam_events_data_get_beam_file
	<<SF beam events: procedures>>=
	function beam_events_data_get_beam_file (data) result (file)
	class(beam_events_data_t), intent(in) :: data
	type(string_t) :: file
	file = "Beam events: " // data%file
	end function beam_events_data_get_beam_file

	@ %def beam_events_data_get_beam_file
	@
	\subsection{The beam events object}
	Flavor and polarization carried through, no radiated particles.
	<<SF beam events: public>>=
	public :: beam_events_t
	<<SF beam events: types>>=
	type, extends (sf_int_t) :: beam_events_t
	type(beam_events_data_t), pointer :: data => null ()
	integer :: count = 0
	contains
	<<SF beam events: beam events: TBP>>
	end type beam_events_t

	@ %def beam_events_t
	@ Type string: show beam events file.
	<<SF beam events: beam events: TBP>>=
	procedure :: type_string => beam_events_type_string
	<<SF beam events: procedures>>=
	function beam_events_type_string (object) result (string)
	class(beam_events_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "Beam events: " // object%data%file
	else
	string = "Beam events: [undefined]"
	end if
	end function beam_events_type_string

	@ %def beam_events_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF beam events: beam events: TBP>>=
	procedure :: write => beam_events_write
	<<SF beam events: procedures>>=
	subroutine beam_events_write (object, unit, testflag)
	class(beam_events_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "Beam events data: [undefined]"
	end if
	end subroutine beam_events_write

	@ %def beam_events_write
	@
	<<SF beam events: beam events: TBP>>=
	procedure :: init => beam_events_init
	<<SF beam events: procedures>>=
	subroutine beam_events_init (sf_int, data)
	class(beam_events_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	real(default), dimension(2) :: m2
	real(default), dimension(0) :: mr2
	type(quantum_numbers_mask_t), dimension(4) :: mask
	integer, dimension(4) :: hel_lock
	type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
	type(polarization_t), target :: pol1, pol2
	type(polarization_iterator_t) :: it_hel1, it_hel2
	integer :: i
	select type (data)
	type is (beam_events_data_t)
	m2 = data%flv_in%get_mass () ** 2
	hel_lock = [3, 4, 1, 2]
	mask = quantum_numbers_mask (.false., .false., .false.)
	call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
	sf_int%data => data
	do i = 1, 2
	call qn_fc(i)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i)))
	call qn_fc(i+2)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i)))
	end do
	call pol1%init_generic (data%flv_in(1))
	call it_hel1%init (pol1)
	do while (it_hel1%is_valid ())
	qn_hel(1) = it_hel1%get_quantum_numbers ()
	qn_hel(3) = it_hel1%get_quantum_numbers ()
	call pol2%init_generic (data%flv_in(2))
	call it_hel2%init (pol2)
	do while (it_hel2%is_valid ())
	qn_hel(2) = it_hel2%get_quantum_numbers ()
	qn_hel(4) = it_hel2%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc
	call sf_int%add_state (qn)
	call it_hel2%advance ()
	end do
	! call pol2%final ()
	call it_hel1%advance ()
	end do
	! call pol1%final ()
	call sf_int%freeze ()
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	call sf_int%data%open ()
	sf_int%status = SF_INITIAL
	end select
	end subroutine beam_events_init

	@ %def beam_events_init
	@ This spectrum type needs a finalizer, which closes the data file.
	<<SF beam events: beam events: TBP>>=
	procedure :: final => sf_beam_events_final
	<<SF beam events: procedures>>=
	subroutine sf_beam_events_final (object)
	class(beam_events_t), intent(inout) :: object
	call object%data%close ()
	call object%interaction_t%final ()
	end subroutine sf_beam_events_final

	@ %def sf_beam_events_final
	@
	\subsection{Kinematics}
	Refer to the [[data]] component.
	<<SF beam events: beam events: TBP>>=
	procedure :: is_generator => beam_events_is_generator
	<<SF beam events: procedures>>=
	function beam_events_is_generator (sf_int) result (flag)
	class(beam_events_t), intent(in) :: sf_int
	logical :: flag
	flag = sf_int%data%is_generator ()
	end function beam_events_is_generator

	@ %def beam_events_is_generator
	@ Generate free parameters. We read them from file.
	<<SF beam events: beam events: TBP>>=
	procedure :: generate_free => beam_events_generate_free
	<<SF beam events: procedures>>=
	recursive subroutine beam_events_generate_free (sf_int, r, rb, x_free)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	integer :: iostat
	associate (data => sf_int%data)
	if (data%unit /= 0) then
	read (data%unit, fmt=*, iostat=iostat) r
	if (iostat > 0) then
	write (msg_buffer, "(A,I0,A)") &
	"Beam events: I/O error after reading ", sf_int%count, &
	" events"
	call msg_fatal ()
	else if (iostat < 0) then
	if (sf_int%count == 0) then
	call msg_fatal ("Beam events: file is empty")
	else if (sf_int%data%warn_eof) then
	write (msg_buffer, "(A,I0,A)") &
	"Beam events: End of file after reading ", sf_int%count, &
	" events, rewinding"
	call msg_warning ()
	end if
	rewind (data%unit)
	sf_int%count = 0
	call sf_int%generate_free (r, rb, x_free)
	else
	sf_int%count = sf_int%count + 1
	rb = 1 - r
	x_free = x_free * product (r)
	end if
	else
	call msg_bug ("Beam events: file is not open for reading")
	end if
	end associate
	end subroutine beam_events_generate_free

	@ %def beam_events_generate_free
	@ Set kinematics. Trivial transfer since this is a pure generator.
	The [[map]] flag doesn't apply.
	<<SF beam events: beam events: TBP>>=
	procedure :: complete_kinematics => beam_events_complete_kinematics
	<<SF beam events: procedures>>=
	subroutine beam_events_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	call msg_fatal ("Beam events: map flag not supported")
	else
	x = r
	xb= rb
	f = 1
	end if
	call sf_int%reduce_momenta (x)
	end subroutine beam_events_complete_kinematics

	@ %def beam_events_complete_kinematics
	@ Compute inverse kinematics. Trivial in this case.
	<<SF beam events: beam events: TBP>>=
	procedure :: inverse_kinematics => beam_events_inverse_kinematics
	<<SF beam events: procedures>>=
	subroutine beam_events_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	call msg_fatal ("Beam events: map flag not supported")
	else
	r = x
	rb= xb
	f = 1
	end if
	if (set_mom) then
	call sf_int%reduce_momenta (x)
	end if
	end subroutine beam_events_inverse_kinematics

	@ %def beam_events_inverse_kinematics
	@
	\subsection{Beam events application}
	Trivial, just set the unit weight.
	<<SF beam events: beam events: TBP>>=
	procedure :: apply => beam_events_apply
	<<SF beam events: procedures>>=
	subroutine beam_events_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	real(default) :: f
	f = 1
	call sf_int%set_matrix_element (cmplx (f, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine beam_events_apply

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

	module sf_beam_events_ut
	use unit_tests
	use sf_beam_events_uti

	<<Standard module head>>

	<<SF beam events: public test>>

	contains

	<<SF beam events: test driver>>

	end module sf_beam_events_ut
	@ %def sf_beam_events_ut
	@
	<<[[sf_beam_events_uti.f90]]>>=
	<<File header>>

	module sf_beam_events_uti

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use sf_aux
	use sf_base

	use sf_beam_events

	<<Standard module head>>

	<<SF beam events: test declarations>>

	contains

	<<SF beam events: tests>>

	end module sf_beam_events_uti
	@ %def sf_beam_events_ut
	@ API: driver for the unit tests below.
	<<SF beam events: public test>>=
	public :: sf_beam_events_test
	<<SF beam events: test driver>>=
	subroutine sf_beam_events_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF beam events: execute tests>>
	end subroutine sf_beam_events_test

	@ %def sf_beam_events_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF beam events: execute tests>>=
	call test (sf_beam_events_1, "sf_beam_events_1", &
	"structure function configuration", &
	u, results)
	<<SF beam events: test declarations>>=
	public :: sf_beam_events_1
	<<SF beam events: tests>>=
	subroutine sf_beam_events_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t), dimension(2) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_beam_events_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&beam-events structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	allocate (beam_events_data_t :: data)
	select type (data)
	type is (beam_events_data_t)
	call data%init (model, pdg_in, var_str (""), var_str ("beam_events.dat"))
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

	call model%final ()

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

	end subroutine sf_beam_events_1

	@ %def sf_beam_events_1
	@
	\subsubsection{Probe the structure-function object}
	Active the beam event reader, generate an event.
	<<SF beam events: execute tests>>=
	call test (sf_beam_events_2, "sf_beam_events_2", &
	"generate event", &
	u, results)
	<<SF beam events: test declarations>>=
	public :: sf_beam_events_2
	<<SF beam events: tests>>=
	subroutine sf_beam_events_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: x_free, f
	integer :: i

	write (u, "(A)") "* Test output: sf_beam_events_2"
	write (u, "(A)") "* Purpose: initialize and display &
	&beam-events structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv(1)%init (ELECTRON, model)
	call flv(2)%init (-ELECTRON, model)
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	call reset_interaction_counter ()

	allocate (beam_events_data_t :: data)
	select type (data)
	type is (beam_events_data_t)
	call data%init (model, pdg_in, &
	var_str (""), var_str ("test_beam_events.dat"))
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Set dummy parameters and generate x."
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 0
	x_free = 1
	call sf_int%generate_free (r, rb, x_free)
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free
	select type (sf_int)
	type is (beam_events_t)
	write (u, "(A,1x,I0)") "count =", sf_int%count
	end select

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate more events, rewind"
	write (u, "(A)")

	select type (sf_int)
	type is (beam_events_t)
	do i = 1, 3
	call sf_int%generate_free (r, rb, x_free)
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,1x,I0)") "count =", sf_int%count
	end do
	end select

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_beam_events_2

	@ %def sf_beam_events_2
	@
	\subsubsection{Check the file handle registry}
	Open and close some files, checking the registry contents.
	<<SF beam events: execute tests>>=
	call test (sf_beam_events_3, "sf_beam_events_3", &
	"check registry", &
	u, results)
	<<SF beam events: test declarations>>=
	public :: sf_beam_events_3
	<<SF beam events: tests>>=
	subroutine sf_beam_events_3 (u)
	integer, intent(in) :: u
	integer :: u1

	write (u, "(A)") "* Test output: sf_beam_events_2"
	write (u, "(A)") "* Purpose: check file handle registry"
	write (u, "(A)")

	write (u, "(A)") "* Create some empty files"
	write (u, "(A)")

	u1 = free_unit ()
	open (u1, file = "sf_beam_events_f1.tmp", action="write", status="new")
	close (u1)
	open (u1, file = "sf_beam_events_f2.tmp", action="write", status="new")
	close (u1)
	open (u1, file = "sf_beam_events_f3.tmp", action="write", status="new")
	close (u1)

	write (u, "(A)") "* Empty registry"
	write (u, "(A)")

	call beam_file_registry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Insert three entries"
	write (u, "(A)")

	call beam_file_registry%open (var_str ("sf_beam_events_f3.tmp"))
	call beam_file_registry%open (var_str ("sf_beam_events_f2.tmp"))
	call beam_file_registry%open (var_str ("sf_beam_events_f1.tmp"))
	call beam_file_registry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Open a second channel"
	write (u, "(A)")

	call beam_file_registry%open (var_str ("sf_beam_events_f2.tmp"))
	call beam_file_registry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Close second entry twice"
	write (u, "(A)")

	call beam_file_registry%close (var_str ("sf_beam_events_f2.tmp"))
	call beam_file_registry%close (var_str ("sf_beam_events_f2.tmp"))
	call beam_file_registry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Close last entry"
	write (u, "(A)")

	call beam_file_registry%close (var_str ("sf_beam_events_f3.tmp"))
	call beam_file_registry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Close remaining entry"
	write (u, "(A)")

	call beam_file_registry%close (var_str ("sf_beam_events_f1.tmp"))
	call beam_file_registry%write (u)

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

	open (u1, file = "sf_beam_events_f1.tmp", action="write")
	close (u1, status = "delete")
	open (u1, file = "sf_beam_events_f2.tmp", action="write")
	close (u1, status = "delete")
	open (u1, file = "sf_beam_events_f3.tmp", action="write")
	close (u1, status = "delete")

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

	end subroutine sf_beam_events_3

	@ %def sf_beam_events_3
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{Lepton collider beamstrahlung: CIRCE1}

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

	module sf_circe1

	<<Use kinds>>
	use kinds, only: double
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_17, FMT_19
	use diagnostics
	use physics_defs, only: ELECTRON, PHOTON
	use lorentz
	use rng_base
	use pdg_arrays
	use model_data
	use flavors
	use colors
	use quantum_numbers
	use state_matrices
	use polarizations
	use sf_mappings
	use sf_base
	use circe1, circe1_rng_t => rng_type !NODEP!

	<<Standard module head>>

	<<SF circe1: public>>

	<<SF circe1: types>>

	contains

	<<SF circe1: procedures>>

	end module sf_circe1
	@ %def sf_circe1
	@
	\subsection{Physics}
	Beamstrahlung is applied before ISR. The [[CIRCE1]] implementation has
	a single structure function for both beams (which makes sense since it
	has to be switched on or off for both beams simultaneously).
	Nevertheless it is factorized:

	The functional form in the [[CIRCE1]] parameterization is defined for
	electrons or photons
	\begin{equation}
	f(x) = \alpha\,x^\beta\,(1-x)^\gamma
	\end{equation}
	for $x<1-\epsilon$ (resp.\ $x>\epsilon$ in the photon case). In the
	remaining interval, the standard form is zero, with a delta
	singularity at $x=1$ (resp.\ $x=0$). Equivalently, the delta part may be
	distributed uniformly among this interval. This latter form is
	implemented in the [[kirke]] version of the [[CIRCE1]] subroutines, and
	is used here.

	The parameter [[circe1\_eps]] sets the peak mapping of the [[CIRCE1]]
	structure function. Its default value is $10^{-5}$.
	The other parameters are the parameterization version and revision
	number, the accelerator type, and the $\sqrt{s}$ value used by
	[[CIRCE1]]. The chattiness can also be set.

	Since the energy is distributed in a narrow region around unity (for
	electrons) or zero (for photons), it is advantageous to map the
	interval first. The mapping is controlled by the parameter
	[[circe1\_epsilon]] which is taken from the [[CIRCE1]]
	internal data structure.

	The $\sqrt{s}$ value, if not explicitly set, is taken from the
	process data. Note that interpolating $\sqrt{s}$ is not recommended;
	one should rather choose one of the distinct values known to [[CIRCE1]].

	\subsection{The CIRCE1 data block}
	The CIRCE1 parameters are: The incoming flavors, the flags whether the photon
	or the lepton is the parton in the hard interaction, the flags for the
	generation mode (generator/mapping/no mapping), the mapping parameter
	$\epsilon$, $\sqrt{s}$ and several steering parameters: [[ver]],
	[[rev]], [[acc]], [[chat]].

	In generator mode, the $x$ values are actually discarded and a random number
	generator is used instead.
	<<SF circe1: public>>=
	public :: circe1_data_t
	<<SF circe1: types>>=
	type, extends (sf_data_t) :: circe1_data_t
	private
	class(model_data_t), pointer :: model => null ()
	type(flavor_t), dimension(2) :: flv_in
	integer, dimension(2) :: pdg_in
	real(default), dimension(2) :: m_in = 0
	logical, dimension(2) :: photon = .false.
	logical :: generate = .false.
	class(rng_factory_t), allocatable :: rng_factory
	real(default) :: sqrts = 0
	real(default) :: eps = 0
	integer :: ver = 0
	integer :: rev = 0
	character(6) :: acc = "?"
	integer :: chat = 0
	logical :: with_radiation = .false.
	contains
	<<SF circe1: circe1 data: TBP>>
	end type circe1_data_t

	@ %def circe1_data_t
	@
	<<SF circe1: circe1 data: TBP>>=
	procedure :: init => circe1_data_init
	<<SF circe1: procedures>>=
	subroutine circe1_data_init &
	(data, model, pdg_in, sqrts, eps, out_photon, &
	ver, rev, acc, chat, with_radiation)
	class(circe1_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), intent(in) :: sqrts
	real(default), intent(in) :: eps
	logical, dimension(2), intent(in) :: out_photon
	character(*), intent(in) :: acc
	integer, intent(in) :: ver, rev, chat
	logical, intent(in) :: with_radiation
	data%model => model
	if (any (pdg_array_get_length (pdg_in) /= 1)) then
	call msg_fatal ("CIRCE1: incoming beam particles must be unique")
	end if
	call data%flv_in(1)%init (pdg_array_get (pdg_in(1), 1), model)
	call data%flv_in(2)%init (pdg_array_get (pdg_in(2), 1), model)
	data%pdg_in = data%flv_in%get_pdg ()
	data%m_in = data%flv_in%get_mass ()
	data%sqrts = sqrts
	data%eps = eps
	data%photon = out_photon
	data%ver = ver
	data%rev = rev
	data%acc = acc
	data%chat = chat
	data%with_radiation = with_radiation
	call data%check ()
	call circex (0.d0, 0.d0, dble (data%sqrts), &
	data%acc, data%ver, data%rev, data%chat)
	end subroutine circe1_data_init

	@ %def circe1_data_init
	@ Activate the generator mode. We import a RNG factory into the data
	type, which can then spawn RNG generator objects.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: set_generator_mode => circe1_data_set_generator_mode
	<<SF circe1: procedures>>=
	subroutine circe1_data_set_generator_mode (data, rng_factory)
	class(circe1_data_t), intent(inout) :: data
	class(rng_factory_t), intent(inout), allocatable :: rng_factory
	data%generate = .true.
	call move_alloc (from = rng_factory, to = data%rng_factory)
	end subroutine circe1_data_set_generator_mode

	@ %def circe1_data_set_generator_mode
	@ Handle error conditions.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: check => circe1_data_check
	<<SF circe1: procedures>>=
	subroutine circe1_data_check (data)
	class(circe1_data_t), intent(in) :: data
	type(flavor_t) :: flv_electron, flv_photon
	call flv_electron%init (ELECTRON, data%model)
	call flv_photon%init (PHOTON, data%model)
	if (.not. flv_electron%is_defined () &
	.or. .not. flv_photon%is_defined ()) then
	call msg_fatal ("CIRCE1: model must contain photon and electron")
	end if
	if (any (abs (data%pdg_in) /= ELECTRON) &
	.or. (data%pdg_in(1) /= - data%pdg_in(2))) then
	call msg_fatal ("CIRCE1: applicable only for e+e- or e-e+ collisions")
	end if
	if (data%eps <= 0) then
	call msg_error ("CIRCE1: circe1_eps = 0: integration will &
	&miss x=1 peak")
	end if
	end subroutine circe1_data_check

	@ %def circe1_data_check
	@ Output
	<<SF circe1: circe1 data: TBP>>=
	procedure :: write => circe1_data_write
	<<SF circe1: procedures>>=
	subroutine circe1_data_write (data, unit, verbose)
	class(circe1_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "CIRCE1 data:"
	write (u, "(3x,A,2(1x,A))") "prt_in =", &
	char (data%flv_in(1)%get_name ()), &
	char (data%flv_in(2)%get_name ())
	write (u, "(3x,A,2(1x,L1))") "photon =", data%photon
	write (u, "(3x,A,L1)") "generate = ", data%generate
	write (u, "(3x,A,2(1x," // FMT_19 // "))") "m_in =", data%m_in
	write (u, "(3x,A," // FMT_19 // ")") "sqrts = ", data%sqrts
	write (u, "(3x,A," // FMT_19 // ")") "eps = ", data%eps
	write (u, "(3x,A,I0)") "ver = ", data%ver
	write (u, "(3x,A,I0)") "rev = ", data%rev
	write (u, "(3x,A,A)") "acc = ", data%acc
	write (u, "(3x,A,I0)") "chat = ", data%chat
	write (u, "(3x,A,L1)") "with rad.= ", data%with_radiation
	if (data%generate) call data%rng_factory%write (u)
	end subroutine circe1_data_write

	@ %def circe1_data_write
	@ Return true if this structure function is in generator mode. In
	that case, all parameters are free, otherwise bound. (We do not
	support mixed cases.) Default is: no generator.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: is_generator => circe1_data_is_generator
	<<SF circe1: procedures>>=
	function circe1_data_is_generator (data) result (flag)
	class(circe1_data_t), intent(in) :: data
	logical :: flag
	flag = data%generate
	end function circe1_data_is_generator

	@ %def circe1_data_is_generator
	@ The number of parameters is two, collinear splitting for the two beams.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: get_n_par => circe1_data_get_n_par
	<<SF circe1: procedures>>=
	function circe1_data_get_n_par (data) result (n)
	class(circe1_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function circe1_data_get_n_par

	@ %def circe1_data_get_n_par
	@ Return the outgoing particles PDG codes. This is either the incoming
	particle (if a photon is radiated), or the photon if that is the particle
	of the hard interaction. The latter is determined via the [[photon]]
	flag. There are two entries for the two beams.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: get_pdg_out => circe1_data_get_pdg_out
	<<SF circe1: procedures>>=
	subroutine circe1_data_get_pdg_out (data, pdg_out)
	class(circe1_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer :: i, n
	n = 2
	do i = 1, n
	if (data%photon(i)) then
	pdg_out(i) = PHOTON
	else
	pdg_out(i) = data%pdg_in(i)
	end if
	end do
	end subroutine circe1_data_get_pdg_out

	@ %def circe1_data_get_pdg_out
	@ This variant is not inherited, it returns integers.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: get_pdg_int => circe1_data_get_pdg_int
	<<SF circe1: procedures>>=
	function circe1_data_get_pdg_int (data) result (pdg)
	class(circe1_data_t), intent(in) :: data
	integer, dimension(2) :: pdg
	integer :: i
	do i = 1, 2
	if (data%photon(i)) then
	pdg(i) = PHOTON
	else
	pdg(i) = data%pdg_in(i)
	end if
	end do
	end function circe1_data_get_pdg_int

	@ %def circe1_data_get_pdg_int
	@ Allocate the interaction record.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: allocate_sf_int => circe1_data_allocate_sf_int
	<<SF circe1: procedures>>=
	subroutine circe1_data_allocate_sf_int (data, sf_int)
	class(circe1_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (circe1_t :: sf_int)
	end subroutine circe1_data_allocate_sf_int

	@ %def circe1_data_allocate_sf_int
	@ Return the accelerator type.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: get_beam_file => circe1_data_get_beam_file
	<<SF circe1: procedures>>=
	function circe1_data_get_beam_file (data) result (file)
	class(circe1_data_t), intent(in) :: data
	type(string_t) :: file
	file = "CIRCE1: " // data%acc
	end function circe1_data_get_beam_file

	@ %def circe1_data_get_beam_file
	@
	\subsection{Random Number Generator for CIRCE}
	The CIRCE implementation now supports a generic random-number
	generator object that allows for a local state as a component. To
	support this, we must extend the abstract type provided by CIRCE and
	delegate the generator call to the (also abstract) RNG used by WHIZARD.
	<<SF circe1: types>>=
	type, extends (circe1_rng_t) :: rng_obj_t
	class(rng_t), allocatable :: rng
	contains
	procedure :: generate => rng_obj_generate
	end type rng_obj_t

	@ %def rng_obj_t
	<<SF circe1: procedures>>=
	subroutine rng_obj_generate (rng_obj, u)
	class(rng_obj_t), intent(inout) :: rng_obj
	real(double), intent(out) :: u
	real(default) :: x
	call rng_obj%rng%generate (x)
	u = x
	end subroutine rng_obj_generate

	@ %def rng_obj_generate
	@
	\subsection{The CIRCE1 object}
	This is a $2\to 4$ interaction, where, depending on the parameters, any two of
	the four outgoing particles are connected to the hard interactions, the others
	are radiated. Knowing that all particles are colorless, we do not have to
	deal with color.

	The flavors are sorted such that the first two particles are the incoming
	leptons, the next two are the radiated particles, and the last two are the
	partons initiating the hard interaction.

	CIRCE1 does not support polarized beams explicitly. For simplicity, we
	nevertheless carry beam polarization through to the outgoing electrons and
	make the photons unpolarized.

	In the case that no radiated particle is kept (which actually is the
	default), polarization is always transferred to the electrons, too. If
	there is a recoil photon in the event, the radiated particles are 3
	and 4, respectively, and 5 and 6 are the outgoing ones (triggering the
	hard scattering process), while in the case of no radiation, the
	outgoing particles are 3 and 4, respectively. In the case of the
	electron being the radiated particle, helicity is not kept.
	<<SF circe1: public>>=
	public :: circe1_t
	<<SF circe1: types>>=
	type, extends (sf_int_t) :: circe1_t
	type(circe1_data_t), pointer :: data => null ()
	real(default), dimension(2) :: x = 0
	real(default), dimension(2) :: xb= 0
	real(default) :: f = 0
	logical, dimension(2) :: continuum = .true.
	logical, dimension(2) :: peak = .true.
	type(rng_obj_t) :: rng_obj
	contains
	<<SF circe1: circe1: TBP>>
	end type circe1_t

	@ %def circe1_t
	@ Type string: has to be here, but there is no string variable on which CIRCE1
	depends. Hence, a dummy routine.
	<<SF circe1: circe1: TBP>>=
	procedure :: type_string => circe1_type_string
	<<SF circe1: procedures>>=
	function circe1_type_string (object) result (string)
	class(circe1_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "CIRCE1: beamstrahlung"
	else
	string = "CIRCE1: [undefined]"
	end if
	end function circe1_type_string

	@ %def circe1_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF circe1: circe1: TBP>>=
	procedure :: write => circe1_write
	<<SF circe1: procedures>>=
	subroutine circe1_write (object, unit, testflag)
	class(circe1_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%data%generate) call object%rng_obj%rng%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(3x,A,2(1x," // FMT_17 // "))") "x =", object%x
	write (u, "(3x,A,2(1x," // FMT_17 // "))") "xb=", object%xb
	if (object%status >= SF_FAILED_EVALUATION) then
	write (u, "(3x,A,1x," // FMT_17 // ")") "f =", object%f
	end if
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "CIRCE1 data: [undefined]"
	end if
	end subroutine circe1_write

	@ %def circe1_write
	@
	<<SF circe1: circe1: TBP>>=
	procedure :: init => circe1_init
	<<SF circe1: procedures>>=
	subroutine circe1_init (sf_int, data)
	class(circe1_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	logical, dimension(6) :: mask_h
	type(quantum_numbers_mask_t), dimension(6) :: mask
	integer, dimension(6) :: hel_lock
	type(polarization_t), target :: pol1, pol2
	type(quantum_numbers_t), dimension(1) :: qn_fc1, qn_fc2
	type(flavor_t) :: flv_photon
	type(color_t) :: col0
	real(default), dimension(2) :: mi2, mr2, mo2
	type(quantum_numbers_t) :: qn_hel1, qn_hel2, qn_photon, qn1, qn2
	type(quantum_numbers_t), dimension(6) :: qn
	type(polarization_iterator_t) :: it_hel1, it_hel2
	hel_lock = 0
	mask_h = .false.
	select type (data)
	type is (circe1_data_t)
	mi2 = data%m_in**2
	if (data%with_radiation) then
	if (data%photon(1)) then
	hel_lock(1) = 3; hel_lock(3) = 1; mask_h(5) = .true.
	mr2(1) = mi2(1)
	mo2(1) = 0._default
	else
	hel_lock(1) = 5; hel_lock(5) = 1; mask_h(3) = .true.
	mr2(1) = 0._default
	mo2(1) = mi2(1)
	end if
	if (data%photon(2)) then
	hel_lock(2) = 4; hel_lock(4) = 2; mask_h(6) = .true.
	mr2(2) = mi2(2)
	mo2(2) = 0._default
	else
	hel_lock(2) = 6; hel_lock(6) = 2; mask_h(4) = .true.
	mr2(2) = 0._default
	mo2(2) = mi2(2)
	end if
	mask = quantum_numbers_mask (.false., .false., mask_h)
	call sf_int%base_init (mask, mi2, mr2, mo2, &
	hel_lock = hel_lock)
	sf_int%data => data
	call flv_photon%init (PHOTON, data%model)
	call col0%init ()
	call qn_photon%init (flv_photon, col0)
	call pol1%init_generic (data%flv_in(1))
	call qn_fc1(1)%init (flv = data%flv_in(1), col = col0)
	call pol2%init_generic (data%flv_in(2))
	call qn_fc2(1)%init (flv = data%flv_in(2), col = col0)
	call it_hel1%init (pol1)

	do while (it_hel1%is_valid ())
	qn_hel1 = it_hel1%get_quantum_numbers ()
	qn1 = qn_hel1 .merge. qn_fc1(1)
	qn(1) = qn1
	if (data%photon(1)) then
	qn(3) = qn1; qn(5) = qn_photon
	else
	qn(3) = qn_photon; qn(5) = qn1
	end if
	call it_hel2%init (pol2)
	do while (it_hel2%is_valid ())
	qn_hel2 = it_hel2%get_quantum_numbers ()
	qn2 = qn_hel2 .merge. qn_fc2(1)
	qn(2) = qn2
	if (data%photon(2)) then
	qn(4) = qn2; qn(6) = qn_photon
	else
	qn(4) = qn_photon; qn(6) = qn2
	end if
	call qn(3:4)%tag_radiated ()
	call sf_int%add_state (qn)
	call it_hel2%advance ()
	end do
	call it_hel1%advance ()
	end do
	! call pol1%final ()
	! call pol2%final ()
	call sf_int%freeze ()
	call sf_int%set_incoming ([1,2])
	call sf_int%set_radiated ([3,4])
	call sf_int%set_outgoing ([5,6])
	else
	if (data%photon(1)) then
	mask_h(3) = .true.
	mo2(1) = 0._default
	else
	hel_lock(1) = 3; hel_lock(3) = 1
	mo2(1) = mi2(1)
	end if
	if (data%photon(2)) then
	mask_h(4) = .true.
	mo2(2) = 0._default
	else
	hel_lock(2) = 4; hel_lock(4) = 2
	mo2(2) = mi2(2)
	end if
	mask = quantum_numbers_mask (.false., .false., mask_h)
	call sf_int%base_init (mask(1:4), mi2, [real(default) :: ], mo2, &
	hel_lock = hel_lock(1:4))
	sf_int%data => data
	call flv_photon%init (PHOTON, data%model)
	call col0%init ()
	call qn_photon%init (flv_photon, col0)
	call pol1%init_generic (data%flv_in(1))
	call qn_fc1(1)%init (flv = data%flv_in(1), col = col0)
	call pol2%init_generic (data%flv_in(2))
	call qn_fc2(1)%init (flv = data%flv_in(2), col = col0)
	call it_hel1%init (pol1)

	do while (it_hel1%is_valid ())
	qn_hel1 = it_hel1%get_quantum_numbers ()
	qn1 = qn_hel1 .merge. qn_fc1(1)
	qn(1) = qn1
	if (data%photon(1)) then
	qn(3) = qn_photon
	else
	qn(3) = qn1
	end if
	call it_hel2%init (pol2)
	do while (it_hel2%is_valid ())
	qn_hel2 = it_hel2%get_quantum_numbers ()
	qn2 = qn_hel2 .merge. qn_fc2(1)
	qn(2) = qn2
	if (data%photon(2)) then
	qn(4) = qn_photon
	else
	qn(4) = qn2
	end if
	call sf_int%add_state (qn(1:4))
	call it_hel2%advance ()
	end do
	call it_hel1%advance ()
	end do
	! call pol1%final ()
	! call pol2%final ()
	call sf_int%freeze ()
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	end if
	sf_int%status = SF_INITIAL
	end select
	if (sf_int%data%generate) then
	call sf_int%data%rng_factory%make (sf_int%rng_obj%rng)
	end if
	end subroutine circe1_init

	@ %def circe1_init
	@
	\subsection{Kinematics}
	Refer to the [[data]] component.
	<<SF circe1: circe1: TBP>>=
	procedure :: is_generator => circe1_is_generator
	<<SF circe1: procedures>>=
	function circe1_is_generator (sf_int) result (flag)
	class(circe1_t), intent(in) :: sf_int
	logical :: flag
	flag = sf_int%data%is_generator ()
	end function circe1_is_generator

	@ %def circe1_is_generator
	@ Generate free parameters, if generator mode is on. Otherwise, the
	parameters will be discarded.
	<<SF circe1: circe1: TBP>>=
	procedure :: generate_free => circe1_generate_free
	<<SF circe1: procedures>>=
	subroutine circe1_generate_free (sf_int, r, rb, x_free)
	class(circe1_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free

	if (sf_int%data%generate) then
	call circe_generate (r, sf_int%data%get_pdg_int (), sf_int%rng_obj)
	rb = 1 - r
	x_free = x_free * product (r)
	else
	r = 0
	rb= 1
	end if
	end subroutine circe1_generate_free

	@ %def circe1_generate_free
	@ Generator mode: depending on the particle codes, call one of the
	available [[girce]] generators. Illegal particle code combinations
	should have been caught during data initialization.
	<<SF circe1: procedures>>=
	subroutine circe_generate (x, pdg, rng_obj)
	real(default), dimension(2), intent(out) :: x
	integer, dimension(2), intent(in) :: pdg
	class(rng_obj_t), intent(inout) :: rng_obj
	real(double) :: xc1, xc2
	select case (abs (pdg(1)))
	case (ELECTRON)
	select case (abs (pdg(2)))
	case (ELECTRON)
	call gircee (xc1, xc2, rng_obj = rng_obj)
	case (PHOTON)
	call girceg (xc1, xc2, rng_obj = rng_obj)
	end select
	case (PHOTON)
	select case (abs (pdg(2)))
	case (ELECTRON)
	call girceg (xc2, xc1, rng_obj = rng_obj)
	case (PHOTON)
	call gircgg (xc1, xc2, rng_obj = rng_obj)
	end select
	end select
	x = [xc1, xc2]
	end subroutine circe_generate

	@ %def circe_generate
	@ Set kinematics. The $r$ values (either from integration or from the
	generator call above) are copied to $x$ unchanged, and $f$ is unity.
	We store the $x$ values, so we can use them for the evaluation later.
	<<SF circe1: circe1: TBP>>=
	procedure :: complete_kinematics => circe1_complete_kinematics
	<<SF circe1: procedures>>=
	subroutine circe1_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(circe1_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	x = r
	xb = rb
	sf_int%x = x
	sf_int%xb= xb
	f = 1
	if (sf_int%data%with_radiation) then
	call sf_int%split_momenta (x, xb)
	else
	call sf_int%reduce_momenta (x)
	end if
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end subroutine circe1_complete_kinematics

	@ %def circe1_complete_kinematics
	@ Compute inverse kinematics. In generator mode, the $r$ values are
	meaningless, but we copy them anyway.
	<<SF circe1: circe1: TBP>>=
	procedure :: inverse_kinematics => circe1_inverse_kinematics
	<<SF circe1: procedures>>=
	subroutine circe1_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	class(circe1_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	r = x
	rb = xb
	sf_int%x = x
	sf_int%xb= xb
	f = 1
	if (set_mom) then
	call sf_int%split_momenta (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine circe1_inverse_kinematics

	@ %def circe1_inverse_kinematics
	@
	\subsection{CIRCE1 application}
	CIRCE is applied for the two beams at once. We can safely assume that no
	structure functions are applied before this, so the incoming particles are
	on-shell electrons/positrons.

	The scale is ignored.
	<<SF circe1: circe1: TBP>>=
	procedure :: apply => circe1_apply
	<<SF circe1: procedures>>=
	subroutine circe1_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(circe1_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	real(default), dimension(2) :: xb
	real(double), dimension(2) :: xc
	real(double), parameter :: one = 1
	associate (data => sf_int%data)
	xc = sf_int%x
	xb = sf_int%xb
	if (data%generate) then
	sf_int%f = 1
	else
	sf_int%f = 0
	if (all (sf_int%continuum)) then
	sf_int%f = circe (xc(1), xc(2), data%pdg_in(1), data%pdg_in(2))
	end if
	if (sf_int%continuum(2) .and. sf_int%peak(1)) then
	sf_int%f = sf_int%f &
	+ circe (one, xc(2), data%pdg_in(1), data%pdg_in(2)) &
	* peak (xb(1), data%eps)
	end if
	if (sf_int%continuum(1) .and. sf_int%peak(2)) then
	sf_int%f = sf_int%f &
	+ circe (xc(1), one, data%pdg_in(1), data%pdg_in(2)) &
	* peak (xb(2), data%eps)
	end if
	if (all (sf_int%peak)) then
	sf_int%f = sf_int%f &
	+ circe (one, one, data%pdg_in(1), data%pdg_in(2)) &
	* peak (xb(1), data%eps) * peak (xb(2), data%eps)
	end if
	end if
	end associate
	call sf_int%set_matrix_element (cmplx (sf_int%f, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine circe1_apply

	@ %def circe1_apply
	@ This is a smeared delta peak at zero, as an endpoint singularity.
	We choose an exponentially decreasing function, starting at zero, with
	integral (from $0$ to $1$) $1-e^{-1/\epsilon}$. For small $\epsilon$,
	this reduces to one.
	<<SF circe1: procedures>>=
	function peak (x, eps) result (f)
	real(default), intent(in) :: x, eps
	real(default) :: f
	f = exp (-x / eps) / eps
	end function peak

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

	module sf_circe1_ut
	use unit_tests
	use sf_circe1_uti

	<<Standard module head>>

	<<SF circe1: public test>>

	contains

	<<SF circe1: test driver>>

	end module sf_circe1_ut
	@ %def sf_circe1_ut
	@
	<<[[sf_circe1_uti.f90]]>>=
	<<File header>>

	module sf_circe1_uti

	<<Use kinds>>
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use rng_base
	use sf_aux
	use sf_base

	use sf_circe1

	use rng_base_ut, only: rng_test_factory_t

	<<Standard module head>>

	<<SF circe1: test declarations>>

	contains

	<<SF circe1: tests>>

	end module sf_circe1_uti
	@ %def sf_circe1_ut
	@ API: driver for the unit tests below.
	<<SF circe1: public test>>=
	public :: sf_circe1_test
	<<SF circe1: test driver>>=
	subroutine sf_circe1_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF circe1: execute tests>>
	end subroutine sf_circe1_test

	@ %def sf_circe1_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF circe1: execute tests>>=
	call test (sf_circe1_1, "sf_circe1_1", &
	"structure function configuration", &
	u, results)
	<<SF circe1: test declarations>>=
	public :: sf_circe1_1
	<<SF circe1: tests>>=
	subroutine sf_circe1_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t), dimension(2) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_circe1_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&CIRCE structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	allocate (circe1_data_t :: data)
	call data%write (u)

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

	select type (data)
	type is (circe1_data_t)
	call data%init (model, pdg_in, &
	sqrts = 500._default, &
	eps = 1e-6_default, &
	out_photon = [.false., .false.], &
	ver = 0, &
	rev = 0, &
	acc = "SBAND", &
	chat = 0, &
	with_radiation = .true.)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

	call model%final ()

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

	end subroutine sf_circe1_1

	@ %def sf_circe1_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the PDF builtin
	structure function.
	<<SF circe1: execute tests>>=
	call test (sf_circe1_2, "sf_circe1_2", &
	"structure function instance", &
	u, results)
	<<SF circe1: test declarations>>=
	public :: sf_circe1_2
	<<SF circe1: tests>>=
	subroutine sf_circe1_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	type(vector4_t), dimension(4) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_circe1_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&circe1 structure function object"
	write (u, "(A)")

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

	call model%init_qed_test ()
	call flv(1)%init (ELECTRON, model)
	call flv(2)%init (-ELECTRON, model)
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	call reset_interaction_counter ()

	allocate (circe1_data_t :: data)
	select type (data)
	type is (circe1_data_t)
	call data%init (model, pdg_in, &
	sqrts = 500._default, &
	eps = 1e-6_default, &
	out_photon = [.false., .false.], &
	ver = 0, &
	rev = 0, &
	acc = "SBAND", &
	chat = 0, &
	with_radiation = .true.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.95,0.85."
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.9_default, 0.8_default]
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1, 2])

	call sf_int%seed_kinematics ([k1, k2])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

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

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_circe1_2

	@ %def sf_circe1_2
	@
	\subsubsection{Generator mode}
	Construct and evaluate a structure function object in generator mode.
	<<SF circe1: execute tests>>=
	call test (sf_circe1_3, "sf_circe1_3", &
	"generator mode", &
	u, results)
	<<SF circe1: test declarations>>=
	public :: sf_circe1_3
	<<SF circe1: tests>>=
	subroutine sf_circe1_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(rng_factory_t), allocatable :: rng_factory
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, x_free

	write (u, "(A)") "* Test output: sf_circe1_3"
	write (u, "(A)") "* Purpose: initialize and fill &
	&circe1 structure function object"
	write (u, "(A)")

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

	call model%init_qed_test ()
	call flv(1)%init (ELECTRON, model)
	call flv(2)%init (-ELECTRON, model)
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	call reset_interaction_counter ()

	allocate (circe1_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)
	select type (data)
	type is (circe1_data_t)
	call data%init (model, pdg_in, &
	sqrts = 500._default, &
	eps = 1e-6_default, &
	out_photon = [.false., .false.], &
	ver = 0, &
	rev = 0, &
	acc = "SBAND", &
	chat = 0, &
	with_radiation = .true.)
	call data%set_generator_mode (rng_factory)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])
	select type (sf_int)
	type is (circe1_t)
	call sf_int%rng_obj%rng%init (3)
	end select

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Generate x"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 0
	x_free = 1
	call sf_int%generate_free (r, rb, x_free)
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_circe1_3

	@ %def sf_circe1_3
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{Lepton Collider Beamstrahlung and Photon collider: CIRCE2}

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

	module sf_circe2

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_19
	use numeric_utils
	use diagnostics
	use os_interface
	use physics_defs, only: PHOTON, ELECTRON
	use lorentz
	use rng_base
	use selectors
	use pdg_arrays
	use model_data
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices
	use polarizations
	use sf_base
	use circe2, circe2_rng_t => rng_type !NODEP!

	<<Standard module head>>

	<<SF circe2: public>>

	<<SF circe2: types>>

	contains

	<<SF circe2: procedures>>

	end module sf_circe2
	@ %def sf_circe2
	@
	\subsection{Physics}
	[[CIRCE2]] describes photon spectra
	Beamstrahlung is applied before ISR. The [[CIRCE2]] implementation has
	a single structure function for both beams (which makes sense since it
	has to be switched on or off for both beams simultaneously).


	\subsection{The CIRCE2 data block}
	The CIRCE2 parameters are: file and collider specification, incoming
	(= outgoing) particles. The luminosity is returned by [[circe2_luminosity]].
	<<SF circe2: public>>=
	public :: circe2_data_t
	<<SF circe2: types>>=
	type, extends (sf_data_t) :: circe2_data_t
	private
	class(model_data_t), pointer :: model => null ()
	type(flavor_t), dimension(2) :: flv_in
	integer, dimension(2) :: pdg_in
	real(default) :: sqrts = 0
	logical :: polarized = .false.
	logical :: beams_polarized = .false.
	class(rng_factory_t), allocatable :: rng_factory
	type(string_t) :: filename
	type(string_t) :: file
	type(string_t) :: design
	real(default) :: lumi = 0
	real(default), dimension(4) :: lumi_hel_frac = 0
	integer, dimension(0:4) :: h1 = [0, -1, -1, 1, 1]
	integer, dimension(0:4) :: h2 = [0, -1, 1,-1, 1]
	integer :: error = 1
	contains
	<<SF circe2: circe2 data: TBP>>
	end type circe2_data_t

	@ %def circe2_data_t
	<<SF circe2: types>>=
	type(circe2_state) :: circe2_global_state

	@
	<<SF circe2: circe2 data: TBP>>=
	procedure :: init => circe2_data_init
	<<SF circe2: procedures>>=
	subroutine circe2_data_init (data, os_data, model, pdg_in, &
	sqrts, polarized, beam_pol, file, design)
	class(circe2_data_t), intent(out) :: data
	type(os_data_t), intent(in) :: os_data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), intent(in) :: sqrts
	logical, intent(in) :: polarized, beam_pol
	type(string_t), intent(in) :: file, design
	integer :: h
	data%model => model
	if (any (pdg_array_get_length (pdg_in) /= 1)) then
	call msg_fatal ("CIRCE2: incoming beam particles must be unique")
	end if
	call data%flv_in(1)%init (pdg_array_get (pdg_in(1), 1), model)
	call data%flv_in(2)%init (pdg_array_get (pdg_in(2), 1), model)
	data%pdg_in = data%flv_in%get_pdg ()
	data%sqrts = sqrts
	data%polarized = polarized
	data%beams_polarized = beam_pol
	data%filename = file
	data%design = design
	call data%check_file (os_data)
	call circe2_load (circe2_global_state, trim (char(data%file)), &
	trim (char(data%design)), data%sqrts, data%error)
	call data%check ()
	data%lumi = circe2_luminosity (circe2_global_state, data%pdg_in, [0, 0])
	if (vanishes (data%lumi)) then
	call msg_fatal ("CIRCE2: luminosity vanishes for specified beams.")
	end if
	if (data%polarized) then
	do h = 1, 4
	data%lumi_hel_frac(h) = &
	circe2_luminosity (circe2_global_state, data%pdg_in, &
	[data%h1(h), data%h2(h)]) &
	/ data%lumi
	end do
	end if
	end subroutine circe2_data_init

	@ %def circe2_data_init
	@ Activate the generator mode. We import a RNG factory into the data
	type, which can then spawn RNG generator objects.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: set_generator_mode => circe2_data_set_generator_mode
	<<SF circe2: procedures>>=
	subroutine circe2_data_set_generator_mode (data, rng_factory)
	class(circe2_data_t), intent(inout) :: data
	class(rng_factory_t), intent(inout), allocatable :: rng_factory
	call move_alloc (from = rng_factory, to = data%rng_factory)
	end subroutine circe2_data_set_generator_mode

	@ %def circe2_data_set_generator_mode
	@ Check whether the requested data file is in the system directory or
	in the current directory.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: check_file => circe2_check_file
	<<SF circe2: procedures>>=
	subroutine circe2_check_file (data, os_data)
	class(circe2_data_t), intent(inout) :: data
	type(os_data_t), intent(in) :: os_data
	logical :: exist
	type(string_t) :: file
	file = data%filename
	if (file == "") &
	call msg_fatal ("CIRCE2: $circe2_file is not set")
	inquire (file = char (file), exist = exist)
	if (exist) then
	data%file = file
	else
	file = os_data%whizard_circe2path // "/" // data%filename
	inquire (file = char (file), exist = exist)
	if (exist) then
	data%file = file
	else
	call msg_fatal ("CIRCE2: data file '" // char (data%filename) &
	// "' not found")
	end if
	end if
	end subroutine circe2_check_file

	@ %def circe2_check_file
	@ Handle error conditions.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: check => circe2_data_check
	<<SF circe2: procedures>>=
	subroutine circe2_data_check (data)
	class(circe2_data_t), intent(in) :: data
	type(flavor_t) :: flv_photon, flv_electron
	call flv_photon%init (PHOTON, data%model)
	if (.not. flv_photon%is_defined ()) then
	call msg_fatal ("CIRCE2: model must contain photon")
	end if
	call flv_electron%init (ELECTRON, data%model)
	if (.not. flv_electron%is_defined ()) then
	call msg_fatal ("CIRCE2: model must contain electron")
	end if
	if (any (abs (data%pdg_in) /= PHOTON .and. abs (data%pdg_in) /= ELECTRON)) &
	then
	call msg_fatal ("CIRCE2: applicable only for e+e- or photon collisions")
	end if
	select case (data%error)
	case (-1)
	call msg_fatal ("CIRCE2: data file not found.")
	case (-2)
	call msg_fatal ("CIRCE2: beam setup does not match data file.")
	case (-3)
	call msg_fatal ("CIRCE2: invalid format of data file.")
	case (-4)
	call msg_fatal ("CIRCE2: data file too large.")
	end select
	end subroutine circe2_data_check

	@ %def circe2_data_check
	@ Output
	<<SF circe2: circe2 data: TBP>>=
	procedure :: write => circe2_data_write
	<<SF circe2: procedures>>=
	subroutine circe2_data_write (data, unit, verbose)
	class(circe2_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u, h
	u = given_output_unit (unit)
	write (u, "(1x,A)") "CIRCE2 data:"
	write (u, "(3x,A,A)") "file = ", char(data%filename)
	write (u, "(3x,A,A)") "design = ", char(data%design)
	write (u, "(3x,A," // FMT_19 // ")") "sqrts = ", data%sqrts
	write (u, "(3x,A,A,A,A)") "prt_in = ", &
	char (data%flv_in(1)%get_name ()), &
	", ", char (data%flv_in(2)%get_name ())
	write (u, "(3x,A,L1)") "polarized = ", data%polarized
	write (u, "(3x,A,L1)") "beams pol. = ", data%beams_polarized
	write (u, "(3x,A," // FMT_19 // ")") "luminosity = ", data%lumi
	if (data%polarized) then
	do h = 1, 4
	write (u, "(6x,'(',I2,1x,I2,')',1x,'=',1x)", advance="no") &
	data%h1(h), data%h2(h)
	write (u, "(6x, " // FMT_19 // ")") data%lumi_hel_frac(h)
	end do
	end if
	call data%rng_factory%write (u)
	end subroutine circe2_data_write

	@ %def circe2_data_write
	@ This is always in generator mode.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: is_generator => circe2_data_is_generator
	<<SF circe2: procedures>>=
	function circe2_data_is_generator (data) result (flag)
	class(circe2_data_t), intent(in) :: data
	logical :: flag
	flag = .true.
	end function circe2_data_is_generator

	@ %def circe2_data_is_generator
	@ The number of parameters is two, collinear splitting for
	the two beams.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: get_n_par => circe2_data_get_n_par
	<<SF circe2: procedures>>=
	function circe2_data_get_n_par (data) result (n)
	class(circe2_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function circe2_data_get_n_par

	@ %def circe2_data_get_n_par
	@ Return the outgoing particles PDG codes. They are equal to the
	incoming ones.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: get_pdg_out => circe2_data_get_pdg_out
	<<SF circe2: procedures>>=
	subroutine circe2_data_get_pdg_out (data, pdg_out)
	class(circe2_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer :: i, n
	n = 2
	do i = 1, n
	pdg_out(i) = data%pdg_in(i)
	end do
	end subroutine circe2_data_get_pdg_out

	@ %def circe2_data_get_pdg_out
	@ Allocate the interaction record.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: allocate_sf_int => circe2_data_allocate_sf_int
	<<SF circe2: procedures>>=
	subroutine circe2_data_allocate_sf_int (data, sf_int)
	class(circe2_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (circe2_t :: sf_int)
	end subroutine circe2_data_allocate_sf_int

	@ %def circe2_data_allocate_sf_int
	@ Return the beam file.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: get_beam_file => circe2_data_get_beam_file
	<<SF circe2: procedures>>=
	function circe2_data_get_beam_file (data) result (file)
	class(circe2_data_t), intent(in) :: data
	type(string_t) :: file
	file = "CIRCE2: " // data%filename
	end function circe2_data_get_beam_file

	@ %def circe2_data_get_beam_file
	@
	\subsection{Random Number Generator for CIRCE}
	The CIRCE implementation now supports a generic random-number
	generator object that allows for a local state as a component. To
	support this, we must extend the abstract type provided by CIRCE and
	delegate the generator call to the (also abstract) RNG used by WHIZARD.
	<<SF circe2: types>>=
	type, extends (circe2_rng_t) :: rng_obj_t
	class(rng_t), allocatable :: rng
	contains
	procedure :: generate => rng_obj_generate
	end type rng_obj_t

	@ %def rng_obj_t
	<<SF circe2: procedures>>=
	subroutine rng_obj_generate (rng_obj, u)
	class(rng_obj_t), intent(inout) :: rng_obj
	real(default), intent(out) :: u
	real(default) :: x
	call rng_obj%rng%generate (x)
	u = x
	end subroutine rng_obj_generate

	@ %def rng_obj_generate
	@
	\subsection{The CIRCE2 object}
	For CIRCE2 spectra it does not make sense to describe the state matrix
	as a radiation interaction, even if photons originate from laser
	backscattering. Instead, it is a $2\to 2$ interaction where the
	incoming particles are identical to the outgoing ones.

	The current implementation of CIRCE2 does support polarization and
	classical correlations, but no entanglement, so the density matrix of
	the outgoing particles is diagonal. The incoming particles are
	unpolarized (user-defined polarization for beams is meaningless, since
	polarization is described by the data file). The outgoing particles
	are polarized or polarization-averaged, depending on user request.

	When assigning matrix elements, we scan the previously initialized
	state matrix. For each entry, we extract helicity and call the
	structure function. In the unpolarized case, the helicity is
	undefined and replaced by value zero. In the polarized case, there
	are four entries. If the generator is used, only one entry is nonzero
	in each call. Which one, is determined by comparing with a previously
	(randomly, distributed by relative luminosity) selected pair of
	helicities.
	<<SF circe2: public>>=
	public :: circe2_t
	<<SF circe2: types>>=
	type, extends (sf_int_t) :: circe2_t
	type(circe2_data_t), pointer :: data => null ()
	type(rng_obj_t) :: rng_obj
	type(selector_t) :: selector
	integer :: h_sel = 0
	contains
	<<SF circe2: circe2: TBP>>
	end type circe2_t

	@ %def circe2_t
	@ Type string: show file and design of [[CIRCE2]] structure function.
	<<SF circe2: circe2: TBP>>=
	procedure :: type_string => circe2_type_string
	<<SF circe2: procedures>>=
	function circe2_type_string (object) result (string)
	class(circe2_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "CIRCE2: " // object%data%design
	else
	string = "CIRCE2: [undefined]"
	end if
	end function circe2_type_string

	@ %def circe2_type_string
	@
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF circe2: circe2: TBP>>=
	procedure :: write => circe2_write
	<<SF circe2: procedures>>=
	subroutine circe2_write (object, unit, testflag)
	class(circe2_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "CIRCE2 data: [undefined]"
	end if
	end subroutine circe2_write

	@ %def circe2_write
	@
	<<SF circe2: circe2: TBP>>=
	procedure :: init => circe2_init
	<<SF circe2: procedures>>=
	subroutine circe2_init (sf_int, data)
	class(circe2_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	logical, dimension(4) :: mask_h
	real(default), dimension(0) :: null_array
	type(quantum_numbers_mask_t), dimension(4) :: mask
	type(quantum_numbers_t), dimension(4) :: qn
	type(helicity_t) :: hel
	type(color_t) :: col0
	integer :: h
	select type (data)
	type is (circe2_data_t)
	if (data%polarized .and. data%beams_polarized) then
	call msg_fatal ("CIRCE2: Beam polarization can't be set &
	&for polarized data file")
	else if (data%beams_polarized) then
	call msg_warning ("CIRCE2: User-defined beam polarization set &
	&for unpolarized CIRCE2 data file")
	end if
	mask_h(1:2) = .not. data%beams_polarized
	mask_h(3:4) = .not. (data%polarized .or. data%beams_polarized)
	mask = quantum_numbers_mask (.false., .false., mask_h)
	call sf_int%base_init (mask, [0._default, 0._default], &
	null_array, [0._default, 0._default])
	sf_int%data => data
	if (data%polarized) then
	if (vanishes (sum (data%lumi_hel_frac)) .or. &
	any (data%lumi_hel_frac < 0)) then
	call msg_fatal ("CIRCE2: Helicity-dependent lumi " &
	// "fractions all vanish or", &
	[var_str ("are negative: Please inspect the " &
	// "CIRCE2 file or "), &
	var_str ("switch off the polarized" // &
	" option for CIRCE2.")])
	else
	call sf_int%selector%init (data%lumi_hel_frac)
	end if
	end if
	call col0%init ()
	if (data%beams_polarized) then
	do h = 1, 4
	call hel%init (data%h1(h))
	call qn(1)%init &
	(flv = data%flv_in(1), col = col0, hel = hel)
	call qn(3)%init &
	(flv = data%flv_in(1), col = col0, hel = hel)
	call hel%init (data%h2(h))
	call qn(2)%init &
	(flv = data%flv_in(2), col = col0, hel = hel)
	call qn(4)%init &
	(flv = data%flv_in(2), col = col0, hel = hel)
	call sf_int%add_state (qn)
	end do
	else if (data%polarized) then
	call qn(1)%init (flv = data%flv_in(1), col = col0)
	call qn(2)%init (flv = data%flv_in(2), col = col0)
	do h = 1, 4
	call hel%init (data%h1(h))
	call qn(3)%init &
	(flv = data%flv_in(1), col = col0, hel = hel)
	call hel%init (data%h2(h))
	call qn(4)%init &
	(flv = data%flv_in(2), col = col0, hel = hel)
	call sf_int%add_state (qn)
	end do
	else
	call qn(1)%init (flv = data%flv_in(1), col = col0)
	call qn(2)%init (flv = data%flv_in(2), col = col0)
	call qn(3)%init (flv = data%flv_in(1), col = col0)
	call qn(4)%init (flv = data%flv_in(2), col = col0)
	call sf_int%add_state (qn)
	end if
	call sf_int%freeze ()
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	call sf_int%data%rng_factory%make (sf_int%rng_obj%rng)
	sf_int%status = SF_INITIAL
	end select
	end subroutine circe2_init

	@ %def circe2_init
	@
	\subsection{Kinematics}
	Refer to the [[data]] component.
	<<SF circe2: circe2: TBP>>=
	procedure :: is_generator => circe2_is_generator
	<<SF circe2: procedures>>=
	function circe2_is_generator (sf_int) result (flag)
	class(circe2_t), intent(in) :: sf_int
	logical :: flag
	flag = sf_int%data%is_generator ()
	end function circe2_is_generator

	@ %def circe2_is_generator
	@ Generate free parameters. We first select a helicity, which we have
	to store, then generate $x$ values for that helicity.
	<<SF circe2: circe2: TBP>>=
	procedure :: generate_free => circe2_generate_whizard_free
	<<SF circe2: procedures>>=
	subroutine circe2_generate_whizard_free (sf_int, r, rb, x_free)
	class(circe2_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	integer :: h_sel
	if (sf_int%data%polarized) then
	call sf_int%selector%generate (sf_int%rng_obj%rng, h_sel)
	else
	h_sel = 0
	end if
	sf_int%h_sel = h_sel
	call circe2_generate_whizard (r, sf_int%data%pdg_in, &
	[sf_int%data%h1(h_sel), sf_int%data%h2(h_sel)], &
	sf_int%rng_obj)
	rb = 1 - r
	x_free = x_free * product (r)
	end subroutine circe2_generate_whizard_free

	@ %def circe2_generate_whizard_free
	@ Generator mode: call the CIRCE2 generator for the given particles
	and helicities. (For unpolarized generation, helicities are zero.)
	<<SF circe2: procedures>>=
	subroutine circe2_generate_whizard (x, pdg, hel, rng_obj)
	real(default), dimension(2), intent(out) :: x
	integer, dimension(2), intent(in) :: pdg
	integer, dimension(2), intent(in) :: hel
	class(rng_obj_t), intent(inout) :: rng_obj
	call circe2_generate (circe2_global_state, rng_obj, x, pdg, hel)
	end subroutine circe2_generate_whizard

	@ %def circe2_generate_whizard
	@ Set kinematics. Trivial here.
	<<SF circe2: circe2: TBP>>=
	procedure :: complete_kinematics => circe2_complete_kinematics
	<<SF circe2: procedures>>=
	subroutine circe2_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(circe2_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	call msg_fatal ("CIRCE2: map flag not supported")
	else
	x = r
	xb= rb
	f = 1
	end if
	call sf_int%reduce_momenta (x)
	end subroutine circe2_complete_kinematics

	@ %def circe2_complete_kinematics
	@ Compute inverse kinematics.
	<<SF circe2: circe2: TBP>>=
	procedure :: inverse_kinematics => circe2_inverse_kinematics
	<<SF circe2: procedures>>=
	subroutine circe2_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	class(circe2_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	call msg_fatal ("CIRCE2: map flag not supported")
	else
	r = x
	rb= xb
	f = 1
	end if
	if (set_mom) then
	call sf_int%reduce_momenta (x)
	end if
	end subroutine circe2_inverse_kinematics

	@ %def circe2_inverse_kinematics
	@
	\subsection{CIRCE2 application}
	This function works on both beams. In polarized mode, we set only the
	selected helicity. In unpolarized mode,
	the interaction has only one entry, and the factor is unity.
	<<SF circe2: circe2: TBP>>=
	procedure :: apply => circe2_apply
	<<SF circe2: procedures>>=
	subroutine circe2_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(circe2_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	complex(default) :: f
	associate (data => sf_int%data)
	f = 1
	if (data%beams_polarized) then
	call sf_int%set_matrix_element (f)
	else if (data%polarized) then
	call sf_int%set_matrix_element (sf_int%h_sel, f)
	else
	call sf_int%set_matrix_element (1, f)
	end if
	end associate
	sf_int%status = SF_EVALUATED
	end subroutine circe2_apply

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

	module sf_circe2_ut
	use unit_tests
	use sf_circe2_uti

	<<Standard module head>>

	<<SF circe2: public test>>

	contains

	<<SF circe2: test driver>>

	end module sf_circe2_ut
	@ %def sf_circe2_ut
	@
	<<[[sf_circe2_uti.f90]]>>=
	<<File header>>

	module sf_circe2_uti

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use physics_defs, only: PHOTON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use rng_base
	use sf_aux
	use sf_base

	use sf_circe2

	use rng_base_ut, only: rng_test_factory_t

	<<Standard module head>>

	<<SF circe2: test declarations>>

	contains

	<<SF circe2: tests>>

	end module sf_circe2_uti
	@ %def sf_circe2_ut
	@ API: driver for the unit tests below.
	<<SF circe2: public test>>=
	public :: sf_circe2_test
	<<SF circe2: test driver>>=
	subroutine sf_circe2_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF circe2: execute tests>>
	end subroutine sf_circe2_test

	@ %def sf_circe2_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF circe2: execute tests>>=
	call test (sf_circe2_1, "sf_circe2_1", &
	"structure function configuration", &
	u, results)
	<<SF circe2: test declarations>>=
	public :: sf_circe2_1
	<<SF circe2: tests>>=
	subroutine sf_circe2_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(pdg_array_t), dimension(2) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	class(sf_data_t), allocatable :: data
	class(rng_factory_t), allocatable :: rng_factory

	write (u, "(A)") "* Test output: sf_circe2_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&CIRCE structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call os_data%init ()
	call model%init_qed_test ()
	pdg_in(1) = PHOTON
	pdg_in(2) = PHOTON

	allocate (circe2_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)

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

	select type (data)
	type is (circe2_data_t)
	call data%init (os_data, model, pdg_in, &
	sqrts = 500._default, &
	polarized = .false., &
	beam_pol = .false., &
	file = var_str ("teslagg_500_polavg.circe"), &
	design = var_str ("TESLA/GG"))
	call data%set_generator_mode (rng_factory)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

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

	allocate (rng_test_factory_t :: rng_factory)

	select type (data)
	type is (circe2_data_t)
	call data%init (os_data, model, pdg_in, &
	sqrts = 500._default, &
	polarized = .true., &
	beam_pol = .false., &
	file = var_str ("teslagg_500.circe"), &
	design = var_str ("TESLA/GG"))
	call data%set_generator_mode (rng_factory)
	end select

	call data%write (u)

	call model%final ()

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

	end subroutine sf_circe2_1

	@ %def sf_circe2_1
	@
	\subsubsection{Generator mode, unpolarized}
	Construct and evaluate a structure function object in generator mode.
	<<SF circe2: execute tests>>=
	call test (sf_circe2_2, "sf_circe2_2", &
	"generator, unpolarized", &
	u, results)
	<<SF circe2: test declarations>>=
	public :: sf_circe2_2
	<<SF circe2: tests>>=
	subroutine sf_circe2_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(rng_factory_t), allocatable :: rng_factory
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, x_free

	write (u, "(A)") "* Test output: sf_circe2_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&circe2 structure function object"
	write (u, "(A)")

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

	call os_data%init ()
	call model%init_qed_test ()
	call flv(1)%init (PHOTON, model)
	call flv(2)%init (PHOTON, model)
	pdg_in(1) = PHOTON
	pdg_in(2) = PHOTON

	call reset_interaction_counter ()

	allocate (circe2_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)
	select type (data)
	type is (circe2_data_t)
	call data%init (os_data, model, pdg_in, &
	sqrts = 500._default, &
	polarized = .false., &
	beam_pol = .false., &
	file = var_str ("teslagg_500_polavg.circe"), &
	design = var_str ("TESLA/GG"))
	call data%set_generator_mode (rng_factory)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])
	select type (sf_int)
	type is (circe2_t)
	call sf_int%rng_obj%rng%init (3)
	end select

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Generate x"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 0
	x_free = 1
	call sf_int%generate_free (r, rb, x_free)
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_circe2_2

	@ %def sf_circe2_2
	@
	\subsubsection{Generator mode, polarized}
	Construct and evaluate a structure function object in generator mode.
	<<SF circe2: execute tests>>=
	call test (sf_circe2_3, "sf_circe2_3", &
	"generator, polarized", &
	u, results)
	<<SF circe2: test declarations>>=
	public :: sf_circe2_3
	<<SF circe2: tests>>=
	subroutine sf_circe2_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(rng_factory_t), allocatable :: rng_factory
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, x_free

	write (u, "(A)") "* Test output: sf_circe2_3"
	write (u, "(A)") "* Purpose: initialize and fill &
	&circe2 structure function object"
	write (u, "(A)")

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

	call os_data%init ()
	call model%init_qed_test ()
	call flv(1)%init (PHOTON, model)
	call flv(2)%init (PHOTON, model)
	pdg_in(1) = PHOTON
	pdg_in(2) = PHOTON

	call reset_interaction_counter ()

	allocate (circe2_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)
	select type (data)
	type is (circe2_data_t)
	call data%init (os_data, model, pdg_in, &
	sqrts = 500._default, &
	polarized = .true., &
	beam_pol = .false., &
	file = var_str ("teslagg_500.circe"), &
	design = var_str ("TESLA/GG"))
	call data%set_generator_mode (rng_factory)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])
	select type (sf_int)
	type is (circe2_t)
	call sf_int%rng_obj%rng%init (3)
	end select

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Generate x"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 0
	x_free = 1
	call sf_int%generate_free (r, rb, x_free)
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_circe2_3

	@ %def sf_circe2_3
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{HOPPET interface}
	Interface to the HOPPET wrapper necessary to perform
	the LO vs. NLO matching of processes containing an initial
	b quark.
	<<[[hoppet_interface.f90]]>>=
	<<File header>>

	module hoppet_interface
	use lhapdf !NODEP!

	<<Standard module head>>

	public :: hoppet_init, hoppet_eval

	contains

	subroutine hoppet_init (pdf_builtin, pdf, pdf_id)
	logical, intent(in) :: pdf_builtin
	type(lhapdf_pdf_t), intent(inout), optional :: pdf
	integer, intent(in), optional :: pdf_id
	external InitForWhizard
	call InitForWhizard (pdf_builtin, pdf, pdf_id)
	end subroutine hoppet_init

	subroutine hoppet_eval (x, q, f)
	double precision, intent(in) :: x, q
	double precision, intent(out) :: f(-6:6)
	external EvalForWhizard
	call EvalForWhizard (x, q, f)
	end subroutine hoppet_eval

	end module hoppet_interface
	@ %def hoppet_interface
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{Builtin PDF sets}
	For convenience in order not to depend on the external package LHAPDF,
	we ship some PDFs with WHIZARD.
	@
	\subsection{The module}
	<<[[sf_pdf_builtin.f90]]>>=
	<<File header>>

	module sf_pdf_builtin

	<<Use kinds>>
	use kinds, only: double
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_17
	use diagnostics
	use os_interface
	use physics_defs, only: n_beam_gluon_offset
	use physics_defs, only: PROTON, PHOTON, GLUON
	use physics_defs, only: HADRON_REMNANT_SINGLET
	use physics_defs, only: HADRON_REMNANT_TRIPLET
	use physics_defs, only: HADRON_REMNANT_OCTET
	use sm_qcd
	use lorentz
	use pdg_arrays
	use model_data
	use flavors
	use colors
	use quantum_numbers
	use state_matrices
	use polarizations
	use sf_base
	use pdf_builtin !NODEP!
	use hoppet_interface

	<<Standard module head>>

	<<SF pdf builtin: public>>

	<<SF pdf builtin: types>>

	<<SF pdf builtin: parameters>>

	contains

	<<SF pdf builtin: procedures>>

	end module sf_pdf_builtin
	@ %def sf_pdf_builtin
	@
	\subsection{Codes for default PDF sets}
	<<SF pdf builtin: parameters>>=
	character(*), parameter :: PDF_BUILTIN_DEFAULT_PROTON = "CTEQ6L"
	! character(*), parameter :: PDF_BUILTIN_DEFAULT_PION = "NONE"
	! character(*), parameter :: PDF_BUILTIN_DEFAULT_PHOTON = "MRST2004QEDp"
	@ %def PDF_BUILTIN_DEFAULT_SET
	@
	\subsection{The PDF builtin data block}
	The data block holds the incoming flavor (which has to be proton,
	pion, or photon), the corresponding pointer to the global access data
	(1, 2, or 3), the flag [[invert]] which is set for an antiproton, the
	bounds as returned by LHAPDF for the specified set, and a mask that
	determines which partons will be actually in use.
	<<SF pdf builtin: public>>=
	public :: pdf_builtin_data_t
	<<SF pdf builtin: types>>=
	type, extends (sf_data_t) :: pdf_builtin_data_t
	private
	integer :: id = -1
	type (string_t) :: name
	class(model_data_t), pointer :: model => null ()
	type(flavor_t) :: flv_in
	logical :: invert
	logical :: has_photon
	logical :: photon
	logical, dimension(-6:6) :: mask
	logical :: mask_photon
	logical :: hoppet_b_matching = .false.
	contains
	<<SF pdf builtin: pdf builtin data: TBP>>
	end type pdf_builtin_data_t

	@ %def pdf_builtin_data_t
	@ Generate PDF data and initialize the requested set. Pion and photon PDFs
	are disabled at the moment until we ship appropiate structure functions.
	needed.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: init => pdf_builtin_data_init
	<<SF pdf builtin: procedures>>=
	subroutine pdf_builtin_data_init (data, &
	model, pdg_in, name, path, hoppet_b_matching)
	class(pdf_builtin_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: path
	logical, intent(in), optional :: hoppet_b_matching
	data%model => model
	if (pdg_array_get_length (pdg_in) /= 1) &
	call msg_fatal ("PDF: incoming particle must be unique")
	call data%flv_in%init (pdg_array_get (pdg_in, 1), model)
	data%mask = .true.
	data%mask_photon = .true.
	select case (pdg_array_get (pdg_in, 1))
	case (PROTON)
	data%name = var_str (PDF_BUILTIN_DEFAULT_PROTON)
	data%invert = .false.
	data%photon = .false.
	case (-PROTON)
	data%name = var_str (PDF_BUILTIN_DEFAULT_PROTON)
	data%invert = .true.
	data%photon = .false.
	! case (PIPLUS)
	! data%name = var_str (PDF_BUILTIN_DEFAULT_PION)
	! data%invert = .false.
	! data%photon = .false.
	! case (-PIPLUS)
	! data%name = var_str (PDF_BUILTIN_DEFAULT_PION)
	! data%invert = .true.
	! data%photon = .false.
	! case (PHOTON)
	! data%name = var_str (PDF_BUILTIN_DEFAULT_PHOTON)
	! data%invert = .false.
	! data%photon = .true.
	case default
	call msg_fatal ("PDF: " &
	// "incoming particle must either proton or antiproton.")
	return
	end select
	data%name = name
	data%id = pdf_get_id (data%name)
	if (data%id < 0) call msg_fatal ("unknown PDF set " // char (data%name))
	data%has_photon = pdf_provides_photon (data%id)
	if (present (hoppet_b_matching)) data%hoppet_b_matching = hoppet_b_matching
	call pdf_init (data%id, path)
	if (data%hoppet_b_matching) call hoppet_init (.true., pdf_id = data%id)
	end subroutine pdf_builtin_data_init

	@ %def pdf_builtin_data_init
	@ Enable/disable partons explicitly. If a mask entry is true,
	applying the PDF will generate the corresponding flavor on output.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: set_mask => pdf_builtin_data_set_mask
	<<SF pdf builtin: procedures>>=
	subroutine pdf_builtin_data_set_mask (data, mask)
	class(pdf_builtin_data_t), intent(inout) :: data
	logical, dimension(-6:6), intent(in) :: mask
	data%mask = mask
	end subroutine pdf_builtin_data_set_mask

	@ %def pdf_builtin_data_set_mask
	@ Output.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: write => pdf_builtin_data_write
	<<SF pdf builtin: procedures>>=
	subroutine pdf_builtin_data_write (data, unit, verbose)
	class(pdf_builtin_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "PDF builtin data:"
	if (data%id < 0) then
	write (u, "(3x,A)") "[undefined]"
	return
	end if
	write (u, "(3x,A)", advance="no") "flavor = "
	call data%flv_in%write (u); write (u, *)
	write (u, "(3x,A,A)") "name = ", char (data%name)
	write (u, "(3x,A,L1)") "invert = ", data%invert
	write (u, "(3x,A,L1)") "has photon = ", data%has_photon
	write (u, "(3x,A,6(1x,L1),1x,A,1x,L1,1x,A,6(1x,L1))") &
	"mask =", &
	data%mask(-6:-1), "", data%mask(0), "", data%mask(1:6)
	write (u, "(3x,A,L1)") "photon mask = ", data%mask_photon
	write (u, "(3x,A,L1)") "hoppet_b = ", data%hoppet_b_matching
	end subroutine pdf_builtin_data_write

	@ %def pdf_builtin_data_write
	@ The number of parameters is one. We do not generate transverse momentum.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: get_n_par => pdf_builtin_data_get_n_par
	<<SF pdf builtin: procedures>>=
	function pdf_builtin_data_get_n_par (data) result (n)
	class(pdf_builtin_data_t), intent(in) :: data
	integer :: n
	n = 1
	end function pdf_builtin_data_get_n_par

	@ %def pdf_builtin_data_get_n_par
	@ Return the outgoing particle PDG codes. This is based on the mask.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: get_pdg_out => pdf_builtin_data_get_pdg_out
	<<SF pdf builtin: procedures>>=
	subroutine pdf_builtin_data_get_pdg_out (data, pdg_out)
	class(pdf_builtin_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	integer :: n, np, i
	n = count (data%mask)
	np = 0; if (data%has_photon .and. data%mask_photon) np = 1
	allocate (pdg1 (n + np))
	pdg1(1:n) = pack ([(i, i = -6, 6)], data%mask)
	if (np == 1) pdg1(n+np) = PHOTON
	pdg_out(1) = pdg1
	end subroutine pdf_builtin_data_get_pdg_out

	@ %def pdf_builtin_data_get_pdg_out
	@ Allocate the interaction record.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: allocate_sf_int => pdf_builtin_data_allocate_sf_int
	<<SF pdf builtin: procedures>>=
	subroutine pdf_builtin_data_allocate_sf_int (data, sf_int)
	class(pdf_builtin_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (pdf_builtin_t :: sf_int)
	end subroutine pdf_builtin_data_allocate_sf_int

	@ %def pdf_builtin_data_allocate_sf_int
	@ Return the numerical PDF set index.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: get_pdf_set => pdf_builtin_data_get_pdf_set
	<<SF pdf builtin: procedures>>=
	elemental function pdf_builtin_data_get_pdf_set (data) result (pdf_set)
	class(pdf_builtin_data_t), intent(in) :: data
	integer :: pdf_set
	pdf_set = data%id
	end function pdf_builtin_data_get_pdf_set

	@ %def pdf_builtin_data_get_pdf_set
	@
	\subsection{The PDF object}
	The PDF $1\to 2$ interaction which describes
	the splitting of an (anti)proton into a parton and a beam remnant. We
	stay in the strict forward-splitting limit, but allow some invariant
	mass for the beam remnant such that the outgoing parton is exactly
	massless. For a real event, we would replace this by a parton
	cascade, where the outgoing partons have virtuality as dictated by
	parton-shower kinematics, and transverse momentum is generated.

	The PDF application is a $1\to 2$ splitting process, where the
	particles are ordered as (hadron, remnant, parton).

	Polarization is ignored completely. The beam particle is colorless,
	while partons and beam remnant carry color. The remnant gets a
	special flavor code.
	<<SF pdf builtin: public>>=
	public :: pdf_builtin_t
	<<SF pdf builtin: types>>=
	type, extends (sf_int_t) :: pdf_builtin_t
	type(pdf_builtin_data_t), pointer :: data => null ()
	real(default) :: x = 0
	real(default) :: q = 0
	contains
	<<SF pdf builtin: pdf builtin: TBP>>
	end type pdf_builtin_t

	@ %def pdf_builtin_t
	@ Type string: display the chosen PDF set.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: type_string => pdf_builtin_type_string
	<<SF pdf builtin: procedures>>=
	function pdf_builtin_type_string (object) result (string)
	class(pdf_builtin_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "PDF builtin: " // object%data%name
	else
	string = "PDF builtin: [undefined]"
	end if
	end function pdf_builtin_type_string

	@ %def pdf_builtin_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: write => pdf_builtin_write
	<<SF pdf builtin: procedures>>=
	subroutine pdf_builtin_write (object, unit, testflag)
	class(pdf_builtin_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(1x,A)") "SF parameters:"
	write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
	if (object%status >= SF_FAILED_EVALUATION) then
	write (u, "(3x,A," // FMT_17 // ")") "Q =", object%q
	end if
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "PDF builtin data: [undefined]"
	end if
	end subroutine pdf_builtin_write

	@ %def pdf_builtin_write
	@ Initialize. We know that [[data]] will be of concrete type
	[[sf_test_data_t]], but we have to cast this explicitly.

	For this implementation, we set the incoming and outgoing masses equal
	to the physical particle mass, but keep the radiated mass zero.

	Optionally, we can provide minimum and maximum values for the momentum
	transfer.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: init => pdf_builtin_init
	<<SF pdf builtin: procedures>>=
	subroutine pdf_builtin_init (sf_int, data)
	class(pdf_builtin_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	type(flavor_t) :: flv, flv_remnant
	type(color_t) :: col0
	type(quantum_numbers_t), dimension(3) :: qn
	integer :: i
	select type (data)
	type is (pdf_builtin_data_t)
	mask = quantum_numbers_mask (.false., .false., .true.)
	call col0%init ()
	call sf_int%base_init (mask, [0._default], [0._default], [0._default])
	sf_int%data => data
	do i = -6, 6
	if (data%mask(i)) then
	call qn(1)%init (data%flv_in, col = col0)
	if (i == 0) then
	call flv%init (GLUON, data%model)
	call flv_remnant%init (HADRON_REMNANT_OCTET, data%model)
	else
	call flv%init (i, data%model)
	call flv_remnant%init &
	(sign (HADRON_REMNANT_TRIPLET, -i), data%model)
	end if
	call qn(2)%init ( &
	flv = flv_remnant, col = color_from_flavor (flv_remnant, 1))
	call qn(2)%tag_radiated ()
	call qn(3)%init ( &
	flv = flv, col = color_from_flavor (flv, 1, reverse=.true.))
	call sf_int%add_state (qn)
	end if
	end do
	if (data%has_photon .and. data%mask_photon) then
	call flv%init (PHOTON, data%model)
	call flv_remnant%init (HADRON_REMNANT_SINGLET, data%model)
	call qn(2)%init (flv = flv_remnant, &
	col = color_from_flavor (flv_remnant, 1))
	call qn(2)%tag_radiated ()
	call qn(3)%init (flv = flv, &
	col = color_from_flavor (flv, 1, reverse = .true.))
	call sf_int%add_state (qn)
	end if
	call sf_int%freeze ()
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	sf_int%status = SF_INITIAL
	end select
	end subroutine pdf_builtin_init

	@ %def pdf_builtin_init
	@
	\subsection{Kinematics}
	Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ is trivial.

	If [[map]] is set, we are asked to provide an efficient mapping.
	For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: complete_kinematics => pdf_builtin_complete_kinematics
	<<SF pdf builtin: procedures>>=
	subroutine pdf_builtin_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(pdf_builtin_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	call msg_fatal ("PDF builtin: map flag not supported")
	else
	x(1) = r(1)
	xb(1)= rb(1)
	f = 1
	end if
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_DONE_KINEMATICS)
	sf_int%x = x(1)
	case (SF_FAILED_KINEMATICS)
	sf_int%x = 0
	f = 0
	end select
	end subroutine pdf_builtin_complete_kinematics

	@ %def pdf_builtin_complete_kinematics
	+@ Overriding the default method: we compute the [[x]] value from the
	+momentum configuration. In this specific case, we also set the
	+internally stored $x$ value, so it can be used in the
	+following routine.
	+<<SF pdf builtin: pdf builtin: TBP>>=
	+ procedure :: recover_x => pdf_builtin_recover_x
	+<<SF pdf builtin: procedures>>=
	+ subroutine pdf_builtin_recover_x (sf_int, x, xb, x_free)
	+ class(pdf_builtin_t), intent(inout) :: sf_int
	+ real(default), dimension(:), intent(out) :: x
	+ real(default), dimension(:), intent(out) :: xb
	+ real(default), intent(inout), optional :: x_free
	+ call sf_int%base_recover_x (x, xb, x_free)
	+ sf_int%x = x(1)
	+ end subroutine pdf_builtin_recover_x
	+
	+@ %def sf_pdf_builtin_recover_x
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: inverse_kinematics => pdf_builtin_inverse_kinematics
	<<SF pdf builtin: procedures>>=
	subroutine pdf_builtin_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	class(pdf_builtin_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	call msg_fatal ("PDF builtin: map flag not supported")
	else
	r(1) = x(1)
	rb(1)= xb(1)
	f = 1
	end if
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	- case (SF_DONE_KINEMATICS)
	- sf_int%x = x(1)
	- case (SF_FAILED_KINEMATICS)
	- sf_int%x = 0
	- f = 0
	+ case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine pdf_builtin_inverse_kinematics

	@ %def pdf_builtin_inverse_kinematics
	@
	\subsection{Structure function}
	Once the scale is also known, we can actually call the PDF and
	set the values. Contrary to LHAPDF, the wrapper already takes care of
	adjusting to the $x$ and $Q$ bounds. Account for the Jacobian.

	[[fill_sub]] allows us to the fill all matrix-elements with [[sub > 0]].
	Whereas [[rescale]] gives rescaling prescription for NLO convolution of the
	structure function in combination with [[i_sub]].
	[[fill_sub]] and [[rescale]] with [[i_sub]] are mutually exclusive.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: apply => pdf_builtin_apply
	<<SF pdf builtin: procedures>>=
	subroutine pdf_builtin_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(pdf_builtin_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	real(default), dimension(-6:6) :: ff
	real(double), dimension(-6:6) :: ff_dbl
	real(default) :: x, fph
	real(double) :: xx, qq
	complex(default), dimension(:), allocatable :: fc
	integer :: i, j_sub, i_sub_opt
	logical :: fill_sub_opt
	i_sub_opt = 0; if (present (i_sub)) i_sub_opt = i_sub
	fill_sub_opt = .false.; if (present (fill_sub)) fill_sub_opt = fill_sub
	if (present (rescale) .and. fill_sub_opt) then
	call msg_bug ("[pdf_builtin_apply] &
	& sf_rescale and fill_sub option are mutually exclusive.")
	end if
	if (i_sub_opt > 0 .and. fill_sub_opt) then
	call msg_bug ("[pdf_builtin_apply] &
	& i_sub and fill_sub options are mutually exclusive.")
	end if
	associate (data => sf_int%data)
	sf_int%q = scale
	x = sf_int%x
	if (present (rescale)) call rescale%apply (x)
	if (debug2_active (D_BEAMS)) then
	call msg_debug2 (D_BEAMS, "pdf_builtin_apply")
	call msg_debug2 (D_BEAMS, "rescale: ", present(rescale))
	call msg_debug2 (D_BEAMS, "i_sub: ", i_sub_opt)
	call msg_debug2 (D_BEAMS, "fill_sub: ", fill_sub_opt)
	call msg_debug2 (D_BEAMS, "x: ", x)
	end if
	xx = x
	qq = scale
	if (data%invert) then
	if (data%has_photon) then
	call pdf_evolve (data%id, x, scale, ff(6:-6:-1), fph)
	else
	if (data%hoppet_b_matching) then
	call hoppet_eval (xx, qq, ff_dbl(6:-6:-1))
	ff = ff_dbl
	else
	call pdf_evolve (data%id, x, scale, ff(6:-6:-1))
	end if
	end if
	else
	if (data%has_photon) then
	call pdf_evolve (data%id, x, scale, ff, fph)
	else
	if (data%hoppet_b_matching) then
	call hoppet_eval (xx, qq, ff_dbl)
	ff = ff_dbl
	else
	call pdf_evolve (data%id, x, scale, ff)
	end if
	end if
	end if
	if (data%has_photon) then
	allocate (fc (count ([data%mask, data%mask_photon])))
	fc = max (pack ([ff, fph], &
	[data%mask, data%mask_photon]), 0._default)
	else
	allocate (fc (count (data%mask)))
	fc = max (pack (ff, data%mask), 0._default)
	end if
	end associate
	if (debug_active (D_BEAMS)) print *, 'Set pdfs: ', real (fc)
	if (present (rescale) .and. i_sub_opt > 0) then
	call sf_int%set_matrix_element (fc, [(i_sub_opt * size(fc) + i, i = 1, size(fc))])
	if (rescale%has_gluons ()) then
	j_sub = i_sub_opt + n_beam_gluon_offset
	call sf_int%set_matrix_element (&
	spread (fc(7), 1, size(fc)), [(j_sub * size(fc) + i, i = 1, size(fc))])
	end if
	else
	call sf_int%set_matrix_element (fc, [(i, i = 1, size(fc))])
	end if
	if(fill_sub_opt) then
	do j_sub = 1, sf_int%get_n_sub ()
	call sf_int%set_matrix_element (fc, [(j_sub * size(fc) + i, i = 1, size(fc))])
	end do
	end if
	sf_int%status = SF_EVALUATED
	end subroutine pdf_builtin_apply

	@ %def pdf_builtin_apply
	@
	\subsection{Strong Coupling}
	Since the PDF codes provide a function for computing the running
	$\alpha_s$ value, we make this available as an implementation of the
	abstract [[alpha_qcd_t]] type, which is used for matrix element evaluation.
	<<SF pdf builtin: public>>=
	public :: alpha_qcd_pdf_builtin_t
	<<SF pdf builtin: types>>=
	type, extends (alpha_qcd_t) :: alpha_qcd_pdf_builtin_t
	type(string_t) :: pdfset_name
	integer :: pdfset_id = -1
	contains
	<<SF pdf builtin: alpha qcd: TBP>>
	end type alpha_qcd_pdf_builtin_t

	@ %def alpha_qcd_pdf_builtin_t
	@ Output.
	<<SF pdf builtin: alpha qcd: TBP>>=
	procedure :: write => alpha_qcd_pdf_builtin_write
	<<SF pdf builtin: procedures>>=
	subroutine alpha_qcd_pdf_builtin_write (object, unit)
	class(alpha_qcd_pdf_builtin_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A)") "QCD parameters (pdf_builtin):"
	write (u, "(5x,A,A)") "PDF set = ", char (object%pdfset_name)
	write (u, "(5x,A,I0)") "PDF ID = ", object%pdfset_id
	end subroutine alpha_qcd_pdf_builtin_write

	@ %def alpha_qcd_pdf_builtin_write
	@ Calculation: the numeric ID selects the correct PDF set, which must
	be properly initialized.
	<<SF pdf builtin: alpha qcd: TBP>>=
	procedure :: get => alpha_qcd_pdf_builtin_get
	<<SF pdf builtin: procedures>>=
	function alpha_qcd_pdf_builtin_get (alpha_qcd, scale) result (alpha)
	class(alpha_qcd_pdf_builtin_t), intent(in) :: alpha_qcd
	real(default), intent(in) :: scale
	real(default) :: alpha
	alpha = pdf_alphas (alpha_qcd%pdfset_id, scale)
	end function alpha_qcd_pdf_builtin_get

	@ %def alpha_qcd_pdf_builtin_get
	@
	Initialization. We need to access the global initialization status.
	<<SF pdf builtin: alpha qcd: TBP>>=
	procedure :: init => alpha_qcd_pdf_builtin_init
	<<SF pdf builtin: procedures>>=
	subroutine alpha_qcd_pdf_builtin_init (alpha_qcd, name, path)
	class(alpha_qcd_pdf_builtin_t), intent(out) :: alpha_qcd
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: path
	alpha_qcd%pdfset_name = name
	alpha_qcd%pdfset_id = pdf_get_id (name)
	if (alpha_qcd%pdfset_id < 0) &
	call msg_fatal ("QCD parameter initialization: PDF set " &
	// char (name) // " is unknown")
	call pdf_init (alpha_qcd%pdfset_id, path)
	end subroutine alpha_qcd_pdf_builtin_init

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

	module sf_pdf_builtin_ut
	use unit_tests
	use sf_pdf_builtin_uti

	<<Standard module head>>

	<<SF pdf builtin: public test>>

	contains

	<<SF pdf builtin: test driver>>

	end module sf_pdf_builtin_ut
	@ %def sf_pdf_builtin_ut
	@
	<<[[sf_pdf_builtin_uti.f90]]>>=
	<<File header>>

	module sf_pdf_builtin_uti

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use physics_defs, only: PROTON
	use sm_qcd
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use sf_base

	use sf_pdf_builtin

	<<Standard module head>>

	<<SF pdf builtin: test declarations>>

	contains

	<<SF pdf builtin: tests>>

	end module sf_pdf_builtin_uti
	@ %def sf_pdf_builtin_ut
	@ API: driver for the unit tests below.
	<<SF pdf builtin: public test>>=
	public :: sf_pdf_builtin_test
	<<SF pdf builtin: test driver>>=
	subroutine sf_pdf_builtin_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF pdf builtin: execute tests>>
	end subroutine sf_pdf_builtin_test

	@ %def sf_pdf_builtin_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF pdf builtin: execute tests>>=
	call test (sf_pdf_builtin_1, "sf_pdf_builtin_1", &
	"structure function configuration", &
	u, results)
	<<SF pdf builtin: test declarations>>=
	public :: sf_pdf_builtin_1
	<<SF pdf builtin: tests>>=
	subroutine sf_pdf_builtin_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data
	type(string_t) :: name

	write (u, "(A)") "* Test output: sf_pdf_builtin_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call os_data%init ()

	call model%init_sm_test ()
	pdg_in = PROTON

	allocate (pdf_builtin_data_t :: data)
	call data%write (u)

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

	name = "CTEQ6L"

	select type (data)
	type is (pdf_builtin_data_t)
	call data%init (model, pdg_in, name, &
	os_data%pdf_builtin_datapath)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_pdf_builtin_1

	@ %def sf_pdf_builtin_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the PDF builtin
	structure function.
	<<SF pdf builtin: execute tests>>=
	call test (sf_pdf_builtin_2, "sf_pdf_builtin_2", &
	"structure function instance", &
	u, results)
	<<SF pdf builtin: test declarations>>=
	public :: sf_pdf_builtin_2
	<<SF pdf builtin: tests>>=
	subroutine sf_pdf_builtin_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(string_t) :: name
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_pdf_builtin_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call os_data%init ()
	call model%init_sm_test ()
	call flv%init (PROTON, model)
	pdg_in = PROTON

	call reset_interaction_counter ()

	name = "CTEQ6L"

	allocate (pdf_builtin_data_t :: data)
	select type (data)
	type is (pdf_builtin_data_t)
	call data%init (model, pdg_in, name, &
	os_data%pdf_builtin_datapath)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.5_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for Q = 100 GeV"
	write (u, "(A)")

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)


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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_pdf_builtin_2

	@ %def sf_pdf_builtin_2
	@
	\subsubsection{Strong Coupling}
	Test $\alpha_s$ as an implementation of the [[alpha_qcd_t]] abstract
	type.
	<<SF pdf builtin: execute tests>>=
	call test (sf_pdf_builtin_3, "sf_pdf_builtin_3", &
	"running alpha_s", &
	u, results)
	<<SF pdf builtin: test declarations>>=
	public :: sf_pdf_builtin_3
	<<SF pdf builtin: tests>>=
	subroutine sf_pdf_builtin_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(qcd_t) :: qcd
	type(string_t) :: name

	write (u, "(A)") "* Test output: sf_pdf_builtin_3"
	write (u, "(A)") "* Purpose: initialize and evaluate alpha_s"
	write (u, "(A)")

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

	call os_data%init ()

	name = "CTEQ6L"

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

	allocate (alpha_qcd_pdf_builtin_t :: qcd%alpha)
	select type (alpha => qcd%alpha)
	type is (alpha_qcd_pdf_builtin_t)
	call alpha%init (name, os_data%pdf_builtin_datapath)
	end select
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for Q = 100"
	write (u, "(A)")

	write (u, "(1x,A,F8.5)") "alpha = ", qcd%alpha%get (100._default)

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

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

	end subroutine sf_pdf_builtin_3

	@ %def sf_pdf_builtin_3
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{LHAPDF}
	Parton distribution functions (PDFs) are available via an interface to
	the LHAPDF standard library.
	@
	\subsection{The module}
	<<[[sf_lhapdf.f90]]>>=
	<<File header>>

	module sf_lhapdf

	<<Use kinds>>
	<<Use strings>>
	use format_defs, only: FMT_17, FMT_19
	use io_units
	use system_dependencies, only: LHAPDF_PDFSETS_PATH
	use system_dependencies, only: LHAPDF5_AVAILABLE
	use system_dependencies, only: LHAPDF6_AVAILABLE
	use diagnostics
	use physics_defs, only: n_beam_gluon_offset
	use physics_defs, only: PROTON, PHOTON, PIPLUS, GLUON
	use physics_defs, only: HADRON_REMNANT_SINGLET
	use physics_defs, only: HADRON_REMNANT_TRIPLET
	use physics_defs, only: HADRON_REMNANT_OCTET
	use lorentz
	use sm_qcd
	use pdg_arrays
	use model_data
	use flavors
	use colors
	use quantum_numbers
	use state_matrices
	use polarizations
	use sf_base
	use lhapdf !NODEP!
	use hoppet_interface

	<<Standard module head>>

	<<SF lhapdf: public>>

	<<SF lhapdf: types>>

	<<SF lhapdf: parameters>>

	<<SF lhapdf: variables>>

	<<SF lhapdf: interfaces>>

	contains

	<<SF lhapdf: procedures>>

	end module sf_lhapdf
	@ %def sf_lhapdf
	@
	\subsection{Codes for default PDF sets}
	The default PDF for protons set is chosen to be CTEQ6ll (LO fit with
	LO $\alpha_s$).
	<<SF lhapdf: parameters>>=
	character(*), parameter :: LHAPDF5_DEFAULT_PROTON = "cteq6ll.LHpdf"
	character(*), parameter :: LHAPDF5_DEFAULT_PION = "ABFKWPI.LHgrid"
	character(*), parameter :: LHAPDF5_DEFAULT_PHOTON = "GSG960.LHgrid"
	character(*), parameter :: LHAPDF6_DEFAULT_PROTON = "CT10"
	@ %def LHAPDF5_DEFAULT_PROTON LHAPDF5_DEFAULT_PION
	@ %def LHAPDF5_DEFAULT_PHOTON LHAPDF6_DEFAULT_PROTON
	@
	\subsection{LHAPDF library interface}
	Here we specify explicit interfaces for all LHAPDF routines that we
	use below.
	<<SF lhapdf: interfaces>>=
	interface
	subroutine InitPDFsetM (set, file)
	integer, intent(in) :: set
	character(*), intent(in) :: file
	end subroutine InitPDFsetM
	end interface

	@ %def InitPDFsetM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine InitPDFM (set, mem)
	integer, intent(in) :: set, mem
	end subroutine InitPDFM
	end interface

	@ %def InitPDFM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine numberPDFM (set, n_members)
	integer, intent(in) :: set
	integer, intent(out) :: n_members
	end subroutine numberPDFM
	end interface

	@ %def numberPDFM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine evolvePDFM (set, x, q, ff)
	integer, intent(in) :: set
	double precision, intent(in) :: x, q
	double precision, dimension(-6:6), intent(out) :: ff
	end subroutine evolvePDFM
	end interface

	@ %def evolvePDFM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine evolvePDFphotonM (set, x, q, ff, fphot)
	integer, intent(in) :: set
	double precision, intent(in) :: x, q
	double precision, dimension(-6:6), intent(out) :: ff
	double precision, intent(out) :: fphot
	end subroutine evolvePDFphotonM
	end interface

	@ %def evolvePDFphotonM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine evolvePDFpM (set, x, q, s, scheme, ff)
	integer, intent(in) :: set
	double precision, intent(in) :: x, q, s
	integer, intent(in) :: scheme
	double precision, dimension(-6:6), intent(out) :: ff
	end subroutine evolvePDFpM
	end interface

	@ %def evolvePDFpM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine GetXminM (set, mem, xmin)
	integer, intent(in) :: set, mem
	double precision, intent(out) :: xmin
	end subroutine GetXminM
	end interface

	@ %def GetXminM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine GetXmaxM (set, mem, xmax)
	integer, intent(in) :: set, mem
	double precision, intent(out) :: xmax
	end subroutine GetXmaxM
	end interface

	@ %def GetXmaxM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine GetQ2minM (set, mem, q2min)
	integer, intent(in) :: set, mem
	double precision, intent(out) :: q2min
	end subroutine GetQ2minM
	end interface

	@ %def GetQ2minM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine GetQ2maxM (set, mem, q2max)
	integer, intent(in) :: set, mem
	double precision, intent(out) :: q2max
	end subroutine GetQ2maxM
	end interface

	@ %def GetQ2maxM
	<<SF lhapdf: interfaces>>=
	interface
	function has_photon () result(flag)
	logical :: flag
	end function has_photon
	end interface

	@ %def has_photon
	@
	\subsection{The LHAPDF status}
	This type holds the initialization status of the LHAPDF system. Entry
	1 is for proton PDFs, entry 2 for pion PDFs, entry 3 for photon PDFs.

	Since it is connected to the external LHAPDF library, this is a truly
	global object. We implement it as a a private module variable. To
	access it from elsewhere, the caller has to create and initialize an
	object of type [[lhapdf_status_t]], which acts as a proxy.
	<<SF lhapdf: types>>=
	type :: lhapdf_global_status_t
	private
	logical, dimension(3) :: initialized = .false.
	end type lhapdf_global_status_t

	@ %def lhapdf_global_status_t
	<<SF lhapdf: variables>>=
	type(lhapdf_global_status_t), save :: lhapdf_global_status
	@ %def lhapdf_global_status
	<<SF lhapdf: procedures>>=
	function lhapdf_global_status_is_initialized (set) result (flag)
	logical :: flag
	integer, intent(in), optional :: set
	if (present (set)) then
	select case (set)
	case (1:3); flag = lhapdf_global_status%initialized(set)
	case default; flag = .false.
	end select
	else
	flag = any (lhapdf_global_status%initialized)
	end if
	end function lhapdf_global_status_is_initialized

	@ %def lhapdf_global_status_is_initialized
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_global_status_set_initialized (set)
	integer, intent(in) :: set
	lhapdf_global_status%initialized(set) = .true.
	end subroutine lhapdf_global_status_set_initialized

	@ %def lhapdf_global_status_set_initialized
	@ This is the only public procedure, it tells the system to forget
	about previous initialization, allowing for changing the chosen PDF
	set. Note that such a feature works only if the global program flow
	is serial, so no two distinct sets are accessed simultaneously. But
	this applies to LHAPDF anyway.
	<<SF lhapdf: public>>=
	public :: lhapdf_global_reset
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_global_reset ()
	lhapdf_global_status%initialized = .false.
	end subroutine lhapdf_global_reset

	@ %def lhapdf_global_status_reset
	@
	\subsection{LHAPDF initialization}
	Before using LHAPDF, we have to initialize it with a particular data
	set and member. This applies not just if we use structure functions,
	but also if we just use an $\alpha_s$ formula. The integer [[set]]
	should be $1$ for proton, $2$ for pion, and $3$ for photon, but this
	is just convention.

	It appears as if LHAPDF does not allow for multiple data sets being
	used concurrently (?), so multi-threaded usage with different sets
	(e.g., a scan) is excluded. The current setup with a global flag that
	indicates initialization is fine as long as Whizard itself is run in
	serial mode at the Sindarin level. If we introduce multithreading in
	any form from Sindarin, we have to rethink the implementation of the
	LHAPDF interface. (The same considerations apply to builtin PDFs.)

	If the particular set has already been initialized, do nothing. This
	implies that whenever we want to change the setup for a particular
	set, we have to reset the LHAPDF status.
	[[lhapdf_initialize]] has an obvious name clash with [[lhapdf_init]],
	the reason it works for [[pdf_builtin]] is that there things are
	outsourced to a separate module (inc. [[lhapdf_status]] etc.).
	<<SF lhapdf: public>>=
	public :: lhapdf_initialize
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_initialize (set, prefix, file, member, pdf, b_match)
	integer, intent(in) :: set
	type(string_t), intent(inout) :: prefix
	type(string_t), intent(inout) :: file
	type(lhapdf_pdf_t), intent(inout), optional :: pdf
	integer, intent(inout) :: member
	logical, intent(in), optional :: b_match
	if (prefix == "") prefix = LHAPDF_PDFSETS_PATH
	if (LHAPDF5_AVAILABLE) then
	if (lhapdf_global_status_is_initialized (set)) return
	if (file == "") then
	select case (set)
	case (1); file = LHAPDF5_DEFAULT_PROTON
	case (2); file = LHAPDF5_DEFAULT_PION
	case (3); file = LHAPDF5_DEFAULT_PHOTON
	end select
	end if
	if (data_file_exists (prefix // "/" // file)) then
	call InitPDFsetM (set, char (prefix // "/" // file))
	else
	call msg_fatal ("LHAPDF: Data file '" &
	// char (file) // "' not found in '" // char (prefix) // "'.")
	return
	end if
	if (.not. dataset_member_exists (set, member)) then
	call msg_error (" LHAPDF: Chosen member does not exist for set '" &
	// char (file) // "', using default.")
	member = 0
	end if
	call InitPDFM (set, member)
	else if (LHAPDF6_AVAILABLE) then
	! TODO: (bcn 2015-07-07) we should have a closer look why this global
	! check must not be executed
	! if (lhapdf_global_status_is_initialized (set) .and. &
	! pdf%is_associated ()) return
	if (file == "") then
	select case (set)
	case (1); file = LHAPDF6_DEFAULT_PROTON
	case (2);
	call msg_fatal ("LHAPDF6: no pion PDFs supported")
	case (3);
	call msg_fatal ("LHAPDF6: no photon PDFs supported")
	end select
	end if
	if (data_file_exists (prefix // "/" // file // "/" // file // ".info")) then
	call pdf%init (char (file), member)
	else
	call msg_fatal ("LHAPDF: Data file '" &
	// char (file) // "' not found in '" // char (prefix) // "'.")
	return
	end if
	end if
	if (present (b_match)) then
	if (b_match) then
	if (LHAPDF5_AVAILABLE) then
	call hoppet_init (.false.)
	else if (LHAPDF6_AVAILABLE) then
	call hoppet_init (.false., pdf)
	end if
	end if
	end if
	call lhapdf_global_status_set_initialized (set)
	contains
	function data_file_exists (fq_name) result (exist)
	type(string_t), intent(in) :: fq_name
	logical :: exist
	inquire (file = char(fq_name), exist = exist)
	end function data_file_exists
	function dataset_member_exists (set, member) result (exist)
	integer, intent(in) :: set, member
	logical :: exist
	integer :: n_members
	call numberPDFM (set, n_members)
	exist = member >= 0 .and. member <= n_members
	end function dataset_member_exists
	end subroutine lhapdf_initialize

	@ %def lhapdf_initialize
	@
	\subsection{Kinematics}
	Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ is trivial.

	If [[map]] is set, we are asked to provide an efficient mapping.
	For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: complete_kinematics => lhapdf_complete_kinematics
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(lhapdf_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	call msg_fatal ("LHAPDF: map flag not supported")
	else
	x(1) = r(1)
	xb(1)= rb(1)
	f = 1
	end if
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_DONE_KINEMATICS)
	sf_int%x = x(1)
	case (SF_FAILED_KINEMATICS)
	sf_int%x = 0
	f = 0
	end select
	end subroutine lhapdf_complete_kinematics

	@ %def lhapdf_complete_kinematics
	-@
	+@ Overriding the default method: we compute the [[x]] value from the
	+momentum configuration. In this specific case, we also set the
	+internally stored $x$ value, so it can be used in the
	+following routine.
	+<<SF lhapdf: lhapdf: TBP>>=
	+ procedure :: recover_x => lhapdf_recover_x
	+<<SF lhapdf: procedures>>=
	+ subroutine lhapdf_recover_x (sf_int, x, xb, x_free)
	+ class(lhapdf_t), intent(inout) :: sf_int
	+ real(default), dimension(:), intent(out) :: x
	+ real(default), dimension(:), intent(out) :: xb
	+ real(default), intent(inout), optional :: x_free
	+ call sf_int%base_recover_x (x, xb, x_free)
	+ sf_int%x = x(1)
	+ end subroutine lhapdf_recover_x
	+
	+@ %def lhapdf_recover_x
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: inverse_kinematics => lhapdf_inverse_kinematics
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	class(lhapdf_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	call msg_fatal ("LHAPDF: map flag not supported")
	else
	r(1) = x(1)
	rb(1)= xb(1)
	f = 1
	end if
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	- case (SF_DONE_KINEMATICS)
	- sf_int%x = x(1)
	- case (SF_FAILED_KINEMATICS)
	- sf_int%x = 0
	- f = 0
	+ case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine lhapdf_inverse_kinematics

	@ %def lhapdf_inverse_kinematics
	@
	\subsection{The LHAPDF data block}
	The data block holds the incoming flavor (which has to be proton,
	pion, or photon), the corresponding pointer to the global access data
	(1, 2, or 3), the flag [[invert]] which is set for an antiproton, the
	bounds as returned by LHAPDF for the specified set, and a mask that
	determines which partons will be actually in use.
	<<SF lhapdf: public>>=
	public :: lhapdf_data_t
	<<SF lhapdf: types>>=
	type, extends (sf_data_t) :: lhapdf_data_t
	private
	type(string_t) :: prefix
	type(string_t) :: file
	type(lhapdf_pdf_t) :: pdf
	integer :: member = 0
	class(model_data_t), pointer :: model => null ()
	type(flavor_t) :: flv_in
	integer :: set = 0
	logical :: invert = .false.
	logical :: photon = .false.
	logical :: has_photon = .false.
	integer :: photon_scheme = 0
	real(default) :: xmin = 0, xmax = 0
	real(default) :: qmin = 0, qmax = 0
	logical, dimension(-6:6) :: mask = .true.
	logical :: mask_photon = .true.
	logical :: hoppet_b_matching = .false.
	contains
	<<SF lhapdf: lhapdf data: TBP>>
	end type lhapdf_data_t

	@ %def lhapdf_data_t
	@ Generate PDF data. This is provided as a function, but it has the
	side-effect of initializing the requested PDF set. A finalizer is not
	needed.

	The library uses double precision, so since the default precision may be
	extended or quadruple, we use auxiliary variables for type casting.
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: init => lhapdf_data_init
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_data_init &
	(data, model, pdg_in, prefix, file, member, photon_scheme, &
	hoppet_b_matching)
	class(lhapdf_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	type(string_t), intent(in), optional :: prefix, file
	integer, intent(in), optional :: member
	integer, intent(in), optional :: photon_scheme
	logical, intent(in), optional :: hoppet_b_matching
	double precision :: xmin, xmax, q2min, q2max
	external :: InitPDFsetM, InitPDFM, numberPDFM
	external :: GetXminM, GetXmaxM, GetQ2minM, GetQ2maxM
	if (.not. LHAPDF5_AVAILABLE .and. .not. LHAPDF6_AVAILABLE) then
	call msg_fatal ("LHAPDF requested but library is not linked")
	return
	end if
	data%model => model
	if (pdg_array_get_length (pdg_in) /= 1) &
	call msg_fatal ("PDF: incoming particle must be unique")
	call data%flv_in%init (pdg_array_get (pdg_in, 1), model)
	select case (pdg_array_get (pdg_in, 1))
	case (PROTON)
	data%set = 1
	case (-PROTON)
	data%set = 1
	data%invert = .true.
	case (PIPLUS)
	data%set = 2
	case (-PIPLUS)
	data%set = 2
	data%invert = .true.
	case (PHOTON)
	data%set = 3
	data%photon = .true.
	if (present (photon_scheme)) data%photon_scheme = photon_scheme
	case default
	call msg_fatal (" LHAPDF: " &
	// "incoming particle must be (anti)proton, pion, or photon.")
	return
	end select
	if (present (prefix)) then
	data%prefix = prefix
	else
	data%prefix = ""
	end if
	if (present (file)) then
	data%file = file
	else
	data%file = ""
	end if
	if (present (hoppet_b_matching)) data%hoppet_b_matching = hoppet_b_matching
	if (LHAPDF5_AVAILABLE) then
	call lhapdf_initialize &
	(data%set, data%prefix, data%file, data%member, &
	b_match = data%hoppet_b_matching)
	call GetXminM (data%set, data%member, xmin)
	call GetXmaxM (data%set, data%member, xmax)
	call GetQ2minM (data%set, data%member, q2min)
	call GetQ2maxM (data%set, data%member, q2max)
	data%xmin = xmin
	data%xmax = xmax
	data%qmin = sqrt (q2min)
	data%qmax = sqrt (q2max)
	data%has_photon = has_photon ()
	else if (LHAPDF6_AVAILABLE) then
	call lhapdf_initialize &
	(data%set, data%prefix, data%file, data%member, &
	data%pdf, data%hoppet_b_matching)
	data%xmin = data%pdf%getxmin ()
	data%xmax = data%pdf%getxmax ()
	data%qmin = sqrt(data%pdf%getq2min ())
	data%qmax = sqrt(data%pdf%getq2max ())
	data%has_photon = data%pdf%has_photon ()
	end if
	end subroutine lhapdf_data_init

	@ %def lhapdf_data_init
	@ Enable/disable partons explicitly. If a mask entry is true,
	applying the PDF will generate the corresponding flavor on output.
	<<LHAPDF: lhapdf data: TBP>>=
	procedure :: set_mask => lhapdf_data_set_mask
	<<LHAPDF: procedures>>=
	subroutine lhapdf_data_set_mask (data, mask)
	class(lhapdf_data_t), intent(inout) :: data
	logical, dimension(-6:6), intent(in) :: mask
	data%mask = mask
	end subroutine lhapdf_data_set_mask

	@ %def lhapdf_data_set_mask
	@ Return the public part of the data set.
	<<LHAPDF: public>>=
	public :: lhapdf_data_get_public_info
	<<LHAPDF: procedures>>=
	subroutine lhapdf_data_get_public_info &
	(data, lhapdf_dir, lhapdf_file, lhapdf_member)
	type(lhapdf_data_t), intent(in) :: data
	type(string_t), intent(out) :: lhapdf_dir, lhapdf_file
	integer, intent(out) :: lhapdf_member
	lhapdf_dir = data%prefix
	lhapdf_file = data%file
	lhapdf_member = data%member
	end subroutine lhapdf_data_get_public_info

	@ %def lhapdf_data_get_public_info
	@ Return the number of the member of the data set.
	<<LHAPDF: public>>=
	public :: lhapdf_data_get_set
	<<LHAPDF: procedures>>=
	function lhapdf_data_get_set(data) result(set)
	type(lhapdf_data_t), intent(in) :: data
	integer :: set
	set = data%set
	end function lhapdf_data_get_set

	@ %def lhapdf_data_get_set
	@ Output
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: write => lhapdf_data_write
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_data_write (data, unit, verbose)
	class(lhapdf_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical :: verb
	integer :: u
	if (present (verbose)) then
	verb = verbose
	else
	verb = .false.
	end if
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "LHAPDF data:"
	if (data%set /= 0) then
	write (u, "(3x,A)", advance="no") "flavor = "
	call data%flv_in%write (u); write (u, *)
	if (verb) then
	write (u, "(3x,A,A)") " prefix = ", char (data%prefix)
	else
	write (u, "(3x,A,A)") " prefix = ", &
	" <empty (non-verbose version)>"
	end if
	write (u, "(3x,A,A)") " file = ", char (data%file)
	write (u, "(3x,A,I3)") " member = ", data%member
	write (u, "(3x,A," // FMT_19 // ")") " x(min) = ", data%xmin
	write (u, "(3x,A," // FMT_19 // ")") " x(max) = ", data%xmax
	write (u, "(3x,A," // FMT_19 // ")") " Q(min) = ", data%qmin
	write (u, "(3x,A," // FMT_19 // ")") " Q(max) = ", data%qmax
	write (u, "(3x,A,L1)") " invert = ", data%invert
	if (data%photon) write (u, "(3x,A,I3)") &
	" IP2 (scheme) = ", data%photon_scheme
	write (u, "(3x,A,6(1x,L1),1x,A,1x,L1,1x,A,6(1x,L1))") &
	" mask = ", &
	data%mask(-6:-1), "", data%mask(0), "", data%mask(1:6)
	write (u, "(3x,A,L1)") " photon mask = ", data%mask_photon
	if (data%set == 1) write (u, "(3x,A,L1)") &
	" hoppet_b = ", data%hoppet_b_matching
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine lhapdf_data_write
	@ %def lhapdf_data_write
	@ The number of parameters is one. We do not generate transverse momentum.
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: get_n_par => lhapdf_data_get_n_par
	<<SF lhapdf: procedures>>=
	function lhapdf_data_get_n_par (data) result (n)
	class(lhapdf_data_t), intent(in) :: data
	integer :: n
	n = 1
	end function lhapdf_data_get_n_par

	@ %def lhapdf_data_get_n_par
	@ Return the outgoing particle PDG codes. This is based on the mask.
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: get_pdg_out => lhapdf_data_get_pdg_out
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_data_get_pdg_out (data, pdg_out)
	class(lhapdf_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	integer :: n, np, i
	n = count (data%mask)
	np = 0; if (data%has_photon .and. data%mask_photon) np = 1
	allocate (pdg1 (n + np))
	pdg1(1:n) = pack ([(i, i = -6, 6)], data%mask)
	if (np == 1) pdg1(n+np) = PHOTON
	pdg_out(1) = pdg1
	end subroutine lhapdf_data_get_pdg_out

	@ %def lhapdf_data_get_pdg_out
	@ Allocate the interaction record.
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: allocate_sf_int => lhapdf_data_allocate_sf_int
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_data_allocate_sf_int (data, sf_int)
	class(lhapdf_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (lhapdf_t :: sf_int)
	end subroutine lhapdf_data_allocate_sf_int

	@ %def lhapdf_data_allocate_sf_int
	@ Return the numerical PDF set index.
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: get_pdf_set => lhapdf_data_get_pdf_set
	<<SF lhapdf: procedures>>=
	elemental function lhapdf_data_get_pdf_set (data) result (pdf_set)
	class(lhapdf_data_t), intent(in) :: data
	integer :: pdf_set
	pdf_set = data%set
	end function lhapdf_data_get_pdf_set

	@ %def lhapdf_data_get_pdf_set
	@
	\subsection{The LHAPDF object}
	The [[lhapdf_t]] data type is a $1\to 2$ interaction which describes
	the splitting of an (anti)proton into a parton and a beam remnant. We
	stay in the strict forward-splitting limit, but allow some invariant
	mass for the beam remnant such that the outgoing parton is exactly
	massless. For a real event, we would replace this by a parton
	cascade, where the outgoing partons have virtuality as dictated by
	parton-shower kinematics, and transverse momentum is generated.

	This is the LHAPDF object which holds input data together with the
	interaction. We also store the $x$ momentum fraction and the scale,
	since kinematics and function value are requested at different times.

	The PDF application is a $1\to 2$ splitting process, where the
	particles are ordered as (hadron, remnant, parton).

	Polarization is ignored completely. The beam particle is colorless,
	while partons and beam remnant carry color. The remnant gets a
	special flavor code.
	<<SF lhapdf: public>>=
	public :: lhapdf_t
	<<SF lhapdf: types>>=
	type, extends (sf_int_t) :: lhapdf_t
	type(lhapdf_data_t), pointer :: data => null ()
	real(default) :: x = 0
	real(default) :: q = 0
	real(default) :: s = 0
	contains
	<<SF lhapdf: lhapdf: TBP>>
	end type lhapdf_t

	@ %def lhapdf_t
	@ Type string: display the chosen PDF set.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: type_string => lhapdf_type_string
	<<SF lhapdf: procedures>>=
	function lhapdf_type_string (object) result (string)
	class(lhapdf_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "LHAPDF: " // object%data%file
	else
	string = "LHAPDF: [undefined]"
	end if
	end function lhapdf_type_string

	@ %def lhapdf_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: write => lhapdf_write
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_write (object, unit, testflag)
	class(lhapdf_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(1x,A)") "SF parameters:"
	write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
	if (object%status >= SF_FAILED_EVALUATION) then
	write (u, "(3x,A," // FMT_17 // ")") "Q =", object%q
	end if
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "LHAPDF data: [undefined]"
	end if
	end subroutine lhapdf_write

	@ %def lhapdf_write
	@ Initialize. We know that [[data]] will be of concrete type
	[[sf_lhapdf_data_t]], but we have to cast this explicitly.

	For this implementation, we set the incoming and outgoing masses equal
	to the physical particle mass, but keep the radiated mass zero.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: init => lhapdf_init
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_init (sf_int, data)
	class(lhapdf_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	type(flavor_t) :: flv, flv_remnant
	type(color_t) :: col0
	type(quantum_numbers_t), dimension(3) :: qn
	integer :: i
	select type (data)
	type is (lhapdf_data_t)
	mask = quantum_numbers_mask (.false., .false., .true.)
	call col0%init ()
	call sf_int%base_init (mask, [0._default], [0._default], [0._default])
	sf_int%data => data
	do i = -6, 6
	if (data%mask(i)) then
	call qn(1)%init (data%flv_in, col = col0)
	if (i == 0) then
	call flv%init (GLUON, data%model)
	call flv_remnant%init (HADRON_REMNANT_OCTET, data%model)
	else
	call flv%init (i, data%model)
	call flv_remnant%init &
	(sign (HADRON_REMNANT_TRIPLET, -i), data%model)
	end if
	call qn(2)%init ( &
	flv = flv_remnant, col = color_from_flavor (flv_remnant, 1))
	call qn(2)%tag_radiated ()
	call qn(3)%init ( &
	flv = flv, col = color_from_flavor (flv, 1, reverse=.true.))
	call sf_int%add_state (qn)
	end if
	end do
	if (data%has_photon .and. data%mask_photon) then
	call flv%init (PHOTON, data%model)
	call flv_remnant%init (HADRON_REMNANT_SINGLET, data%model)
	call qn(2)%init (flv = flv_remnant, &
	col = color_from_flavor (flv_remnant, 1))
	call qn(2)%tag_radiated ()
	call qn(3)%init (flv = flv, &
	col = color_from_flavor (flv, 1, reverse=.true.))
	call sf_int%add_state (qn)
	end if
	call sf_int%freeze ()
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	sf_int%status = SF_INITIAL
	end select
	end subroutine lhapdf_init

	@ %def lhapdf_init
	@
	\subsection{Structure function}
	We have to cast the LHAPDF arguments to/from double precision (possibly
	from/to extended/quadruple precision), if necessary. Furthermore,
	some structure functions can yield negative results (sea quarks close
	to $x=1$). We set these unphysical values to zero.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: apply => lhapdf_apply
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_apply (sf_int, scale, rescale, i_sub, fill_sub)
	class(lhapdf_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	logical, intent(in), optional :: fill_sub
	real(default) :: x, s
	double precision :: xx, qq, ss
	double precision, dimension(-6:6) :: ff
	double precision :: fphot
	complex(default), dimension(:), allocatable :: fc
	integer :: i, i_sub_opt, j_sub
	logical :: fill_sub_opt
	external :: evolvePDFM, evolvePDFpM
	i_sub_opt = 0; if (present (i_sub)) i_sub_opt = i_sub
	fill_sub_opt = .false.; if (present (fill_sub)) fill_sub_opt = fill_sub
	if (present (rescale) .and. fill_sub_opt) then
	call msg_bug ("[lhapdf_apply] &
	& sf_rescale and fill_sub option are mutually exclusive.")
	end if
	if (i_sub_opt > 0 .and. fill_sub_opt) then
	call msg_bug ("[lhapdf_apply] &
	& i_sub and fill_sub options are mutually exclusive.")
	end if
	associate (data => sf_int%data)
	sf_int%q = scale
	x = sf_int%x
	if (present (rescale)) call rescale%apply (x)
	s = sf_int%s
	xx = x
	if (debug2_active (D_BEAMS)) then
	call msg_debug2 (D_BEAMS, "lhapdf_apply")
	call msg_debug2 (D_BEAMS, "rescale: ", present(rescale))
	call msg_debug2 (D_BEAMS, "i_sub: ", i_sub_opt)
	call msg_debug2 (D_BEAMS, "fill_sub: ", fill_sub_opt)
	call msg_debug2 (D_BEAMS, "x: ", x)
	end if
	qq = min (data%qmax, scale)
	qq = max (data%qmin, qq)
	if (.not. data% photon) then
	if (data%invert) then
	if (data%has_photon) then
	if (LHAPDF5_AVAILABLE) then
	call evolvePDFphotonM &
	(data% set, xx, qq, ff(6:-6:-1), fphot)
	else if (LHAPDF6_AVAILABLE) then
	call data%pdf%evolve_pdfphotonm &
	(xx, qq, ff(6:-6:-1), fphot)
	end if
	else
	if (data%hoppet_b_matching) then
	call hoppet_eval (xx, qq, ff(6:-6:-1))
	else
	if (LHAPDF5_AVAILABLE) then
	call evolvePDFM (data% set, xx, qq, ff(6:-6:-1))
	else if (LHAPDF6_AVAILABLE) then
	call data%pdf%evolve_pdfm (xx, qq, ff(6:-6:-1))
	end if
	end if
	end if
	else
	if (data%has_photon) then
	if (LHAPDF5_AVAILABLE) then
	call evolvePDFphotonM (data% set, xx, qq, ff, fphot)
	else if (LHAPDF6_AVAILABLE) then
	call data%pdf%evolve_pdfphotonm (xx, qq, ff, fphot)
	end if
	else
	if (data%hoppet_b_matching) then
	call hoppet_eval (xx, qq, ff)
	else
	if (LHAPDF5_AVAILABLE) then
	call evolvePDFM (data% set, xx, qq, ff)
	else if (LHAPDF6_AVAILABLE) then
	call data%pdf%evolve_pdfm (xx, qq, ff)
	end if
	end if
	end if
	end if
	else
	ss = s
	if (LHAPDF5_AVAILABLE) then
	call evolvePDFpM (data% set, xx, qq, &
	ss, data% photon_scheme, ff)
	else if (LHAPDF6_AVAILABLE) then
	call data%pdf%evolve_pdfpm (xx, qq, ss, &
	data%photon_scheme, ff)
	end if
	end if
	if (data%has_photon) then
	allocate (fc (count ([data%mask, data%mask_photon])))
	fc = max (pack ([ff, fphot] / x, &
	[data% mask, data%mask_photon]), 0._default)
	else
	allocate (fc (count (data%mask)))
	fc = max (pack (ff / x, data%mask), 0._default)
	end if
	end associate
	if (debug_active (D_BEAMS)) print *, 'Set pdfs: ', real (fc)
	if (present (rescale) .and. i_sub_opt > 0) then
	call sf_int%set_matrix_element (fc, [(i_sub_opt * size(fc) + i, i = 1, size(fc))])
	if (rescale%has_gluons ()) then
	j_sub = i_sub_opt + n_beam_gluon_offset
	call sf_int%set_matrix_element (&
	spread (fc(7), 1, size(fc)), [(j_sub * size(fc) + i, i = 1, size(fc))])
	end if
	else
	call sf_int%set_matrix_element (fc, [(i, i = 1, size(fc))])
	end if
	if(fill_sub_opt) then
	do j_sub = 1, sf_int%get_n_sub ()
	call sf_int%set_matrix_element (fc, [(j_sub * size(fc) + i, i = 1, size(fc))])
	end do
	end if
	sf_int%status = SF_EVALUATED
	end subroutine lhapdf_apply

	@ %def apply_lhapdf
	@
	\subsection{Strong Coupling}
	Since the PDF codes provide a function for computing the running
	$\alpha_s$ value, we make this available as an implementation of the
	abstract [[alpha_qcd_t]] type, which is used for matrix element evaluation.
	<<SF lhapdf: public>>=
	public :: alpha_qcd_lhapdf_t
	<<SF lhapdf: types>>=
	type, extends (alpha_qcd_t) :: alpha_qcd_lhapdf_t
	type(string_t) :: pdfset_dir
	type(string_t) :: pdfset_file
	integer :: pdfset_member = -1
	type(lhapdf_pdf_t) :: pdf
	contains
	<<SF lhapdf: alpha qcd: TBP>>
	end type alpha_qcd_lhapdf_t

	@ %def alpha_qcd_lhapdf_t
	@ Output. As in earlier versions we leave the LHAPDF path out.
	<<SF lhapdf: alpha qcd: TBP>>=
	procedure :: write => alpha_qcd_lhapdf_write
	<<SF lhapdf: procedures>>=
	subroutine alpha_qcd_lhapdf_write (object, unit)
	class(alpha_qcd_lhapdf_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A)") "QCD parameters (lhapdf):"
	write (u, "(5x,A,A)") "PDF set = ", char (object%pdfset_file)
	write (u, "(5x,A,I0)") "PDF member = ", object%pdfset_member
	end subroutine alpha_qcd_lhapdf_write

	@ %def alpha_qcd_lhapdf_write
	@ Calculation: the numeric member ID selects the correct PDF set, which must
	be properly initialized.
	<<SF lhapdf: interfaces>>=
	interface
	double precision function alphasPDF (Q)
	double precision, intent(in) :: Q
	end function alphasPDF
	end interface

	@ %def alphasPDF
	@
	<<SF lhapdf: alpha qcd: TBP>>=
	procedure :: get => alpha_qcd_lhapdf_get
	<<SF lhapdf: procedures>>=
	function alpha_qcd_lhapdf_get (alpha_qcd, scale) result (alpha)
	class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
	real(default), intent(in) :: scale
	real(default) :: alpha
	if (LHAPDF5_AVAILABLE) then
	alpha = alphasPDF (dble (scale))
	else if (LHAPDF6_AVAILABLE) then
	alpha = alpha_qcd%pdf%alphas_pdf (dble (scale))
	end if
	end function alpha_qcd_lhapdf_get

	@ %def alpha_qcd_lhapdf_get
	@
	Initialization. We need to access the (quasi-global) initialization status.
	<<SF lhapdf: alpha qcd: TBP>>=
	procedure :: init => alpha_qcd_lhapdf_init
	<<SF lhapdf: procedures>>=
	subroutine alpha_qcd_lhapdf_init (alpha_qcd, file, member, path)
	class(alpha_qcd_lhapdf_t), intent(out) :: alpha_qcd
	type(string_t), intent(inout) :: file
	integer, intent(inout) :: member
	type(string_t), intent(inout) :: path
	alpha_qcd%pdfset_file = file
	alpha_qcd%pdfset_member = member
	if (alpha_qcd%pdfset_member < 0) &
	call msg_fatal ("QCD parameter initialization: PDF set " &
	// char (file) // " is unknown")
	if (LHAPDF5_AVAILABLE) then
	call lhapdf_initialize (1, path, file, member)
	else if (LHAPDF6_AVAILABLE) then
	call lhapdf_initialize &
	(1, path, file, member, alpha_qcd%pdf)
	end if
	end subroutine alpha_qcd_lhapdf_init

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

	module sf_lhapdf_ut
	use unit_tests
	use system_dependencies, only: LHAPDF5_AVAILABLE
	use system_dependencies, only: LHAPDF6_AVAILABLE
	use sf_lhapdf_uti

	<<Standard module head>>

	<<SF lhapdf: public test>>

	contains

	<<SF lhapdf: test driver>>

	end module sf_lhapdf_ut
	@ %def sf_lhapdf_ut
	@
	<<[[sf_lhapdf_uti.f90]]>>=
	<<File header>>

	module sf_lhapdf_uti

	<<Use kinds>>
	<<Use strings>>
	use system_dependencies, only: LHAPDF5_AVAILABLE
	use system_dependencies, only: LHAPDF6_AVAILABLE
	use os_interface
	use physics_defs, only: PROTON
	use sm_qcd
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use sf_base

	use sf_lhapdf

	<<Standard module head>>

	<<SF lhapdf: test declarations>>

	contains

	<<SF lhapdf: tests>>

	end module sf_lhapdf_uti
	@ %def sf_lhapdf_ut
	@ API: driver for the unit tests below.
	<<SF lhapdf: public test>>=
	public :: sf_lhapdf_test
	<<SF lhapdf: test driver>>=
	subroutine sf_lhapdf_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF lhapdf: execute tests>>
	end subroutine sf_lhapdf_test

	@ %def sf_lhapdf_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF lhapdf: execute tests>>=
	if (LHAPDF5_AVAILABLE) then
	call test (sf_lhapdf_1, "sf_lhapdf5_1", &
	"structure function configuration", &
	u, results)
	else if (LHAPDF6_AVAILABLE) then
	call test (sf_lhapdf_1, "sf_lhapdf6_1", &
	"structure function configuration", &
	u, results)
	end if
	<<SF lhapdf: test declarations>>=
	public :: sf_lhapdf_1
	<<SF lhapdf: tests>>=
	subroutine sf_lhapdf_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_lhapdf_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call model%init_sm_test ()
	pdg_in = PROTON

	allocate (lhapdf_data_t :: data)
	call data%write (u)

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

	select type (data)
	type is (lhapdf_data_t)
	call data%init (model, pdg_in)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_lhapdf_1

	@ %def sf_lhapdf_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the PDF builtin
	structure function.
	<<SF lhapdf: execute tests>>=
	if (LHAPDF5_AVAILABLE) then
	call test (sf_lhapdf_2, "sf_lhapdf5_2", &
	"structure function instance", &
	u, results)
	else if (LHAPDF6_AVAILABLE) then
	call test (sf_lhapdf_2, "sf_lhapdf6_2", &
	"structure function instance", &
	u, results)
	end if
	<<SF lhapdf: test declarations>>=
	public :: sf_lhapdf_2
	<<SF lhapdf: tests>>=
	subroutine sf_lhapdf_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_lhapdf_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

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

	call model%init_sm_test ()
	call flv%init (PROTON, model)
	pdg_in = PROTON
	call lhapdf_global_reset ()

	call reset_interaction_counter ()

	allocate (lhapdf_data_t :: data)
	select type (data)
	type is (lhapdf_data_t)
	call data%init (model, pdg_in)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.5_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for Q = 100 GeV"
	write (u, "(A)")

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%apply (scale = 100._default)
	call sf_int%write (u, testflag = .true.)


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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_lhapdf_2

	@ %def sf_lhapdf_2
	@
	\subsubsection{Strong Coupling}
	Test $\alpha_s$ as an implementation of the [[alpha_qcd_t]] abstract
	type.
	<<SF lhapdf: execute tests>>=
	if (LHAPDF5_AVAILABLE) then
	call test (sf_lhapdf_3, "sf_lhapdf5_3", &
	"running alpha_s", &
	u, results)
	else if (LHAPDF6_AVAILABLE) then
	call test (sf_lhapdf_3, "sf_lhapdf6_3", &
	"running alpha_s", &
	u, results)
	end if
	<<SF lhapdf: test declarations>>=
	public :: sf_lhapdf_3
	<<SF lhapdf: tests>>=
	subroutine sf_lhapdf_3 (u)
	integer, intent(in) :: u
	type(qcd_t) :: qcd
	type(string_t) :: name, path
	integer :: member

	write (u, "(A)") "* Test output: sf_lhapdf_3"
	write (u, "(A)") "* Purpose: initialize and evaluate alpha_s"
	write (u, "(A)")

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

	call lhapdf_global_reset ()

	if (LHAPDF5_AVAILABLE) then
	name = "cteq6ll.LHpdf"
	member = 1
	path = ""
	else if (LHAPDF6_AVAILABLE) then
	name = "CT10"
	member = 1
	path = ""
	end if

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

	allocate (alpha_qcd_lhapdf_t :: qcd%alpha)
	select type (alpha => qcd%alpha)
	type is (alpha_qcd_lhapdf_t)
	call alpha%init (name, member, path)
	end select
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for Q = 100"
	write (u, "(A)")

	write (u, "(1x,A,F8.5)") "alpha = ", qcd%alpha%get (100._default)

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

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

	end subroutine sf_lhapdf_3

	@ %def sf_lhapdf_3
	@
	\section{Easy PDF Access}
	For the shower, subtraction and matching, it is very useful to have
	direct access to $f(x,Q)$ independently of the used library.
	<<[[pdf.f90]]>>=
	<<File header>>

	module pdf

	<<Use kinds with double>>
	use io_units
	use system_dependencies, only: LHAPDF5_AVAILABLE, LHAPDF6_AVAILABLE
	use diagnostics
	use beam_structures
	use lhapdf !NODEP!
	use pdf_builtin !NODEP!

	<<Standard module head>>

	<<PDF: public>>

	<<PDF: parameters>>

	<<PDF: types>>

	contains

	<<PDF: procedures>>

	end module pdf
	@ %def pdf
	We support the following implementations:
	<<PDF: parameters>>=
	integer, parameter, public :: STRF_NONE = 0
	integer, parameter, public :: STRF_LHAPDF6 = 1
	integer, parameter, public :: STRF_LHAPDF5 = 2
	integer, parameter, public :: STRF_PDF_BUILTIN = 3

	@ %def STRF_NONE STRF_LHAPDF6 STRF_LHAPDF5 STRF_PDF_BUILTIN
	@ A container to bundle all necessary PDF data. Could be moved to a more
	central location.
	<<PDF: public>>=
	public :: pdf_data_t
	<<PDF: types>>=
	type :: pdf_data_t
	type(lhapdf_pdf_t) :: pdf
	real(default) :: xmin, xmax, qmin, qmax
	integer :: type = STRF_NONE
	integer :: set = 0
	contains
	<<PDF: pdf data: TBP>>
	end type pdf_data_t

	@ %def pdf_data
	@
	<<PDF: pdf data: TBP>>=
	procedure :: init => pdf_data_init
	<<PDF: procedures>>=
	subroutine pdf_data_init (pdf_data, pdf_data_in)
	class(pdf_data_t), intent(out) :: pdf_data
	type(pdf_data_t), target, intent(in) :: pdf_data_in
	pdf_data%xmin = pdf_data_in%xmin
	pdf_data%xmax = pdf_data_in%xmax
	pdf_data%qmin = pdf_data_in%qmin
	pdf_data%qmax = pdf_data_in%qmax
	pdf_data%set = pdf_data_in%set
	pdf_data%type = pdf_data_in%type
	if (pdf_data%type == STRF_LHAPDF6) then
	if (pdf_data_in%pdf%is_associated ()) then
	call lhapdf_copy_pointer (pdf_data_in%pdf, pdf_data%pdf)
	else
	call msg_bug ('pdf_data_init: pdf_data%pdf was not associated!')
	end if
	end if
	end subroutine pdf_data_init

	@ %def pdf_data_init
	@
	<<PDF: pdf data: TBP>>=
	procedure :: write => pdf_data_write
	<<PDF: procedures>>=
	subroutine pdf_data_write (pdf_data, unit)
	class(pdf_data_t), intent(in) :: pdf_data
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(3x,A,I0)") "PDF set = ", pdf_data%set
	write (u, "(3x,A,I0)") "PDF type = ", pdf_data%type
	end subroutine pdf_data_write

	@ %def pdf_data_write
	@
	<<PDF: pdf data: TBP>>=
	procedure :: setup => pdf_data_setup
	<<PDF: procedures>>=
	subroutine pdf_data_setup (pdf_data, caller, beam_structure, lhapdf_member, set)
	class(pdf_data_t), intent(inout) :: pdf_data
	character(len=*), intent(in) :: caller
	type(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: lhapdf_member, set
	real(default) :: xmin, xmax, q2min, q2max
	pdf_data%set = set
	if (beam_structure%contains ("lhapdf")) then
	if (LHAPDF6_AVAILABLE) then
	pdf_data%type = STRF_LHAPDF6
	else if (LHAPDF5_AVAILABLE) then
	pdf_data%type = STRF_LHAPDF5
	end if
	write (msg_buffer, "(A,I0)") caller &
	// ": interfacing LHAPDF set #", pdf_data%set
	call msg_message ()
	else if (beam_structure%contains ("pdf_builtin")) then
	pdf_data%type = STRF_PDF_BUILTIN
	write (msg_buffer, "(A,I0)") caller &
	// ": interfacing PDF builtin set #", pdf_data%set
	call msg_message ()
	end if
	select case (pdf_data%type)
	case (STRF_LHAPDF6)
	pdf_data%xmin = pdf_data%pdf%getxmin ()
	pdf_data%xmax = pdf_data%pdf%getxmax ()
	pdf_data%qmin = sqrt(pdf_data%pdf%getq2min ())
	pdf_data%qmax = sqrt(pdf_data%pdf%getq2max ())
	case (STRF_LHAPDF5)
	call GetXminM (1, lhapdf_member, xmin)
	call GetXmaxM (1, lhapdf_member, xmax)
	call GetQ2minM (1, lhapdf_member, q2min)
	call GetQ2maxM (1, lhapdf_member, q2max)
	pdf_data%xmin = xmin
	pdf_data%xmax = xmax
	pdf_data%qmin = sqrt(q2min)
	pdf_data%qmax = sqrt(q2max)
	end select
	end subroutine pdf_data_setup

	@ %def pdf_data_setup
	@ This could be overloaded with a version that only asks for a specific
	flavor as it is supported by LHAPDF6.
	<<PDF: pdf data: TBP>>=
	procedure :: evolve => pdf_data_evolve
	<<PDF: procedures>>=
	subroutine pdf_data_evolve (pdf_data, x, q_in, f)
	class(pdf_data_t), intent(inout) :: pdf_data
	real(double), intent(in) :: x, q_in
	real(double), dimension(-6:6), intent(out) :: f
	real(double) :: q
	select case (pdf_data%type)
	case (STRF_PDF_BUILTIN)
	call pdf_evolve_LHAPDF (pdf_data%set, x, q_in, f)
	case (STRF_LHAPDF6)
	q = min (pdf_data%qmax, q_in)
	q = max (pdf_data%qmin, q)
	call pdf_data%pdf%evolve_pdfm (x, q, f)
	case (STRF_LHAPDF5)
	q = min (pdf_data%qmax, q_in)
	q = max (pdf_data%qmin, q)
	call evolvePDFM (pdf_data%set, x, q, f)
	case default
	call msg_fatal ("PDF function: unknown PDF method.")
	end select
	end subroutine pdf_data_evolve
	@ %def pdf_data_evolve
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Dispatch}
	@
	<<[[dispatch_beams.f90]]>>=
	<<File header>>

	module dispatch_beams

	<<Use kinds>>
	<<Use strings>>
	use diagnostics
	use os_interface, only: os_data_t
	use variables, only: var_list_t
	use constants, only: PI
	use numeric_utils, only: vanishes
	use physics_defs, only: PHOTON
	use rng_base, only: rng_factory_t
	use pdg_arrays
	use model_data, only: model_data_t
	use dispatch_rng, only: dispatch_rng_factory
	use dispatch_rng, only: update_rng_seed_in_var_list
	use flavors, only: flavor_t
	use sm_qcd, only: qcd_t, alpha_qcd_fixed_t, alpha_qcd_from_scale_t
	use sm_qcd, only: alpha_qcd_from_lambda_t
	use physics_defs, only: MZ_REF, ALPHA_QCD_MZ_REF

	use beam_structures
	use sf_base
	use sf_mappings
	use sf_isr
	use sf_epa
	use sf_ewa
	use sf_escan
	use sf_gaussian
	use sf_beam_events
	use sf_circe1
	use sf_circe2
	use sf_pdf_builtin
	use sf_lhapdf

	<<Standard module head>>

	<<Dispatch beams: public>>

	<<Dispatch beams: types>>

	<<Dispatch beams: variables>>

	contains

	<<Dispatch beams: procedures>>

	end module dispatch_beams
	@ %def dispatch_beams
	@ This data type is a container for transferring structure-function
	specific data from the [[dispatch_sf_data]] to the
	[[dispatch_sf_channels]] subroutine.
	<<Dispatch beams: public>>=
	public :: sf_prop_t
	<<Dispatch beams: types>>=
	type :: sf_prop_t
	real(default), dimension(2) :: isr_eps = 1
	end type sf_prop_t

	@ %def sf_prop_t
	@
	Allocate a structure-function configuration object according to the
	[[sf_method]] string.

	The [[sf_prop]] object can be used to transfer structure-function
	specific data up and to the [[dispatch_sf_channels]] subroutine below,
	so they can be used for particular mappings.

	The [[var_list_global]] object is used for the RNG generator seed.
	It is intent(inout) because the RNG generator seed
	may change during initialization.

	The [[pdg_in]] array is the array of incoming flavors, corresponding
	to the upstream structure function or the beam array. This will be
	checked for the structure function in question and replaced by the
	outgoing flavors. The [[pdg_prc]] array is the array of incoming
	flavors (beam index, component index) for the hard process.
	<<Dispatch beams: public>>=
	public :: dispatch_sf_data
	<<Dispatch beams: procedures>>=
	subroutine dispatch_sf_data (data, sf_method, i_beam, sf_prop, &
	var_list, var_list_global, model, &
	os_data, sqrts, pdg_in, pdg_prc, polarized)
	class(sf_data_t), allocatable, intent(inout) :: data
	type(string_t), intent(in) :: sf_method
	integer, dimension(:), intent(in) :: i_beam
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_in
	type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
	type(sf_prop_t), intent(inout) :: sf_prop
	type(var_list_t), intent(in) :: var_list
	type(var_list_t), intent(inout) :: var_list_global
	integer :: next_rng_seed
	class(model_data_t), target, intent(in) :: model
	type(os_data_t), intent(in) :: os_data
	real(default), intent(in) :: sqrts
	logical, intent(in) :: polarized
	type(pdg_array_t), dimension(:), allocatable :: pdg_out
	real(default) :: isr_alpha, isr_q_max, isr_mass
	integer :: isr_order
	logical :: isr_recoil, isr_keep_energy
	real(default) :: epa_alpha, epa_x_min, epa_q_min, epa_e_max, epa_mass
	logical :: epa_recoil, epa_keep_energy
	real(default) :: ewa_x_min, ewa_pt_max, ewa_mass
	logical :: ewa_recoil, ewa_keep_energy
	type(pdg_array_t), dimension(:), allocatable :: pdg_prc1
	integer :: ewa_id
	type(string_t) :: pdf_name
	type(string_t) :: lhapdf_dir, lhapdf_file
	type(string_t), dimension(13) :: lhapdf_photon_sets
	integer :: lhapdf_member, lhapdf_photon_scheme
	logical :: hoppet_b_matching
	class(rng_factory_t), allocatable :: rng_factory
	logical :: circe1_photon1, circe1_photon2, circe1_generate, &
	circe1_with_radiation
	real(default) :: circe1_sqrts, circe1_eps
	integer :: circe1_version, circe1_chattiness, &
	circe1_revision
	character(6) :: circe1_accelerator
	logical :: circe2_polarized
	type(string_t) :: circe2_design, circe2_file
	real(default), dimension(2) :: gaussian_spread
	logical :: beam_events_warn_eof
	type(string_t) :: beam_events_dir, beam_events_file
	logical :: escan_normalize
	integer :: i
	lhapdf_photon_sets = [var_str ("DOG0.LHgrid"), var_str ("DOG1.LHgrid"), &
	var_str ("DGG.LHgrid"), var_str ("LACG.LHgrid"), &
	var_str ("GSG0.LHgrid"), var_str ("GSG1.LHgrid"), &
	var_str ("GSG960.LHgrid"), var_str ("GSG961.LHgrid"), &
	var_str ("GRVG0.LHgrid"), var_str ("GRVG1.LHgrid"), &
	var_str ("ACFGPG.LHgrid"), var_str ("WHITG.LHgrid"), &
	var_str ("SASG.LHgrid")]
	select case (char (sf_method))
	case ("pdf_builtin")
	allocate (pdf_builtin_data_t :: data)
	select type (data)
	type is (pdf_builtin_data_t)
	pdf_name = &
	var_list%get_sval (var_str ("$pdf_builtin_set"))
	hoppet_b_matching = &
	var_list%get_lval (var_str ("?hoppet_b_matching"))
	call data%init ( &
	model, pdg_in(i_beam(1)), &
	name = pdf_name, &
	path = os_data%pdf_builtin_datapath, &
	hoppet_b_matching = hoppet_b_matching)
	end select
	case ("pdf_builtin_photon")
	call msg_fatal ("Currently, there are no photon PDFs built into WHIZARD,", &
	[var_str ("for the photon content inside a proton or neutron use"), &
	var_str ("the 'lhapdf_photon' structure function.")])
	case ("lhapdf")
	allocate (lhapdf_data_t :: data)
	if (pdg_array_get (pdg_in(i_beam(1)), 1) == PHOTON) then
	call msg_fatal ("The 'lhapdf' structure is intended only for protons and", &
	[var_str ("pions, please use 'lhapdf_photon' for photon beams.")])
	end if
	lhapdf_dir = &
	var_list%get_sval (var_str ("$lhapdf_dir"))
	lhapdf_file = &
	var_list%get_sval (var_str ("$lhapdf_file"))
	lhapdf_member = &
	var_list%get_ival (var_str ("lhapdf_member"))
	lhapdf_photon_scheme = &
	var_list%get_ival (var_str ("lhapdf_photon_scheme"))
	hoppet_b_matching = &
	var_list%get_lval (var_str ("?hoppet_b_matching"))
	select type (data)
	type is (lhapdf_data_t)
	call data%init &
	(model, pdg_in(i_beam(1)), &
	lhapdf_dir, lhapdf_file, lhapdf_member, &
	lhapdf_photon_scheme, hoppet_b_matching)
	end select
	case ("lhapdf_photon")
	allocate (lhapdf_data_t :: data)
	if (pdg_array_get_length (pdg_in(i_beam(1))) /= 1 .or. &
	pdg_array_get (pdg_in(i_beam(1)), 1) /= PHOTON) then
	call msg_fatal ("The 'lhapdf_photon' structure function is exclusively for", &
	[var_str ("photon PDFs, i.e. for photons as beam particles")])
	end if
	lhapdf_dir = &
	var_list%get_sval (var_str ("$lhapdf_dir"))
	lhapdf_file = &
	var_list%get_sval (var_str ("$lhapdf_photon_file"))
	lhapdf_member = &
	var_list%get_ival (var_str ("lhapdf_member"))
	lhapdf_photon_scheme = &
	var_list%get_ival (var_str ("lhapdf_photon_scheme"))
	if (.not. any (lhapdf_photon_sets == lhapdf_file)) then
	call msg_fatal ("This PDF set is not supported or not " // &
	"intended for photon beams.")
	end if
	select type (data)
	type is (lhapdf_data_t)
	call data%init &
	(model, pdg_in(i_beam(1)), &
	lhapdf_dir, lhapdf_file, lhapdf_member, &
	lhapdf_photon_scheme)
	end select
	case ("isr")
	allocate (isr_data_t :: data)
	isr_alpha = &
	var_list%get_rval (var_str ("isr_alpha"))
	if (vanishes (isr_alpha)) then
	isr_alpha = (var_list%get_rval (var_str ("ee"))) &
	** 2 / (4 * PI)
	end if
	isr_q_max = &
	var_list%get_rval (var_str ("isr_q_max"))
	if (vanishes (isr_q_max)) then
	isr_q_max = sqrts
	end if
	isr_mass = var_list%get_rval (var_str ("isr_mass"))
	isr_order = var_list%get_ival (var_str ("isr_order"))
	isr_recoil = var_list%get_lval (var_str ("?isr_recoil"))
	isr_keep_energy = var_list%get_lval (var_str ("?isr_keep_energy"))
	select type (data)
	type is (isr_data_t)
	call data%init &
	(model, pdg_in (i_beam(1)), isr_alpha, isr_q_max, &
	isr_mass, isr_order, recoil = isr_recoil, keep_energy = &
	isr_keep_energy)
	call data%check ()
	sf_prop%isr_eps(i_beam(1)) = data%get_eps ()
	end select
	case ("epa")
	allocate (epa_data_t :: data)
	epa_alpha = var_list%get_rval (var_str ("epa_alpha"))
	if (vanishes (epa_alpha)) then
	epa_alpha = (var_list%get_rval (var_str ("ee"))) &
	** 2 / (4 * PI)
	end if
	epa_x_min = var_list%get_rval (var_str ("epa_x_min"))
	epa_q_min = var_list%get_rval (var_str ("epa_q_min"))
	epa_e_max = var_list%get_rval (var_str ("epa_e_max"))
	if (vanishes (epa_e_max)) then
	epa_e_max = sqrts
	end if
	epa_mass = var_list%get_rval (var_str ("epa_mass"))
	epa_recoil = var_list%get_lval (var_str ("?epa_recoil"))
	epa_keep_energy = var_list%get_lval (var_str ("?epa_keep_energy"))
	select type (data)
	type is (epa_data_t)
	call data%init &
	(model, pdg_in (i_beam(1)), epa_alpha, epa_x_min, &
	epa_q_min, epa_e_max, epa_mass, recoil = epa_recoil, &
	keep_energy = epa_keep_energy)
	call data%check ()
	end select
	case ("ewa")
	allocate (ewa_data_t :: data)
	allocate (pdg_prc1 (size (pdg_prc, 2)))
	pdg_prc1 = pdg_prc(i_beam(1),:)
	if (any (pdg_array_get_length (pdg_prc1) /= 1) &
	.or. any (pdg_prc1 /= pdg_prc1(1))) then
	call msg_fatal &
	("EWA: process incoming particle (W/Z) must be unique")
	end if
	ewa_id = abs (pdg_array_get (pdg_prc1(1), 1))
	ewa_x_min = var_list%get_rval (var_str ("ewa_x_min"))
	ewa_pt_max = var_list%get_rval (var_str ("ewa_pt_max"))
	if (vanishes (ewa_pt_max)) then
	ewa_pt_max = sqrts
	end if
	ewa_mass = var_list%get_rval (var_str ("ewa_mass"))
	ewa_recoil = var_list%get_lval (&
	var_str ("?ewa_recoil"))
	ewa_keep_energy = var_list%get_lval (&
	var_str ("?ewa_keep_energy"))
	select type (data)
	type is (ewa_data_t)
	call data%init &
	(model, pdg_in (i_beam(1)), ewa_x_min, &
	ewa_pt_max, sqrts, ewa_recoil, &
	ewa_keep_energy, ewa_mass)
	call data%set_id (ewa_id)
	call data%check ()
	end select
	case ("circe1")
	allocate (circe1_data_t :: data)
	select type (data)
	type is (circe1_data_t)
	circe1_photon1 = &
	var_list%get_lval (var_str ("?circe1_photon1"))
	circe1_photon2 = &
	var_list%get_lval (var_str ("?circe1_photon2"))
	circe1_sqrts = &
	var_list%get_rval (var_str ("circe1_sqrts"))
	circe1_eps = &
	var_list%get_rval (var_str ("circe1_eps"))
	if (circe1_sqrts <= 0) circe1_sqrts = sqrts
	circe1_generate = &
	var_list%get_lval (var_str ("?circe1_generate"))
	circe1_version = &
	var_list%get_ival (var_str ("circe1_ver"))
	circe1_revision = &
	var_list%get_ival (var_str ("circe1_rev"))
	circe1_accelerator = &
	char (var_list%get_sval (var_str ("$circe1_acc")))
	circe1_chattiness = &
	var_list%get_ival (var_str ("circe1_chat"))
	circe1_with_radiation = &
	var_list%get_lval (var_str ("?circe1_with_radiation"))
	call data%init (model, pdg_in, circe1_sqrts, circe1_eps, &
	[circe1_photon1, circe1_photon2], &
	circe1_version, circe1_revision, circe1_accelerator, &
	circe1_chattiness, circe1_with_radiation)
	if (circe1_generate) then
	call msg_message ("CIRCE1: activating generator mode")
	call dispatch_rng_factory &
	(rng_factory, var_list_global, next_rng_seed)
	call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
	call data%set_generator_mode (rng_factory)
	end if
	end select
	case ("circe2")
	allocate (circe2_data_t :: data)
	select type (data)
	type is (circe2_data_t)
	circe2_polarized = &
	var_list%get_lval (var_str ("?circe2_polarized"))
	circe2_file = &
	var_list%get_sval (var_str ("$circe2_file"))
	circe2_design = &
	var_list%get_sval (var_str ("$circe2_design"))
	call data%init (os_data, model, pdg_in, sqrts, &
	circe2_polarized, polarized, circe2_file, circe2_design)
	call msg_message ("CIRCE2: activating generator mode")
	call dispatch_rng_factory &
	(rng_factory, var_list_global, next_rng_seed)
	call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
	call data%set_generator_mode (rng_factory)
	end select
	case ("gaussian")
	allocate (gaussian_data_t :: data)
	select type (data)
	type is (gaussian_data_t)
	gaussian_spread = &
	[var_list%get_rval (var_str ("gaussian_spread1")), &
	var_list%get_rval (var_str ("gaussian_spread2"))]
	call dispatch_rng_factory &
	(rng_factory, var_list_global, next_rng_seed)
	call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
	call data%init (model, pdg_in, gaussian_spread, rng_factory)
	end select
	case ("beam_events")
	allocate (beam_events_data_t :: data)
	select type (data)
	type is (beam_events_data_t)
	beam_events_dir = os_data%whizard_beamsimpath
	beam_events_file = var_list%get_sval (&
	var_str ("$beam_events_file"))
	beam_events_warn_eof = var_list%get_lval (&
	var_str ("?beam_events_warn_eof"))
	call data%init (model, pdg_in, &
	beam_events_dir, beam_events_file, beam_events_warn_eof)
	end select
	case ("energy_scan")
	escan_normalize = &
	var_list%get_lval (var_str ("?energy_scan_normalize"))
	allocate (escan_data_t :: data)
	select type (data)
	type is (escan_data_t)
	if (escan_normalize) then
	call data%init (model, pdg_in)
	else
	call data%init (model, pdg_in, sqrts)
	end if
	end select
	case default
	if (associated (dispatch_sf_data_extra)) then
	call dispatch_sf_data_extra (data, sf_method, i_beam, &
	sf_prop, var_list, var_list_global, model, os_data, sqrts, pdg_in, &
	pdg_prc, polarized)
	end if
	if (.not. allocated (data)) then
	call msg_fatal ("Structure function '" &
	// char (sf_method) // "' not implemented")
	end if
	end select
	if (allocated (data)) then
	allocate (pdg_out (size (pdg_prc, 1)))
	call data%get_pdg_out (pdg_out)
	do i = 1, size (i_beam)
	pdg_in(i_beam(i)) = pdg_out(i)
	end do
	end if
	end subroutine dispatch_sf_data

	@ %def dispatch_sf_data
	@ This is a hook that allows us to inject further handlers for
	structure-function objects, in particular a test structure function.
	<<Dispatch beams: public>>=
	public :: dispatch_sf_data_extra
	<<Dispatch beams: variables>>=
	procedure (dispatch_sf_data), pointer :: &
	dispatch_sf_data_extra => null ()
	@ %def dispatch_sf_data_extra
	@ This is an auxiliary procedure, used by the beam-structure
	expansion: tell for a given structure function name, whether it
	corresponds to a pair spectrum ($n=2$), a single-particle structure
	function ($n=1$), or nothing ($n=0$). Though [[energy_scan]] can
	in principle also be a pair spectrum, it always has only one
	parameter.
	<<Dispatch beams: public>>=
	public :: strfun_mode
	<<Dispatch beams: procedures>>=
	function strfun_mode (name) result (n)
	type(string_t), intent(in) :: name
	integer :: n
	select case (char (name))
	case ("none")
	n = 0
	case ("sf_test_0", "sf_test_1")
	n = 1
	case ("pdf_builtin","pdf_builtin_photon", &
	"lhapdf","lhapdf_photon")
	n = 1
	case ("isr","epa","ewa")
	n = 1
	case ("circe1", "circe2")
	n = 2
	case ("gaussian")
	n = 2
	case ("beam_events")
	n = 2
	case ("energy_scan")
	n = 2
	case default
	n = -1
	call msg_bug ("Structure function '" // char (name) &
	// "' not supported yet")
	end select
	end function strfun_mode

	@ %def strfun_mode
	@ Dispatch a whole structure-function chain, given beam data and beam
	structure data.

	This could be done generically, but we should look at the specific
	combination of structure functions in order to select appropriate mappings.

	The [[beam_structure]] argument gets copied because
	we want to expand it to canonical form (one valid structure-function
	entry per record) before proceeding further.

	The [[pdg_prc]] argument is the array of incoming flavors. The first
	index is the beam index, the second one the process component index.
	Each element is itself a PDG array, notrivial if there is a flavor sum
	for the incoming state of this component.

	The dispatcher is divided in two parts. The first part configures the
	structure function data themselves. After this, we can configure the
	phase space for the elementary process.
	<<Dispatch beams: public>>=
	public :: dispatch_sf_config
	<<Dispatch beams: procedures>>=
	subroutine dispatch_sf_config (sf_config, sf_prop, beam_structure, &
	var_list, var_list_global, model, os_data, sqrts, pdg_prc)
	type(sf_config_t), dimension(:), allocatable, intent(out) :: sf_config
	type(sf_prop_t), intent(out) :: sf_prop
	type(beam_structure_t), intent(inout) :: beam_structure
	type(var_list_t), intent(in) :: var_list
	type(var_list_t), intent(inout) :: var_list_global
	class(model_data_t), target, intent(in) :: model
	type(os_data_t), intent(in) :: os_data
	real(default), intent(in) :: sqrts
	class(sf_data_t), allocatable :: sf_data
	type(beam_structure_t) :: beam_structure_tmp
	type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
	type(string_t), dimension(:), allocatable :: prt_in
	type(pdg_array_t), dimension(:), allocatable :: pdg_in
	type(flavor_t) :: flv_in
	integer :: n_beam, n_record, i
	beam_structure_tmp = beam_structure
	call beam_structure_tmp%expand (strfun_mode)
	n_record = beam_structure_tmp%get_n_record ()
	allocate (sf_config (n_record))
	n_beam = beam_structure_tmp%get_n_beam ()
	if (n_beam > 0) then
	allocate (prt_in (n_beam), pdg_in (n_beam))
	prt_in = beam_structure_tmp%get_prt ()
	do i = 1, n_beam
	call flv_in%init (prt_in(i), model)
	pdg_in(i) = flv_in%get_pdg ()
	end do
	else
	n_beam = size (pdg_prc, 1)
	allocate (pdg_in (n_beam))
	pdg_in = pdg_prc(:,1)
	end if
	do i = 1, n_record
	call dispatch_sf_data (sf_data, &
	beam_structure_tmp%get_name (i), &
	beam_structure_tmp%get_i_entry (i), &
	sf_prop, var_list, var_list_global, model, os_data, sqrts, &
	pdg_in, pdg_prc, &
	beam_structure_tmp%polarized ())
	call sf_config(i)%init (beam_structure_tmp%get_i_entry (i), sf_data)
	deallocate (sf_data)
	end do
	end subroutine dispatch_sf_config

	@ %def dispatch_sf_config
	@
	\subsection{QCD coupling}
	Allocate the [[alpha]] (running coupling) component of the [[qcd]] block with
	a concrete implementation, depending on the variable settings in the
	[[global]] record.

	If a fixed $\alpha_s$ is requested, we do not allocate the
	[[qcd%alpha]] object. In this case, the matrix element code will just take
	the model parameter as-is, which implies fixed $\alpha_s$. If the
	object is allocated, the $\alpha_s$ value is computed and updated for
	each matrix-element call.

	Also fetch the [[alphas_nf]] variable from the list and store it in
	the QCD record. This is not used in the $\alpha_s$ calculation, but
	the QCD record thus becomes a messenger for this user parameter.
	<<Dispatch beams: public>>=
	public :: dispatch_qcd
	<<Dispatch beams: procedures>>=
	subroutine dispatch_qcd (qcd, var_list, os_data)
	type(qcd_t), intent(inout) :: qcd
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	logical :: fixed, from_mz, from_pdf_builtin, from_lhapdf, from_lambda_qcd
	real(default) :: mz, alpha_val, lambda
	integer :: nf, order, lhapdf_member
	type(string_t) :: pdfset, lhapdf_dir, lhapdf_file
	call unpack_variables ()
	if (allocated (qcd%alpha)) deallocate (qcd%alpha)
	if (from_lhapdf .and. from_pdf_builtin) then
	call msg_fatal (" Mixing alphas evolution", &
	[var_str (" from LHAPDF and builtin PDF is not permitted")])
	end if
	select case (count ([from_mz, from_pdf_builtin, from_lhapdf, from_lambda_qcd]))
	case (0)
	if (fixed) then
	allocate (alpha_qcd_fixed_t :: qcd%alpha)
	else
	call msg_fatal ("QCD alpha: no calculation mode set")
	end if
	case (2:)
	call msg_fatal ("QCD alpha: calculation mode is ambiguous")
	case (1)
	if (fixed) then
	call msg_fatal ("QCD alpha: use '?alphas_is_fixed = false' for " // &
	"running alphas")
	else if (from_mz) then
	allocate (alpha_qcd_from_scale_t :: qcd%alpha)
	else if (from_pdf_builtin) then
	allocate (alpha_qcd_pdf_builtin_t :: qcd%alpha)
	else if (from_lhapdf) then
	allocate (alpha_qcd_lhapdf_t :: qcd%alpha)
	else if (from_lambda_qcd) then
	allocate (alpha_qcd_from_lambda_t :: qcd%alpha)
	end if
	call msg_message ("QCD alpha: using a running strong coupling")
	end select
	call init_alpha ()
	qcd%n_f = var_list%get_ival (var_str ("alphas_nf"))
	contains
	<<Dispatch qcd: dispatch qcd: procedures>>
	end subroutine dispatch_qcd

	@ %def dispatch_qcd
	@
	<<Dispatch qcd: dispatch qcd: procedures>>=
	subroutine unpack_variables ()
	fixed = var_list%get_lval (var_str ("?alphas_is_fixed"))
	from_mz = var_list%get_lval (var_str ("?alphas_from_mz"))
	from_pdf_builtin = &
	var_list%get_lval (var_str ("?alphas_from_pdf_builtin"))
	from_lhapdf = &
	var_list%get_lval (var_str ("?alphas_from_lhapdf"))
	from_lambda_qcd = &
	var_list%get_lval (var_str ("?alphas_from_lambda_qcd"))
	pdfset = var_list%get_sval (var_str ("$pdf_builtin_set"))
	lambda = var_list%get_rval (var_str ("lambda_qcd"))
	nf = var_list%get_ival (var_str ("alphas_nf"))
	order = var_list%get_ival (var_str ("alphas_order"))
	lhapdf_dir = var_list%get_sval (var_str ("$lhapdf_dir"))
	lhapdf_file = var_list%get_sval (var_str ("$lhapdf_file"))
	lhapdf_member = var_list%get_ival (var_str ("lhapdf_member"))
	if (var_list%contains (var_str ("mZ"))) then
	mz = var_list%get_rval (var_str ("mZ"))
	else
	mz = MZ_REF
	end if
	if (var_list%contains (var_str ("alphas"))) then
	alpha_val = var_list%get_rval (var_str ("alphas"))
	else
	alpha_val = ALPHA_QCD_MZ_REF
	end if
	end subroutine unpack_variables

	@
	<<Dispatch qcd: dispatch qcd: procedures>>=
	subroutine init_alpha ()
	select type (alpha => qcd%alpha)
	type is (alpha_qcd_fixed_t)
	alpha%val = alpha_val
	type is (alpha_qcd_from_scale_t)
	alpha%mu_ref = mz
	alpha%ref = alpha_val
	alpha%order = order
	alpha%nf = nf
	type is (alpha_qcd_from_lambda_t)
	alpha%lambda = lambda
	alpha%order = order
	alpha%nf = nf
	type is (alpha_qcd_pdf_builtin_t)
	call alpha%init (pdfset, &
	os_data%pdf_builtin_datapath)
	type is (alpha_qcd_lhapdf_t)
	call alpha%init (lhapdf_file, lhapdf_member, lhapdf_dir)
	end select
	end subroutine init_alpha

	@

File Metadata

Mime Type: text/x-diff
Expires: Tue, Sep 30, 5:44 AM (8 h, 41 m)
Storage Engine: blob
Storage Format: Raw Data
Storage Handle: 6566326
Default Alt Text: (892 KB)

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions