Index: trunk/src/physics/physics.nw
===================================================================
--- trunk/src/physics/physics.nw	(revision 8834)
+++ trunk/src/physics/physics.nw	(revision 8835)
@@ -1,8511 +1,9066 @@
 % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
 % WHIZARD code as NOWEB source: physics and such
 \chapter{Physics}
 \includemodulegraph{physics}
 
 Here we collect definitions and functions that we need for (particle)
 physics in general, to make them available for the more specific needs
 of WHIZARD.
 \begin{description}
 \item[physics\_defs]
   Physical constants.
 \item[c\_particles]
   A simple data type for particles which is C compatible.
 \item[lorentz]
   Define three-vectors, four-vectors and Lorentz
   transformations and common operations for them.
 \item[phs\_point]
   Collections of Lorentz vectors.
 \item[sm\_physics]
   Here, running functions are stored for special kinematical setup like
   running coupling constants, Catani-Seymour dipoles, or Sudakov factors.
 \item[sm\_qcd]
   Definitions and methods for dealing with the running QCD coupling.
 \item[shower\_algorithms]
   Algorithms typically used in Parton Showers as well as in their
   matching to NLO computations, e.g. with the POWHEG method.
 \end{description}
 
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Physics Constants}
 There is also the generic [[constants]] module.  The constants listed
 here are more specific for particle physics.
 <<[[physics_defs.f90]]>>=
 <<File header>>
 
 module physics_defs
 
 <<Use kinds>>
 <<Use strings>>
   use constants, only: one, two, three
 
 <<Standard module head>>
 
 <<Physics defs: public parameters>>
 
 <<Physics defs: public>>
 
 <<Physics defs: interfaces>>
 
   interface
 <<Physics defs: sub interfaces>>
   end interface
 
 end module physics_defs
 @ %def physics_defs
 @
 <<[[physics_defs_sub.f90]]>>=
 <<File header>>
 
 submodule (physics_defs) physics_defs_s
 
   implicit none
 
 contains
 
 <<Physics defs: procedures>>
 
 end submodule physics_defs_s
 
 @ %def physics_defs_s
 @
 \subsection{Units}
 Conversion from energy units to cross-section units.
 <<Physics defs: public parameters>>=
   real(default), parameter, public :: &
        conv = 0.38937966e12_default
 @
 Conversion from millimeter to nanoseconds for lifetimes.
 <<Physics defs: public parameters>>=
   real(default), parameter, public :: &
        ns_per_mm = 1.e6_default / 299792458._default
 @
 Rescaling factor.
 <<Physics defs: public parameters>>=
   real(default), parameter, public :: &
        pb_per_fb = 1.e-3_default
 @
 String for the default energy and cross-section units.
 <<Physics defs: public parameters>>=
   character(*), parameter, public :: &
        energy_unit = "GeV"
   character(*), parameter, public :: &
        cross_section_unit = "fb"
 @
 \subsection{SM and QCD constants}
 <<Physics defs: public parameters>>=
   real(default), parameter, public :: &
        NC = three, &
        CF = (NC**2 - one) / two / NC, &
        CA = NC, &
        TR = one / two
 @
 \subsection{Parameter Reference values}
 These are used exclusively in the context of
 running QCD parameters.  In other contexts, we rely on the uniform
 parameter set as provided by the model definition, modifiable by the
 user.
 <<Physics defs: public parameters>>=
   real(default), public, parameter :: MZ_REF = 91.188_default
   real(default), public, parameter :: ME_REF = 0.000510998928_default
   real(default), public, parameter :: ALPHA_QCD_MZ_REF = 0.1178_default
   real(default), public, parameter :: ALPHA_QED_ME_REF = 0.0072973525693_default
   real(default), public, parameter :: LAMBDA_QCD_REF = 200.e-3_default
 @ %def alpha_s_mz_ref mz_ref lambda_qcd_ref
 @
 \subsection{Particle codes}
 Let us define a few particle codes independent of the model.
 
 We need an UNDEFINED value:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: UNDEFINED = 0
 
 @ %def UNDEFINED
 @ SM fermions:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: DOWN_Q = 1
   integer, parameter, public :: UP_Q = 2
   integer, parameter, public :: STRANGE_Q = 3
   integer, parameter, public :: CHARM_Q = 4
   integer, parameter, public :: BOTTOM_Q = 5
   integer, parameter, public :: TOP_Q = 6
   integer, parameter, public :: ELECTRON = 11
   integer, parameter, public :: ELECTRON_NEUTRINO = 12
   integer, parameter, public :: MUON = 13
   integer, parameter, public :: MUON_NEUTRINO = 14
   integer, parameter, public :: TAU = 15
   integer, parameter, public :: TAU_NEUTRINO = 16
 
 @ %def ELECTRON MUON TAU
 @ Gauge bosons:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: GLUON = 21
   integer, parameter, public :: PHOTON = 22
   integer, parameter, public :: PHOTON_OFFSHELL = -2002
   integer, parameter, public :: PHOTON_ONSHELL = 2002
   integer, parameter, public :: Z_BOSON = 23
   integer, parameter, public :: W_BOSON = 24
 
 @ %def GLUON PHOTON Z_BOSON W_BOSON
 @ Light mesons:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: PION = 111
   integer, parameter, public :: PIPLUS = 211
   integer, parameter, public :: PIMINUS = - PIPLUS
 
 @ %def PION PIPLUS PIMINUS
 @ Di-Quarks:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: UD0 = 2101
   integer, parameter, public :: UD1 = 2103
   integer, parameter, public :: UU1 = 2203
 
 @ %def UD0 UD1 UU1
 @ Mesons:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: K0L = 130
   integer, parameter, public :: K0S = 310
   integer, parameter, public :: K0 = 311
   integer, parameter, public :: KPLUS = 321
   integer, parameter, public :: DPLUS = 411
   integer, parameter, public :: D0 = 421
   integer, parameter, public :: B0 = 511
   integer, parameter, public :: BPLUS = 521
 
 @ %def K0L K0S K0 KPLUS DPLUS D0 B0 BPLUS
 @ Light baryons:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: PROTON = 2212
   integer, parameter, public :: NEUTRON = 2112
   integer, parameter, public :: DELTAPLUSPLUS = 2224
   integer, parameter, public :: DELTAPLUS = 2214
   integer, parameter, public :: DELTA0 = 2114
   integer, parameter, public :: DELTAMINUS = 1114
 
 @ %def PROTON NEUTRON DELTAPLUSPLUS DELTAPLUS DELTA0 DELTAMINUS
 @ Strange baryons:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: SIGMAPLUS = 3222
   integer, parameter, public :: SIGMA0 = 3212
   integer, parameter, public :: SIGMAMINUS = 3112
 
 @ %def SIGMAPLUS SIGMA0 SIGMAMINUS
 @ Charmed baryons:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: SIGMACPLUSPLUS = 4222
   integer, parameter, public :: SIGMACPLUS = 4212
   integer, parameter, public :: SIGMAC0 = 4112
 
 @ %def SIGMACPLUSPLUS SIGMACPLUS SIGMAC0
 @ Bottom baryons:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: SIGMAB0 = 5212
   integer, parameter, public :: SIGMABPLUS = 5222
 
 @ %def SIGMAB0 SIGMABPLUS
 @ 81-100 are reserved for internal codes. Hadron and beam remnants:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: BEAM_REMNANT = 9999
   integer, parameter, public :: HADRON_REMNANT = 90
   integer, parameter, public :: HADRON_REMNANT_SINGLET = 91
   integer, parameter, public :: HADRON_REMNANT_TRIPLET = 92
   integer, parameter, public :: HADRON_REMNANT_OCTET = 93
 
 @ %def BEAM_REMNANT HADRON_REMNANT
 @ %def HADRON_REMNANT_SINGLET HADRON_REMNANT_TRIPLET HADRON_REMNANT_OCTET
 @
 Further particle codes for internal use:
 <<Physics defs: public parameters>>=
   integer, parameter, public :: INTERNAL = 94
   integer, parameter, public :: INVALID = 97
 
   integer, parameter, public :: COMPOSITE = 99
 
 @ %def INTERNAL INVALID COMPOSITE
 @
 \subsection{Spin codes}
 Somewhat redundant, but for better readability we define named
 constants for spin types.  If the mass is nonzero, this is equal to
 the number of degrees of freedom.
 <<Physics defs: public parameters>>=
   integer, parameter, public:: UNKNOWN = 0
   integer, parameter, public :: SCALAR = 1, SPINOR = 2, VECTOR = 3, &
                                 VECTORSPINOR = 4, TENSOR = 5
 
 @ %def UNKNOWN SCALAR SPINOR VECTOR VECTORSPINOR TENSOR
 @ Isospin types and charge types are counted in an analogous way,
 where charge type 1 is charge 0, 2 is charge 1/3, and so on. Zero
 always means unknown. Note that charge and isospin types have an
 explicit sign.
 
 Color types are defined as the dimension of the representation.
 
 \subsection{NLO status codes}
 Used to specify whether a [[term_instance_t]] of a
 [[process_instance_t]] is associated with a Born, real-subtracted,
 virtual-subtracted or subtraction-dummy matrix element.
 <<Physics defs: public parameters>>=
   integer, parameter, public :: BORN = 0
   integer, parameter, public :: NLO_REAL = 1
   integer, parameter, public :: NLO_VIRTUAL = 2
   integer, parameter, public :: NLO_MISMATCH = 3
   integer, parameter, public :: NLO_DGLAP = 4
   integer, parameter, public :: NLO_SUBTRACTION = 5
   integer, parameter, public :: NLO_FULL = 6
   integer, parameter, public :: GKS = 7
   integer, parameter, public :: COMPONENT_UNDEFINED = 99
 
 @ % def BORN, NLO_REAL, NLO_VIRTUAL, NLO_SUBTRACTION, GKS
 @ [[NLO_FULL]] is not strictly a component status code but having it is
 convenient.
 We define the number of additional subtractions for beam-involved NLO calculations.
 Each subtraction refers to a rescaling of one of two beams.
 Obviously, this approach is not flexible enough to support setups with just a
 single beam described by a structure function.
 <<Physics defs: public parameters>>=
   integer, parameter, public :: n_beams_rescaled = 2
 
 @ %def n_beams_rescaled
 @
 Orders of the electron PDFs.
 <<Physics defs: public parameters>>=
   integer, parameter, public :: EPDF_LL = 0
   integer, parameter, public :: EPDF_NLL = 1
 
 @ %def EPDF_LL EPDF_NLL
 @
 <<Physics defs: public>>=
   public :: component_status
 <<Physics defs: interfaces>>=
   interface component_status
      module procedure component_status_of_string
      module procedure component_status_to_string
   end interface
 <<Physics defs: sub interfaces>>=
     elemental module function component_status_of_string (string) result (i)
       integer :: i
       type(string_t), intent(in) :: string
     end function component_status_of_string
     elemental module function component_status_to_string (i) result (string)
       type(string_t) :: string
       integer, intent(in) :: i
     end function component_status_to_string
 <<Physics defs: procedures>>=
   elemental module function component_status_of_string (string) result (i)
     integer :: i
     type(string_t), intent(in) :: string
     select case (char(string))
     case ("born")
        i = BORN
     case ("real")
        i = NLO_REAL
     case ("virtual")
        i = NLO_VIRTUAL
     case ("mismatch")
        i = NLO_MISMATCH
     case ("dglap")
        i = NLO_DGLAP
     case ("subtraction")
        i = NLO_SUBTRACTION
     case ("full")
        i = NLO_FULL
     case ("GKS")
        i = GKS
     case default
        i = COMPONENT_UNDEFINED
     end select
   end function component_status_of_string
 
   elemental module function component_status_to_string (i) result (string)
     type(string_t) :: string
     integer, intent(in) :: i
     select case (i)
     case (BORN)
        string = "born"
     case (NLO_REAL)
        string = "real"
     case (NLO_VIRTUAL)
        string = "virtual"
     case (NLO_MISMATCH)
        string = "mismatch"
     case (NLO_DGLAP)
        string = "dglap"
     case (NLO_SUBTRACTION)
        string = "subtraction"
     case (NLO_FULL)
        string = "full"
     case (GKS)
        string = "GKS"
     case default
        string = "undefined"
     end select
   end function component_status_to_string
 
 @ %def component_status
 @
 <<Physics defs: public>>=
   public :: is_nlo_component
 <<Physics defs: sub interfaces>>=
     elemental module function is_nlo_component (comp) result (is_nlo)
       logical :: is_nlo
       integer, intent(in) :: comp
     end function is_nlo_component
 <<Physics defs: procedures>>=
   elemental module function is_nlo_component (comp) result (is_nlo)
     logical :: is_nlo
     integer, intent(in) :: comp
     select case (comp)
     case (BORN : GKS)
        is_nlo = .true.
     case default
        is_nlo = .false.
     end select
   end function is_nlo_component
 
 @ %def is_nlo_component
 @
 <<Physics defs: public>>=
   public :: is_subtraction_component
 <<Physics defs: sub interfaces>>=
     module function is_subtraction_component (emitter, nlo_type) result (is_subtraction)
       logical :: is_subtraction
       integer, intent(in) :: emitter, nlo_type
     end function is_subtraction_component
 <<Physics defs: procedures>>=
   module function is_subtraction_component (emitter, nlo_type) result (is_subtraction)
     logical :: is_subtraction
     integer, intent(in) :: emitter, nlo_type
     is_subtraction = nlo_type == NLO_REAL .and. emitter < 0
   end function is_subtraction_component
 
 @ %def is_subtraction_component
 @
 \subsection{Threshold}
 Some commonly used variables for the threshold computation
 <<Physics defs: public parameters>>=
   integer, parameter, public :: THR_POS_WP = 3
   integer, parameter, public :: THR_POS_WM = 4
   integer, parameter, public :: THR_POS_B = 5
   integer, parameter, public :: THR_POS_BBAR = 6
   integer, parameter, public :: THR_POS_GLUON = 7
 
   integer, parameter, public :: THR_EMITTER_OFFSET = 4
 
   integer, parameter, public :: NO_FACTORIZATION = 0
   integer, parameter, public :: FACTORIZATION_THRESHOLD = 1
 
   integer, dimension(2), parameter, public :: ass_quark = [5, 6]
   integer, dimension(2), parameter, public :: ass_boson = [3, 4]
 
   integer, parameter, public :: PROC_MODE_UNDEFINED = 0
   integer, parameter, public :: PROC_MODE_TT = 1
   integer, parameter, public :: PROC_MODE_WBWB = 2
 
 @
 @
 <<Physics defs: public>>=
   public :: thr_leg
 <<Physics defs: sub interfaces>>=
     module function thr_leg (emitter) result (leg)
       integer :: leg
       integer, intent(in) :: emitter
     end function thr_leg
 <<Physics defs: procedures>>=
   module function thr_leg (emitter) result (leg)
     integer :: leg
     integer, intent(in) :: emitter
     leg = emitter - THR_EMITTER_OFFSET
   end function thr_leg
 
 @ %def thr_leg
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{C-compatible Particle Type}
 For easy communication with C code, we introduce a simple C-compatible
 type for particles.   The components are either default C integers or
 default C doubles.
 
 The [[c_prt]] type is transparent, and its contents should be regarded
 as part of the interface.
 <<[[c_particles.f90]]>>=
 <<File header>>
 
 module c_particles
 
   use, intrinsic :: iso_c_binding !NODEP!
 
 <<Standard module head>>
 
 <<C Particles: public>>
 
 <<C Particles: types>>
 
   interface
 <<C Particles: sub interfaces>>
   end interface
 
 end module c_particles
 @ %def c_particles
 @
 <<[[c_particles_sub.f90]]>>=
 <<File header>>
 
 submodule (c_particles) c_particles_s
 
   use io_units
   use format_defs, only: FMT_14, FMT_19
 
   implicit none
 
 contains
 
 <<C Particles: procedures>>
 
 end submodule c_particles_s
 
 @ %def c_particles_s
 @
 <<C Particles: public>>=
   public :: c_prt_t
 <<C Particles: types>>=
   type, bind(C) :: c_prt_t
      integer(c_int) :: type = 0
      integer(c_int) :: pdg = 0
      integer(c_int) :: polarized = 0
      integer(c_int) :: h = 0
      real(c_double) :: pe = 0
      real(c_double) :: px = 0
      real(c_double) :: py = 0
      real(c_double) :: pz = 0
      real(c_double) :: p2 = 0
   end type c_prt_t
 
 @ %def c_prt_t
 @ This is for debugging only, there is no C binding.  It is a
 simplified version of [[prt_write]].
 <<C Particles: public>>=
   public :: c_prt_write
 <<C Particles: sub interfaces>>=
     module subroutine c_prt_write (prt, unit)
       type(c_prt_t), intent(in) :: prt
       integer, intent(in), optional :: unit
     end subroutine c_prt_write
 <<C Particles: procedures>>=
   module subroutine c_prt_write (prt, unit)
     type(c_prt_t), intent(in) :: prt
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)", advance="no")  "prt("
     write (u, "(I0,':')", advance="no")  prt%type
     if (prt%polarized /= 0) then
        write (u, "(I0,'/',I0,'|')", advance="no")  prt%pdg, prt%h
     else
        write (u, "(I0,'|')", advance="no") prt%pdg
     end if
     write (u, "(" // FMT_14 // ",';'," // FMT_14 // ",','," // &
          FMT_14 // ",','," // FMT_14 // ")", advance="no") &
          prt%pe, prt%px, prt%py, prt%pz
     write (u, "('|'," // FMT_19 // ")", advance="no")  prt%p2
     write (u, "(A)")  ")"
   end subroutine c_prt_write
 
 @ %def c_prt_write
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Lorentz algebra}
 Define Lorentz vectors, three-vectors, boosts, and some functions to
 manipulate them.
 
 To make maximum use of this, all functions, if possible, are declared
 elemental (or pure, if this is not possible).
 <<[[lorentz.f90]]>>=
 <<File header>>
 
 module lorentz
 
 <<Use kinds with double>>
   use constants, only: zero, one
   use c_particles
 
 <<Standard module head>>
 
 <<Lorentz: public>>
 
 <<Lorentz: public operators>>
 
 <<Lorentz: public functions>>
 
 <<Lorentz: types>>
 
 <<Lorentz: parameters>>
 
 <<Lorentz: interfaces>>
 
   interface
 <<Lorentz: sub interfaces>>
   end interface
 
 end module lorentz
 @ %def lorentz
 @
 <<[[lorentz_sub.f90]]>>=
 <<File header>>
 
 submodule (lorentz) lorentz_s
 
   use constants, only: pi, twopi, degree, two, tiny_07, eps0
   use numeric_utils
   use io_units
   use format_defs, only: FMT_11, FMT_13, FMT_15, FMT_19
   use format_utils, only: pac_fmt
   use diagnostics
 
   implicit none
 
 contains
 
 <<Lorentz: procedures>>
 
 end submodule lorentz_s
 
 @ %def lorentz_s
 @
 \subsection{Three-vectors}
 First of all, let us introduce three-vectors in a trivial way.  The
 functions and overloaded elementary operations clearly are too much
 overhead, but we like to keep the interface for three-vectors and
 four-vectors exactly parallel.  By the way, we might attach a label to
 a vector by extending the type definition later.
 <<Lorentz: public>>=
   public :: vector3_t
 <<Lorentz: types>>=
   type :: vector3_t
      real(default), dimension(3) :: p
   end type vector3_t
 
 @ %def vector3_t
 @ Output a vector
 <<Lorentz: public>>=
   public :: vector3_write
 <<Lorentz: sub interfaces>>=
     module subroutine vector3_write (p, unit, testflag)
       type(vector3_t), intent(in) :: p
       integer, intent(in), optional :: unit
       logical, intent(in), optional :: testflag
     end subroutine vector3_write
 <<Lorentz: procedures>>=
   module subroutine vector3_write (p, unit, testflag)
     type(vector3_t), intent(in) :: p
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     character(len=7) :: fmt
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call pac_fmt (fmt, FMT_19, FMT_15, testflag)
     write(u, "(1x,A,3(1x," // fmt // "))") 'P = ', p%p
   end subroutine vector3_write
 
 @ %def vector3_write
 @ This is a three-vector with zero components
 <<Lorentz: public>>=
   public :: vector3_null
 <<Lorentz: parameters>>=
   type(vector3_t), parameter :: vector3_null = &
        vector3_t ([ zero, zero, zero ])
 
 @ %def vector3_null
 @ Canonical three-vector:
 <<Lorentz: public>>=
   public :: vector3_canonical
 <<Lorentz: sub interfaces>>=
     elemental module function vector3_canonical (k) result (p)
       type(vector3_t) :: p
       integer, intent(in) :: k
     end function vector3_canonical
 <<Lorentz: procedures>>=
   elemental module function vector3_canonical (k) result (p)
     type(vector3_t) :: p
     integer, intent(in) :: k
     p = vector3_null
     p%p(k) = 1
   end function vector3_canonical
 
 @ %def vector3_canonical
 @ A moving particle ($k$-axis, or arbitrary axis).  Note that the
 function for the generic momentum cannot be elemental.
 <<Lorentz: public>>=
   public :: vector3_moving
 <<Lorentz: interfaces>>=
   interface vector3_moving
      module procedure vector3_moving_canonical
      module procedure vector3_moving_generic
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector3_moving_canonical (p, k) result(q)
       type(vector3_t) :: q
       real(default), intent(in) :: p
       integer, intent(in) :: k
     end function vector3_moving_canonical
     pure module function vector3_moving_generic (p) result(q)
       real(default), dimension(3), intent(in) :: p
       type(vector3_t) :: q
     end function vector3_moving_generic
 <<Lorentz: procedures>>=
   elemental module function vector3_moving_canonical (p, k) result(q)
     type(vector3_t) :: q
     real(default), intent(in) :: p
     integer, intent(in) :: k
     q = vector3_null
     q%p(k) = p
   end function vector3_moving_canonical
   pure module function vector3_moving_generic (p) result(q)
     real(default), dimension(3), intent(in) :: p
     type(vector3_t) :: q
     q%p = p
   end function vector3_moving_generic
 
 @ %def vector3_moving
 @ Equality and inequality
 <<Lorentz: public operators>>=
   public :: operator(==), operator(/=)
 <<Lorentz: interfaces>>=
   interface operator(==)
      module procedure vector3_eq
   end interface
   interface operator(/=)
      module procedure vector3_neq
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector3_eq (p, q) result (r)
       logical :: r
       type(vector3_t), intent(in) :: p,q
     end function vector3_eq
     elemental module function vector3_neq (p, q) result (r)
       logical :: r
       type(vector3_t), intent(in) :: p,q
     end function vector3_neq
 <<Lorentz: procedures>>=
   elemental module function vector3_eq (p, q) result (r)
     logical :: r
     type(vector3_t), intent(in) :: p,q
     r = all (abs (p%p - q%p) < eps0)
   end function vector3_eq
   elemental module function vector3_neq (p, q) result (r)
     logical :: r
     type(vector3_t), intent(in) :: p,q
     r = any (abs(p%p - q%p) > eps0)
   end function vector3_neq
 
 @ %def == /=
 @ Define addition and subtraction
 <<Lorentz: public operators>>=
   public :: operator(+), operator(-)
 <<Lorentz: interfaces>>=
   interface operator(+)
      module procedure add_vector3
   end interface
   interface operator(-)
      module procedure sub_vector3
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function add_vector3 (p, q) result (r)
       type(vector3_t) :: r
       type(vector3_t), intent(in) :: p,q
     end function add_vector3
     elemental module function sub_vector3 (p, q) result (r)
       type(vector3_t) :: r
       type(vector3_t), intent(in) :: p,q
     end function sub_vector3
 <<Lorentz: procedures>>=
   elemental module function add_vector3 (p, q) result (r)
     type(vector3_t) :: r
     type(vector3_t), intent(in) :: p,q
     r%p = p%p + q%p
   end function add_vector3
   elemental module function sub_vector3 (p, q) result (r)
     type(vector3_t) :: r
     type(vector3_t), intent(in) :: p,q
     r%p = p%p - q%p
   end function sub_vector3
 
 @ %def + -
 @ The multiplication sign is overloaded with scalar multiplication;
 similarly division:
 <<Lorentz: public operators>>=
   public :: operator(*), operator(/)
 <<Lorentz: interfaces>>=
   interface operator(*)
      module procedure prod_integer_vector3, prod_vector3_integer
      module procedure prod_real_vector3, prod_vector3_real
   end interface
   interface operator(/)
      module procedure div_vector3_real, div_vector3_integer
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function prod_real_vector3 (s, p) result (q)
       type(vector3_t) :: q
       real(default), intent(in) :: s
       type(vector3_t), intent(in) :: p
     end function prod_real_vector3
     elemental module function prod_vector3_real (p, s) result (q)
       type(vector3_t) :: q
       real(default), intent(in) :: s
       type(vector3_t), intent(in) :: p
     end function prod_vector3_real
     elemental module function div_vector3_real (p, s) result (q)
       type(vector3_t) :: q
       real(default), intent(in) :: s
       type(vector3_t), intent(in) :: p
     end function div_vector3_real
     elemental module function prod_integer_vector3 (s, p) result (q)
       type(vector3_t) :: q
       integer, intent(in) :: s
       type(vector3_t), intent(in) :: p
     end function prod_integer_vector3
     elemental module function prod_vector3_integer (p, s) result (q)
       type(vector3_t) :: q
       integer, intent(in) :: s
       type(vector3_t), intent(in) :: p
     end function prod_vector3_integer
     elemental module function div_vector3_integer (p, s) result (q)
       type(vector3_t) :: q
       integer, intent(in) :: s
       type(vector3_t), intent(in) :: p
     end function div_vector3_integer
 <<Lorentz: procedures>>=
   elemental module function prod_real_vector3 (s, p) result (q)
     type(vector3_t) :: q
     real(default), intent(in) :: s
     type(vector3_t), intent(in) :: p
     q%p = s * p%p
   end function prod_real_vector3
   elemental module function prod_vector3_real (p, s) result (q)
     type(vector3_t) :: q
     real(default), intent(in) :: s
     type(vector3_t), intent(in) :: p
     q%p = s * p%p
   end function prod_vector3_real
   elemental module function div_vector3_real (p, s) result (q)
     type(vector3_t) :: q
     real(default), intent(in) :: s
     type(vector3_t), intent(in) :: p
     q%p = p%p/s
   end function div_vector3_real
   elemental module function prod_integer_vector3 (s, p) result (q)
     type(vector3_t) :: q
     integer, intent(in) :: s
     type(vector3_t), intent(in) :: p
     q%p = s * p%p
   end function prod_integer_vector3
   elemental module function prod_vector3_integer (p, s) result (q)
     type(vector3_t) :: q
     integer, intent(in) :: s
     type(vector3_t), intent(in) :: p
     q%p = s * p%p
   end function prod_vector3_integer
   elemental module function div_vector3_integer (p, s) result (q)
     type(vector3_t) :: q
     integer, intent(in) :: s
     type(vector3_t), intent(in) :: p
     q%p = p%p/s
   end function div_vector3_integer
 
 @ %def * /
 @ The multiplication sign can also indicate scalar products:
 <<Lorentz: interfaces>>=
   interface operator(*)
      module procedure prod_vector3
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function prod_vector3 (p, q) result (s)
       real(default) :: s
       type(vector3_t), intent(in) :: p,q
     end function prod_vector3
 <<Lorentz: procedures>>=
   elemental module function prod_vector3 (p, q) result (s)
     real(default) :: s
     type(vector3_t), intent(in) :: p,q
     s = dot_product (p%p, q%p)
   end function prod_vector3
 
 @ %def *
 <<Lorentz: public functions>>=
   public :: cross_product
 <<Lorentz: interfaces>>=
   interface cross_product
      module procedure vector3_cross_product
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector3_cross_product (p, q) result (r)
       type(vector3_t) :: r
       type(vector3_t), intent(in) :: p,q
     end function vector3_cross_product
 <<Lorentz: procedures>>=
   elemental module function vector3_cross_product (p, q) result (r)
     type(vector3_t) :: r
     type(vector3_t), intent(in) :: p,q
     integer :: i
     do i=1,3
        r%p(i) = dot_product (p%p, matmul(epsilon_three(i,:,:), q%p))
     end do
   end function vector3_cross_product
 
 @ %def cross_product
 @ Exponentiation is defined only for integer powers.  Odd powers mean
 take the square root; so [[p**1]] is the length of [[p]].
 <<Lorentz: public operators>>=
   public :: operator(**)
 <<Lorentz: interfaces>>=
   interface operator(**)
      module procedure power_vector3
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function power_vector3 (p, e) result (s)
       real(default) :: s
       type(vector3_t), intent(in) :: p
       integer, intent(in) :: e
     end function power_vector3
 <<Lorentz: procedures>>=
   elemental module function power_vector3 (p, e) result (s)
     real(default) :: s
     type(vector3_t), intent(in) :: p
     integer, intent(in) :: e
     s = dot_product (p%p, p%p)
     if (e/=2) then
        if (mod(e,2)==0) then
           s = s**(e/2)
        else
           s = sqrt(s)**e
        end if
     end if
   end function power_vector3
 
 @ %def **
 @ Finally, we need a negation.
 <<Lorentz: interfaces>>=
   interface operator(-)
      module procedure negate_vector3
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function negate_vector3 (p) result (q)
       type(vector3_t) :: q
       type(vector3_t), intent(in) :: p
     end function negate_vector3
 <<Lorentz: procedures>>=
   elemental module function negate_vector3 (p) result (q)
     type(vector3_t) :: q
     type(vector3_t), intent(in) :: p
     integer :: i
     do i = 1, 3
        if (abs (p%p(i)) < eps0) then
           q%p(i) = 0
        else
           q%p(i) = -p%p(i)
        end if
     end do
   end function negate_vector3
 
 @ %def -
 @ The sum function can be useful:
 <<Lorentz: public functions>>=
   public :: sum
 <<Lorentz: interfaces>>=
   interface sum
      module procedure sum_vector3
   end interface
 @ %def sum
 @
 <<Lorentz: public>>=
   public :: vector3_set_component
 <<Lorentz: sub interfaces>>=
     module subroutine vector3_set_component (p, i, value)
       type(vector3_t), intent(inout) :: p
       integer, intent(in) :: i
       real(default), intent(in) :: value
     end subroutine vector3_set_component
 <<Lorentz: procedures>>=
   module subroutine vector3_set_component (p, i, value)
     type(vector3_t), intent(inout) :: p
     integer, intent(in) :: i
     real(default), intent(in) :: value
     p%p(i) = value
   end subroutine vector3_set_component
 
 @ %def vector3_set_component
 @
 <<Lorentz: sub interfaces>>=
     pure module function sum_vector3 (p) result (q)
       type(vector3_t) :: q
       type(vector3_t), dimension(:), intent(in) :: p
     end function sum_vector3
 <<Lorentz: procedures>>=
   pure module function sum_vector3 (p) result (q)
     type(vector3_t) :: q
     type(vector3_t), dimension(:), intent(in) :: p
     integer :: i
     do i=1, 3
        q%p(i) = sum (p%p(i))
     end do
   end function sum_vector3
 
 @ %def sum
 @ Any component:
 <<Lorentz: public>>=
   public :: vector3_get_component
 @ %def component
 <<Lorentz: sub interfaces>>=
     elemental module function vector3_get_component (p, k) result (c)
       type(vector3_t), intent(in) :: p
       integer, intent(in) :: k
       real(default) :: c
     end function vector3_get_component
 <<Lorentz: procedures>>=
   elemental module function vector3_get_component (p, k) result (c)
     type(vector3_t), intent(in) :: p
     integer, intent(in) :: k
     real(default) :: c
     c = p%p(k)
   end function vector3_get_component
 
 @ %def vector3_get_component
 @ Extract all components.  This is not elemental.
 <<Lorentz: public>>=
   public :: vector3_get_components
 <<Lorentz: sub interfaces>>=
     pure module function vector3_get_components (p) result (a)
       type(vector3_t), intent(in) :: p
       real(default), dimension(3) :: a
     end function vector3_get_components
 <<Lorentz: procedures>>=
   pure module function vector3_get_components (p) result (a)
     type(vector3_t), intent(in) :: p
     real(default), dimension(3) :: a
     a = p%p
   end function vector3_get_components
 
 @ %def vector3_get_components
 @ This function returns the direction of a three-vector, i.e., a
 normalized three-vector.  If the vector is null, we return a null vector.
 <<Lorentz: public functions>>=
   public :: direction
 <<Lorentz: interfaces>>=
   interface direction
      module procedure vector3_get_direction
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector3_get_direction (p) result (q)
       type(vector3_t) :: q
       type(vector3_t), intent(in) :: p
     end function vector3_get_direction
 <<Lorentz: procedures>>=
   elemental module function vector3_get_direction (p) result (q)
     type(vector3_t) :: q
     type(vector3_t), intent(in) :: p
     real(default) :: pp
     pp = p**1
     if (pp > eps0) then
        q%p = p%p / pp
     else
        q%p = 0
     end if
   end function vector3_get_direction
 
 @ %def direction
 @
 \subsection{Four-vectors}
 In four-vectors the zero-component needs special treatment, therefore
 we do not use the standard operations.  Sure, we pay for the extra
 layer of abstraction by losing efficiency; so we have to assume that
 the time-critical applications do not involve four-vector operations.
 <<Lorentz: public>>=
   public :: vector4_t
 <<Lorentz: types>>=
   type :: vector4_t
      real(default), dimension(0:3) :: p = &
         [zero, zero, zero, zero]
   contains
   <<Lorentz: vector4: TBP>>
   end type vector4_t
 @ %def vector4_t
 @ Output a vector
 <<Lorentz: public>>=
   public :: vector4_write
 <<Lorentz: vector4: TBP>>=
   procedure :: write => vector4_write
 <<Lorentz: sub interfaces>>=
     module subroutine vector4_write &
            (p, unit, show_mass, testflag, compressed, ultra)
       class(vector4_t), intent(in) :: p
       integer, intent(in), optional :: unit
       logical, intent(in), optional :: show_mass, testflag, compressed, ultra
     end subroutine vector4_write
 <<Lorentz: procedures>>=
   module subroutine vector4_write &
          (p, unit, show_mass, testflag, compressed, ultra)
     class(vector4_t), intent(in) :: p
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: show_mass, testflag, compressed, ultra
     logical :: comp, sm, tf, extreme
     integer :: u
     character(len=7) :: fmt
     real(default) :: m
     comp = .false.; if (present (compressed))  comp = compressed
     sm = .false.;  if (present (show_mass))  sm = show_mass
     tf = .false.;  if (present (testflag))  tf = testflag
     extreme = .false.; if (present (ultra))  extreme = ultra
     if (extreme) then
        call pac_fmt (fmt, FMT_19, FMT_11, testflag)
     else
        call pac_fmt (fmt, FMT_19, FMT_13, testflag)
     end if
     u = given_output_unit (unit);  if (u < 0)  return
     if (comp) then
        write (u, "(4(F12.3,1X))", advance="no")  p%p(0:3)
     else
        write (u, "(1x,A,1x," // fmt // ")") 'E = ', p%p(0)
        write (u, "(1x,A,3(1x," // fmt // "))") 'P = ', p%p(1:)
        if (sm) then
           m = p**1
           if (tf)  call pacify (m, tolerance = 1E-6_default)
           write (u, "(1x,A,1x," // fmt // ")") 'M = ', m
        end if
     end if
   end subroutine vector4_write
 
 @ %def vector4_write
 @ Binary I/O
 <<Lorentz: public>>=
   public :: vector4_write_raw
   public :: vector4_read_raw
 <<Lorentz: sub interfaces>>=
     module subroutine vector4_write_raw (p, u)
       type(vector4_t), intent(in) :: p
       integer, intent(in) :: u
     end subroutine vector4_write_raw
     module subroutine vector4_read_raw (p, u, iostat)
       type(vector4_t), intent(out) :: p
       integer, intent(in) :: u
       integer, intent(out), optional :: iostat
     end subroutine vector4_read_raw
 <<Lorentz: procedures>>=
   module subroutine vector4_write_raw (p, u)
     type(vector4_t), intent(in) :: p
     integer, intent(in) :: u
     write (u) p%p
   end subroutine vector4_write_raw
 
   module subroutine vector4_read_raw (p, u, iostat)
     type(vector4_t), intent(out) :: p
     integer, intent(in) :: u
     integer, intent(out), optional :: iostat
     read (u, iostat=iostat) p%p
   end subroutine vector4_read_raw
 
 @ %def vector4_write_raw vector4_read_raw
 @ This is a four-vector with zero components
 <<Lorentz: public>>=
   public :: vector4_null
 <<Lorentz: parameters>>=
   type(vector4_t), parameter :: vector4_null = &
        vector4_t ([ zero, zero, zero, zero ])
 
 @ %def vector4_null
 @ Canonical four-vector:
 <<Lorentz: public>>=
   public :: vector4_canonical
 <<Lorentz: sub interfaces>>=
     elemental module function vector4_canonical (k) result (p)
       type(vector4_t) :: p
       integer, intent(in) :: k
     end function vector4_canonical
 <<Lorentz: procedures>>=
   elemental module function vector4_canonical (k) result (p)
     type(vector4_t) :: p
     integer, intent(in) :: k
     p = vector4_null
     p%p(k) = 1
   end function vector4_canonical
 
 @ %def vector4_canonical
 @ A particle at rest:
 <<Lorentz: public>>=
   public :: vector4_at_rest
 <<Lorentz: sub interfaces>>=
     elemental module function vector4_at_rest (m) result (p)
       type(vector4_t) :: p
       real(default), intent(in) :: m
     end function vector4_at_rest
 <<Lorentz: procedures>>=
   elemental module function vector4_at_rest (m) result (p)
     type(vector4_t) :: p
     real(default), intent(in) :: m
     p = vector4_t ([ m, zero, zero, zero ])
   end function vector4_at_rest
 
 @ %def vector4_at_rest
 @ A moving particle ($k$-axis, or arbitrary axis)
 <<Lorentz: public>>=
   public :: vector4_moving
 <<Lorentz: interfaces>>=
   interface vector4_moving
      module procedure vector4_moving_canonical
      module procedure vector4_moving_generic
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector4_moving_canonical (E, p, k) result (q)
       type(vector4_t) :: q
       real(default), intent(in) :: E, p
       integer, intent(in) :: k
     end function vector4_moving_canonical
     elemental module function vector4_moving_generic (E, p) result (q)
       type(vector4_t) :: q
       real(default), intent(in) :: E
       type(vector3_t), intent(in) :: p
     end function vector4_moving_generic
 <<Lorentz: procedures>>=
   elemental module function vector4_moving_canonical (E, p, k) result (q)
     type(vector4_t) :: q
     real(default), intent(in) :: E, p
     integer, intent(in) :: k
     q = vector4_at_rest(E)
     q%p(k) = p
   end function vector4_moving_canonical
   elemental module function vector4_moving_generic (E, p) result (q)
     type(vector4_t) :: q
     real(default), intent(in) :: E
     type(vector3_t), intent(in) :: p
     q%p(0) = E
     q%p(1:) = p%p
   end function vector4_moving_generic
 
 @ %def vector4_moving
 @ Equality and inequality
 <<Lorentz: interfaces>>=
   interface operator(==)
      module procedure vector4_eq
   end interface
   interface operator(/=)
      module procedure vector4_neq
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector4_eq (p, q) result (r)
       logical :: r
       type(vector4_t), intent(in) :: p,q
     end function vector4_eq
     elemental module function vector4_neq (p, q) result (r)
       logical :: r
       type(vector4_t), intent(in) :: p,q
     end function vector4_neq
 <<Lorentz: procedures>>=
   elemental module function vector4_eq (p, q) result (r)
     logical :: r
     type(vector4_t), intent(in) :: p,q
     r = all (abs (p%p - q%p) < eps0)
   end function vector4_eq
   elemental module function vector4_neq (p, q) result (r)
     logical :: r
     type(vector4_t), intent(in) :: p,q
     r = any (abs (p%p - q%p) > eps0)
   end function vector4_neq
 
 @ %def == /=
 @ Addition and subtraction:
 <<Lorentz: interfaces>>=
   interface operator(+)
      module procedure add_vector4
   end interface
   interface operator(-)
      module procedure sub_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function add_vector4 (p,q) result (r)
       type(vector4_t) :: r
       type(vector4_t), intent(in) :: p,q
     end function add_vector4
     elemental module function sub_vector4 (p,q) result (r)
       type(vector4_t) :: r
       type(vector4_t), intent(in) :: p,q
     end function sub_vector4
 <<Lorentz: procedures>>=
   elemental module function add_vector4 (p,q) result (r)
     type(vector4_t) :: r
     type(vector4_t), intent(in) :: p,q
     r%p = p%p + q%p
   end function add_vector4
   elemental module function sub_vector4 (p,q) result (r)
     type(vector4_t) :: r
     type(vector4_t), intent(in) :: p,q
     r%p = p%p - q%p
   end function sub_vector4
 
 @ %def + -
 @ We also need scalar multiplication and division:
 <<Lorentz: interfaces>>=
   interface operator(*)
      module procedure prod_real_vector4, prod_vector4_real
      module procedure prod_integer_vector4, prod_vector4_integer
   end interface
   interface operator(/)
      module procedure div_vector4_real
      module procedure div_vector4_integer
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function prod_real_vector4 (s, p) result (q)
       type(vector4_t) :: q
       real(default), intent(in) :: s
       type(vector4_t), intent(in) :: p
     end function prod_real_vector4
     elemental module function prod_vector4_real (p, s) result (q)
       type(vector4_t) :: q
       real(default), intent(in) :: s
       type(vector4_t), intent(in) :: p
     end function prod_vector4_real
     elemental module function div_vector4_real (p, s) result (q)
       type(vector4_t) :: q
       real(default), intent(in) :: s
       type(vector4_t), intent(in) :: p
     end function div_vector4_real
     elemental module function prod_integer_vector4 (s, p) result (q)
       type(vector4_t) :: q
       integer, intent(in) :: s
       type(vector4_t), intent(in) :: p
     end function prod_integer_vector4
     elemental module function prod_vector4_integer (p, s) result (q)
       type(vector4_t) :: q
       integer, intent(in) :: s
       type(vector4_t), intent(in) :: p
     end function prod_vector4_integer
     elemental module function div_vector4_integer (p, s) result (q)
       type(vector4_t) :: q
       integer, intent(in) :: s
       type(vector4_t), intent(in) :: p
     end function div_vector4_integer
 <<Lorentz: procedures>>=
   elemental module function prod_real_vector4 (s, p) result (q)
     type(vector4_t) :: q
     real(default), intent(in) :: s
     type(vector4_t), intent(in) :: p
     q%p = s * p%p
   end function prod_real_vector4
   elemental module function prod_vector4_real (p, s) result (q)
     type(vector4_t) :: q
     real(default), intent(in) :: s
     type(vector4_t), intent(in) :: p
     q%p = s * p%p
   end function prod_vector4_real
   elemental module function div_vector4_real (p, s) result (q)
     type(vector4_t) :: q
     real(default), intent(in) :: s
     type(vector4_t), intent(in) :: p
     q%p = p%p/s
   end function div_vector4_real
   elemental module function prod_integer_vector4 (s, p) result (q)
     type(vector4_t) :: q
     integer, intent(in) :: s
     type(vector4_t), intent(in) :: p
     q%p = s * p%p
   end function prod_integer_vector4
   elemental module function prod_vector4_integer (p, s) result (q)
     type(vector4_t) :: q
     integer, intent(in) :: s
     type(vector4_t), intent(in) :: p
     q%p = s * p%p
   end function prod_vector4_integer
   elemental module function div_vector4_integer (p, s) result (q)
     type(vector4_t) :: q
     integer, intent(in) :: s
     type(vector4_t), intent(in) :: p
     q%p = p%p/s
   end function div_vector4_integer
 
 @ %def * /
 @ Scalar products and squares in the Minkowski sense:
 <<Lorentz: interfaces>>=
   interface operator(*)
      module procedure prod_vector4
   end interface
   interface operator(**)
      module procedure power_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function prod_vector4 (p, q) result (s)
       real(default) :: s
       type(vector4_t), intent(in) :: p,q
     end function prod_vector4
 <<Lorentz: procedures>>=
   elemental module function prod_vector4 (p, q) result (s)
     real(default) :: s
     type(vector4_t), intent(in) :: p,q
     s = p%p(0)*q%p(0) - dot_product(p%p(1:), q%p(1:))
   end function prod_vector4
 
 @ %def *
 @ The power operation for four-vectors is signed, i.e., [[p**1]] is
 positive for timelike and negative for spacelike vectors.  Note that
 [[(p**1)**2]] is not necessarily equal to [[p**2]].
 <<Lorentz: sub interfaces>>=
     elemental module function power_vector4 (p, e) result (s)
       real(default) :: s
       type(vector4_t), intent(in) :: p
       integer, intent(in) :: e
     end function power_vector4
 <<Lorentz: procedures>>=
   elemental module function power_vector4 (p, e) result (s)
     real(default) :: s
     type(vector4_t), intent(in) :: p
     integer, intent(in) :: e
     s = p * p
     if (e /= 2) then
        if (mod(e, 2) == 0) then
           s = s**(e / 2)
        else if (s >= 0) then
           s = sqrt(s)**e
        else
           s = -(sqrt(abs(s))**e)
        end if
     end if
   end function power_vector4
 
 @ %def **
 @ Finally, we introduce a negation
 <<Lorentz: interfaces>>=
   interface operator(-)
      module procedure negate_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function negate_vector4 (p) result (q)
       type(vector4_t) :: q
       type(vector4_t), intent(in) :: p
     end function negate_vector4
 <<Lorentz: procedures>>=
   elemental module function negate_vector4 (p) result (q)
     type(vector4_t) :: q
     type(vector4_t), intent(in) :: p
     integer :: i
     do i = 0, 3
        if (abs (p%p(i)) < eps0) then
           q%p(i) = 0
        else
           q%p(i) = -p%p(i)
        end if
     end do
   end function negate_vector4
 
 @ %def -
 @ The sum function can be useful:
 <<Lorentz: interfaces>>=
   interface sum
      module procedure sum_vector4, sum_vector4_mask
   end interface
 @ %def sum
 @
 <<Lorentz: sub interfaces>>=
     pure module function sum_vector4 (p) result (q)
       type(vector4_t) :: q
       type(vector4_t), dimension(:), intent(in) :: p
     end function sum_vector4
     pure module function sum_vector4_mask (p, mask) result (q)
       type(vector4_t) :: q
       type(vector4_t), dimension(:), intent(in) :: p
       logical, dimension(:), intent(in) :: mask
     end function sum_vector4_mask
 <<Lorentz: procedures>>=
   pure module function sum_vector4 (p) result (q)
     type(vector4_t) :: q
     type(vector4_t), dimension(:), intent(in) :: p
     integer :: i
     do i = 0, 3
        q%p(i) = sum (p%p(i))
     end do
   end function sum_vector4
 
   pure module function sum_vector4_mask (p, mask) result (q)
     type(vector4_t) :: q
     type(vector4_t), dimension(:), intent(in) :: p
     logical, dimension(:), intent(in) :: mask
     integer :: i
     do i = 0, 3
        q%p(i) = sum (p%p(i), mask=mask)
     end do
   end function sum_vector4_mask
 
 @ %def sum
 @
 \subsection{Conversions}
 Manually set a component of the four-vector:
 <<Lorentz: public>>=
   public :: vector4_set_component
 <<Lorentz: sub interfaces>>=
     module subroutine vector4_set_component (p, k, c)
       type(vector4_t), intent(inout) :: p
       integer, intent(in) :: k
       real(default), intent(in) :: c
     end subroutine vector4_set_component
 <<Lorentz: procedures>>=
   module subroutine vector4_set_component (p, k, c)
     type(vector4_t), intent(inout) :: p
     integer, intent(in) :: k
     real(default), intent(in) :: c
     p%p(k) = c
   end subroutine vector4_set_component
 
 @ %def vector4_get_component
 Any component:
 <<Lorentz: public>>=
   public :: vector4_get_component
 <<Lorentz: sub interfaces>>=
     elemental module function vector4_get_component (p, k) result (c)
       real(default) :: c
       type(vector4_t), intent(in) :: p
       integer, intent(in) :: k
     end function vector4_get_component
 <<Lorentz: procedures>>=
   elemental module function vector4_get_component (p, k) result (c)
     real(default) :: c
     type(vector4_t), intent(in) :: p
     integer, intent(in) :: k
     c = p%p(k)
   end function vector4_get_component
 
 @ %def vector4_get_component
 @ Extract all components.  This is not elemental.
 <<Lorentz: public>>=
   public :: vector4_get_components
 <<Lorentz: sub interfaces>>=
     pure module function vector4_get_components (p) result (a)
       real(default), dimension(0:3) :: a
       type(vector4_t), intent(in) :: p
     end function vector4_get_components
 <<Lorentz: procedures>>=
   pure module function vector4_get_components (p) result (a)
     real(default), dimension(0:3) :: a
     type(vector4_t), intent(in) :: p
     a = p%p
   end function vector4_get_components
 
 @ %def vector4_get_components
 @ This function returns the space part of a four-vector, such that we
 can apply three-vector operations on it:
 <<Lorentz: public functions>>=
   public :: space_part
 <<Lorentz: interfaces>>=
   interface space_part
      module procedure vector4_get_space_part
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector4_get_space_part (p) result (q)
       type(vector3_t) :: q
       type(vector4_t), intent(in) :: p
     end function vector4_get_space_part
 <<Lorentz: procedures>>=
   elemental module function vector4_get_space_part (p) result (q)
     type(vector3_t) :: q
     type(vector4_t), intent(in) :: p
     q%p = p%p(1:)
   end function vector4_get_space_part
 
 @ %def space_part
 @ This function returns the direction of a four-vector, i.e., a
 normalized three-vector.  If the four-vector has zero space part, we
 return a null vector.
 <<Lorentz: interfaces>>=
   interface direction
      module procedure vector4_get_direction
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector4_get_direction (p) result (q)
       type(vector3_t) :: q
       type(vector4_t), intent(in) :: p
     end function vector4_get_direction
 <<Lorentz: procedures>>=
   elemental module function vector4_get_direction (p) result (q)
     type(vector3_t) :: q
     type(vector4_t), intent(in) :: p
     real(default) :: qq
     q%p = p%p(1:)
     qq = q**1
     if (abs(qq) > eps0) then
        q%p = q%p / qq
     else
        q%p = 0
     end if
   end function vector4_get_direction
 
 @ %def direction
 @ Change the sign of the spatial part of a four-vector
 <<Lorentz: public>>=
   public :: vector4_invert_direction
 <<Lorentz: sub interfaces>>=
     elemental module subroutine vector4_invert_direction (p)
       type(vector4_t), intent(inout) :: p
     end subroutine vector4_invert_direction
 <<Lorentz: procedures>>=
   elemental module subroutine vector4_invert_direction (p)
     type(vector4_t), intent(inout) :: p
     p%p(1:3) = -p%p(1:3)
   end subroutine vector4_invert_direction
 
 @ %def vector4_invert_direction
 @ This function returns the four-vector as an ordinary array.  A
 second version for an array of four-vectors.
 <<Lorentz: public>>=
   public :: assignment (=)
 <<Lorentz: interfaces>>=
   interface assignment (=)
      module procedure array_from_vector4_1, array_from_vector4_2, &
             array_from_vector3_1, array_from_vector3_2, &
             vector4_from_array, vector3_from_array
   end interface
 <<Lorentz: sub interfaces>>=
     pure module subroutine array_from_vector4_1 (a, p)
       real(default), dimension(:), intent(out) :: a
       type(vector4_t), intent(in) :: p
     end subroutine array_from_vector4_1
     pure module subroutine array_from_vector4_2 (a, p)
       type(vector4_t), dimension(:), intent(in) :: p
       real(default), dimension(:,:), intent(out) :: a
     end subroutine array_from_vector4_2
     pure module subroutine array_from_vector3_1 (a, p)
       real(default), dimension(:), intent(out) :: a
       type(vector3_t), intent(in) :: p
     end subroutine array_from_vector3_1
     pure module subroutine array_from_vector3_2 (a, p)
       type(vector3_t), dimension(:), intent(in) :: p
       real(default), dimension(:,:), intent(out) :: a
     end subroutine array_from_vector3_2
     pure module subroutine vector4_from_array (p, a)
       type(vector4_t), intent(out) :: p
       real(default), dimension(:), intent(in) :: a
     end subroutine vector4_from_array
     pure module subroutine vector3_from_array (p, a)
       type(vector3_t), intent(out) :: p
       real(default), dimension(:), intent(in) :: a
     end subroutine vector3_from_array
 <<Lorentz: procedures>>=
   pure module subroutine array_from_vector4_1 (a, p)
     real(default), dimension(:), intent(out) :: a
     type(vector4_t), intent(in) :: p
     a = p%p
   end subroutine array_from_vector4_1
 
   pure module subroutine array_from_vector4_2 (a, p)
     type(vector4_t), dimension(:), intent(in) :: p
     real(default), dimension(:,:), intent(out) :: a
     integer :: i
     forall (i=1:size(p))
        a(:,i) = p(i)%p
     end forall
   end subroutine array_from_vector4_2
 
   pure module subroutine array_from_vector3_1 (a, p)
     real(default), dimension(:), intent(out) :: a
     type(vector3_t), intent(in) :: p
     a = p%p
   end subroutine array_from_vector3_1
 
   pure module subroutine array_from_vector3_2 (a, p)
     type(vector3_t), dimension(:), intent(in) :: p
     real(default), dimension(:,:), intent(out) :: a
     integer :: i
     forall (i=1:size(p))
        a(:,i) = p(i)%p
     end forall
   end subroutine array_from_vector3_2
 
   pure module subroutine vector4_from_array (p, a)
     type(vector4_t), intent(out) :: p
     real(default), dimension(:), intent(in) :: a
     p%p(0:3) = a
   end subroutine vector4_from_array
 
   pure module subroutine vector3_from_array (p, a)
     type(vector3_t), intent(out) :: p
     real(default), dimension(:), intent(in) :: a
     p%p(1:3) = a
   end subroutine vector3_from_array
 
 @ %def array_from_vector4 array_from_vector3
 @
 <<Lorentz: public>>=
   public :: vector4
 <<Lorentz: sub interfaces>>=
     pure module function vector4 (a) result (p)
       type(vector4_t) :: p
       real(default), intent(in), dimension(4) :: a
     end function vector4
 <<Lorentz: procedures>>=
   pure module function vector4 (a) result (p)
     type(vector4_t) :: p
     real(default), intent(in), dimension(4) :: a
     p%p = a
   end function vector4
 
 @ %def vector4
 @
 <<Lorentz: vector4: TBP>>=
   procedure :: to_pythia6 => vector4_to_pythia6
 <<Lorentz: sub interfaces>>=
     pure module function vector4_to_pythia6 (vector4, m) result (p)
       real(double), dimension(1:5) :: p
       class(vector4_t), intent(in) :: vector4
       real(default), intent(in), optional :: m
     end function vector4_to_pythia6
 <<Lorentz: procedures>>=
   pure module function vector4_to_pythia6 (vector4, m) result (p)
     real(double), dimension(1:5) :: p
     class(vector4_t), intent(in) :: vector4
     real(default), intent(in), optional :: m
     p(1:3) = vector4%p(1:3)
     p(4) = vector4%p(0)
     if (present (m)) then
        p(5) = m
     else
        p(5) = vector4 ** 1
     end if
   end function vector4_to_pythia6
 
 @ %def vector4_to_pythia6
 @
 \subsection{Interface to [[c_prt]]}
 Transform the momentum of a [[c_prt]] object into a four-vector and
 vice versa:
 <<Lorentz: interfaces>>=
   interface assignment (=)
      module procedure vector4_from_c_prt, c_prt_from_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     pure module subroutine vector4_from_c_prt (p, c_prt)
       type(vector4_t), intent(out) :: p
       type(c_prt_t), intent(in) :: c_prt
     end subroutine vector4_from_c_prt
     pure module subroutine c_prt_from_vector4 (c_prt, p)
       type(c_prt_t), intent(out) :: c_prt
       type(vector4_t), intent(in) :: p
     end subroutine c_prt_from_vector4
 <<Lorentz: procedures>>=
   pure module subroutine vector4_from_c_prt (p, c_prt)
     type(vector4_t), intent(out) :: p
     type(c_prt_t), intent(in) :: c_prt
     p%p(0) = c_prt%pe
     p%p(1) = c_prt%px
     p%p(2) = c_prt%py
     p%p(3) = c_prt%pz
   end subroutine vector4_from_c_prt
 
   pure module subroutine c_prt_from_vector4 (c_prt, p)
     type(c_prt_t), intent(out) :: c_prt
     type(vector4_t), intent(in) :: p
     c_prt%pe = p%p(0)
     c_prt%px = p%p(1)
     c_prt%py = p%p(2)
     c_prt%pz = p%p(3)
     c_prt%p2 = p ** 2
   end subroutine c_prt_from_vector4
 
 @ %def vector4_from_c_prt c_prt_from_vector4
 @ Initialize a [[c_prt_t]] object with the components of a four-vector
 as its kinematical entries.  Compute the invariant mass, or use the
 optional mass-squared value instead.
 <<Lorentz: public>>=
   public :: vector4_to_c_prt
 <<Lorentz: sub interfaces>>=
     elemental module function vector4_to_c_prt (p, p2) result (c_prt)
       type(c_prt_t) :: c_prt
       type(vector4_t), intent(in) :: p
       real(default), intent(in), optional :: p2
     end function vector4_to_c_prt
 <<Lorentz: procedures>>=
   elemental module function vector4_to_c_prt (p, p2) result (c_prt)
     type(c_prt_t) :: c_prt
     type(vector4_t), intent(in) :: p
     real(default), intent(in), optional :: p2
     c_prt%pe = p%p(0)
     c_prt%px = p%p(1)
     c_prt%py = p%p(2)
     c_prt%pz = p%p(3)
     if (present (p2)) then
        c_prt%p2 = p2
     else
        c_prt%p2 = p ** 2
     end if
   end function vector4_to_c_prt
 
 @ %def vector4_to_c_prt
 @
 \subsection{Angles}
 Return the angles in a canonical system.  The angle $\phi$ is defined
 between $0\leq\phi<2\pi$.  In degenerate cases, return zero.
 <<Lorentz: public functions>>=
   public :: azimuthal_angle
 <<Lorentz: interfaces>>=
   interface azimuthal_angle
      module procedure vector3_azimuthal_angle
      module procedure vector4_azimuthal_angle
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector3_azimuthal_angle (p) result (phi)
       real(default) :: phi
       type(vector3_t), intent(in) :: p
     end function vector3_azimuthal_angle
     elemental module function vector4_azimuthal_angle (p) result (phi)
       real(default) :: phi
       type(vector4_t), intent(in) :: p
     end function vector4_azimuthal_angle
 <<Lorentz: procedures>>=
   elemental module function vector3_azimuthal_angle (p) result (phi)
     real(default) :: phi
     type(vector3_t), intent(in) :: p
     if (any (abs (p%p(1:2)) > 0)) then
        phi = atan2(p%p(2), p%p(1))
        if (phi < 0) phi = phi + twopi
     else
        phi = 0
     end if
   end function vector3_azimuthal_angle
   elemental module function vector4_azimuthal_angle (p) result (phi)
     real(default) :: phi
     type(vector4_t), intent(in) :: p
     phi = vector3_azimuthal_angle (space_part (p))
   end function vector4_azimuthal_angle
 
 @ %def azimuthal_angle
 @ Azimuthal angle in degrees
 <<Lorentz: public functions>>=
   public :: azimuthal_angle_deg
 <<Lorentz: interfaces>>=
   interface azimuthal_angle_deg
      module procedure vector3_azimuthal_angle_deg
      module procedure vector4_azimuthal_angle_deg
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector3_azimuthal_angle_deg (p) result (phi)
       real(default) :: phi
       type(vector3_t), intent(in) :: p
     end function vector3_azimuthal_angle_deg
     elemental module function vector4_azimuthal_angle_deg (p) result (phi)
       real(default) :: phi
       type(vector4_t), intent(in) :: p
     end function vector4_azimuthal_angle_deg
 <<Lorentz: procedures>>=
   elemental module function vector3_azimuthal_angle_deg (p) result (phi)
     real(default) :: phi
     type(vector3_t), intent(in) :: p
     phi = vector3_azimuthal_angle (p) / degree
   end function vector3_azimuthal_angle_deg
   elemental module function vector4_azimuthal_angle_deg (p) result (phi)
     real(default) :: phi
     type(vector4_t), intent(in) :: p
     phi = vector4_azimuthal_angle (p) / degree
   end function vector4_azimuthal_angle_deg
 
 @ %def azimuthal_angle_deg
 @ The azimuthal distance of two vectors.  This is the difference of
 the azimuthal angles, but cannot be larger than $\pi$: The result is
 between $-\pi<\Delta\phi\leq\pi$.
 <<Lorentz: public functions>>=
   public :: azimuthal_distance
 <<Lorentz: interfaces>>=
   interface azimuthal_distance
      module procedure vector3_azimuthal_distance
      module procedure vector4_azimuthal_distance
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector3_azimuthal_distance (p, q) result (dphi)
       real(default) :: dphi
       type(vector3_t), intent(in) :: p,q
     end function vector3_azimuthal_distance
     elemental module function vector4_azimuthal_distance (p, q) result (dphi)
       real(default) :: dphi
       type(vector4_t), intent(in) :: p,q
     end function vector4_azimuthal_distance
 <<Lorentz: procedures>>=
   elemental module function vector3_azimuthal_distance (p, q) result (dphi)
     real(default) :: dphi
     type(vector3_t), intent(in) :: p,q
     dphi = vector3_azimuthal_angle (q) - vector3_azimuthal_angle (p)
     if (dphi <= -pi) then
        dphi = dphi + twopi
     else if (dphi > pi) then
        dphi = dphi - twopi
     end if
   end function vector3_azimuthal_distance
   elemental module function vector4_azimuthal_distance (p, q) result (dphi)
     real(default) :: dphi
     type(vector4_t), intent(in) :: p,q
     dphi = vector3_azimuthal_distance &
          (space_part (p), space_part (q))
   end function vector4_azimuthal_distance
 
 @ %def azimuthal_distance
 @ The same in degrees:
 <<Lorentz: public functions>>=
   public :: azimuthal_distance_deg
 <<Lorentz: interfaces>>=
   interface azimuthal_distance_deg
      module procedure vector3_azimuthal_distance_deg
      module procedure vector4_azimuthal_distance_deg
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function vector3_azimuthal_distance_deg (p, q) result (dphi)
       real(default) :: dphi
       type(vector3_t), intent(in) :: p,q
     end function vector3_azimuthal_distance_deg
     elemental module function vector4_azimuthal_distance_deg (p, q) result (dphi)
       real(default) :: dphi
       type(vector4_t), intent(in) :: p,q
     end function vector4_azimuthal_distance_deg
 <<Lorentz: procedures>>=
   elemental module function vector3_azimuthal_distance_deg (p, q) result (dphi)
     real(default) :: dphi
     type(vector3_t), intent(in) :: p,q
     dphi = vector3_azimuthal_distance (p, q) / degree
   end function vector3_azimuthal_distance_deg
   elemental module function vector4_azimuthal_distance_deg (p, q) result (dphi)
     real(default) :: dphi
     type(vector4_t), intent(in) :: p,q
     dphi = vector4_azimuthal_distance (p, q) / degree
   end function vector4_azimuthal_distance_deg
 
 @ %def azimuthal_distance_deg
 @ The polar angle is defined $0\leq\theta\leq\pi$.  Note that
 [[ATAN2]] has the reversed order of arguments: [[ATAN2(Y,X)]].  Here,
 $x$ is the 3-component while $y$ is the transverse momentum which is
 always nonnegative.  Therefore, the result is nonnegative as well.
 <<Lorentz: public functions>>=
   public :: polar_angle
 <<Lorentz: interfaces>>=
   interface polar_angle
      module procedure polar_angle_vector3
      module procedure polar_angle_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function polar_angle_vector3 (p) result (theta)
       real(default) :: theta
       type(vector3_t), intent(in) :: p
     end function polar_angle_vector3
     elemental module function polar_angle_vector4 (p) result (theta)
       real(default) :: theta
       type(vector4_t), intent(in) :: p
     end function polar_angle_vector4
 <<Lorentz: procedures>>=
   elemental module function polar_angle_vector3 (p) result (theta)
     real(default) :: theta
     type(vector3_t), intent(in) :: p
     if (any (abs (p%p) > 0)) then
        theta = atan2 (sqrt(p%p(1)**2 + p%p(2)**2), p%p(3))
     else
        theta = 0
     end if
   end function polar_angle_vector3
   elemental module function polar_angle_vector4 (p) result (theta)
     real(default) :: theta
     type(vector4_t), intent(in) :: p
     theta = polar_angle (space_part (p))
   end function polar_angle_vector4
 
 @ %def polar_angle
 @ This is the cosine of the polar angle: $-1\leq\cos\theta\leq 1$.
 <<Lorentz: public functions>>=
   public :: polar_angle_ct
 <<Lorentz: interfaces>>=
   interface polar_angle_ct
      module procedure polar_angle_ct_vector3
      module procedure polar_angle_ct_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function polar_angle_ct_vector3 (p) result (ct)
       real(default) :: ct
       type(vector3_t), intent(in) :: p
     end function polar_angle_ct_vector3
     elemental module function polar_angle_ct_vector4 (p) result (ct)
       real(default) :: ct
       type(vector4_t), intent(in) :: p
     end function polar_angle_ct_vector4
 <<Lorentz: procedures>>=
   elemental module function polar_angle_ct_vector3 (p) result (ct)
     real(default) :: ct
     type(vector3_t), intent(in) :: p
     if (any (abs (p%p) > 0)) then
        ct = p%p(3) / p**1
     else
        ct = 1
     end if
   end function polar_angle_ct_vector3
   elemental module function polar_angle_ct_vector4 (p) result (ct)
     real(default) :: ct
     type(vector4_t), intent(in) :: p
     ct = polar_angle_ct (space_part (p))
   end function polar_angle_ct_vector4
 
 @ %def polar_angle_ct
 @ The polar angle in degrees.
 <<Lorentz: public functions>>=
   public :: polar_angle_deg
 <<Lorentz: interfaces>>=
   interface polar_angle_deg
      module procedure polar_angle_deg_vector3
      module procedure polar_angle_deg_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function polar_angle_deg_vector3 (p) result (theta)
       real(default) :: theta
       type(vector3_t), intent(in) :: p
     end function polar_angle_deg_vector3
     elemental module function polar_angle_deg_vector4 (p) result (theta)
       real(default) :: theta
       type(vector4_t), intent(in) :: p
     end function polar_angle_deg_vector4
 <<Lorentz: procedures>>=
   elemental module function polar_angle_deg_vector3 (p) result (theta)
     real(default) :: theta
     type(vector3_t), intent(in) :: p
     theta = polar_angle (p) / degree
   end function polar_angle_deg_vector3
   elemental module function polar_angle_deg_vector4 (p) result (theta)
     real(default) :: theta
     type(vector4_t), intent(in) :: p
     theta = polar_angle (p) / degree
   end function polar_angle_deg_vector4
 
 @ %def polar_angle_deg
 @ This is the angle enclosed between two three-momenta.  If one of the
 momenta is zero, we return an angle of zero.  The range of the result
 is $0\leq\theta\leq\pi$.  If there is only one argument, take the
 positive $z$ axis as reference.
 <<Lorentz: public functions>>=
   public :: enclosed_angle
 <<Lorentz: interfaces>>=
   interface enclosed_angle
      module procedure enclosed_angle_vector3
      module procedure enclosed_angle_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function enclosed_angle_vector3 (p, q) result (theta)
       real(default) :: theta
       type(vector3_t), intent(in) :: p, q
     end function enclosed_angle_vector3
     elemental module function enclosed_angle_vector4 (p, q) result (theta)
       real(default) :: theta
       type(vector4_t), intent(in) :: p, q
     end function enclosed_angle_vector4
 <<Lorentz: procedures>>=
   elemental module function enclosed_angle_vector3 (p, q) result (theta)
     real(default) :: theta
     type(vector3_t), intent(in) :: p, q
     theta = acos (enclosed_angle_ct (p, q))
   end function enclosed_angle_vector3
   elemental module function enclosed_angle_vector4 (p, q) result (theta)
     real(default) :: theta
     type(vector4_t), intent(in) :: p, q
     theta = enclosed_angle (space_part (p), space_part (q))
   end function enclosed_angle_vector4
 
 @ %def enclosed_angle
 @ The cosine of the enclosed angle.
 <<Lorentz: public functions>>=
   public :: enclosed_angle_ct
 <<Lorentz: interfaces>>=
   interface enclosed_angle_ct
      module procedure enclosed_angle_ct_vector3
      module procedure enclosed_angle_ct_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function enclosed_angle_ct_vector3 (p, q) result (ct)
       real(default) :: ct
       type(vector3_t), intent(in) :: p, q
     end function enclosed_angle_ct_vector3
     elemental module function enclosed_angle_ct_vector4 (p, q) result (ct)
       real(default) :: ct
       type(vector4_t), intent(in) :: p, q
     end function enclosed_angle_ct_vector4
 <<Lorentz: procedures>>=
   elemental module function enclosed_angle_ct_vector3 (p, q) result (ct)
     real(default) :: ct
     type(vector3_t), intent(in) :: p, q
     if (any (abs (p%p) > 0) .and. any (abs (q%p) > 0)) then
        ct = p*q / (p**1 * q**1)
        if (ct>1) then
           ct = 1
        else if (ct<-1) then
           ct = -1
        end if
     else
        ct = 1
     end if
   end function enclosed_angle_ct_vector3
   elemental module function enclosed_angle_ct_vector4 (p, q) result (ct)
     real(default) :: ct
     type(vector4_t), intent(in) :: p, q
     ct = enclosed_angle_ct (space_part (p), space_part (q))
   end function enclosed_angle_ct_vector4
 
 @ %def enclosed_angle_ct
 @ The enclosed angle in degrees.
 <<Lorentz: public functions>>=
   public :: enclosed_angle_deg
 <<Lorentz: interfaces>>=
   interface enclosed_angle_deg
      module procedure enclosed_angle_deg_vector3
      module procedure enclosed_angle_deg_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function enclosed_angle_deg_vector3 (p, q) result (theta)
       real(default) :: theta
       type(vector3_t), intent(in) :: p, q
     end function enclosed_angle_deg_vector3
     elemental module function enclosed_angle_deg_vector4 (p, q) result (theta)
       real(default) :: theta
       type(vector4_t), intent(in) :: p, q
     end function enclosed_angle_deg_vector4
 <<Lorentz: procedures>>=
   elemental module function enclosed_angle_deg_vector3 (p, q) result (theta)
     real(default) :: theta
     type(vector3_t), intent(in) :: p, q
     theta = enclosed_angle (p, q) / degree
   end function enclosed_angle_deg_vector3
   elemental module function enclosed_angle_deg_vector4 (p, q) result (theta)
     real(default) :: theta
     type(vector4_t), intent(in) :: p, q
     theta = enclosed_angle (p, q) / degree
   end function enclosed_angle_deg_vector4
 
 @ %def enclosed_angle
 @ The polar angle of the first momentum w.r.t.\ the second momentum,
 evaluated in the rest frame of the second momentum.  If the second
 four-momentum is not timelike, return zero.
 <<Lorentz: public functions>>=
   public :: enclosed_angle_rest_frame
   public :: enclosed_angle_ct_rest_frame
   public :: enclosed_angle_deg_rest_frame
 <<Lorentz: interfaces>>=
   interface enclosed_angle_rest_frame
      module procedure enclosed_angle_rest_frame_vector4
   end interface
   interface enclosed_angle_ct_rest_frame
      module procedure enclosed_angle_ct_rest_frame_vector4
   end interface
   interface enclosed_angle_deg_rest_frame
      module procedure enclosed_angle_deg_rest_frame_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function enclosed_angle_rest_frame_vector4 (p, q) result (theta)
       type(vector4_t), intent(in) :: p, q
       real(default) :: theta
     end function enclosed_angle_rest_frame_vector4
     elemental module function enclosed_angle_ct_rest_frame_vector4 (p, q) result (ct)
       type(vector4_t), intent(in) :: p, q
       real(default) :: ct
     end function enclosed_angle_ct_rest_frame_vector4
     elemental module function enclosed_angle_deg_rest_frame_vector4 (p, q) &
          result (theta)
       type(vector4_t), intent(in) :: p, q
       real(default) :: theta
     end function enclosed_angle_deg_rest_frame_vector4
 <<Lorentz: procedures>>=
   elemental module function enclosed_angle_rest_frame_vector4 (p, q) result (theta)
     type(vector4_t), intent(in) :: p, q
     real(default) :: theta
     theta = acos (enclosed_angle_ct_rest_frame (p, q))
   end function enclosed_angle_rest_frame_vector4
   elemental module function enclosed_angle_ct_rest_frame_vector4 (p, q) result (ct)
     type(vector4_t), intent(in) :: p, q
     real(default) :: ct
     if (invariant_mass(q) > 0) then
        ct = enclosed_angle_ct ( &
             space_part (boost(-q, invariant_mass (q)) * p), &
             space_part (q))
     else
        ct = 1
     end if
   end function enclosed_angle_ct_rest_frame_vector4
   elemental module function enclosed_angle_deg_rest_frame_vector4 (p, q) &
        result (theta)
     type(vector4_t), intent(in) :: p, q
     real(default) :: theta
     theta = enclosed_angle_rest_frame (p, q) / degree
   end function enclosed_angle_deg_rest_frame_vector4
 
 @ %def enclosed_angle_rest_frame
 @ %def enclosed_angle_ct_rest_frame
 @ %def enclosed_angle_deg_rest_frame
 @
 \subsection{More kinematical functions (some redundant)}
 The scalar transverse momentum (assuming the $z$ axis is longitudinal)
 <<Lorentz: public functions>>=
   public :: transverse_part
 <<Lorentz: interfaces>>=
   interface transverse_part
      module procedure transverse_part_vector4_beam_axis
      module procedure transverse_part_vector4_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function transverse_part_vector4_beam_axis (p) result (pT)
       real(default) :: pT
       type(vector4_t), intent(in) :: p
     end function transverse_part_vector4_beam_axis
     elemental module function transverse_part_vector4_vector4 (p1, p2) result (pT)
       real(default) :: pT
       type(vector4_t), intent(in) :: p1, p2
     end function transverse_part_vector4_vector4
 <<Lorentz: procedures>>=
   elemental module function transverse_part_vector4_beam_axis (p) result (pT)
     real(default) :: pT
     type(vector4_t), intent(in) :: p
     pT = sqrt(p%p(1)**2 + p%p(2)**2)
   end function transverse_part_vector4_beam_axis
 
   elemental module function transverse_part_vector4_vector4 (p1, p2) result (pT)
     real(default) :: pT
     type(vector4_t), intent(in) :: p1, p2
     real(default) :: p1_norm, p2_norm, p1p2, pT2
     p1_norm = space_part_norm(p1)**2
     p2_norm = space_part_norm(p2)**2
 !    p1p2 = p1%p(1:3)*p2%p(1:3)
     p1p2 = vector4_get_space_part(p1) * vector4_get_space_part(p2)
     pT2 = (p1_norm*p2_norm - p1p2)/p1_norm
     pT = sqrt (pT2)
   end function transverse_part_vector4_vector4
 
 @ %def transverse_part
 @ The scalar longitudinal momentum (assuming the $z$ axis is
 longitudinal).  Identical to [[momentum_z_component]].
 <<Lorentz: public functions>>=
   public :: longitudinal_part
 <<Lorentz: interfaces>>=
   interface longitudinal_part
      module procedure longitudinal_part_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function longitudinal_part_vector4 (p) result (pL)
       real(default) :: pL
       type(vector4_t), intent(in) :: p
     end function longitudinal_part_vector4
 <<Lorentz: procedures>>=
   elemental module function longitudinal_part_vector4 (p) result (pL)
     real(default) :: pL
     type(vector4_t), intent(in) :: p
     pL = p%p(3)
   end function longitudinal_part_vector4
 
 @ %def longitudinal_part
 @ Absolute value of three-momentum
 <<Lorentz: public functions>>=
   public :: space_part_norm
 <<Lorentz: interfaces>>=
   interface space_part_norm
      module procedure space_part_norm_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function space_part_norm_vector4 (p) result (p3)
       real(default) :: p3
       type(vector4_t), intent(in) :: p
     end function space_part_norm_vector4
 <<Lorentz: procedures>>=
   elemental module function space_part_norm_vector4 (p) result (p3)
     real(default) :: p3
     type(vector4_t), intent(in) :: p
     p3 = sqrt (p%p(1)**2 + p%p(2)**2 + p%p(3)**2)
   end function space_part_norm_vector4
 
 @ %def momentum
 @ The energy (the zeroth component)
 <<Lorentz: public functions>>=
   public :: energy
 <<Lorentz: interfaces>>=
   interface energy
      module procedure energy_vector4
      module procedure energy_vector3
      module procedure energy_real
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function energy_vector4 (p) result (E)
       real(default) :: E
       type(vector4_t), intent(in) :: p
     end function energy_vector4
     elemental module function energy_vector3 (p, mass) result (E)
       real(default) :: E
       type(vector3_t), intent(in) :: p
       real(default), intent(in), optional :: mass
     end function energy_vector3
     elemental module function energy_real (p, mass) result (E)
       real(default) :: E
       real(default), intent(in) :: p
       real(default), intent(in), optional :: mass
     end function energy_real
 <<Lorentz: procedures>>=
   elemental module function energy_vector4 (p) result (E)
     real(default) :: E
     type(vector4_t), intent(in) :: p
     E = p%p(0)
   end function energy_vector4
 
 @ Alternative: The energy corresponding to a given momentum and mass.
 If the mass is omitted, it is zero
 <<Lorentz: procedures>>=
   elemental module function energy_vector3 (p, mass) result (E)
     real(default) :: E
     type(vector3_t), intent(in) :: p
     real(default), intent(in), optional :: mass
     if (present (mass)) then
        E = sqrt (p**2 + mass**2)
     else
        E = p**1
     end if
   end function energy_vector3
 
   elemental module function energy_real (p, mass) result (E)
     real(default) :: E
     real(default), intent(in) :: p
     real(default), intent(in), optional :: mass
     if (present (mass)) then
        E = sqrt (p**2 + mass**2)
     else
        E = abs (p)
     end if
   end function energy_real
 
 @ %def energy
 @ The invariant mass of four-momenta.  Zero for lightlike, negative for
 spacelike momenta.
 <<Lorentz: public functions>>=
   public :: invariant_mass
 <<Lorentz: interfaces>>=
   interface invariant_mass
      module procedure invariant_mass_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function invariant_mass_vector4 (p) result (m)
       real(default) :: m
       type(vector4_t), intent(in) :: p
     end function invariant_mass_vector4
 <<Lorentz: procedures>>=
   elemental module function invariant_mass_vector4 (p) result (m)
     real(default) :: m
     type(vector4_t), intent(in) :: p
     real(default) :: msq
     msq = p*p
     if (msq >= 0) then
        m = sqrt (msq)
     else
        m = - sqrt (abs (msq))
     end if
   end function invariant_mass_vector4
 @ %def invariant_mass
 @ The invariant mass squared.  Zero for lightlike, negative for
 spacelike momenta.
 <<Lorentz: public functions>>=
   public :: invariant_mass_squared
 <<Lorentz: interfaces>>=
   interface invariant_mass_squared
      module procedure invariant_mass_squared_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function invariant_mass_squared_vector4 (p) result (msq)
       real(default) :: msq
       type(vector4_t), intent(in) :: p
     end function invariant_mass_squared_vector4
 <<Lorentz: procedures>>=
   elemental module function invariant_mass_squared_vector4 (p) result (msq)
     real(default) :: msq
     type(vector4_t), intent(in) :: p
     msq = p*p
   end function invariant_mass_squared_vector4
 
 @ %def invariant_mass_squared
 @ The transverse mass.  If the mass squared is negative, this value
 also is negative.
 <<Lorentz: public functions>>=
   public :: transverse_mass
 <<Lorentz: interfaces>>=
   interface transverse_mass
      module procedure transverse_mass_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function transverse_mass_vector4 (p) result (m)
       real(default) :: m
       type(vector4_t), intent(in) :: p
     end function transverse_mass_vector4
 <<Lorentz: procedures>>=
   elemental module function transverse_mass_vector4 (p) result (m)
     real(default) :: m
     type(vector4_t), intent(in) :: p
     real(default) :: msq
     msq = p%p(0)**2 - p%p(1)**2 - p%p(2)**2
     if (msq >= 0) then
        m = sqrt (msq)
     else
        m = - sqrt (abs (msq))
     end if
   end function transverse_mass_vector4
 
 @ %def transverse_mass
 @ The rapidity (defined if particle is massive or $p_\perp>0$)
 <<Lorentz: public functions>>=
   public :: rapidity
 <<Lorentz: interfaces>>=
   interface rapidity
      module procedure rapidity_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function rapidity_vector4 (p) result (y)
       real(default) :: y
       type(vector4_t), intent(in) :: p
     end function rapidity_vector4
 <<Lorentz: procedures>>=
   elemental module function rapidity_vector4 (p) result (y)
     real(default) :: y
     type(vector4_t), intent(in) :: p
     y = .5 * log( (energy (p) + longitudinal_part (p)) &
          &       /(energy (p) - longitudinal_part (p)))
   end function rapidity_vector4
 
 @ %def rapidity
 @ The pseudorapidity (defined if $p_\perp>0$)
 <<Lorentz: public functions>>=
   public :: pseudorapidity
 <<Lorentz: interfaces>>=
   interface pseudorapidity
      module procedure pseudorapidity_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function pseudorapidity_vector4 (p) result (eta)
       real(default) :: eta
       type(vector4_t), intent(in) :: p
     end function pseudorapidity_vector4
 <<Lorentz: procedures>>=
   elemental module function pseudorapidity_vector4 (p) result (eta)
     real(default) :: eta
     type(vector4_t), intent(in) :: p
     eta = -log( tan (.5 * polar_angle (p)))
   end function pseudorapidity_vector4
 
 @ %def pseudorapidity
 @ The rapidity distance (defined if both $p_\perp>0$)
 <<Lorentz: public functions>>=
   public :: rapidity_distance
 <<Lorentz: interfaces>>=
   interface rapidity_distance
      module procedure rapidity_distance_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function rapidity_distance_vector4 (p, q) result (dy)
       type(vector4_t), intent(in) :: p, q
       real(default) :: dy
     end function rapidity_distance_vector4
 <<Lorentz: procedures>>=
   elemental module function rapidity_distance_vector4 (p, q) result (dy)
     type(vector4_t), intent(in) :: p, q
     real(default) :: dy
     dy = rapidity (q) - rapidity (p)
   end function rapidity_distance_vector4
 
 @ %def rapidity_distance
 @ The pseudorapidity distance (defined if both $p_\perp>0$)
 <<Lorentz: public functions>>=
   public :: pseudorapidity_distance
 <<Lorentz: interfaces>>=
   interface pseudorapidity_distance
      module procedure pseudorapidity_distance_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function pseudorapidity_distance_vector4 (p, q) result (deta)
       real(default) :: deta
       type(vector4_t), intent(in) :: p, q
     end function pseudorapidity_distance_vector4
 <<Lorentz: procedures>>=
   elemental module function pseudorapidity_distance_vector4 (p, q) result (deta)
     real(default) :: deta
     type(vector4_t), intent(in) :: p, q
     deta = pseudorapidity (q) - pseudorapidity (p)
   end function pseudorapidity_distance_vector4
 
 @ %def pseudorapidity_distance
 @ The distance on the $\eta-\phi$ cylinder:
 <<Lorentz: public functions>>=
   public :: eta_phi_distance
 <<Lorentz: interfaces>>=
   interface eta_phi_distance
      module procedure eta_phi_distance_vector4
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function eta_phi_distance_vector4 (p, q) result (dr)
       type(vector4_t), intent(in) :: p, q
       real(default) :: dr
     end function eta_phi_distance_vector4
 <<Lorentz: procedures>>=
   elemental module function eta_phi_distance_vector4 (p, q) result (dr)
     type(vector4_t), intent(in) :: p, q
     real(default) :: dr
     dr = sqrt ( &
          pseudorapidity_distance (p, q)**2 &
          + azimuthal_distance (p, q)**2)
   end function eta_phi_distance_vector4
 
 @ %def eta_phi_distance
 @
 \subsection{Lorentz transformations}
 <<Lorentz: public>>=
   public :: lorentz_transformation_t
 <<Lorentz: types>>=
   type :: lorentz_transformation_t
      private
      real(default), dimension(0:3, 0:3) :: L
    contains
    <<Lorentz: lorentz transformation: TBP>>
   end type lorentz_transformation_t
 
 @ %def lorentz_transformation_t
 @ Output:
 <<Lorentz: public>>=
   public :: lorentz_transformation_write
 <<Lorentz: lorentz transformation: TBP>>=
   procedure :: write => lorentz_transformation_write
 <<Lorentz: sub interfaces>>=
     module subroutine lorentz_transformation_write (L, unit, testflag, ultra)
       class(lorentz_transformation_t), intent(in) :: L
       integer, intent(in), optional :: unit
       logical, intent(in), optional :: testflag, ultra
     end subroutine lorentz_transformation_write
 <<Lorentz: procedures>>=
   module subroutine lorentz_transformation_write (L, unit, testflag, ultra)
     class(lorentz_transformation_t), intent(in) :: L
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag, ultra
     integer :: u, i
     logical :: ult
     character(len=7) :: fmt
     ult = .false.; if (present (ultra)) ult = ultra
     if (ult) then
        call pac_fmt (fmt, FMT_19, FMT_11, ultra)
     else
        call pac_fmt (fmt, FMT_19, FMT_13, testflag)
     end if
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A,3(1x," // fmt // "))")  "L00 = ", L%L(0,0)
     write (u, "(1x,A,3(1x," // fmt // "))")  "L0j = ", L%L(0,1:3)
     do i = 1, 3
        write (u, "(1x,A,I0,A,3(1x," // fmt // "))")  &
             "L", i, "0 = ", L%L(i,0)
        write (u, "(1x,A,I0,A,3(1x," // fmt // "))")  &
             "L", i, "j = ", L%L(i,1:3)
     end do
   end subroutine lorentz_transformation_write
 
 @ %def lorentz_transformation_write
 @ Extract all components:
 <<Lorentz: public>>=
   public :: lorentz_transformation_get_components
 <<Lorentz: sub interfaces>>=
     pure module function lorentz_transformation_get_components (L) result (a)
       type(lorentz_transformation_t), intent(in) :: L
       real(default), dimension(0:3,0:3) :: a
     end function lorentz_transformation_get_components
 <<Lorentz: procedures>>=
   pure module function lorentz_transformation_get_components (L) result (a)
     type(lorentz_transformation_t), intent(in) :: L
     real(default), dimension(0:3,0:3) :: a
     a = L%L
   end function lorentz_transformation_get_components
 
 @ %def lorentz_transformation_get_components
 @
 \subsection{Functions of Lorentz transformations}
 For the inverse, we make use of the fact that
 $\Lambda^{\mu\nu}\Lambda_{\mu\rho}=\delta^\nu_\rho$.  So, lowering the
 indices and transposing is sufficient.
 <<Lorentz: public functions>>=
   public :: inverse
 <<Lorentz: interfaces>>=
   interface inverse
      module procedure lorentz_transformation_inverse
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function lorentz_transformation_inverse (L) result (IL)
       type(lorentz_transformation_t) :: IL
       type(lorentz_transformation_t), intent(in) :: L
     end function lorentz_transformation_inverse
 <<Lorentz: procedures>>=
   elemental module function lorentz_transformation_inverse (L) result (IL)
     type(lorentz_transformation_t) :: IL
     type(lorentz_transformation_t), intent(in) :: L
     IL%L(0,0) = L%L(0,0)
     IL%L(0,1:) = -L%L(1:,0)
     IL%L(1:,0) = -L%L(0,1:)
     IL%L(1:,1:) = transpose(L%L(1:,1:))
   end function lorentz_transformation_inverse
 
 @ %def lorentz_transformation_inverse
 @ %def inverse
 @
 \subsection{Invariants}
 These are used below.  The first array index is varying fastest in
 [[FORTRAN]]; therefore the extra minus in the odd-rank tensor
 epsilon.
 <<Lorentz: parameters>>=
   integer, dimension(3,3), parameter :: delta_three = &
        & reshape( source = [ 1,0,0, 0,1,0, 0,0,1 ], &
        &          shape  = [3,3] )
   integer, dimension(3,3,3), parameter :: epsilon_three = &
        & reshape( source = [ 0, 0,0,  0,0,-1,   0,1,0, &
        &                     0, 0,1,  0,0, 0,  -1,0,0, &
        &                     0,-1,0,  1,0, 0,   0,0,0 ],&
        &          shape = [3,3,3] )
 @ %def delta_three epsilon_three
 @ This could be of some use:
 <<Lorentz: public>>=
   public :: identity
 <<Lorentz: parameters>>=
   type(lorentz_transformation_t), parameter :: &
        & identity = &
        & lorentz_transformation_t ( &
        & reshape( source = [ one, zero, zero, zero, &
        &                     zero, one, zero, zero, &
        &                     zero, zero, one, zero, &
        &                     zero, zero, zero, one ],&
        &          shape = [4,4] ) )
 @ %def identity
 <<Lorentz: public>>=
   public :: space_reflection
 <<Lorentz: parameters>>=
   type(lorentz_transformation_t), parameter :: &
        & space_reflection = &
        & lorentz_transformation_t ( &
        & reshape( source = [ one, zero, zero, zero, &
        &                     zero,-one, zero, zero, &
        &                     zero, zero,-one, zero, &
        &                     zero, zero, zero,-one ],&
        &          shape = [4,4] ) )
 @ %def space_reflection
 @ Builds a unit vector orthogal to the input vector in the xy-plane.
 <<Lorentz: public functions>>=
   public :: create_orthogonal
 <<Lorentz: sub interfaces>>=
     module function create_orthogonal (p_in) result (p_out)
       type(vector3_t), intent(in) :: p_in
       type(vector3_t) :: p_out
     end function create_orthogonal
 <<Lorentz: procedures>>=
   module function create_orthogonal (p_in) result (p_out)
     type(vector3_t), intent(in) :: p_in
     type(vector3_t) :: p_out
     real(default) :: ab
     ab = sqrt (p_in%p(1)**2 + p_in%p(2)**2)
     if (abs (ab) < eps0) then
       p_out%p(1) = 1
       p_out%p(2) = 0
       p_out%p(3) = 0
     else
       p_out%p(1) = p_in%p(2)
       p_out%p(2) = -p_in%p(1)
       p_out%p(3) = 0
       p_out = p_out / ab
     end if
   end function create_orthogonal
 
 @ %def create_orthogonal
 @
 <<Lorentz: public functions>>=
   public :: create_unit_vector
 <<Lorentz: sub interfaces>>=
     module function create_unit_vector (p_in) result (p_out)
       type(vector4_t), intent(in) :: p_in
       type(vector3_t) :: p_out
     end function create_unit_vector
 <<Lorentz: procedures>>=
   module function create_unit_vector (p_in) result (p_out)
     type(vector4_t), intent(in) :: p_in
     type(vector3_t) :: p_out
     p_out%p = p_in%p(1:3) / space_part_norm (p_in)
   end function create_unit_vector
 
 @ %def create_unit_vector
 @
 <<Lorentz: public functions>>=
   public :: normalize
 <<Lorentz: sub interfaces>>=
     module function normalize(p) result (p_norm)
       type(vector3_t) :: p_norm
       type(vector3_t), intent(in) :: p
     end function normalize
 <<Lorentz: procedures>>=
   module function normalize(p) result (p_norm)
     type(vector3_t) :: p_norm
     type(vector3_t), intent(in) :: p
     real(default) :: abs
     abs = sqrt (p%p(1)**2 + p%p(2)**2 + p%p(3)**2)
     p_norm = p / abs
   end function normalize
 
 @ %def normalize
 @ Computes the invariant mass of the momenta sum given by the indices in
 [[i_res_born]] and the optional argument [[i_emitter]].
 <<Lorentz: public>>=
   public :: compute_resonance_mass
 <<Lorentz: sub interfaces>>=
     pure module function compute_resonance_mass (p, i_res_born, i_gluon) result (m)
       real(default) :: m
       type(vector4_t), intent(in), dimension(:) :: p
       integer, intent(in), dimension(:) :: i_res_born
       integer, intent(in), optional :: i_gluon
     end function compute_resonance_mass
 <<Lorentz: procedures>>=
   pure module function compute_resonance_mass (p, i_res_born, i_gluon) result (m)
     real(default) :: m
     type(vector4_t), intent(in), dimension(:) :: p
     integer, intent(in), dimension(:) :: i_res_born
     integer, intent(in), optional :: i_gluon
     type(vector4_t) :: p_res
     p_res = get_resonance_momentum (p, i_res_born, i_gluon)
     m = p_res**1
   end function compute_resonance_mass
 
 @ %def compute_resonance_mass
 @
 <<Lorentz: public>>=
   public :: get_resonance_momentum
 <<Lorentz: sub interfaces>>=
     pure module function get_resonance_momentum &
          (p, i_res_born, i_gluon) result (p_res)
       type(vector4_t) :: p_res
       type(vector4_t), intent(in), dimension(:) :: p
       integer, intent(in), dimension(:) :: i_res_born
       integer, intent(in), optional :: i_gluon
     end function get_resonance_momentum
 <<Lorentz: procedures>>=
   pure module function get_resonance_momentum &
        (p, i_res_born, i_gluon) result (p_res)
     type(vector4_t) :: p_res
     type(vector4_t), intent(in), dimension(:) :: p
     integer, intent(in), dimension(:) :: i_res_born
     integer, intent(in), optional :: i_gluon
     integer :: i
     p_res = vector4_null
     do i = 1, size (i_res_born)
        p_res = p_res + p (i_res_born(i))
     end do
     if (present (i_gluon)) p_res = p_res + p (i_gluon)
   end function get_resonance_momentum
 
 @ %def get_resonance_momentum
 @
 <<Lorentz: public>>=
   public :: create_two_particle_decay
 <<Lorentz: sub interfaces>>=
     module function create_two_particle_decay (s, p1, p2) result (p_rest)
       type(vector4_t), dimension(3) :: p_rest
       real(default), intent(in) :: s
       type(vector4_t), intent(in) :: p1, p2
     end function create_two_particle_decay
 <<Lorentz: procedures>>=
   module function create_two_particle_decay (s, p1, p2) result (p_rest)
     type(vector4_t), dimension(3) :: p_rest
     real(default), intent(in) :: s
     type(vector4_t), intent(in) :: p1, p2
     real(default) :: m1_sq, m2_sq
     real(default) :: E1, E2, p
     m1_sq = p1**2; m2_sq = p2**2
     p = sqrt (lambda (s, m1_sq, m2_sq)) / (two * sqrt (s))
     E1 = sqrt (m1_sq + p**2); E2 = sqrt (m2_sq + p**2)
     p_rest(1)%p = [sqrt (s), zero, zero, zero]
     p_rest(2)%p(0) = E1
     p_rest(2)%p(1:3) = p * p1%p(1:3) / space_part_norm (p1)
     p_rest(3)%p(0) = E2; p_rest(3)%p(1:3) = -p_rest(2)%p(1:3)
   end function create_two_particle_decay
 
 @ %def create_two_particle_decay
 @ This function creates a phase-space point for a $1 \to 3$ decay in
 the decaying particle's rest frame. There are three rest frames for
 this system, corresponding to $s$-, $t$,- and $u$-channel momentum
 exchange, also referred to as Gottfried-Jackson frames. Below, we choose
 the momentum with index 1 to be aligned along the $z$-axis. We then
 have
 \begin{align*}
   s_1 &= \left(p_1 + p_2\right)^2, \\
   s_2 &= \left(p_2 + p_3\right)^2, \\
   s_3 &= \left(p_1 + p_3\right)^2, \\
   s_1 + s_2 + s_3 &= s + m_1^2 + m_2^2 + m_3^2.
 \end{align*}
 From these we can construct
 \begin{align*}
   E_1^{R23} = \frac{s - s_2 - m_1^2}{2\sqrt{s_2}} &\quad P_1^{R23} = \frac{\lambda^{1/2}(s, s_2, m_1^2)}{2\sqrt{s_2}},\\
   E_2^{R23} = \frac{s_2 + m_2^2 - m_3^2}{2\sqrt{s_2}} &\quad P_2^{R23} = \frac{\lambda^{1/2}(s_2, m_2^2, m_3^2)}{2\sqrt{s_2}},\\
   E_3^{R23} = \frac{s_2 + m_3^2 - m_2^2}{2\sqrt{s_2}} &\quad P_3^{R23} = P_2^{R23},
 \end{align*}
 where $R23$ denotes the Gottfried-Jackson frame of our choice. Finally, the scattering angle $\theta_{12}^{R23}$ between
 momentum $1$ and $2$ can be determined to be
 \begin{equation*}
   \cos\theta_{12}^{R23} = \frac{(s - s_2 - m_1^2)(s_2 + m_2^2 - m_3^2) + 2s_2 (m_1^2 + m_2^2 - s_1)}
                                {\lambda^{1/2}(s, s_2, m_1^2) \lambda^{1/2}(s_2, m_2^2, m_3^2)}
 \end{equation*}
 <<Lorentz: public>>=
   public :: create_three_particle_decay
 <<Lorentz: sub interfaces>>=
     module function create_three_particle_decay (p1, p2, p3) result (p_rest)
       type(vector4_t), dimension(4) :: p_rest
       type(vector4_t), intent(in) :: p1, p2, p3
     end function create_three_particle_decay
 <<Lorentz: procedures>>=
   module function create_three_particle_decay (p1, p2, p3) result (p_rest)
     type(vector4_t), dimension(4) :: p_rest
     type(vector4_t), intent(in) :: p1, p2, p3
     real(default) :: E1, E2, E3
     real(default) :: pr1, pr2, pr3
     real(default) :: s, s1, s2, s3
     real(default) :: m1_sq, m2_sq, m3_sq
     real(default) :: cos_theta_12
     type(vector3_t) :: v3_unit
     type(lorentz_transformation_t) :: rot
     m1_sq = p1**2
     m2_sq = p2**2
     m3_sq = p3**2
     s1 = (p1 + p2)**2
     s2 = (p2 + p3)**2
     s3 = (p3 + p1)**2
     s = s1 + s2 + s3 - m1_sq - m2_sq - m3_sq
     E1 = (s - s2 - m1_sq) / (two * sqrt (s2))
     E2 = (s2 + m2_sq - m3_sq) / (two * sqrt (s2))
     E3 = (s2 + m3_sq - m2_sq) / (two * sqrt (s2))
     pr1 = sqrt (lambda (s, s2, m1_sq)) / (two * sqrt (s2))
     pr2 = sqrt (lambda (s2, m2_sq, m3_sq)) / (two * sqrt(s2))
     pr3 = pr2
     cos_theta_12 = ((s - s2 - m1_sq) * (s2 + m2_sq - m3_sq) + two * s2 * (m1_sq + m2_sq - s1)) / &
          sqrt (lambda (s, s2, m1_sq) * lambda (s2, m2_sq, m3_sq))
     v3_unit%p = [zero, zero, one]
     p_rest(1)%p(0) = E1
     p_rest(1)%p(1:3) = v3_unit%p * pr1
     p_rest(2)%p(0) = E2
     p_rest(2)%p(1:3) = v3_unit%p * pr2
     p_rest(3)%p(0) = E3
     p_rest(3)%p(1:3) = v3_unit%p * pr3
     p_rest(4)%p(0) = (s + s2 - m1_sq) / (2 * sqrt (s2))
     p_rest(4)%p(1:3) = - p_rest(1)%p(1:3)
     rot = rotation (cos_theta_12, sqrt (one - cos_theta_12**2), 2)
     p_rest(2) = rot * p_rest(2)
     p_rest(3)%p(1:3) = - p_rest(2)%p(1:3)
   end function create_three_particle_decay
 
 @ %def create_three_particle_decay
 @
 <<Lorentz: public>>=
   public :: evaluate_one_to_two_splitting_special
 <<Lorentz: interfaces>>=
   abstract interface
      subroutine evaluate_one_to_two_splitting_special (p_origin, &
           p1_in, p2_in, p1_out, p2_out, msq_in, jac)
        import
        type(vector4_t), intent(in) :: p_origin
        type(vector4_t), intent(in) :: p1_in, p2_in
        type(vector4_t), intent(inout) :: p1_out, p2_out
        real(default), intent(in), optional :: msq_in
        real(default), intent(inout), optional :: jac
      end subroutine evaluate_one_to_two_splitting_special
   end interface
 
 @ %def evaluate_one_to_two_splitting_special
 @
 <<Lorentz: public>>=
   public :: generate_on_shell_decay
 <<Lorentz: sub interfaces>>=
     recursive module subroutine generate_on_shell_decay (p_dec, &
         p_in, p_out, i_real, msq_in, jac, evaluate_special)
       type(vector4_t), intent(in) :: p_dec
       type(vector4_t), intent(in), dimension(:) :: p_in
       type(vector4_t), intent(inout), dimension(:) :: p_out
       integer, intent(in) :: i_real
       real(default), intent(in), optional :: msq_in
       real(default), intent(inout), optional :: jac
       procedure(evaluate_one_to_two_splitting_special), intent(in), &
             pointer, optional :: evaluate_special
     end subroutine generate_on_shell_decay
 <<Lorentz: procedures>>=
   recursive module subroutine generate_on_shell_decay (p_dec, &
       p_in, p_out, i_real, msq_in, jac, evaluate_special)
     type(vector4_t), intent(in) :: p_dec
     type(vector4_t), intent(in), dimension(:) :: p_in
     type(vector4_t), intent(inout), dimension(:) :: p_out
     integer, intent(in) :: i_real
     real(default), intent(in), optional :: msq_in
     real(default), intent(inout), optional :: jac
     procedure(evaluate_one_to_two_splitting_special), intent(in), &
           pointer, optional :: evaluate_special
     type(vector4_t) :: p_dec_new
     integer :: n_recoil
     n_recoil = size (p_in) - 1
     if (n_recoil > 1) then
        if (present (evaluate_special)) then
           call evaluate_special (p_dec, p_in(1), sum (p_in (2 : n_recoil + 1)), &
                p_out(i_real), p_dec_new)
           call generate_on_shell_decay (p_dec_new, p_in (2 : ), p_out, &
                i_real + 1, msq_in, jac, evaluate_special)
        else
           call evaluate_one_to_two_splitting (p_dec, p_in(1), &
                sum (p_in (2 : n_recoil + 1)), p_out(i_real), p_dec_new, msq_in, jac)
           call generate_on_shell_decay (p_dec_new, p_in (2 : ), p_out, &
                i_real + 1, msq_in, jac)
        end if
     else
        call evaluate_one_to_two_splitting (p_dec, p_in(1), p_in(2), &
             p_out(i_real), p_out(i_real + 1), msq_in, jac)
     end if
 
   end subroutine generate_on_shell_decay
 
   subroutine evaluate_one_to_two_splitting (p_origin, &
       p1_in, p2_in, p1_out, p2_out, msq_in, jac)
     type(vector4_t), intent(in) :: p_origin
     type(vector4_t), intent(in) :: p1_in, p2_in
     type(vector4_t), intent(inout) :: p1_out, p2_out
     real(default), intent(in), optional :: msq_in
     real(default), intent(inout), optional :: jac
     type(lorentz_transformation_t) :: L
     type(vector4_t) :: p1_rest, p2_rest
     real(default) :: m, msq, msq1, msq2
     real(default) :: E1, E2, p
     real(default) :: lda, rlda_soft
 
     call get_rest_frame (p1_in, p2_in, p1_rest, p2_rest)
 
     msq = p_origin**2; m = sqrt(msq)
     msq1 = p1_in**2; msq2 = p2_in**2
 
     lda = lambda (msq, msq1, msq2)
     if (lda < zero) then
        print *, 'Encountered lambda < 0 in 1 -> 2 splitting! '
        print *, 'lda: ', lda
        print *, 'm: ', m, 'msq: ', msq
        print *, 'm1: ', sqrt (msq1), 'msq1: ', msq1
        print *, 'm2: ', sqrt (msq2), 'msq2: ', msq2
        stop
     end if
     p = sqrt (lda) / (two * m)
 
     E1 = sqrt (msq1 + p**2)
     E2 = sqrt (msq2 + p**2)
 
     p1_out = shift_momentum (p1_rest, E1, p)
     p2_out = shift_momentum (p2_rest, E2, p)
 
     L = boost (p_origin, p_origin**1)
     p1_out = L  * p1_out
     p2_out = L  * p2_out
 
     if (present (jac) .and. present (msq_in)) then
        jac = jac * sqrt(lda) / msq
        rlda_soft = sqrt (lambda (msq_in, msq1, msq2))
        !!! We have to undo the Jacobian which has already been
        !!! supplied by the Born phase space.
        jac = jac * msq_in / rlda_soft
     end if
 
   contains
 
    subroutine get_rest_frame (p1_in, p2_in, p1_out, p2_out)
      type(vector4_t), intent(in) :: p1_in, p2_in
      type(vector4_t), intent(out) :: p1_out, p2_out
      type(lorentz_transformation_t) :: L
      L = inverse (boost (p1_in + p2_in, (p1_in + p2_in)**1))
      p1_out = L * p1_in; p2_out = L * p2_in
    end subroutine get_rest_frame
 
    function shift_momentum (p_in, E, p) result (p_out)
      type(vector4_t) :: p_out
      type(vector4_t), intent(in) :: p_in
      real(default), intent(in) :: E, p
      type(vector3_t) :: vec
      vec%p(1:3) = p_in%p(1:3) / space_part_norm (p_in)
      p_out = vector4_moving (E, p * vec)
    end function shift_momentum
 
   end subroutine evaluate_one_to_two_splitting
 
 @ %def generate_on_shell_decay
 @
 \subsection{Boosts}
 We build Lorentz transformations from boosts and rotations.  In both
 cases we can supply a three-vector which defines the axis and (hyperbolic)
 angle.  For a boost, this is the vector $\vec\beta=\vec p/E$,
 such that a particle at rest with mass $m$ is boosted to a particle
 with three-vector $\vec p$.  Here, we have
 \begin{equation}
   \beta = \tanh\chi = p/E, \qquad
   \gamma = \cosh\chi = E/m, \qquad
   \beta\gamma = \sinh\chi = p/m
 \end{equation}
 <<Lorentz: public functions>>=
   public :: boost
 <<Lorentz: interfaces>>=
   interface boost
      module procedure boost_from_rest_frame
      module procedure boost_from_rest_frame_vector3
      module procedure boost_generic
      module procedure boost_canonical
   end interface
 @ %def boost
 @ In the first form, the argument is some four-momentum, the space
 part of which determines a direction, and the associated mass (which
 is not checked against the four-momentum).  The boost vector
 $\gamma\vec\beta$ is then given by $\vec p/m$.  This boosts from the
 rest frame of a particle to the current frame.  To be explicit, if
 $\vec p$ is the momentum of a particle and $m$ its mass, $L(\vec p/m)$
 is the transformation that turns $(m;\vec 0)$ into $(E;\vec p)$.
 Conversely, the inverse transformation boosts a vector \emph{into} the
 rest frame of a particle, in particular $(E;\vec p)$ into $(m;\vec
 0)$.
 <<Lorentz: sub interfaces>>=
     elemental module function boost_from_rest_frame (p, m) result (L)
       type(lorentz_transformation_t) :: L
       type(vector4_t), intent(in) :: p
       real(default), intent(in) :: m
     end function boost_from_rest_frame
     elemental module function boost_from_rest_frame_vector3 (p, m) result (L)
       type(lorentz_transformation_t) :: L
       type(vector3_t), intent(in) :: p
       real(default), intent(in) :: m
     end function boost_from_rest_frame_vector3
 <<Lorentz: procedures>>=
   elemental module function boost_from_rest_frame (p, m) result (L)
     type(lorentz_transformation_t) :: L
     type(vector4_t), intent(in) :: p
     real(default), intent(in) :: m
     L = boost_from_rest_frame_vector3 (space_part (p), m)
   end function boost_from_rest_frame
   elemental module function boost_from_rest_frame_vector3 (p, m) result (L)
     type(lorentz_transformation_t) :: L
     type(vector3_t), intent(in) :: p
     real(default), intent(in) :: m
     type(vector3_t) :: beta_gamma
     real(default) :: bg2, g, c
     integer :: i,j
     if (m > eps0) then
        beta_gamma = p / m
        bg2 = beta_gamma**2
     else
        bg2 = 0
        L = identity
        return
     end if
     if (bg2 > eps0) then
        g = sqrt(1 + bg2);  c = (g-1)/bg2
     else
        g = one + bg2 / two
        c = one / two
     end if
     L%L(0,0)  = g
     L%L(0,1:) = beta_gamma%p
     L%L(1:,0) = L%L(0,1:)
     do i=1,3
        do j=1,3
           L%L(i,j) = delta_three(i,j) + c*beta_gamma%p(i)*beta_gamma%p(j)
        end do
     end do
   end function boost_from_rest_frame_vector3
 @ %def boost_from_rest_frame
 @ A canonical boost is a boost along one of the coordinate axes, which
 we may supply as an integer argument.  Here, $\gamma\beta$ is scalar.
 <<Lorentz: sub interfaces>>=
     elemental module function boost_canonical (beta_gamma, k) result (L)
       type(lorentz_transformation_t) :: L
       real(default), intent(in) :: beta_gamma
       integer, intent(in) :: k
     end function boost_canonical
 <<Lorentz: procedures>>=
   elemental module function boost_canonical (beta_gamma, k) result (L)
     type(lorentz_transformation_t) :: L
     real(default), intent(in) :: beta_gamma
     integer, intent(in) :: k
     real(default) :: g
     g = sqrt(1 + beta_gamma**2)
     L = identity
     L%L(0,0) = g
     L%L(0,k) = beta_gamma
     L%L(k,0) = L%L(0,k)
     L%L(k,k) = L%L(0,0)
   end function boost_canonical
 @ %def boost_canonical
 @ Instead of a canonical axis, we can supply an arbitrary axis which
 need not be normalized.  If it is zero, return the unit matrix.
 <<Lorentz: sub interfaces>>=
     elemental module function boost_generic (beta_gamma, axis) result (L)
       type(lorentz_transformation_t) :: L
       real(default), intent(in) :: beta_gamma
       type(vector3_t), intent(in) :: axis
     end function boost_generic
 <<Lorentz: procedures>>=
   elemental module function boost_generic (beta_gamma, axis) result (L)
     type(lorentz_transformation_t) :: L
     real(default), intent(in) :: beta_gamma
     type(vector3_t), intent(in) :: axis
     if (any (abs (axis%p) > 0)) then
        L = boost_from_rest_frame_vector3 (beta_gamma * axis, axis**1)
     else
        L = identity
     end if
   end function boost_generic
 
 @ %def boost_generic
 @
 \subsection{Rotations}
 For a rotation, the vector defines the rotation axis, and its length
 the rotation angle. All of these rotations rotate counterclockwise
 in a right-handed coordinate system.
 <<Lorentz: public functions>>=
   public :: rotation
 <<Lorentz: interfaces>>=
   interface rotation
      module procedure rotation_generic
      module procedure rotation_canonical
      module procedure rotation_generic_cs
      module procedure rotation_canonical_cs
   end interface
 @ %def rotation
 @ If $\cos\phi$ and $\sin\phi$ is already known, we do not have to
 calculate them.  Of course, the user has to ensure that
 $\cos^2\phi+\sin^2\phi=1$, and that the given axis [[n]] is normalized to
 one.  In the second form, the length of [[axis]] is the rotation
 angle.
 <<Lorentz: sub interfaces>>=
     elemental module function rotation_generic_cs (cp, sp, axis) result (R)
       type(lorentz_transformation_t) :: R
       real(default), intent(in) :: cp, sp
       type(vector3_t), intent(in) :: axis
     end function rotation_generic_cs
     elemental module function rotation_generic (axis) result (R)
       type(lorentz_transformation_t) :: R
       type(vector3_t), intent(in) :: axis
     end function rotation_generic
     elemental module function rotation_canonical_cs (cp, sp, k) result (R)
       type(lorentz_transformation_t) :: R
       real(default), intent(in) :: cp, sp
       integer, intent(in) :: k
     end function rotation_canonical_cs
     elemental module function rotation_canonical (phi, k) result (R)
       type(lorentz_transformation_t) :: R
       real(default), intent(in) :: phi
       integer, intent(in) :: k
     end function rotation_canonical
 <<Lorentz: procedures>>=
   elemental module function rotation_generic_cs (cp, sp, axis) result (R)
     type(lorentz_transformation_t) :: R
     real(default), intent(in) :: cp, sp
     type(vector3_t), intent(in) :: axis
     integer :: i,j
     R = identity
     do i=1,3
        do j=1,3
           R%L(i,j) = cp*delta_three(i,j) + (1-cp)*axis%p(i)*axis%p(j)  &
                &   - sp*dot_product(epsilon_three(i,j,:), axis%p)
        end do
     end do
   end function rotation_generic_cs
   elemental module function rotation_generic (axis) result (R)
     type(lorentz_transformation_t) :: R
     type(vector3_t), intent(in) :: axis
     real(default) :: phi
     if (any (abs(axis%p) > 0)) then
        phi = abs(axis**1)
        R = rotation_generic_cs (cos(phi), sin(phi), axis/phi)
     else
        R = identity
     end if
   end function rotation_generic
 @ %def rotation_generic_cs rotation_generic
 @ Alternatively, give just the angle and label the coordinate axis by
 an integer.
 <<Lorentz: procedures>>=
   elemental module function rotation_canonical_cs (cp, sp, k) result (R)
     type(lorentz_transformation_t) :: R
     real(default), intent(in) :: cp, sp
     integer, intent(in) :: k
     integer :: i,j
     R = identity
     do i=1,3
        do j=1,3
           R%L(i,j) = -sp*epsilon_three(i,j,k)
        end do
        R%L(i,i) = cp
     end do
     R%L(k,k) = 1
   end function rotation_canonical_cs
   elemental module function rotation_canonical (phi, k) result (R)
     type(lorentz_transformation_t) :: R
     real(default), intent(in) :: phi
     integer, intent(in) :: k
     R = rotation_canonical_cs(cos(phi), sin(phi), k)
   end function rotation_canonical
 @ %def rotation_canonical_cs rotation_canonical
 @
 This is viewed as a method for the first argument (three-vector):
 Reconstruct the rotation that rotates it into the second three-vector.
 <<Lorentz: public functions>>=
   public :: rotation_to_2nd
 <<Lorentz: interfaces>>=
   interface rotation_to_2nd
      module procedure rotation_to_2nd_generic
      module procedure rotation_to_2nd_canonical
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function rotation_to_2nd_generic (p, q) result (R)
       type(lorentz_transformation_t) :: R
       type(vector3_t), intent(in) :: p, q
     end function rotation_to_2nd_generic
     elemental module function rotation_to_2nd_canonical (k, p) result (R)
       type(lorentz_transformation_t) :: R
       integer, intent(in) :: k
       type(vector3_t), intent(in) :: p
     end function rotation_to_2nd_canonical
 <<Lorentz: procedures>>=
   elemental module function rotation_to_2nd_generic (p, q) result (R)
     type(lorentz_transformation_t) :: R
     type(vector3_t), intent(in) :: p, q
     type(vector3_t) :: a, b, ab
     real(default) :: ct, st
     if (any (abs (p%p) > 0) .and. any (abs (q%p) > 0)) then
        a = direction (p)
        b = direction (q)
        ab = cross_product(a,b)
        ct = a * b;  st = ab**1
        if (abs(st) > eps0) then
           R = rotation_generic_cs (ct, st, ab / st)
        else if (ct < 0) then
           R = space_reflection
        else
           R = identity
        end if
     else
        R = identity
     end if
   end function rotation_to_2nd_generic
 @ %def rotation_to_2nd_generic
 @
 The same for a canonical axis: The function returns the transformation that
 rotates the $k$-axis into the direction of $p$.
 <<Lorentz: procedures>>=
   elemental module function rotation_to_2nd_canonical (k, p) result (R)
     type(lorentz_transformation_t) :: R
     integer, intent(in) :: k
     type(vector3_t), intent(in) :: p
     type(vector3_t) :: b, ab
     real(default) :: ct, st
     integer :: i, j
     if (any (abs (p%p) > 0)) then
        b = direction (p)
        ab%p = 0
        do i = 1, 3
           do j = 1, 3
              ab%p(j) = ab%p(j) + b%p(i) * epsilon_three(i,j,k)
           end do
        end do
        ct = b%p(k);  st = ab**1
        if (abs(st) > eps0) then
           R = rotation_generic_cs (ct, st, ab / st)
        else if (ct < 0) then
           R = space_reflection
        else
           R = identity
        end if
     else
        R = identity
     end if
   end function rotation_to_2nd_canonical
 
 @ %def rotation_to_2nd_canonical
 @
 \subsection{Composite Lorentz transformations}
 This function returns the transformation that, given a pair of vectors
 $p_{1,2}$, (a) boosts from the rest frame of the c.m. system (with
 invariant mass $m$) into the lab frame where $p_i$ are defined, and
 (b) turns the given axis (or the canonical vectors $\pm
 e_k$) in the rest frame into the directions of $p_{1,2}$ in the lab frame.
 Note that the energy components are not used; for a
 consistent result one should have $(p_1+p_2)^2 = m^2$.
 <<Lorentz: public functions>>=
   public :: transformation
 <<Lorentz: interfaces>>=
   interface transformation
      module procedure transformation_rec_generic
      module procedure transformation_rec_canonical
   end interface
 @ %def transformation
 <<Lorentz: sub interfaces>>=
     elemental module function transformation_rec_generic (axis, p1, p2, m) result (L)
       type(vector3_t), intent(in) :: axis
       type(vector4_t), intent(in) :: p1, p2
       real(default), intent(in) :: m
       type(lorentz_transformation_t) :: L
     end function transformation_rec_generic
     elemental module function transformation_rec_canonical (k, p1, p2, m) result (L)
       integer, intent(in) :: k
       type(vector4_t), intent(in) :: p1, p2
       real(default), intent(in) :: m
       type(lorentz_transformation_t) :: L
     end function transformation_rec_canonical
 <<Lorentz: procedures>>=
   elemental module function transformation_rec_generic (axis, p1, p2, m) result (L)
     type(vector3_t), intent(in) :: axis
     type(vector4_t), intent(in) :: p1, p2
     real(default), intent(in) :: m
     type(lorentz_transformation_t) :: L
     L = boost (p1 + p2, m)
     L = L * rotation_to_2nd (axis, space_part (inverse (L) * p1))
   end function transformation_rec_generic
   elemental module function transformation_rec_canonical (k, p1, p2, m) result (L)
     integer, intent(in) :: k
     type(vector4_t), intent(in) :: p1, p2
     real(default), intent(in) :: m
     type(lorentz_transformation_t) :: L
     L = boost (p1 + p2, m)
     L = L * rotation_to_2nd (k, space_part (inverse (L) * p1))
   end function transformation_rec_canonical
 @ %def transformation_rec_generic transformation_rec_canonical
 @
 \subsection{Applying Lorentz transformations}
 Multiplying vectors and Lorentz transformations is straightforward.
 <<Lorentz: interfaces>>=
   interface operator(*)
      module procedure prod_LT_vector4
      module procedure prod_LT_LT
      module procedure prod_vector4_LT
   end interface
 <<Lorentz: sub interfaces>>=
     elemental module function prod_LT_vector4 (L, p) result (np)
       type(vector4_t) :: np
       type(lorentz_transformation_t), intent(in) :: L
       type(vector4_t), intent(in) :: p
     end function prod_LT_vector4
     elemental module function prod_LT_LT (L1, L2) result (NL)
       type(lorentz_transformation_t) :: NL
       type(lorentz_transformation_t), intent(in) :: L1,L2
     end function prod_LT_LT
     elemental module function prod_vector4_LT (p, L) result (np)
       type(vector4_t) :: np
       type(vector4_t), intent(in) :: p
       type(lorentz_transformation_t), intent(in) :: L
     end function prod_vector4_LT
 <<Lorentz: procedures>>=
   elemental module function prod_LT_vector4 (L, p) result (np)
     type(vector4_t) :: np
     type(lorentz_transformation_t), intent(in) :: L
     type(vector4_t), intent(in) :: p
     np%p = matmul (L%L, p%p)
   end function prod_LT_vector4
   elemental module function prod_LT_LT (L1, L2) result (NL)
     type(lorentz_transformation_t) :: NL
     type(lorentz_transformation_t), intent(in) :: L1,L2
     NL%L = matmul (L1%L, L2%L)
   end function prod_LT_LT
   elemental module function prod_vector4_LT (p, L) result (np)
     type(vector4_t) :: np
     type(vector4_t), intent(in) :: p
     type(lorentz_transformation_t), intent(in) :: L
     np%p = matmul (p%p, L%L)
   end function prod_vector4_LT
 
 @ %def *
 @
 \subsection{Special Lorentz transformations}
 These routines have their application in the generation and extraction
 of angles in the phase-space sampling routine.  Since this part of the
 program is time-critical, we calculate the composition of
 transformations directly instead of multiplying rotations and boosts.
 
 This Lorentz transformation is the composition of a rotation by $\phi$
 around the $3$ axis, a rotation by $\theta$ around the $2$ axis, and a
 boost along the $3$ axis:
 \begin{equation}
   L = B_3(\beta\gamma)\,R_2(\theta)\,R_3(\phi)
 \end{equation}
 Instead of the angles we provide sine and cosine.
 <<Lorentz: public functions>>=
   public :: LT_compose_r3_r2_b3
 <<Lorentz: sub interfaces>>=
     elemental module function LT_compose_r3_r2_b3 &
          (cp, sp, ct, st, beta_gamma) result (L)
       type(lorentz_transformation_t) :: L
       real(default), intent(in) :: cp, sp, ct, st, beta_gamma
     end function LT_compose_r3_r2_b3
 <<Lorentz: procedures>>=
   elemental module function LT_compose_r3_r2_b3 &
        (cp, sp, ct, st, beta_gamma) result (L)
     type(lorentz_transformation_t) :: L
     real(default), intent(in) :: cp, sp, ct, st, beta_gamma
     real(default) :: gamma
     if (abs(beta_gamma) < eps0) then
        L%L(0,0)  = 1
        L%L(1:,0) = 0
        L%L(0,1:) = 0
        L%L(1,1:) = [  ct*cp, -ct*sp, st ]
        L%L(2,1:) = [     sp,     cp,  zero ]
        L%L(3,1:) = [ -st*cp,  st*sp, ct ]
     else
        gamma = sqrt(1 + beta_gamma**2)
        L%L(0,0)  = gamma
        L%L(1,0)  = 0
        L%L(2,0)  = 0
        L%L(3,0)  = beta_gamma
        L%L(0,1:) = beta_gamma * [ -st*cp,  st*sp, ct ]
        L%L(1,1:) =              [  ct*cp, -ct*sp, st ]
        L%L(2,1:) =              [     sp,     cp, zero ]
        L%L(3,1:) = gamma      * [ -st*cp,  st*sp, ct ]
     end if
   end function LT_compose_r3_r2_b3
 
 @ %def LT_compose_r3_r2_b3
 @ Different ordering:
 \begin{equation}
   L = B_3(\beta\gamma)\,R_3(\phi)\,R_2(\theta)
 \end{equation}
 <<Lorentz: public functions>>=
   public :: LT_compose_r2_r3_b3
 <<Lorentz: sub interfaces>>=
     elemental module function LT_compose_r2_r3_b3 &
          (ct, st, cp, sp, beta_gamma) result (L)
       type(lorentz_transformation_t) :: L
       real(default), intent(in) :: ct, st, cp, sp, beta_gamma
     end function LT_compose_r2_r3_b3
 <<Lorentz: procedures>>=
   elemental module function LT_compose_r2_r3_b3 &
        (ct, st, cp, sp, beta_gamma) result (L)
     type(lorentz_transformation_t) :: L
     real(default), intent(in) :: ct, st, cp, sp, beta_gamma
     real(default) :: gamma
     if (abs(beta_gamma) < eps0) then
        L%L(0,0)  = 1
        L%L(1:,0) = 0
        L%L(0,1:) = 0
        L%L(1,1:) = [  ct*cp,    -sp,     st*cp ]
        L%L(2,1:) = [  ct*sp,     cp,     st*sp ]
        L%L(3,1:) = [ -st   ,   zero,     ct    ]
     else
        gamma = sqrt(1 + beta_gamma**2)
        L%L(0,0)  = gamma
        L%L(1,0)  = 0
        L%L(2,0)  = 0
        L%L(3,0)  = beta_gamma
        L%L(0,1:) = beta_gamma * [ -st   ,   zero,     ct    ]
        L%L(1,1:) =              [  ct*cp,    -sp,     st*cp ]
        L%L(2,1:) =              [  ct*sp,     cp,     st*sp ]
        L%L(3,1:) = gamma      * [ -st   ,   zero,     ct    ]
     end if
   end function LT_compose_r2_r3_b3
 
 @ %def LT_compose_r2_r3_b3
 @ This function returns the previous Lorentz transformation applied to
 an arbitrary four-momentum and extracts the space part of the result:
 \begin{equation}
   \vec n = [B_3(\beta\gamma)\,R_2(\theta)\,R_3(\phi)\,p]_{\rm space\ part}
 \end{equation}
 The second variant applies if there is no rotation
 <<Lorentz: public functions>>=
   public :: axis_from_p_r3_r2_b3, axis_from_p_b3
 <<Lorentz: sub interfaces>>=
     elemental module function axis_from_p_r3_r2_b3 &
          (p, cp, sp, ct, st, beta_gamma) result (n)
       type(vector3_t) :: n
       type(vector4_t), intent(in) :: p
       real(default), intent(in) :: cp, sp, ct, st, beta_gamma
     end function axis_from_p_r3_r2_b3
     elemental module function axis_from_p_b3 (p, beta_gamma) result (n)
       type(vector3_t) :: n
       type(vector4_t), intent(in) :: p
       real(default), intent(in) :: beta_gamma
     end function axis_from_p_b3
 <<Lorentz: procedures>>=
   elemental module function axis_from_p_r3_r2_b3 &
        (p, cp, sp, ct, st, beta_gamma) result (n)
     type(vector3_t) :: n
     type(vector4_t), intent(in) :: p
     real(default), intent(in) :: cp, sp, ct, st, beta_gamma
     real(default) :: gamma, px, py
     px = cp * p%p(1) - sp * p%p(2)
     py = sp * p%p(1) + cp * p%p(2)
     n%p(1) =  ct * px + st * p%p(3)
     n%p(2) = py
     n%p(3) = -st * px + ct * p%p(3)
     if (abs(beta_gamma) > eps0) then
        gamma = sqrt(1 + beta_gamma**2)
        n%p(3) = n%p(3) * gamma + p%p(0) * beta_gamma
     end if
   end function axis_from_p_r3_r2_b3
 
   elemental module function axis_from_p_b3 (p, beta_gamma) result (n)
     type(vector3_t) :: n
     type(vector4_t), intent(in) :: p
     real(default), intent(in) :: beta_gamma
     real(default) :: gamma
     n%p = p%p(1:3)
     if (abs(beta_gamma) > eps0) then
        gamma = sqrt(1 + beta_gamma**2)
        n%p(3) = n%p(3) * gamma + p%p(0) * beta_gamma
     end if
   end function axis_from_p_b3
 
 @ %def axis_from_p_r3_r2_b3 axis_from_p_b3
 @
 \subsection{Special functions}
 The K\"all\'en function, mostly used for the phase space.
 This is equivalent to $\lambda(x,y,z)=x^2+y^2+z^2-2xy-2xz-2yz$.
 <<Lorentz: public functions>>=
   public :: lambda
 <<Lorentz: sub interfaces>>=
     elemental module function lambda (m1sq, m2sq, m3sq)
       real(default) :: lambda
       real(default), intent(in) :: m1sq, m2sq, m3sq
     end function lambda
 <<Lorentz: procedures>>=
   elemental module function lambda (m1sq, m2sq, m3sq)
     real(default) :: lambda
     real(default), intent(in) :: m1sq, m2sq, m3sq
     lambda = (m1sq - m2sq - m3sq)**2 - 4*m2sq*m3sq
   end function lambda
 
 @ %def lambda
 @ Return a pair of head-to-head colliding momenta, given the collider
 energy, particle masses, and optionally the momentum of the
 c.m. system.
 <<Lorentz: public functions>>=
   public :: colliding_momenta
 <<Lorentz: sub interfaces>>=
     module function colliding_momenta (sqrts, m, p_cm) result (p)
       type(vector4_t), dimension(2) :: p
       real(default), intent(in) :: sqrts
       real(default), dimension(2), intent(in), optional :: m
       real(default), intent(in), optional :: p_cm
     end function colliding_momenta
 <<Lorentz: procedures>>=
   module function colliding_momenta (sqrts, m, p_cm) result (p)
     type(vector4_t), dimension(2) :: p
     real(default), intent(in) :: sqrts
     real(default), dimension(2), intent(in), optional :: m
     real(default), intent(in), optional :: p_cm
     real(default), dimension(2) :: dmsq
     real(default) :: ch, sh
     real(default), dimension(2) :: E0, p0
     integer, dimension(2), parameter :: sgn = [1, -1]
     if (abs(sqrts) < eps0) then
        call msg_fatal (" Colliding beams: sqrts is zero (please set sqrts)")
        p = vector4_null;  return
     else if (sqrts <= 0) then
        call msg_fatal (" Colliding beams: sqrts is negative")
        p = vector4_null;  return
     end if
     if (present (m)) then
        dmsq = sgn * (m(1)**2-m(2)**2)
        E0 = (sqrts + dmsq/sqrts) / 2
        if (any (E0 < m)) then
           call msg_fatal &
                (" Colliding beams: beam energy is less than particle mass")
           p = vector4_null;  return
        end if
        p0 = sgn * sqrt (E0**2 - m**2)
     else
        E0 = sqrts / 2
        p0 = sgn * E0
     end if
     if (present (p_cm)) then
        sh = p_cm / sqrts
        ch = sqrt (1 + sh**2)
        p = vector4_moving (E0 * ch + p0 * sh, E0 * sh + p0 * ch, 3)
     else
        p = vector4_moving (E0, p0, 3)
     end if
   end function colliding_momenta
 
 @ %def colliding_momenta
 @ This subroutine is for the purpose of numerical checks and
 comparisons.  The idea is to set a number to zero if it is numerically
 equivalent with zero.  The equivalence is established by comparing
 with a [[tolerance]] argument.  We implement this for vectors and
 transformations.
 <<Lorentz: public functions>>=
   public :: pacify
 <<Lorentz: interfaces>>=
   interface pacify
      module procedure pacify_vector3
      module procedure pacify_vector4
      module procedure pacify_LT
   end interface pacify
 
 <<Lorentz: sub interfaces>>=
     elemental module subroutine pacify_vector3 (p, tolerance)
       type(vector3_t), intent(inout) :: p
       real(default), intent(in) :: tolerance
     end subroutine pacify_vector3
     elemental module subroutine pacify_vector4 (p, tolerance)
       type(vector4_t), intent(inout) :: p
       real(default), intent(in) :: tolerance
     end subroutine pacify_vector4
     elemental module subroutine pacify_LT (LT, tolerance)
       type(lorentz_transformation_t), intent(inout) :: LT
       real(default), intent(in) :: tolerance
     end subroutine pacify_LT
 <<Lorentz: procedures>>=
   elemental module subroutine pacify_vector3 (p, tolerance)
     type(vector3_t), intent(inout) :: p
     real(default), intent(in) :: tolerance
     where (abs (p%p) < tolerance)  p%p = zero
   end subroutine pacify_vector3
 
   elemental module subroutine pacify_vector4 (p, tolerance)
     type(vector4_t), intent(inout) :: p
     real(default), intent(in) :: tolerance
     where (abs (p%p) < tolerance)  p%p = zero
   end subroutine pacify_vector4
 
   elemental module subroutine pacify_LT (LT, tolerance)
     type(lorentz_transformation_t), intent(inout) :: LT
     real(default), intent(in) :: tolerance
     where (abs (LT%L) < tolerance)  LT%L = zero
   end subroutine pacify_LT
 
 @ %def pacify
 @
 <<Lorentz: public>>=
   public :: vector_set_reshuffle
 <<Lorentz: sub interfaces>>=
     module subroutine vector_set_reshuffle (p1, list, p2)
       type(vector4_t), intent(in), dimension(:), allocatable :: p1
       integer, intent(in), dimension(:), allocatable :: list
       type(vector4_t), intent(out), dimension(:), allocatable :: p2
     end subroutine vector_set_reshuffle
 <<Lorentz: procedures>>=
   module subroutine vector_set_reshuffle (p1, list, p2)
     type(vector4_t), intent(in), dimension(:), allocatable :: p1
     integer, intent(in), dimension(:), allocatable :: list
     type(vector4_t), intent(out), dimension(:), allocatable :: p2
     integer :: n, n_p
     n_p = size (p1)
     if (size (list) /= n_p) return
     allocate (p2 (n_p))
     do n = 1, n_p
       p2(n) = p1(list(n))
     end do
   end subroutine vector_set_reshuffle
 
 @ %def vector_set_reshuffle
 @
 <<Lorentz: public>>=
   public :: vector_set_is_cms
 <<Lorentz: sub interfaces>>=
     module function vector_set_is_cms (p, n_in) result (is_cms)
       logical :: is_cms
       type(vector4_t), intent(in), dimension(:) :: p
       integer, intent(in) :: n_in
     end function vector_set_is_cms
 <<Lorentz: procedures>>=
   module function vector_set_is_cms (p, n_in) result (is_cms)
     logical :: is_cms
     type(vector4_t), intent(in), dimension(:) :: p
     integer, intent(in) :: n_in
     integer :: i
     type(vector4_t) :: p_sum
     p_sum%p = 0._default
     do i = 1, n_in
        p_sum = p_sum + p(i)
     end do
     is_cms = all (abs (p_sum%p(1:3)) < tiny_07)
   end function vector_set_is_cms
 
 @ %def vector_set_is_cms
 @
 <<Lorentz: public>>=
-  public :: vector_set_is_lab
-<<Lorentz: sub interfaces>>=
-    module function vector_set_is_lab (p, n_in) result (is_lab)
-      logical :: is_lab
-      type(vector4_t), intent(in), dimension(:) :: p
-      integer, intent(in) :: n_in
-    end function vector_set_is_lab
-<<Lorentz: procedures>>=
-  module function vector_set_is_lab (p, n_in) result (is_lab)
-    logical :: is_lab
-    type(vector4_t), intent(in), dimension(:) :: p
-    integer, intent(in) :: n_in
-    is_lab = .not. vector_set_is_cms (p, n_in)
-  end function vector_set_is_lab
-
-@ %def vector_set_is_lab
-@
-<<Lorentz: public>>=
   public :: vector4_write_set
 <<Lorentz: sub interfaces>>=
     module subroutine vector4_write_set (p, unit, show_mass, testflag, &
           check_conservation, ultra, n_in)
       type(vector4_t), intent(in), dimension(:) :: p
       integer, intent(in), optional :: unit
       logical, intent(in), optional :: show_mass
       logical, intent(in), optional :: testflag, ultra
       logical, intent(in), optional :: check_conservation
       integer, intent(in), optional :: n_in
     end subroutine vector4_write_set
 <<Lorentz: procedures>>=
   module subroutine vector4_write_set (p, unit, show_mass, testflag, &
         check_conservation, ultra, n_in)
     type(vector4_t), intent(in), dimension(:) :: p
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: show_mass
     logical, intent(in), optional :: testflag, ultra
     logical, intent(in), optional :: check_conservation
     integer, intent(in), optional :: n_in
     logical :: extreme
     integer :: i, j
     real(default), dimension(0:3) :: p_tot
     character(len=7) :: fmt
     integer :: u
     logical :: yorn, is_test
     integer :: n
     extreme = .false.; if (present (ultra))  extreme = ultra
     is_test = .false.; if (present (testflag)) is_test = testflag
     u = given_output_unit (unit);  if (u < 0)  return
     n = 2; if (present (n_in)) n = n_in
     p_tot = 0
     yorn = .false.; if (present (check_conservation)) yorn = check_conservation
     do i = 1, size (p)
       if (yorn .and. i > n) then
          forall (j=0:3) p_tot(j) = p_tot(j) - p(i)%p(j)
       else
          forall (j=0:3) p_tot(j) = p_tot(j) + p(i)%p(j)
       end if
       call vector4_write (p(i), u, show_mass=show_mass, &
            testflag=testflag, ultra=ultra)
     end do
     if (extreme) then
        call pac_fmt (fmt, FMT_19, FMT_11, testflag)
     else
        call pac_fmt (fmt, FMT_19, FMT_15, testflag)
     end if
     if (is_test)  call pacify (p_tot, 1.E-9_default)
     if (.not. is_test) then
        write (u, "(A5)") 'Total: '
        write (u, "(1x,A,1x," // fmt // ")")    "E = ", p_tot(0)
        write (u, "(1x,A,3(1x," // fmt // "))") "P = ", p_tot(1:)
     end if
   end subroutine vector4_write_set
 
 @ %def vector4_write_set
 @
 <<Lorentz: public>>=
   public :: vector4_check_momentum_conservation
 <<Lorentz: sub interfaces>>=
     module subroutine vector4_check_momentum_conservation (p, n_in, unit, &
        abs_smallness, rel_smallness, verbose)
       type(vector4_t), dimension(:), intent(in) :: p
       integer, intent(in) :: n_in
       integer, intent(in), optional :: unit
       real(default), intent(in), optional :: abs_smallness, rel_smallness
       logical, intent(in), optional :: verbose
     end subroutine vector4_check_momentum_conservation
 <<Lorentz: procedures>>=
   module subroutine vector4_check_momentum_conservation (p, n_in, unit, &
      abs_smallness, rel_smallness, verbose)
     type(vector4_t), dimension(:), intent(in) :: p
     integer, intent(in) :: n_in
     integer, intent(in), optional :: unit
     real(default), intent(in), optional :: abs_smallness, rel_smallness
     logical, intent(in), optional :: verbose
     integer :: u, i
     type(vector4_t) :: psum_in, psum_out
     logical, dimension(0:3) :: p_diff
     logical :: verb
     u = given_output_unit (unit);  if (u < 0)  return
     verb = .false.; if (present (verbose)) verb = verbose
     psum_in = vector4_null
     do i = 1, n_in
        psum_in = psum_in + p(i)
     end do
     psum_out = vector4_null
     do i = n_in + 1, size (p)
        psum_out = psum_out + p(i)
     end do
     p_diff = vanishes (psum_in%p - psum_out%p, &
          abs_smallness = abs_smallness, rel_smallness = rel_smallness)
     if (.not. all (p_diff)) then
        call msg_warning ("Momentum conservation: FAIL", unit = u)
        if (verb) then
           write (u, "(A)") "Incoming:"
           call vector4_write (psum_in, u)
           write (u, "(A)") "Outgoing:"
           call vector4_write (psum_out, u)
        end if
     else
        if (verb) then
           write (u, "(A)") "Momentum conservation: CHECK"
        end if
     end if
   end subroutine vector4_check_momentum_conservation
 
 @ %def vector4_check_momentum_conservation
 @ This computes the quantities
 \begin{align*}
   \langle ij \rangle &= \sqrt{|S_{ij}|} e^{i\phi_{ij}},
   [ij] &= \sqrt{|S_{ij}|} e^{\i\tilde{\phi}_{ij}},
 \end{align*}
 with $S_{ij} = \left(p_i + p_j\right)^2$. The phase space factor
 $\phi_{ij}$ is determined by
 \begin{align*}
   \cos\phi_{ij} &= \frac{p_i^1p_j^+ - p_j^1p_i^+}{\sqrt{p_i^+p_j^+S_{ij}}},
   \sin\phi_{ij} &= \frac{p_i^2p_j^+ - p_j^2p_i^+}{\sqrt{p_i^+p_j^+S_{ij}}}.
 \end{align*}
 After $\langle ij \rangle$ has been computed according to these
 formulae, $[ij]$ can be obtained by using the relation $S_{ij} =
 \langle ij \rangle [ji]$ and taking into account that $[ij] =
 -[ji]$. Thus, a minus-sign has to be applied.
 <<Lorentz: public>>=
   public :: spinor_product
 <<Lorentz: sub interfaces>>=
     module subroutine spinor_product (p1, p2, prod1, prod2)
       type(vector4_t), intent(in) :: p1, p2
       complex(default), intent(out) :: prod1, prod2
     end subroutine spinor_product
 <<Lorentz: procedures>>=
   module subroutine spinor_product (p1, p2, prod1, prod2)
     type(vector4_t), intent(in) :: p1, p2
     complex(default), intent(out) :: prod1, prod2
     real(default) :: sij
     complex(default) :: phase
     real(default) :: pp_1, pp_2
     pp_1 = p1%p(0) + p1%p(3)
     pp_2 = p2%p(0) + p2%p(3)
     sij = (p1+p2)**2
     phase = cmplx ((p1%p(1)*pp_2 - p2%p(1)*pp_1)/sqrt (sij*pp_1*pp_2), &
                    (p1%p(2)*pp_2 - p2%p(2)*pp_1)/sqrt (sij*pp_1*pp_2), &
                     default)
     !!! <ij>
     prod1 = sqrt (sij) * phase
     !!! [ij]
     if (abs(prod1) > 0) then
        prod2 = - sij / prod1
     else
        prod2 = 0
     end if
   end subroutine spinor_product
 
 @ %def spinor_product
+\subsection{Unit tests}
+Test module, followed by the corresponding implementation module.
+<<[[lorentz_ut.f90]]>>=
+<<File header>>
+
+module lorentz_ut
+  use unit_tests
+  use lorentz_uti
+
+<<Standard module head>>
+
+<<Lorentz: public test>>
+
+contains
+
+<<Lorentz: test driver>>
+
+end module lorentz_ut
+@ %def lorentz_ut
+@
+<<[[lorentz_uti.f90]]>>=
+<<File header>>
+
+module lorentz_uti
+
+<<Use kinds>>
+  use constants, only: zero, Pi
+  use format_defs, only: FMT_12  
+  use lorentz
+
+<<Standard module head>>
+
+<<Lorentz: test declarations>>
+
+contains
+
+<<Lorentz: tests>>
+
+end module lorentz_uti
+@ %def lorentz_ut
+@ API: driver for the unit tests below.
+<<Lorentz: public test>>=
+  public :: lorentz_test
+<<Lorentz: test driver>>=
+  subroutine lorentz_test (u, results)
+    integer, intent(in) :: u
+    type(test_results_t), intent(inout) :: results
+  <<Lorentz: execute tests>>
+  end subroutine lorentz_test
+
+@ %def lorentz_test
+@
+\subsubsection{Algebra with 3-vectors}
+<<Lorentz: execute tests>>=
+  call test (lorentz_1, "lorentz_1", &
+       "Test 3-vector functionality", &
+       u, results)
+<<Lorentz: test declarations>>=
+  public :: lorentz_1
+<<Lorentz: tests>>=
+  subroutine lorentz_1 (u)
+    integer, intent(in) :: u
+    type(vector3_t) :: v3_1, v3_2
+
+    write (u, "(A)")  "* Test output: lorentz_1"
+    write (u, "(A)")  "*   Purpose: testing vector3_t"
+    write (u, "(A)")
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Null 3-vector"
+    write (u, "(A)")
+    call vector3_write (vector3_null, u, testflag = .true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Canonical 3-vector"
+    write (u, "(A)")
+    call vector3_write (vector3_canonical (1), u, testflag = .true.)
+    call vector3_write (vector3_canonical (2), u, testflag = .true.)
+    call vector3_write (vector3_canonical (3), u, testflag = .true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Canonical moving 3-vector"
+    write (u, "(A)")
+    call vector3_write (vector3_moving (42._default, 1), u, testflag = .true.)
+    call vector3_write (vector3_moving (42._default, 2), u, testflag = .true.)
+    call vector3_write (vector3_moving (42._default, 3), u, testflag = .true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Generic moving 3-vector"
+    write (u, "(A)")
+    call vector3_write (vector3_moving ([3._default, 4._default, 5._default]), &
+         u, testflag = .true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Simple algebra with 3-vectors"
+    write (u, "(A)")
+    v3_1 = vector3_moving ([3._default, 4._default, 5._default])
+    v3_2 = vector3_moving ([-2._default, 5._default, -1._default])
+    write (u, "(1x,A)")  "v3_1:"
+    call vector3_write (v3_1, u, testflag=.true.)
+    write (u, "(1x,A)")  "v3_2:"
+    call vector3_write (v3_2, u, testflag=.true.)
+    write (u, "(1x,A)")  "-v3_1:"
+    call vector3_write (-v3_1, u, testflag=.true.)
+    write (u, "(1x,A)")  "v3_1 / |v3_1|:"
+    call vector3_write (direction (v3_1), u, testflag=.true.)
+    write (u, "(1x,A," // FMT_12 // ")")  "v3_1(x): ", vector3_get_component (v3_1, 1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v3_1(y): ", vector3_get_component (v3_1, 2)
+    write (u, "(1x,A," // FMT_12 // ")")  "v3_1(z): ", vector3_get_component (v3_1, 3)
+    write (u, "(1x,A)")  "v3_1 + v3_2:"
+    call vector3_write (v3_1 + v3_2, u, testflag=.true.)
+    write (u, "(1x,A)")  "v3_1 - v3_2:"
+    call vector3_write (v3_1 - v3_2, u, testflag=.true.)
+    write (u, "(1x,A,L1)")  "v3_1 == v3_2: ", v3_1 == v3_2
+    write (u, "(1x,A,L1)")  "v3_1 /= v3_2: ", v3_1 /= v3_2
+    write (u, "(1x,A)")  "2 * v3_1:"
+    call vector3_write (2._default * v3_1, u, testflag=.true.)
+    write (u, "(1x,A)")  "v3_2 / 4:"
+    call vector3_write (v3_2 / 4, u, testflag=.true.)
+    write (u, "(1x,A," // FMT_12 // ")")  "v3_1, azimuth (radians):", azimuthal_angle (v3_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v3_1, azimuth (degrees):", &
+         azimuthal_angle_deg (v3_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v3_1, polar (radians)  :", polar_angle (v3_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v3_1, polar (degrees)  :", &
+         polar_angle_deg (v3_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v3_1, cosine polar     :", &
+         polar_angle_ct (v3_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v3_1, energy w. mass=1 :", &
+         energy (v3_1, 1._default)
+    write (u, "(1x,A)")  "3-vector orthogonal to v3_1:"
+    call vector3_write (create_orthogonal (v3_1), u, testflag=.true.)
+    write (u, "(1x,A)")  "unit 3-vector from v3_1:"
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Dot and cross product"
+    write (u, "(A)")
+    write (u, "(1x,A," // FMT_12 // ")")  "v3_1 * v3_2: ", v3_1 * v3_2
+    write (u, "(1x,A," // FMT_12 // ")")  "v3_1**3    : ", v3_1**3
+    write (u, "(1x,A)")  "v3_1 x v3_2:"
+    call vector3_write (cross_product (v3_1, v3_2), u, testflag=.true.)
+    write (u, "(1x,A," // FMT_12 // ")")  "enclosed angle (radians):", &
+         enclosed_angle (v3_1, v3_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "enclosed angle (degrees):", &
+         enclosed_angle_deg (v3_1, v3_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "cosine (enclosed angle) :", &
+         enclosed_angle_ct (v3_1, v3_2)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Test output end: lorentz_1"
+
+  end subroutine lorentz_1
+
+@ %def lorentz_1
+@
+\subsubsection{Algebra with 4-vectors}
+<<Lorentz: execute tests>>=
+  call test(lorentz_2, "lorentz_2", &
+            "Test 4-vector functionality", u, results)
+<<Lorentz: test declarations>>=
+  public :: lorentz_2
+<<Lorentz: tests>>=
+  subroutine lorentz_2 (u)
+    integer, intent(in) :: u
+    type(vector3_t) :: v3_1, v3_2
+    type(vector4_t) :: v4_1, v4_2, v4_1_inv
+
+    write (u, "(A)")  "* Test output: lorentz_2"
+    write (u, "(A)")  "*   Purpose: testing vector4_t"
+    write (u, "(A)")
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Null 4-vector"
+    write (u, "(A)")
+    call vector4_write (vector4_null, u, testflag = .true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Canonical 4-vector"
+    write (u, "(A)")
+    call vector4_write (vector4_canonical (0), u, testflag = .true.)
+    call vector4_write (vector4_canonical (1), u, testflag = .true.)
+    call vector4_write (vector4_canonical (2), u, testflag = .true.)
+    call vector4_write (vector4_canonical (3), u, testflag = .true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* 4-vector at rest with mass m = 17"
+    write (u, "(A)")
+    call vector4_write (vector4_at_rest (17._default), u, testflag = .true.)
+    
+    write (u, "(A)")
+    write (u, "(A)")  "* Canonical moving 4-vector"
+    write (u, "(A)")
+    call vector4_write (vector4_moving (17._default, 42._default, 1), u, testflag = .true.)
+    call vector4_write (vector4_moving (17._default, 42._default, 2), u, testflag = .true.)
+    call vector4_write (vector4_moving (17._default, 42._default, 3), u, testflag = .true.)
+     
+    write (u, "(A)")
+    write (u, "(A)")  "* Generic moving 4-vector"
+    write (u, "(A)")
+    v3_1 = [3._default, 4._default, 5._default]
+    call vector4_write (vector4_moving (17._default, v3_1), u, testflag = .true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Simple algebra with 4-vectors"
+    write (u, "(A)")
+    v3_2 = [-2._default, 5._default, -1._default]
+    v4_1 = vector4_moving (8._default, v3_1)    
+    v4_2 = vector4_moving (zero, v3_2)
+    write (u, "(1x,A)")  "v4_1:"
+    call vector4_write (v4_1, u, testflag=.true.)
+    write (u, "(1x,A)")  "v4_2:"
+    call vector4_write (v4_2, u, testflag=.true.)
+    write (u, "(1x,A)")  "-v4_1:"
+    call vector4_write (-v4_1, u, testflag=.true.)
+    v4_1_inv = v4_1
+    call vector4_invert_direction (v4_1_inv)
+    write (u, "(1x,A)")  "v4_1, inverted direction:"
+    call vector4_write (v4_1_inv, u, testflag=.true.)
+    write (u, "(1x,A)")  "(v4_1)_spatial / |(v4_1)_spatial|:"
+    call vector3_write (direction (v4_1), u, testflag=.true.)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1(E): ", energy (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1(x): ", vector4_get_component (v4_1, 1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1(y): ", vector4_get_component (v4_1, 2)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1(z): ", vector4_get_component (v4_1, 3)
+    write (u, "(1x,A)")  "space_part (v4_1):"
+    call vector3_write (space_part (v4_1), u, testflag=.true.)
+    write (u, "(1x,A," // FMT_12 // ")")  "norm space_part (v4_1): ", &
+         space_part_norm (v4_1)
+    write (u, "(1x,A)") "unit vector from v4_1:"
+    call vector3_write (create_unit_vector (v4_1), u, testflag = .true.)
+    write (u, "(1x,A)")  "v4_1 + v4_2:"
+    call vector4_write (v4_1 + v4_2, u, testflag=.true.)
+    write (u, "(1x,A)")  "v4_1 - v4_2:"
+    call vector4_write (v4_1 - v4_2, u, testflag=.true.)
+    write (u, "(1x,A,L1)")  "v4_1 == v4_2: ", v4_1 == v4_2
+    write (u, "(1x,A,L1)")  "v4_1 /= v4_2: ", v4_1 /= v4_2
+    write (u, "(1x,A)")  "2 * v4_1:"
+    call vector4_write (2._default * v4_1, u, testflag=.true.)
+    write (u, "(1x,A)")  "v4_2 / 4:"
+    call vector4_write (v4_2 / 4, u, testflag=.true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Angles and kinematic properties of 4-vectors"
+    write (u, "(A)")
+   
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, azimuth (radians):", azimuthal_angle (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, azimuth (degrees):", &
+         azimuthal_angle_deg (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, polar (radians)  :", polar_angle (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, polar (degrees)  :", &
+         polar_angle_deg (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, cosine polar     :", &
+         polar_angle_ct (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, invariant mass   :", &
+         invariant_mass (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, invariant mass sq:", &
+         invariant_mass_squared (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_2, invariant mass   :", &
+         invariant_mass (v4_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_2, invariant mass sq:", &
+         invariant_mass_squared (v4_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, transverse mass  :", &
+         transverse_mass (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, rapidity         :", &
+         rapidity (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, pseudorapidity   :", &
+         pseudorapidity (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, pT               :", &
+         transverse_part (v4_1)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1, pL               :", &
+         longitudinal_part (v4_1)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Test output end: lorentz_2"
+
+  end subroutine lorentz_2
+
+@ %def lorentz_2
+@
+\subsubsection{Bilinear functions of 4-vectors}
+<<Lorentz: execute tests>>=
+  call test(lorentz_3, "lorentz_3", &
+            "Test 4-vector bilinear functions", u, results)
+<<Lorentz: test declarations>>=
+  public :: lorentz_3
+<<Lorentz: tests>>=
+  subroutine lorentz_3 (u)
+    integer, intent(in) :: u
+    type(vector3_t) :: v3_1, v3_2
+    type(vector4_t) :: v4_1, v4_2
+
+    write (u, "(A)")  "* Test output: lorentz_3"
+    write (u, "(A)")  "*   Purpose: testing bilinear functions of 4-vectors"
+    write (u, "(A)")
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Products and distances of 4-vectors"
+    write (u, "(A)")
+    v3_1 = [3._default, 4._default, 5._default]
+    v3_2 = [-2._default, 5._default, -1._default]
+    v4_1 = vector4_moving (8._default, v3_1)    
+    v4_2 = vector4_moving (6._default, v3_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1 * v4_2: ", v4_1 * v4_2
+    write (u, "(1x,A," // FMT_12 // ")")  "rapidity distance       :", &
+         rapidity_distance (v4_1, v4_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "pseudorapidity distance :", &
+         pseudorapidity_distance (v4_1, v4_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "eta phi distance        :", &
+         eta_phi_distance (v4_1, v4_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "enclosed angle (radians):", &
+         enclosed_angle (v4_1, v4_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "enclosed angle (degrees):", &
+         enclosed_angle_deg (v4_1, v4_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "cosine (enclosed angle) :", &
+         enclosed_angle_ct (v4_1, v4_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "rest frame theta (rad)  :", &
+         enclosed_angle_rest_frame (v4_1, v4_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "rest frame theta (deg)  :", &
+         enclosed_angle_deg_rest_frame (v4_1, v4_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "rest frame cosine(theta):", &
+         enclosed_angle_ct_rest_frame (v4_1, v4_2)
+    write (u, "(1x,A," // FMT_12 // ")")  "v4_1_T w.r.t. v4_2      :", &
+         transverse_part (v4_1, v4_2)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Test output end: lorentz_3"
+
+  end subroutine lorentz_3
+
+@ %def lorentz_3
+@
+\subsubsection{Tests for Lorentz transformations}
+<<Lorentz: execute tests>>=
+  call test(lorentz_4, "lorentz_4", &
+            "Test Lorentz transformations", u, results)
+<<Lorentz: test declarations>>=
+  public :: lorentz_4
+<<Lorentz: tests>>=
+  subroutine lorentz_4 (u)
+    integer, intent(in) :: u
+    type(vector3_t) :: v3_1, v3_2
+    type(vector4_t) :: v4
+    type(lorentz_transformation_t) :: LT
+    real(default) :: tol
+
+    write (u, "(A)")  "* Test output: lorentz_4"
+    write (u, "(A)")  "*   Purpose: testing Lorentz transformations"
+    write (u, "(A)")
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Basic Lorentz transformatios"
+    write (u, "(A)")
+    write (u, "(1x,A)")  "LT = 1:"
+    call lorentz_transformation_write (identity, u, testflag=.true.)
+    write (u, "(A)")
+    write (u, "(1x,A)")  "LT = space reflection:"
+    call lorentz_transformation_write (space_reflection, u, testflag=.true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Lorentz transformations: rotations"
+    write (u, "(A)")
+    v3_1 = [1._default, 2._default, 3._default]
+    v3_2 = [-2._default, 1._default, -5._default]
+    tol = 1.e-12_default
+    write (u, "(1x,A)")  "Rotation of Pi/4 around 1-axis, def. by cos and sin:"
+    LT = rotation (0.707107_default, 0.707107_default, 1)
+    call pacify (LT, tol)
+    call lorentz_transformation_write (LT, u, testflag=.true.)
+    write (u, "(1x,A)")  "Rotation of Pi/4 around 2-axis, def. by cos and sin:"
+    LT = rotation (0.707107_default, 0.707107_default, 2)
+    call pacify (LT, tol)
+    call lorentz_transformation_write (LT, u, testflag=.true.)
+    write (u, "(1x,A)")  "Rotation of Pi/4 around 3-axis, def. by cos and sin:"
+    LT = rotation (0.707107_default, 0.707107_default, 3)
+    call pacify (LT, tol)
+    call lorentz_transformation_write (LT, u, testflag=.true.)
+    write (u, "(1x,A)")  "Rotation of Pi/4 around 1-axis, def. by angle:"
+    LT = rotation (Pi/4._default, 1)
+    call pacify (LT, tol)
+    call lorentz_transformation_write (LT, u, testflag=.true.)
+    write (u, "(1x,A)")  "Rotation of Pi/4 around 2-axis, def. by angle:"
+    LT = rotation (Pi/4._default, 2)
+    call pacify (LT, tol)
+    call lorentz_transformation_write (LT, u, testflag=.true.)
+    write (u, "(1x,A)")  "Rotation of Pi/4 around 3-axis, def. by angle:"
+    LT = rotation (Pi/4._default, 3)
+    call pacify (LT, tol)
+    call lorentz_transformation_write (LT, u, testflag=.true.)
+    write (u, "(1x,A)")  "Rotation of Pi/4 around axis = (1,2,3):"
+    call lorentz_transformation_write (rotation (0.707107_default, 0.707107_default, &
+         normalize (v3_1)), u, testflag=.true.)
+    write (u, "(1x,A)")  "Rotation in plane to axis = (1,2,3), angle given by length of axis:"
+    call lorentz_transformation_write (rotation (v3_1), u, testflag=.true.)
+    write (u, "(1x,A)")  "Rotation from v3_1=(1,2,3) to v3_2=(-2,1,-5):"
+    call lorentz_transformation_write (rotation_to_2nd (v3_1,v3_2), u, testflag=.true.)
+    write (u, "(1x,A)")  "Rotation from 1-axis to v3_2=(-2,1,-5):"
+    call lorentz_transformation_write (rotation_to_2nd (1,v3_2), u, testflag=.true.)
+    write (u, "(1x,A)")  "Rotation from 2-axis to v3_2=(-2,1,-5):"
+    call lorentz_transformation_write (rotation_to_2nd (2,v3_2), u, testflag=.true.)
+    write (u, "(1x,A)")  "Rotation from 3-axis to v3_2=(-2,1,-5):"
+    call lorentz_transformation_write (rotation_to_2nd (3,v3_2), u, testflag=.true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Lorentz transformations: boosts"
+    write (u, "(A)")
+    write (u, "(1x,A)")  "Boost from rest frame to 3-vector, mass m=10:"
+    call lorentz_transformation_write (boost (v3_1, 10._default), u, testflag=.true.)
+    write (u, "(1x,A)")  "Boost from rest frame to 4-vector, mass m=10:"
+    v4 = vector4_moving (42._default, v3_1)
+    call lorentz_transformation_write (boost (v4, 10._default), u, testflag=.true.)
+    write (u, "(1x,A)")  "Boost along 1-axis, beta*gamma = 12"
+    call lorentz_transformation_write (boost (12._default, 1), u, testflag=.true.)
+    write (u, "(1x,A)")  "Boost along 2-axis, beta*gamma = 12"
+    call lorentz_transformation_write (boost (12._default, 2), u, testflag=.true.)
+    write (u, "(1x,A)")  "Boost along 3-axis, beta*gamma = 12"
+    call lorentz_transformation_write (boost (12._default, 3), u, testflag=.true.)
+    write (u, "(1x,A)")  "Boost along axis=(1,2,3), beta*gamma = 12"
+    call lorentz_transformation_write (boost (12._default, v3_1), u, testflag=.true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Test output end: lorentz_4"
+
+  end subroutine lorentz_4
+
+@ %def lorentz_4
+@
+\subsubsection{Tests for additional kinematic functions and sets of 4-vectors}
+<<Lorentz: execute tests>>=
+  call test(lorentz_5, "lorentz_5", &
+            "Test additional kinematics", u, results)
+<<Lorentz: test declarations>>=
+  public :: lorentz_5
+<<Lorentz: tests>>=
+  subroutine lorentz_5 (u)
+    integer, intent(in) :: u
+    type(vector4_t), dimension(2) :: p
+    real(default), dimension(2) :: m
+    real(default) :: sqrts
+    type(vector4_t), dimension(8) :: tt_mom
+    type(vector4_t), dimension(:), allocatable :: tin, tout
+    integer, dimension(:), allocatable :: shuffle
+    
+    write (u, "(A)")  "* Test output: lorentz_5"
+    write (u, "(A)")  "*   Purpose: testing additional kinematics and sets of 4-vectors"
+    write (u, "(A)")
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Colliding momenta, 13 TeV, massless"
+    write (u, "(A)")
+    sqrts = 13000._default
+    p = colliding_momenta (sqrts)
+    call vector4_write (p(1), u, testflag=.true.)
+    call vector4_write (p(2), u, testflag=.true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Colliding momenta, 10 GeV, massive muons"
+    write (u, "(A)")
+    sqrts = 10._default
+    m = [0.1057_default, 0.1057_default]
+    p = colliding_momenta (sqrts, m)
+    call vector4_write (p(1), u, testflag=.true.)
+    call vector4_write (p(2), u, testflag=.true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Kinematical function lambda"
+    write (u, "(A)")
+
+    write (u, "(1x,A," // FMT_12 // ")")  "s = 172.3**2, m1 = 4.2, m2 = 80.418:", &
+         lambda (172.3_default**2, 4.2_default**2, 80.418_default**2)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Test vector_set"
+    write (u, "(A)")
+
+    tt_mom(1) = [2.5000000000000000e+02_default, zero, zero, 2.4999999999947777e+02_default]
+    tt_mom(2) = [2.5000000000000000e+02_default, zero, zero, -2.4999999999947777e+02_default]
+    tt_mom(3) = [1.1557492413664579e+02_default, 3.9011599241011098e+01_default, &
+         -6.4278142734963140e+01_default, 8.7671766153043137e+01_default]
+    tt_mom(4) = [1.4617918132729235e+02_default, -1.0947970597860679e+02_default, &
+         1.5484441802571380e+01_default, -9.5525593923398418e+01_default]
+    tt_mom(5) = [5.2637589215119526e+01_default, -4.7413198564695762e+01_default, &
+         1.0087885417286579e+01_default, 2.0516525153079229e+01_default]
+    tt_mom(6) = [5.4760292922264796e+01_default, 1.5197406985690520e+01_default, &
+         5.1527071739328015e+01_default, -1.0615525413924287e+01_default]
+    tt_mom(7) = [3.2415057664609684e+01_default, 7.5539389341684711e+00_default, &
+         -1.5935831743946720e+01_default, -2.7139737100881156e+01_default]
+    tt_mom(8) = [9.8432954734067863E+01_default, 9.5129959382432399e+01_default, &
+         3.1145755197238966e+00_default, 2.5092565132081496e+01_default]
+    write (u, "(1x,A)")  "Write routine for vector sets, maximal compression:"
+    call vector4_write_set (tt_mom, u, show_mass=.true., testflag=.true., &
+         check_conservation=.true., ultra=.true.)
+    write (u, "(1x,A,L1)")  "Vector set is CMS frame: ", vector_set_is_cms (tt_mom, 2)
+    write (u, "(1x,A)")  "Reshuffle vector set, final state inverted:"
+    allocate (tin (8))
+    tin = tt_mom
+    allocate (shuffle (8), source = [1,2,8,7,6,5,4,3])
+    call vector_set_reshuffle (tin, shuffle, tout)
+    call vector4_write_set (tout, u, show_mass=.true., testflag=.true., &
+         check_conservation=.true., ultra=.true.)
+    write (u, "(1x,A)")  "Vector set, check momentum conservation:"
+    call vector4_check_momentum_conservation (tt_mom, 2, u, &
+         abs_smallness = 1.e-12_default, verbose=.true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Test output end: lorentz_5"
+
+  end subroutine lorentz_5
+
+@ %def lorentz_5
+@
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Collections of Lorentz Vectors}
 The [[phs_point]] type is a container for an array of Lorentz vectors.  This
 allows us to transfer Lorentz-vector arrays more freely, and to collect vector
 arrays of non-uniform size.
 <<[[phs_points.f90]]>>=
 <<File header>>
 
 module phs_points
 
 <<Use kinds>>
   use lorentz, only: vector4_t
   use lorentz, only: lorentz_transformation_t
   use lorentz, only: sum
 
 <<Standard module head>>
 
 <<PHS points: public>>
 
 <<PHS points: types>>
 
 <<PHS points: interfaces>>
 
   interface
 <<PHS points: sub interfaces>>
   end interface
 
 end module phs_points
 @ %def phs_points
 @
 <<[[phs_points_sub.f90]]>>=
 <<File header>>
 
 submodule (phs_points) phs_points_s
 
   use lorentz, only: vector4_null
   use lorentz, only: vector4_write_set
   use lorentz, only: operator(==)
   use lorentz, only: operator(*)
   use lorentz, only: operator(**)
 
   implicit none
 
 contains
 
 <<PHS points: procedures>>
 
 end submodule phs_points_s
 
 @ %def phs_points_s
 @
 \subsection{PHS point definition}
 This is a trivial container for an array of momenta.  The main
 application is to store a non-uniform array of phase-space points.
 <<PHS points: public>>=
   public :: phs_point_t
 <<PHS points: types>>=
   type :: phs_point_t
      private
      type(vector4_t), dimension(:), allocatable :: p
   contains
   <<PHS points: phs point: TBP>>
   end type phs_point_t
 
 @ %def phs_point_t
 @
 \subsection{PHS point: basic tools}
 Output.  This is instrumented with options, which have to be
 provided by the caller.
 <<PHS points: phs point: TBP>>=
   procedure :: write => phs_point_write
 <<PHS points: sub interfaces>>=
     module subroutine phs_point_write (phs_point, unit, show_mass, testflag, &
         check_conservation, ultra, n_in)
       class(phs_point_t), intent(in) :: phs_point
       integer, intent(in), optional :: unit
       logical, intent(in), optional :: show_mass
       logical, intent(in), optional :: testflag, ultra
       logical, intent(in), optional :: check_conservation
       integer, intent(in), optional :: n_in
     end subroutine phs_point_write
 <<PHS points: procedures>>=
   module subroutine phs_point_write (phs_point, unit, show_mass, testflag, &
       check_conservation, ultra, n_in)
     class(phs_point_t), intent(in) :: phs_point
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: show_mass
     logical, intent(in), optional :: testflag, ultra
     logical, intent(in), optional :: check_conservation
     integer, intent(in), optional :: n_in
     if (allocated (phs_point%p)) then
        call vector4_write_set (phs_point%p, &
             unit = unit, &
             show_mass = show_mass, &
             testflag = testflag, &
             check_conservation = check_conservation, &
             ultra = ultra, &
             n_in = n_in)
     end if
   end subroutine phs_point_write
 
 @ %def phs_point_write
 @ Non-intrinsic assignment
 <<PHS points: public>>=
   public :: assignment(=)
 <<PHS points: interfaces>>=
   interface assignment(=)
      module procedure phs_point_from_n
      module procedure phs_point_from_vector4
      module procedure vector4_from_phs_point
   end interface
 @ Initialize with zero momenta but fixed size
 <<PHS points: sub interfaces>>=
     pure module subroutine phs_point_from_n (phs_point, n_particles)
       type(phs_point_t), intent(out) :: phs_point
       integer, intent(in) :: n_particles
     end subroutine phs_point_from_n
 <<PHS points: procedures>>=
   pure module subroutine phs_point_from_n (phs_point, n_particles)
     type(phs_point_t), intent(out) :: phs_point
     integer, intent(in) :: n_particles
     allocate (phs_point%p (n_particles), source = vector4_null)
   end subroutine phs_point_from_n
 
 @ %def phs_point_init_from_n
 @ Transform from/to plain vector array
 <<PHS points: sub interfaces>>=
     pure module subroutine phs_point_from_vector4 (phs_point, p)
       type(phs_point_t), intent(out) :: phs_point
       type(vector4_t), dimension(:), intent(in) :: p
     end subroutine phs_point_from_vector4
     pure module subroutine vector4_from_phs_point (p, phs_point)
       class(phs_point_t), intent(in) :: phs_point
       type(vector4_t), dimension(:), allocatable, intent(out) :: p
     end subroutine vector4_from_phs_point
 <<PHS points: procedures>>=
   pure module subroutine phs_point_from_vector4 (phs_point, p)
     type(phs_point_t), intent(out) :: phs_point
     type(vector4_t), dimension(:), intent(in) :: p
     phs_point%p = p
   end subroutine phs_point_from_vector4
 
   pure module subroutine vector4_from_phs_point (p, phs_point)
     class(phs_point_t), intent(in) :: phs_point
     type(vector4_t), dimension(:), allocatable, intent(out) :: p
     if (allocated (phs_point%p))  p = phs_point%p
   end subroutine vector4_from_phs_point
 
 @ %def phs_point_from_vector4
 @ %def vector4_from_phs_point
 @ Query the size of the momentum array (assuming it is allocated).
 <<PHS points: public>>=
   public :: size
 <<PHS points: interfaces>>=
   interface size
      module procedure phs_point_size
   end interface size
 <<PHS points: sub interfaces>>=
     pure module function phs_point_size (phs_point) result (s)
       class(phs_point_t), intent(in) :: phs_point
       integer :: s
     end function phs_point_size
 <<PHS points: procedures>>=
   pure module function phs_point_size (phs_point) result (s)
     class(phs_point_t), intent(in) :: phs_point
     integer :: s
     if (allocated (phs_point%p)) then
        s = size (phs_point%p)
     else
        s = 0
     end if
   end function phs_point_size
 
 @ %def phs_point_size
 @ Equality, implemented only for valid points.
 <<PHS points: public>>=
   public :: operator(==)
 <<PHS points: interfaces>>=
   interface operator(==)
      module procedure phs_point_eq
   end interface operator(==)
 <<PHS points: sub interfaces>>=
     elemental module function phs_point_eq &
          (phs_point_1, phs_point_2) result (flag)
       class(phs_point_t), intent(in) :: phs_point_1, phs_point_2
       logical :: flag
     end function phs_point_eq
 <<PHS points: procedures>>=
   elemental module function phs_point_eq &
        (phs_point_1, phs_point_2) result (flag)
     class(phs_point_t), intent(in) :: phs_point_1, phs_point_2
     logical :: flag
     if (allocated (phs_point_1%p) .and. (allocated (phs_point_2%p))) then
        flag = all (phs_point_1%p == phs_point_2%p)
     else
        flag = .false.
     end if
   end function phs_point_eq
 
 @ %def phs_point_eq
 @ Extract all momenta, as a method
 <<PHS points: phs point: TBP>>=
   procedure :: get => phs_point_get
 <<PHS points: sub interfaces>>=
     pure module function phs_point_get (phs_point) result (p)
       class(phs_point_t), intent(in) :: phs_point
       type(vector4_t), dimension(:), allocatable :: p
     end function phs_point_get
 <<PHS points: procedures>>=
   pure module function phs_point_get (phs_point) result (p)
     class(phs_point_t), intent(in) :: phs_point
     type(vector4_t), dimension(:), allocatable :: p
     if (allocated (phs_point%p)) then
        p = phs_point%p
     else
        allocate (p (0))
     end if
   end function phs_point_get
 
 @ %def phs_point_select
 @ Extract a subset of all momenta.
 <<PHS points: phs point: TBP>>=
   procedure :: select => phs_point_select
 <<PHS points: sub interfaces>>=
     elemental module function phs_point_select (phs_point, i) result (p)
       class(phs_point_t), intent(in) :: phs_point
       integer, intent(in) :: i
       type(vector4_t) :: p
     end function phs_point_select
 <<PHS points: procedures>>=
   elemental module function phs_point_select (phs_point, i) result (p)
     class(phs_point_t), intent(in) :: phs_point
     integer, intent(in) :: i
     type(vector4_t) :: p
     if (allocated (phs_point%p)) then
        p = phs_point%p(i)
     else
        p = vector4_null
     end if
   end function phs_point_select
 
 @ %def phs_point_select
 @ Return the invariant mass squared for a subset of momenta
 <<PHS points: phs point: TBP>>=
   procedure :: get_msq => phs_point_get_msq
 <<PHS points: sub interfaces>>=
     pure module function phs_point_get_msq (phs_point, iarray) result (msq)
       class(phs_point_t), intent(in) :: phs_point
       integer, dimension(:), intent(in) :: iarray
       real(default) :: msq
     end function phs_point_get_msq
 <<PHS points: procedures>>=
   pure module function phs_point_get_msq (phs_point, iarray) result (msq)
     class(phs_point_t), intent(in) :: phs_point
     integer, dimension(:), intent(in) :: iarray
     real(default) :: msq
     if (allocated (phs_point%p)) then
        msq = (sum (phs_point%p(iarray)))**2
     else
        msq = 0
     end if
   end function phs_point_get_msq
 
 @ %def phs_point_get_msq
 
 @
 \subsection{Lorentz algebra pieces}
 Lorentz transformation.
 <<PHS points: public>>=
   public :: operator(*)
 <<PHS points: interfaces>>=
   interface operator(*)
      module procedure prod_LT_phs_point
   end interface operator(*)
 <<PHS points: sub interfaces>>=
     elemental module function prod_LT_phs_point (L, phs_point) result (phs_point_LT)
       type(lorentz_transformation_t), intent(in) :: L
       type(phs_point_t), intent(in) :: phs_point
       type(phs_point_t) :: phs_point_LT
     end function prod_LT_phs_point
 <<PHS points: procedures>>=
   elemental module function prod_LT_phs_point (L, phs_point) result (phs_point_LT)
     type(lorentz_transformation_t), intent(in) :: L
     type(phs_point_t), intent(in) :: phs_point
     type(phs_point_t) :: phs_point_LT
     if (allocated (phs_point%p))  phs_point_LT%p = L * phs_point%p
   end function prod_LT_phs_point
 
 @ %def prod_LT_phs_point
 @ Compute momentum sum, analogous to the standard [[sum]] function
 (mask), and additionally using an index array.
 <<PHS points: public>>=
   public :: sum
 <<PHS points: interfaces>>=
   interface sum
      module procedure phs_point_sum
      module procedure phs_point_sum_iarray
   end interface sum
 <<PHS points: sub interfaces>>=
     pure module function phs_point_sum (phs_point, mask) result (p)
       class(phs_point_t), intent(in) :: phs_point
       logical, dimension(:), intent(in), optional :: mask
       type(vector4_t) :: p
     end function phs_point_sum
     pure module function phs_point_sum_iarray (phs_point, iarray) result (p)
       class(phs_point_t), intent(in) :: phs_point
       integer, dimension(:), intent(in) :: iarray
       type(vector4_t) :: p
     end function phs_point_sum_iarray
 <<PHS points: procedures>>=
   pure module function phs_point_sum (phs_point, mask) result (p)
     class(phs_point_t), intent(in) :: phs_point
     logical, dimension(:), intent(in), optional :: mask
     type(vector4_t) :: p
     if (allocated (phs_point%p)) then
-       p = sum (phs_point%p, mask)
+       if (present (mask)) then
+          p = sum (phs_point%p, mask)
+       else
+          p = sum (phs_point%p)
+       end if
     else
        p = vector4_null
     end if
   end function phs_point_sum
 
   pure module function phs_point_sum_iarray (phs_point, iarray) result (p)
     class(phs_point_t), intent(in) :: phs_point
     integer, dimension(:), intent(in) :: iarray
     type(vector4_t) :: p
     logical, dimension(:), allocatable :: mask
     integer :: i
     allocate (mask (size (phs_point)), source = .false.)
     mask(iarray) = .true.
     p = sum (phs_point, mask)
   end function phs_point_sum_iarray
 
 @ %def phs_point_sum
 @
 \subsection{Methods for specific applications}
 Convenience method: compute the pair of energy fractions w.r.t.\ the
 specified beam energy.  We assume that the momenta represent a
 scattering process (two incoming particles) in the c.m.\ frame.
 <<PHS points: phs point: TBP>>=
   procedure :: get_x => phs_point_get_x
 <<PHS points: sub interfaces>>=
     pure module function phs_point_get_x (phs_point, E_beam) result (x)
       class(phs_point_t), intent(in) :: phs_point
       real(default), dimension(2) :: x
       real(default), intent(in) :: E_beam
     end function phs_point_get_x
 <<PHS points: procedures>>=
   pure module function phs_point_get_x (phs_point, E_beam) result (x)
     class(phs_point_t), intent(in) :: phs_point
     real(default), dimension(2) :: x
     real(default), intent(in) :: E_beam
     x = phs_point%p(1:2)%p(0) / E_beam
   end function phs_point_get_x
 
 @ %def phs_point_get_x
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[phs_points_ut.f90]]>>=
 <<File header>>
 
 module phs_points_ut
   use unit_tests
   use phs_points_uti
 
 <<Standard module head>>
 
 <<PHS points: public test>>
 
 contains
 
 <<PHS points: test driver>>
 
 end module phs_points_ut
 @ %def phs_points_ut
 @
 <<[[phs_points_uti.f90]]>>=
 <<File header>>
 
 module phs_points_uti
 
 <<Use kinds>>
+  use constants, only: zero
+  use format_defs, only: FMT_12
+  use lorentz
   use phs_points
 
 <<Standard module head>>
 
 <<PHS points: test declarations>>
 
 contains
 
 <<PHS points: tests>>
 
 end module phs_points_uti
 @ %def phs_points_ut
 @ API: driver for the unit tests below.
 <<PHS points: public test>>=
   public :: phs_points_test
 <<PHS points: test driver>>=
   subroutine phs_points_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<PHS points: execute tests>>
   end subroutine phs_points_test
 
 @ %def phs_points_test
 @
-\subsubsection{Splitting functions}
+\subsubsection{PHS point unit test implementation}
 <<PHS points: execute tests>>=
   call test (phs_points_1, "phs_points_1", &
-       "Dummy test", &
+       "Test PHS point functionality", &
        u, results)
 <<PHS points: test declarations>>=
   public :: phs_points_1
 <<PHS points: tests>>=
   subroutine phs_points_1 (u)
     integer, intent(in) :: u
+    type(vector4_t), dimension(8) :: tt_mom
+    type(phs_point_t) :: phs_p
+    type(vector4_t) :: p_sum
+    type(vector4_t), dimension(:), allocatable :: p_tau, p_out
 
     write (u, "(A)")  "* Test output: phs_points_1"
-    write (u, "(A)")  "*   Purpose: none yet"
+    write (u, "(A)")  "*   Purpose: handling a 2->6 PSP"
+    write (u, "(A)")
+
+    write (u, "(A)")
+    write (u, "(A)")  "*   Setting up a 2->6 off-shell top PSP"
+    write (u, "(A)")
+
+    tt_mom(1) = [2.5000000000000000e+02_default, zero, zero, 2.4999999999947775e+02_default]
+    tt_mom(2) = [2.5000000000000000e+02_default, zero, zero, -2.4999999999947775e+02_default]
+    tt_mom(3) = [1.1557492413664579e+02_default, 3.9011599241011098e+01_default, &
+         -6.4278142734963140e+01_default, 8.7671766153043137e+01_default]
+    tt_mom(4) = [1.4617918132729235e+02_default, -1.0947970597860679e+02_default, &
+         1.5484441802571380e+01_default, -9.5525593923398418e+01_default]
+    tt_mom(5) = [5.2637589215119526e+01_default, -4.7413198564695762e+01_default, &
+         1.0087885417286579e+01_default, 2.0516525153079229e+01_default]
+    tt_mom(6) = [5.4760292922264796e+01_default, 1.5197406985690520e+01_default, &
+         5.1527071739328015e+01_default, -1.0615525413924287e+01_default]
+    tt_mom(7) = [3.2415057664609684e+01_default, 7.5539389341684711e+00_default, &
+         -1.5935831743946720e+01_default, -2.7139737100881156e+01_default]
+    tt_mom(8) = [9.8432954734067863e+01_default, 9.5129959382432389e+01_default, &
+         3.1145755197238953e+00_default, 2.5092565132081493e+01_default]
+    phs_p = tt_mom
+
+    write (u, "(A)")
+    write (u, "(A)")  "*   Retrieving the size of PSP"
+    write (u, "(A)")
+    write (u, "(3x,A,I0)")  "Size PSP  = ", size (phs_p)
+
+    write (u, "(A)")
+    write (u, "(A)")  "*   Returning the set of 4-momenta from PSP"
+    write (u, "(A)")
+    p_out = phs_p%get ()
+    write (u, "(3x,A)")  "set 4-mom.  = "
+    call vector4_write_set (p_out, u, testflag = .true., ultra = .true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "*   Sum of momenta of PSP"
+    write (u, "(A)")
+    p_sum = sum (phs_p)
+    call pacify (p_sum, tolerance = 1.e-12_default)
+    write (u, "(3x,A)")  "Sum:"
+    call p_sum%write (u)
+
+    write (u, "(A)")
+    write (u, "(A)")  "*   Reconstructing top/antitop candidate invariant masses from PSP"
+    write (u, "(A)")
+    write (u, "(3x,A," // FMT_12 // ")")  "m2(top)   = ", sqrt (phs_p%get_msq ([3,6,8]))
+    write (u, "(3x,A," // FMT_12 // ")")  "m2(a-top) = ", sqrt (phs_p%get_msq ([4,5,7]))
+
+    write (u, "(A)")
+    write (u, "(A)")  "*   Select a specific 4-vector from PSP, here for a tau"
     write (u, "(A)")
+    p_tau = phs_p%select ([7])
+    write (u, "(3x,A)")  "p(tau):"
+    call p_tau(1)%write (u, show_mass = .true., testflag = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_points_1"
 
   end subroutine phs_points_1
 
 @ %def phs_points_1
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Special Physics functions}
 Here, we declare functions that are specific for the Standard Model,
 including QCD: fixed and running $\alpha_s$, Catani-Seymour
 dipole terms, loop functions, etc.
 
 To make maximum use of this, all functions, if possible, are declared
 elemental (or pure, if this is not possible).
 <<[[sm_physics.f90]]>>=
 <<File header>>
 
 module sm_physics
 
 <<Use kinds with double>>
   use constants
   use physics_defs
   use lorentz
 
 <<Standard module head>>
 
 <<SM physics: public>>
 
 <<SM physics: parameters>>
 
   interface
 <<SM physics: sub interfaces>>
   end interface
 
 end module sm_physics
 @ %def sm_physics
 @
 <<[[sm_physics_sub.f90]]>>=
 <<File header>>
 
 submodule (sm_physics) sm_physics_s
 
   use io_units
   use numeric_utils
   use diagnostics
   use permutations, only: factorial
 
   implicit none
 
 contains
 
 <<SM physics: procedures>>
 
 end submodule sm_physics_s
 
 @ %def sm_physics_s
 @
 \subsection{Constants for Quantum Field Theory calculations}
 
 For loop calculations in quantum field theories, one needs the
 numerical values of the Riemann zeta function:
 \begin{align*}
   \zeta(2) &=\; 1.64493406684822643647241516665\ldots \; \\
   \zeta(3) &=\; 1.20205690315959428539973816151\ldots \; \\
   \zeta(4) &=\; 1.08232323371113819151600369654\ldots \; \\
   \zeta(5) &=\; 1.03692775514336992633136548646\ldots \;
 \end{align*}
 <<SM physics: public>>=
   public :: zeta2, zeta3, zeta4, zeta5
 <<SM physics: parameters>>=
   real(default), parameter :: &
        zeta2 = 1.64493406684822643647241516665_default, &
        zeta3 = 1.20205690315959428539973816151_default, &
        zeta4 = 1.08232323371113819151600369654_default, &
        zeta5 = 1.03692775514336992633136548646_default
 
 @  %def zeta2 zeta3 zeta4
 @ The Euler-Mascheroni constant is
 \begin{equation*}
   \gamma_E =
 \end{equation*}
 <<SM physics: public>>=
   public :: eulerc
 <<SM physics: parameters>>=
   real(default), parameter :: &
        eulerc =0.5772156649015328606065120900824024310422_default
 
 @ %def eulerc
 @
 \subsection{Running $\alpha_s$}
 
 Then we define the coefficients of the beta function of QCD (as a
 reference cf. the Particle Data Group), where $n_f$ is the number of
 active flavors in two different schemes:
 \begin{align}
   \beta_0 &=\; 11 - \frac23 n_f \\
   \beta_1 &=\; 51 - \frac{19}{3} n_f \\
   \beta_2 &=\; 2857 - \frac{5033}{9} n_f + \frac{325}{27} n_f^2
 \end{align}
 \begin{align}
   b_0 &=\; \frac{1}{12 \pi} \left( 11 C_A  - 2 n_f \right) \\
   b_1 &=\; \frac{1}{24 \pi^2} \left( 17 C_A^2 - 5 C_A n_f - 3 C_F n_f \right) \\
   b_2 &=\; \frac{1}{(4\pi)^3} \biggl( \frac{2857}{54} C_A^3 -
   \frac{1415}{54} * C_A^2 n_f - \frac{205}{18} C_A C_F n_f + C_F^2 n_f
   + \frac{79}{54} C_A n_f**2 + \frac{11}{9} C_F n_f**2 \biggr)
 \end{align}
 The functions [[sumQ2q]] and [[sumQ4q]] provide the sum of the squared
 and quartic electric charges of a number [[nf]] of active quark flavors.
 <<SM physics: public>>=
   public :: beta0, beta1, beta2
   public :: coeff_b0, coeff_b1, coeff_b2, coeffqed_b0, coeffqed_b1
 <<SM physics: sub interfaces>>=
     pure module function beta0 (nf)
       real(default), intent(in) :: nf
       real(default) :: beta0
     end function beta0
     pure module function beta1 (nf)
       real(default), intent(in) :: nf
       real(default) :: beta1
     end function beta1
     pure module function beta2 (nf)
       real(default), intent(in) :: nf
       real(default) :: beta2
     end function beta2
     pure module function coeff_b0 (nf)
       real(default), intent(in) :: nf
       real(default) :: coeff_b0
     end function coeff_b0
     pure module function coeff_b1 (nf)
       real(default), intent(in) :: nf
       real(default) :: coeff_b1
     end function coeff_b1
     pure module function coeff_b2 (nf)
       real(default), intent(in) :: nf
       real(default) :: coeff_b2
     end function coeff_b2
     pure module function coeffqed_b0 (nf, nlep)
       integer, intent(in) :: nf, nlep
       real(default) :: n_lep, coeffqed_b0
     end function coeffqed_b0
     pure module function coeffqed_b1 (nf, nlep)
       integer, intent(in) :: nf, nlep
       real(default) :: n_lep, coeffqed_b1
     end function coeffqed_b1
 <<SM physics: procedures>>=
   pure module function beta0 (nf)
     real(default), intent(in) :: nf
     real(default) :: beta0
     beta0 = 11.0_default - two/three * nf
   end function beta0
 
   pure module function beta1 (nf)
     real(default), intent(in) :: nf
     real(default) :: beta1
     beta1 = 51.0_default - 19.0_default/three * nf
   end function beta1
 
   pure module function beta2 (nf)
     real(default), intent(in) :: nf
     real(default) :: beta2
     beta2 = 2857.0_default - 5033.0_default / 9.0_default * &
                     nf + 325.0_default/27.0_default * nf**2
   end function beta2
 
   pure module function coeff_b0 (nf)
     real(default), intent(in) :: nf
     real(default) :: coeff_b0
     coeff_b0 = (11.0_default * CA - two * nf) / (12.0_default * pi)
   end function coeff_b0
 
   pure module function coeff_b1 (nf)
     real(default), intent(in) :: nf
     real(default) :: coeff_b1
     coeff_b1 = (17.0_default * CA**2 - five * CA * nf - three * CF * nf) / &
                (24.0_default * pi**2)
   end function coeff_b1
 
   pure module function coeff_b2 (nf)
     real(default), intent(in) :: nf
     real(default) :: coeff_b2
     coeff_b2 = (2857.0_default/54.0_default * CA**3 - &
                     1415.0_default/54.0_default * &
                     CA**2 * nf - 205.0_default/18.0_default * CA*CF*nf &
                     + 79.0_default/54.0_default * CA*nf**2 + &
                     11.0_default/9.0_default * CF * nf**2) / (four*pi)**3
   end function coeff_b2
 
   pure module function coeffqed_b0 (nf, nlep)
     integer, intent(in) :: nf, nlep
     real(default) :: n_lep, coeffqed_b0
     n_lep = real(nlep, kind=default)
     coeffqed_b0 = - (three * sumQ2q (nf) + n_lep) / (three*pi)
   end function coeffqed_b0
 
   pure module function coeffqed_b1 (nf, nlep)
     integer, intent(in) :: nf, nlep
     real(default) :: n_lep, coeffqed_b1
     n_lep = real(nlep, kind=default)
     coeffqed_b1 = - (three * sumQ4q (nf) + n_lep) / (four*pi**2)
   end function coeffqed_b1
 
   pure function sumQ2q (nf)
     integer, intent(in) :: nf
     real(default) :: sumQ2q
     select case (nf)
     case (0)
        sumQ2q = zero
     case (1)
        sumQ2q = 1.0_default/9.0_default
     case (2)
        sumQ2q = 5.0_default/9.0_default
     case (3)
        sumQ2q = 2.0_default/3.0_default
     case (4)
        sumQ2q = 10.0_default/9.0_default
     case (5)
        sumQ2q = 11.0_default/9.0_default
     case (6:)
        sumQ2q = 5.0_default/3.0_default
     end select
   end function sumQ2q
 
   pure function sumQ4q (nf)
     integer, intent(in) :: nf
     real(default) :: sumQ4q
     select case (nf)
     case (0)
        sumQ4q = zero
     case (1)
        sumQ4q = 1.0_default/81.0_default
     case (2)
        sumQ4q = 17.0_default/81.0_default
     case (3)
        sumQ4q = 2.0_default/9.0_default
     case (4)
        sumQ4q = 34.0_default/81.0_default
     case (5)
        sumQ4q = 35.0_default/81.0_default
     case (6:)
        sumQ4q = 17.0_default/27.0_default
     end select
   end function sumQ4q
 
 @ %def beta0 beta1 beta2
 @ %def coeff_b0 coeff_b1 coeff_b2 coeffqed_b0 coeffqed_b1
 @ %def sumQ2q sumQ4q
 @ There should be two versions of running $\alpha_s$, one which takes
 the scale and $\Lambda_{\text{QCD}}$ as input, and one which takes the
 scale and e.g. $\alpha_s(m_Z)$ as input. Here, we take the one which
 takes the QCD scale and scale as inputs from the PDG book.
 <<SM physics: public>>=
   public :: running_as, running_as_lam, running_alpha, running_alpha_num
 <<SM physics: sub interfaces>>=
     pure module function running_as (scale, al_mz, mz, order, nf) result (ascale)
       real(default), intent(in) :: scale
       real(default), intent(in), optional :: al_mz, nf, mz
       integer, intent(in), optional :: order
       real(default) :: ascale
     end function running_as
     pure module function running_as_lam (nf, scale, lambda, order) result (ascale)
       real(default), intent(in) :: nf, scale
       real(default), intent(in), optional :: lambda
       integer, intent(in), optional :: order
       real(default) :: ascale
      end function running_as_lam
     pure module function running_alpha &
          (scale, al_me, me, order, nf, nlep) result (ascale)
       real(default), intent(in) :: scale
       real(default), intent(in), optional :: al_me, me
       integer, intent(in), optional :: order, nf, nlep
       real(default) :: ascale
     end function running_alpha
     pure module function running_alpha_num &
          (scale, al_me, me, order, nf, nlep) result (ascale)
       real(default), intent(in) :: scale
       real(default), intent(in), optional :: al_me, me
       integer, intent(in), optional :: order, nf, nlep
       real(default) :: ascale
     end function running_alpha_num
 <<SM physics: procedures>>=
   pure module function running_as (scale, al_mz, mz, order, nf) result (ascale)
     real(default), intent(in) :: scale
     real(default), intent(in), optional :: al_mz, nf, mz
     integer, intent(in), optional :: order
     integer :: ord
     real(default) :: az, m_z, as_log, n_f, b0, b1, b2, ascale
     real(default) :: as0, as1
     if (present (mz)) then
        m_z = mz
     else
        m_z = MZ_REF
     end if
     if (present (order)) then
        ord = order
     else
        ord = 0
     end if
     if (present (al_mz)) then
        az = al_mz
     else
        az = ALPHA_QCD_MZ_REF
     end if
     if (present (nf)) then
        n_f = nf
     else
        n_f = 5
     end if
     b0 = coeff_b0 (n_f)
     b1 = coeff_b1 (n_f)
     b2 = coeff_b2 (n_f)
     as_log = one + b0 * az * log(scale**2/m_z**2)
     as0 = az / as_log
     as1 = as0 - as0**2 * b1/b0 * log(as_log)
     select case (ord)
     case (0)
        ascale = as0
     case (1)
        ascale = as1
     case (2)
        ascale = as1 + as0**3 * (b1**2/b0**2 * ((log(as_log))**2 - &
             log(as_log) + as_log - one) - b2/b0 * (as_log - one))
     case default
        ascale = as0
     end select
   end function running_as
 
   pure module function running_as_lam (nf, scale, lambda, order) result (ascale)
     real(default), intent(in) :: nf, scale
     real(default), intent(in), optional :: lambda
     integer, intent(in), optional :: order
     real(default) :: lambda_qcd
     real(default) :: as0, as1, logmul, b0, b1, b2, ascale
     integer :: ord
     if (present (lambda)) then
        lambda_qcd = lambda
     else
        lambda_qcd = LAMBDA_QCD_REF
     end if
     if (present (order)) then
        ord = order
     else
        ord = 0
     end if
     b0 = beta0(nf)
     logmul = log(scale**2/lambda_qcd**2)
     as0 = four*pi / b0 / logmul
     if (ord > 0) then
        b1 = beta1(nf)
        as1 = as0 * (one - two* b1 / b0**2 * log(logmul) / logmul)
     end if
     select case (ord)
     case (0)
        ascale = as0
     case (1)
        ascale = as1
     case (2)
        b2 = beta2(nf)
        ascale = as1 + as0 * four * b1**2/b0**4/logmul**2 * &
             ((log(logmul) - 0.5_default)**2 + &
              b2*b0/8.0_default/b1**2 - five/four)
     case default
        ascale = as0
     end select
   end function running_as_lam
 
   pure module function running_alpha &
        (scale, al_me, me, order, nf, nlep) result (ascale)
     real(default), intent(in) :: scale
     real(default), intent(in), optional :: al_me, me
     integer, intent(in), optional :: order, nf, nlep
     integer :: ord, n_f, n_lep
     real(default) :: ae, m_e, a_log, b0, b1, ascale
     real(default) :: a0, a1
     if (present (me)) then
        m_e = me
     else
        m_e = ME_REF
     end if
     if (present (order)) then
        ord = order
     else
        ord = 0
     end if
     if (present (al_me)) then
        ae = al_me
     else
        ae = ALPHA_QED_ME_REF
     end if
     if (present (nf)) then
        n_f = nf
     else
        n_f = 5
     end if
     if (present (nlep)) then
        n_lep = nlep
     else
        n_lep = 1
     end if
     b0 = coeffqed_b0 (n_f, n_lep)
     b1 = coeffqed_b1 (n_f, n_lep)
     a_log = one + b0 * ae * log(scale**2/m_e**2)
     a0 = ae / a_log
     a1 = ae / (a_log + ae * b1/b0 * &
          log((a_log + ae * b1/b0)/(one + ae * b1/b0)))
     select case (ord)
     case (0)
        ascale = a0
     case (1)
        ascale = a1
     case default
        ascale = a0
     end select
   end function running_alpha
 
   pure module function running_alpha_num &
        (scale, al_me, me, order, nf, nlep) result (ascale)
     real(default), intent(in) :: scale
     real(default), intent(in), optional :: al_me, me
     integer, intent(in), optional :: order, nf, nlep
     integer, parameter :: n_steps = 20
     integer :: ord, n_f, n_lep, k1
     real(default), parameter :: sxth = 1._default/6._default
     real(default) :: ae, ascale, m_e, log_q, dlr, &
          b0, b1, xk0, xk1, xk2, xk3
     if (present (order)) then
        ord = order
     else
        ord = 0
     end if
     if (present (al_me)) then
        ae = al_me
     else
        ae = ALPHA_QED_ME_REF
     end if
     if (present (me)) then
        m_e = me
     else
        m_e = ME_REF
     end if
     if (present (nf)) then
        n_f = nf
     else
        n_f = 5
     end if
     if (present (nlep)) then
        n_lep = nlep
     else
        n_lep = 1
     end if
     ascale = ae
     log_q = log (scale**2/m_e**2)
     dlr = log_q / n_steps
     b0 = coeffqed_b0 (n_f, n_lep)
     b1 = coeffqed_b1 (n_f, n_lep)
     ! ..Solution of the evolution equation depending on ORD
     !   (fourth-order Runge-Kutta beyond the leading order)
     select case (ord)
     case (0)
        ascale = ae / (one + b0 * ae * log_q)
     case (1:)
        do k1 = 1, n_steps
           xk0 = dlr * beta_qed (ascale)
           xk1 = dlr * beta_qed (ascale + 0.5 * xk0)
           xk2 = dlr * beta_qed (ascale + 0.5 * xk1)
           xk3 = dlr * beta_qed (ascale + xk2)
           ascale = ascale + sxth * (xk0 + 2._default * xk1 + &
                2._default * xk2 + xk3)
        end do
     end select
   contains
     pure function beta_qed (alpha)
       real(default), intent(in) :: alpha
       real(default) :: beta_qed
       beta_qed = - alpha**2 * (b0 + alpha * b1)
     end function beta_qed
   end function running_alpha_num
 
 @ %def running_as
 @ %def running_as_lam
 @ %def running_alpha running_alpha_num
 @ This routine determines the Landau pole $\Lambda^{(n_f)}_{\overline{MS}}$
 for given $\alpha_s$, scale, number of flavors and order.
 <<SM physics: public>>=
   public :: lambda_qcd
 <<SM physics: sub interfaces>>=
     module function lambda_qcd (as_q, q, nf, order) result (lambda)
       real(default), intent(in) :: as_q, q
       integer, intent(in) :: order, nf
       real(default) :: lambda
     end function lambda_qcd
 <<SM physics: procedures>>=
   module function lambda_qcd (as_q, q, nf, order) result (lambda)
     real(default), intent(in) :: as_q, q
     integer, intent(in) :: nf, order
     real(default) :: lambda
     real(default), parameter :: acc = 1e-8_default
     if (order == 0) then
        lambda = lambda_qcd_lo (as_q, q, nf)
     else if (order == 1) then
        lambda = lambda_qcd_nlo (as_q, q, nf)
     else if (order == 2) then
        lambda = lambda_qcd_nnlo (as_q, q, nf)
     else
        call msg_error ("lambda_qcd: order unknown")
     end if
   contains
     function lambda_qcd_lo (as_q, q, nf) result (lambda)
       real(default) :: lambda
       real(default), intent(in) :: as_q, q
       integer, intent(in) :: nf
       real(default) :: b0, t0, t1, as0, as1
       b0 = coeff_b0(real(nf, default))
       t1 = one/b0/as_q
       FIND_ROOT: do
          if (signal_is_pending ())  return
          t0 = t1
          as0 = one/b0/t1
          as1 = - one/b0/t1**2
          t1 = (as_q-as0)/as1 + t1
          if (abs(t0-t1)/t0 < acc) exit FIND_ROOT
       end do FIND_ROOT
       lambda = q * exp(-t1/two)
     end function lambda_qcd_lo
     function lambda_qcd_nlo (as_q, q, nf) result (lambda)
       real(default) :: lambda
       real(default), intent(in) :: as_q, q
       integer, intent(in) :: nf
       real(default) :: b0, b1, t0, t1, as0, as1, logt
       b0 = coeff_b0(real(nf, default))
       b1 = coeff_b1(real(nf, default))
       t1 = one/b0/as_q
       FIND_ROOT: do
          if (signal_is_pending ())  return
          logt = log(t1)
          t0 = t1
          as0 = one/b0/t1 - b1/b0 * logt/(b0 * t1)**2
          as1 = - one/b0/t1**2 - b1/b0**3 * (one - two*logt)/t1**3
          t1 = (as_q-as0)/as1 + t1
          if (abs(t0-t1)/t0 < acc) exit FIND_ROOT
       end do FIND_ROOT
       lambda = q * exp(-t1/two)
     end function lambda_qcd_nlo
     function lambda_qcd_nnlo (as_q, q, nf) result (lambda)
       real(default) :: lambda
       real(default), intent(in) :: as_q, q
       integer, intent(in) :: nf
       real(default) :: b0, b1, b2, t0, t1, as0, as1, logt
       b0 = coeff_b0(real(nf, default))
       b1 = coeff_b1(real(nf, default))
       b2 = coeff_b2(real(nf, default))
       t1 = one/b0/as_q
       FIND_ROOT: do
          if (signal_is_pending ())  return
          logt = log(t1)
          t0 = t1
          as0 = one/b0/t1 * (one - b1/b0**2 * logt/t1 + (b1/b0**2 * logt/t1)**2 &
               - (b1**2 * (logt + one) - b0*b2)/b0**4/t1**2)
          as1 = one/b0/t1 * (-two*b1**2 * logt**2/(b0**4 * t1**3) &
               + two*(b1**2 * (logt + one) - b0*b2)/(b0**4 * t1**3) &
               + b1 * logt/(b0**2 * t1**2) + two*b1**2 * logt/(b0**4 * t1**3) &
               - b1/(b0**2 * t1**2) - b1**2/(b0**4 * t1**3)) &
               - (b1**2 * logt**2/(b0**4 * t1**2) - (b1**2 * (logt + one) &
               - b0*b2)/(b0**4 * t1**2) - b1 * logt/(b0**2 * t1) + one)/(b0 * t1**2)
          t1 = (as_q-as0)/as1 + t1
          if (abs(t0-t1)/t0 < acc) exit FIND_ROOT
       end do FIND_ROOT
       lambda = q * exp(-t1/two)
     end function lambda_qcd_nnlo
   end function lambda_qcd
 
 @ %def lambda_qcd
 @
 \subsection{Catani-Seymour Parameters}
 These are fundamental constants of the Catani-Seymour dipole formalism.
 Since the corresponding parameters for the gluon case depend on the
 number of flavors which is treated as an argument, there we do have
 functions and not parameters.
 \begin{equation}
   \gamma_q = \gamma_{\bar q} = \frac{3}{2} C_F \qquad \gamma_g =
   \frac{11}{6} C_A - \frac{2}{3} T_R N_f
 \end{equation}
 \begin{equation}
   K_q = K_{\bar q} = \left(  \frac{7}{2} - \frac{\pi^2}{6} \right) C_F \qquad
   K_g = \left( \frac{67}{18} - \frac{\pi^2}{6} \right) C_A -
   \frac{10}{9} T_R N_f
 \end{equation}
 <<SM physics: parameters>>=
   real(default), parameter, public ::  gamma_q = three/two * CF, &
      k_q = (7.0_default/two - pi**2/6.0_default) * CF
 
 @ %def gamma_q
 @
 <<SM physics: public>>=
   public :: gamma_g, k_g
 <<SM physics: sub interfaces>>=
     elemental module function gamma_g (nf) result (gg)
       real(default), intent(in) :: nf
       real(default) :: gg
     end function gamma_g
     elemental module function k_g (nf) result (kg)
       real(default), intent(in) :: nf
       real(default) :: kg
     end function k_g
 <<SM physics: procedures>>=
   elemental module function gamma_g (nf) result (gg)
     real(default), intent(in) :: nf
     real(default) :: gg
     gg = 11.0_default/6.0_default * CA - two/three * TR * nf
   end function gamma_g
 
   elemental module function k_g (nf) result (kg)
     real(default), intent(in) :: nf
     real(default) :: kg
     kg = (67.0_default/18.0_default - pi**2/6.0_default) * CA - &
          10.0_default/9.0_default * TR * nf
   end function k_g
 
 @ %def gamma_g
 @ %def k_g
 @
 \subsection{Mathematical Functions}
 The dilogarithm.  This simplified version is bound to double
 precision, and restricted to argument values less or equal to unity,
 so we do not need complex algebra.  The wrapper converts it to default
 precision (which is, of course, a no-op if double=default).
 
 The routine calculates the dilogarithm through mapping on the area
 where there is a quickly convergent series (adapted from an F77
 routine by Hans Kuijf, 1988): Map $x$ such that $x$ is not in the
 neighbourhood of $1$.  Note that $|z|=-\ln(1-x)$ is always smaller
 than $1.10$, but $\frac{1.10^{19}}{19!}{\rm Bernoulli}_{19}=2.7\times
 10^{-15}$.
 <<SM physics: public>>=
   public :: Li2
 <<SM physics: sub interfaces>>=
     elemental module function Li2 (x)
       real(default), intent(in) :: x
       real(default) :: Li2
     end function Li2
 <<SM physics: procedures>>=
   elemental module function Li2 (x)
     real(default), intent(in) :: x
     real(default) :: Li2
     Li2 = real( Li2_double (real(x, kind=double)), kind=default)
   end function Li2
 
 @ %def: Li2
 @
 <<SM physics: procedures>>=
   elemental function Li2_double (x)  result (Li2)
     real(double), intent(in) :: x
     real(double) :: Li2
     real(double), parameter :: pi2_6 = pi**2/6
     if (abs(1-x) < tiny_07) then
        Li2 = pi2_6
     else if (abs(1-x) <  0.5_double) then
        Li2 = pi2_6 - log(1-x) * log(x) - Li2_restricted (1-x)
     else if (abs(x) > 1.d0) then
        ! Li2 = 0
        ! call msg_bug (" Dilogarithm called outside of defined range.")
        !!! Reactivate Dilogarithm identity
         Li2 = -pi2_6 - 0.5_default * log(-x) * log(-x) - Li2_restricted (1/x)
     else
        Li2 = Li2_restricted (x)
     end if
   contains
     elemental function Li2_restricted (x) result (Li2)
       real(double), intent(in) :: x
       real(double) :: Li2
       real(double) :: tmp, z, z2
       z = - log (1-x)
       z2 = z**2
 ! Horner's rule for the powers z^3 through z^19
       tmp = 43867._double/798._double
       tmp = tmp * z2 /342._double - 3617._double/510._double
       tmp = tmp * z2 /272._double + 7._double/6._double
       tmp = tmp * z2 /210._double - 691._double/2730._double
       tmp = tmp * z2 /156._double + 5._double/66._double
       tmp = tmp * z2 /110._double - 1._double/30._double
       tmp = tmp * z2 / 72._double + 1._double/42._double
       tmp = tmp * z2 / 42._double - 1._double/30._double
       tmp = tmp * z2 / 20._double + 1._double/6._double
 ! The first three terms of the power series
       Li2 = z2 * z * tmp / 6._double - 0.25_double * z2 + z
     end function Li2_restricted
   end function Li2_double
 
 @ %def Li2_double
 @ Complex digamma function. For this we use the asymptotic formula in
 Abramoqicz/Stegun, Eq. (6.3.18), and the recurrence formula
 Eq. (6.3.6):
 \begin{equation}
   \psi^{(0})(z) := \psi(z) = \frac{\Gamma'(z)}{\Gamma(z)}
 \end{equation}
 <<SM physics: public>>=
   public :: psic
   public :: psir
 <<SM physics: sub interfaces>>=
     elemental module function psic (z) result (psi)
       complex(default), intent(in) :: z
       complex(default) :: psi
     end function psic
     elemental module function psir (x) result (psi)
       real(default), intent(in) :: x
       real(default) :: psi
     end function psir
 <<SM physics: procedures>>=
   elemental module function psic (z) result (psi)
     complex(default), intent(in) :: z
     complex(default) :: psi
     complex(default) :: shift, zz, zi, zi2
     shift = 0
     zz = z
     if (abs (aimag(zz)) < 10._default) then
        do while (abs (zz) < 10._default)
           shift = shift - 1 / zz
           zz = zz + 1
        end do
     end if
     zi  = 1/zz
     zi2 = zi*zi
     psi = shift + log(zz) - zi/2 - zi2 / 5040._default * ( 420._default + &
          zi2 * ( -42._default + zi2 * (20._default - 21._default * zi2)))
   end function psic
 
   elemental module function psir (x) result (psi)
     real(default), intent(in) :: x
     real(default) :: psi
     psi = real (psic (cmplx (x,0,kind=default)), kind=default)
   end function psir
 
 @ %def psic psir
 @ Complex polygamma function. For this we use the asymptotic formula in
 Abramoqicz/Stegun, Eq. (6.4.11), and the recurrence formula
 Eq. (6.4.11):
 \begin{equation}
   \psi^{(m})(z) := \frac{d^m}{dz^m} \psi(z) = \frac{d^{m+1}}{dz^{m+1}}
   \ln \Gamma(z)
 \end{equation}
 <<SM physics: public>>=
   public :: psim
   public :: psimr
 <<SM physics: sub interfaces>>=
     elemental module function psim (z, m) result (psi)
       complex(default), intent(in) :: z
       integer, intent(in) :: m
       complex(default) :: psi
     end function psim
     elemental module function psimr (x, m) result (psi)
       real(default), intent(in) :: x
       integer, intent(in) :: m
       real(default) :: psi
     end function psimr
 <<SM physics: procedures>>=
   elemental module function psim (z, m) result (psi)
     complex(default), intent(in) :: z
     integer, intent(in) :: m
     complex(default) :: psi
     complex(default) :: shift, rec, zz, zi, zi2
     real(default) :: c1, c2, c3, c4, c5, c6, c7
     integer :: i
     if (m < 1) then
        psi = psic(z)
     else
        shift = 0
        zz = z
        if (abs (aimag (zz)) < 10._default) then
           CHECK_ABS: do
              rec = (-1)**m * factorial (m) / zz**(m+1)
              shift = shift - rec
              zz = zz + 1
              if (abs (zz) > 10._default) exit CHECK_ABS
           end do CHECK_ABS
        end if
        c1 =   1._default
        c2 =   1._default / 2._default
        c3 =   1._default / 6._default
        c4 = - 1._default / 30._default
        c5 =   1._default / 42._default
        c6 = - 1._default / 30._default
        c7 =   5._default / 66._default
        do i = 2, m
           c1 = c1 * (i-1)
           c2 = c2 * i
           c3 = c3 * (i+1)
           c4 = c4 * (i+3)
           c5 = c5 * (i+5)
           c6 = c6 * (i+7)
           c7 = c7 * (i+9)
        end do
        zi  = 1/zz
        zi2 = zi*zi
        psi = shift + (-1)**(m-1) * zi**m * ( c1 + zi * ( c2 + zi * ( &
             c3 + zi2 * ( c4 + zi2 * ( c5 + zi2 * ( c6 + ( c7 * zi2)))))))
     end if
   end function psim
 
   elemental module function psimr (x, m) result (psi)
     real(default), intent(in) :: x
     integer, intent(in) :: m
     real(default) :: psi
     psi = real (psim (cmplx (x,0,kind=default), m), kind=default)
   end function psimr
 
 @ %def psim psimr
 @ Nielsen's generalized polylogarithms, 
 \begin{equation*}
   S_{n,m}(x) = \frac{(-1)^{n+m-1}}{(n-1)!m!} \int_0^1 t^{-1}
   \; \ln^{n-1} t \; \ln^m (1-xt) \; dt \; ,
 \end{equation*}
 adapted from the CERNLIB function [[wgplg]] for real arguments [[x]]
 and integer $n$ and $m$ satisfying $1 \leq n \leq 4$, $1 \leq m \leq 4$,
 $n+m \leq 5$, i.e. one of the functions $S_{1,1}$, $S_{1,2}$,
 $S_{2,1}$, $S_{1,3}$, $S_{2,2}$, $S_{3,1}$, $S_{1,4}$, $S_{2,3}$,
 $S_{3,2}$, $S_{4,1}$. If $x\leq1$, $S_{n,m}(x)$ is real, and the
 imaginary part is set to zero.
 <<SM physics: public>>=
   public :: cnielsen
   public :: nielsen
 <<SM physics: sub interfaces>>=
     module function cnielsen (n, m, x) result (nplog)
       integer, intent(in) :: n, m
       real(default), intent(in) :: x
       complex(default) :: nplog
     end function cnielsen
     module function nielsen (n, m, x) result (nplog)
       integer, intent(in) :: n, m
       real(default), intent(in) :: x
       real(default) :: nplog
     end function nielsen
 <<SM physics: procedures>>=
   module function cnielsen (n, m, x) result (nplog)
     integer, intent(in) :: n, m
     real(default), intent(in) :: x
     complex(default) :: nplog
     real(default), parameter :: c1 = 4._default/3._default, &
          c2 = 1._default/3._default
     real(default), dimension(0:4), parameter :: &
          fct = [1.0_default,1.0_default,2.0_default,6.0_default,24.0_default]
     real(default), dimension(4,4) :: s1, cc
     real(default), dimension(0:30,10) :: aa
     complex(default), dimension(0:5) :: vv
     real(default), dimension(0:5) :: uu
     real(default) :: x1, h, alfa, b0, b1, b2, qq, rr
     complex(default) :: sj, sk
     integer, dimension(10), parameter :: &
          nc = [24,26,28,30,22,24,26,19,22,17]
     integer, dimension(31), parameter :: &
          index = [1,2,3,4,0,0,0,0,0,0,5,6,7,0,0,0,0,0,0,0, &
                   8,9,0,0,0,0,0,0,0,0,10]
     real(default), dimension(0:4), parameter :: &
          sgn = [1._default, -1._default, 1._default, -1._default, 1._default]
     integer :: it, j, k, l, m1, n1
     if ((n<1) .or. (n>4) .or. (m<1) .or. (m>4) .or. (n+m > 5)) then
        call msg_fatal &
             ("The Nielsen dilogarithms cannot be applied for these values.")
     end if
     s1 = 0._default
     s1(1,1) = 1.6449340668482_default
     s1(1,2) = 1.2020569031596_default
     s1(1,3) = 1.0823232337111_default
     s1(1,4) = 1.0369277551434_default
     s1(2,1) = 1.2020569031596_default
     s1(2,2) = 2.7058080842778e-1_default
     s1(2,3) = 9.6551159989444e-2_default
     s1(3,1) = 1.0823232337111_default
     s1(3,2) = 9.6551159989444e-2_default
     s1(4,1) = 1.0369277551434_default
     cc = 0._default
     cc(1,1) = 1.6449340668482_default
     cc(1,2) = 1.2020569031596_default
     cc(1,3) = 1.0823232337111_default
     cc(1,4) = 1.0369277551434_default
     cc(2,2) =-1.8940656589945_default
     cc(2,3) =-3.0142321054407_default
     cc(3,1) = 1.8940656589945_default
     cc(3,2) = 3.0142321054407_default
     aa = 0._default
     aa( 0,1) = 0.96753215043498_default
     aa( 1,1) = 0.16607303292785_default
     aa( 2,1) = 0.02487932292423_default
     aa( 3,1) = 0.00468636195945_default
     aa( 4,1) = 0.00100162749616_default
     aa( 5,1) = 0.00023200219609_default
     aa( 6,1) = 0.00005681782272_default
     aa( 7,1) = 0.00001449630056_default
     aa( 8,1) = 0.00000381632946_default
     aa( 9,1) = 0.00000102990426_default
     aa(10,1) = 0.00000028357538_default
     aa(11,1) = 0.00000007938705_default
     aa(12,1) = 0.00000002253670_default
     aa(13,1) = 0.00000000647434_default
     aa(14,1) = 0.00000000187912_default
     aa(15,1) = 0.00000000055029_default
     aa(16,1) = 0.00000000016242_default
     aa(17,1) = 0.00000000004827_default
     aa(18,1) = 0.00000000001444_default
     aa(19,1) = 0.00000000000434_default
     aa(20,1) = 0.00000000000131_default
     aa(21,1) = 0.00000000000040_default
     aa(22,1) = 0.00000000000012_default
     aa(23,1) = 0.00000000000004_default
     aa(24,1) = 0.00000000000001_default
 
     aa( 0,2) = 0.95180889127832_default
     aa( 1,2) = 0.43131131846532_default
     aa( 2,2) = 0.10002250714905_default
     aa( 3,2) = 0.02442415595220_default
     aa( 4,2) = 0.00622512463724_default
     aa( 5,2) = 0.00164078831235_default
     aa( 6,2) = 0.00044407920265_default
     aa( 7,2) = 0.00012277494168_default
     aa( 8,2) = 0.00003453981284_default
     aa( 9,2) = 0.00000985869565_default
     aa(10,2) = 0.00000284856995_default
     aa(11,2) = 0.00000083170847_default
     aa(12,2) = 0.00000024503950_default
     aa(13,2) = 0.00000007276496_default
     aa(14,2) = 0.00000002175802_default
     aa(15,2) = 0.00000000654616_default
     aa(16,2) = 0.00000000198033_default
     aa(17,2) = 0.00000000060204_default
     aa(18,2) = 0.00000000018385_default
     aa(19,2) = 0.00000000005637_default
     aa(20,2) = 0.00000000001735_default
     aa(21,2) = 0.00000000000536_default
     aa(22,2) = 0.00000000000166_default
     aa(23,2) = 0.00000000000052_default
     aa(24,2) = 0.00000000000016_default
     aa(25,2) = 0.00000000000005_default
     aa(26,2) = 0.00000000000002_default
 
     aa( 0,3) = 0.98161027991365_default
     aa( 1,3) = 0.72926806320726_default
     aa( 2,3) = 0.22774714909321_default
     aa( 3,3) = 0.06809083296197_default
     aa( 4,3) = 0.02013701183064_default
     aa( 5,3) = 0.00595478480197_default
     aa( 6,3) = 0.00176769013959_default
     aa( 7,3) = 0.00052748218502_default
     aa( 8,3) = 0.00015827461460_default
     aa( 9,3) = 0.00004774922076_default
     aa(10,3) = 0.00001447920408_default
     aa(11,3) = 0.00000441154886_default
     aa(12,3) = 0.00000135003870_default
     aa(13,3) = 0.00000041481779_default
     aa(14,3) = 0.00000012793307_default
     aa(15,3) = 0.00000003959070_default
     aa(16,3) = 0.00000001229055_default
     aa(17,3) = 0.00000000382658_default
     aa(18,3) = 0.00000000119459_default
     aa(19,3) = 0.00000000037386_default
     aa(20,3) = 0.00000000011727_default
     aa(21,3) = 0.00000000003687_default
     aa(22,3) = 0.00000000001161_default
     aa(23,3) = 0.00000000000366_default
     aa(24,3) = 0.00000000000116_default
     aa(25,3) = 0.00000000000037_default
     aa(26,3) = 0.00000000000012_default
     aa(27,3) = 0.00000000000004_default
     aa(28,3) = 0.00000000000001_default
 
     aa( 0,4) = 1.0640521184614_default
     aa( 1,4) = 1.0691720744981_default
     aa( 2,4) = 0.41527193251768_default
     aa( 3,4) = 0.14610332936222_default
     aa( 4,4) = 0.04904732648784_default
     aa( 5,4) = 0.01606340860396_default
     aa( 6,4) = 0.00518889350790_default
     aa( 7,4) = 0.00166298717324_default
     aa( 8,4) = 0.00053058279969_default
     aa( 9,4) = 0.00016887029251_default
     aa(10,4) = 0.00005368328059_default
     aa(11,4) = 0.00001705923313_default
     aa(12,4) = 0.00000542174374_default
     aa(13,4) = 0.00000172394082_default
     aa(14,4) = 0.00000054853275_default
     aa(15,4) = 0.00000017467795_default
     aa(16,4) = 0.00000005567550_default
     aa(17,4) = 0.00000001776234_default
     aa(18,4) = 0.00000000567224_default
     aa(19,4) = 0.00000000181313_default
     aa(20,4) = 0.00000000058012_default
     aa(21,4) = 0.00000000018579_default
     aa(22,4) = 0.00000000005955_default
     aa(23,4) = 0.00000000001911_default
     aa(24,4) = 0.00000000000614_default
     aa(25,4) = 0.00000000000197_default
     aa(26,4) = 0.00000000000063_default
     aa(27,4) = 0.00000000000020_default
     aa(28,4) = 0.00000000000007_default
     aa(29,4) = 0.00000000000002_default
     aa(30,4) = 0.00000000000001_default
 
     aa( 0,5) = 0.97920860669175_default
     aa( 1,5) = 0.08518813148683_default
     aa( 2,5) = 0.00855985222013_default
     aa( 3,5) = 0.00121177214413_default
     aa( 4,5) = 0.00020722768531_default
     aa( 5,5) = 0.00003996958691_default
     aa( 6,5) = 0.00000838064065_default
     aa( 7,5) = 0.00000186848945_default
     aa( 8,5) = 0.00000043666087_default
     aa( 9,5) = 0.00000010591733_default
     aa(10,5) = 0.00000002647892_default
     aa(11,5) = 0.00000000678700_default
     aa(12,5) = 0.00000000177654_default
     aa(13,5) = 0.00000000047342_default
     aa(14,5) = 0.00000000012812_default
     aa(15,5) = 0.00000000003514_default
     aa(16,5) = 0.00000000000975_default
     aa(17,5) = 0.00000000000274_default
     aa(18,5) = 0.00000000000077_default
     aa(19,5) = 0.00000000000022_default
     aa(20,5) = 0.00000000000006_default
     aa(21,5) = 0.00000000000002_default
     aa(22,5) = 0.00000000000001_default
 
     aa( 0,6) = 0.95021851963952_default
     aa( 1,6) = 0.29052529161433_default
     aa( 2,6) = 0.05081774061716_default
     aa( 3,6) = 0.00995543767280_default
     aa( 4,6) = 0.00211733895031_default
     aa( 5,6) = 0.00047859470550_default
     aa( 6,6) = 0.00011334321308_default
     aa( 7,6) = 0.00002784733104_default
     aa( 8,6) = 0.00000704788108_default
     aa( 9,6) = 0.00000182788740_default
     aa(10,6) = 0.00000048387492_default
     aa(11,6) = 0.00000013033842_default
     aa(12,6) = 0.00000003563769_default
     aa(13,6) = 0.00000000987174_default
     aa(14,6) = 0.00000000276586_default
     aa(15,6) = 0.00000000078279_default
     aa(16,6) = 0.00000000022354_default
     aa(17,6) = 0.00000000006435_default
     aa(18,6) = 0.00000000001866_default
     aa(19,6) = 0.00000000000545_default
     aa(20,6) = 0.00000000000160_default
     aa(21,6) = 0.00000000000047_default
     aa(22,6) = 0.00000000000014_default
     aa(23,6) = 0.00000000000004_default
     aa(24,6) = 0.00000000000001_default
 
     aa( 0,7) = 0.95064032186777_default
     aa( 1,7) = 0.54138285465171_default
     aa( 2,7) = 0.13649979590321_default
     aa( 3,7) = 0.03417942328207_default
     aa( 4,7) = 0.00869027883583_default
     aa( 5,7) = 0.00225284084155_default
     aa( 6,7) = 0.00059516089806_default
     aa( 7,7) = 0.00015995617766_default
     aa( 8,7) = 0.00004365213096_default
     aa( 9,7) = 0.00001207474688_default
     aa(10,7) = 0.00000338018176_default
     aa(11,7) = 0.00000095632476_default
     aa(12,7) = 0.00000027313129_default
     aa(13,7) = 0.00000007866968_default
     aa(14,7) = 0.00000002283195_default
     aa(15,7) = 0.00000000667205_default
     aa(16,7) = 0.00000000196191_default
     aa(17,7) = 0.00000000058018_default
     aa(18,7) = 0.00000000017246_default
     aa(19,7) = 0.00000000005151_default
     aa(20,7) = 0.00000000001545_default
     aa(21,7) = 0.00000000000465_default
     aa(22,7) = 0.00000000000141_default
     aa(23,7) = 0.00000000000043_default
     aa(24,7) = 0.00000000000013_default
     aa(25,7) = 0.00000000000004_default
     aa(26,7) = 0.00000000000001_default
 
     aa( 0,8) = 0.98800011672229_default
     aa( 1,8) = 0.04364067609601_default
     aa( 2,8) = 0.00295091178278_default
     aa( 3,8) = 0.00031477809720_default
     aa( 4,8) = 0.00004314846029_default
     aa( 5,8) = 0.00000693818230_default
     aa( 6,8) = 0.00000124640350_default
     aa( 7,8) = 0.00000024293628_default
     aa( 8,8) = 0.00000005040827_default
     aa( 9,8) = 0.00000001099075_default
     aa(10,8) = 0.00000000249467_default
     aa(11,8) = 0.00000000058540_default
     aa(12,8) = 0.00000000014127_default
     aa(13,8) = 0.00000000003492_default
     aa(14,8) = 0.00000000000881_default
     aa(15,8) = 0.00000000000226_default
     aa(16,8) = 0.00000000000059_default
     aa(17,8) = 0.00000000000016_default
     aa(18,8) = 0.00000000000004_default
     aa(19,8) = 0.00000000000001_default
 
     aa( 0,9) = 0.95768506546350_default
     aa( 1,9) = 0.19725249679534_default
     aa( 2,9) = 0.02603370313918_default
     aa( 3,9) = 0.00409382168261_default
     aa( 4,9) = 0.00072681707110_default
     aa( 5,9) = 0.00014091879261_default
     aa( 6,9) = 0.00002920458914_default
     aa( 7,9) = 0.00000637631144_default
     aa( 8,9) = 0.00000145167850_default
     aa( 9,9) = 0.00000034205281_default
     aa(10,9) = 0.00000008294302_default
     aa(11,9) = 0.00000002060784_default
     aa(12,9) = 0.00000000522823_default
     aa(13,9) = 0.00000000135066_default
     aa(14,9) = 0.00000000035451_default
     aa(15,9) = 0.00000000009436_default
     aa(16,9) = 0.00000000002543_default
     aa(17,9) = 0.00000000000693_default
     aa(18,9) = 0.00000000000191_default
     aa(19,9) = 0.00000000000053_default
     aa(20,9) = 0.00000000000015_default
     aa(21,9) = 0.00000000000004_default
     aa(22,9) = 0.00000000000001_default
 
     aa( 0,10) = 0.99343651671347_default
     aa( 1,10) = 0.02225770126826_default
     aa( 2,10) = 0.00101475574703_default
     aa( 3,10) = 0.00008175156250_default
     aa( 4,10) = 0.00000899973547_default
     aa( 5,10) = 0.00000120823987_default
     aa( 6,10) = 0.00000018616913_default
     aa( 7,10) = 0.00000003174723_default
     aa( 8,10) = 0.00000000585215_default
     aa( 9,10) = 0.00000000114739_default
     aa(10,10) = 0.00000000023652_default
     aa(11,10) = 0.00000000005082_default
     aa(12,10) = 0.00000000001131_default
     aa(13,10) = 0.00000000000259_default
     aa(14,10) = 0.00000000000061_default
     aa(15,10) = 0.00000000000015_default
     aa(16,10) = 0.00000000000004_default
     aa(17,10) = 0.00000000000001_default
 
     if (x == 1._default) then
        nplog = s1(n,m)
     else if (x > 2._default .or. x < -1.0_default) then
        x1 = 1._default / x
        h = c1 * x1 + c2
        alfa = h + h
        vv(0) = 1._default
        if (x < -1.0_default) then
           vv(1) = log(-x)
        else if (x > 2._default) then
           vv(1) = log(cmplx(-x,0._default,kind=default))
        end if
        do l = 2, n+m
           vv(l) = vv(1) * vv(l-1)/l
        end do
        sk = 0._default
        do k = 0, m-1
           m1 = m-k
           rr = x1**m1 / (fct(m1) * fct(n-1))
           sj = 0._default
           do j = 0, k
              n1 = n+k-j
              l = index(10*n1+m1-10)
              b1 = 0._default
              b2 = 0._default
              do it = nc(l), 0, -1
                 b0 = aa(it,l) + alfa*b1 - b2
                 b2 = b1
                 b1 = b0
              end do
              qq = (fct(n1-1) / fct(k-j)) * (b0 - h*b2) * rr / m1**n1
              sj = sj + vv(j) * qq
           end do
           sk = sk + sgn(k) * sj
        end do
        sj = 0._default
        do j = 0, n-1
           sj = sj + vv(j) * cc(n-j,m)
        end do
        nplog = sgn(n) * sk + sgn(m) * (sj + vv(n+m))
     else if (x > 0.5_default) then
        x1 = 1._default - x
        h = c1 * x1 + c2
        alfa = h + h
        vv(0) = 1._default
        uu(0) = 1._default
        vv(1) = log(cmplx(x1,0._default,kind=default))
        uu(1) = log(x)
        do l = 2, m
           vv(l) = vv(1) * vv(l-1) / l
        end do
        do l = 2, n
           uu(l) = uu(1) * uu(l-1) / l
        end do
        sk = 0._default
        do k = 0, n-1
           m1 = n-k
           rr = x1**m1 / fct(m1)
           sj = 0._default
           do j = 0, m-1
              n1 = m-j
              l = index(10*n1 + m1 - 10)
              b1 = 0._default
              b2 = 0._default
              do it = nc(l), 0, -1
                 b0 = aa(it,l) + alfa*b1 - b2
                 b2 = b1
                 b1 = b0
              end do
              qq = sgn(j) * (b0 - h*b2) * rr / m1**n1
              sj = sj + vv(j) * qq
           end do
           sk = sk + uu(k) * (s1(m1,m) - sj)
        end do
        nplog = sk + sgn(m) * uu(n) * vv(m)
     else
        l = index(10*n + m - 10)
        h = c1 * x + c2
        alfa = h + h
        b1 = 0._default
        b2 = 0._default
        do it = nc(l), 0, -1
           b0 = aa(it,l) + alfa*b1 - b2
           b2 = b1
           b1 = b0
        end do
        nplog = (b0 - h*b2) * x**m / (fct(m) * m**n)
     end if
   end function cnielsen
 
   module function nielsen (n, m, x) result (nplog)
     integer, intent(in) :: n, m
     real(default), intent(in) :: x
     real(default) :: nplog
     nplog = real (cnielsen (n, m, x))
   end function nielsen
 
 @ %def cnielsen nielsen
 @ $\text{Li}_{n}(x) = S_{n-1,1}(x)$.
 <<SM physics: public>>=
   public :: polylog
 <<SM physics: sub interfaces>>=
     module function polylog (n, x) result (plog)
       integer, intent(in) :: n
       real(default), intent(in) :: x
       real(default) :: plog
     end function polylog
 <<SM physics: procedures>>=
   module function polylog (n, x) result (plog)
     integer, intent(in) :: n
     real(default), intent(in) :: x
     real(default) :: plog
     plog = nielsen (n-1,1,x)
   end function polylog
 
 @ %def polylog
 @ $\text{Li}_2(x)$.
 <<SM physics: public>>=
   public :: dilog
 <<SM physics: sub interfaces>>=
     module function dilog (x) result (dlog)
       real(default), intent(in) :: x
       real(default) :: dlog
     end function dilog
 <<SM physics: procedures>>=
   module function dilog (x) result (dlog)
     real(default), intent(in) :: x
     real(default) :: dlog
     dlog = polylog (2,x)
   end function dilog
 
 @ %def dilog
 @ $\text{Li}_3(x)$.
 <<SM physics: public>>=
   public :: trilog
 <<SM physics: sub interfaces>>=
     module function trilog (x) result (tlog)
       real(default), intent(in) :: x
       real(default) :: tlog
     end function trilog
 <<SM physics: procedures>>=
   module function trilog (x) result (tlog)
     real(default), intent(in) :: x
     real(default) :: tlog
     tlog = polylog (3,x)
   end function trilog
 
 @ %def trilog
 @
 \subsection{Loop Integrals}
 These functions appear in the calculation of the effective one-loop coupling of
 a (pseudo)scalar to a vector boson pair.
 <<SM physics: public>>=
   public :: faux
 <<SM physics: sub interfaces>>=
     elemental module function faux (x) result (y)
       real(default), intent(in) :: x
       complex(default) :: y
     end function faux
 <<SM physics: procedures>>=
   elemental module function faux (x) result (y)
     real(default), intent(in) :: x
     complex(default) :: y
     if (1 <= x) then
        y = asin(sqrt(1/x))**2
     else
        y = - 1/4.0_default * (log((1 + sqrt(1 - x))/ &
             (1 - sqrt(1 - x))) - cmplx (0.0_default, pi, kind=default))**2
     end if
   end function faux
 
 @ %def faux
 @
 <<SM physics: public>>=
   public :: fonehalf
 <<SM physics: sub interfaces>>=
     elemental module function fonehalf (x) result (y)
       real(default), intent(in) :: x
       complex(default) :: y
     end function fonehalf
 <<SM physics: procedures>>=
   elemental module function fonehalf (x) result (y)
     real(default), intent(in) :: x
     complex(default) :: y
     if (abs(x) < eps0) then
        y = 0
     else
        y = - 2.0_default * x * (1 + (1 - x) * faux(x))
     end if
   end function fonehalf
 
 @ %def fonehalf
 @
 <<SM physics: public>>=
   public :: fonehalf_pseudo
 <<SM physics: sub interfaces>>=
     module function fonehalf_pseudo (x) result (y)
       real(default), intent(in) :: x
       complex(default) :: y
     end function fonehalf_pseudo
 <<SM physics: procedures>>=
   module function fonehalf_pseudo (x) result (y)
     real(default), intent(in) :: x
     complex(default) :: y
     if (abs(x) < eps0) then
        y = 0
     else
        y = - 2.0_default * x * faux(x)
     end if
   end function fonehalf_pseudo
 
 @ %def fonehalf_pseudo
 @
 <<SM physics: public>>=
   public :: fone
 <<SM physics: sub interfaces>>=
     elemental module function fone (x) result  (y)
       real(default), intent(in) :: x
       complex(default) :: y
     end function fone
 <<SM physics: procedures>>=
   elemental module function fone (x) result  (y)
     real(default), intent(in) :: x
     complex(default) :: y
     if (abs(x) < eps0) then
        y = 2.0_default
     else
        y = 2.0_default + 3.0_default * x + &
             3.0_default * x * (2.0_default - x) * &
             faux(x)
     end if
   end function fone
 
 @ %def fone
 @
 <<SM physics: public>>=
   public :: gaux
 <<SM physics: sub interfaces>>=
     elemental module function gaux (x) result (y)
       real(default), intent(in) :: x
       complex(default) :: y
     end function gaux
 <<SM physics: procedures>>=
   elemental module function gaux (x) result (y)
     real(default), intent(in) :: x
     complex(default) :: y
     if (1 <= x) then
        y = sqrt(x - 1) * asin(sqrt(1/x))
     else
        y = sqrt(1 - x) * (log((1 + sqrt(1 - x)) / &
             (1 - sqrt(1 - x))) - &
             cmplx (0.0_default, pi, kind=default)) / 2.0_default
     end if
   end function gaux
 
 @ %def gaux
 @
 <<SM physics: public>>=
   public :: tri_i1
 <<SM physics: sub interfaces>>=
     elemental module function tri_i1 (a,b) result (y)
       real(default), intent(in) :: a,b
       complex(default) :: y
     end function tri_i1
 <<SM physics: procedures>>=
   elemental module function tri_i1 (a,b) result (y)
     real(default), intent(in) :: a,b
     complex(default) :: y
     if (a < eps0 .or. b < eps0) then
        y = 0
     else
        y = a*b/2.0_default/(a-b) + a**2 * b**2/2.0_default/(a-b)**2 * &
             (faux(a) - faux(b)) + &
             a**2 * b/(a-b)**2 * (gaux(a) - gaux(b))
     end if
   end function tri_i1
 
 @ %def tri_i1
 @
 <<SM physics: public>>=
   public :: tri_i2
 <<SM physics: sub interfaces>>=
     elemental module function tri_i2 (a,b) result (y)
       real(default), intent(in) :: a,b
       complex(default) :: y
     end function tri_i2
 <<SM physics: procedures>>=
   elemental module function tri_i2 (a,b) result (y)
     real(default), intent(in) :: a,b
     complex(default) :: y
     if (a < eps0 .or. b < eps0) then
        y = 0
     else
        y = - a * b / 2.0_default / (a-b) * (faux(a) - faux(b))
     end if
   end function tri_i2
 
 @ %def tri_i2
 @
 \subsection{More on $\alpha_s$}
 These functions are for the running of the strong coupling constants,
 $\alpha_s$.
 <<SM physics: public>>=
   public :: run_b0
 <<SM physics: sub interfaces>>=
     elemental module function run_b0 (nf) result (bnull)
       integer, intent(in) :: nf
       real(default) :: bnull
     end function run_b0
 <<SM physics: procedures>>=
   elemental module function run_b0 (nf) result (bnull)
     integer, intent(in) :: nf
     real(default) :: bnull
     bnull = 33.0_default - 2.0_default * nf
   end function run_b0
 
 @ %def run_b0
 @
 <<SM physics: public>>=
   public :: run_b1
 <<SM physics: sub interfaces>>=
     elemental module function run_b1 (nf) result (bone)
       integer, intent(in) :: nf
       real(default) :: bone
     end function run_b1
 <<SM physics: procedures>>=
   elemental module function run_b1 (nf) result (bone)
     integer, intent(in) :: nf
     real(default) :: bone
     bone = 6.0_default * (153.0_default - 19.0_default * nf)/run_b0(nf)**2
   end function run_b1
 
 @ %def run_b1
 @
 <<SM physics: public>>=
   public :: run_aa
 <<SM physics: sub interfaces>>=
     elemental module function run_aa (nf) result (aaa)
         integer, intent(in) :: nf
         real(default) :: aaa
     end function run_aa
 <<SM physics: procedures>>=
   elemental module function run_aa (nf) result (aaa)
     integer, intent(in) :: nf
     real(default) :: aaa
     aaa = 12.0_default * PI / run_b0(nf)
   end function run_aa
 
 @ %def run_aa
 @
 <<SM physics: pubic functions>>=
   public :: run_bb
 <<SM physics: procedures>>=
   elemental function run_bb (nf) result (bbb)
     integer, intent(in) :: nf
     real(default) :: bbb
     bbb = run_b1(nf) / run_aa(nf)
   end function run_bb
 
 @ %def run_bb
 @
 \subsection{Functions for Catani-Seymour dipoles}
 
 For the automated Catani-Seymour dipole subtraction, we need the
 following functions.
 
 <<SM physics: public>>=
   public :: ff_dipole
 <<SM physics: sub interfaces>>=
     pure module subroutine ff_dipole (v_ijk, y_ijk, p_ij, pp_k, p_i, p_j, p_k)
       type(vector4_t), intent(in) :: p_i, p_j, p_k
       type(vector4_t), intent(out) :: p_ij, pp_k
       real(default), intent(out) :: y_ijk
       real(default), intent(out) :: v_ijk
     end subroutine ff_dipole
 <<SM physics: procedures>>=
   pure module subroutine ff_dipole (v_ijk, y_ijk, p_ij, pp_k, p_i, p_j, p_k)
     type(vector4_t), intent(in) :: p_i, p_j, p_k
     type(vector4_t), intent(out) :: p_ij, pp_k
     real(default), intent(out) :: y_ijk
     real(default) :: z_i
     real(default), intent(out) :: v_ijk
     z_i   = (p_i*p_k) / ((p_k*p_j) + (p_k*p_i))
     y_ijk = (p_i*p_j) / ((p_i*p_j) + (p_i*p_k) + (p_j*p_k))
     p_ij  = p_i + p_j - y_ijk/(1.0_default - y_ijk) * p_k
     pp_k  = (1.0/(1.0_default - y_ijk)) * p_k
     !!! We don't multiply by alpha_s right here:
     v_ijk = 8.0_default * PI * CF * &
          (2.0 / (1.0 - z_i*(1.0 - y_ijk)) - (1.0 + z_i))
   end subroutine ff_dipole
 
 @ %def ff_dipole
 @
 <<SM physics: public>>=
   public :: fi_dipole
 <<SM physics: sub interfaces>>=
     pure module subroutine fi_dipole (v_ija, x_ija, p_ij, pp_a, p_i, p_j, p_a)
       type(vector4_t), intent(in) :: p_i,  p_j,  p_a
       type(vector4_t), intent(out) :: p_ij, pp_a
       real(default), intent(out) :: x_ija
       real(default), intent(out) :: v_ija
     end subroutine fi_dipole
 <<SM physics: procedures>>=
   pure module subroutine fi_dipole (v_ija, x_ija, p_ij, pp_a, p_i, p_j, p_a)
     type(vector4_t), intent(in) :: p_i, p_j, p_a
     type(vector4_t), intent(out) :: p_ij, pp_a
     real(default), intent(out) :: x_ija
     real(default) :: z_i
     real(default), intent(out) :: v_ija
     z_i   = (p_i*p_a) / ((p_a*p_j) + (p_a*p_i))
     x_ija = ((p_i*p_a) + (p_j*p_a) - (p_i*p_j)) &
          / ((p_i*p_a) + (p_j*p_a))
     p_ij  = p_i + p_j - (1.0_default - x_ija) * p_a
     pp_a  = x_ija * p_a
     !!! We don't not multiply by alpha_s right here:
     v_ija = 8.0_default * PI * CF * &
          (2.0 / (1.0 - z_i + (1.0 - x_ija)) - (1.0 + z_i)) / x_ija
   end subroutine fi_dipole
 
 @ %def fi_dipole
 @
 <<SM physics: public>>=
   public :: if_dipole
 <<SM physics: sub interfaces>>=
     pure module subroutine if_dipole (v_kja, u_j, p_aj, pp_k, p_k, p_j, p_a)
       type(vector4_t), intent(in) :: p_k, p_j, p_a
       type(vector4_t), intent(out) :: p_aj, pp_k
       real(default), intent(out) :: u_j
       real(default), intent(out) :: v_kja
     end subroutine if_dipole
 <<SM physics: procedures>>=
   pure module subroutine if_dipole (v_kja, u_j, p_aj, pp_k, p_k, p_j, p_a)
     type(vector4_t), intent(in) :: p_k, p_j, p_a
     type(vector4_t), intent(out) :: p_aj, pp_k
     real(default), intent(out) :: u_j
     real(default) :: x_kja
     real(default), intent(out) :: v_kja
     u_j   = (p_a*p_j) / ((p_a*p_j) + (p_a*p_k))
     x_kja = ((p_a*p_k) + (p_a*p_j) - (p_j*p_k)) &
          / ((p_a*p_j) + (p_a*p_k))
     p_aj  = x_kja * p_a
     pp_k  = p_k + p_j - (1.0_default - x_kja) * p_a
     v_kja = 8.0_default * PI * CF * &
          (2.0 / (1.0 - x_kja + u_j) - (1.0 + x_kja)) / x_kja
   end subroutine if_dipole
 
 @ %def if_dipole
 @ This function depends on a variable number of final state particles
 whose kinematics all get changed by the initial-initial dipole insertion.
 <<SM physics: public>>=
   public :: ii_dipole
 <<SM physics: sub interfaces>>=
     pure module subroutine ii_dipole (v_jab, v_j, p_in, p_out, flag_1or2)
       type(vector4_t), dimension(:), intent(in) :: p_in
       type(vector4_t), dimension(size(p_in)-1), intent(out) :: p_out
       logical, intent(in) :: flag_1or2
       real(default), intent(out) :: v_j
       real(default), intent(out) :: v_jab
     end subroutine ii_dipole
 <<SM physics: procedures>>=
   pure module subroutine ii_dipole (v_jab, v_j, p_in, p_out, flag_1or2)
     type(vector4_t), dimension(:), intent(in) :: p_in
     type(vector4_t), dimension(size(p_in)-1), intent(out) :: p_out
     logical, intent(in) :: flag_1or2
     real(default), intent(out) :: v_j
     real(default), intent(out) :: v_jab
     type(vector4_t) :: p_a, p_b, p_j
     type(vector4_t) :: k, kk
     type(vector4_t) :: p_aj
     real(default) :: x_jab
     integer :: i
     !!! flag_1or2 decides whether this a 12 or 21 dipole
     if (flag_1or2) then
        p_a = p_in(1)
        p_b = p_in(2)
     else
        p_b = p_in(1)
        p_a = p_in(2)
     end if
     !!! We assume that the unresolved particle has always the last
     !!! momentum
     p_j = p_in(size(p_in))
     x_jab = ((p_a*p_b) - (p_a*p_j) - (p_b*p_j)) / (p_a*p_b)
     v_j = (p_a*p_j) / (p_a * p_b)
     p_aj  = x_jab * p_a
     k     = p_a + p_b - p_j
     kk    = p_aj + p_b
     do i = 3, size(p_in)-1
        p_out(i) = p_in(i) - 2.0*((k+kk)*p_in(i))/((k+kk)*(k+kk)) * (k+kk) + &
             (2.0 * (k*p_in(i)) / (k*k)) * kk
     end do
     if (flag_1or2) then
        p_out(1) = p_aj
        p_out(2) = p_b
     else
        p_out(1) = p_b
        p_out(2) = p_aj
     end if
     v_jab = 8.0_default * PI * CF * &
          (2.0 / (1.0 - x_jab) - (1.0 + x_jab)) / x_jab
   end subroutine ii_dipole
 @ %def ii_dipole
 @
 \subsection{Distributions for integrated dipoles and such}
 Note that the following formulae are only meaningful for
 $0 \leq x \leq 1$.
 
 The Dirac delta distribution, modified for Monte-Carlo sampling,
 centered at $x=1-\frac{\epsilon}{2}$:
 
 <<SM physics: public>>=
   public :: delta
 <<SM physics: sub interfaces>>=
     elemental module function delta (x,eps) result (z)
        real(default), intent(in) :: x, eps
        real(default) :: z
     end function delta
 <<SM physics: procedures>>=
   elemental module function delta (x,eps) result (z)
      real(default), intent(in) :: x, eps
      real(default) :: z
      if (x > one - eps) then
         z = one / eps
      else
         z = 0
      end if
   end function delta
 
 @ %def delta
 @ The $+$-distribution, $P_+(x) = \left( \frac{1}{1-x}\right)_+$, for
 the regularization of soft-collinear singularities. The constant part
 for the Monte-Carlo sampling is the integral over the splitting
 function divided by the weight for the WHIZARD numerical integration
 over the interval.
 <<SM physics: public>>=
   public :: plus_distr
 <<SM physics: sub interfaces>>=
     elemental module function plus_distr (x,eps) result (plusd)
       real(default), intent(in) :: x, eps
       real(default) :: plusd
     end function plus_distr
 <<SM physics: procedures>>=
   elemental module function plus_distr (x,eps) result (plusd)
     real(default), intent(in) :: x, eps
     real(default) :: plusd
     if (x > one - eps) then
        plusd = log(eps) / eps
     else
        plusd = one / (one - x)
     end if
   end function plus_distr
 
 @ %def plus_distr
 @ The splitting function in $D=4$ dimensions, regularized as
 $+$-distributions if necessary:
 \begin{align}
   P^{qq} (x) = P^{\bar q\bar q} (x) &= \; C_F \cdot \left( \frac{1 +
       x^2}{1-x} \right)_+ \\
   P^{qg} (x) = P^{\bar q g}     (x) &= \; C_F  \cdot \frac{1 + (1-x)^2}{x}\\
   P^{gq} (x) = P^{g \bar q}     (x) &= \; T_R \cdot \left[ x^2 + (1-x)^2
   \right] \\
   P^{gg} (x) &= \; 2 C_A \biggl[ \left( \frac{1}{1-x} \right)_+ +
                  \frac{1-x}{x} - 1 + x(1-x) \biggl] \notag{}\\
              &\quad + \delta(1-x) \left( \frac{11}{6} C_A -
                                           \frac{2}{3} N_f T_R \right)
 \end{align}
 Since the number of flavors summed over in the gluon splitting
 function might depend on the physics case under consideration, it is
 implemented as an input variable.
 <<SM physics: public>>=
   public :: pqq
 <<SM physics: sub interfaces>>=
     elemental module function pqq (x,eps) result (pqqx)
       real(default), intent(in) :: x, eps
       real(default) :: pqqx
     end function pqq
 <<SM physics: procedures>>=
   elemental module function pqq (x,eps) result (pqqx)
     real(default), intent(in) :: x, eps
     real(default) :: pqqx
     if (x > (1.0_default - eps)) then
        pqqx = (eps - one) / two + two * log(eps) / eps - &
             three * (eps - one) / eps / two
     else
        pqqx = (one + x**2) / (one - x)
     end if
     pqqx = CF * pqqx
   end function pqq
 
 @ %def pqq
 @
 <<SM physics: public>>=
   public :: pgq
 <<SM physics: sub interfaces>>=
     elemental module function pgq (x) result (pgqx)
       real(default), intent(in) :: x
       real(default) :: pgqx
     end function pgq
 <<SM physics: procedures>>=
   elemental module function pgq (x) result (pgqx)
     real(default), intent(in) :: x
     real(default) :: pgqx
     pgqx = TR * (x**2 + (one - x)**2)
   end function pgq
 
 @ %def pgq
 @
 <<SM physics: public>>=
   public :: pqg
 <<SM physics: sub interfaces>>=
     elemental module function pqg (x) result (pqgx)
       real(default), intent(in) :: x
       real(default) :: pqgx
     end function pqg
 <<SM physics: procedures>>=
   elemental module function pqg (x) result (pqgx)
     real(default), intent(in) :: x
     real(default) :: pqgx
     pqgx = CF * (one + (one - x)**2) / x
   end function pqg
 
 @ %def pqg
 @
 <<SM physics: public>>=
   public :: pgg
 <<SM physics: sub interfaces>>=
     elemental module function pgg (x, nf, eps) result (pggx)
       real(default), intent(in) :: x, nf, eps
       real(default) :: pggx
     end function pgg
 <<SM physics: procedures>>=
   elemental module function pgg (x, nf, eps) result (pggx)
     real(default), intent(in) :: x, nf, eps
     real(default) :: pggx
     pggx = two * CA * ( plus_distr (x, eps) + (one-x)/x - one + &
                    x*(one-x)) + delta (x, eps)  * gamma_g(nf)
   end function pgg
 
 @ %def pgg
 @ For the $qq$ and $gg$ cases, there exist ``regularized'' versions of
 the splitting functions:
 \begin{align}
   P^{qq}_{\text{reg}} (x) &= - C_F \cdot (1 + x) \\
   P^{gg}_{\text{reg}} (x) &= 2 C_A \left[ \frac{1-x}{x} - 1 + x(1-x) \right]
 \end{align}
 <<SM physics: public>>=
   public :: pqq_reg
 <<SM physics: sub interfaces>>=
     elemental module function pqq_reg (x) result (pqqregx)
        real(default), intent(in) :: x
        real(default) :: pqqregx
     end function pqq_reg
 <<SM physics: procedures>>=
   elemental module function pqq_reg (x) result (pqqregx)
      real(default), intent(in) :: x
      real(default) :: pqqregx
      pqqregx = - CF * (one + x)
   end function pqq_reg
 
 @ %def pqq_reg
 @
 <<SM physics: public>>=
   public :: pgg_reg
 <<SM physics: sub interfaces>>=
     elemental module function pgg_reg (x) result (pggregx)
        real(default), intent(in) :: x
        real(default) :: pggregx
     end function pgg_reg
 <<SM physics: procedures>>=
   elemental module function pgg_reg (x) result (pggregx)
      real(default), intent(in) :: x
      real(default) :: pggregx
      pggregx = two * CA * ((one - x)/x - one + x*(one - x))
   end function pgg_reg
 
 @ %def pgg_reg
 @ Here, we collect the expressions needed for integrated
 Catani-Seymour dipoles, and the so-called flavor kernels. We always
 distinguish between the ``ordinary'' Catani-Seymour version, and the
 one including a phase-space slicing parameter, $\alpha$.
 
 The standard flavor kernels $\overline{K}^{ab}$ are:
 \begin{align}
   \overline{K}^{qg} (x) = \overline{K}^{\bar q g} (x) & = \;
   P^{qg} (x) \log ((1-x)/x) + CF \times x \\
   %%%
   \overline{K}^{gq} (x) = \overline{K}^{g \bar q} (x) & = \;
   P^{gq} (x) \log ((1-x)/x) + TR \times 2x(1-x) \\
   %%%
   \overline{K}^{qq} &=\; C_F \biggl[ \left( \frac{2}{1-x} \log
   \frac{1-x}{x} \right)_+ - (1+x) \log ((1-x)/x)  +
   (1-x) \biggr] \notag{}\\
                     &\quad - (5 - \pi^2) \cdot C_F \cdot \delta(1-x) \\
   %%%
   \overline{K}^{gg} &=\; 2 C_A \biggl[ \left( \frac{1}{1-x} \log
     \frac{1-x}{x} \right)_+ + \left( \frac{1-x}{x} - 1 + x(1-x)
   \right) \log((1-x)/x) \biggr] \notag{}\\
                     &\quad - \delta(1-x) \biggl[ \left(
     \frac{50}{9} - \pi^2 \right) C_A - \frac{16}{9} T_R N_f \biggr]
 \end{align}
 <<SM physics: public>>=
   public :: kbarqg
 <<SM physics: sub interfaces>>=
     module function kbarqg (x) result (kbarqgx)
       real(default), intent(in) :: x
       real(default) :: kbarqgx
     end function kbarqg
 <<SM physics: procedures>>=
   module function kbarqg (x) result (kbarqgx)
     real(default), intent(in) :: x
     real(default) :: kbarqgx
     kbarqgx = pqg(x) * log((one-x)/x) + CF * x
   end function kbarqg
 
 @ %def kbarqg
 @
 <<SM physics: public>>=
   public :: kbargq
 <<SM physics: sub interfaces>>=
     module function kbargq (x) result (kbargqx)
       real(default), intent(in) :: x
       real(default) :: kbargqx
     end function kbargq
 <<SM physics: procedures>>=
   module function kbargq (x) result (kbargqx)
     real(default), intent(in) :: x
     real(default) :: kbargqx
     kbargqx = pgq(x) * log((one-x)/x) + two * TR * x * (one - x)
   end function kbargq
 
 @ %def kbarqg
 @
 <<SM physics: public>>=
   public :: kbarqq
 <<SM physics: sub interfaces>>=
     module function kbarqq (x,eps) result (kbarqqx)
       real(default), intent(in) :: x, eps
       real(default) :: kbarqqx
     end function kbarqq
 <<SM physics: procedures>>=
   module function kbarqq (x,eps) result (kbarqqx)
     real(default), intent(in) :: x, eps
     real(default) :: kbarqqx
     kbarqqx = CF*(log_plus_distr(x,eps) - (one+x) * log((one-x)/x) + (one - &
          x) - (five - pi**2) * delta(x,eps))
   end function kbarqq
 
 @ %def kbarqq
 @
 <<SM physics: public>>=
   public :: kbargg
 <<SM physics: sub interfaces>>=
     module function kbargg (x,eps,nf) result (kbarggx)
       real(default), intent(in) :: x, eps, nf
       real(default) :: kbarggx
     end function kbargg
 <<SM physics: procedures>>=
   module function kbargg (x,eps,nf) result (kbarggx)
     real(default), intent(in) :: x, eps, nf
     real(default) :: kbarggx
     kbarggx = CA * (log_plus_distr(x,eps) + two * ((one-x)/x - one + &
                          x*(one-x) * log((1-x)/x))) - delta(x,eps) * &
                          ((50.0_default/9.0_default - pi**2) * CA - &
                          16.0_default/9.0_default * TR * nf)
   end function kbargg
 
 @ %def kbargg
 @ The $\tilde{K}$ are used when two identified hadrons participate:
 \begin{equation}
     \tilde{K}^{ab} (x) = P^{ab}_{\text{reg}} (x) \cdot \log (1-x) +
     \delta^{ab} \mathbf{T}_a^2 \biggl[ \left( \frac{2}{1-x} \log (1-x)
     \right)_+ - \frac{\pi^2}{3} \delta(1-x) \biggr]
 \end{equation}
 
 <<SM physics: public>>=
   public :: ktildeqq
 <<SM physics: sub interfaces>>=
     module function ktildeqq (x,eps) result (ktildeqqx)
       real(default), intent(in) :: x, eps
       real(default) :: ktildeqqx
     end function ktildeqq
 <<SM physics: procedures>>=
   module function ktildeqq (x,eps) result (ktildeqqx)
     real(default), intent(in) :: x, eps
     real(default) :: ktildeqqx
     ktildeqqx = pqq_reg (x) * log(one-x) + CF * ( - log2_plus_distr (x,eps) &
                           - pi**2/three * delta(x,eps))
   end function ktildeqq
 
 @ %def ktildeqq
 @
 <<SM physics: public>>=
   public :: ktildeqg
 <<SM physics: sub interfaces>>=
     module function ktildeqg (x,eps) result (ktildeqgx)
       real(default), intent(in) :: x, eps
       real(default) :: ktildeqgx
     end function ktildeqg
 <<SM physics: procedures>>=
   module function ktildeqg (x,eps) result (ktildeqgx)
     real(default), intent(in) :: x, eps
     real(default) :: ktildeqgx
     ktildeqgx = pqg (x) * log(one-x)
   end function ktildeqg
 
 @ %def ktildeqg
 @
 <<SM physics: public>>=
   public :: ktildegq
 <<SM physics: sub interfaces>>=
     module function ktildegq (x,eps) result (ktildegqx)
       real(default), intent(in) :: x, eps
       real(default) :: ktildegqx
     end function ktildegq
 <<SM physics: procedures>>=
   module function ktildegq (x,eps) result (ktildegqx)
     real(default), intent(in) :: x, eps
     real(default) :: ktildegqx
     ktildegqx = pgq (x) * log(one-x)
   end function ktildegq
 
 @ %def ktildeqg
 @
 <<SM physics: public>>=
   public :: ktildegg
 <<SM physics: sub interfaces>>=
     module function ktildegg (x,eps) result (ktildeggx)
       real(default), intent(in) :: x, eps
       real(default) :: ktildeggx
     end function ktildegg
 <<SM physics: procedures>>=
   module function ktildegg (x,eps) result (ktildeggx)
     real(default), intent(in) :: x, eps
     real(default) :: ktildeggx
     ktildeggx = pgg_reg (x) * log(one-x) + CA * ( - &
        log2_plus_distr (x,eps) - pi**2/three * delta(x,eps))
   end function ktildegg
 
 @ %def ktildegg
 @ The insertion operator might not be necessary for a GOLEM interface
 but is demanded by the Les Houches NLO accord. It is a
 three-dimensional array, where the index always gives the inverse
 power of the DREG expansion parameter, $\epsilon$.
 <<SM physics: public>>=
   public :: insert_q
 <<SM physics: sub interfaces>>=
     pure module function insert_q () result (i_q)
       real(default), dimension(0:2) :: i_q
     end function insert_q
 <<SM physics: procedures>>=
   pure module function insert_q () result (i_q)
     real(default), dimension(0:2) :: i_q
     i_q(0) = gamma_q + k_q - pi**2/three * CF
     i_q(1) = gamma_q
     i_q(2) = CF
   end function insert_q
 
 @ %def insert_q
 @
 <<SM physics: public>>=
   public :: insert_g
 <<SM physics: sub interfaces>>=
     pure module function insert_g (nf) result (i_g)
       real(default), intent(in) :: nf
       real(default), dimension(0:2) :: i_g
     end function insert_g
 <<SM physics: procedures>>=
   pure module function insert_g (nf) result (i_g)
     real(default), intent(in) :: nf
     real(default), dimension(0:2) :: i_g
     i_g(0) = gamma_g (nf) + k_g (nf) - pi**2/three * CA
     i_g(1) = gamma_g (nf)
     i_g(2) = CA
   end function insert_g
 
 @ %def insert_g
 @ For better convergence, one can exclude regions of phase space with
 a slicing parameter from the dipole subtraction procedure. First of
 all, the $K$ functions get modified:
 \begin{equation}
   K_i (\alpha) = K_i - \mathbf{T}_i^2 \log^2 \alpha + \gamma_i (
   \alpha - 1 - \log\alpha)
 \end{equation}
 <<SM physics: public>>=
   public :: k_q_al, k_g_al
 <<SM physics: sub interfaces>>=
     pure module function k_q_al (alpha)
       real(default), intent(in) :: alpha
       real(default) :: k_q_al
     end function k_q_al
     pure module function k_g_al (alpha, nf)
       real(default), intent(in) :: alpha, nf
       real(default) :: k_g_al
     end function k_g_al
 <<SM physics: procedures>>=
   pure module function k_q_al (alpha)
     real(default), intent(in) :: alpha
     real(default) :: k_q_al
     k_q_al = k_q - CF * (log(alpha))**2 + gamma_q * &
                       (alpha - one - log(alpha))
   end function k_q_al
 
   pure module function k_g_al (alpha, nf)
     real(default), intent(in) :: alpha, nf
     real(default) :: k_g_al
     k_g_al = k_g (nf) - CA * (log(alpha))**2 + gamma_g (nf) * &
                      (alpha - one - log(alpha))
   end function k_g_al
 
 @ %def k_q_al
 @ %def k_g_al
 @ The $+$-distribution, but with a phase-space slicing parameter,
 $\alpha$,  $P_{1-\alpha}(x) = \left( \frac{1}{1-x}
 \right)_{1-x}$. Since we need the fatal error message here, this
 function cannot be elemental.
 <<SM physics: public>>=
   public :: plus_distr_al
 <<SM physics: sub interfaces>>=
     module function plus_distr_al (x,alpha,eps) result (plusd_al)
       real(default), intent(in) :: x,  eps, alpha
       real(default) :: plusd_al
     end function plus_distr_al
 <<SM physics: procedures>>=
   module function plus_distr_al (x,alpha,eps) result (plusd_al)
     real(default), intent(in) :: x,  eps, alpha
     real(default) :: plusd_al
     if ((one - alpha) >= (one - eps)) then
        plusd_al = zero
        call msg_fatal ('sm_physics, plus_distr_al: alpha and epsilon chosen wrongly')
     elseif (x < (1.0_default - alpha)) then
        plusd_al = 0
     else if (x > (1.0_default - eps)) then
        plusd_al = log(eps/alpha)/eps
     else
        plusd_al = one/(one-x)
     end if
   end function plus_distr_al
 
 @ %def plus_distr_al
 @ Introducing phase-space slicing parameters, these standard flavor
 kernels $\overline{K}^{ab}$ become:
 \begin{align}
   \overline{K}^{qg}_\alpha (x) = \overline{K}^{\bar q g}_\alpha (x) & = \;
   P^{qg} (x) \log (\alpha (1-x)/x) + C_F \times x \\
   %%%
   \overline{K}^{gq}_\alpha (x) = \overline{K}^{g \bar q}_\alpha (x) & = \;
   P^{gq} (x) \log (\alpha (1-x)/x) + T_R \times 2x(1-x) \\
   %%%
   \overline{K}^{qq}_\alpha &=
       C_F  (1 - x) + P^{qq}_{\text{reg}} (x) \log \frac{\alpha(1-x)}{x}
       \notag{}\\           &\quad
       + C_F \delta (1 - x) \log^2 \alpha
       + C_F \left( \frac{2}{1-x} \log \frac{1-x}{x} \right)_+ \notag{}\\
                            &\quad
       - \left( \gamma_q + K_q(\alpha) - \frac56 \pi^2 C_F \right) \cdot
       \delta(1-x) \; C_F \Bigl[ + \frac{2}{1-x}  \log \left(
       \frac{\alpha (2-x)}{1+\alpha-x} \right)
       - \theta(1 - \alpha - x) \cdot \left( \frac{2}{1-x} \log
       \frac{2-x}{1-x} \right) \Bigr] \\
   %%%
   \overline{K}^{gg}_\alpha &=\;
        P^{gg}_{\text{reg}} (x) \log \frac{\alpha(1-x)}{x}
       + C_A \delta (1 - x) \log^2 \alpha  \notag{}\\
                            &\quad
       + C_A \left( \frac{2}{1-x} \log \frac{1-x}{x} \right)_+
        - \left( \gamma_g + K_g(\alpha) - \frac56 \pi^2 C_A \right) \cdot
        \delta(1-x) \; C_A \Bigl[ + \frac{2}{1-x}  \log \left(
        \frac{\alpha (2-x)}{1+\alpha-x} \right)
       - \theta(1 - \alpha - x) \cdot \left( \frac{2}{1-x} \log
       \frac{2-x}{1-x} \right) \Bigr]
 \end{align}
 <<SM physics: public>>=
   public :: kbarqg_al
 <<SM physics: sub interfaces>>=
     module function kbarqg_al (x,alpha,eps) result (kbarqgx)
       real(default), intent(in) :: x, alpha, eps
       real(default) :: kbarqgx
     end function kbarqg_al
 <<SM physics: procedures>>=
   module function kbarqg_al (x,alpha,eps) result (kbarqgx)
     real(default), intent(in) :: x, alpha, eps
     real(default) :: kbarqgx
     kbarqgx = pqg (x) * log(alpha*(one-x)/x) + CF * x
   end function kbarqg_al
 @ %def kbarqg_al
 @
 
 <<SM physics: public>>=
   public :: kbargq_al
 <<SM physics: sub interfaces>>=
     module function kbargq_al (x,alpha,eps) result (kbargqx)
       real(default), intent(in) :: x, alpha, eps
       real(default) :: kbargqx
     end function kbargq_al
 <<SM physics: procedures>>=
   module function kbargq_al (x,alpha,eps) result (kbargqx)
     real(default), intent(in) :: x, alpha, eps
     real(default) :: kbargqx
     kbargqx = pgq (x) * log(alpha*(one-x)/x) + two * TR * x * (one-x)
   end function kbargq_al
 @ %def kbargq_al
 @
 
 <<SM physics: public>>=
   public :: kbarqq_al
 <<SM physics: sub interfaces>>=
     module function kbarqq_al (x,alpha,eps) result (kbarqqx)
       real(default), intent(in) :: x, alpha, eps
       real(default) :: kbarqqx
     end function kbarqq_al
 <<SM physics: procedures>>=
   module function kbarqq_al (x,alpha,eps) result (kbarqqx)
     real(default), intent(in) :: x, alpha, eps
     real(default) :: kbarqqx
     kbarqqx = CF * (one - x) + pqq_reg(x) * log(alpha*(one-x)/x) &
          + CF * log_plus_distr(x,eps) &
          - (gamma_q + k_q_al(alpha) - CF * &
          five/6.0_default  * pi**2 - CF * (log(alpha))**2) * &
          delta(x,eps) + &
          CF * two/(one -x)*log(alpha*(two-x)/(one+alpha-x))
     if (x < (one-alpha)) then
        kbarqqx = kbarqqx - CF * two/(one-x) * log((two-x)/(one-x))
     end if
   end function kbarqq_al
 
 @ %def kbarqq_al
 <<SM physics: public>>=
   public :: kbargg_al
 <<SM physics: sub interfaces>>=
     module function kbargg_al (x,alpha,eps,nf) result (kbarggx)
       real(default), intent(in) :: x, alpha, eps, nf
       real(default) :: kbarggx
     end function kbargg_al
 <<SM physics: procedures>>=
   module function kbargg_al (x,alpha,eps,nf) result (kbarggx)
     real(default), intent(in) :: x, alpha, eps, nf
     real(default) :: kbarggx
     kbarggx = pgg_reg(x) * log(alpha*(one-x)/x) &
          + CA * log_plus_distr(x,eps) &
          - (gamma_g(nf) + k_g_al(alpha,nf) - CA * &
          five/6.0_default  * pi**2 - CA * (log(alpha))**2) * &
          delta(x,eps) + &
          CA * two/(one -x)*log(alpha*(two-x)/(one+alpha-x))
     if (x < (one-alpha)) then
        kbarggx = kbarggx - CA * two/(one-x) * log((two-x)/(one-x))
     end if
   end function kbargg_al
 
 @ %def kbargg_al
 @ The $\tilde{K}$ flavor kernels in the presence of a phase-space slicing
 parameter, are:
 \begin{equation}
   \tilde{K}^{ab} (x,\alpha) = P^{qq, \text{reg}} (x)
   \log\frac{1-x}{\alpha} + ..........
 \end{equation}
 <<SM physics: public>>=
   public :: ktildeqq_al
 <<SM physics: sub interfaces>>=
     module function ktildeqq_al (x,alpha,eps) result (ktildeqqx)
       real(default), intent(in) :: x, eps, alpha
       real(default) :: ktildeqqx
     end function ktildeqq_al
 <<SM physics: procedures>>=
   module function ktildeqq_al (x,alpha,eps) result (ktildeqqx)
     real(default), intent(in) :: x, eps, alpha
     real(default) :: ktildeqqx
     ktildeqqx = pqq_reg(x) * log((one-x)/alpha) + CF*( &
          - log2_plus_distr_al(x,alpha,eps) - Pi**2/three * delta(x,eps) &
          + (one+x**2)/(one-x) * log(min(one,(alpha/(one-x)))) &
          + two/(one-x) * log((one+alpha-x)/alpha))
     if (x > (one-alpha)) then
        ktildeqqx = ktildeqqx - CF*two/(one-x)*log(two-x)
     end if
   end function ktildeqq_al
 
 @ %def ktildeqq_al
 @ This is a logarithmic $+$-distribution, $\left(
   \frac{\log((1-x)/x)}{1-x} \right)_+$. For the sampling, we need the
 integral over this function over the incomplete sampling interval
 $[0,1-\epsilon]$, which is $\log^2(x) + 2 Li_2(x) -
 \frac{\pi^2}{3}$. As this function is negative definite for $\epsilon
 > 0.1816$, we take a hard upper limit for that sampling parameter,
 irrespective of the fact what the user chooses.
 <<SM physics: public>>=
   public :: log_plus_distr
 <<SM physics: sub interfaces>>=
     module function log_plus_distr (x,eps) result (lpd)
        real(default), intent(in) :: x, eps
        real(default) :: lpd, eps2
     end function log_plus_distr
 <<SM physics: procedures>>=
   module function log_plus_distr (x,eps) result (lpd)
      real(default), intent(in) :: x, eps
      real(default) :: lpd, eps2
      eps2 = min (eps, 0.1816_default)
      if (x > (1.0_default - eps2)) then
         lpd = ((log(eps2))**2 + two*Li2(eps2) - pi**2/three)/eps2
      else
         lpd = two*log((one-x)/x)/(one-x)
      end if
   end function log_plus_distr
 
 @ %def log_plus_distr
 @ Logarithmic $+$-distribution, $2 \left( \frac{\log(1/(1-x))}{1-x} \right)_+$.
 <<SM physics: public>>=
   public :: log2_plus_distr
 <<SM physics: sub interfaces>>=
     module function log2_plus_distr (x,eps) result (lpd)
       real(default), intent(in) :: x, eps
       real(default) :: lpd
     end function log2_plus_distr
 <<SM physics: procedures>>=
   module function log2_plus_distr (x,eps) result (lpd)
     real(default), intent(in) :: x, eps
     real(default) :: lpd
     if (x > (1.0_default - eps)) then
        lpd = - (log(eps))**2/eps
     else
        lpd = two*log(one/(one-x))/(one-x)
     end if
   end function log2_plus_distr
 
 @ %def log2_plus_distr
 @ Logarithmic $+$-distribution with phase-space slicing parameter, $2
 \left( \frac{\log(1/(1-x))}{1-x} \right)_{1-\alpha}$.
 <<SM physics: public>>=
   public :: log2_plus_distr_al
 <<SM physics: sub interfaces>>=
     module function log2_plus_distr_al (x,alpha,eps) result (lpd_al)
       real(default), intent(in) :: x, eps, alpha
       real(default) :: lpd_al
     end function log2_plus_distr_al
 <<SM physics: procedures>>=
   module function log2_plus_distr_al (x,alpha,eps) result (lpd_al)
     real(default), intent(in) :: x, eps, alpha
     real(default) :: lpd_al
     if ((one - alpha) >= (one - eps)) then
        lpd_al = zero
        call msg_fatal ('alpha and epsilon chosen wrongly')
     elseif (x < (one - alpha)) then
        lpd_al = 0
     elseif (x > (1.0_default - eps)) then
        lpd_al = - ((log(eps))**2 - (log(alpha))**2)/eps
     else
        lpd_al = two*log(one/(one-x))/(one-x)
     end if
   end function log2_plus_distr_al
 
 @ %def log2_plus_distr_al
 @
 \subsection{Splitting Functions}
 @ Analogue to the regularized distributions of the last subsection, we
 give here the unregularized splitting functions, relevant for the parton
 shower algorithm. We can use this unregularized version since there will
 be a cut-off $\epsilon$ that ensures that $\{z,1-z\}>\epsilon(t)$. This
 cut-off seperates resolvable from unresolvable emissions.
 
 [[p_xxx]] are the kernels that are summed over helicity:
 <<SM physics: public>>=
   public :: p_qqg
   public :: p_gqq
   public :: p_ggg
 @ $q\to q g$
 <<SM physics: sub interfaces>>=
     elemental module function p_qqg (z) result (P)
       real(default), intent(in) :: z
       real(default) :: P
     end function p_qqg
 <<SM physics: procedures>>=
   elemental module function p_qqg (z) result (P)
     real(default), intent(in) :: z
     real(default) :: P
     P = CF * (one + z**2) / (one - z)
   end function p_qqg
 @ $g\to q \bar{q}$
 <<SM physics: sub interfaces>>=
     elemental module function p_gqq (z) result (P)
       real(default), intent(in) :: z
       real(default) :: P
     end function p_gqq
 <<SM physics: procedures>>=
   elemental module function p_gqq (z) result (P)
     real(default), intent(in) :: z
     real(default) :: P
     P = TR * (z**2 + (one - z)**2)
   end function p_gqq
 @ $g\to g g$
 <<SM physics: sub interfaces>>=
     elemental module function p_ggg (z) result (P)
       real(default), intent(in) :: z
       real(default) :: P
     end function p_ggg
 <<SM physics: procedures>>=
   elemental module function p_ggg (z) result (P)
     real(default), intent(in) :: z
     real(default) :: P
     P = NC * ((one - z) / z + z / (one - z) + z * (one - z))
   end function p_ggg
 
 @ %def p_qqg p_gqq p_ggg
 @ Analytically integrated splitting kernels:
 <<SM physics: public>>=
   public :: integral_over_p_qqg
   public :: integral_over_p_gqq
   public :: integral_over_p_ggg
 <<SM physics: sub interfaces>>=
     pure module function integral_over_p_qqg (zmin, zmax) result (integral)
       real(default), intent(in) :: zmin, zmax
       real(default) :: integral
     end function integral_over_p_qqg
     pure module function integral_over_p_gqq (zmin, zmax) result (integral)
       real(default), intent(in) :: zmin, zmax
       real(default) :: integral
     end function integral_over_p_gqq
     pure module function integral_over_p_ggg (zmin, zmax) result (integral)
       real(default), intent(in) :: zmin, zmax
       real(default) :: integral
     end function integral_over_p_ggg
 <<SM physics: procedures>>=
   pure module function integral_over_p_qqg (zmin, zmax) result (integral)
     real(default), intent(in) :: zmin, zmax
     real(default) :: integral
     integral = (two / three) * (- zmax**2 + zmin**2 - &
          two * (zmax - zmin) + four * log((one - zmin) / (one - zmax)))
   end function integral_over_p_qqg
 
   pure module function integral_over_p_gqq (zmin, zmax) result (integral)
     real(default), intent(in) :: zmin, zmax
     real(default) :: integral
     integral = 0.5_default * ((two / three) * &
          (zmax**3 - zmin**3) - (zmax**2 - zmin**2) + (zmax - zmin))
   end function integral_over_p_gqq
 
   pure module function integral_over_p_ggg (zmin, zmax) result (integral)
     real(default), intent(in) :: zmin, zmax
     real(default) :: integral
     integral = three * ((log(zmax) - two * zmax - &
          log(one - zmax) + zmax**2 / two - zmax**3 / three) - &
          (log(zmin) - zmin - zmin - log(one - zmin) + zmin**2 &
          / two - zmin**3 / three) )
   end function integral_over_p_ggg
 
 @ %def integral_over_p_gqq integral_over_p_ggg integral_over_p_qqg
 @ We can also use (massless) helicity dependent splitting functions:
 <<SM physics: public>>=
   public :: p_qqg_pol
 @ $q_a\to q_b g_c$, the helicity of the quark is not changed by gluon
 emission and the gluon is preferably polarized in the branching plane
 ($l_c=1$):
 <<SM physics: sub interfaces>>=
     elemental module function p_qqg_pol (z, l_a, l_b, l_c) result (P)
       real(default), intent(in) :: z
       integer, intent(in) :: l_a, l_b, l_c
       real(default) :: P
     end function p_qqg_pol
 <<SM physics: procedures>>=
   elemental module function p_qqg_pol (z, l_a, l_b, l_c) result (P)
     real(default), intent(in) :: z
     integer, intent(in) :: l_a, l_b, l_c
     real(default) :: P
     if (l_a /= l_b) then
        P = zero
        return
     end if
     if (l_c == -1) then
        P = one - z
     else
        P = (one + z)**2 / (one - z)
     end if
     P = P * CF
   end function p_qqg_pol
 
 @
 \subsubsection{Mellin transforms of splitting functions}
 
 As Mellin transforms necessarily live in the complex plane, all
 functions are defined as complex functions:
 @ Splitting function $P_{qq}(N)$:
 <<SM physics: public>>=
   public :: pqqm
 <<SM physics: sub interfaces>>=
     module function pqqm (n, c_f) result (pqq_m)
       integer, intent(in) :: n
       real(default), intent(in) :: c_f
       complex(default) :: pqq_m
     end function pqqm
 <<SM physics: procedures>>=
   module function pqqm (n, c_f) result (pqq_m)
     integer, intent(in) :: n
     real(default), intent(in) :: c_f
     complex(default) :: pqq_m
     pqq_m = three - four * (eulerc + &
          psic(cmplx(N+1,zero,kind=default))) + two/N/(N+1)
   end function pqqm
 
 @ %def pqqm
 @
 \subsection{Top width}
 In order to produce sensible results, the widths have to be recomputed
 for each parameter and order.
 We start with the LO-expression for the top width given by the decay
 $t\,\to\,W^+,b$, cf. [[doi:10.1016/0550-3213(91)90530-B]]:\\
 The analytic formula given there is
 \begin{equation*}
   \Gamma = \frac{G_F m_t^2}{16\sqrt{2}\pi}
   \left[\mathcal{F}_0(\varepsilon, \xi^{-1/2}) -
     \frac{2\alpha_s}{3\pi} \mathcal{F}_1 (\varepsilon, \xi^{-1/2})\right],
 \end{equation*}
 with
 \begin{align*}
   \mathcal{F}_0 &= \frac{\sqrt{\lambda}}{2} f_0, \\
   f_0 &= 4\left[(1-\varepsilon^2)^2 + w^2(1+\varepsilon^2) - 2w^4\right], \\
   \lambda = 1 + w^4 + \varepsilon^4 - 2(w^2 + \varepsilon^2 + w^2\varepsilon^2).
 \end{align*}
 Defining
 \begin{equation*}
   u_q = \frac{1 + \varepsilon^2 - w^2 - \lambda^{1/2}}{1 +
     \varepsilon^2 - w^2 + \lambda^{1/2}}
 \end{equation*}
 and
 \begin{equation*}
   u_w = \frac{1 - \varepsilon^2 + w^2 - \lambda^{1/2}}{1 -
     \varepsilon^2 + w^2 + \lambda^{1/2}}
 \end{equation*}
 the factor $\mathcal{F}_1$ can be expressed as
 \begin{align*}
   \mathcal{F}_1 = \frac{1}{2}f_0(1+\varepsilon^2-w^2)
   & \left[\pi^2 + 2Li_2(u_w) - 2Li_2(1-u_w) - 4Li_2(u_q) \right. \\
     & -4Li_2(u_q u_w) + \log\left(\frac{1-u_q}{w^2}\right)\log(1-u_q)
     - \log^2(1-u_q u_w) \\
     & \left.+\frac{1}{4}\log^2\left(\frac{w^2}{u_w}\right) - \log(u_w)
     \log\left[\frac{(1-u_q u_w)^2}{1-u_q}\right]
     -2\log(u_q)\log\left[(1-u_q)(1-u_q u_w)\right]\right] \\
   & -\sqrt{\lambda}f_0(2\log(w) + 3\log(\varepsilon) - 2\log{\lambda}) \\
   &  +4(1-\varepsilon^2)\left[(1-\varepsilon^2)^2 +
     w^2(1+\varepsilon^2) - 4w^4\right]\log(u_w) \\
   & \left[(3 - \varepsilon^2 + 11\varepsilon^4 - \varepsilon^6)
     + w^2(6 - 12\varepsilon^2 +2\varepsilon^4) - w^4(21 +
     5\varepsilon^2) + 12w^6\right] \log(u_q) \\
   & 6\sqrt{\lambda} (1-\varepsilon^2) (1 + \varepsilon^2 - w^2)
   \log(\varepsilon)
   + \sqrt{\lambda}\left[-5 + 22\varepsilon^2 - 5\varepsilon^4 -
     9w^2(1+\varepsilon^2) + 6w^4\right].
 \end{align*}
 @
 <<SM physics: public>>=
   public :: top_width_sm_lo
 <<SM physics: sub interfaces>>=
     elemental module function top_width_sm_lo (alpha, sinthw, vtb, mtop, mw, mb) &
            result (gamma)
       real(default) :: gamma
       real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb
     end function top_width_sm_lo
 <<SM physics: procedures>>=
   elemental module function top_width_sm_lo (alpha, sinthw, vtb, mtop, mw, mb) &
          result (gamma)
     real(default) :: gamma
     real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb
     real(default) :: kappa
     kappa = sqrt ((mtop**2 - (mw + mb)**2) * (mtop**2 - (mw - mb)**2))
     gamma = alpha / four * mtop / (two * sinthw**2) * &
          vtb**2 * kappa / mtop**2 * &
          ((mtop**2 + mb**2) / (two * mtop**2) + &
           (mtop**2 - mb**2)**2 / (two * mtop**2 * mw**2) - &
            mw**2 / mtop**2)
   end function top_width_sm_lo
 
 @ %def top_width_sm_lo
 @
 <<SM physics: public>>=
   public :: g_mu_from_alpha
 <<SM physics: sub interfaces>>=
     elemental module function g_mu_from_alpha (alpha, mw, sinthw) result (g_mu)
       real(default) :: g_mu
       real(default), intent(in) :: alpha, mw, sinthw
     end function g_mu_from_alpha
 <<SM physics: procedures>>=
   elemental module function g_mu_from_alpha (alpha, mw, sinthw) result (g_mu)
     real(default) :: g_mu
     real(default), intent(in) :: alpha, mw, sinthw
     g_mu = pi * alpha / sqrt(two) / mw**2 / sinthw**2
   end function g_mu_from_alpha
 
 @ %def g_mu_from_alpha
 @
 <<SM physics: public>>=
   public :: alpha_from_g_mu
 <<SM physics: sub interfaces>>=
     elemental module function alpha_from_g_mu (g_mu, mw, sinthw) result (alpha)
       real(default) :: alpha
       real(default), intent(in) :: g_mu, mw, sinthw
     end function alpha_from_g_mu
 <<SM physics: procedures>>=
   elemental module function alpha_from_g_mu (g_mu, mw, sinthw) result (alpha)
     real(default) :: alpha
     real(default), intent(in) :: g_mu, mw, sinthw
     alpha = g_mu * sqrt(two) / pi * mw**2 * sinthw**2
   end function alpha_from_g_mu
 
 @ %def alpha_from_g_mu
 @ Cf. (3.3)-(3.7) in [[1207.5018]].
 <<SM physics: public>>=
   public :: top_width_sm_qcd_nlo_massless_b
 <<SM physics: sub interfaces>>=
     elemental module function top_width_sm_qcd_nlo_massless_b &
            (alpha, sinthw, vtb, mtop, mw, alphas) result (gamma)
       real(default) :: gamma
       real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, alphas
     end function top_width_sm_qcd_nlo_massless_b
 <<SM physics: procedures>>=
   elemental module function top_width_sm_qcd_nlo_massless_b &
          (alpha, sinthw, vtb, mtop, mw, alphas) result (gamma)
     real(default) :: gamma
     real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, alphas
     real(default) :: prefac, g_mu, w2
     g_mu = g_mu_from_alpha (alpha, mw, sinthw)
     prefac = g_mu * mtop**3 * vtb**2 / (16 * sqrt(two) * pi)
     w2 = mw**2 / mtop**2
     gamma = prefac * (f0 (w2) - (two * alphas) / (3 * Pi) * f1 (w2))
   end function top_width_sm_qcd_nlo_massless_b
 
 @ %def top_width_sm_qcd_nlo_massless_b
 @
 <<SM physics: public>>=
   public :: f0
 <<SM physics: sub interfaces>>=
     elemental module function f0 (w2) result (f)
       real(default) :: f
       real(default), intent(in) :: w2
     end function f0
 <<SM physics: procedures>>=
   elemental module function f0 (w2) result (f)
     real(default) :: f
     real(default), intent(in) :: w2
     f = two * (one - w2)**2 * (1 + 2 * w2)
   end function f0
 
 @ %def f0
 @
 <<SM physics: public>>=
   public :: f1
 <<SM physics: sub interfaces>>=
     elemental module function f1 (w2) result (f)
       real(default) :: f
       real(default), intent(in) :: w2
     end function f1
 <<SM physics: procedures>>=
   elemental module function f1 (w2) result (f)
     real(default) :: f
     real(default), intent(in) :: w2
     f = f0 (w2) * (pi**2 + two * Li2 (w2) - two * Li2 (one - w2)) &
          + four * w2 * (one - w2 - two * w2**2) * log (w2) &
          + two * (one - w2)**2 * (five + four * w2) * log (one - w2) &
          - (one - w2) * (five + 9 * w2 - 6 * w2**2)
   end function f1
 
 @ %def f1
 @ Basically, the same as above but with $m_b$ dependence,
 cf. Jezabek / Kuehn 1989.
 <<SM physics: public>>=
   public :: top_width_sm_qcd_nlo_jk
 <<SM physics: sub interfaces>>=
     elemental module function top_width_sm_qcd_nlo_jk &
            (alpha, sinthw, vtb, mtop, mw, mb, alphas) result (gamma)
       real(default) :: gamma
       real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb, alphas
     end function top_width_sm_qcd_nlo_jk
 <<SM physics: procedures>>=
   elemental module function top_width_sm_qcd_nlo_jk &
          (alpha, sinthw, vtb, mtop, mw, mb, alphas) result (gamma)
     real(default) :: gamma
     real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb, alphas
     real(default) :: prefac, g_mu, eps2, i_xi
     g_mu = g_mu_from_alpha (alpha, mw, sinthw)
     prefac = g_mu * mtop**3 * vtb**2 / (16 * sqrt(two) * pi)
     eps2 = (mb / mtop)**2
     i_xi = (mw / mtop)**2
     gamma = prefac * (ff0 (eps2, i_xi) - &
          (two * alphas) / (3 * Pi) * ff1 (eps2, i_xi))
   end function top_width_sm_qcd_nlo_jk
 
 @ %def top_width_sm_qcd_nlo_jk
 @ Same as above, $m_b > 0$, with the slightly different implementation
 (2.6) of arXiv:1204.1513v1 by Campbell and Ellis.
 <<SM physics: public>>=
   public :: top_width_sm_qcd_nlo_ce
 <<SM physics: sub interfaces>>=
     elemental module function top_width_sm_qcd_nlo_ce &
          (alpha, sinthw, vtb, mtop, mw, mb, alpha_s) result (gamma)
       real(default) :: gamma
       real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb, alpha_s
     end function top_width_sm_qcd_nlo_ce
 <<SM physics: procedures>>=
   elemental module function top_width_sm_qcd_nlo_ce &
        (alpha, sinthw, vtb, mtop, mw, mb, alpha_s) result (gamma)
     real(default) :: gamma
     real(default), intent(in) :: alpha, sinthw, vtb, mtop, mw, mb, alpha_s
     real(default) :: pm, pp, p0, p3
     real(default) :: yw, yp
     real(default) :: W0, Wp, Wm, w2
     real(default) :: beta2
     real(default) :: f
     real(default) :: g_mu, gamma0
     beta2 = (mb / mtop)**2
     w2 = (mw / mtop)**2
     p0 = (one - w2 + beta2) / two
     p3 = sqrt (lambda (one, w2, beta2)) / two
     pp = p0 + p3
     pm = p0 - p3
     W0 = (one + w2 - beta2) / two
     Wp = W0 + p3
     Wm = W0 - p3
     yp = log (pp / pm) / two
     yw = log (Wp / Wm) / two
     f = (one - beta2)**2 + w2 * (one + beta2) - two * w2**2
     g_mu = g_mu_from_alpha (alpha, mw, sinthw)
     gamma0 = g_mu * mtop**3 * vtb**2 / (8 * pi * sqrt(two))
     gamma = gamma0 * alpha_s / twopi * CF * &
          (8 * f * p0 * (Li2(one - pm) - Li2(one - pp) - two * Li2(one - pm / pp) &
          + yp * log((four * p3**2) / (pp**2 * Wp)) + yw * log (pp)) &
          + four * (one - beta2) * ((one - beta2)**2 + w2 * (one + beta2) - four * w2**2) * yw &
          + (3 - beta2 + 11 * beta2**2 - beta2**3 + w2 * (6 - 12 * beta2 + two * beta2**2) &
          - w2**2 * (21 + 5 * beta2) + 12 * w2**3) * yp &
          + 8 * f * p3 * log (sqrt(w2) / (four * p3**2)) &
          + 6 * (one - four * beta2 + 3 * beta2**2 + w2 * (3 + beta2) - four * w2**2) * p3 * log(sqrt(beta2)) &
          + (5 - 22 * beta2 + 5 * beta2**2 + 9 * w2 * (one + beta2) - 6 * w2**2) * p3)
   end function top_width_sm_qcd_nlo_ce
 
 @ %def top_width_sm_qcd_nlo_ce
 @
 <<SM physics: public>>=
   public :: ff0
 <<SM physics: sub interfaces>>=
     elemental module function ff0 (eps2, w2) result (f)
       real(default) :: f
       real(default), intent(in) :: eps2, w2
     end function ff0
 <<SM physics: procedures>>=
   elemental module function ff0 (eps2, w2) result (f)
     real(default) :: f
     real(default), intent(in) :: eps2, w2
     f = one / two * sqrt(ff_lambda (eps2, w2)) * ff_f0 (eps2, w2)
   end function ff0
 
 @ %def ff0
 @
 <<SM physics: public>>=
   public :: ff_f0
 <<SM physics: sub interfaces>>=
     elemental module function ff_f0 (eps2, w2) result (f)
       real(default) :: f
       real(default), intent(in) :: eps2, w2
     end function ff_f0
 <<SM physics: procedures>>=
   elemental module function ff_f0 (eps2, w2) result (f)
     real(default) :: f
     real(default), intent(in) :: eps2, w2
     f = four * ((1 - eps2)**2 + w2 * (1 + eps2) - 2 * w2**2)
   end function ff_f0
 
 @ %def ff_f0
 @
 <<SM physics: public>>=
   public :: ff_lambda
 <<SM physics: sub interfaces>>=
     elemental module function ff_lambda (eps2, w2) result (l)
       real(default) :: l
       real(default), intent(in) :: eps2, w2
     end function ff_lambda
 <<SM physics: procedures>>=
   elemental module function ff_lambda (eps2, w2) result (l)
     real(default) :: l
     real(default), intent(in) :: eps2, w2
     l = one + w2**2 + eps2**2 - two * (w2 + eps2 + w2 * eps2)
   end function ff_lambda
 
 @ %def ff_lambda
 @
 <<SM physics: public>>=
   public :: ff1
 <<SM physics: sub interfaces>>=
     elemental module function ff1 (eps2, w2) result (f)
       real(default) :: f
       real(default), intent(in) :: eps2, w2
     end function ff1
 <<SM physics: procedures>>=
   elemental module function ff1 (eps2, w2) result (f)
     real(default) :: f
     real(default), intent(in) :: eps2, w2
     real(default) :: uq, uw, sq_lam, fff
     sq_lam = sqrt (ff_lambda (eps2, w2))
     fff = ff_f0 (eps2, w2)
     uw = (one - eps2 + w2 - sq_lam) / &
          (one - eps2 + w2 + sq_lam)
     uq = (one + eps2 - w2 - sq_lam) / &
          (one + eps2 - w2 + sq_lam)
     f = one / two * fff * (one + eps2 - w2) * &
          (pi**2 + two * Li2 (uw) - two * Li2 (one - uw) - four * Li2 (uq) &
           - four * Li2 (uq * uw) + log ((one - uq) / w2) * log (one - uq) &
           - log (one - uq * uw)**2 + one / four * log (w2 / uw)**2 &
           - log (uw) * log ((one - uq * uw)**2 / (one - uq)) &
           - two * log (uq) * log ((one - uq) * (one - uq * uw))) &
           - sq_lam * fff * (two * log (sqrt (w2)) &
           + three * log (sqrt (eps2)) - two * log (sq_lam**2)) &
           + four * (one - eps2) * ((one - eps2)**2 + w2 * (one + eps2) &
           - four * w2**2) * log (uw) &
           + (three - eps2 + 11 * eps2**2 - eps2**3 + w2 * &
             (6 - 12 * eps2 + 2 * eps2**2) - w2**2 * (21 + five * eps2) &
           + 12 * w2**3) * log (uq) &
           + 6 * sq_lam * (one - eps2) * &
             (one + eps2 - w2) * log (sqrt (eps2)) &
           + sq_lam * (- five + 22 * eps2 - five * eps2**2 - 9 * w2 * &
             (one + eps2) + 6 * w2**2)
   end function ff1
 
 @ %def ff1
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sm_physics_ut.f90]]>>=
 <<File header>>
 
 module sm_physics_ut
   use unit_tests
   use sm_physics_uti
 
 <<Standard module head>>
 
 <<SM physics: public test>>
 
 contains
 
 <<SM physics: test driver>>
 
 end module sm_physics_ut
 @ %def sm_physics_ut
 @
 <<[[sm_physics_uti.f90]]>>=
 <<File header>>
 
 module sm_physics_uti
 
 <<Use kinds>>
   use numeric_utils
   use format_defs, only: FMT_15
   use constants
 
   use sm_physics
 
 <<Standard module head>>
 
 <<SM physics: test declarations>>
 
 contains
 
 <<SM physics: tests>>
 
 end module sm_physics_uti
 @ %def sm_physics_ut
 @ API: driver for the unit tests below.
 <<SM physics: public test>>=
   public :: sm_physics_test
 <<SM physics: test driver>>=
   subroutine sm_physics_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SM physics: execute tests>>
   end subroutine sm_physics_test
 
 @ %def sm_physics_test
 @
 \subsubsection{Splitting functions}
 <<SM physics: execute tests>>=
   call test (sm_physics_1, "sm_physics_1", &
        "Splitting functions", &
        u, results)
 <<SM physics: test declarations>>=
   public :: sm_physics_1
 <<SM physics: tests>>=
   subroutine sm_physics_1 (u)
     integer, intent(in) :: u
     real(default) :: z = 0.75_default
 
     write (u, "(A)")  "* Test output: sm_physics_1"
     write (u, "(A)")  "*   Purpose: check analytic properties"
     write (u, "(A)")
 
     write (u, "(A)")  "* Splitting functions:"
     write (u, "(A)")
 
     call assert (u, vanishes (p_qqg_pol (z, +1, -1, +1)), "+-+")
     call assert (u, vanishes (p_qqg_pol (z, +1, -1, -1)), "+--")
     call assert (u, vanishes (p_qqg_pol (z, -1, +1, +1)), "-++")
     call assert (u, vanishes (p_qqg_pol (z, -1, +1, -1)), "-+-")
 
     !call assert (u, nearly_equal ( &
          !p_qqg_pol (z, +1, +1, -1) + p_qqg_pol (z, +1, +1, +1), &
          !p_qqg (z)), "pol sum")
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sm_physics_1"
 
   end subroutine sm_physics_1
 
 @ %def sm_physics_1
 @
 \subsubsection{Top width}
 <<SM physics: execute tests>>=
   call test(sm_physics_2, "sm_physics_2", &
             "Top width", u, results)
 <<SM physics: test declarations>>=
   public :: sm_physics_2
 <<SM physics: tests>>=
   subroutine sm_physics_2 (u)
     integer, intent(in) :: u
     real(default) :: mtop, mw, mz, mb, g_mu, sinthw, alpha, vtb, gamma0
     real(default) :: w2, alphas, alphas_mz, gamma1
     write (u, "(A)")  "* Test output: sm_physics_2"
     write (u, "(A)")  "*   Purpose: Check different top width computations"
     write (u, "(A)")
 
     write (u, "(A)")  "*   Values from [[1207.5018]] (massless b)"
     mtop = 172.0
     mw = 80.399
     mz = 91.1876
     mb = zero
     mb = 0.00001
     g_mu = 1.16637E-5
     sinthw = sqrt(one - mw**2 / mz**2)
     alpha = alpha_from_g_mu (g_mu, mw, sinthw)
     vtb = one
     w2 = mw**2 / mtop**2
 
     write (u, "(A)")  "*   Check Li2 implementation"
     call assert_equal (u, Li2(w2), 0.2317566263959552_default, &
          "Li2(w2)", rel_smallness=1.0E-6_default)
     call assert_equal (u, Li2(one - w2), 1.038200378935867_default, &
          "Li2(one - w2)", rel_smallness=1.0E-6_default)
 
     write (u, "(A)")  "*   Check LO Width"
     gamma0 = top_width_sm_lo (alpha, sinthw, vtb, mtop, mw, mb)
     call assert_equal (u, gamma0, 1.4655_default, &
          "top_width_sm_lo", rel_smallness=1.0E-5_default)
     alphas = zero
     gamma0 = top_width_sm_qcd_nlo_massless_b &
          (alpha, sinthw, vtb, mtop, mw, alphas)
     call assert_equal (u, gamma0, 1.4655_default, &
          "top_width_sm_qcd_nlo_massless_b", rel_smallness=1.0E-5_default)
     gamma0 = top_width_sm_qcd_nlo_jk &
          (alpha, sinthw, vtb, mtop, mw, mb, alphas)
     call assert_equal (u, gamma0, 1.4655_default, &
          "top_width_sm_qcd_nlo", rel_smallness=1.0E-5_default)
 
     write (u, "(A)")  "*   Check NLO Width"
     alphas_mz = 0.1202      ! MSTW2008 NLO fit
     alphas = running_as (mtop, alphas_mz, mz, 1, 5.0_default)
     gamma1 = top_width_sm_qcd_nlo_massless_b &
          (alpha, sinthw, vtb, mtop, mw, alphas)
     call assert_equal (u, gamma1, 1.3376_default, rel_smallness=1.0E-4_default)
     gamma1 = top_width_sm_qcd_nlo_jk &
          (alpha, sinthw, vtb, mtop, mw, mb, alphas)
     ! It would be nice to get one more significant digit but the
     ! expression is numerically rather unstable for mb -> 0
     call assert_equal (u, gamma1, 1.3376_default, rel_smallness=1.0E-3_default)
 
     write (u, "(A)")  "*   Values from threshold validation (massive b)"
     alpha = one / 125.924
     ! ee = 0.315901
     ! cw = 0.881903
     ! v = 240.024
     mtop = 172.0 ! This is the value for M1S !!!
     mb = 4.2
     sinthw = 0.47143
     mz = 91.188
     mw = 80.419
     call assert_equal (u, sqrt(one - mw**2 / mz**2), sinthw, &
          "sinthw", rel_smallness=1.0E-6_default)
 
     write (u, "(A)")  "*   Check LO Width"
     gamma0 = top_width_sm_lo (alpha, sinthw, vtb, mtop, mw, mb)
     call assert_equal (u, gamma0, 1.5386446_default, &
          "gamma0", rel_smallness=1.0E-7_default)
     alphas = zero
     gamma0 = top_width_sm_qcd_nlo_jk &
          (alpha, sinthw, vtb, mtop, mw, mb, alphas)
     call assert_equal (u, gamma0, 1.5386446_default, &
          "gamma0", rel_smallness=1.0E-7_default)
 
     write (u, "(A)")  "*   Check NLO Width"
     alphas_mz = 0.118 !(Z pole, NLL running to mu_h)
     alphas = running_as (mtop, alphas_mz, mz, 1, 5.0_default)
     write (u, "(A," // FMT_15 // ")")  "*   alphas = ", alphas
     gamma1 = top_width_sm_qcd_nlo_jk &
          (alpha, sinthw, vtb, mtop, mw, mb, alphas)
     write (u, "(A," // FMT_15 // ")")  "*   Gamma1 = ", gamma1
 
     mb = zero
     gamma1 = top_width_sm_qcd_nlo_massless_b &
          (alpha, sinthw, vtb, mtop, mw, alphas)
     alphas = running_as (mtop, alphas_mz, mz, 1, 5.0_default)
     write (u, "(A," // FMT_15 // ")")  "*   Gamma1(mb=0) = ", gamma1
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sm_physics_2"
   end subroutine sm_physics_2
 
 @ %def sm_physics_2
 @
 \subsubsection{Special functions}
 <<SM physics: execute tests>>=
   call test (sm_physics_3, "sm_physics_3", &
        "Special functions", &
        u, results)
 <<SM physics: test declarations>>=
   public :: sm_physics_3
 <<SM physics: tests>>=
   subroutine sm_physics_3 (u)
     integer, intent(in) :: u
     complex(default) :: z1 = (0.75_default, 1.25_default)
     complex(default) :: z2 = (1.33_default, 11.25_default)
     complex(default) :: psiz
     real(default) :: x1 = 0.045847700_default
     real(default) :: psir
 
     write (u, "(A)")  "* Test output: sm_physics_3"
     write (u, "(A)")  "*   Purpose: check special functions"
     write (u, "(A)")
 
     write (u, "(A)")  "* Complex digamma function:"
     write (u, "(A)")
 
     psiz = psic (z1)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z1      = ", &
          real(z1), aimag(z1)
     write (u, "(1x,A,'(',F7.5,',',F7.5,')')")  " psi(z1) = ", &
          real(psiz), aimag(psiz)
     psiz = psic (z2)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z2      = ", &
          real(z2), aimag(z2)
     write (u, "(1x,A,'(',F7.5,',',F7.5,')')")  " psi(z2) = ", &
          real(psiz), aimag(psiz)
 
     write (u, "(A)")
     write (u, "(A)")  "* Complex polygamma function:"
     write (u, "(A)")
 
     psiz = psim (z1,1)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z1        = ", &
          real(z1), aimag(z1)
     write (u, "(1x,A,'(',F8.5,',',F8.5,')')")  " psi(z1,1) = ", &
          real(psiz), aimag(psiz)
     psiz = psim (z2,1)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z2        = ", &
          real(z2), aimag(z2)
     write (u, "(1x,A,'(',F8.5,',',F8.5,')')")  " psi(z2,1) = ", &
          real(psiz), aimag(psiz)
 
     write (u, "(A)")
 
     psiz = psim (z1,2)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z1        = ", &
          real(z1), aimag(z1)
     write (u, "(1x,A,'(',F8.5,',',F8.5,')')")  " psi(z1,2) = ", &
          real(psiz), aimag(psiz)
     psiz = psim (z2,2)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z2        = ", &
          real(z2), aimag(z2)
     write (u, "(1x,A,'(',F8.5,',',F8.5,')')")  " psi(z2,2) = ", &
          real(psiz), aimag(psiz)
 
     write (u, "(A)")
 
     psiz = psim (z1,3)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z1        = ", &
          real(z1), aimag(z1)
     write (u, "(1x,A,'(',F8.5,',',F8.5,')')")  " psi(z1,3) = ", &
          real(psiz), aimag(psiz)
     psiz = psim (z2,3)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z2        = ", &
          real(z2), aimag(z2)
     write (u, "(1x,A,'(',F8.5,',',F8.5,')')")  " psi(z2,3) = ", &
          real(psiz), aimag(psiz)
 
     write (u, "(A)")
 
     psiz = psim (z1,4)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z1        = ", &
          real(z1), aimag(z1)
     write (u, "(1x,A,'(',F8.5,',',F8.5,')')")  " psi(z1,4) = ", &
          real(psiz), aimag(psiz)
     psiz = psim (z2,4)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z2        = ", &
          real(z2), aimag(z2)
     write (u, "(1x,A,'(',F8.5,',',F8.5,')')")  " psi(z2,4) = ", &
          real(psiz), aimag(psiz)
 
     write (u, "(A)")
 
     psiz = psim (z1,5)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z1        = ", &
          real(z1), aimag(z1)
     write (u, "(1x,A,'(',F8.5,',',F8.5,')')")  " psi(z1,5) = ", &
          real(psiz), aimag(psiz)
     psiz = psim (z2,5)
     write (u, "(1x,A,'(',F5.2,',',F5.2,')')")  " z2        = ", &
          real(z2), aimag(z2)
     write (u, "(1x,A,'(',F8.5,',',F8.5,')')")  " psi(z2,5) = ", &
          real(psiz), aimag(psiz)
 
     write (u, "(A)")
     write (u, "(A)")  "* Real polygamma function:"
     write (u, "(A)")
 
     psir = psimr (x1,1)
     write (u, "(1x,A,'(',F8.5,')')")  " x1        = ", x1
     write (u, "(1x,A,'(',F8.4,')')")  " psir      = ", psir
 
     write (u, "(A)")
     write (u, "(A)")  "* Generalized Nielsen polylogarithm:"
     write (u, "(A)")
 
     write (u, "(1x,A,F8.5)")  " S(1,1,0) = ", &
          nielsen(1,1,0._default)
     write (u, "(1x,A,F8.5)")  " S(1,1,-1) = ", &
          nielsen(1,1,-1._default)
     write (u, "(1x,A,F8.5)")  " S(1,2,-1) = ", &
          nielsen(1,2,-1._default)
     write (u, "(1x,A,F8.5)")  " S(2,1,-1) = ", &
          nielsen(2,1,-1._default)
     write (u, "(1x,A,F8.5)")  " S(1,3,-1) = ", &
          nielsen(1,3,-1._default)
     write (u, "(1x,A,F8.5)")  " S(2,2,-1) = ", &
          nielsen(2,2,-1._default)
     write (u, "(1x,A,F8.5)")  " S(3,1,-1) = ", &
          nielsen(3,1,-1._default)
     write (u, "(1x,A,F8.5)")  " S(1,4,-1) = ", &
          nielsen(1,4,-1._default)
     write (u, "(1x,A,F8.5)")  " S(2,3,-1) = ", &
          nielsen(2,3,-1._default)
     write (u, "(1x,A,F8.5)")  " S(3,2,-1) = ", &
          nielsen(3,2,-1._default)
     write (u, "(1x,A,F8.5)")  " S(4,1,-1) = ", &
          nielsen(4,1,-1._default)
     write (u, "(1x,A,F8.5)")  " S(1,1,0.2) = ", &
          nielsen(1,1,0.2_default)
     write (u, "(1x,A,F8.5)")  " S(1,2,0.2) = ", &
          nielsen(1,2,0.2_default)
     write (u, "(1x,A,F8.5)")  " S(2,1,0.2) = ", &
          nielsen(2,1,0.2_default)
     write (u, "(1x,A,F8.5)")  " S(1,3,0.2) = ", &
          nielsen(1,3,0.2_default)
     write (u, "(1x,A,F8.5)")  " S(2,2,0.2) = ", &
          nielsen(2,2,0.2_default)
     write (u, "(1x,A,F8.5)")  " S(3,1,0.2) = ", &
          nielsen(3,1,0.2_default)
     write (u, "(1x,A,F8.5)")  " S(1,4,0.2) = ", &
          nielsen(1,4,0.2_default)
     write (u, "(1x,A,F8.5)")  " S(2,3,0.2) = ", &
          nielsen(2,3,0.2_default)
     write (u, "(1x,A,F8.5)")  " S(3,2,0.2) = ", &
          nielsen(3,2,0.2_default)
     write (u, "(1x,A,F8.5)")  " S(4,1,0.2) = ", &
          nielsen(4,1,0.2_default)
     write (u, "(1x,A,F8.5)")  " S(1,1,1) = ", &
          nielsen(1,1,1._default)
     write (u, "(1x,A,F8.5)")  " S(1,2,1) = ", &
          nielsen(1,2,1._default)
     write (u, "(1x,A,F8.5)")  " S(2,1,1) = ", &
          nielsen(2,1,1._default)
     write (u, "(1x,A,F8.5)")  " S(1,3,1) = ", &
          nielsen(1,3,1._default)
     write (u, "(1x,A,F8.5)")  " S(2,2,1) = ", &
          nielsen(2,2,1._default)
     write (u, "(1x,A,F8.5)")  " S(3,1,1) = ", &
          nielsen(3,1,1._default)
     write (u, "(1x,A,F8.5)")  " S(1,4,1) = ", &
          nielsen(1,4,1._default)
     write (u, "(1x,A,F8.5)")  " S(2,3,1) = ", &
          nielsen(2,3,1._default)
     write (u, "(1x,A,F8.5)")  " S(3,2,1) = ", &
          nielsen(3,2,1._default)
     write (u, "(1x,A,F8.5)")  " S(4,1,1) = ", &
          nielsen(4,1,1._default)
     write (u, "(1x,A,F8.5)")  " S(1,1,0.75) = ", &
          nielsen(1,1,0.75_default)
     write (u, "(1x,A,F8.5)")  " S(1,3,0.75) = ", &
          nielsen(1,3,0.75_default)
     write (u, "(1x,A,F8.5)")  " S(1,4,0.75) = ", &
          nielsen(1,4,0.75_default)
     write (u, "(1x,A,F8.5)")  " S(2,2,0.75) = ", &
          nielsen(2,2,0.75_default)
     write (u, "(1x,A,'(',F8.5,',',F8.5,')')")  " S(1,1,2) = ", &
          real(cnielsen(1,1,3._default)), &
          aimag(cnielsen(1,1,3._default))
 
     write (u, "(A)")
     write (u, "(A)")  "* Dilog, trilog, polylog:"
     write (u, "(A)")
 
     write (u, "(1x,A,F8.5)")  " Li2(0.66)    = ", &
          dilog(0.66_default)
     write (u, "(1x,A,F8.5)")  " Li3(0.66)    = ", &
          trilog(0.66_default)
     write (u, "(1x,A,F8.5)")  " Poly(4,0.66) = ", &
          polylog(4,0.66_default)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sm_physics_3"
 
   end subroutine sm_physics_3
 
 @ %def sm_physics_3
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{QCD Coupling}
 We provide various distinct implementations of the QCD coupling.  In
 this module, we define an abstract data type and three
 implementations: fixed, running with $\alpha_s(M_Z)$ as input, and
 running with $\Lambda_{\text{QCD}}$ as input.  We use the functions
 defined above in the module [[sm_physics]] but provide a common
 interface.  Later modules may define additional implementations.
 <<[[sm_qcd.f90]]>>=
 <<File header>>
 
 module sm_qcd
 
 <<Use kinds>>
   use physics_defs
 
 <<Standard module head>>
 
 <<SM qcd: public>>
 
 <<SM qcd: types>>
 
 <<SM qcd: interfaces>>
 
   interface
 <<SM qcd: sub interfaces>>
   end interface
 
 end module sm_qcd
 @ %def sm_qcd
 @
 <<[[sm_qcd_sub.f90]]>>=
 <<File header>>
 
 submodule (sm_qcd) sm_qcd_s
 
   use io_units
   use format_defs, only: FMT_12
   use numeric_utils
   use diagnostics
   use md5
   use sm_physics
 
   implicit none
 
 contains
 
 <<SM qcd: procedures>>
 
 end submodule sm_qcd_s
 
 @ %def sm_qcd_s
 @
 \subsection{Coupling: Abstract Data Type}
 This is the abstract version of the QCD coupling implementation.
 <<SM qcd: public>>=
   public :: alpha_qcd_t
 <<SM qcd: types>>=
   type, abstract :: alpha_qcd_t
    contains
    <<SM qcd: alpha qcd: TBP>>
   end type alpha_qcd_t
 
 @ %def alpha_qcd_t
 @ There must be an output routine.
 <<SM qcd: alpha qcd: TBP>>=
   procedure (alpha_qcd_write), deferred :: write
 <<SM qcd: interfaces>>=
   abstract interface
      subroutine alpha_qcd_write (object, unit)
        import
        class(alpha_qcd_t), intent(in) :: object
        integer, intent(in), optional :: unit
      end subroutine alpha_qcd_write
   end interface
 
 @ %def alpha_qcd_write
 @ This method computes the running coupling, given a certain scale.  All
 parameters (reference value, order of the approximation, etc.) must be
 set before calling this.
 <<SM qcd: alpha qcd: TBP>>=
   procedure (alpha_qcd_get), deferred :: get
 <<SM qcd: interfaces>>=
   abstract interface
      function alpha_qcd_get (alpha_qcd, scale) result (alpha)
        import
        class(alpha_qcd_t), intent(in) :: alpha_qcd
        real(default), intent(in) :: scale
        real(default) :: alpha
      end function alpha_qcd_get
   end interface
 
 @ %def alpha_qcd_get
 @
 \subsection{Fixed Coupling}
 In this version, the $\alpha_s$ value is fixed, the [[scale]] argument
 of the [[get]] method is ignored.  There is only one parameter, the
 value.  By default, this is the value at $M_Z$.
 <<SM qcd: public>>=
   public :: alpha_qcd_fixed_t
 <<SM qcd: types>>=
   type, extends (alpha_qcd_t) :: alpha_qcd_fixed_t
      real(default) :: val = ALPHA_QCD_MZ_REF
    contains
    <<SM qcd: alpha qcd fixed: TBP>>
   end type alpha_qcd_fixed_t
 
 @ %def alpha_qcd_fixed_t
 @ Output.
 <<SM qcd: alpha qcd fixed: TBP>>=
   procedure :: write => alpha_qcd_fixed_write
 <<SM qcd: sub interfaces>>=
     module subroutine alpha_qcd_fixed_write (object, unit)
       class(alpha_qcd_fixed_t), intent(in) :: object
       integer, intent(in), optional :: unit
     end subroutine alpha_qcd_fixed_write
 <<SM qcd: procedures>>=
   module subroutine alpha_qcd_fixed_write (object, unit)
     class(alpha_qcd_fixed_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(3x,A)")  "QCD parameters (fixed coupling):"
     write (u, "(5x,A," // FMT_12 // ")")  "alpha = ", object%val
   end subroutine alpha_qcd_fixed_write
 
 @ %def alpha_qcd_fixed_write
 @ Calculation: the scale is ignored in this case.
 <<SM qcd: alpha qcd fixed: TBP>>=
   procedure :: get => alpha_qcd_fixed_get
 <<SM qcd: sub interfaces>>=
     module function alpha_qcd_fixed_get (alpha_qcd, scale) result (alpha)
       class(alpha_qcd_fixed_t), intent(in) :: alpha_qcd
       real(default), intent(in) :: scale
       real(default) :: alpha
     end function alpha_qcd_fixed_get
 <<SM qcd: procedures>>=
   module function alpha_qcd_fixed_get (alpha_qcd, scale) result (alpha)
     class(alpha_qcd_fixed_t), intent(in) :: alpha_qcd
     real(default), intent(in) :: scale
     real(default) :: alpha
     alpha = alpha_qcd%val
   end function alpha_qcd_fixed_get
 
 @ %def alpha_qcd_fixed_get
 @
 \subsection{Running Coupling}
 In this version, the $\alpha_s$ value runs relative to the value at a
 given reference scale.  There are two parameters: the value of this
 scale (default: $M_Z$), the value of $\alpha_s$ at this scale, and the
 number of effective flavors.  Furthermore, we have the order of the
 approximation.
 <<SM qcd: public>>=
   public :: alpha_qcd_from_scale_t
 <<SM qcd: types>>=
   type, extends (alpha_qcd_t) :: alpha_qcd_from_scale_t
      real(default) :: mu_ref = MZ_REF
      real(default) :: ref = ALPHA_QCD_MZ_REF
      integer :: order = 0
      integer :: nf = 5
    contains
    <<SM qcd: alpha qcd from scale: TBP>>
   end type alpha_qcd_from_scale_t
 
 @ %def alpha_qcd_from_scale_t
 @ Output.
 <<SM qcd: alpha qcd from scale: TBP>>=
   procedure :: write => alpha_qcd_from_scale_write
 <<SM qcd: sub interfaces>>=
     module subroutine alpha_qcd_from_scale_write (object, unit)
       class(alpha_qcd_from_scale_t), intent(in) :: object
       integer, intent(in), optional :: unit
     end subroutine alpha_qcd_from_scale_write
 <<SM qcd: procedures>>=
   module subroutine alpha_qcd_from_scale_write (object, unit)
     class(alpha_qcd_from_scale_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(3x,A)")  "QCD parameters (running coupling):"
     write (u, "(5x,A," // FMT_12 // ")")  "Scale mu  = ", object%mu_ref
     write (u, "(5x,A," // FMT_12 // ")")  "alpha(mu) = ", object%ref
     write (u, "(5x,A,I0)")      "LL order  = ", object%order
     write (u, "(5x,A,I0)")      "N(flv)    = ", object%nf
   end subroutine alpha_qcd_from_scale_write
 
 @ %def alpha_qcd_from_scale_write
 @ Calculation: here, we call the function for running $\alpha_s$ that
 was defined in [[sm_physics]] above.  The function does not take into
 account thresholds, so the number of flavors should be the correct one
 for the chosen scale.  Normally, this should be the $Z$ boson mass.
 <<SM qcd: alpha qcd from scale: TBP>>=
   procedure :: get => alpha_qcd_from_scale_get
 <<SM qcd: sub interfaces>>=
     module function alpha_qcd_from_scale_get (alpha_qcd, scale) result (alpha)
       class(alpha_qcd_from_scale_t), intent(in) :: alpha_qcd
       real(default), intent(in) :: scale
       real(default) :: alpha
     end function alpha_qcd_from_scale_get
 <<SM qcd: procedures>>=
   module function alpha_qcd_from_scale_get (alpha_qcd, scale) result (alpha)
     class(alpha_qcd_from_scale_t), intent(in) :: alpha_qcd
     real(default), intent(in) :: scale
     real(default) :: alpha
     alpha = running_as (scale, alpha_qcd%ref, alpha_qcd%mu_ref, &
          alpha_qcd%order, real (alpha_qcd%nf, kind=default))
   end function alpha_qcd_from_scale_get
 
 @ %def alpha_qcd_from_scale_get
 @
 \subsection{Running Coupling, determined by $\Lambda_{\text{QCD}}$}
 In this version, the inputs are the value $\Lambda_{\text{QCD}}$ and
 the order of the approximation.
 <<SM qcd: public>>=
   public :: alpha_qcd_from_lambda_t
 <<SM qcd: types>>=
   type, extends (alpha_qcd_t) :: alpha_qcd_from_lambda_t
      real(default) :: lambda = LAMBDA_QCD_REF
      integer :: order = 0
      integer :: nf = 5
    contains
    <<SM qcd: alpha qcd from lambda: TBP>>
   end type alpha_qcd_from_lambda_t
 
 @ %def alpha_qcd_from_lambda_t
 @ Output.
 <<SM qcd: alpha qcd from lambda: TBP>>=
   procedure :: write => alpha_qcd_from_lambda_write
 <<SM qcd: sub interfaces>>=
     module subroutine alpha_qcd_from_lambda_write (object, unit)
       class(alpha_qcd_from_lambda_t), intent(in) :: object
       integer, intent(in), optional :: unit
     end subroutine alpha_qcd_from_lambda_write
 <<SM qcd: procedures>>=
   module subroutine alpha_qcd_from_lambda_write (object, unit)
     class(alpha_qcd_from_lambda_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(3x,A)")  "QCD parameters (Lambda_QCD as input):"
     write (u, "(5x,A," // FMT_12 // ")")  "Lambda_QCD = ", object%lambda
     write (u, "(5x,A,I0)")      "LL order   = ", object%order
     write (u, "(5x,A,I0)")      "N(flv)     = ", object%nf
   end subroutine alpha_qcd_from_lambda_write
 
 @ %def alpha_qcd_from_lambda_write
 @ Calculation: here, we call the second function for running $\alpha_s$ that
 was defined in [[sm_physics]] above.  The $\Lambda$ value should be
 the one that is appropriate for the chosen number of effective
 flavors.  Again, thresholds are not incorporated.
 <<SM qcd: alpha qcd from lambda: TBP>>=
   procedure :: get => alpha_qcd_from_lambda_get
 <<SM qcd: sub interfaces>>=
     module function alpha_qcd_from_lambda_get (alpha_qcd, scale) result (alpha)
       class(alpha_qcd_from_lambda_t), intent(in) :: alpha_qcd
       real(default), intent(in) :: scale
       real(default) :: alpha
     end function alpha_qcd_from_lambda_get
 <<SM qcd: procedures>>=
   module function alpha_qcd_from_lambda_get (alpha_qcd, scale) result (alpha)
     class(alpha_qcd_from_lambda_t), intent(in) :: alpha_qcd
     real(default), intent(in) :: scale
     real(default) :: alpha
     alpha = running_as_lam (real (alpha_qcd%nf, kind=default), scale, &
          alpha_qcd%lambda, alpha_qcd%order)
   end function alpha_qcd_from_lambda_get
 
 @ %def alpha_qcd_from_lambda_get
 @
 \subsection{QCD Wrapper type}
 We could get along with a polymorphic QCD type, but a monomorphic wrapper type
 with a polymorphic component is easier to handle and probably safer
 (w.r.t.\ compiler bugs).  However, we keep the object transparent, so we can
 set the type-specific parameters directly (by a [[dispatch]] routine).
 <<SM qcd: public>>=
   public :: qcd_t
 <<SM qcd: types>>=
   type :: qcd_t
      class(alpha_qcd_t), allocatable :: alpha
      character(32) :: md5sum = ""
      integer :: n_f = -1
    contains
    <<SM qcd: qcd: TBP>>
   end type qcd_t
 
 @ %def qcd_t
 @ Output.  We first print the polymorphic [[alpha]] which contains a headline,
 then any extra components.
 <<SM qcd: qcd: TBP>>=
   procedure :: write => qcd_write
 <<SM qcd: sub interfaces>>=
     module subroutine qcd_write (qcd, unit, show_md5sum)
       class(qcd_t), intent(in) :: qcd
       integer, intent(in), optional :: unit
       logical, intent(in), optional :: show_md5sum
     end subroutine qcd_write
 <<SM qcd: procedures>>=
   module subroutine qcd_write (qcd, unit, show_md5sum)
     class(qcd_t), intent(in) :: qcd
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: show_md5sum
     logical :: show_md5
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     show_md5 = .true.;  if (present (show_md5sum))  show_md5 = show_md5sum
     if (allocated (qcd%alpha)) then
        call qcd%alpha%write (u)
     else
        write (u, "(3x,A)")  "QCD parameters (coupling undefined)"
     end if
     if (show_md5 .and. qcd%md5sum /= "") &
          write (u, "(5x,A,A,A)") "md5sum = '", qcd%md5sum, "'"
   end subroutine qcd_write
 
 @ %def qcd_write
 @ Compute an MD5 sum for the [[alpha_s]] setup.  This is
 done by writing them to a temporary file, using a standard format.
 <<SM qcd: qcd: TBP>>=
   procedure :: compute_alphas_md5sum => qcd_compute_alphas_md5sum
 <<SM qcd: sub interfaces>>=
     module subroutine qcd_compute_alphas_md5sum (qcd)
       class(qcd_t), intent(inout) :: qcd
       integer :: unit
     end subroutine qcd_compute_alphas_md5sum
 <<SM qcd: procedures>>=
   module subroutine qcd_compute_alphas_md5sum (qcd)
     class(qcd_t), intent(inout) :: qcd
     integer :: unit
     if (allocated (qcd%alpha)) then
        unit = free_unit ()
        open (unit, status="scratch", action="readwrite")
        call qcd%alpha%write (unit)
        rewind (unit)
        qcd%md5sum = md5sum (unit)
        close (unit)
     end if
   end subroutine qcd_compute_alphas_md5sum
 
 @ %def qcd_compute_alphas_md5sum
 @
 @ Retrieve the MD5 sum of the qcd setup.
 <<SM qcd: qcd: TBP>>=
   procedure :: get_md5sum => qcd_get_md5sum
 <<SM qcd: sub interfaces>>=
     module function qcd_get_md5sum (qcd) result (md5sum)
       character(32) :: md5sum
       class(qcd_t), intent(inout) :: qcd
     end function qcd_get_md5sum
 <<SM qcd: procedures>>=
   module function qcd_get_md5sum (qcd) result (md5sum)
     character(32) :: md5sum
     class(qcd_t), intent(inout) :: qcd
     md5sum = qcd%md5sum
   end function qcd_get_md5sum
 
 @ %def qcd_get_md5sum
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sm_qcd_ut.f90]]>>=
 <<File header>>
 
 module sm_qcd_ut
   use unit_tests
   use sm_qcd_uti
 
 <<Standard module head>>
 
 <<SM qcd: public test>>
 
 contains
 
 <<SM qcd: test driver>>
 
 end module sm_qcd_ut
 @ %def sm_qcd_ut
 @
 <<[[sm_qcd_uti.f90]]>>=
 <<File header>>
 
 module sm_qcd_uti
 
 <<Use kinds>>
   use physics_defs, only: MZ_REF
 
   use sm_qcd
 
 <<Standard module head>>
 
 <<SM qcd: test declarations>>
 
 contains
 
 <<SM qcd: tests>>
 
 end module sm_qcd_uti
 @ %def sm_qcd_ut
 @ API: driver for the unit tests below.
 <<SM qcd: public test>>=
   public :: sm_qcd_test
 <<SM qcd: test driver>>=
   subroutine sm_qcd_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SM qcd: execute tests>>
   end subroutine sm_qcd_test
 
 @ %def sm_qcd_test
 @
 \subsubsection{QCD Coupling}
 We check two different implementations of the abstract QCD coupling.
 <<SM qcd: execute tests>>=
   call test (sm_qcd_1, "sm_qcd_1", &
        "running alpha_s", &
        u, results)
 <<SM qcd: test declarations>>=
   public :: sm_qcd_1
 <<SM qcd: tests>>=
   subroutine sm_qcd_1 (u)
     integer, intent(in) :: u
     type(qcd_t) :: qcd
 
     write (u, "(A)")  "* Test output: sm_qcd_1"
     write (u, "(A)")  "*   Purpose: compute running alpha_s"
     write (u, "(A)")
 
     write (u, "(A)")  "* Fixed:"
     write (u, "(A)")
 
     allocate (alpha_qcd_fixed_t :: qcd%alpha)
     call qcd%compute_alphas_md5sum ()
 
     call qcd%write (u)
     write (u, *)
     write (u, "(1x,A,F10.7)")  "alpha_s (mz)    =", &
          qcd%alpha%get (MZ_REF)
     write (u, "(1x,A,F10.7)")  "alpha_s (1 TeV) =", &
          qcd%alpha%get (1000._default)
     write (u, *)
     deallocate (qcd%alpha)
 
     write (u, "(A)")  "* Running from MZ (LO):"
     write (u, "(A)")
 
     allocate (alpha_qcd_from_scale_t :: qcd%alpha)
     call qcd%compute_alphas_md5sum ()
 
     call qcd%write (u)
     write (u, *)
     write (u, "(1x,A,F10.7)")  "alpha_s (mz)    =", &
          qcd%alpha%get (MZ_REF)
     write (u, "(1x,A,F10.7)")  "alpha_s (1 TeV) =", &
          qcd%alpha%get (1000._default)
     write (u, *)
 
     write (u, "(A)")  "* Running from MZ (NLO):"
     write (u, "(A)")
 
     select type (alpha => qcd%alpha)
     type is (alpha_qcd_from_scale_t)
        alpha%order = 1
     end select
     call qcd%compute_alphas_md5sum ()
 
     call qcd%write (u)
     write (u, *)
     write (u, "(1x,A,F10.7)")  "alpha_s (mz)    =", &
          qcd%alpha%get (MZ_REF)
     write (u, "(1x,A,F10.7)")  "alpha_s (1 TeV) =", &
          qcd%alpha%get (1000._default)
     write (u, *)
 
     write (u, "(A)")  "* Running from MZ (NNLO):"
     write (u, "(A)")
 
     select type (alpha => qcd%alpha)
     type is (alpha_qcd_from_scale_t)
        alpha%order = 2
     end select
     call qcd%compute_alphas_md5sum ()
 
     call qcd%write (u)
     write (u, *)
     write (u, "(1x,A,F10.7)")  "alpha_s (mz)    =", &
          qcd%alpha%get (MZ_REF)
     write (u, "(1x,A,F10.7)")  "alpha_s (1 TeV) =", &
          qcd%alpha%get (1000._default)
     write (u, *)
 
     deallocate (qcd%alpha)
     write (u, "(A)")  "* Running from Lambda_QCD (LO):"
     write (u, "(A)")
 
     allocate (alpha_qcd_from_lambda_t :: qcd%alpha)
     call qcd%compute_alphas_md5sum ()
 
     call qcd%write (u)
     write (u, *)
     write (u, "(1x,A,F10.7)")  "alpha_s (mz)    =", &
          qcd%alpha%get (MZ_REF)
     write (u, "(1x,A,F10.7)")  "alpha_s (1 TeV) =", &
          qcd%alpha%get (1000._default)
     write (u, *)
 
     write (u, "(A)")  "* Running from Lambda_QCD (NLO):"
     write (u, "(A)")
 
     select type (alpha => qcd%alpha)
     type is (alpha_qcd_from_lambda_t)
        alpha%order = 1
     end select
     call qcd%compute_alphas_md5sum ()
 
     call qcd%write (u)
     write (u, *)
     write (u, "(1x,A,F10.7)")  "alpha_s (mz)    =", &
          qcd%alpha%get (MZ_REF)
     write (u, "(1x,A,F10.7)")  "alpha_s (1 TeV) =", &
          qcd%alpha%get (1000._default)
     write (u, *)
 
     write (u, "(A)")  "* Running from Lambda_QCD (NNLO):"
     write (u, "(A)")
 
     select type (alpha => qcd%alpha)
     type is (alpha_qcd_from_lambda_t)
        alpha%order = 2
     end select
     call qcd%compute_alphas_md5sum ()
 
     call qcd%write (u)
     write (u, *)
     write (u, "(1x,A,F10.7)")  "alpha_s (mz)    =", &
          qcd%alpha%get (MZ_REF)
     write (u, "(1x,A,F10.7)")  "alpha_s (1 TeV) =", &
          qcd%alpha%get (1000._default)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sm_qcd_1"
 
   end subroutine sm_qcd_1
 
 @ %def sm_qcd_1
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{QED Coupling}
 On the surface similar to the QCD coupling module but much simpler.
 Only a fixed QED couping $\alpha_\text{em}$ is allowed.
 Can be extended later if we want to enable a running of
 $\alpha_\text{em}$ as well.
 <<[[sm_qed.f90]]>>=
 <<File header>>
 
 module sm_qed
 
 <<Use kinds>>
   use physics_defs
 
 <<Standard module head>>
 
 <<SM qed: public>>
 
 <<SM qed: types>>
 
 <<SM qed: interfaces>>
 
   interface
 <<SM qed: sub interfaces>>
   end interface
 
 end module sm_qed
 @ %def sm_qed
 @
 <<[[sm_qed_sub.f90]]>>=
 <<File header>>
 
 submodule (sm_qed) sm_qed_s
 
   use io_units
   use format_defs, only: FMT_12
   use md5
   use sm_physics
 
   implicit none
 
 contains
 
 <<SM qed: procedures>>
 
 end submodule sm_qed_s
 
 @ %def sm_qed_s
 @
 \subsection{Coupling: Abstract Data Type}
 This is the abstract version of the QCD coupling implementation.
 <<SM qed: public>>=
   public :: alpha_qed_t
 <<SM qed: types>>=
   type, abstract :: alpha_qed_t
    contains
    <<SM qed: alpha qed: TBP>>
   end type alpha_qed_t
 
 @ %def alpha_qed_t
 @ There must be an output routine.
 <<SM qed: alpha qed: TBP>>=
   procedure (alpha_qed_write), deferred :: write
 <<SM qed: interfaces>>=
   abstract interface
      subroutine alpha_qed_write (object, unit)
        import
        class(alpha_qed_t), intent(in) :: object
        integer, intent(in), optional :: unit
      end subroutine alpha_qed_write
   end interface
 
 @ %def alpha_qed_write
 @ This method computes the running coupling, given a certain scale.  All
 parameters (reference value, order of the approximation, etc.) must be
 set before calling this.
 <<SM qed: alpha qed: TBP>>=
   procedure (alpha_qed_get), deferred :: get
 <<SM qed: interfaces>>=
   abstract interface
      function alpha_qed_get (alpha_qed, scale) result (alpha)
        import
        class(alpha_qed_t), intent(in) :: alpha_qed
        real(default), intent(in) :: scale
        real(default) :: alpha
      end function alpha_qed_get
   end interface
 
 @ %def alpha_qed_get
 @
 \subsection{Fixed Coupling}
 In this version, the $\alpha$ value is fixed, the [[scale]] argument
 of the [[get]] method is ignored.  There is only one parameter, the
 value. The default depends on the electroweak scheme chosen in the
 model.
 <<SM qed: public>>=
   public :: alpha_qed_fixed_t
 <<SM qed: types>>=
   type, extends (alpha_qed_t) :: alpha_qed_fixed_t
      real(default) :: val = ALPHA_QED_ME_REF
    contains
    <<SM qed: alpha qed fixed: TBP>>
   end type alpha_qed_fixed_t
 
 @ %def alpha_qed_fixed_t
 @ Output.
 <<SM qed: alpha qed fixed: TBP>>=
   procedure :: write => alpha_qed_fixed_write
 <<SM qed: sub interfaces>>=
     module subroutine alpha_qed_fixed_write (object, unit)
       class(alpha_qed_fixed_t), intent(in) :: object
       integer, intent(in), optional :: unit
     end subroutine alpha_qed_fixed_write
 <<SM qed: procedures>>=
   module subroutine alpha_qed_fixed_write (object, unit)
     class(alpha_qed_fixed_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(3x,A)")  "QED parameters (fixed coupling):"
     write (u, "(5x,A," // FMT_12 // ")")  "alpha = ", object%val
   end subroutine alpha_qed_fixed_write
 
 @ %def alpha_qed_fixed_write
 @ Calculation: the scale is ignored in this case.
 <<SM qed: alpha qed fixed: TBP>>=
   procedure :: get => alpha_qed_fixed_get
 <<SM qed: sub interfaces>>=
     module function alpha_qed_fixed_get (alpha_qed, scale) result (alpha)
       class(alpha_qed_fixed_t), intent(in) :: alpha_qed
       real(default), intent(in) :: scale
       real(default) :: alpha
     end function alpha_qed_fixed_get
 <<SM qed: procedures>>=
   module function alpha_qed_fixed_get (alpha_qed, scale) result (alpha)
     class(alpha_qed_fixed_t), intent(in) :: alpha_qed
     real(default), intent(in) :: scale
     real(default) :: alpha
     alpha = alpha_qed%val
   end function alpha_qed_fixed_get
 
 @ %def alpha_qed_fixed_get
 @
 \subsection{Running Coupling}
 In this version, the $\alpha$ value runs relative to the value at a
 given reference scale.  There are two parameters: the value of this
 scale (default: $M_Z$), the value of $\alpha$ at this scale, and the
 number of effective flavors.  Furthermore, we have the order of the
 approximation.
 <<SM qed: public>>=
   public :: alpha_qed_from_scale_t
 <<SM qed: types>>=
   type, extends (alpha_qed_t) :: alpha_qed_from_scale_t
      real(default) :: mu_ref = ME_REF
      real(default) :: ref = ALPHA_QED_ME_REF
      integer :: order = 0
      integer :: nf = 5
      integer :: nlep = 1
      logical :: analytic = .true.
    contains
    <<SM qed: alpha qed from scale: TBP>>
   end type alpha_qed_from_scale_t
 
 @ %def alpha_qed_from_scale_t
 @ Output.
 <<SM qed: alpha qed from scale: TBP>>=
   procedure :: write => alpha_qed_from_scale_write
 <<SM qed: sub interfaces>>=
     module subroutine alpha_qed_from_scale_write (object, unit)
       class(alpha_qed_from_scale_t), intent(in) :: object
       integer, intent(in), optional :: unit
     end subroutine alpha_qed_from_scale_write
 <<SM qed: procedures>>=
   module subroutine alpha_qed_from_scale_write (object, unit)
     class(alpha_qed_from_scale_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(3x,A)")  "QED parameters (running coupling):"
     write (u, "(5x,A," // FMT_12 // ")")  "Scale mu  = ", object%mu_ref
     write (u, "(5x,A," // FMT_12 // ")")  "alpha(mu) = ", object%ref
     write (u, "(5x,A,I0)")      "LL order  = ", object%order
     write (u, "(5x,A,I0)")      "N(flv)    = ", object%nf
     write (u, "(5x,A,I0)")      "N(lep)    = ", object%nlep
     write (u, "(5x,A,L1)")      "analytic  = ", object%analytic
   end subroutine alpha_qed_from_scale_write
 
 @ %def alpha_qed_from_scale_write
 @ Calculation: here, we call the function for running $\alpha_s$ that
 was defined in [[sm_physics]] above.  The function does not take into
 account thresholds, so the number of flavors should be the correct one
 for the chosen scale.  Normally, this should be the $Z$ boson mass.
 <<SM qed: alpha qed from scale: TBP>>=
   procedure :: get => alpha_qed_from_scale_get
 <<SM qed: sub interfaces>>=
     module function alpha_qed_from_scale_get (alpha_qed, scale) result (alpha)
       class(alpha_qed_from_scale_t), intent(in) :: alpha_qed
       real(default), intent(in) :: scale
       real(default) :: alpha
     end function alpha_qed_from_scale_get
 <<SM qed: procedures>>=
   module function alpha_qed_from_scale_get (alpha_qed, scale) result (alpha)
     class(alpha_qed_from_scale_t), intent(in) :: alpha_qed
     real(default), intent(in) :: scale
     real(default) :: alpha
     if (alpha_qed%analytic) then
        alpha = running_alpha (scale, alpha_qed%ref, alpha_qed%mu_ref, &
             alpha_qed%order, alpha_qed%nf, alpha_qed%nlep)
     else
        alpha = running_alpha_num (scale, alpha_qed%ref, alpha_qed%mu_ref, &
             alpha_qed%order, alpha_qed%nf, alpha_qed%nlep)
     end if
   end function alpha_qed_from_scale_get
 
 @ %def alpha_qed_from_scale_get
 @
 \subsection{QED type}
 This module is similar to [[qcd_t]], defining the type [[qed_t]].
 It stores the [[alpha_qed_t]] type which is either constant or a running $\alpha$
 with different options.
 <<SM qed: public>>=
   public :: qed_t
 <<SM qed: types>>=
   type :: qed_t
      class(alpha_qed_t), allocatable :: alpha
      character(32) :: md5sum = ""
      integer :: n_f = -1
      integer :: n_lep = -1
    contains
    <<SM qed: qed: TBP>>
   end type qed_t
 
 @ %def qed_t
 Output.  We first print the polymorphic [[alpha]] which contains a headline,
 then any extra components.
 <<SM qed: qed: TBP>>=
   procedure :: write => qed_write
 <<SM qed: sub interfaces>>=
     module subroutine qed_write (qed, unit, show_md5sum)
       class(qed_t), intent(in) :: qed
       integer, intent(in), optional :: unit
       logical, intent(in), optional :: show_md5sum
     end subroutine qed_write
 <<SM qed: procedures>>=
   module subroutine qed_write (qed, unit, show_md5sum)
     class(qed_t), intent(in) :: qed
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: show_md5sum
     logical :: show_md5
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     show_md5 = .true.;  if (present (show_md5sum))  show_md5 = show_md5sum
     if (allocated (qed%alpha)) then
        call qed%alpha%write (u)
     else
        write (u, "(3x,A)")  "QED parameters (coupling undefined)"
     end if
     if (show_md5 .and. qed%md5sum /= "") &
          write (u, "(5x,A,A,A)") "md5sum = '", qed%md5sum, "'"
   end subroutine qed_write
 
 @ % def qed_write
 @ Compute an MD5 sum for the [[alpha]] setup.  This is
 done by writing them to a temporary file, using a standard format.
 <<SM qed: qed: TBP>>=
   procedure :: compute_alpha_md5sum => qed_compute_alpha_md5sum
 <<SM qed: sub interfaces>>=
     module subroutine qed_compute_alpha_md5sum (qed)
       class(qed_t), intent(inout) :: qed
       integer :: unit
     end subroutine qed_compute_alpha_md5sum
 <<SM qed: procedures>>=
   module subroutine qed_compute_alpha_md5sum (qed)
     class(qed_t), intent(inout) :: qed
     integer :: unit
     if (allocated (qed%alpha)) then
        unit = free_unit ()
        open (unit, status="scratch", action="readwrite")
        call qed%alpha%write (unit)
        rewind (unit)
        qed%md5sum = md5sum (unit)
        close (unit)
     end if
   end subroutine qed_compute_alpha_md5sum
 
 @ %def qed_compute_alphas_md5sum
 @
 @ Retrieve the MD5 sum of the qed setup.
 <<SM qed: qed: TBP>>=
   procedure :: get_md5sum => qed_get_md5sum
 <<SM qed: sub interfaces>>=
     module function qed_get_md5sum (qed) result (md5sum)
       character(32) :: md5sum
       class(qed_t), intent(inout) :: qed
     end function qed_get_md5sum
 <<SM qed: procedures>>=
   module function qed_get_md5sum (qed) result (md5sum)
     character(32) :: md5sum
     class(qed_t), intent(inout) :: qed
     md5sum = qed%md5sum
   end function qed_get_md5sum
 
 @ %def qed_get_md5sum
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sm_qed_ut.f90]]>>=
 <<File header>>
 
 module sm_qed_ut
   use unit_tests
   use sm_qed_uti
 
 <<Standard module head>>
 
 <<SM qed: public test>>
 
 contains
 
 <<SM qed: test driver>>
 
 end module sm_qed_ut
 @ %def sm_qed_ut
 @
 <<[[sm_qed_uti.f90]]>>=
 <<File header>>
 
 module sm_qed_uti
 
 <<Use kinds>>
   use physics_defs, only: ME_REF
 
   use sm_qed
 
 <<Standard module head>>
 
 <<SM qed: test declarations>>
 
 contains
 
 <<SM qed: tests>>
 
 end module sm_qed_uti
 @ %def sm_qed_ut
 @ API: driver for the unit tests below.
 <<SM qed: public test>>=
   public :: sm_qed_test
 <<SM qed: test driver>>=
   subroutine sm_qed_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SM qed: execute tests>>
   end subroutine sm_qed_test
 
 @ %def sm_qed_test
 @
 \subsubsection{QED Coupling}
 We check two different implementations of the abstract QED coupling.
 <<SM qed: execute tests>>=
   call test (sm_qed_1, "sm_qed_1", &
        "running alpha", &
        u, results)
 <<SM qed: test declarations>>=
   public :: sm_qed_1
 <<SM qed: tests>>=
   subroutine sm_qed_1 (u)
     integer, intent(in) :: u
     type(qed_t) :: qed
 
     write (u, "(A)")  "* Test output: sm_qed_1"
     write (u, "(A)")  "*   Purpose: compute running alpha"
     write (u, "(A)")
 
     write (u, "(A)")  "* Fixed:"
     write (u, "(A)")
 
     allocate (alpha_qed_fixed_t :: qed%alpha)
     call qed%compute_alpha_md5sum ()
 
     call qed%write (u)
     write (u, *)
     write (u, "(1x,A,F10.7)")  "alpha (me)     =", &
          qed%alpha%get (ME_REF)
     write (u, "(1x,A,F10.7)")  "alpha (10 GeV) =", &
          qed%alpha%get (10._default)
     write (u, "(1x,A,F10.7)")  "alpha (1 TeV)  =", &
          qed%alpha%get (1000._default)
     write (u, *)
     deallocate (qed%alpha)
 
     write (u, "(A)")  "* Running from me (LO):"
     write (u, "(A)")
 
     allocate (alpha_qed_from_scale_t :: qed%alpha)
     call qed%compute_alpha_md5sum ()
 
     call qed%write (u)
     write (u, *)
     write (u, "(1x,A,F10.7)")  "alpha (me)     =", &
          qed%alpha%get (ME_REF)
     write (u, "(1x,A,F10.7)")  "alpha (10 GeV) =", &
          qed%alpha%get (10._default)
     write (u, "(1x,A,F10.7)")  "alpha (1 TeV)  =", &
          qed%alpha%get (1000._default)
     write (u, *)
 
     write (u, "(A)")  "* Running from me (NLO, analytic):"
     write (u, "(A)")
 
     select type (alpha => qed%alpha)
     type is (alpha_qed_from_scale_t)
        alpha%order = 1
     end select
     call qed%compute_alpha_md5sum ()
 
     call qed%write (u)
     write (u, *)
     write (u, "(1x,A,F10.7)")  "alpha (me)     =", &
          qed%alpha%get (ME_REF)
     write (u, "(1x,A,F10.7)")  "alpha (10 GeV) =", &
          qed%alpha%get (10._default)
     write (u, "(1x,A,F10.7)")  "alpha (1 TeV)  =", &
          qed%alpha%get (1000._default)
     write (u, *)
 
     write (u, "(A)")  "* Running from me (NLO, numeric):"
     write (u, "(A)")
 
     select type (alpha => qed%alpha)
     type is (alpha_qed_from_scale_t)
        alpha%order = 1
        alpha%analytic = .false.
     end select
     call qed%compute_alpha_md5sum ()
 
     call qed%write (u)
     write (u, *)
     write (u, "(1x,A,F10.7)")  "alpha (me)     =", &
          qed%alpha%get (ME_REF)
     write (u, "(1x,A,F10.7)")  "alpha (10 GeV) =", &
          qed%alpha%get (10._default)
     write (u, "(1x,A,F10.7)")  "alpha (1 TeV)  =", &
          qed%alpha%get (1000._default)
     write (u, *)
     deallocate (qed%alpha)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sm_qed_1"
 
   end subroutine sm_qed_1
 
 @ %def sm_qed_1
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Shower algorithms}
 <<[[shower_algorithms.f90]]>>=
 <<File header>>
 
 module shower_algorithms
 
 <<Use kinds>>
 
 <<Standard module head>>
 
 <<Shower algorithms: public>>
 
 <<Shower algorithms: interfaces>>
 
   interface
 <<Shower algorithms: sub interfaces>>
   end interface
 
 end module shower_algorithms
 @ %def shower_algorithms
 <<[[shower_algorithms_sub.f90]]>>=
 <<File header>>
 
 submodule (shower_algorithms) shower_algorithms_s
 
   use diagnostics
   use constants
 
   implicit none
 
 contains
 
 <<Shower algorithms: procedures>>
 
 <<Shower algorithms: tests>>
 
 end submodule shower_algorithms_s
 
 @ %def shower_algorithms_s
 @
 @ We want to generate emission variables [[x]]$\in\mathds{R}^d$
 proportional to
 \begin{align}
   &\quad f(x)\; \Delta(f, h(x)) \quad\text{with}\\
   \Delta(f, H) &= \exp\left\{-\int\text{d}^d x'f(x') \Theta(h(x') -
                 H)\right\}
 \end{align}
 The [[true_function]] $f$ is however too complicated and we are only
 able to generate [[x]] according to the [[overestimator]] $F$.  This
 algorithm is described in Appendix B of 0709.2092 and is proven e.g.~in
 1211.7204 and hep-ph/0606275.  Intuitively speaking, we overestimate the
 emission probability and can therefore set [[scale_max = scale]] if the
 emission is rejected.
 <<Shower algorithms: sub interfaces>>=
     module subroutine generate_vetoed (x, overestimator, true_function, &
            sudakov, inverse_sudakov, scale_min)
       real(default), dimension(:), intent(out) :: x
       !class(rng_t), intent(inout) :: rng
       procedure(XXX_function), pointer, intent(in) :: overestimator, true_function
       procedure(sudakov_p), pointer, intent(in) :: sudakov, inverse_sudakov
       real(default), intent(in) :: scale_min
     end subroutine generate_vetoed
 <<Shower algorithms: procedures>>=
   module subroutine generate_vetoed (x, overestimator, true_function, &
          sudakov, inverse_sudakov, scale_min)
     real(default), dimension(:), intent(out) :: x
     !class(rng_t), intent(inout) :: rng
     procedure(XXX_function), pointer, intent(in) :: overestimator, true_function
     procedure(sudakov_p), pointer, intent(in) :: sudakov, inverse_sudakov
     real(default), intent(in) :: scale_min
     real(default) :: random, scale_max, scale
     scale_max = inverse_sudakov (one)
     do while (scale_max > scale_min)
        !call rng%generate (random)
        scale = inverse_sudakov (random * sudakov (scale_max))
        call generate_on_hypersphere (x, overestimator, scale)
        !call rng%generate (random)
        if (random < true_function (x) / overestimator (x)) then
           return !!! accept x
        end if
        scale_max = scale
     end do
   end subroutine generate_vetoed
 
 @ %def generate_vetoed
 @
 <<Shower algorithms: procedures>>=
   subroutine generate_on_hypersphere (x, overestimator, scale)
     real(default), dimension(:), intent(out) :: x
     procedure(XXX_function), pointer, intent(in) :: overestimator
     real(default), intent(in) :: scale
     call msg_bug ("generate_on_hypersphere: not implemented")
   end subroutine generate_on_hypersphere
 
 @ %def generate_on_hypersphere
 @
 <<Shower algorithms: interfaces>>=
   interface
     pure function XXX_function (x)
       import
       real(default) :: XXX_function
       real(default), dimension(:), intent(in) :: x
     end function XXX_function
   end interface
   interface
     pure function sudakov_p (x)
       import
       real(default) :: sudakov_p
       real(default), intent(in) :: x
     end function sudakov_p
   end interface
 @
 \subsection{Unit tests}
 (Currently unused.)
 <<XXX Shower algorithms: public>>=
   public :: shower_algorithms_test
 <<XXX Shower algorithms: tests>>=
   subroutine shower_algorithms_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Shower algorithms: execute tests>>
   end subroutine shower_algorithms_test
 
 @ %def shower_algorithms_test
 @
 \subsubsection{Splitting functions}
 <<XXX shower algorithms: execute tests>>=
   call test (shower_algorithms_1, "shower_algorithms_1", &
        "veto technique", &
        u, results)
 <<XXX shower algorithms: tests>>=
   subroutine shower_algorithms_1 (u)
     integer, intent(in) :: u
 
     write (u, "(A)")  "* Test output: shower_algorithms_1"
     write (u, "(A)")  "*   Purpose: check veto technique"
     write (u, "(A)")
 
     write (u, "(A)")  "* Splitting functions:"
     write (u, "(A)")
 
     !call assert (u, vanishes (p_qqg_pol (z, +1, -1, +1)))
     !call assert (u, nearly_equal ( &
          !p_qqg_pol (z, +1, +1, -1) + p_qqg_pol (z, +1, +1, +1),
          !p_qqg (z))
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: shower_algorithms_1"
 
   end subroutine shower_algorithms_1
 
 @ %def shower_algorithms_1
Index: trunk/src/physics/Makefile.am
===================================================================
--- trunk/src/physics/Makefile.am	(revision 8834)
+++ trunk/src/physics/Makefile.am	(revision 8835)
@@ -1,228 +1,229 @@
 ## Makefile.am -- Makefile for WHIZARD
 ##
 ## Process this file with automake to produce Makefile.in
 #
 # Copyright (C) 1999-2022 by
 #     Wolfgang Kilian <kilian@physik.uni-siegen.de>
 #     Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
 #     Juergen Reuter <juergen.reuter@desy.de>
 #     with contributions from
 #     cf. main AUTHORS file
 #
 # WHIZARD is free software; you can redistribute it and/or modify it
 # under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 2, or (at your option)
 # any later version.
 #
 # WHIZARD is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
 #
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 #
 ########################################################################
 
 ## The files in this directory implement physics definitions and functions
 ## for use in the WHIZARD generator.
 
 ## We create a library which is still to be combined with auxiliary libs.
 noinst_LTLIBRARIES = libphysics.la
 check_LTLIBRARIES = libphysics_ut.la
 
 libphysics_la_SOURCES = \
   $(PHYSICS_MODULES) \
   $(PHYSICS_SUBMODULES)
 
 PHYSICS_MODULES = \
   physics_defs.f90 \
   c_particles.f90 \
   lorentz.f90 \
   phs_points.f90 \
   sm_physics.f90 \
   sm_qcd.f90 \
   sm_qed.f90 \
   shower_algorithms.f90
 
 PHYSICS_SUBMODULES = \
   physics_defs_sub.f90 \
   c_particles_sub.f90 \
   lorentz_sub.f90 \
   phs_points_sub.f90 \
   sm_physics_sub.f90 \
   sm_qcd_sub.f90 \
   sm_qed_sub.f90 \
   shower_algorithms_sub.f90
 
 libphysics_ut_la_SOURCES = \
   sm_physics_uti.f90 sm_physics_ut.f90 \
   sm_qcd_uti.f90 sm_qcd_ut.f90 \
   sm_qed_uti.f90 sm_qed_ut.f90 \
+  lorentz_uti.f90 lorentz_ut.f90 \
   phs_points_uti.f90 phs_points_ut.f90
 
 ## Omitting this would exclude it from the distribution
 dist_noinst_DATA = physics.nw
 
 # Modules and installation
 # Dump module names into file Modules
 execmoddir = $(fmoddir)/whizard
 nodist_execmod_HEADERS = \
   ${PHYSICS_MODULES:.f90=.$(FCMOD)}
 
 # Submodules must not be included here
 libphysics_Modules = \
   ${PHYSICS_MODULES:.f90=} \
   ${libphysics_ut_la_SOURCES:.f90=}
 Modules: Makefile
 	@for module in $(libphysics_Modules); do \
           echo $$module >> $@.new; \
         done
 	@if diff $@ $@.new -q >/dev/null; then \
           rm $@.new; \
 	else \
           mv $@.new $@; echo "Modules updated"; \
         fi
 BUILT_SOURCES = Modules
 
 ## Fortran module dependencies
 # Get module lists from other directories
 module_lists = \
   ../basics/Modules \
   ../utilities/Modules \
   ../testing/Modules \
   ../system/Modules \
   ../combinatorics/Modules
 
 $(module_lists):
 	$(MAKE) -C `dirname $@` Modules
 
 Module_dependencies.sed: $(libphysics_la_SOURCES) $(libphysics_ut_la_SOURCES)
 Module_dependencies.sed: $(module_lists)
 	@rm -f $@
 	echo 's/, *only:.*//' >> $@
 	echo 's/, *&//' >> $@
 	echo 's/, *.*=>.*//' >> $@
 	echo 's/$$/.lo/' >> $@
 	for list in $(module_lists); do \
 		dir="`dirname $$list`"; \
 		for mod in `cat $$list`; do \
 			echo 's!: '$$mod'.lo$$!': $$dir/$$mod'.lo!' >> $@; \
 		done \
 	done
 
 DISTCLEANFILES = Module_dependencies.sed
 
 # The following line just says
 #    include Makefile.depend
 # but in a portable fashion (depending on automake's AM_MAKE_INCLUDE
 @am__include@ @am__quote@Makefile.depend@am__quote@
 
 Makefile.depend: Module_dependencies.sed
 Makefile.depend: $(libphysics_la_SOURCES) $(libphysics_ut_la_SOURCES)
 	@rm -f $@
 	for src in $^; do \
 	  module="`basename $$src | sed 's/\.f[90][0358]//'`"; \
 	  grep '^ *use ' $$src \
 	    | grep -v '!NODEP!' \
 	    | sed -e 's/^ *use */'$$module'.lo: /' \
 	          -f Module_dependencies.sed; \
 	done > $@
 
 DISTCLEANFILES += Makefile.depend
 
 # Fortran90 module files are generated at the same time as object files
 .lo.$(FCMOD):
 	@:
 #	touch $@
 
 AM_FCFLAGS = -I../basics -I../utilities -I../testing -I../system -I../combinatorics
 
 ########################################################################
 # For the moment, the submodule dependencies will be hard-coded
 physics_defs_sub.lo: physics_defs.lo
 c_particles_sub.lo: c_particles.lo
 lorentz_sub.lo: lorentz.lo
 phs_points_sub.lo: phs_points.lo
 sm_physics_sub.lo: sm_physics.lo
 sm_qcd_sub.lo: sm_qcd.lo
 sm_qed_sub.lo: sm_qed.lo
 shower_algorithms_sub.lo: shower_algorithms.lo
 
 ########################################################################
 ## Default Fortran compiler options
 
 ## Profiling
 if FC_USE_PROFILING
 AM_FCFLAGS += $(FCFLAGS_PROFILING)
 endif
 
 ## OpenMP
 if FC_USE_OPENMP
 AM_FCFLAGS += $(FCFLAGS_OPENMP)
 endif
 
 # MPI
 if FC_USE_MPI
 AM_FCFLAGS += $(FCFLAGS_MPI)
 endif
 
 ########################################################################
 ## Non-standard targets and dependencies
 
 ## (Re)create F90 sources from NOWEB source.
 if NOWEB_AVAILABLE
 
 PRELUDE = $(top_srcdir)/src/noweb-frame/whizard-prelude.nw
 POSTLUDE = $(top_srcdir)/src/noweb-frame/whizard-postlude.nw
 
 physics.stamp: $(PRELUDE) $(srcdir)/physics.nw $(POSTLUDE)
 	@rm -f physics.tmp
 	@touch physics.tmp
 	for src in $(libphysics_la_SOURCES) $(libphysics_ut_la_SOURCES); do \
 	  $(NOTANGLE) -R[[$$src]] $^ | $(CPIF) $$src; \
         done
 	@mv -f physics.tmp physics.stamp
 
 $(libphysics_la_SOURCES) $(libphysics_ut_la_SOURCES): physics.stamp
 ## Recover from the removal of $@
 	@if test -f $@; then :; else \
 	  rm -f physics.stamp; \
 	  $(MAKE) $(AM_MAKEFLAGS) physics.stamp; \
 	fi
 
 endif
 
 
 ########################################################################
 ## Non-standard cleanup tasks
 ## Remove sources that can be recreated using NOWEB
 if NOWEB_AVAILABLE
 maintainer-clean-noweb:
 	-rm -f *.f90 *.c
 endif
 .PHONY: maintainer-clean-noweb
 
 ## Remove those sources also if builddir and srcdir are different
 if NOWEB_AVAILABLE
 clean-noweb:
 	test "$(srcdir)" != "." && rm -f *.f90 *.c || true
 endif
 .PHONY: clean-noweb
 
 ## Remove F90 module files
 clean-local: clean-noweb
 	-rm -f physics.stamp physics.tmp
 	-rm -f *.$(FCMOD)
 if FC_SUBMODULES
 	-rm -f *.smod *.sub
 endif
 
 ## Remove backup files
 maintainer-clean-backup:
 	-rm -f *~
 .PHONY: maintainer-clean-backup
 
 ## Register additional clean targets
 maintainer-clean-local: maintainer-clean-noweb maintainer-clean-backup
Index: trunk/src/main/main.nw
===================================================================
--- trunk/src/main/main.nw	(revision 8834)
+++ trunk/src/main/main.nw	(revision 8835)
@@ -1,2340 +1,2349 @@
 % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
 % WHIZARD main code as NOWEB source
 \includemodulegraph{main}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Main Program}
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Tools for the command line}
 
 We do not intent to be very smart here, but this module provides a few
 small tools that simplify dealing with the command line.
 
 The [[unquote_value]] subroutine handles an option value that begins with a
 single/double quote character.  It swallows extra option strings until it
 finds a value that ends with another quote character.  The returned string
 consists of all argument strings between quotes, concatenated by blanks (with
 a leading blank).  Note that more complex patterns, such as quoted or embedded
 quotes, or multiple blanks, are not accounted for.
 <<[[cmdline_options.f90]]>>=
 <<File header>>
 
 module cmdline_options
 
 <<Use strings>>
   use diagnostics
 
 <<Standard module head>>
 
   public :: init_options
   public :: no_option_value
   public :: get_option_value
 
 <<Main: cmdline arg len declaration>>
 
   abstract interface
      subroutine msg
      end subroutine msg
   end interface
 
   procedure (msg), pointer :: print_usage => null ()
 
 contains
 
   subroutine init_options (usage_msg)
     procedure (msg) :: usage_msg
     print_usage => usage_msg
   end subroutine init_options
 
   subroutine no_option_value (option, value)
     type(string_t), intent(in) :: option, value
     if (value /= "") then
        call msg_error (" Option '" // char (option) // "' should have no value")
     end if
   end subroutine no_option_value
 
   function get_option_value (i, option, value) result (string)
     type(string_t) :: string
     integer, intent(inout) :: i
     type(string_t), intent(in) :: option
     type(string_t), intent(in), optional :: value
     character(CMDLINE_ARG_LEN) :: arg_value
     integer :: arg_len, arg_status
     logical :: has_value
     if (present (value)) then
        has_value = value /= ""
     else
        has_value = .false.
     end if
     if (has_value) then
        call unquote_value (i, option, value, string)
     else
        i = i + 1
        call get_command_argument (i, arg_value, arg_len, arg_status)
        select case (arg_status)
        case (0)
        case (-1)
           call msg_error (" Option value truncated: '" // arg_value // "'")
        case default
           call print_usage ()
           call msg_fatal (" Option '" // char (option) // "' needs a value")
        end select
        select case (arg_value(1:1))
        case ("-")
           call print_usage ()
           call msg_fatal (" Option '" // char (option) // "' needs a value")
        end select
        call unquote_value (i, option, var_str (trim (arg_value)), string)
     end if
   end function get_option_value
 
   subroutine unquote_value (i, option, value, string)
     integer, intent(inout) :: i
     type(string_t), intent(in) :: option
     type(string_t), intent(in) :: value
     type(string_t), intent(out) :: string
     character(1) :: quote
     character(CMDLINE_ARG_LEN) :: arg_value
     integer :: arg_len, arg_status
     quote = extract (value, 1, 1)
     select case (quote)
     case ("'", '"')
        string = ""
        arg_value = extract (value, 2)
        arg_len = len_trim (value)
        APPEND_QUOTED: do
           if (extract (arg_value, arg_len, arg_len) == quote) then
              string = string // " " // extract (arg_value, 1, arg_len-1)
              exit APPEND_QUOTED
           else
              string = string // " " // trim (arg_value)
              i = i + 1
              call get_command_argument (i, arg_value, arg_len, arg_status)
              select case (arg_status)
              case (0)
              case (-1)
                 call msg_error (" Quoted option value truncated: '" &
                      // char (string) // "'")
              case default
                 call print_usage ()
                 call msg_fatal (" Option '" // char (option) &
                      // "': unterminated quoted value")
              end select
           end if
        end do APPEND_QUOTED
     case default
        string = value
     end select
   end subroutine unquote_value
 
 end module cmdline_options
 
 @ %def init_options
 @ %def no_option_value
 @ %def get_option_value
 @ %def cmdline_options
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Driver program}
 The main program handles command options, initializes the environment,
 and runs WHIZARD in a particular mode (interactive, file, standard
 input).
 
 This is also used in the C interface:
 <<Main: cmdline arg len declaration>>=
   integer, parameter :: CMDLINE_ARG_LEN = 1000
 @ %def CMDLINE_ARG_LEN
 @
 The actual main program:
 <<[[main.f90]]>>=
 <<File header>>
 
 program main
 
 <<Use strings>>
   use system_dependencies
   use diagnostics
   use ifiles
   use os_interface
   use rt_data, only: show_description_of_string, show_tex_descriptions
   use whizard
 
   use cmdline_options
   use features
 
 <<Use mpi f08>>
 
   implicit none
 
 <<Main: cmdline arg len declaration>>
 
 !!! (WK 02/2016) Interface for the separate external routine below
   interface
      subroutine print_usage ()
      end subroutine print_usage
   end interface
 
 ! Main program variable declarations
   character(CMDLINE_ARG_LEN) :: arg
   character(2) :: option
   type(string_t) :: long_option, value
   integer :: i, j, arg_len, arg_status
   logical :: look_for_options
   logical :: interactive
   logical :: banner
   type(string_t) :: job_id, files, this, model, default_lib, library, libraries
   type(string_t) :: logfile, query_string
   type(paths_t) :: paths
   type(string_t) :: pack_arg, unpack_arg
   type(string_t), dimension(:), allocatable :: pack_args, unpack_args
   type(string_t), dimension(:), allocatable :: tmp_strings
   logical :: rebuild_library
   logical :: rebuild_phs, rebuild_grids, rebuild_events
   logical :: recompile_library
   type(ifile_t) :: commands
   type(string_t) :: command, cmdfile
   integer :: cmdfile_unit
   logical :: cmdfile_exists
 
   type(whizard_options_t), allocatable :: options
   type(whizard_t), allocatable, target :: whizard_instance
 
   ! Exit status
   logical :: quit = .false.
   integer :: quit_code = 0
 
   ! Initial values
   look_for_options = .true.
   interactive = .false.
   job_id = ""
   files = ""
   model = "SM"
   default_lib = "default_lib"
   library = ""
   libraries = ""
   banner = .true.
   logging = .true.
   msg_level = RESULT
   logfile = "whizard.log"
   rebuild_library = .false.
   rebuild_phs = .false.
   rebuild_grids = .false.
   rebuild_events = .false.
   recompile_library = .false.
   call paths_init (paths)
 
 <<Main: MPI init>>
 
   ! Read and process options
   call init_options (print_usage)
   i = 0
   SCAN_CMDLINE: do
      i = i + 1
      call get_command_argument (i, arg, arg_len, arg_status)
      select case (arg_status)
      case (0)
      case (-1)
         call msg_error (" Command argument truncated: '" // arg // "'")
      case default
         exit SCAN_CMDLINE
      end select
      if (look_for_options) then
         select case (arg(1:2))
         case ("--")
            value = trim (arg)
            call split (value, long_option, "=")
            select case (char (long_option))
            case ("--version")
               call no_option_value (long_option, value)
               call print_version (); stop
            case ("--help")
               call no_option_value (long_option, value)
               call print_usage (); stop
            case ("--prefix")
               paths%prefix = get_option_value (i, long_option, value)
               cycle scan_cmdline
            case ("--exec-prefix")
               paths%exec_prefix = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--bindir")
               paths%bindir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--libdir")
               paths%libdir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--includedir")
               paths%includedir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--datarootdir")
               paths%datarootdir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--libtool")
               paths%libtool = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--lhapdfdir")
               paths%lhapdfdir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--check")
               call print_usage ()
               call msg_fatal ("Option --check not supported &
                    &(for unit tests, run whizard_ut instead)")
            case ("--show-config")
               call no_option_value (long_option, value)
               call print_features (); stop
            case ("--execute")
               command = get_option_value (i, long_option, value)
               call ifile_append (commands, command)
               cycle SCAN_CMDLINE
            case ("--file")
               cmdfile = get_option_value (i, long_option, value)
               inquire (file=char(cmdfile), exist=cmdfile_exists)
               if (cmdfile_exists) then
                  open (newunit=cmdfile_unit, file=char(cmdfile), &
                       action="read", status="old")
                  call ifile_append (commands, cmdfile_unit)
                  close (cmdfile_unit)
               else
                  call msg_error &
                       ("Sindarin file '" // char (cmdfile) // "' not found")
               end if
               cycle SCAN_CMDLINE
            case ("--interactive")
               call no_option_value (long_option, value)
               interactive = .true.
               cycle SCAN_CMDLINE
            case ("--job-id")
               job_id = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--library")
               library = get_option_value (i, long_option, value)
               libraries = libraries // " " // library
               cycle SCAN_CMDLINE
            case ("--no-library")
               call no_option_value (long_option, value)
               default_lib = ""
               library = ""
               libraries = ""
               cycle SCAN_CMDLINE
            case ("--localprefix")
               paths%localprefix = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--logfile")
               logfile = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--no-logfile")
               call no_option_value (long_option, value)
               logfile = ""
               cycle SCAN_CMDLINE
            case ("--logging")
               call no_option_value (long_option, value)
               logging = .true.
               cycle SCAN_CMDLINE
            case ("--no-logging")
               call no_option_value (long_option, value)
               logging = .false.
               cycle SCAN_CMDLINE
            case ("--query")
               call no_option_value (long_option, value)
               query_string = get_option_value (i, long_option, value)
               call show_description_of_string (query_string)
               call exit (0)
            case ("--generate-variables-tex")
               call no_option_value (long_option, value)
               call show_tex_descriptions ()
               call exit (0)
            case ("--debug")
               call no_option_value (long_option, value)
               call set_debug_levels (get_option_value (i, long_option, value))
               cycle SCAN_CMDLINE
            case ("--debug2")
               call no_option_value (long_option, value)
               call set_debug2_levels (get_option_value (i, long_option, value))
               cycle SCAN_CMDLINE
            case ("--single-event")
               call no_option_value (long_option, value)
               single_event = .true.
               cycle SCAN_CMDLINE
            case ("--banner")
               call no_option_value (long_option, value)
               banner = .true.
               cycle SCAN_CMDLINE
            case ("--no-banner")
               call no_option_value (long_option, value)
               banner = .false.
               cycle SCAN_CMDLINE
            case ("--pack")
               pack_arg = get_option_value (i, long_option, value)
               if (allocated (pack_args)) then
                  call move_alloc (from=pack_args, to=tmp_strings)
                  allocate (pack_args (size (tmp_strings)+1))
                  pack_args(1:size(tmp_strings)) = tmp_strings
               else
                  allocate (pack_args (1))
               end if
               pack_args(size(pack_args)) = pack_arg
               cycle SCAN_CMDLINE
            case ("--unpack")
               unpack_arg = get_option_value (i, long_option, value)
               if (allocated (unpack_args)) then
                  call move_alloc (from=unpack_args, to=tmp_strings)
                  allocate (unpack_args (size (tmp_strings)+1))
                  unpack_args(1:size(tmp_strings)) = tmp_strings
               else
                  allocate (unpack_args (1))
               end if
               unpack_args(size(unpack_args)) = unpack_arg
               cycle SCAN_CMDLINE
            case ("--model")
               model = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--no-model")
               call no_option_value (long_option, value)
               model = ""
               cycle SCAN_CMDLINE
            case ("--rebuild")
               call no_option_value (long_option, value)
               rebuild_library = .true.
               rebuild_phs = .true.
               rebuild_grids = .true.
               rebuild_events = .true.
               cycle SCAN_CMDLINE
            case ("--no-rebuild")
               call no_option_value (long_option, value)
               rebuild_library = .false.
               recompile_library = .false.
               rebuild_phs = .false.
               rebuild_grids = .false.
               rebuild_events = .false.
               cycle SCAN_CMDLINE
            case ("--rebuild-library")
               call no_option_value (long_option, value)
               rebuild_library = .true.
               cycle SCAN_CMDLINE
            case ("--rebuild-phase-space")
               call no_option_value (long_option, value)
               rebuild_phs = .true.
               cycle SCAN_CMDLINE
            case ("--rebuild-grids")
               call no_option_value (long_option, value)
               rebuild_grids = .true.
               cycle SCAN_CMDLINE
            case ("--rebuild-events")
               call no_option_value (long_option, value)
               rebuild_events = .true.
               cycle SCAN_CMDLINE
            case ("--recompile")
               call no_option_value (long_option, value)
               recompile_library = .true.
               rebuild_grids = .true.
               cycle SCAN_CMDLINE
            case ("--write-syntax-tables")
               call no_option_value (long_option, value)
         call init_syntax_tables ()
               call write_syntax_tables ()
               call final_syntax_tables ()
               stop
               cycle SCAN_CMDLINE
            case default
               call print_usage ()
               call msg_fatal ("Option '" // trim (arg) // "' not recognized")
            end select
         end select
         select case (arg(1:1))
         case ("-")
            j = 1
            if (len_trim (arg) == 1) then
               look_for_options = .false.
            else
               SCAN_SHORT_OPTIONS: do
                  j = j + 1
                  if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS
                  option = "-" // arg(j:j)
                  select case (option)
                  case ("-V")
                     call print_version (); stop
                  case ("-?", "-h")
                     call print_usage (); stop
                  case ("-e")
                     command = get_option_value (i, var_str (option))
                     call ifile_append (commands, command)
                     cycle SCAN_CMDLINE
                  case ("-f")
                     cmdfile = get_option_value (i, var_str (option))
                     inquire (file=char(cmdfile), exist=cmdfile_exists)
                     if (cmdfile_exists) then
                        open (newunit=cmdfile_unit, file=char(cmdfile), &
                             action="read", status="old")
                        call ifile_append (commands, cmdfile_unit)
                        close (cmdfile_unit)
                     else
                        call msg_error ("Sindarin file '" &
                             // char (cmdfile) // "' not found")
                     end if
                     cycle SCAN_CMDLINE
                  case ("-i")
                     interactive = .true.
                     cycle SCAN_SHORT_OPTIONS
                  case ("-J")
                     if (j == len_trim (arg)) then
                        job_id = get_option_value (i, var_str (option))
                     else
                        job_id = trim (arg(j+1:))
                     end if
                     cycle SCAN_CMDLINE
                  case ("-l")
                     if (j == len_trim (arg)) then
                        library = get_option_value (i, var_str (option))
                     else
                        library = trim (arg(j+1:))
                     end if
                     libraries = libraries // " " // library
                     cycle SCAN_CMDLINE
                  case ("-L")
                     if (j == len_trim (arg)) then
                        logfile = get_option_value (i, var_str (option))
                     else
                        logfile = trim (arg(j+1:))
                     end if
                     cycle SCAN_CMDLINE
                  case ("-m")
                     if (j < len_trim (arg))  call msg_fatal &
                          ("Option '" // option // "' needs a value")
                     model = get_option_value (i, var_str (option))
                     cycle SCAN_CMDLINE
                  case ("-q")
                     call no_option_value (long_option, value)
                     query_string = get_option_value (i, long_option, value)
                     call show_description_of_string (query_string)
                     call exit (0)
                  case ("-r")
                     rebuild_library = .true.
                     rebuild_phs = .true.
                     rebuild_grids = .true.
                     rebuild_events = .true.
                     cycle SCAN_SHORT_OPTIONS
                  case default
                     call print_usage ()
                     call msg_fatal &
                          ("Option '" // option // "' not recognized")
                  end select
               end do SCAN_SHORT_OPTIONS
            end if
         case default
            files = files // " " // trim (arg)
         end select
      else
         files = files // " " // trim (arg)
      end if
   end do SCAN_CMDLINE
 
   ! Overall initialization
   if (logfile /= "")  call logfile_init (logfile)
   if (banner)  call msg_banner ()
 
    allocate (options)
    allocate (whizard_instance)
 
    if (.not. quit) then
 
       ! Set options and initialize the whizard object
       options%job_id = job_id
       if (allocated (pack_args)) then
          options%pack_args = pack_args
       else
          allocate (options%pack_args (0))
       end if
       if (allocated (unpack_args)) then
          options%unpack_args = unpack_args
       else
          allocate (options%unpack_args (0))
       end if
       options%preload_model = model
       options%default_lib = default_lib
       options%preload_libraries = libraries
       options%rebuild_library = rebuild_library
       options%recompile_library = recompile_library
       options%rebuild_phs = rebuild_phs
       options%rebuild_grids = rebuild_grids
       options%rebuild_events = rebuild_events
     <<Main: dependent flags>>
 
       call whizard_instance%init (options, paths, logfile)
 
       call mask_term_signals ()
 
    end if
 
    ! Run commands given on the command line
    if (.not. quit .and. ifile_get_length (commands) > 0) then
       call whizard_instance%process_ifile (commands, quit, quit_code)
    end if
 
    if (.not. quit) then
       ! Process commands from standard input
       if (.not. interactive .and. files == "") then
          call whizard_instance%process_stdin (quit, quit_code)
 
          ! ... or process commands from file
       else
          files = trim (adjustl (files))
          SCAN_FILES: do while (files /= "")
             call split (files, this, " ")
             call whizard_instance%process_file (this, quit, quit_code)
             if (quit)  exit SCAN_FILES
          end do SCAN_FILES
 
       end if
   end if
 
   ! Enter an interactive shell if requested
   if (.not. quit .and. interactive) then
      call whizard_instance%shell (quit_code)
   end if
 
   ! Overall finalization
   call ifile_final (commands)
 
   deallocate (options)
 
   call whizard_instance%final ()
   deallocate (whizard_instance)
 
 <<Main: MPI finalize>>
 
   call terminate_now_if_signal ()
   call release_term_signals ()
   call msg_terminate (quit_code = quit_code)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 contains
 
   subroutine print_version ()
     print "(A)", "WHIZARD " // WHIZARD_VERSION
     print "(A)", "Copyright (C) 1999-2022 Wolfgang Kilian, Thorsten Ohl, Juergen Reuter"
     print "(A)", "              ---------------------------------------                "
     print "(A)", "This is free software; see the source for copying conditions.  There is NO"
     print "(A)", "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
     print *
   end subroutine print_version
 
 end program main
 
 !!! (WK 02/2016)
 !!! Separate subroutine, because this becomes a procedure pointer target
 !!! Internal procedures as targets are not supported by some compilers.
 
   subroutine print_usage ()
     use system_dependencies, only: WHIZARD_VERSION
     print "(A)", "WHIZARD " // WHIZARD_VERSION
     print "(A)", "Usage: whizard [OPTIONS] [FILE]"
     print "(A)", "Run WHIZARD with the command list taken from FILE(s)"
     print "(A)", "Options for resetting default directories and tools" &
             // "(GNU naming conventions):"
     print "(A)", "    --prefix DIR"
     print "(A)", "    --exec-prefix DIR"
     print "(A)", "    --bindir DIR"
     print "(A)", "    --libdir DIR"
     print "(A)", "    --includedir DIR"
     print "(A)", "    --datarootdir DIR"
     print "(A)", "    --libtool LOCAL_LIBTOOL"
     print "(A)", "    --lhapdfdir DIR   (PDF sets directory)"
     print "(A)", "Other options:"
     print "(A)", "-h, --help            display this help and exit"
     print "(A)", "    --banner          display banner at startup (default)"
     print "(A)", "    --debug AREA      switch on debug output for AREA."
     print "(A)", "                      AREA can be one of Whizard's src dirs or 'all'"
     print "(A)", "    --debug2 AREA     switch on more verbose debug output for AREA."
     print "(A)", "    --single-event    only compute one phase-space point (for debugging)"
     print "(A)", "-e, --execute CMDS    execute SINDARIN CMDS before reading FILE(s)"
     print "(A)", "-f, --file CMDFILE    execute SINDARIN from CMDFILE before reading FILE(s)"
     print "(A)", "-i, --interactive     run interactively after reading FILE(s)"
     print "(A)", "-J, --job-id STRING   set job ID to STRING (default: empty)"
     print "(A)", "-l, --library LIB     preload process library NAME"
     print "(A)", "    --localprefix DIR"
     print "(A)", "                      search in DIR for local models (default: ~/.whizard)"
     print "(A)", "-L, --logfile FILE    write log to FILE (default: 'whizard.log'"
     print "(A)", "    --logging         switch on logging at startup (default)"
     print "(A)", "-m, --model NAME      preload model NAME (default: 'SM')"
     print "(A)", "    --no-banner       do not display banner at startup"
     print "(A)", "    --no-library      do not preload process library"
     print "(A)", "    --no-logfile      do not write a logfile"
     print "(A)", "    --no-logging      switch off logging at startup"
     print "(A)", "    --no-model        do not preload a model"
     print "(A)", "    --no-rebuild      do not force rebuilding"
     print "(A)", "    --pack DIR        tar/gzip DIR after job"
     print "(A)", "-q, --query VARIABLE  display documentation of VARIABLE"
     print "(A)", "-r, --rebuild         rebuild all (see below)"
     print "(A)", "    --rebuild-library"
     print "(A)", "                      rebuild process code library"
     print "(A)", "    --rebuild-phase-space"
     print "(A)", "                      rebuild phase-space configuration"
     print "(A)", "    --rebuild-grids   rebuild integration grids"
     print "(A)", "    --rebuild-events  rebuild event samples"
     print "(A)", "    --recompile       recompile process code"
     print "(A)", "    --show-config     show build-time configuration"
     print "(A)", "    --unpack FILE     untar/gunzip FILE before job"
     print "(A)", "-V, --version         output version information and exit"
     print "(A)", "    --write-syntax-tables"
     print "(A)", "                      write the internal syntax tables to files and exit"
     print "(A)", "-                     further options are taken as filenames"
     print *
     print "(A)", "With no FILE, read standard input."
   end subroutine print_usage
 
 @ %def main
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Driver program for the unit tests}
 This is a variant of the above main program that takes unit-test names
 as command-line options and runs those tests.
 <<[[main_ut.f90]]>>=
 <<File header>>
 
 program main_ut
 
 <<Use strings>>
   use unit_tests
   use io_units
   use system_dependencies
   use diagnostics
   use os_interface
 
   use cmdline_options
 
   use model_testbed !NODEP!
 <<Use mpi f08>>
 
 <<Main: use tests>>
 
   implicit none
 
 <<Main: cmdline arg len declaration>>
 
 !!! (WK 02/2016) Interface for the separate external routine below
   interface
      subroutine print_usage ()
      end subroutine print_usage
   end interface
 
   ! Main program variable declarations
   character(CMDLINE_ARG_LEN) :: arg
   character(2) :: option
   type(string_t) :: long_option, value
   integer :: i, j, arg_len, arg_status
   logical :: look_for_options
   logical :: banner
   type(string_t) :: check, checks
   type(test_results_t) :: test_results
   logical :: success
 
   ! Exit status
   integer :: quit_code = 0
 
   ! Initial values
   look_for_options = .true.
   banner = .true.
   logging = .false.
   msg_level = RESULT
   check = ""
   checks = ""
 
 <<Main: MPI init>>
 
   ! Read and process options
   call init_options (print_usage)
   i = 0
   SCAN_CMDLINE: do
      i = i + 1
      call get_command_argument (i, arg, arg_len, arg_status)
      select case (arg_status)
      case (0)
      case (-1)
         call msg_error (" Command argument truncated: '" // arg // "'")
      case default
         exit SCAN_CMDLINE
      end select
      if (look_for_options) then
         select case (arg(1:2))
         case ("--")
            value = trim (arg)
            call split (value, long_option, "=")
            select case (char (long_option))
            case ("--version")
               call no_option_value (long_option, value)
               call print_version (); stop
            case ("--help")
               call no_option_value (long_option, value)
               call print_usage (); stop
            case ("--banner")
               call no_option_value (long_option, value)
               banner = .true.
               cycle SCAN_CMDLINE
            case ("--no-banner")
               call no_option_value (long_option, value)
               banner = .false.
               cycle SCAN_CMDLINE
            case ("--check")
               check = get_option_value (i, long_option, value)
               checks = checks // " " // check
               cycle SCAN_CMDLINE
            case ("--debug")
               call no_option_value (long_option, value)
               call set_debug_levels (get_option_value (i, long_option, value))
               cycle SCAN_CMDLINE
            case ("--debug2")
               call no_option_value (long_option, value)
               call set_debug2_levels (get_option_value (i, long_option, value))
               cycle SCAN_CMDLINE
            case default
               call print_usage ()
               call msg_fatal ("Option '" // trim (arg) // "' not recognized")
            end select
         end select
         select case (arg(1:1))
         case ("-")
            j = 1
            if (len_trim (arg) == 1) then
               look_for_options = .false.
            else
               SCAN_SHORT_OPTIONS: do
                  j = j + 1
                  if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS
                  option = "-" // arg(j:j)
                  select case (option)
                  case ("-V")
                     call print_version (); stop
                  case ("-?", "-h")
                     call print_usage (); stop
                  case default
                     call print_usage ()
                     call msg_fatal &
                          ("Option '" // option // "' not recognized")
                  end select
               end do SCAN_SHORT_OPTIONS
            end if
         case default
            call print_usage ()
            call msg_fatal ("Option '" // trim (arg) // "' not recognized")
         end select
      else
         call print_usage ()
         call msg_fatal ("Option '" // trim (arg) // "' not recognized")
      end if
   end do SCAN_CMDLINE
 
   ! Overall initialization
   if (banner)  call msg_banner ()
 
    ! Run any self-checks (and no commands)
    if (checks /= "") then
       checks = trim (adjustl (checks))
       RUN_CHECKS: do while (checks /= "")
          call split (checks, check, " ")
          call whizard_check (check, test_results)
       end do RUN_CHECKS
       call test_results%wrapup (6, success)
       if (.not. success)  quit_code = 7
    end if
 
  <<Main: MPI finalize>>
 
    call msg_terminate (quit_code = quit_code)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 contains
 
   subroutine print_version ()
     print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)"
     print "(A)", "Copyright (C) 1999-2022 Wolfgang Kilian, Thorsten Ohl, Juergen Reuter"
     print "(A)", "              ---------------------------------------                "
     print "(A)", "This is free software; see the source for copying conditions.  There is NO"
     print "(A)", "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
     print *
   end subroutine print_version
 
 <<Main: tests>>
 
 end program main_ut
 
 !!! (WK 02/2016)
 !!! Separate subroutine, because this becomes a procedure pointer target
 !!! Internal procedures as targets are not supported by some compilers.
 
   subroutine print_usage ()
     use system_dependencies, only: WHIZARD_VERSION
     print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)"
     print "(A)", "Usage: whizard_ut [OPTIONS] [FILE]"
     print "(A)", "Run WHIZARD unit tests as given on the command line"
     print "(A)", "Options:"
     print "(A)", "-h, --help            display this help and exit"
     print "(A)", "    --banner          display banner at startup (default)"
     print "(A)", "    --no-banner       do not display banner at startup"
     print "(A)", "    --debug AREA      switch on debug output for AREA."
     print "(A)", "                      AREA can be one of Whizard's src dirs or 'all'"
     print "(A)", "    --debug2 AREA     switch on more verbose debug output for AREA."
     print "(A)", "-V, --version         output version information and exit"
     print "(A)", "    --check TEST      run unit test TEST"
   end subroutine print_usage
 @ %def main_ut
 @
 <<Main: MPI init>>=
 @
 <<Main: MPI finalize>>=
 @
 @ MPI init.
 <<MPI: Main: MPI init>>=
   call MPI_init ()
 <<MPI: Main: MPI finalize>>=
   call MPI_finalize ()
 @ %def MPI_init MPI_finalize
 <<Main: dependent flags>>=
 @
 Every rebuild action is forbidden for the slave workers except
 [[rebuild_grids]], which is handled correctly inside the corresponding
 integration object.
 <<MPI: Main: dependent flags>>=
   if (.not. mpi_is_comm_master ()) then
     options%rebuild_library = .false.
     options%recompile_library = .false.
     options%rebuild_phs = .false.
     options%rebuild_events = .false.
   end if
 @
 \subsection{Self-tests}
 For those self-tests, we need some auxiliary routines that provide an
 enviroment.  The environment depends on things that are not available at the
 level of the module that we want to test.
 
 \subsubsection{Testbed for event I/O}
 This subroutine prepares a test process with a single event.  All objects are
 allocated via anonymous pointers, because we want to recover the pointers and
 delete the objects in a separate procedure.
 <<Main: tests>>=
   subroutine prepare_eio_test (event, unweighted, n_alt, sample_norm)
     use variables, only: var_list_t
     use model_data
     use process, only: process_t
     use instances, only: process_instance_t
     use processes_ut, only: prepare_test_process
     use event_base
     use events
 
     class(generic_event_t), intent(inout), pointer :: event
     logical, intent(in), optional :: unweighted
     integer, intent(in), optional :: n_alt
     type(string_t), intent(in), optional :: sample_norm
     type(model_data_t), pointer :: model
     type(var_list_t) :: var_list
     type(string_t) :: sample_normalization
     type(process_t), pointer :: proc
     type(process_instance_t), pointer :: process_instance
 
     allocate (model)
     call model%init_test ()
 
     allocate (proc)
     allocate (process_instance)
 
     call prepare_test_process (proc, process_instance, model, &
          run_id = var_str ("run_test"))
     call process_instance%setup_event_data ()
 
     call model%final ()
     deallocate (model)
 
     allocate (event_t :: event)
     select type (event)
     type is (event_t)
        if (present (unweighted)) then
           call var_list%append_log (&
                var_str ("?unweighted"), unweighted, &
                intrinsic = .true.)
        else
           call var_list%append_log (&
                var_str ("?unweighted"), .true., &
                intrinsic = .true.)
        end if
        if (present (sample_norm)) then
           sample_normalization = sample_norm
        else
           sample_normalization = var_str ("auto")
        end if
        call var_list%append_string (&
             var_str ("$sample_normalization"), &
             sample_normalization, intrinsic = .true.)
        call event%basic_init (var_list, n_alt)
        call event%connect (process_instance, proc%get_model_ptr ())
        call var_list%final ()
     end select
 
   end subroutine prepare_eio_test
 
 @ %def prepare_eio_test
 @ Recover those pointers, finalize the objects and deallocate.
 <<Main: tests>>=
   subroutine cleanup_eio_test (event)
     use model_data
     use process, only: process_t
     use instances, only: process_instance_t
     use processes_ut, only: cleanup_test_process
     use event_base
     use events
 
     class(generic_event_t), intent(inout), pointer :: event
     type(process_t), pointer :: proc
     type(process_instance_t), pointer :: process_instance
 
     select type (event)
     type is (event_t)
        proc => event%get_process_ptr ()
        process_instance => event%get_process_instance_ptr ()
        call cleanup_test_process (proc, process_instance)
        deallocate (process_instance)
        deallocate (proc)
        call event%final ()
     end select
     deallocate (event)
 
   end subroutine cleanup_eio_test
 
 @ %def cleanup_eio_test_event
 @ Assign those procedures to appropriate pointers (module variables) in the
 [[eio_base]] module, so they can be called as if they were module procedures.
 <<Main: use tests>>=
   use eio_base_ut, only: eio_prepare_test
   use eio_base_ut, only: eio_cleanup_test
 <<Main: prepare testbed>>=
   eio_prepare_test => prepare_eio_test
   eio_cleanup_test => cleanup_eio_test
 @
 \subsubsection{Any Model}
 This procedure reads any model from file and, optionally, assigns a
 var-list pointer.  If the model pointer is still null, we allocate the model
 object first, with concrete type [[model_t]].  This is a service for modules
 which do just have access to the [[model_data_t]] base type.
 <<Main: tests>>=
   subroutine prepare_whizard_model (model, name, vars)
   <<Use strings>>
     use os_interface
     use model_data
     use var_base
     use models
     class(model_data_t), intent(inout), pointer :: model
     type(string_t), intent(in) :: name
     class(vars_t), pointer, intent(out), optional :: vars
     type(os_data_t) :: os_data
     call syntax_model_file_init ()
     call os_data%init ()
     if (.not. associated (model))  allocate (model_t :: model)
     select type (model)
     type is (model_t)
        call model%read (name // ".mdl", os_data)
        if (present (vars)) then
           vars => model%get_var_list_ptr ()
        end if
     end select
   end subroutine prepare_whizard_model
 
 @ %def prepare_whizard_model
 @ Cleanup after use.  Includes deletion of the model-file syntax.
 <<Main: tests>>=
   subroutine cleanup_whizard_model (model)
     use model_data
     use models
     class(model_data_t), intent(inout), target :: model
     call model%final ()
     call syntax_model_file_final ()
   end subroutine cleanup_whizard_model
 
 @ %def cleanup_whizard_model
 @ Assign those procedures to appropriate pointers (module variables) in the
 [[model_testbed]] module, so they can be called as if they were module
 procedures.
 <<Main: prepare testbed>>=
   prepare_model => prepare_whizard_model
   cleanup_model => cleanup_whizard_model
 @
 \subsubsection{Fallback model: hadrons}
 Some event format tests require the hadronic SM implementation, which
 has to be read from file.  We provide the functionality here, so the
 tests do not depend on model I/O.
 <<Main: tests>>=
   subroutine prepare_fallback_model (model)
     use model_data
     class(model_data_t), intent(inout), pointer :: model
     call prepare_whizard_model (model, var_str ("SM_hadrons"))
   end subroutine prepare_fallback_model
 
 @ %def prepare_fallback_model
 @ Assign those procedures to appropriate pointers (module variables) in the
 [[eio_base]] module, so they can be called as if they were module procedures.
 <<Main: use tests>>=
   use eio_base_ut, only: eio_prepare_fallback_model
   use eio_base_ut, only: eio_cleanup_fallback_model
 <<Main: prepare testbed>>=
   eio_prepare_fallback_model => prepare_fallback_model
   eio_cleanup_fallback_model => cleanup_model
 @
 \subsubsection{Access to the test random-number generator}
 This generator is not normally available for the dispatcher.  We assign an
 additional dispatch routine to the hook in the [[dispatch]] module
 which will be checked before the default rule.
 <<Main: use tests>>=
   use dispatch_rng, only: dispatch_rng_factory_fallback
   use dispatch_rng_ut, only: dispatch_rng_factory_test
 <<Main: prepare testbed>>=
   dispatch_rng_factory_fallback => dispatch_rng_factory_test
 @
 \subsubsection{Access to the test structure functions}
 These are not normally available for the dispatcher.  We assign an
 additional dispatch routine to the hook in the [[dispatch]] module
 which will be checked before the default rule.
 <<Main: use tests>>=
   use dispatch_beams, only: dispatch_sf_data_extra
   use dispatch_ut, only: dispatch_sf_data_test
 <<Main: prepare testbed>>=
   dispatch_sf_data_extra => dispatch_sf_data_test
 @
 \subsubsection{Procedure for Checking}
 This is for developers only, but needs a well-defined interface.
 <<Main: tests>>=
   subroutine whizard_check (check, results)
     type(string_t), intent(in) :: check
     type(test_results_t), intent(inout) :: results
     type(os_data_t) :: os_data
     integer :: u
     call os_data%init ()
     u = free_unit ()
     open (u, file="whizard_check." // char (check) // ".log", &
          action="write", status="replace")
     call msg_message (repeat ('=', 76), 0)
     call msg_message ("Running self-test: " // char (check), 0)
     call msg_message (repeat ('-', 76), 0)
   <<Main: prepare testbed>>
     select case (char (check))
   <<Main: test cases>>
     case ("all")
      <<Main: all tests>>
     case default
        call msg_fatal ("Self-test '" // char (check) // "' not implemented.")
     end select
     close (u)
   end subroutine whizard_check
 
 @ %def whizard_check
 @
 \subsection{Unit test references}
 \subsubsection{Formats}
 <<Main: use tests>>=
   use formats_ut, only: format_test
 <<Main: test cases>>=
   case ("formats")
      call format_test (u, results)
 <<Main: all tests>>=
   call format_test (u, results)
 @
 \subsubsection{Numeric utilities}
 <<Main: use tests>>=
   use numeric_utils_ut, only: numeric_utils_test
 <<Main: test cases>>=
   case ("numeric_utils")
      call numeric_utils_test (u, results)
 <<Main: all tests>>=
   call numeric_utils_test (u, results)
 @
 \subsubsection{Binary Tree}
 <<Main: use tests>>=
   use binary_tree_ut, only: binary_tree_test
 <<Main: test cases>>=
   case ("binary_tree")
      call binary_tree_test (u, results)
 <<Main: all tests>>=
   call binary_tree_test (u, results)
 @
 \subsubsection{Array List}
 <<Main: use tests>>=
   use array_list_ut, only: array_list_test
 <<Main: test cases>>=
   case ("array_list")
      call array_list_test (u, results)
 <<Main: all tests>>=
   call array_list_test (u, results)
 @
 \subsubsection{Iterator}
 <<Main: use tests>>=
   use iterator_ut, only: iterator_test
 <<Main: test cases>>=
   case ("iterator")
      call iterator_test (u, results)
 <<Main: all tests>>=
   call iterator_test (u, results)
 @
 \subsubsection{MD5}
 <<Main: use tests>>=
   use md5_ut, only: md5_test
 <<Main: test cases>>=
   case ("md5")
      call md5_test (u, results)
 <<Main: all tests>>=
   call md5_test (u, results)
 @
 \subsubsection{OS Interface}
 <<Main: use tests>>=
   use os_interface_ut, only: os_interface_test
 <<Main: test cases>>=
   case ("os_interface")
      call os_interface_test (u, results)
 <<Main: all tests>>=
   call os_interface_test (u, results)
 @
 \subsubsection{Sorting}
 <<Main: use tests>>=
   use sorting_ut, only: sorting_test
 <<Main: test cases>>=
   case ("sorting")
      call sorting_test (u, results)
 <<Main: all tests>>=
   call sorting_test (u, results)
 @
 \subsubsection{Grids}
 <<Main: use tests>>=
   use grids_ut, only: grids_test
 <<Main: test cases>>=
   case ("grids")
      call grids_test (u, results)
 <<Main: all tests>>=
   call grids_test (u, results)
 @
 \subsubsection{Solver}
 <<Main: use tests>>=
   use solver_ut, only: solver_test
 <<Main: test cases>>=
   case ("solver")
      call solver_test (u, results)
 <<Main: all tests>>=
   call solver_test (u, results)
 @
 \subsubsection{CPU Time}
 <<Main: use tests>>=
   use cputime_ut, only: cputime_test
 <<Main: test cases>>=
   case ("cputime")
      call cputime_test (u, results)
 <<Main: all tests>>=
   call cputime_test (u, results)
 @
+\subsubsection{Lorentz algebra}
+<<Main: use tests>>=
+  use lorentz_ut, only: lorentz_test
+<<Main: test cases>>=
+  case ("lorentz")
+     call lorentz_test (u, results)
+<<Main: all tests>>=
+  call lorentz_test (u, results)
+@
 \subsubsection{PHS points}
 <<Main: use tests>>=
   use phs_points_ut, only: phs_points_test
 <<Main: test cases>>=
   case ("phs_points")
      call phs_points_test (u, results)
 <<Main: all tests>>=
   call phs_points_test (u, results)
 @
 \subsubsection{SM QCD}
 <<Main: use tests>>=
   use sm_qcd_ut, only: sm_qcd_test
 <<Main: test cases>>=
   case ("sm_qcd")
      call sm_qcd_test (u, results)
 <<Main: all tests>>=
   call sm_qcd_test (u, results)
 @
 \subsubsection{SM QED}
 <<Main: use tests>>=
   use sm_qed_ut, only: sm_qed_test
 <<Main: test cases>>=
   case ("sm_qed")
      call sm_qed_test (u, results)
 <<Main: all tests>>=
   call sm_qed_test (u, results)
 @
 \subsubsection{SM physics}
 <<Main: use tests>>=
   use sm_physics_ut, only: sm_physics_test
 <<Main: test cases>>=
   case ("sm_physics")
      call sm_physics_test (u, results)
 <<Main: all tests>>=
   call sm_physics_test (u, results)
 @
 \subsubsection{Electron PDFs}
 <<Main: use tests>>=
   use electron_pdfs_ut, only: electron_pdfs_test
 <<Main: test cases>>=
   case ("electron_pdfs")
      call electron_pdfs_test (u, results)
 <<Main: all tests>>=
   call electron_pdfs_test (u, results)
 @
 \subsubsection{Lexers}
 <<Main: use tests>>=
   use lexers_ut, only: lexer_test
 <<Main: test cases>>=
   case ("lexers")
      call lexer_test (u, results)
 <<Main: all tests>>=
   call lexer_test (u, results)
 @
 \subsubsection{Parser}
 <<Main: use tests>>=
   use parser_ut, only: parse_test
 <<Main: test cases>>=
   case ("parser")
      call parse_test (u, results)
 <<Main: all tests>>=
   call parse_test (u, results)
 @
 \subsubsection{XML}
 <<Main: use tests>>=
   use xml_ut, only: xml_test
 <<Main: test cases>>=
   case ("xml")
      call xml_test (u, results)
 <<Main: all tests>>=
   call xml_test (u, results)
 @
 \subsubsection{Colors}
 <<Main: use tests>>=
   use colors_ut, only: color_test
 <<Main: test cases>>=
   case ("colors")
      call color_test (u, results)
 <<Main: all tests>>=
   call color_test (u, results)
 @
 \subsubsection{State matrices}
 <<Main: use tests>>=
   use state_matrices_ut, only: state_matrix_test
 <<Main: test cases>>=
   case ("state_matrices")
      call state_matrix_test (u, results)
 <<Main: all tests>>=
   call state_matrix_test (u, results)
 @
 \subsubsection{Analysis}
 <<Main: use tests>>=
   use analysis_ut, only: analysis_test
 <<Main: test cases>>=
   case ("analysis")
      call analysis_test (u, results)
 <<Main: all tests>>=
   call analysis_test (u, results)
 @
 \subsubsection{Particles}
 <<Main: use tests>>=
   use particles_ut, only: particles_test
 <<Main: test cases>>=
   case ("particles")
      call particles_test (u, results)
 <<Main: all tests>>=
   call particles_test (u, results)
 @
 \subsubsection{Models}
 <<Main: use tests>>=
   use models_ut, only: models_test
 <<Main: test cases>>=
   case ("models")
      call models_test (u, results)
 <<Main: all tests>>=
   call models_test (u, results)
 @
 \subsubsection{Auto Components}
 <<Main: use tests>>=
   use auto_components_ut, only: auto_components_test
 <<Main: test cases>>=
   case ("auto_components")
      call auto_components_test (u, results)
 <<Main: all tests>>=
   call auto_components_test (u, results)
 @
 \subsubsection{Radiation Generator}
 <<Main: use tests>>=
   use radiation_generator_ut, only: radiation_generator_test
 <<Main: test cases>>=
   case ("radiation_generator")
      call radiation_generator_test (u, results)
 <<Main: all tests>>=
   call radiation_generator_test (u, results)
 @
 \subsection{BLHA}
 <<Main: use tests>>=
   use blha_ut, only: blha_test
 <<Main: test cases>>=
   case ("blha")
      call blha_test (u, results)
 <<Main: all tests>>=
   call blha_test (u, results)
 @
 \subsubsection{Evaluators}
 <<Main: use tests>>=
   use evaluators_ut, only: evaluator_test
 <<Main: test cases>>=
   case ("evaluators")
      call evaluator_test (u, results)
 <<Main: all tests>>=
   call evaluator_test (u, results)
 @
 \subsubsection{Expressions}
 <<Main: use tests>>=
   use eval_trees_ut, only: expressions_test
 <<Main: test cases>>=
   case ("expressions")
      call expressions_test (u, results)
 <<Main: all tests>>=
   call expressions_test (u, results)
 @
 \subsubsection{Resonances}
 <<Main: use tests>>=
   use resonances_ut, only: resonances_test
 <<Main: test cases>>=
   case ("resonances")
      call resonances_test (u, results)
 <<Main: all tests>>=
   call resonances_test (u, results)
 @
 \subsubsection{PHS Trees}
 <<Main: use tests>>=
   use phs_trees_ut, only: phs_trees_test
 <<Main: test cases>>=
   case ("phs_trees")
      call phs_trees_test (u, results)
 <<Main: all tests>>=
   call phs_trees_test (u, results)
 @
 \subsubsection{PHS Forests}
 <<Main: use tests>>=
   use phs_forests_ut, only: phs_forests_test
 <<Main: test cases>>=
   case ("phs_forests")
      call phs_forests_test (u, results)
 <<Main: all tests>>=
   call phs_forests_test (u, results)
 @
 \subsubsection{Beams}
 <<Main: use tests>>=
   use beams_ut, only: beams_test
 <<Main: test cases>>=
   case ("beams")
      call beams_test (u, results)
 <<Main: all tests>>=
   call beams_test (u, results)
 @
 \subsubsection{$su(N)$ Algebra}
 <<Main: use tests>>=
   use su_algebra_ut, only: su_algebra_test
 <<Main: test cases>>=
   case ("su_algebra")
      call su_algebra_test (u, results)
 <<Main: all tests>>=
   call su_algebra_test (u, results)
 @
 \subsubsection{Bloch Vectors}
 <<Main: use tests>>=
   use bloch_vectors_ut, only: bloch_vectors_test
 <<Main: test cases>>=
   case ("bloch_vectors")
      call bloch_vectors_test (u, results)
 <<Main: all tests>>=
   call bloch_vectors_test (u, results)
 @
 \subsubsection{Polarizations}
 <<Main: use tests>>=
   use polarizations_ut, only: polarizations_test
 <<Main: test cases>>=
   case ("polarizations")
      call polarizations_test (u, results)
 <<Main: all tests>>=
   call polarizations_test (u, results)
 @
 \subsubsection{SF Aux}
 <<Main: use tests>>=
   use sf_aux_ut, only: sf_aux_test
 <<Main: test cases>>=
   case ("sf_aux")
      call sf_aux_test (u, results)
 <<Main: all tests>>=
   call sf_aux_test (u, results)
 @
 \subsubsection{SF Mappings}
 <<Main: use tests>>=
   use sf_mappings_ut, only: sf_mappings_test
 <<Main: test cases>>=
   case ("sf_mappings")
      call sf_mappings_test (u, results)
 <<Main: all tests>>=
   call sf_mappings_test (u, results)
 @
 \subsubsection{SF Base}
 <<Main: use tests>>=
   use sf_base_ut, only: sf_base_test
 <<Main: test cases>>=
   case ("sf_base")
      call sf_base_test (u, results)
 <<Main: all tests>>=
   call sf_base_test (u, results)
 @
 \subsubsection{SF PDF Builtin}
 <<Main: use tests>>=
   use sf_pdf_builtin_ut, only: sf_pdf_builtin_test
 <<Main: test cases>>=
   case ("sf_pdf_builtin")
      call sf_pdf_builtin_test (u, results)
 <<Main: all tests>>=
   call sf_pdf_builtin_test (u, results)
 @
 \subsubsection{SF LHAPDF}
 <<Main: use tests>>=
   use sf_lhapdf_ut, only: sf_lhapdf_test
 <<Main: test cases>>=
   case ("sf_lhapdf")
      call sf_lhapdf_test (u, results)
 <<Main: all tests>>=
   call sf_lhapdf_test (u, results)
 @
 \subsubsection{SF ISR}
 <<Main: use tests>>=
   use sf_isr_ut, only: sf_isr_test
 <<Main: test cases>>=
   case ("sf_isr")
      call sf_isr_test (u, results)
 <<Main: all tests>>=
   call sf_isr_test (u, results)
 @
 \subsubsection{SF EPA}
 <<Main: use tests>>=
   use sf_epa_ut, only: sf_epa_test
 <<Main: test cases>>=
   case ("sf_epa")
      call sf_epa_test (u, results)
 <<Main: all tests>>=
   call sf_epa_test (u, results)
 @
 \subsubsection{SF EWA}
 <<Main: use tests>>=
   use sf_ewa_ut, only: sf_ewa_test
 <<Main: test cases>>=
   case ("sf_ewa")
      call sf_ewa_test (u, results)
 <<Main: all tests>>=
   call sf_ewa_test (u, results)
 @
 \subsubsection{SF CIRCE1}
 <<Main: use tests>>=
   use sf_circe1_ut, only: sf_circe1_test
 <<Main: test cases>>=
   case ("sf_circe1")
      call sf_circe1_test (u, results)
 <<Main: all tests>>=
   call sf_circe1_test (u, results)
 @
 \subsubsection{SF CIRCE2}
 <<Main: use tests>>=
   use sf_circe2_ut, only: sf_circe2_test
 <<Main: test cases>>=
   case ("sf_circe2")
      call sf_circe2_test (u, results)
 <<Main: all tests>>=
   call sf_circe2_test (u, results)
 @
 \subsubsection{SF Gaussian}
 <<Main: use tests>>=
   use sf_gaussian_ut, only: sf_gaussian_test
 <<Main: test cases>>=
   case ("sf_gaussian")
      call sf_gaussian_test (u, results)
 <<Main: all tests>>=
   call sf_gaussian_test (u, results)
 @
 \subsubsection{SF Beam Events}
 <<Main: use tests>>=
   use sf_beam_events_ut, only: sf_beam_events_test
 <<Main: test cases>>=
   case ("sf_beam_events")
      call sf_beam_events_test (u, results)
 <<Main: all tests>>=
   call sf_beam_events_test (u, results)
 @
 \subsubsection{SF EScan}
 <<Main: use tests>>=
   use sf_escan_ut, only: sf_escan_test
 <<Main: test cases>>=
   case ("sf_escan")
      call sf_escan_test (u, results)
 <<Main: all tests>>=
   call sf_escan_test (u, results)
 @
 \subsubsection{PHS Base}
 <<Main: use tests>>=
   use phs_base_ut, only: phs_base_test
 <<Main: test cases>>=
   case ("phs_base")
      call phs_base_test (u, results)
 <<Main: all tests>>=
   call phs_base_test (u, results)
 @
 \subsubsection{PHS None}
 <<Main: use tests>>=
   use phs_none_ut, only: phs_none_test
 <<Main: test cases>>=
   case ("phs_none")
      call phs_none_test (u, results)
 <<Main: all tests>>=
   call phs_none_test (u, results)
 @
 \subsubsection{PHS Single}
 <<Main: use tests>>=
   use phs_single_ut, only: phs_single_test
 <<Main: test cases>>=
   case ("phs_single")
      call phs_single_test (u, results)
 <<Main: all tests>>=
   call phs_single_test (u, results)
 @
 \subsubsection{PHS Rambo}
 <<Main: use tests>>=
   use phs_rambo_ut, only: phs_rambo_test
 <<Main: test cases>>=
   case ("phs_rambo")
      call phs_rambo_test (u, results)
 <<Main: all tests>>=
   call phs_rambo_test (u, results)
 @
 \subsubsection{PHS Wood}
 <<Main: use tests>>=
   use phs_wood_ut, only: phs_wood_test
   use phs_wood_ut, only: phs_wood_vis_test
 <<Main: test cases>>=
   case ("phs_wood")
      call phs_wood_test (u, results)
   case ("phs_wood_vis")
      call phs_wood_vis_test (u, results)
 <<Main: all tests>>=
   call phs_wood_test (u, results)
   call phs_wood_vis_test (u, results)
 @
 \subsubsection{PHS FKS Generator}
 <<Main: use tests>>=
   use phs_fks_ut, only: phs_fks_generator_test
 <<Main: test cases>>=
   case ("phs_fks_generator")
      call phs_fks_generator_test (u, results)
 <<Main: all tests>>=
   call phs_fks_generator_test (u, results)
 @
 \subsubsection{FKS regions}
 <<Main: use tests>>=
   use fks_regions_ut, only: fks_regions_test
 <<Main: test cases>>=
   case ("fks_regions")
      call fks_regions_test (u, results)
 <<Main: all tests>>=
   call fks_regions_test (u, results)
 @
 \subsubsection{Real subtraction}
 <<Main: use tests>>=
   use real_subtraction_ut, only: real_subtraction_test
 <<Main: test cases>>=
   case ("real_subtraction")
      call real_subtraction_test (u, results)
 <<Main: all tests>>=
   call real_subtraction_test (u, results)
 @
 \subsubsection{RECOLA}
 <<Main: use tests>>=
   use prc_recola_ut, only: prc_recola_test
 <<Main: test cases>>=
   case ("prc_recola")
      call prc_recola_test (u, results)
 <<Main: all tests>>=
   call prc_recola_test (u, results)
 @
 \subsubsection{RNG Base}
 <<Main: use tests>>=
   use rng_base_ut, only: rng_base_test
 <<Main: test cases>>=
   case ("rng_base")
      call rng_base_test (u, results)
 <<Main: all tests>>=
   call rng_base_test (u, results)
 @
 \subsubsection{RNG Tao}
 <<Main: use tests>>=
   use rng_tao_ut, only: rng_tao_test
 <<Main: test cases>>=
   case ("rng_tao")
      call rng_tao_test (u, results)
 <<Main: all tests>>=
   call rng_tao_test (u, results)
 @
 \subsubsection{RNG Stream}
 <<Main: use tests>>=
   use rng_stream_ut, only: rng_stream_test
 <<Main: test cases>>=
   case ("rng_stream")
      call rng_stream_test (u, results)
 <<Main: all tests>>=
   call rng_stream_test (u, results)
 @
 \subsubsection{Selectors}
 <<Main: use tests>>=
   use selectors_ut, only: selectors_test
 <<Main: test cases>>=
   case ("selectors")
      call selectors_test (u, results)
 <<Main: all tests>>=
   call selectors_test (u, results)
 @
 \subsubsection{VEGAS}
 <<Main: use tests>>=
   use vegas_ut, only: vegas_test
 <<Main: test cases>>=
   case ("vegas")
      call vegas_test (u, results)
 <<Main: all tests>>=
   call vegas_test (u, results)
 @
 \subsubsection{VAMP2}
 <<Main: use tests>>=
   use vamp2_ut, only: vamp2_test
 <<Main: test cases>>=
   case ("vamp2")
      call vamp2_test (u, results)
 <<Main: all tests>>=
   call vamp2_test (u, results)
 @
 \subsubsection{MCI Base}
 <<Main: use tests>>=
   use mci_base_ut, only: mci_base_test
 <<Main: test cases>>=
   case ("mci_base")
      call mci_base_test (u, results)
 <<Main: all tests>>=
   call mci_base_test (u, results)
 @
 \subsubsection{MCI None}
 <<Main: use tests>>=
   use mci_none_ut, only: mci_none_test
 <<Main: test cases>>=
   case ("mci_none")
      call mci_none_test (u, results)
 <<Main: all tests>>=
   call mci_none_test (u, results)
 @
 \subsubsection{MCI Midpoint}
 <<Main: use tests>>=
   use mci_midpoint_ut, only: mci_midpoint_test
 <<Main: test cases>>=
   case ("mci_midpoint")
      call mci_midpoint_test (u, results)
 <<Main: all tests>>=
   call mci_midpoint_test (u, results)
 @
 \subsubsection{MCI VAMP}
 <<Main: use tests>>=
   use mci_vamp_ut, only: mci_vamp_test
 <<Main: test cases>>=
   case ("mci_vamp")
      call mci_vamp_test (u, results)
 <<Main: all tests>>=
   call mci_vamp_test (u, results)
 @
 \subsubsection{MCI VAMP2}
 <<Main: use tests>>=
   use mci_vamp2_ut, only: mci_vamp2_test
 <<Main: test cases>>=
   case ("mci_vamp2")
      call mci_vamp2_test (u, results)
 <<Main: all tests>>=
   call mci_vamp2_test (u, results)
 @
 \subsubsection{Integration Results}
 <<Main: use tests>>=
   use integration_results_ut, only: integration_results_test
 <<Main: test cases>>=
   case ("integration_results")
      call integration_results_test (u, results)
 <<Main: all tests>>=
   call integration_results_test (u, results)
 @
 \subsubsection{PRCLib Interfaces}
 <<Main: use tests>>=
   use prclib_interfaces_ut, only: prclib_interfaces_test
 <<Main: test cases>>=
   case ("prclib_interfaces")
      call prclib_interfaces_test (u, results)
 <<Main: all tests>>=
   call prclib_interfaces_test (u, results)
 @
 \subsubsection{Particle Specifiers}
 <<Main: use tests>>=
   use particle_specifiers_ut, only: particle_specifiers_test
 <<Main: test cases>>=
   case ("particle_specifiers")
      call particle_specifiers_test (u, results)
 <<Main: all tests>>=
   call particle_specifiers_test (u, results)
 @
 \subsubsection{Process Libraries}
 <<Main: use tests>>=
   use process_libraries_ut, only: process_libraries_test
 <<Main: test cases>>=
   case ("process_libraries")
      call process_libraries_test (u, results)
 <<Main: all tests>>=
   call process_libraries_test (u, results)
 @
 \subsubsection{PRCLib Stacks}
 <<Main: use tests>>=
   use prclib_stacks_ut, only: prclib_stacks_test
 <<Main: test cases>>=
   case ("prclib_stacks")
      call prclib_stacks_test (u, results)
 <<Main: all tests>>=
   call prclib_stacks_test (u, results)
 @
 \subsubsection{HepMC}
 <<Main: use tests>>=
   use hepmc_interface_ut, only: hepmc_interface_test
 <<Main: test cases>>=
   case ("hepmc")
      call hepmc_interface_test (u, results)
 <<Main: all tests>>=
   call hepmc_interface_test (u, results)
 @
 \subsubsection{LCIO}
 <<Main: use tests>>=
   use lcio_interface_ut, only: lcio_interface_test
 <<Main: test cases>>=
   case ("lcio")
      call lcio_interface_test (u, results)
 <<Main: all tests>>=
   call lcio_interface_test (u, results)
 @
 \subsubsection{Jets}
 <<Main: use tests>>=
   use jets_ut, only: jets_test
 <<Main: test cases>>=
   case ("jets")
      call jets_test (u, results)
 <<Main: all tests>>=
   call jets_test (u, results)
 @
 \subsection{LHA User Process WHIZARD}
 <<Main: use tests>>=
   use whizard_lha_ut, only: whizard_lha_test
 <<Main: test cases>>=
   case ("whizard_lha")
      call whizard_lha_test (u, results)
 <<Main: all tests>>=
   call whizard_lha_test (u, results)
 @
 \subsection{Pythia8}
 <<Main: use tests>>=
   use pythia8_ut, only: pythia8_test
 <<Main: test cases>>=
   case ("pythia8")
      call pythia8_test (u, results)
 <<Main: all tests>>=
   call pythia8_test (u, results)
 @
 \subsubsection{PDG Arrays}
 <<Main: use tests>>=
   use pdg_arrays_ut, only: pdg_arrays_test
 <<Main: test cases>>=
   case ("pdg_arrays")
      call pdg_arrays_test (u, results)
 <<Main: all tests>>=
   call pdg_arrays_test (u, results)
 @
 \subsubsection{interactions}
 <<Main: use tests>>=
   use interactions_ut, only: interaction_test
 <<Main: test cases>>=
   case ("interactions")
      call interaction_test (u, results)
 <<Main: all tests>>=
   call interaction_test (u, results)
 @
 \subsubsection{SLHA}
 <<Main: use tests>>=
   use slha_interface_ut, only: slha_test
 <<Main: test cases>>=
   case ("slha_interface")
      call slha_test (u, results)
 <<Main: all tests>>=
   call slha_test (u, results)
 @
 \subsubsection{Cascades}
 <<Main: use tests>>=
   use cascades_ut, only: cascades_test
 <<Main: test cases>>=
   case ("cascades")
      call cascades_test (u, results)
 <<Main: all tests>>=
   call cascades_test (u, results)
 @
 \subsubsection{Cascades2 lexer}
 <<Main: use tests>>=
   use cascades2_lexer_ut, only: cascades2_lexer_test
 <<Main: test cases>>=
   case ("cascades2_lexer")
      call cascades2_lexer_test (u, results)
 <<Main: all tests>>=
   call cascades2_lexer_test (u, results)
 @
 \subsubsection{Cascades2}
 <<Main: use tests>>=
   use cascades2_ut, only: cascades2_test
 <<Main: test cases>>=
   case ("cascades2")
      call cascades2_test (u, results)
 <<Main: all tests>>=
   call cascades2_test (u, results)
 @
 \subsubsection{PRC Test}
 <<Main: use tests>>=
   use prc_test_ut, only: prc_test_test
 <<Main: test cases>>=
   case ("prc_test")
      call prc_test_test (u, results)
 <<Main: all tests>>=
   call prc_test_test (u, results)
 @
 \subsubsection{PRC Template ME}
 <<Main: use tests>>=
   use prc_template_me_ut, only: prc_template_me_test
 <<Main: test cases>>=
   case ("prc_template_me")
      call prc_template_me_test (u, results)
 <<Main: all tests>>=
   call prc_template_me_test (u, results)
 @
 \subsubsection{PRC OMega}
 <<Main: use tests>>=
   use prc_omega_ut, only: prc_omega_test
   use prc_omega_ut, only: prc_omega_diags_test
 <<Main: test cases>>=
   case ("prc_omega")
      call prc_omega_test (u, results)
   case ("prc_omega_diags")
      call prc_omega_diags_test (u, results)
 <<Main: all tests>>=
   call prc_omega_test (u, results)
   call prc_omega_diags_test (u, results)
 @
 \subsubsection{Parton States}
 <<Main: use tests>>=
   use parton_states_ut, only: parton_states_test
 <<Main: test cases>>=
   case ("parton_states")
      call parton_states_test (u, results)
 <<Main: all tests>>=
   call parton_states_test (u, results)
 @
 \subsubsection{Subevt Expr}
 <<Main: use tests>>=
   use expr_tests_ut, only: subevt_expr_test
 <<Main: test cases>>=
   case ("subevt_expr")
      call subevt_expr_test (u, results)
 <<Main: all tests>>=
   call subevt_expr_test (u, results)
 @
 \subsubsection{Processes}
 <<Main: use tests>>=
   use processes_ut, only: processes_test
 <<Main: test cases>>=
   case ("processes")
      call processes_test (u, results)
 <<Main: all tests>>=
   call processes_test (u, results)
 @
 \subsubsection{Process Stacks}
 <<Main: use tests>>=
   use process_stacks_ut, only: process_stacks_test
 <<Main: test cases>>=
   case ("process_stacks")
      call process_stacks_test (u, results)
 <<Main: all tests>>=
   call process_stacks_test (u, results)
 @
 \subsubsection{Event Transforms}
 <<Main: use tests>>=
   use event_transforms_ut, only: event_transforms_test
 <<Main: test cases>>=
   case ("event_transforms")
      call event_transforms_test (u, results)
 <<Main: all tests>>=
   call event_transforms_test (u, results)
 @
 \subsubsection{Resonance Insertion Transform}
 <<Main: use tests>>=
   use resonance_insertion_ut, only: resonance_insertion_test
 <<Main: test cases>>=
   case ("resonance_insertion")
      call resonance_insertion_test (u, results)
 <<Main: all tests>>=
   call resonance_insertion_test (u, results)
 @
 \subsubsection{Recoil Kinematics}
 <<Main: use tests>>=
   use recoil_kinematics_ut, only: recoil_kinematics_test
 <<Main: test cases>>=
   case ("recoil_kinematics")
      call recoil_kinematics_test (u, results)
 <<Main: all tests>>=
   call recoil_kinematics_test (u, results)
 @
 \subsubsection{ISR Handler}
 <<Main: use tests>>=
   use isr_epa_handler_ut, only: isr_handler_test
 <<Main: test cases>>=
   case ("isr_handler")
      call isr_handler_test (u, results)
 <<Main: all tests>>=
   call isr_handler_test (u, results)
 @
 \subsubsection{EPA Handler}
 <<Main: use tests>>=
   use isr_epa_handler_ut, only: epa_handler_test
 <<Main: test cases>>=
   case ("epa_handler")
      call epa_handler_test (u, results)
 <<Main: all tests>>=
   call epa_handler_test (u, results)
 @
 \subsubsection{Decays}
 <<Main: use tests>>=
   use decays_ut, only: decays_test
 <<Main: test cases>>=
   case ("decays")
      call decays_test (u, results)
 <<Main: all tests>>=
   call decays_test (u, results)
 @
 \subsubsection{Shower}
 <<Main: use tests>>=
   use shower_ut, only: shower_test
 <<Main: test cases>>=
   case ("shower")
      call shower_test (u, results)
 <<Main: all tests>>=
   call shower_test (u, results)
 @
 \subsubsection{Events}
 <<Main: use tests>>=
   use events_ut, only: events_test
 <<Main: test cases>>=
   case ("events")
      call events_test (u, results)
 <<Main: all tests>>=
   call events_test (u, results)
 @
 \subsubsection{HEP Events}
 <<Main: use tests>>=
   use hep_events_ut, only: hep_events_test
 <<Main: test cases>>=
   case ("hep_events")
      call hep_events_test (u, results)
 <<Main: all tests>>=
   call hep_events_test (u, results)
 @
 \subsubsection{EIO Data}
 <<Main: use tests>>=
   use eio_data_ut, only: eio_data_test
 <<Main: test cases>>=
   case ("eio_data")
      call eio_data_test (u, results)
 <<Main: all tests>>=
   call eio_data_test (u, results)
 @
 \subsubsection{EIO Base}
 <<Main: use tests>>=
   use eio_base_ut, only: eio_base_test
 <<Main: test cases>>=
   case ("eio_base")
      call eio_base_test (u, results)
 <<Main: all tests>>=
   call eio_base_test (u, results)
 @
 \subsubsection{EIO Direct}
 <<Main: use tests>>=
   use eio_direct_ut, only: eio_direct_test
 <<Main: test cases>>=
   case ("eio_direct")
      call eio_direct_test (u, results)
 <<Main: all tests>>=
   call eio_direct_test (u, results)
 @
 \subsubsection{EIO Raw}
 <<Main: use tests>>=
   use eio_raw_ut, only: eio_raw_test
 <<Main: test cases>>=
   case ("eio_raw")
      call eio_raw_test (u, results)
 <<Main: all tests>>=
   call eio_raw_test (u, results)
 @
 \subsubsection{EIO Checkpoints}
 <<Main: use tests>>=
   use eio_checkpoints_ut, only: eio_checkpoints_test
 <<Main: test cases>>=
   case ("eio_checkpoints")
      call eio_checkpoints_test (u, results)
 <<Main: all tests>>=
   call eio_checkpoints_test (u, results)
 @
 \subsubsection{EIO LHEF}
 <<Main: use tests>>=
   use eio_lhef_ut, only: eio_lhef_test
 <<Main: test cases>>=
   case ("eio_lhef")
      call eio_lhef_test (u, results)
 <<Main: all tests>>=
   call eio_lhef_test (u, results)
 @
 \subsubsection{EIO HepMC}
 <<Main: use tests>>=
   use eio_hepmc_ut, only: eio_hepmc_test
 <<Main: test cases>>=
   case ("eio_hepmc")
      call eio_hepmc_test (u, results)
 <<Main: all tests>>=
   call eio_hepmc_test (u, results)
 @
 \subsubsection{EIO LCIO}
 <<Main: use tests>>=
   use eio_lcio_ut, only: eio_lcio_test
 <<Main: test cases>>=
   case ("eio_lcio")
      call eio_lcio_test (u, results)
 <<Main: all tests>>=
   call eio_lcio_test (u, results)
 @
 \subsubsection{EIO StdHEP}
 <<Main: use tests>>=
   use eio_stdhep_ut, only: eio_stdhep_test
 <<Main: test cases>>=
   case ("eio_stdhep")
      call eio_stdhep_test (u, results)
 <<Main: all tests>>=
   call eio_stdhep_test (u, results)
 @
 \subsubsection{EIO ASCII}
 <<Main: use tests>>=
   use eio_ascii_ut, only: eio_ascii_test
 <<Main: test cases>>=
   case ("eio_ascii")
      call eio_ascii_test (u, results)
 <<Main: all tests>>=
   call eio_ascii_test (u, results)
 @
 \subsubsection{EIO Weights}
 <<Main: use tests>>=
   use eio_weights_ut, only: eio_weights_test
 <<Main: test cases>>=
   case ("eio_weights")
      call eio_weights_test (u, results)
 <<Main: all tests>>=
   call eio_weights_test (u, results)
 @
 \subsubsection{EIO Dump}
 <<Main: use tests>>=
   use eio_dump_ut, only: eio_dump_test
 <<Main: test cases>>=
   case ("eio_dump")
      call eio_dump_test (u, results)
 <<Main: all tests>>=
   call eio_dump_test (u, results)
 @
 \subsubsection{Iterations}
 <<Main: use tests>>=
   use iterations_ut, only: iterations_test
 <<Main: test cases>>=
   case ("iterations")
      call iterations_test (u, results)
 <<Main: all tests>>=
   call iterations_test (u, results)
 @
 \subsubsection{Beam Structures}
 <<Main: use tests>>=
   use beam_structures_ut, only: beam_structures_test
 <<Main: test cases>>=
   case ("beam_structures")
      call beam_structures_test (u, results)
 <<Main: all tests>>=
   call beam_structures_test (u, results)
 @
 \subsubsection{RT Data}
 <<Main: use tests>>=
   use rt_data_ut, only: rt_data_test
 <<Main: test cases>>=
   case ("rt_data")
      call rt_data_test (u, results)
 <<Main: all tests>>=
   call rt_data_test (u, results)
 @
 \subsubsection{Dispatch}
 <<Main: use tests>>=
   use dispatch_ut, only: dispatch_test
 <<Main: test cases>>=
   case ("dispatch")
      call dispatch_test (u, results)
 <<Main: all tests>>=
   call dispatch_test (u, results)
 @
 \subsubsection{Dispatch RNG}
 <<Main: use tests>>=
   use dispatch_rng_ut, only: dispatch_rng_test
 <<Main: test cases>>=
   case ("dispatch_rng")
      call dispatch_rng_test (u, results)
 <<Main: all tests>>=
   call dispatch_rng_test (u, results)
 @
 \subsubsection{Dispatch MCI}
 <<Main: use tests>>=
   use dispatch_mci_ut, only: dispatch_mci_test
 <<Main: test cases>>=
   case ("dispatch_mci")
      call dispatch_mci_test (u, results)
 <<Main: all tests>>=
   call dispatch_mci_test (u, results)
 @
 \subsubsection{Dispatch PHS}
 <<Main: use tests>>=
   use dispatch_phs_ut, only: dispatch_phs_test
 <<Main: test cases>>=
   case ("dispatch_phs")
      call dispatch_phs_test (u, results)
 <<Main: all tests>>=
   call dispatch_phs_test (u, results)
 @
 \subsubsection{Dispatch transforms}
 <<Main: use tests>>=
   use dispatch_transforms_ut, only: dispatch_transforms_test
 <<Main: test cases>>=
   case ("dispatch_transforms")
      call dispatch_transforms_test (u, results)
 <<Main: all tests>>=
   call dispatch_transforms_test (u, results)
 @
 \subsubsection{Shower partons}
 <<Main: use tests>>=
   use shower_base_ut, only: shower_base_test
 <<Main: test cases>>=
   case ("shower_base")
      call shower_base_test (u, results)
 <<Main: all tests>>=
   call shower_base_test (u, results)
 @
 \subsubsection{Process Configurations}
 <<Main: use tests>>=
   use process_configurations_ut, only: process_configurations_test
 <<Main: test cases>>=
   case ("process_configurations")
      call process_configurations_test (u, results)
 <<Main: all tests>>=
   call process_configurations_test (u, results)
 @
 \subsubsection{Compilations}
 <<Main: use tests>>=
   use compilations_ut, only: compilations_test
   use compilations_ut, only: compilations_static_test
 <<Main: test cases>>=
   case ("compilations")
      call compilations_test (u, results)
   case ("compilations_static")
      call compilations_static_test (u, results)
 <<Main: all tests>>=
   call compilations_test (u, results)
   call compilations_static_test (u, results)
 @
 \subsubsection{Integrations}
 <<Main: use tests>>=
   use integrations_ut, only: integrations_test
   use integrations_ut, only: integrations_history_test
 <<Main: test cases>>=
   case ("integrations")
      call integrations_test (u, results)
   case ("integrations_history")
      call integrations_history_test (u, results)
 <<Main: all tests>>=
   call integrations_test (u, results)
   call integrations_history_test (u, results)
 @
 \subsubsection{Event Streams}
 <<Main: use tests>>=
   use event_streams_ut, only: event_streams_test
 <<Main: test cases>>=
   case ("event_streams")
      call event_streams_test (u, results)
 <<Main: all tests>>=
   call event_streams_test (u, results)
 @
 \subsubsection{Restricted Subprocesses}
 <<Main: use tests>>=
   use restricted_subprocesses_ut, only: restricted_subprocesses_test
 <<Main: test cases>>=
   case ("restricted_subprocesses")
      call restricted_subprocesses_test (u, results)
 <<Main: all tests>>=
   call restricted_subprocesses_test (u, results)
 @
 \subsubsection{Simulations}
 <<Main: use tests>>=
   use simulations_ut, only: simulations_test
 <<Main: test cases>>=
   case ("simulations")
      call simulations_test (u, results)
 <<Main: all tests>>=
   call simulations_test (u, results)
 @
 \subsubsection{Commands}
 <<Main: use tests>>=
   use commands_ut, only: commands_test
 <<Main: test cases>>=
   case ("commands")
      call commands_test (u, results)
 <<Main: all tests>>=
   call commands_test (u, results)
 @
 \subsubsection{$ttV$ formfactors}
 <<Main: use tests>>=
   use ttv_formfactors_ut, only: ttv_formfactors_test
 <<Main: test cases>>=
   case ("ttv_formfactors")
      call ttv_formfactors_test (u, results)
 <<Main: all tests>>=
   call ttv_formfactors_test (u, results)
 @
 \subsubsection{API}
 <<Main: use tests>>=
   use api_ut, only: api_test
 <<Main: test cases>>=
   case ("api")
      call api_test (u, results)
 <<Main: all tests>>=
   call api_test (u, results)
 @
 \subsubsection{API/HepMC}
 <<Main: use tests>>=
   use api_hepmc_ut, only: api_hepmc_test
 <<Main: test cases>>=
   case ("api_hepmc")
      call api_hepmc_test (u, results)
 <<Main: all tests>>=
   call api_hepmc_test (u, results)
 @
 \subsubsection{API/LCIO}
 <<Main: use tests>>=
   use api_lcio_ut, only: api_lcio_test
 <<Main: test cases>>=
   case ("api_lcio")
      call api_lcio_test (u, results)
 <<Main: all tests>>=
   call api_lcio_test (u, results)
Index: trunk/share/tests/unit_tests/ref-output/lorentz_1.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/lorentz_1.ref	(revision 0)
+++ trunk/share/tests/unit_tests/ref-output/lorentz_1.ref	(revision 8835)
@@ -0,0 +1,68 @@
+* Test output: lorentz_1
+*   Purpose: testing vector3_t
+
+
+* Null 3-vector
+
+ P =   0.00000000E+00  0.00000000E+00  0.00000000E+00
+
+* Canonical 3-vector
+
+ P =   1.00000000E+00  0.00000000E+00  0.00000000E+00
+ P =   0.00000000E+00  1.00000000E+00  0.00000000E+00
+ P =   0.00000000E+00  0.00000000E+00  1.00000000E+00
+
+* Canonical moving 3-vector
+
+ P =   4.20000000E+01  0.00000000E+00  0.00000000E+00
+ P =   0.00000000E+00  4.20000000E+01  0.00000000E+00
+ P =   0.00000000E+00  0.00000000E+00  4.20000000E+01
+
+* Generic moving 3-vector
+
+ P =   3.00000000E+00  4.00000000E+00  5.00000000E+00
+
+* Simple algebra with 3-vectors
+
+ v3_1:
+ P =   3.00000000E+00  4.00000000E+00  5.00000000E+00
+ v3_2:
+ P =  -2.00000000E+00  5.00000000E+00 -1.00000000E+00
+ -v3_1:
+ P =  -3.00000000E+00 -4.00000000E+00 -5.00000000E+00
+ v3_1 / |v3_1|:
+ P =   4.24264069E-01  5.65685425E-01  7.07106781E-01
+ v3_1(x):  3.00000E+00
+ v3_1(y):  4.00000E+00
+ v3_1(z):  5.00000E+00
+ v3_1 + v3_2:
+ P =   1.00000000E+00  9.00000000E+00  4.00000000E+00
+ v3_1 - v3_2:
+ P =   5.00000000E+00 -1.00000000E+00  6.00000000E+00
+ v3_1 == v3_2: F
+ v3_1 /= v3_2: T
+ 2 * v3_1:
+ P =   6.00000000E+00  8.00000000E+00  1.00000000E+01
+ v3_2 / 4:
+ P =  -5.00000000E-01  1.25000000E+00 -2.50000000E-01
+ v3_1, azimuth (radians): 9.27295E-01
+ v3_1, azimuth (degrees): 5.31301E+01
+ v3_1, polar (radians)  : 7.85398E-01
+ v3_1, polar (degrees)  : 4.50000E+01
+ v3_1, cosine polar     : 7.07107E-01
+ v3_1, energy w. mass=1 : 7.14143E+00
+ 3-vector orthogonal to v3_1:
+ P =   8.00000000E-01 -6.00000000E-01  0.00000000E+00
+ unit 3-vector from v3_1:
+
+* Dot and cross product
+
+ v3_1 * v3_2:  9.00000E+00
+ v3_1**3    :  3.53553E+02
+ v3_1 x v3_2:
+ P =  -2.90000000E+01 -7.00000000E+00  2.30000000E+01
+ enclosed angle (radians): 1.33627E+00
+ enclosed angle (degrees): 7.65628E+01
+ cosine (enclosed angle) : 2.32379E-01
+
+* Test output end: lorentz_1
Index: trunk/share/tests/unit_tests/ref-output/lorentz_2.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/lorentz_2.ref	(revision 0)
+++ trunk/share/tests/unit_tests/ref-output/lorentz_2.ref	(revision 8835)
@@ -0,0 +1,97 @@
+* Test output: lorentz_2
+*   Purpose: testing vector4_t
+
+
+* Null 4-vector
+
+ E =   0.000000E+00
+ P =   0.000000E+00  0.000000E+00  0.000000E+00
+
+* Canonical 4-vector
+
+ E =   1.000000E+00
+ P =   0.000000E+00  0.000000E+00  0.000000E+00
+ E =   0.000000E+00
+ P =   1.000000E+00  0.000000E+00  0.000000E+00
+ E =   0.000000E+00
+ P =   0.000000E+00  1.000000E+00  0.000000E+00
+ E =   0.000000E+00
+ P =   0.000000E+00  0.000000E+00  1.000000E+00
+
+* 4-vector at rest with mass m = 17
+
+ E =   1.700000E+01
+ P =   0.000000E+00  0.000000E+00  0.000000E+00
+
+* Canonical moving 4-vector
+
+ E =   1.700000E+01
+ P =   4.200000E+01  0.000000E+00  0.000000E+00
+ E =   1.700000E+01
+ P =   0.000000E+00  4.200000E+01  0.000000E+00
+ E =   1.700000E+01
+ P =   0.000000E+00  0.000000E+00  4.200000E+01
+
+* Generic moving 4-vector
+
+ E =   1.700000E+01
+ P =   3.000000E+00  4.000000E+00  5.000000E+00
+
+* Simple algebra with 4-vectors
+
+ v4_1:
+ E =   8.000000E+00
+ P =   3.000000E+00  4.000000E+00  5.000000E+00
+ v4_2:
+ E =   0.000000E+00
+ P =  -2.000000E+00  5.000000E+00 -1.000000E+00
+ -v4_1:
+ E =  -8.000000E+00
+ P =  -3.000000E+00 -4.000000E+00 -5.000000E+00
+ v4_1, inverted direction:
+ E =   8.000000E+00
+ P =  -3.000000E+00 -4.000000E+00 -5.000000E+00
+ (v4_1)_spatial / |(v4_1)_spatial|:
+ P =   4.24264069E-01  5.65685425E-01  7.07106781E-01
+ v4_1(E):  8.00000E+00
+ v4_1(x):  3.00000E+00
+ v4_1(y):  4.00000E+00
+ v4_1(z):  5.00000E+00
+ space_part (v4_1):
+ P =   3.00000000E+00  4.00000000E+00  5.00000000E+00
+ norm space_part (v4_1):  7.07107E+00
+ unit vector from v4_1:
+ P =   4.24264069E-01  5.65685425E-01  7.07106781E-01
+ v4_1 + v4_2:
+ E =   8.000000E+00
+ P =   1.000000E+00  9.000000E+00  4.000000E+00
+ v4_1 - v4_2:
+ E =   8.000000E+00
+ P =   5.000000E+00 -1.000000E+00  6.000000E+00
+ v4_1 == v4_2: F
+ v4_1 /= v4_2: T
+ 2 * v4_1:
+ E =   1.600000E+01
+ P =   6.000000E+00  8.000000E+00  1.000000E+01
+ v4_2 / 4:
+ E =   0.000000E+00
+ P =  -5.000000E-01  1.250000E+00 -2.500000E-01
+
+* Angles and kinematic properties of 4-vectors
+
+ v4_1, azimuth (radians): 9.27295E-01
+ v4_1, azimuth (degrees): 5.31301E+01
+ v4_1, polar (radians)  : 7.85398E-01
+ v4_1, polar (degrees)  : 4.50000E+01
+ v4_1, cosine polar     : 7.07107E-01
+ v4_1, invariant mass   : 3.74166E+00
+ v4_1, invariant mass sq: 1.40000E+01
+ v4_2, invariant mass   :-5.47723E+00
+ v4_2, invariant mass sq:-3.00000E+01
+ v4_1, transverse mass  : 6.24500E+00
+ v4_1, rapidity         : 7.33169E-01
+ v4_1, pseudorapidity   : 8.81374E-01
+ v4_1, pT               : 5.00000E+00
+ v4_1, pL               : 5.00000E+00
+
+* Test output end: lorentz_2
Index: trunk/share/tests/unit_tests/ref-output/lorentz_3.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/lorentz_3.ref	(revision 0)
+++ trunk/share/tests/unit_tests/ref-output/lorentz_3.ref	(revision 8835)
@@ -0,0 +1,19 @@
+* Test output: lorentz_3
+*   Purpose: testing bilinear functions of 4-vectors
+
+
+* Products and distances of 4-vectors
+
+ v4_1 * v4_2:  3.90000E+01
+ rapidity distance       :-9.01405E-01
+ pseudorapidity distance :-1.06602E+00
+ eta phi distance        : 1.47817E+00
+ enclosed angle (radians): 1.33627E+00
+ enclosed angle (degrees): 7.65628E+01
+ cosine (enclosed angle) : 2.32379E-01
+ rest frame theta (rad)  : 2.68108E+00
+ rest frame theta (deg)  : 1.53615E+02
+ rest frame cosine(theta):-8.95827E-01
+ v4_1_T w.r.t. v4_2      : 5.46077E+00
+
+* Test output end: lorentz_3
Index: trunk/share/tests/unit_tests/ref-output/lorentz_4.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/lorentz_4.ref	(revision 0)
+++ trunk/share/tests/unit_tests/ref-output/lorentz_4.ref	(revision 8835)
@@ -0,0 +1,195 @@
+* Test output: lorentz_4
+*   Purpose: testing Lorentz transformations
+
+
+* Basic Lorentz transformatios
+
+ LT = 1:
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =   1.000000E+00  0.000000E+00  0.000000E+00
+ L20 =   0.000000E+00
+ L2j =   0.000000E+00  1.000000E+00  0.000000E+00
+ L30 =   0.000000E+00
+ L3j =   0.000000E+00  0.000000E+00  1.000000E+00
+
+ LT = space reflection:
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =  -1.000000E+00  0.000000E+00  0.000000E+00
+ L20 =   0.000000E+00
+ L2j =   0.000000E+00 -1.000000E+00  0.000000E+00
+ L30 =   0.000000E+00
+ L3j =   0.000000E+00  0.000000E+00 -1.000000E+00
+
+* Lorentz transformations: rotations
+
+ Rotation of Pi/4 around 1-axis, def. by cos and sin:
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =   1.000000E+00  0.000000E+00  0.000000E+00
+ L20 =   0.000000E+00
+ L2j =   0.000000E+00  7.071070E-01 -7.071070E-01
+ L30 =   0.000000E+00
+ L3j =   0.000000E+00  7.071070E-01  7.071070E-01
+ Rotation of Pi/4 around 2-axis, def. by cos and sin:
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =   7.071070E-01  0.000000E+00  7.071070E-01
+ L20 =   0.000000E+00
+ L2j =   0.000000E+00  1.000000E+00  0.000000E+00
+ L30 =   0.000000E+00
+ L3j =  -7.071070E-01  0.000000E+00  7.071070E-01
+ Rotation of Pi/4 around 3-axis, def. by cos and sin:
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =   7.071070E-01 -7.071070E-01  0.000000E+00
+ L20 =   0.000000E+00
+ L2j =   7.071070E-01  7.071070E-01  0.000000E+00
+ L30 =   0.000000E+00
+ L3j =   0.000000E+00  0.000000E+00  1.000000E+00
+ Rotation of Pi/4 around 1-axis, def. by angle:
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =   1.000000E+00  0.000000E+00  0.000000E+00
+ L20 =   0.000000E+00
+ L2j =   0.000000E+00  7.071068E-01 -7.071068E-01
+ L30 =   0.000000E+00
+ L3j =   0.000000E+00  7.071068E-01  7.071068E-01
+ Rotation of Pi/4 around 2-axis, def. by angle:
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =   7.071068E-01  0.000000E+00  7.071068E-01
+ L20 =   0.000000E+00
+ L2j =   0.000000E+00  1.000000E+00  0.000000E+00
+ L30 =   0.000000E+00
+ L3j =  -7.071068E-01  0.000000E+00  7.071068E-01
+ Rotation of Pi/4 around 3-axis, def. by angle:
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =   7.071068E-01 -7.071068E-01  0.000000E+00
+ L20 =   0.000000E+00
+ L2j =   7.071068E-01  7.071068E-01  0.000000E+00
+ L30 =   0.000000E+00
+ L3j =   0.000000E+00  0.000000E+00  1.000000E+00
+ Rotation of Pi/4 around axis = (1,2,3):
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =   7.280279E-01 -5.251050E-01  4.407274E-01
+ L20 =   0.000000E+00
+ L2j =   6.087887E-01  7.907907E-01 -6.345672E-02
+ L30 =   0.000000E+00
+ L3j =  -3.152018E-01  3.145079E-01  8.953954E-01
+ Rotation in plane to axis = (1,2,3), angle given by length of axis:
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =  -6.949206E-01  7.135210E-01  8.929286E-02
+ L20 =   0.000000E+00
+ L2j =  -1.920070E-01 -3.037850E-01  9.331924E-01
+ L30 =   0.000000E+00
+ L3j =   6.929782E-01  6.313497E-01  3.481075E-01
+ Rotation from v3_1=(1,2,3) to v3_2=(-2,1,-5):
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =   7.690767E-01 -1.285133E-01 -6.261034E-01
+ L20 =   0.000000E+00
+ L2j =   3.594367E-01 -7.230434E-01  5.899267E-01
+ L30 =   0.000000E+00
+ L3j =  -5.285133E-01 -6.787434E-01 -5.098834E-01
+ Rotation from 1-axis to v3_2=(-2,1,-5):
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =  -3.651484E-01 -1.825742E-01  9.128709E-01
+ L20 =   0.000000E+00
+ L2j =   1.825742E-01  9.474943E-01  2.625285E-01
+ L30 =   0.000000E+00
+ L3j =  -9.128709E-01  2.625285E-01 -3.126427E-01
+ Rotation from 2-axis to v3_2=(-2,1,-5):
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =   8.872516E-01 -3.651484E-01 -2.818710E-01
+ L20 =   0.000000E+00
+ L2j =   3.651484E-01  1.825742E-01  9.128709E-01
+ L30 =   0.000000E+00
+ L3j =  -2.818710E-01 -9.128709E-01  2.953226E-01
+ Rotation from 3-axis to v3_2=(-2,1,-5):
+ L00 =   1.000000E+00
+ L0j =   0.000000E+00  0.000000E+00  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =  -5.302967E-01  7.651484E-01 -3.651484E-01
+ L20 =   0.000000E+00
+ L2j =   7.651484E-01  6.174258E-01  1.825742E-01
+ L30 =   0.000000E+00
+ L3j =   3.651484E-01 -1.825742E-01 -9.128709E-01
+
+* Lorentz transformations: boosts
+
+ Boost from rest frame to 3-vector, mass m=10:
+ L00 =   1.067708E+00
+ L0j =   1.000000E-01  2.000000E-01  3.000000E-01
+ L10 =   1.000000E-01
+ L1j =   1.004836E+00  9.672546E-03  1.450882E-02
+ L20 =   2.000000E-01
+ L2j =   9.672546E-03  1.019345E+00  2.901764E-02
+ L30 =   3.000000E-01
+ L3j =   1.450882E-02  2.901764E-02  1.043526E+00
+ Boost from rest frame to 4-vector, mass m=10:
+ L00 =   1.067708E+00
+ L0j =   1.000000E-01  2.000000E-01  3.000000E-01
+ L10 =   1.000000E-01
+ L1j =   1.004836E+00  9.672546E-03  1.450882E-02
+ L20 =   2.000000E-01
+ L2j =   9.672546E-03  1.019345E+00  2.901764E-02
+ L30 =   3.000000E-01
+ L3j =   1.450882E-02  2.901764E-02  1.043526E+00
+ Boost along 1-axis, beta*gamma = 12
+ L00 =   1.204159E+01
+ L0j =   1.200000E+01  0.000000E+00  0.000000E+00
+ L10 =   1.200000E+01
+ L1j =   1.204159E+01  0.000000E+00  0.000000E+00
+ L20 =   0.000000E+00
+ L2j =   0.000000E+00  1.000000E+00  0.000000E+00
+ L30 =   0.000000E+00
+ L3j =   0.000000E+00  0.000000E+00  1.000000E+00
+ Boost along 2-axis, beta*gamma = 12
+ L00 =   1.204159E+01
+ L0j =   0.000000E+00  1.200000E+01  0.000000E+00
+ L10 =   0.000000E+00
+ L1j =   1.000000E+00  0.000000E+00  0.000000E+00
+ L20 =   1.200000E+01
+ L2j =   0.000000E+00  1.204159E+01  0.000000E+00
+ L30 =   0.000000E+00
+ L3j =   0.000000E+00  0.000000E+00  1.000000E+00
+ Boost along 3-axis, beta*gamma = 12
+ L00 =   1.204159E+01
+ L0j =   0.000000E+00  0.000000E+00  1.200000E+01
+ L10 =   0.000000E+00
+ L1j =   1.000000E+00  0.000000E+00  0.000000E+00
+ L20 =   0.000000E+00
+ L2j =   0.000000E+00  1.000000E+00  0.000000E+00
+ L30 =   1.200000E+01
+ L3j =   0.000000E+00  0.000000E+00  1.204159E+01
+ Boost along axis=(1,2,3), beta*gamma = 12
+ L00 =   1.204159E+01
+ L0j =   3.207135E+00  6.414270E+00  9.621405E+00
+ L10 =   3.207135E+00
+ L1j =   1.788685E+00  1.577371E+00  2.366056E+00
+ L20 =   6.414270E+00
+ L2j =   1.577371E+00  4.154741E+00  4.732112E+00
+ L30 =   9.621405E+00
+ L3j =   2.366056E+00  4.732112E+00  8.098168E+00
+
+* Test output end: lorentz_4
Index: trunk/share/tests/unit_tests/ref-output/lorentz_5.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/lorentz_5.ref	(revision 0)
+++ trunk/share/tests/unit_tests/ref-output/lorentz_5.ref	(revision 8835)
@@ -0,0 +1,79 @@
+* Test output: lorentz_5
+*   Purpose: testing additional kinematics and sets of 4-vectors
+
+
+* Colliding momenta, 13 TeV, massless
+
+ E =   6.500000E+03
+ P =   0.000000E+00  0.000000E+00  6.500000E+03
+ E =   6.500000E+03
+ P =   0.000000E+00  0.000000E+00 -6.500000E+03
+
+* Colliding momenta, 10 GeV, massive muons
+
+ E =   5.000000E+00
+ P =   0.000000E+00  0.000000E+00  4.998883E+00
+ E =   5.000000E+00
+ P =   0.000000E+00  0.000000E+00 -4.998883E+00
+
+* Kinematical function lambda
+
+ s = 172.3**2, m1 = 4.2, m2 = 80.418: 5.37904E+08
+
+* Test vector_set
+
+ Write routine for vector sets, maximal compression:
+ E =   2.5000E+02
+ P =   0.0000E+00  0.0000E+00  2.5000E+02
+ M =   5.1099E-04
+ E =   2.5000E+02
+ P =   0.0000E+00  0.0000E+00 -2.5000E+02
+ M =   5.1099E-04
+ E =   1.1557E+02
+ P =   3.9012E+01 -6.4278E+01  8.7672E+01
+ M =   4.2000E+00
+ E =   1.4618E+02
+ P =  -1.0948E+02  1.5484E+01 -9.5526E+01
+ M =   4.2000E+00
+ E =   5.2638E+01
+ P =  -4.7413E+01  1.0088E+01  2.0517E+01
+ M =   1.0566E-01
+ E =   5.4760E+01
+ P =   1.5197E+01  5.1527E+01 -1.0616E+01
+ M =   0.0000E+00
+ E =   3.2415E+01
+ P =   7.5539E+00 -1.5936E+01 -2.7140E+01
+ M =   1.7770E+00
+ E =   9.8433E+01
+ P =   9.5130E+01  3.1146E+00  2.5093E+01
+ M =   0.0000E+00
+ Vector set is CMS frame: T
+ Reshuffle vector set, final state inverted:
+ E =   2.5000E+02
+ P =   0.0000E+00  0.0000E+00  2.5000E+02
+ M =   5.1099E-04
+ E =   2.5000E+02
+ P =   0.0000E+00  0.0000E+00 -2.5000E+02
+ M =   5.1099E-04
+ E =   9.8433E+01
+ P =   9.5130E+01  3.1146E+00  2.5093E+01
+ M =   0.0000E+00
+ E =   3.2415E+01
+ P =   7.5539E+00 -1.5936E+01 -2.7140E+01
+ M =   1.7770E+00
+ E =   5.4760E+01
+ P =   1.5197E+01  5.1527E+01 -1.0616E+01
+ M =   0.0000E+00
+ E =   5.2638E+01
+ P =  -4.7413E+01  1.0088E+01  2.0517E+01
+ M =   1.0566E-01
+ E =   1.4618E+02
+ P =  -1.0948E+02  1.5484E+01 -9.5526E+01
+ M =   4.2000E+00
+ E =   1.1557E+02
+ P =   3.9012E+01 -6.4278E+01  8.7672E+01
+ M =   4.2000E+00
+ Vector set, check momentum conservation:
+Momentum conservation: CHECK
+
+* Test output end: lorentz_5
Index: trunk/share/tests/unit_tests/ref-output/phs_points_1.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/phs_points_1.ref	(revision 8834)
+++ trunk/share/tests/unit_tests/ref-output/phs_points_1.ref	(revision 8835)
@@ -1,5 +1,50 @@
 * Test output: phs_points_1
-*   Purpose: none yet
+*   Purpose: handling a 2->6 PSP
 
 
+*   Setting up a 2->6 off-shell top PSP
+
+
+*   Retrieving the size of PSP
+
+   Size PSP  = 8
+
+*   Returning the set of 4-momenta from PSP
+
+   set 4-mom.  =
+ E =   2.5000E+02
+ P =   0.0000E+00  0.0000E+00  2.5000E+02
+ E =   2.5000E+02
+ P =   0.0000E+00  0.0000E+00 -2.5000E+02
+ E =   1.1557E+02
+ P =   3.9012E+01 -6.4278E+01  8.7672E+01
+ E =   1.4618E+02
+ P =  -1.0948E+02  1.5484E+01 -9.5526E+01
+ E =   5.2638E+01
+ P =  -4.7413E+01  1.0088E+01  2.0517E+01
+ E =   5.4760E+01
+ P =   1.5197E+01  5.1527E+01 -1.0616E+01
+ E =   3.2415E+01
+ P =   7.5539E+00 -1.5936E+01 -2.7140E+01
+ E =   9.8433E+01
+ P =   9.5130E+01  3.1146E+00  2.5093E+01
+
+*   Sum of momenta of PSP
+
+   Sum:
+ E =   1.000000000000E+03
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+
+*   Reconstructing top/antitop candidate invariant masses from PSP
+
+   m2(top)   =  1.98512E+02
+   m2(a-top) =  1.43662E+02
+
+*   Select a specific 4-vector from PSP, here for a tau
+
+   p(tau):
+ E =   3.241506E+01
+ P =   7.553939E+00 -1.593583E+01 -2.713974E+01
+ M =   1.777050E+00
+
 * Test output end: phs_points_1
Index: trunk/share/tests/Makefile.am
===================================================================
--- trunk/share/tests/Makefile.am	(revision 8834)
+++ trunk/share/tests/Makefile.am	(revision 8835)
@@ -1,1629 +1,1634 @@
 ## Makefile.am -- Makefile for WHIZARD tests
 ##
 ## Process this file with automake to produce Makefile.in
 ##
 ########################################################################
 #
 # Copyright (C) 1999-2022 by
 #     Wolfgang Kilian <kilian@physik.uni-siegen.de>
 #     Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
 #     Juergen Reuter <juergen.reuter@desy.de>
 #     with contributions from
 #     cf. main AUTHORS file
 #
 # WHIZARD is free software; you can redistribute it and/or modify it
 # under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 2, or (at your option)
 # any later version.
 #
 # WHIZARD is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
 #
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 #
 ########################################################################
 
 EXTRA_DIST = \
     $(TESTSUITE_MACROS) $(TESTSUITES_M4) $(TESTSUITES_SIN) \
     $(TESTSUITE_TOOLS) \
     $(REF_OUTPUT_FILES) \
     cascades2_1.fds \
     cascades2_2.fds \
     cascades2_lexer_1.fds \
     ext_tests_nmssm/nmssm.slha \
     functional_tests/structure_2_inc.sin functional_tests/testproc_3.phs \
     functional_tests/susyhit.in \
     functional_tests/ufo_5_test.slha
 
 TESTSUITE_MACROS = testsuite.m4
 TESTSUITE_TOOLS = \
     check-debug-output.py \
     check-debug-output-hadro.py \
     check-hepmc-weights.py \
     compare-histograms.py \
     compare-integrals.py \
     compare-integrals-multi.py \
     compare-methods.py
 
 REF_OUTPUT_FILES = \
     extra_integration_results.dat \
     $(REF_OUTPUT_FILES_BASE) $(REF_OUTPUT_FILES_DOUBLE) \
     $(REF_OUTPUT_FILES_PREC) $(REF_OUTPUT_FILES_EXT) \
     $(REF_OUTPUT_FILES_QUAD)
 
 REF_OUTPUT_FILES_BASE = \
     unit_tests/ref-output/analysis_1.ref \
     unit_tests/ref-output/api_1.ref \
     unit_tests/ref-output/api_2.ref \
     unit_tests/ref-output/api_3.ref \
     unit_tests/ref-output/api_4.ref \
     unit_tests/ref-output/api_5.ref \
     unit_tests/ref-output/api_6.ref \
     unit_tests/ref-output/api_7.ref \
     unit_tests/ref-output/api_8.ref \
     unit_tests/ref-output/api_c_1.ref \
     unit_tests/ref-output/api_c_2.ref \
     unit_tests/ref-output/api_c_3.ref \
     unit_tests/ref-output/api_c_4.ref \
     unit_tests/ref-output/api_c_5.ref \
     unit_tests/ref-output/api_cc_1.ref \
     unit_tests/ref-output/api_cc_2.ref \
     unit_tests/ref-output/api_cc_3.ref \
     unit_tests/ref-output/api_cc_4.ref \
     unit_tests/ref-output/api_cc_5.ref \
     unit_tests/ref-output/api_hepmc2_1.ref \
     unit_tests/ref-output/api_hepmc2_cc_1.ref \
     unit_tests/ref-output/api_hepmc3_1.ref \
     unit_tests/ref-output/api_hepmc3_cc_1.ref \
     unit_tests/ref-output/api_lcio_1.ref \
     unit_tests/ref-output/api_lcio_cc_1.ref \
     unit_tests/ref-output/array_list_1.ref \
     unit_tests/ref-output/auto_components_1.ref \
     unit_tests/ref-output/auto_components_2.ref \
     unit_tests/ref-output/auto_components_3.ref \
     unit_tests/ref-output/beam_1.ref \
     unit_tests/ref-output/beam_2.ref \
     unit_tests/ref-output/beam_3.ref \
     unit_tests/ref-output/beam_structures_1.ref \
     unit_tests/ref-output/beam_structures_2.ref \
     unit_tests/ref-output/beam_structures_3.ref \
     unit_tests/ref-output/beam_structures_4.ref \
     unit_tests/ref-output/beam_structures_5.ref \
     unit_tests/ref-output/beam_structures_6.ref \
     unit_tests/ref-output/binary_tree_1.ref \
     unit_tests/ref-output/blha_1.ref \
     unit_tests/ref-output/blha_2.ref \
     unit_tests/ref-output/blha_3.ref \
     unit_tests/ref-output/bloch_vectors_1.ref \
     unit_tests/ref-output/bloch_vectors_2.ref \
     unit_tests/ref-output/bloch_vectors_3.ref \
     unit_tests/ref-output/bloch_vectors_4.ref \
     unit_tests/ref-output/bloch_vectors_5.ref \
     unit_tests/ref-output/bloch_vectors_6.ref \
     unit_tests/ref-output/bloch_vectors_7.ref \
     unit_tests/ref-output/cascades2_1.ref \
     unit_tests/ref-output/cascades2_2.ref \
     unit_tests/ref-output/cascades2_lexer_1.ref \
     unit_tests/ref-output/cascades_1.ref \
     unit_tests/ref-output/cascades_2.ref \
     unit_tests/ref-output/color_1.ref \
     unit_tests/ref-output/color_2.ref \
     unit_tests/ref-output/commands_1.ref \
     unit_tests/ref-output/commands_2.ref \
     unit_tests/ref-output/commands_3.ref \
     unit_tests/ref-output/commands_4.ref \
     unit_tests/ref-output/commands_5.ref \
     unit_tests/ref-output/commands_6.ref \
     unit_tests/ref-output/commands_7.ref \
     unit_tests/ref-output/commands_8.ref \
     unit_tests/ref-output/commands_9.ref \
     unit_tests/ref-output/commands_10.ref \
     unit_tests/ref-output/commands_11.ref \
     unit_tests/ref-output/commands_12.ref \
     unit_tests/ref-output/commands_13.ref \
     unit_tests/ref-output/commands_14.ref \
     unit_tests/ref-output/commands_15.ref \
     unit_tests/ref-output/commands_16.ref \
     unit_tests/ref-output/commands_17.ref \
     unit_tests/ref-output/commands_18.ref \
     unit_tests/ref-output/commands_19.ref \
     unit_tests/ref-output/commands_20.ref \
     unit_tests/ref-output/commands_21.ref \
     unit_tests/ref-output/commands_22.ref \
     unit_tests/ref-output/commands_23.ref \
     unit_tests/ref-output/commands_24.ref \
     unit_tests/ref-output/commands_25.ref \
     unit_tests/ref-output/commands_26.ref \
     unit_tests/ref-output/commands_27.ref \
     unit_tests/ref-output/commands_28.ref \
     unit_tests/ref-output/commands_29.ref \
     unit_tests/ref-output/commands_30.ref \
     unit_tests/ref-output/commands_31.ref \
     unit_tests/ref-output/commands_32.ref \
     unit_tests/ref-output/commands_33.ref \
     unit_tests/ref-output/commands_34.ref \
     unit_tests/ref-output/compilations_1.ref \
     unit_tests/ref-output/compilations_2.ref \
     unit_tests/ref-output/compilations_3.ref \
     unit_tests/ref-output/compilations_static_1.ref \
     unit_tests/ref-output/compilations_static_2.ref \
     unit_tests/ref-output/cputime_1.ref \
     unit_tests/ref-output/cputime_2.ref \
     unit_tests/ref-output/decays_1.ref \
     unit_tests/ref-output/decays_2.ref \
     unit_tests/ref-output/decays_3.ref \
     unit_tests/ref-output/decays_4.ref \
     unit_tests/ref-output/decays_5.ref \
     unit_tests/ref-output/decays_6.ref \
     unit_tests/ref-output/dispatch_1.ref \
     unit_tests/ref-output/dispatch_2.ref \
     unit_tests/ref-output/dispatch_7.ref \
     unit_tests/ref-output/dispatch_8.ref \
     unit_tests/ref-output/dispatch_10.ref \
     unit_tests/ref-output/dispatch_11.ref \
     unit_tests/ref-output/dispatch_mci_1.ref \
     unit_tests/ref-output/dispatch_phs_1.ref \
     unit_tests/ref-output/dispatch_phs_2.ref \
     unit_tests/ref-output/dispatch_rng_1.ref \
     unit_tests/ref-output/dispatch_transforms_1.ref \
     unit_tests/ref-output/dispatch_transforms_2.ref \
     unit_tests/ref-output/eio_ascii_1.ref \
     unit_tests/ref-output/eio_ascii_2.ref \
     unit_tests/ref-output/eio_ascii_3.ref \
     unit_tests/ref-output/eio_ascii_4.ref \
     unit_tests/ref-output/eio_ascii_5.ref \
     unit_tests/ref-output/eio_ascii_6.ref \
     unit_tests/ref-output/eio_ascii_7.ref \
     unit_tests/ref-output/eio_ascii_8.ref \
     unit_tests/ref-output/eio_ascii_9.ref \
     unit_tests/ref-output/eio_ascii_10.ref \
     unit_tests/ref-output/eio_ascii_11.ref \
     unit_tests/ref-output/eio_base_1.ref \
     unit_tests/ref-output/eio_checkpoints_1.ref \
     unit_tests/ref-output/eio_data_1.ref \
     unit_tests/ref-output/eio_data_2.ref \
     unit_tests/ref-output/eio_direct_1.ref \
     unit_tests/ref-output/eio_dump_1.ref \
     unit_tests/ref-output/eio_hepmc2_1.ref \
     unit_tests/ref-output/eio_hepmc2_2.ref \
     unit_tests/ref-output/eio_hepmc2_3.ref \
     unit_tests/ref-output/eio_hepmc3_1.ref \
     unit_tests/ref-output/eio_hepmc3_2.ref \
     unit_tests/ref-output/eio_hepmc3_3.ref \
     unit_tests/ref-output/eio_lcio_1.ref \
     unit_tests/ref-output/eio_lcio_2.ref \
     unit_tests/ref-output/eio_lhef_1.ref \
     unit_tests/ref-output/eio_lhef_2.ref \
     unit_tests/ref-output/eio_lhef_3.ref \
     unit_tests/ref-output/eio_lhef_4.ref \
     unit_tests/ref-output/eio_lhef_5.ref \
     unit_tests/ref-output/eio_lhef_6.ref \
     unit_tests/ref-output/eio_raw_1.ref \
     unit_tests/ref-output/eio_raw_2.ref \
     unit_tests/ref-output/eio_stdhep_1.ref \
     unit_tests/ref-output/eio_stdhep_2.ref \
     unit_tests/ref-output/eio_stdhep_3.ref \
     unit_tests/ref-output/eio_stdhep_4.ref \
     unit_tests/ref-output/eio_weights_1.ref \
     unit_tests/ref-output/eio_weights_2.ref \
     unit_tests/ref-output/eio_weights_3.ref \
     unit_tests/ref-output/electron_pdfs_1.ref \
     unit_tests/ref-output/electron_pdfs_2.ref \
     unit_tests/ref-output/electron_pdfs_3.ref \
     unit_tests/ref-output/electron_pdfs_4.ref \
     unit_tests/ref-output/electron_pdfs_5.ref \
     unit_tests/ref-output/electron_pdfs_6.ref \
     unit_tests/ref-output/epa_handler_1.ref \
     unit_tests/ref-output/epa_handler_2.ref \
     unit_tests/ref-output/epa_handler_3.ref \
     unit_tests/ref-output/evaluator_1.ref \
     unit_tests/ref-output/evaluator_2.ref \
     unit_tests/ref-output/evaluator_3.ref \
     unit_tests/ref-output/evaluator_4.ref \
     unit_tests/ref-output/event_streams_1.ref \
     unit_tests/ref-output/event_streams_2.ref \
     unit_tests/ref-output/event_streams_3.ref \
     unit_tests/ref-output/event_streams_4.ref \
     unit_tests/ref-output/event_transforms_1.ref \
     unit_tests/ref-output/events_1.ref \
     unit_tests/ref-output/events_2.ref \
     unit_tests/ref-output/events_3.ref \
     unit_tests/ref-output/events_4.ref \
     unit_tests/ref-output/events_5.ref \
     unit_tests/ref-output/events_6.ref \
     unit_tests/ref-output/events_7.ref \
     unit_tests/ref-output/expressions_1.ref \
     unit_tests/ref-output/expressions_2.ref \
     unit_tests/ref-output/expressions_3.ref \
     unit_tests/ref-output/expressions_4.ref \
     unit_tests/ref-output/fks_regions_1.ref \
     unit_tests/ref-output/fks_regions_2.ref \
     unit_tests/ref-output/fks_regions_3.ref \
     unit_tests/ref-output/fks_regions_4.ref \
     unit_tests/ref-output/fks_regions_5.ref \
     unit_tests/ref-output/fks_regions_6.ref \
     unit_tests/ref-output/fks_regions_7.ref \
     unit_tests/ref-output/fks_regions_8.ref \
     unit_tests/ref-output/format_1.ref \
     unit_tests/ref-output/grids_1.ref \
     unit_tests/ref-output/grids_2.ref \
     unit_tests/ref-output/grids_3.ref \
     unit_tests/ref-output/grids_4.ref \
     unit_tests/ref-output/grids_5.ref \
     unit_tests/ref-output/hep_events_1.ref \
     unit_tests/ref-output/hepmc2_interface_1.ref \
     unit_tests/ref-output/hepmc3_interface_1.ref \
     unit_tests/ref-output/integration_results_1.ref \
     unit_tests/ref-output/integration_results_2.ref \
     unit_tests/ref-output/integration_results_3.ref \
     unit_tests/ref-output/integration_results_4.ref \
     unit_tests/ref-output/integration_results_5.ref \
     unit_tests/ref-output/integrations_1.ref \
     unit_tests/ref-output/integrations_2.ref \
     unit_tests/ref-output/integrations_3.ref \
     unit_tests/ref-output/integrations_4.ref \
     unit_tests/ref-output/integrations_5.ref \
     unit_tests/ref-output/integrations_6.ref \
     unit_tests/ref-output/integrations_7.ref \
     unit_tests/ref-output/integrations_8.ref \
     unit_tests/ref-output/integrations_9.ref \
     unit_tests/ref-output/integrations_history_1.ref \
     unit_tests/ref-output/interaction_1.ref \
     unit_tests/ref-output/isr_handler_1.ref \
     unit_tests/ref-output/isr_handler_2.ref \
     unit_tests/ref-output/isr_handler_3.ref \
     unit_tests/ref-output/iterations_1.ref \
     unit_tests/ref-output/iterations_2.ref \
     unit_tests/ref-output/iterator_1.ref \
     unit_tests/ref-output/jets_1.ref \
     unit_tests/ref-output/lcio_interface_1.ref \
     unit_tests/ref-output/lexer_1.ref \
+    unit_tests/ref-output/lorentz_1.ref \
+    unit_tests/ref-output/lorentz_2.ref \
+    unit_tests/ref-output/lorentz_3.ref \
+    unit_tests/ref-output/lorentz_4.ref \
+    unit_tests/ref-output/lorentz_5.ref \
     unit_tests/ref-output/mci_base_1.ref \
     unit_tests/ref-output/mci_base_2.ref \
     unit_tests/ref-output/mci_base_3.ref \
     unit_tests/ref-output/mci_base_4.ref \
     unit_tests/ref-output/mci_base_5.ref \
     unit_tests/ref-output/mci_base_6.ref \
     unit_tests/ref-output/mci_base_7.ref \
     unit_tests/ref-output/mci_base_8.ref \
     unit_tests/ref-output/mci_midpoint_1.ref \
     unit_tests/ref-output/mci_midpoint_2.ref \
     unit_tests/ref-output/mci_midpoint_3.ref \
     unit_tests/ref-output/mci_midpoint_4.ref \
     unit_tests/ref-output/mci_midpoint_5.ref \
     unit_tests/ref-output/mci_midpoint_6.ref \
     unit_tests/ref-output/mci_midpoint_7.ref \
     unit_tests/ref-output/mci_none_1.ref \
     unit_tests/ref-output/mci_vamp2_1.ref \
     unit_tests/ref-output/mci_vamp2_2.ref \
     unit_tests/ref-output/mci_vamp2_3.ref \
     unit_tests/ref-output/mci_vamp_1.ref \
     unit_tests/ref-output/mci_vamp_2.ref \
     unit_tests/ref-output/mci_vamp_3.ref \
     unit_tests/ref-output/mci_vamp_4.ref \
     unit_tests/ref-output/mci_vamp_5.ref \
     unit_tests/ref-output/mci_vamp_6.ref \
     unit_tests/ref-output/mci_vamp_7.ref \
     unit_tests/ref-output/mci_vamp_8.ref \
     unit_tests/ref-output/mci_vamp_9.ref \
     unit_tests/ref-output/mci_vamp_10.ref \
     unit_tests/ref-output/mci_vamp_11.ref \
     unit_tests/ref-output/mci_vamp_12.ref \
     unit_tests/ref-output/mci_vamp_13.ref \
     unit_tests/ref-output/mci_vamp_14.ref \
     unit_tests/ref-output/mci_vamp_15.ref \
     unit_tests/ref-output/mci_vamp_16.ref \
     unit_tests/ref-output/md5_1.ref \
     unit_tests/ref-output/models_1.ref \
     unit_tests/ref-output/models_2.ref \
     unit_tests/ref-output/models_3.ref \
     unit_tests/ref-output/models_4.ref \
     unit_tests/ref-output/models_5.ref \
     unit_tests/ref-output/models_6.ref \
     unit_tests/ref-output/models_7.ref \
     unit_tests/ref-output/models_8.ref \
     unit_tests/ref-output/models_9.ref \
     unit_tests/ref-output/models_10.ref \
     unit_tests/ref-output/numeric_utils_1.ref \
     unit_tests/ref-output/numeric_utils_2.ref \
     unit_tests/ref-output/os_interface_1.ref \
     unit_tests/ref-output/parse_1.ref \
     unit_tests/ref-output/particle_specifiers_1.ref \
     unit_tests/ref-output/particle_specifiers_2.ref \
     unit_tests/ref-output/particles_1.ref \
     unit_tests/ref-output/particles_2.ref \
     unit_tests/ref-output/particles_3.ref \
     unit_tests/ref-output/particles_4.ref \
     unit_tests/ref-output/particles_5.ref \
     unit_tests/ref-output/particles_6.ref \
     unit_tests/ref-output/particles_7.ref \
     unit_tests/ref-output/particles_8.ref \
     unit_tests/ref-output/particles_9.ref \
     unit_tests/ref-output/parton_states_1.ref \
     unit_tests/ref-output/pdg_arrays_1.ref \
     unit_tests/ref-output/pdg_arrays_2.ref \
     unit_tests/ref-output/pdg_arrays_3.ref \
     unit_tests/ref-output/pdg_arrays_4.ref \
     unit_tests/ref-output/pdg_arrays_5.ref \
     unit_tests/ref-output/phs_base_1.ref \
     unit_tests/ref-output/phs_base_2.ref \
     unit_tests/ref-output/phs_base_3.ref \
     unit_tests/ref-output/phs_base_4.ref \
     unit_tests/ref-output/phs_base_5.ref \
     unit_tests/ref-output/phs_fks_generator_1.ref \
     unit_tests/ref-output/phs_fks_generator_2.ref \
     unit_tests/ref-output/phs_fks_generator_3.ref \
     unit_tests/ref-output/phs_fks_generator_4.ref \
     unit_tests/ref-output/phs_fks_generator_5.ref \
     unit_tests/ref-output/phs_fks_generator_6.ref \
     unit_tests/ref-output/phs_fks_generator_7.ref \
     unit_tests/ref-output/phs_forest_1.ref \
     unit_tests/ref-output/phs_forest_2.ref \
     unit_tests/ref-output/phs_none_1.ref \
     unit_tests/ref-output/phs_points_1.ref \
     unit_tests/ref-output/phs_rambo_1.ref \
     unit_tests/ref-output/phs_rambo_2.ref \
     unit_tests/ref-output/phs_rambo_3.ref \
     unit_tests/ref-output/phs_rambo_4.ref \
     unit_tests/ref-output/phs_single_1.ref \
     unit_tests/ref-output/phs_single_2.ref \
     unit_tests/ref-output/phs_single_3.ref \
     unit_tests/ref-output/phs_single_4.ref \
     unit_tests/ref-output/phs_tree_1.ref \
     unit_tests/ref-output/phs_tree_2.ref \
     unit_tests/ref-output/phs_wood_1.ref \
     unit_tests/ref-output/phs_wood_2.ref \
     unit_tests/ref-output/phs_wood_3.ref \
     unit_tests/ref-output/phs_wood_4.ref \
     unit_tests/ref-output/phs_wood_5.ref \
     unit_tests/ref-output/phs_wood_6.ref \
     unit_tests/ref-output/phs_wood_vis_1.ref \
     unit_tests/ref-output/polarization_1.ref \
     unit_tests/ref-output/polarization_2.ref \
     unit_tests/ref-output/prc_omega_1.ref \
     unit_tests/ref-output/prc_omega_2.ref \
     unit_tests/ref-output/prc_omega_3.ref \
     unit_tests/ref-output/prc_omega_4.ref \
     unit_tests/ref-output/prc_omega_5.ref \
     unit_tests/ref-output/prc_omega_6.ref \
     unit_tests/ref-output/prc_omega_diags_1.ref \
     unit_tests/ref-output/prc_recola_1.ref \
     unit_tests/ref-output/prc_recola_2.ref \
     unit_tests/ref-output/prc_template_me_1.ref \
     unit_tests/ref-output/prc_template_me_2.ref \
     unit_tests/ref-output/prc_test_1.ref \
     unit_tests/ref-output/prc_test_2.ref \
     unit_tests/ref-output/prc_test_3.ref \
     unit_tests/ref-output/prc_test_4.ref \
     unit_tests/ref-output/prclib_interfaces_1.ref \
     unit_tests/ref-output/prclib_interfaces_2.ref \
     unit_tests/ref-output/prclib_interfaces_3.ref \
     unit_tests/ref-output/prclib_interfaces_4.ref \
     unit_tests/ref-output/prclib_interfaces_5.ref \
     unit_tests/ref-output/prclib_interfaces_6.ref \
     unit_tests/ref-output/prclib_interfaces_7.ref \
     unit_tests/ref-output/prclib_stacks_1.ref \
     unit_tests/ref-output/prclib_stacks_2.ref \
     unit_tests/ref-output/process_configurations_1.ref \
     unit_tests/ref-output/process_configurations_2.ref \
     unit_tests/ref-output/process_libraries_1.ref \
     unit_tests/ref-output/process_libraries_2.ref \
     unit_tests/ref-output/process_libraries_3.ref \
     unit_tests/ref-output/process_libraries_4.ref \
     unit_tests/ref-output/process_libraries_5.ref \
     unit_tests/ref-output/process_libraries_6.ref \
     unit_tests/ref-output/process_libraries_7.ref \
     unit_tests/ref-output/process_libraries_8.ref \
     unit_tests/ref-output/process_stacks_1.ref \
     unit_tests/ref-output/process_stacks_2.ref \
     unit_tests/ref-output/process_stacks_3.ref \
     unit_tests/ref-output/process_stacks_4.ref \
     unit_tests/ref-output/processes_1.ref \
     unit_tests/ref-output/processes_2.ref \
     unit_tests/ref-output/processes_3.ref \
     unit_tests/ref-output/processes_4.ref \
     unit_tests/ref-output/processes_5.ref \
     unit_tests/ref-output/processes_6.ref \
     unit_tests/ref-output/processes_7.ref \
     unit_tests/ref-output/processes_8.ref \
     unit_tests/ref-output/processes_9.ref \
     unit_tests/ref-output/processes_10.ref \
     unit_tests/ref-output/processes_11.ref \
     unit_tests/ref-output/processes_12.ref \
     unit_tests/ref-output/processes_13.ref \
     unit_tests/ref-output/processes_14.ref \
     unit_tests/ref-output/processes_15.ref \
     unit_tests/ref-output/processes_16.ref \
     unit_tests/ref-output/processes_17.ref \
     unit_tests/ref-output/processes_18.ref \
     unit_tests/ref-output/processes_19.ref \
     unit_tests/ref-output/radiation_generator_1.ref \
     unit_tests/ref-output/radiation_generator_2.ref \
     unit_tests/ref-output/radiation_generator_3.ref \
     unit_tests/ref-output/radiation_generator_4.ref \
     unit_tests/ref-output/real_subtraction_1.ref \
     unit_tests/ref-output/recoil_kinematics_1.ref \
     unit_tests/ref-output/recoil_kinematics_2.ref \
     unit_tests/ref-output/recoil_kinematics_3.ref \
     unit_tests/ref-output/recoil_kinematics_4.ref \
     unit_tests/ref-output/recoil_kinematics_5.ref \
     unit_tests/ref-output/recoil_kinematics_6.ref \
     unit_tests/ref-output/resonance_insertion_1.ref \
     unit_tests/ref-output/resonance_insertion_2.ref \
     unit_tests/ref-output/resonance_insertion_3.ref \
     unit_tests/ref-output/resonance_insertion_4.ref \
     unit_tests/ref-output/resonance_insertion_5.ref \
     unit_tests/ref-output/resonance_insertion_6.ref \
     unit_tests/ref-output/resonances_1.ref \
     unit_tests/ref-output/resonances_2.ref \
     unit_tests/ref-output/resonances_3.ref \
     unit_tests/ref-output/resonances_4.ref \
     unit_tests/ref-output/resonances_5.ref \
     unit_tests/ref-output/resonances_6.ref \
     unit_tests/ref-output/resonances_7.ref \
     unit_tests/ref-output/restricted_subprocesses_1.ref \
     unit_tests/ref-output/restricted_subprocesses_2.ref \
     unit_tests/ref-output/restricted_subprocesses_3.ref \
     unit_tests/ref-output/restricted_subprocesses_4.ref \
     unit_tests/ref-output/restricted_subprocesses_5.ref \
     unit_tests/ref-output/restricted_subprocesses_6.ref \
     unit_tests/ref-output/rng_base_1.ref \
     unit_tests/ref-output/rng_base_2.ref \
     unit_tests/ref-output/rng_stream_1.ref \
     unit_tests/ref-output/rng_stream_2.ref \
     unit_tests/ref-output/rng_stream_3.ref \
     unit_tests/ref-output/rng_tao_1.ref \
     unit_tests/ref-output/rng_tao_2.ref \
     unit_tests/ref-output/rt_data_1.ref \
     unit_tests/ref-output/rt_data_2.ref \
     unit_tests/ref-output/rt_data_3.ref \
     unit_tests/ref-output/rt_data_4.ref \
     unit_tests/ref-output/rt_data_5.ref \
     unit_tests/ref-output/rt_data_6.ref \
     unit_tests/ref-output/rt_data_7.ref \
     unit_tests/ref-output/rt_data_8.ref \
     unit_tests/ref-output/rt_data_9.ref \
     unit_tests/ref-output/rt_data_10.ref \
     unit_tests/ref-output/rt_data_11.ref \
     unit_tests/ref-output/selectors_1.ref \
     unit_tests/ref-output/selectors_2.ref \
     unit_tests/ref-output/sf_aux_1.ref \
     unit_tests/ref-output/sf_aux_2.ref \
     unit_tests/ref-output/sf_aux_3.ref \
     unit_tests/ref-output/sf_aux_4.ref \
     unit_tests/ref-output/sf_base_1.ref \
     unit_tests/ref-output/sf_base_2.ref \
     unit_tests/ref-output/sf_base_3.ref \
     unit_tests/ref-output/sf_base_4.ref \
     unit_tests/ref-output/sf_base_5.ref \
     unit_tests/ref-output/sf_base_6.ref \
     unit_tests/ref-output/sf_base_7.ref \
     unit_tests/ref-output/sf_base_8.ref \
     unit_tests/ref-output/sf_base_9.ref \
     unit_tests/ref-output/sf_base_10.ref \
     unit_tests/ref-output/sf_base_11.ref \
     unit_tests/ref-output/sf_base_12.ref \
     unit_tests/ref-output/sf_base_13.ref \
     unit_tests/ref-output/sf_base_14.ref \
     unit_tests/ref-output/sf_beam_events_1.ref \
     unit_tests/ref-output/sf_beam_events_2.ref \
     unit_tests/ref-output/sf_beam_events_3.ref \
     unit_tests/ref-output/sf_circe1_1.ref \
     unit_tests/ref-output/sf_circe1_2.ref \
     unit_tests/ref-output/sf_circe1_3.ref \
     unit_tests/ref-output/sf_circe2_1.ref \
     unit_tests/ref-output/sf_circe2_2.ref \
     unit_tests/ref-output/sf_circe2_3.ref \
     unit_tests/ref-output/sf_epa_1.ref \
     unit_tests/ref-output/sf_epa_2.ref \
     unit_tests/ref-output/sf_epa_3.ref \
     unit_tests/ref-output/sf_epa_4.ref \
     unit_tests/ref-output/sf_epa_5.ref \
     unit_tests/ref-output/sf_escan_1.ref \
     unit_tests/ref-output/sf_escan_2.ref \
     unit_tests/ref-output/sf_ewa_1.ref \
     unit_tests/ref-output/sf_ewa_2.ref \
     unit_tests/ref-output/sf_ewa_3.ref \
     unit_tests/ref-output/sf_ewa_4.ref \
     unit_tests/ref-output/sf_ewa_5.ref \
     unit_tests/ref-output/sf_gaussian_1.ref \
     unit_tests/ref-output/sf_gaussian_2.ref \
     unit_tests/ref-output/sf_isr_1.ref \
     unit_tests/ref-output/sf_isr_2.ref \
     unit_tests/ref-output/sf_isr_3.ref \
     unit_tests/ref-output/sf_isr_4.ref \
     unit_tests/ref-output/sf_isr_5.ref \
     unit_tests/ref-output/sf_lhapdf5_1.ref \
     unit_tests/ref-output/sf_lhapdf5_2.ref \
     unit_tests/ref-output/sf_lhapdf5_3.ref \
     unit_tests/ref-output/sf_lhapdf6_1.ref \
     unit_tests/ref-output/sf_lhapdf6_2.ref \
     unit_tests/ref-output/sf_lhapdf6_3.ref \
     unit_tests/ref-output/sf_mappings_1.ref \
     unit_tests/ref-output/sf_mappings_2.ref \
     unit_tests/ref-output/sf_mappings_3.ref \
     unit_tests/ref-output/sf_mappings_4.ref \
     unit_tests/ref-output/sf_mappings_5.ref \
     unit_tests/ref-output/sf_mappings_6.ref \
     unit_tests/ref-output/sf_mappings_7.ref \
     unit_tests/ref-output/sf_mappings_8.ref \
     unit_tests/ref-output/sf_mappings_9.ref \
     unit_tests/ref-output/sf_mappings_10.ref \
     unit_tests/ref-output/sf_mappings_11.ref \
     unit_tests/ref-output/sf_mappings_12.ref \
     unit_tests/ref-output/sf_mappings_13.ref \
     unit_tests/ref-output/sf_mappings_14.ref \
     unit_tests/ref-output/sf_mappings_15.ref \
     unit_tests/ref-output/sf_mappings_16.ref \
     unit_tests/ref-output/sf_pdf_builtin_1.ref \
     unit_tests/ref-output/sf_pdf_builtin_2.ref \
     unit_tests/ref-output/sf_pdf_builtin_3.ref \
     unit_tests/ref-output/shower_1.ref \
     unit_tests/ref-output/shower_2.ref \
     unit_tests/ref-output/shower_base_1.ref \
     unit_tests/ref-output/simulations_1.ref \
     unit_tests/ref-output/simulations_2.ref \
     unit_tests/ref-output/simulations_3.ref \
     unit_tests/ref-output/simulations_4.ref \
     unit_tests/ref-output/simulations_5.ref \
     unit_tests/ref-output/simulations_6.ref \
     unit_tests/ref-output/simulations_7.ref \
     unit_tests/ref-output/simulations_8.ref \
     unit_tests/ref-output/simulations_9.ref \
     unit_tests/ref-output/simulations_10.ref \
     unit_tests/ref-output/simulations_11.ref \
     unit_tests/ref-output/simulations_12.ref \
     unit_tests/ref-output/simulations_13.ref \
     unit_tests/ref-output/simulations_14.ref \
     unit_tests/ref-output/simulations_15.ref \
     unit_tests/ref-output/slha_1.ref \
     unit_tests/ref-output/slha_2.ref \
     unit_tests/ref-output/sm_physics_1.ref \
     unit_tests/ref-output/sm_physics_2.ref \
     unit_tests/ref-output/sm_physics_3.ref \
     unit_tests/ref-output/sm_qcd_1.ref \
     unit_tests/ref-output/sm_qed_1.ref \
     unit_tests/ref-output/solver_1.ref \
     unit_tests/ref-output/sorting_1.ref \
     unit_tests/ref-output/state_matrix_1.ref \
     unit_tests/ref-output/state_matrix_2.ref \
     unit_tests/ref-output/state_matrix_3.ref \
     unit_tests/ref-output/state_matrix_4.ref \
     unit_tests/ref-output/state_matrix_5.ref \
     unit_tests/ref-output/state_matrix_6.ref \
     unit_tests/ref-output/state_matrix_7.ref \
     unit_tests/ref-output/su_algebra_1.ref \
     unit_tests/ref-output/su_algebra_2.ref \
     unit_tests/ref-output/su_algebra_3.ref \
     unit_tests/ref-output/su_algebra_4.ref \
     unit_tests/ref-output/subevt_expr_1.ref \
     unit_tests/ref-output/subevt_expr_2.ref \
     unit_tests/ref-output/ttv_formfactors_1.ref \
     unit_tests/ref-output/ttv_formfactors_2.ref \
     unit_tests/ref-output/vamp2_1.ref \
     unit_tests/ref-output/vamp2_2.ref \
     unit_tests/ref-output/vamp2_3.ref \
     unit_tests/ref-output/vamp2_4.ref \
     unit_tests/ref-output/vamp2_5.ref \
     unit_tests/ref-output/vegas_1.ref \
     unit_tests/ref-output/vegas_2.ref \
     unit_tests/ref-output/vegas_3.ref \
     unit_tests/ref-output/vegas_4.ref \
     unit_tests/ref-output/vegas_5.ref \
     unit_tests/ref-output/vegas_6.ref \
     unit_tests/ref-output/vegas_7.ref \
     unit_tests/ref-output/whizard_lha_1.ref \
     unit_tests/ref-output/xml_1.ref \
     unit_tests/ref-output/xml_2.ref \
     unit_tests/ref-output/xml_3.ref \
     unit_tests/ref-output/xml_4.ref \
     functional_tests/ref-output/alphas.ref \
     functional_tests/ref-output/analyze_1.ref \
     functional_tests/ref-output/analyze_2.ref \
     functional_tests/ref-output/analyze_3.ref \
     functional_tests/ref-output/analyze_4.ref \
     functional_tests/ref-output/analyze_5.ref \
     functional_tests/ref-output/analyze_6.ref \
     functional_tests/ref-output/beam_events_1.ref \
     functional_tests/ref-output/beam_events_4.ref \
     functional_tests/ref-output/beam_setup_1.ref \
     functional_tests/ref-output/beam_setup_2.ref \
     functional_tests/ref-output/beam_setup_3.ref \
     functional_tests/ref-output/beam_setup_4.ref \
     functional_tests/ref-output/bjet_cluster.ref \
     functional_tests/ref-output/br_redef_1.ref \
     functional_tests/ref-output/cascades2_phs_1.ref \
     functional_tests/ref-output/cascades2_phs_2.ref \
     functional_tests/ref-output/circe1_1.ref \
     functional_tests/ref-output/circe1_2.ref \
     functional_tests/ref-output/circe1_3.ref \
     functional_tests/ref-output/circe1_6.ref \
     functional_tests/ref-output/circe1_10.ref \
     functional_tests/ref-output/circe1_errors_1.ref \
     functional_tests/ref-output/circe2_1.ref \
     functional_tests/ref-output/circe2_2.ref \
     functional_tests/ref-output/circe2_3.ref \
     functional_tests/ref-output/cmdline_1.ref \
     functional_tests/ref-output/colors.ref \
     functional_tests/ref-output/colors_hgg.ref \
     functional_tests/ref-output/cuts.ref \
     functional_tests/ref-output/decay_err_1.ref \
     functional_tests/ref-output/decay_err_2.ref \
     functional_tests/ref-output/decay_err_3.ref \
     functional_tests/ref-output/energy_scan_1.ref \
     functional_tests/ref-output/ep_3.ref \
     functional_tests/ref-output/epa_1.ref \
     functional_tests/ref-output/epa_2.ref \
     functional_tests/ref-output/epa_3.ref \
     functional_tests/ref-output/epa_4.ref \
     functional_tests/ref-output/event_dump_1.ref \
     functional_tests/ref-output/event_dump_2.ref \
     functional_tests/ref-output/event_eff_1.ref \
     functional_tests/ref-output/event_eff_2.ref \
     functional_tests/ref-output/event_failed_1.ref \
     functional_tests/ref-output/event_weights_1.ref \
     functional_tests/ref-output/event_weights_2.ref \
     functional_tests/ref-output/ewa_4.ref \
     functional_tests/ref-output/extpar.ref \
     functional_tests/ref-output/fatal.ref \
     functional_tests/ref-output/fatal_beam_decay.ref \
     functional_tests/ref-output/fks_res_2.ref \
     functional_tests/ref-output/flvsum_1.ref \
     functional_tests/ref-output/gaussian_1.ref \
     functional_tests/ref-output/gaussian_2.ref \
     functional_tests/ref-output/hadronize_1.ref \
     functional_tests/ref-output/hepmc_1.ref \
     functional_tests/ref-output/hepmc_2.ref \
     functional_tests/ref-output/hepmc_3.ref \
     functional_tests/ref-output/hepmc_4.ref \
     functional_tests/ref-output/hepmc_5.ref \
     functional_tests/ref-output/hepmc_6.ref \
     functional_tests/ref-output/hepmc_7.ref \
     functional_tests/ref-output/hepmc_9.ref \
     functional_tests/ref-output/hepmc_10.ref \
     functional_tests/ref-output/isr_1.ref \
     functional_tests/ref-output/isr_epa_1.ref \
     functional_tests/ref-output/jets_xsec.ref \
     functional_tests/ref-output/job_id_1.ref \
     functional_tests/ref-output/job_id_2.ref \
     functional_tests/ref-output/job_id_3.ref \
     functional_tests/ref-output/job_id_4.ref \
     functional_tests/ref-output/lcio_1.ref \
     functional_tests/ref-output/lcio_3.ref \
     functional_tests/ref-output/lcio_4.ref \
     functional_tests/ref-output/lcio_5.ref \
     functional_tests/ref-output/lcio_6.ref \
     functional_tests/ref-output/lcio_8.ref \
     functional_tests/ref-output/lcio_9.ref \
     functional_tests/ref-output/lcio_10.ref \
     functional_tests/ref-output/lcio_11.ref \
     functional_tests/ref-output/lhef_1.ref \
     functional_tests/ref-output/lhef_2.ref \
     functional_tests/ref-output/lhef_3.ref \
     functional_tests/ref-output/lhef_4.ref \
     functional_tests/ref-output/lhef_5.ref \
     functional_tests/ref-output/lhef_6.ref \
     functional_tests/ref-output/lhef_9.ref \
     functional_tests/ref-output/lhef_10.ref \
     functional_tests/ref-output/lhef_11.ref \
     functional_tests/ref-output/libraries_1.ref \
     functional_tests/ref-output/libraries_2.ref \
     functional_tests/ref-output/libraries_4.ref \
     functional_tests/ref-output/method_ovm_1.ref \
     functional_tests/ref-output/mlm_matching_fsr.ref \
     functional_tests/ref-output/mlm_pythia6_isr.ref \
     functional_tests/ref-output/model_change_1.ref \
     functional_tests/ref-output/model_change_2.ref \
     functional_tests/ref-output/model_change_3.ref \
     functional_tests/ref-output/model_scheme_1.ref \
     functional_tests/ref-output/model_test.ref \
     functional_tests/ref-output/mssmtest_1.ref \
     functional_tests/ref-output/mssmtest_2.ref \
     functional_tests/ref-output/mssmtest_3.ref \
     functional_tests/ref-output/multi_comp_4.ref \
     functional_tests/ref-output/nlo_1.ref \
     functional_tests/ref-output/nlo_2.ref \
     functional_tests/ref-output/nlo_6.ref \
     functional_tests/ref-output/nlo_decay_1.ref \
     functional_tests/ref-output/observables_1.ref \
     functional_tests/ref-output/openloops_1.ref \
     functional_tests/ref-output/openloops_2.ref \
     functional_tests/ref-output/openloops_4.ref \
     functional_tests/ref-output/openloops_5.ref \
     functional_tests/ref-output/openloops_6.ref \
     functional_tests/ref-output/openloops_7.ref \
     functional_tests/ref-output/openloops_8.ref \
     functional_tests/ref-output/openloops_9.ref \
     functional_tests/ref-output/openloops_10.ref \
     functional_tests/ref-output/openloops_11.ref \
     functional_tests/ref-output/pack_1.ref \
     functional_tests/ref-output/parton_shower_1.ref \
     functional_tests/ref-output/photon_isolation_1.ref \
     functional_tests/ref-output/photon_isolation_2.ref \
     functional_tests/ref-output/polarized_1.ref \
     functional_tests/ref-output/process_log.ref \
     functional_tests/ref-output/pythia6_1.ref \
     functional_tests/ref-output/pythia6_2.ref \
     functional_tests/ref-output/qcdtest_4.ref \
     functional_tests/ref-output/qcdtest_5.ref \
     functional_tests/ref-output/qcdtest_6.ref \
     functional_tests/ref-output/qedtest_1.ref \
     functional_tests/ref-output/qedtest_2.ref \
     functional_tests/ref-output/qedtest_5.ref \
     functional_tests/ref-output/qedtest_6.ref \
     functional_tests/ref-output/qedtest_7.ref \
     functional_tests/ref-output/qedtest_8.ref \
     functional_tests/ref-output/qedtest_9.ref \
     functional_tests/ref-output/qedtest_10.ref \
     functional_tests/ref-output/rambo_vamp_1.ref \
     functional_tests/ref-output/rambo_vamp_2.ref \
     functional_tests/ref-output/real_partition_1.ref \
     functional_tests/ref-output/rebuild_2.ref \
     functional_tests/ref-output/rebuild_3.ref \
     functional_tests/ref-output/rebuild_4.ref \
     functional_tests/ref-output/recola_1.ref \
     functional_tests/ref-output/recola_2.ref \
     functional_tests/ref-output/recola_3.ref \
     functional_tests/ref-output/recola_4.ref \
     functional_tests/ref-output/recola_5.ref \
     functional_tests/ref-output/recola_6.ref \
     functional_tests/ref-output/recola_7.ref \
     functional_tests/ref-output/recola_8.ref \
     functional_tests/ref-output/recola_9.ref \
     functional_tests/ref-output/resonances_5.ref \
     functional_tests/ref-output/resonances_6.ref \
     functional_tests/ref-output/resonances_7.ref \
     functional_tests/ref-output/resonances_8.ref \
     functional_tests/ref-output/resonances_9.ref \
     functional_tests/ref-output/resonances_12.ref \
     functional_tests/ref-output/restrictions.ref \
     functional_tests/ref-output/reweight_1.ref \
     functional_tests/ref-output/reweight_2.ref \
     functional_tests/ref-output/reweight_3.ref \
     functional_tests/ref-output/reweight_4.ref \
     functional_tests/ref-output/reweight_5.ref \
     functional_tests/ref-output/reweight_6.ref \
     functional_tests/ref-output/reweight_7.ref \
     functional_tests/ref-output/reweight_8.ref \
     functional_tests/ref-output/reweight_9.ref \
     functional_tests/ref-output/reweight_10.ref \
     functional_tests/ref-output/select_1.ref \
     functional_tests/ref-output/select_2.ref \
     functional_tests/ref-output/show_1.ref \
     functional_tests/ref-output/show_2.ref \
     functional_tests/ref-output/show_3.ref \
     functional_tests/ref-output/show_4.ref \
     functional_tests/ref-output/show_5.ref \
     functional_tests/ref-output/shower_err_1.ref \
     functional_tests/ref-output/sm_cms_1.ref \
     functional_tests/ref-output/smtest_1.ref \
     functional_tests/ref-output/smtest_3.ref \
     functional_tests/ref-output/smtest_4.ref \
     functional_tests/ref-output/smtest_5.ref \
     functional_tests/ref-output/smtest_6.ref \
     functional_tests/ref-output/smtest_7.ref \
     functional_tests/ref-output/smtest_9.ref \
     functional_tests/ref-output/smtest_10.ref \
     functional_tests/ref-output/smtest_11.ref \
     functional_tests/ref-output/smtest_12.ref \
     functional_tests/ref-output/smtest_13.ref \
     functional_tests/ref-output/smtest_14.ref \
     functional_tests/ref-output/smtest_15.ref \
     functional_tests/ref-output/smtest_16.ref \
     functional_tests/ref-output/smtest_17.ref \
     functional_tests/ref-output/spincor_1.ref \
     functional_tests/ref-output/static_1.ref \
     functional_tests/ref-output/static_2.ref \
     functional_tests/ref-output/stdhep_1.ref \
     functional_tests/ref-output/stdhep_2.ref \
     functional_tests/ref-output/stdhep_3.ref \
     functional_tests/ref-output/stdhep_4.ref \
     functional_tests/ref-output/stdhep_5.ref \
     functional_tests/ref-output/stdhep_6.ref \
     functional_tests/ref-output/structure_1.ref \
     functional_tests/ref-output/structure_2.ref \
     functional_tests/ref-output/structure_3.ref \
     functional_tests/ref-output/structure_4.ref \
     functional_tests/ref-output/structure_5.ref \
     functional_tests/ref-output/structure_6.ref \
     functional_tests/ref-output/structure_7.ref \
     functional_tests/ref-output/structure_8.ref \
     functional_tests/ref-output/susyhit.ref \
     functional_tests/ref-output/template_me_1.ref \
     functional_tests/ref-output/template_me_2.ref \
     functional_tests/ref-output/testproc_1.ref \
     functional_tests/ref-output/testproc_2.ref \
     functional_tests/ref-output/testproc_3.ref \
     functional_tests/ref-output/testproc_4.ref \
     functional_tests/ref-output/testproc_5.ref \
     functional_tests/ref-output/testproc_6.ref \
     functional_tests/ref-output/testproc_7.ref \
     functional_tests/ref-output/testproc_8.ref \
     functional_tests/ref-output/testproc_9.ref \
     functional_tests/ref-output/testproc_10.ref \
     functional_tests/ref-output/testproc_11.ref \
     functional_tests/ref-output/ufo_1.ref \
     functional_tests/ref-output/ufo_2.ref \
     functional_tests/ref-output/ufo_3.ref \
     functional_tests/ref-output/ufo_4.ref \
     functional_tests/ref-output/ufo_5.ref \
     functional_tests/ref-output/ufo_6.ref \
     functional_tests/ref-output/user_prc_threshold_1.ref \
     functional_tests/ref-output/user_prc_threshold_2.ref \
     functional_tests/ref-output/vamp2_1.ref \
     functional_tests/ref-output/vamp2_2.ref \
     functional_tests/ref-output/vamp2_3.ref \
     functional_tests/ref-output/vars.ref \
     ext_tests_nlo/ref-output/nlo_ee4j.ref \
     ext_tests_nlo/ref-output/nlo_ee4t.ref \
     ext_tests_nlo/ref-output/nlo_ee5j.ref \
     ext_tests_nlo/ref-output/nlo_eejj.ref \
     ext_tests_nlo/ref-output/nlo_eejjj.ref \
     ext_tests_nlo/ref-output/nlo_eett.ref \
     ext_tests_nlo/ref-output/nlo_eetth.ref \
     ext_tests_nlo/ref-output/nlo_eetthh.ref \
     ext_tests_nlo/ref-output/nlo_eetthj.ref \
     ext_tests_nlo/ref-output/nlo_eetthz.ref \
     ext_tests_nlo/ref-output/nlo_eettwjj.ref \
     ext_tests_nlo/ref-output/nlo_eettww.ref \
     ext_tests_nlo/ref-output/nlo_eettz.ref \
     ext_tests_nlo/ref-output/nlo_eettzj.ref \
     ext_tests_nlo/ref-output/nlo_eettzjj.ref \
     ext_tests_nlo/ref-output/nlo_eettzz.ref \
     ext_tests_nlo/ref-output/nlo_ppzj_real_partition.ref \
     ext_tests_nlo/ref-output/nlo_pptttt.ref \
     ext_tests_nlo/ref-output/nlo_ppw.ref \
     ext_tests_nlo/ref-output/nlo_ppz.ref \
     ext_tests_nlo/ref-output/nlo_ppzj_sim_1.ref \
     ext_tests_nlo/ref-output/nlo_ppzj_sim_2.ref \
     ext_tests_nlo/ref-output/nlo_ppzj_sim_3.ref \
     ext_tests_nlo/ref-output/nlo_ppzj_sim_4.ref \
     ext_tests_nlo/ref-output/nlo_ppzw.ref \
     ext_tests_nlo/ref-output/nlo_ppzz.ref \
     ext_tests_nlo/ref-output/nlo_ppee_ew.ref \
     ext_tests_nlo/ref-output/nlo_pphee_ew.ref \
     ext_tests_nlo/ref-output/nlo_pphjj_ew.ref \
     ext_tests_nlo/ref-output/nlo_pphz_ew.ref \
     ext_tests_nlo/ref-output/nlo_ppllll_ew.ref \
     ext_tests_nlo/ref-output/nlo_ppllnn_ew.ref \
     ext_tests_nlo/ref-output/nlo_pptt_ew.ref \
     ext_tests_nlo/ref-output/nlo_pptj_ew.ref \
     ext_tests_nlo/ref-output/nlo_ppwhh_ew.ref \
     ext_tests_nlo/ref-output/nlo_ppww_ew.ref \
     ext_tests_nlo/ref-output/nlo_ppwzh_ew.ref \
     ext_tests_nlo/ref-output/nlo_ppz_ew.ref \
     ext_tests_nlo/ref-output/nlo_ppzzz_ew.ref
 
 # Reference files that depend on the numerical precision
 REF_OUTPUT_FILES_DOUBLE = \
     functional_tests/ref-output-double/beam_events_2.ref \
     functional_tests/ref-output-double/beam_events_3.ref \
     functional_tests/ref-output-double/beam_setup_5.ref \
     functional_tests/ref-output-double/circe1_4.ref \
     functional_tests/ref-output-double/circe1_5.ref \
     functional_tests/ref-output-double/circe1_7.ref \
     functional_tests/ref-output-double/circe1_8.ref \
     functional_tests/ref-output-double/circe1_9.ref \
     functional_tests/ref-output-double/circe1_photons_1.ref \
     functional_tests/ref-output-double/circe1_photons_2.ref \
     functional_tests/ref-output-double/circe1_photons_3.ref \
     functional_tests/ref-output-double/circe1_photons_4.ref \
     functional_tests/ref-output-double/circe1_photons_5.ref \
     functional_tests/ref-output-double/colors_2.ref \
     functional_tests/ref-output-double/defaultcuts.ref \
     functional_tests/ref-output-double/ep_1.ref \
     functional_tests/ref-output-double/ep_2.ref \
     functional_tests/ref-output-double/ewa_1.ref \
     functional_tests/ref-output-double/ewa_2.ref \
     functional_tests/ref-output-double/ewa_3.ref \
     functional_tests/ref-output-double/fks_res_1.ref \
     functional_tests/ref-output-double/fks_res_3.ref \
     functional_tests/ref-output-double/helicity.ref \
     functional_tests/ref-output-double/hepmc_8.ref \
     functional_tests/ref-output-double/ilc.ref \
     functional_tests/ref-output-double/isr_2.ref \
     functional_tests/ref-output-double/isr_3.ref \
     functional_tests/ref-output-double/isr_4.ref \
     functional_tests/ref-output-double/isr_5.ref \
     functional_tests/ref-output-double/isr_6.ref \
     functional_tests/ref-output-double/lcio_2.ref \
     functional_tests/ref-output-double/lcio_7.ref \
     functional_tests/ref-output-double/lcio_12.ref \
     functional_tests/ref-output-double/lhapdf5.ref \
     functional_tests/ref-output-double/lhapdf6.ref \
     functional_tests/ref-output-double/lhef_7.ref \
     functional_tests/ref-output-double/mlm_matching_isr.ref \
     functional_tests/ref-output-double/multi_comp_1.ref \
     functional_tests/ref-output-double/multi_comp_2.ref \
     functional_tests/ref-output-double/multi_comp_3.ref \
     functional_tests/ref-output-double/testproc_12.ref \
     functional_tests/ref-output-double/nlo_3.ref \
     functional_tests/ref-output-double/nlo_4.ref \
     functional_tests/ref-output-double/nlo_5.ref \
     functional_tests/ref-output-double/nlo_7.ref \
     functional_tests/ref-output-double/nlo_8.ref \
     functional_tests/ref-output-double/nlo_9.ref \
     functional_tests/ref-output-double/nlo_10.ref \
     functional_tests/ref-output-double/observables_2.ref \
     functional_tests/ref-output-double/openloops_3.ref \
     functional_tests/ref-output-double/openloops_12.ref \
     functional_tests/ref-output-double/openloops_13.ref \
     functional_tests/ref-output-double/openloops_14.ref \
     functional_tests/ref-output-double/parton_shower_2.ref \
     functional_tests/ref-output-double/pdf_builtin.ref \
     functional_tests/ref-output-double/powheg_1.ref \
     functional_tests/ref-output-double/powheg_2.ref \
     functional_tests/ref-output-double/pythia6_3.ref \
     functional_tests/ref-output-double/pythia6_4.ref \
     functional_tests/ref-output-double/qcdtest_1.ref \
     functional_tests/ref-output-double/qcdtest_2.ref \
     functional_tests/ref-output-double/qcdtest_3.ref \
     functional_tests/ref-output-double/qedtest_3.ref \
     functional_tests/ref-output-double/qedtest_4.ref \
     functional_tests/ref-output-double/resonances_1.ref \
     functional_tests/ref-output-double/resonances_2.ref \
     functional_tests/ref-output-double/resonances_3.ref \
     functional_tests/ref-output-double/resonances_4.ref \
     functional_tests/ref-output-double/resonances_10.ref \
     functional_tests/ref-output-double/resonances_11.ref \
     functional_tests/ref-output-double/resonances_13.ref \
     functional_tests/ref-output-double/resonances_14.ref \
     functional_tests/ref-output-double/resonances_15.ref \
     functional_tests/ref-output-double/smtest_2.ref \
     functional_tests/ref-output-double/smtest_8.ref \
     functional_tests/ref-output-double/tauola_1.ref \
     functional_tests/ref-output-double/tauola_2.ref \
     functional_tests/ref-output-double/tauola_3.ref
 
 REF_OUTPUT_FILES_PREC = \
     functional_tests/ref-output-prec/beam_setup_5.ref \
     functional_tests/ref-output-prec/circe1_9.ref \
     functional_tests/ref-output-prec/circe1_photons_1.ref \
     functional_tests/ref-output-prec/circe1_photons_2.ref \
     functional_tests/ref-output-prec/circe1_photons_3.ref \
     functional_tests/ref-output-prec/circe1_photons_4.ref \
     functional_tests/ref-output-prec/circe1_photons_5.ref \
     functional_tests/ref-output-prec/colors_2.ref \
     functional_tests/ref-output-prec/defaultcuts.ref \
     functional_tests/ref-output-prec/ep_1.ref \
     functional_tests/ref-output-prec/ep_2.ref \
     functional_tests/ref-output-prec/ewa_1.ref \
     functional_tests/ref-output-prec/fks_res_1.ref \
     functional_tests/ref-output-prec/fks_res_3.ref \
     functional_tests/ref-output-prec/helicity.ref \
     functional_tests/ref-output-prec/ilc.ref \
     functional_tests/ref-output-prec/lhapdf5.ref \
     functional_tests/ref-output-prec/lhapdf6.ref \
     functional_tests/ref-output-prec/lhef_7.ref \
     functional_tests/ref-output-prec/multi_comp_1.ref \
     functional_tests/ref-output-prec/multi_comp_2.ref \
     functional_tests/ref-output-prec/multi_comp_3.ref \
     functional_tests/ref-output-prec/testproc_12.ref \
     functional_tests/ref-output-prec/nlo_3.ref \
     functional_tests/ref-output-prec/nlo_4.ref \
     functional_tests/ref-output-prec/parton_shower_2.ref \
     functional_tests/ref-output-prec/pdf_builtin.ref \
     functional_tests/ref-output-prec/qcdtest_1.ref \
     functional_tests/ref-output-prec/qcdtest_2.ref \
     functional_tests/ref-output-prec/qcdtest_3.ref \
     functional_tests/ref-output-prec/qedtest_3.ref \
     functional_tests/ref-output-prec/qedtest_4.ref \
     functional_tests/ref-output-prec/smtest_2.ref \
     functional_tests/ref-output-prec/smtest_8.ref
 
 REF_OUTPUT_FILES_EXT = \
     functional_tests/ref-output-ext/beam_events_2.ref \
     functional_tests/ref-output-ext/beam_events_3.ref \
     functional_tests/ref-output-ext/circe1_4.ref \
     functional_tests/ref-output-ext/circe1_5.ref \
     functional_tests/ref-output-ext/circe1_7.ref \
     functional_tests/ref-output-ext/circe1_8.ref \
     functional_tests/ref-output-ext/ewa_2.ref \
     functional_tests/ref-output-ext/ewa_3.ref \
     functional_tests/ref-output-ext/hepmc_8.ref \
     functional_tests/ref-output-ext/isr_2.ref \
     functional_tests/ref-output-ext/isr_3.ref \
     functional_tests/ref-output-ext/isr_4.ref \
     functional_tests/ref-output-ext/isr_5.ref \
     functional_tests/ref-output-ext/isr_6.ref \
     functional_tests/ref-output-ext/lcio_2.ref \
     functional_tests/ref-output-ext/lcio_7.ref \
     functional_tests/ref-output-ext/lcio_12.ref \
     functional_tests/ref-output-ext/mlm_matching_isr.ref \
     functional_tests/ref-output-ext/nlo_5.ref \
     functional_tests/ref-output-ext/nlo_7.ref \
     functional_tests/ref-output-ext/nlo_8.ref \
     functional_tests/ref-output-ext/nlo_9.ref \
     functional_tests/ref-output-ext/nlo_10.ref \
     functional_tests/ref-output-ext/observables_2.ref \
     functional_tests/ref-output-ext/openloops_3.ref \
     functional_tests/ref-output-ext/openloops_12.ref \
     functional_tests/ref-output-ext/openloops_13.ref \
     functional_tests/ref-output-ext/openloops_14.ref \
     functional_tests/ref-output-ext/powheg_1.ref \
     functional_tests/ref-output-ext/powheg_2.ref \
     functional_tests/ref-output-ext/pythia6_3.ref \
     functional_tests/ref-output-ext/pythia6_4.ref \
     functional_tests/ref-output-ext/resonances_1.ref \
     functional_tests/ref-output-ext/resonances_2.ref \
     functional_tests/ref-output-ext/resonances_3.ref \
     functional_tests/ref-output-ext/resonances_4.ref \
     functional_tests/ref-output-ext/resonances_10.ref \
     functional_tests/ref-output-ext/resonances_11.ref \
     functional_tests/ref-output-ext/resonances_13.ref \
     functional_tests/ref-output-ext/resonances_14.ref \
     functional_tests/ref-output-ext/resonances_15.ref \
     functional_tests/ref-output-ext/tauola_1.ref \
     functional_tests/ref-output-ext/tauola_2.ref \
     functional_tests/ref-output-ext/tauola_3.ref
 
 REF_OUTPUT_FILES_QUAD = \
     functional_tests/ref-output-quad/beam_events_2.ref \
     functional_tests/ref-output-quad/beam_events_3.ref \
     functional_tests/ref-output-quad/circe1_4.ref \
     functional_tests/ref-output-quad/circe1_5.ref \
     functional_tests/ref-output-quad/circe1_7.ref \
     functional_tests/ref-output-quad/circe1_8.ref \
     functional_tests/ref-output-quad/ewa_2.ref \
     functional_tests/ref-output-quad/ewa_3.ref \
     functional_tests/ref-output-quad/hepmc_8.ref \
     functional_tests/ref-output-quad/isr_2.ref \
     functional_tests/ref-output-quad/isr_3.ref \
     functional_tests/ref-output-quad/isr_4.ref \
     functional_tests/ref-output-quad/isr_5.ref \
     functional_tests/ref-output-quad/isr_6.ref \
     functional_tests/ref-output-quad/lcio_2.ref \
     functional_tests/ref-output-quad/lcio_7.ref \
     functional_tests/ref-output-quad/lcio_12.ref \
     functional_tests/ref-output-quad/mlm_matching_isr.ref \
     functional_tests/ref-output-quad/nlo_5.ref \
     functional_tests/ref-output-quad/nlo_7.ref \
     functional_tests/ref-output-quad/nlo_8.ref \
     functional_tests/ref-output-quad/nlo_9.ref \
     functional_tests/ref-output-quad/nlo_10.ref \
     functional_tests/ref-output-quad/observables_2.ref \
     functional_tests/ref-output-quad/openloops_3.ref \
     functional_tests/ref-output-quad/openloops_12.ref \
     functional_tests/ref-output-quad/openloops_13.ref \
     functional_tests/ref-output-quad/openloops_14.ref \
     functional_tests/ref-output-quad/powheg_1.ref \
     functional_tests/ref-output-quad/powheg_2.ref \
     functional_tests/ref-output-quad/pythia6_3.ref \
     functional_tests/ref-output-quad/pythia6_4.ref \
     functional_tests/ref-output-quad/resonances_1.ref \
     functional_tests/ref-output-quad/resonances_2.ref \
     functional_tests/ref-output-quad/resonances_3.ref \
     functional_tests/ref-output-quad/resonances_4.ref \
     functional_tests/ref-output-quad/resonances_10.ref \
     functional_tests/ref-output-quad/resonances_11.ref \
     functional_tests/ref-output-quad/resonances_13.ref \
     functional_tests/ref-output-quad/resonances_14.ref \
     functional_tests/ref-output-quad/resonances_15.ref \
     functional_tests/ref-output-quad/tauola_1.ref \
     functional_tests/ref-output-quad/tauola_2.ref \
     functional_tests/ref-output-quad/tauola_3.ref
 
 TESTSUITES_M4 = \
     $(MISC_TESTS_M4) \
     $(EXT_MSSM_M4) \
     $(EXT_NMSSM_M4)
 
 TESTSUITES_SIN = \
     $(MISC_TESTS_SIN) \
     $(EXT_ILC_SIN) \
     $(EXT_MSSM_SIN) \
     $(EXT_NMSSM_SIN) \
     $(EXT_SHOWER_SIN) \
     $(EXT_NLO_SIN) \
     $(EXT_NLO_ADD_SIN)
 
 
 MISC_TESTS_M4 =
 
 MISC_TESTS_SIN = \
     functional_tests/alphas.sin \
     functional_tests/analyze_1.sin \
     functional_tests/analyze_2.sin \
     functional_tests/analyze_3.sin \
     functional_tests/analyze_4.sin \
     functional_tests/analyze_5.sin \
     functional_tests/analyze_6.sin \
     functional_tests/beam_events_1.sin \
     functional_tests/beam_events_2.sin \
     functional_tests/beam_events_3.sin \
     functional_tests/beam_events_4.sin \
     functional_tests/beam_setup_1.sin \
     functional_tests/beam_setup_2.sin \
     functional_tests/beam_setup_3.sin \
     functional_tests/beam_setup_4.sin \
     functional_tests/beam_setup_5.sin \
     functional_tests/bjet_cluster.sin \
     functional_tests/br_redef_1.sin \
     functional_tests/cascades2_phs_1.sin \
     functional_tests/cascades2_phs_2.sin \
     functional_tests/circe1_1.sin \
     functional_tests/circe1_2.sin \
     functional_tests/circe1_3.sin \
     functional_tests/circe1_4.sin \
     functional_tests/circe1_5.sin \
     functional_tests/circe1_6.sin \
     functional_tests/circe1_7.sin \
     functional_tests/circe1_8.sin \
     functional_tests/circe1_9.sin \
     functional_tests/circe1_10.sin \
     functional_tests/circe1_errors_1.sin \
     functional_tests/circe1_photons_1.sin \
     functional_tests/circe1_photons_2.sin \
     functional_tests/circe1_photons_3.sin \
     functional_tests/circe1_photons_4.sin \
     functional_tests/circe1_photons_5.sin \
     functional_tests/circe2_1.sin \
     functional_tests/circe2_2.sin \
     functional_tests/circe2_3.sin \
     functional_tests/cmdline_1.sin \
     functional_tests/cmdline_1_a.sin \
     functional_tests/cmdline_1_b.sin \
     functional_tests/colors.sin \
     functional_tests/colors_2.sin \
     functional_tests/colors_hgg.sin \
     functional_tests/cuts.sin \
     functional_tests/decay_err_1.sin \
     functional_tests/decay_err_2.sin \
     functional_tests/decay_err_3.sin \
     functional_tests/defaultcuts.sin \
     functional_tests/empty.sin \
     functional_tests/energy_scan_1.sin \
     functional_tests/ep_1.sin \
     functional_tests/ep_2.sin \
     functional_tests/ep_3.sin \
     functional_tests/epa_1.sin \
     functional_tests/epa_2.sin \
     functional_tests/epa_3.sin \
     functional_tests/epa_4.sin \
     functional_tests/event_dump_1.sin \
     functional_tests/event_dump_2.sin \
     functional_tests/event_eff_1.sin \
     functional_tests/event_eff_2.sin \
     functional_tests/event_failed_1.sin \
     functional_tests/event_weights_1.sin \
     functional_tests/event_weights_2.sin \
     functional_tests/ewa_1.sin \
     functional_tests/ewa_2.sin \
     functional_tests/ewa_3.sin \
     functional_tests/ewa_4.sin \
     functional_tests/extpar.sin \
     functional_tests/fatal.sin \
     functional_tests/fatal_beam_decay.sin \
     functional_tests/fks_res_1.sin \
     functional_tests/fks_res_2.sin \
     functional_tests/fks_res_3.sin \
     functional_tests/flvsum_1.sin \
     functional_tests/gaussian_1.sin \
     functional_tests/gaussian_2.sin \
     functional_tests/hadronize_1.sin \
     functional_tests/helicity.sin \
     functional_tests/hepmc_1.sin \
     functional_tests/hepmc_2.sin \
     functional_tests/hepmc_3.sin \
     functional_tests/hepmc_4.sin \
     functional_tests/hepmc_5.sin \
     functional_tests/hepmc_6.sin \
     functional_tests/hepmc_7.sin \
     functional_tests/hepmc_8.sin \
     functional_tests/hepmc_9.sin \
     functional_tests/hepmc_10.sin \
     functional_tests/ilc.sin \
     functional_tests/isr_1.sin \
     functional_tests/isr_2.sin \
     functional_tests/isr_3.sin \
     functional_tests/isr_4.sin \
     functional_tests/isr_5.sin \
     functional_tests/isr_6.sin \
     functional_tests/isr_epa_1.sin \
     functional_tests/jets_xsec.sin \
     functional_tests/job_id_1.sin \
     functional_tests/job_id_2.sin \
     functional_tests/job_id_3.sin \
     functional_tests/job_id_4.sin \
     functional_tests/lcio_1.sin \
     functional_tests/lcio_2.sin \
     functional_tests/lcio_3.sin \
     functional_tests/lcio_4.sin \
     functional_tests/lcio_5.sin \
     functional_tests/lcio_6.sin \
     functional_tests/lcio_7.sin \
     functional_tests/lcio_8.sin \
     functional_tests/lcio_9.sin \
     functional_tests/lcio_10.sin \
     functional_tests/lcio_11.sin \
     functional_tests/lcio_12.sin \
     functional_tests/lhapdf5.sin \
     functional_tests/lhapdf6.sin \
     functional_tests/lhef_1.sin \
     functional_tests/lhef_2.sin \
     functional_tests/lhef_3.sin \
     functional_tests/lhef_4.sin \
     functional_tests/lhef_5.sin \
     functional_tests/lhef_6.sin \
     functional_tests/lhef_7.sin \
     functional_tests/lhef_8.sin \
     functional_tests/lhef_9.sin \
     functional_tests/lhef_10.sin \
     functional_tests/lhef_11.sin \
     functional_tests/libraries_1.sin \
     functional_tests/libraries_2.sin \
     functional_tests/libraries_3.sin \
     functional_tests/libraries_4.sin \
     functional_tests/method_ovm_1.sin \
     functional_tests/mlm_matching_fsr.sin \
     functional_tests/mlm_matching_isr.sin \
     functional_tests/mlm_pythia6_isr.sin \
     functional_tests/model_change_1.sin \
     functional_tests/model_change_2.sin \
     functional_tests/model_change_3.sin \
     functional_tests/model_scheme_1.sin \
     functional_tests/model_test.sin \
     functional_tests/mssmtest_1.sin \
     functional_tests/mssmtest_2.sin \
     functional_tests/mssmtest_3.sin \
     functional_tests/multi_comp_1.sin \
     functional_tests/multi_comp_2.sin \
     functional_tests/multi_comp_3.sin \
     functional_tests/multi_comp_4.sin \
     functional_tests/nlo_1.sin \
     functional_tests/nlo_2.sin \
     functional_tests/nlo_3.sin \
     functional_tests/nlo_4.sin \
     functional_tests/nlo_5.sin \
     functional_tests/nlo_6.sin \
     functional_tests/nlo_7.sin \
     functional_tests/nlo_8.sin \
     functional_tests/nlo_9.sin \
     functional_tests/nlo_10.sin \
     functional_tests/nlo_decay_1.sin \
     functional_tests/observables_1.sin \
     functional_tests/observables_2.sin \
     functional_tests/openloops_1.sin \
     functional_tests/openloops_2.sin \
     functional_tests/openloops_3.sin \
     functional_tests/openloops_4.sin \
     functional_tests/openloops_5.sin \
     functional_tests/openloops_6.sin \
     functional_tests/openloops_7.sin \
     functional_tests/openloops_8.sin \
     functional_tests/openloops_9.sin \
     functional_tests/openloops_10.sin \
     functional_tests/openloops_11.sin \
     functional_tests/openloops_12.sin \
     functional_tests/openloops_13.sin \
     functional_tests/openloops_14.sin \
     functional_tests/pack_1.sin \
     functional_tests/parton_shower_1.sin \
     functional_tests/parton_shower_2.sin \
     functional_tests/pdf_builtin.sin \
     functional_tests/photon_isolation_1.sin \
     functional_tests/photon_isolation_2.sin \
     functional_tests/polarized_1.sin \
     functional_tests/powheg_1.sin \
     functional_tests/powheg_2.sin \
     functional_tests/process_log.sin \
     functional_tests/pythia6_1.sin \
     functional_tests/pythia6_2.sin \
     functional_tests/pythia6_3.sin \
     functional_tests/pythia6_4.sin \
     functional_tests/pythia8_1.sin \
     functional_tests/pythia8_2.sin \
     functional_tests/qcdtest_1.sin \
     functional_tests/qcdtest_2.sin \
     functional_tests/qcdtest_3.sin \
     functional_tests/qcdtest_4.sin \
     functional_tests/qcdtest_5.sin \
     functional_tests/qcdtest_6.sin \
     functional_tests/qedtest_1.sin \
     functional_tests/qedtest_2.sin \
     functional_tests/qedtest_3.sin \
     functional_tests/qedtest_4.sin \
     functional_tests/qedtest_5.sin \
     functional_tests/qedtest_6.sin \
     functional_tests/qedtest_7.sin \
     functional_tests/qedtest_8.sin \
     functional_tests/qedtest_9.sin \
     functional_tests/qedtest_10.sin \
     functional_tests/rambo_vamp_1.sin \
     functional_tests/rambo_vamp_2.sin \
     functional_tests/real_partition_1.sin \
     functional_tests/rebuild_1.sin \
     functional_tests/rebuild_2.sin \
     functional_tests/rebuild_3.sin \
     functional_tests/rebuild_4.sin \
     functional_tests/rebuild_5.sin \
     functional_tests/recola_1.sin \
     functional_tests/recola_2.sin \
     functional_tests/recola_3.sin \
     functional_tests/recola_4.sin \
     functional_tests/recola_5.sin \
     functional_tests/recola_6.sin \
     functional_tests/recola_7.sin \
     functional_tests/recola_8.sin \
     functional_tests/recola_9.sin \
     functional_tests/resonances_1.sin \
     functional_tests/resonances_2.sin \
     functional_tests/resonances_3.sin \
     functional_tests/resonances_4.sin \
     functional_tests/resonances_5.sin \
     functional_tests/resonances_6.sin \
     functional_tests/resonances_7.sin \
     functional_tests/resonances_8.sin \
     functional_tests/resonances_9.sin \
     functional_tests/resonances_10.sin \
     functional_tests/resonances_11.sin \
     functional_tests/resonances_12.sin \
     functional_tests/resonances_13.sin \
     functional_tests/resonances_14.sin \
     functional_tests/resonances_15.sin \
     functional_tests/restrictions.sin \
     functional_tests/reweight_1.sin \
     functional_tests/reweight_2.sin \
     functional_tests/reweight_3.sin \
     functional_tests/reweight_4.sin \
     functional_tests/reweight_5.sin \
     functional_tests/reweight_6.sin \
     functional_tests/reweight_7.sin \
     functional_tests/reweight_8.sin \
     functional_tests/reweight_9.sin \
     functional_tests/reweight_10.sin \
     functional_tests/select_1.sin \
     functional_tests/select_2.sin \
     functional_tests/show_1.sin \
     functional_tests/show_2.sin \
     functional_tests/show_3.sin \
     functional_tests/show_4.sin \
     functional_tests/show_5.sin \
     functional_tests/shower_err_1.sin \
     functional_tests/sm_cms_1.sin \
     functional_tests/smtest_1.sin \
     functional_tests/smtest_2.sin \
     functional_tests/smtest_3.sin \
     functional_tests/smtest_4.sin \
     functional_tests/smtest_5.sin \
     functional_tests/smtest_6.sin \
     functional_tests/smtest_7.sin \
     functional_tests/smtest_8.sin \
     functional_tests/smtest_9.sin \
     functional_tests/smtest_10.sin \
     functional_tests/smtest_11.sin \
     functional_tests/smtest_12.sin \
     functional_tests/smtest_13.sin \
     functional_tests/smtest_14.sin \
     functional_tests/smtest_15.sin \
     functional_tests/smtest_16.sin \
     functional_tests/smtest_17.sin \
     functional_tests/spincor_1.sin \
     functional_tests/static_1.exe.sin \
     functional_tests/static_1.sin \
     functional_tests/static_2.exe.sin \
     functional_tests/static_2.sin \
     functional_tests/stdhep_1.sin \
     functional_tests/stdhep_2.sin \
     functional_tests/stdhep_3.sin \
     functional_tests/stdhep_4.sin \
     functional_tests/stdhep_5.sin \
     functional_tests/stdhep_6.sin \
     functional_tests/structure_1.sin \
     functional_tests/structure_2.sin \
     functional_tests/structure_3.sin \
     functional_tests/structure_4.sin \
     functional_tests/structure_5.sin \
     functional_tests/structure_6.sin \
     functional_tests/structure_7.sin \
     functional_tests/structure_8.sin \
     functional_tests/susyhit.sin \
     functional_tests/tauola_1.sin \
     functional_tests/tauola_2.sin \
     functional_tests/tauola_3.sin \
     functional_tests/template_me_1.sin \
     functional_tests/template_me_2.sin \
     functional_tests/testproc_1.sin \
     functional_tests/testproc_2.sin \
     functional_tests/testproc_3.sin \
     functional_tests/testproc_4.sin \
     functional_tests/testproc_5.sin \
     functional_tests/testproc_6.sin \
     functional_tests/testproc_7.sin \
     functional_tests/testproc_8.sin \
     functional_tests/testproc_9.sin \
     functional_tests/testproc_10.sin \
     functional_tests/testproc_11.sin \
     functional_tests/testproc_12.sin \
     functional_tests/ufo_1.sin \
     functional_tests/ufo_2.sin \
     functional_tests/ufo_3.sin \
     functional_tests/ufo_4.sin \
     functional_tests/ufo_5.sin \
     functional_tests/ufo_6.sin \
     functional_tests/user_prc_threshold_1.sin \
     functional_tests/user_prc_threshold_2.sin \
     functional_tests/vamp2_1.sin \
     functional_tests/vamp2_2.sin \
     functional_tests/vamp2_3.sin \
     functional_tests/vars.sin
 
 EXT_MSSM_M4 = \
     ext_tests_mssm/mssm_ext-aa.m4 \
     ext_tests_mssm/mssm_ext-bb.m4 \
     ext_tests_mssm/mssm_ext-bt.m4 \
     ext_tests_mssm/mssm_ext-dd.m4 \
     ext_tests_mssm/mssm_ext-dd2.m4 \
     ext_tests_mssm/mssm_ext-ddckm.m4 \
     ext_tests_mssm/mssm_ext-dg.m4 \
     ext_tests_mssm/mssm_ext-ee.m4 \
     ext_tests_mssm/mssm_ext-ee2.m4 \
     ext_tests_mssm/mssm_ext-en.m4 \
     ext_tests_mssm/mssm_ext-ga.m4 \
     ext_tests_mssm/mssm_ext-gg.m4 \
     ext_tests_mssm/mssm_ext-gw.m4 \
     ext_tests_mssm/mssm_ext-gz.m4 \
     ext_tests_mssm/mssm_ext-tn.m4 \
     ext_tests_mssm/mssm_ext-tt.m4 \
     ext_tests_mssm/mssm_ext-ug.m4 \
     ext_tests_mssm/mssm_ext-uu.m4 \
     ext_tests_mssm/mssm_ext-uu2.m4 \
     ext_tests_mssm/mssm_ext-uuckm.m4 \
     ext_tests_mssm/mssm_ext-wa.m4 \
     ext_tests_mssm/mssm_ext-ww.m4 \
     ext_tests_mssm/mssm_ext-wz.m4 \
     ext_tests_mssm/mssm_ext-za.m4 \
     ext_tests_mssm/mssm_ext-zz.m4
 
 EXT_NMSSM_M4 = \
     ext_tests_nmssm/nmssm_ext-aa.m4  \
     ext_tests_nmssm/nmssm_ext-bb1.m4 \
     ext_tests_nmssm/nmssm_ext-bb2.m4 \
     ext_tests_nmssm/nmssm_ext-bt.m4  \
     ext_tests_nmssm/nmssm_ext-dd1.m4 \
     ext_tests_nmssm/nmssm_ext-dd2.m4 \
     ext_tests_nmssm/nmssm_ext-ee1.m4 \
     ext_tests_nmssm/nmssm_ext-ee2.m4 \
     ext_tests_nmssm/nmssm_ext-en.m4  \
     ext_tests_nmssm/nmssm_ext-ga.m4  \
     ext_tests_nmssm/nmssm_ext-gg.m4  \
     ext_tests_nmssm/nmssm_ext-gw.m4  \
     ext_tests_nmssm/nmssm_ext-gz.m4  \
     ext_tests_nmssm/nmssm_ext-qg.m4  \
     ext_tests_nmssm/nmssm_ext-tn.m4  \
     ext_tests_nmssm/nmssm_ext-tt1.m4 \
     ext_tests_nmssm/nmssm_ext-tt2.m4 \
     ext_tests_nmssm/nmssm_ext-uu1.m4 \
     ext_tests_nmssm/nmssm_ext-uu2.m4 \
     ext_tests_nmssm/nmssm_ext-wa.m4  \
     ext_tests_nmssm/nmssm_ext-ww1.m4 \
     ext_tests_nmssm/nmssm_ext-ww2.m4 \
     ext_tests_nmssm/nmssm_ext-wz.m4  \
     ext_tests_nmssm/nmssm_ext-za.m4  \
     ext_tests_nmssm/nmssm_ext-zz1.m4 \
     ext_tests_nmssm/nmssm_ext-zz2.m4
 
 EXT_MSSM_SIN = $(EXT_MSSM_M4:.m4=.sin)
 EXT_NMSSM_SIN = $(EXT_NMSSM_M4:.m4=.sin)
 
 EXT_ILC_SIN = \
     ext_tests_ilc/ilc_settings.sin \
     ext_tests_ilc/ilc_top_pair_360.sin \
     ext_tests_ilc/ilc_top_pair_500.sin \
     ext_tests_ilc/ilc_vbf_higgs_360.sin \
     ext_tests_ilc/ilc_vbf_higgs_500.sin \
     ext_tests_ilc/ilc_vbf_no_higgs_360.sin \
     ext_tests_ilc/ilc_vbf_no_higgs_500.sin \
     ext_tests_ilc/ilc_higgs_strahlung_360.sin \
     ext_tests_ilc/ilc_higgs_strahlung_500.sin \
     ext_tests_ilc/ilc_higgs_strahlung_background_360.sin \
     ext_tests_ilc/ilc_higgs_strahlung_background_500.sin \
     ext_tests_ilc/ilc_higgs_coupling_360.sin \
     ext_tests_ilc/ilc_higgs_coupling_500.sin \
     ext_tests_ilc/ilc_higgs_coupling_background_360.sin \
     ext_tests_ilc/ilc_higgs_coupling_background_500.sin
 
 EXT_SHOWER_SIN = \
     ext_tests_shower/shower_1_norad.sin \
     ext_tests_shower/shower_2_aall.sin \
     ext_tests_shower/shower_3_bb.sin \
     ext_tests_shower/shower_3_jj.sin \
     ext_tests_shower/shower_3_qqqq.sin \
     ext_tests_shower/shower_3_tt.sin \
     ext_tests_shower/shower_3_z_nu.sin \
     ext_tests_shower/shower_3_z_tau.sin \
     ext_tests_shower/shower_4_ee.sin \
     ext_tests_shower/shower_5.sin \
     ext_tests_shower/shower_6.sin
 
 EXT_NLO_SIN = \
     ext_tests_nlo/nlo_ee4b.sin \
     ext_tests_nlo/nlo_ee4j.sin \
     ext_tests_nlo/nlo_ee4t.sin \
     ext_tests_nlo/nlo_ee4tj.sin \
     ext_tests_nlo/nlo_ee5j.sin \
     ext_tests_nlo/nlo_eebb.sin \
     ext_tests_nlo/nlo_eebbj.sin \
     ext_tests_nlo/nlo_eebbjj.sin \
     ext_tests_nlo/nlo_eejj.sin \
     ext_tests_nlo/nlo_eejjj.sin \
     ext_tests_nlo/nlo_eett.sin \
     ext_tests_nlo/nlo_eetta.sin \
     ext_tests_nlo/nlo_eettaa.sin \
     ext_tests_nlo/nlo_eettah.sin \
     ext_tests_nlo/nlo_eettaj.sin \
     ext_tests_nlo/nlo_eettajj.sin \
     ext_tests_nlo/nlo_eettaz.sin \
     ext_tests_nlo/nlo_eettbb.sin \
     ext_tests_nlo/nlo_eetth.sin \
     ext_tests_nlo/nlo_eetthh.sin \
     ext_tests_nlo/nlo_eetthj.sin \
     ext_tests_nlo/nlo_eetthjj.sin \
     ext_tests_nlo/nlo_eetthz.sin \
     ext_tests_nlo/nlo_eettj.sin \
     ext_tests_nlo/nlo_eettjj.sin \
     ext_tests_nlo/nlo_eettjjj.sin \
     ext_tests_nlo/nlo_eettwjj.sin \
     ext_tests_nlo/nlo_eettww.sin \
     ext_tests_nlo/nlo_eettz.sin \
     ext_tests_nlo/nlo_eettzj.sin \
     ext_tests_nlo/nlo_eettzjj.sin \
     ext_tests_nlo/nlo_eettzz.sin \
     ext_tests_nlo/nlo_ppzj_real_partition.sin \
     ext_tests_nlo/nlo_pptttt.sin \
     ext_tests_nlo/nlo_ppw.sin \
     ext_tests_nlo/nlo_ppz.sin \
     ext_tests_nlo/nlo_ppzj_sim_1.sin \
     ext_tests_nlo/nlo_ppzj_sim_2.sin \
     ext_tests_nlo/nlo_ppzj_sim_3.sin \
     ext_tests_nlo/nlo_ppzj_sim_4.sin \
     ext_tests_nlo/nlo_ppzw.sin \
     ext_tests_nlo/nlo_ppzz.sin \
     ext_tests_nlo/nlo_ppee_ew.sin \
     ext_tests_nlo/nlo_pphee_ew.sin \
     ext_tests_nlo/nlo_pphjj_ew.sin \
     ext_tests_nlo/nlo_pphz_ew.sin \
     ext_tests_nlo/nlo_ppllll_ew.sin \
     ext_tests_nlo/nlo_ppllnn_ew.sin \
     ext_tests_nlo/nlo_pptj_ew.sin \
     ext_tests_nlo/nlo_ppwhh_ew.sin \
     ext_tests_nlo/nlo_ppww_ew.sin \
     ext_tests_nlo/nlo_ppwzh_ew.sin \
     ext_tests_nlo/nlo_ppz_ew.sin \
     ext_tests_nlo/nlo_ppzzz_ew.sin \
     ext_tests_nlo/nlo_ppeej_ew.sin \
     ext_tests_nlo/nlo_ppevj_ew.sin \
     ext_tests_nlo/nlo_pptt_ew.sin \
     ext_tests_nlo/nlo_settings.sin \
     ext_tests_nlo/nlo_settings_ew.sin
 
 EXT_NLO_ADD_SIN = \
     ext_tests_nlo_add/nlo_decay_tbw.sin \
     ext_tests_nlo_add/nlo_fks_delta_i_ppee.sin \
     ext_tests_nlo_add/nlo_fks_delta_o_eejj.sin \
     ext_tests_nlo_add/nlo_jets.sin \
     ext_tests_nlo_add/nlo_methods_gosam.sin \
     ext_tests_nlo_add/nlo_qq_powheg.sin \
     ext_tests_nlo_add/nlo_threshold_factorized.sin \
     ext_tests_nlo_add/nlo_threshold.sin \
     ext_tests_nlo_add/nlo_tt_powheg_sudakov.sin \
     ext_tests_nlo_add/nlo_tt_powheg.sin \
     ext_tests_nlo_add/nlo_tt.sin \
     ext_tests_nlo_add/nlo_uu_powheg.sin \
     ext_tests_nlo_add/nlo_uu.sin
 
 all-local: $(TESTSUITES_SIN)
 
 if M4_AVAILABLE
 SUFFIXES = .m4 .sin
 .m4.sin:
 	case "$@" in \
 	*/*) \
 		mkdir -p `sed 's,/.[^/]*$$,,g' <<< "$@"` ;; \
 	esac
 	$(M4) $(srcdir)/$(TESTSUITE_MACROS) $< > $@
 endif M4_AVAILABLE
Index: trunk/share/debug/Makefile_full
===================================================================
--- trunk/share/debug/Makefile_full	(revision 8834)
+++ trunk/share/debug/Makefile_full	(revision 8835)
@@ -1,713 +1,715 @@
 FC=pgfortran_2019
 FCFLAGS=-Mbackslash
 CC=gcc
 CCFLAGS=
 
 MODELS = \
 	SM.mdl \
 	SM_hadrons.mdl \
 	Test.mdl
 
 CC_SRC = \
 	sprintf_interface.c \
 	signal_interface.c
 
 F77_SRC = \
 	pythia.F \
 	pythia_pdf.f \
 	pythia6_up.f \
 	toppik.f \
 	toppik_axial.f
 
 FC0_SRC = 
 
 FC_SRC = \
 	format_defs.f90 \
 	io_units.f90 \
 	kinds.f90 \
 	constants.f90 \
 	iso_varying_string.f90 \
 	unit_tests.f90 \
 	unit_tests_sub.f90 \
 	numeric_utils.f90 \
 	numeric_utils_sub.f90 \
 	system_dependencies.f90 \
 	string_utils.f90 \
 	string_utils_sub.f90 \
 	system_defs.f90 \
 	system_defs_sub.f90 \	
 	debug_master.f90 \
 	diagnostics.f90 \
 	diagnostics_sub.f90 \
 	sorting.f90 \
 	physics_defs.f90 \
 	physics_defs_sub.f90 \
 	pdg_arrays.f90 \
 	bytes.f90 \
 	hashes.f90 \
 	md5.f90 \
 	model_data.f90 \
 	model_data_sub.f90 \
 	auto_components.f90 \
 	auto_components_sub.f90 \
 	var_base.f90 \
 	model_testbed.f90 \
 	auto_components_uti.f90 \
 	auto_components_ut.f90 \
 	os_interface.f90 \
 	os_interface_sub.f90 \
 	c_particles.f90 \
 	c_particles_sub.f90 \
 	format_utils.f90 \
 	lorentz.f90 \
 	lorentz_sub.f90 \
+	lorentz_uti.f90 \
+	lorentz_ut.f90 \
 	phs_points.f90 \
 	phs_points_sub.f90 \
 	colors.f90 \
 	colors_sub.f90 \
 	flavors.f90 \
 	flavors_sub.f90 \
 	helicities.f90 \
 	helicities_sub.f90 \
 	quantum_numbers.f90 \
 	quantum_numbers_sub.f90 \
 	state_matrices.f90 \
 	state_matrices_sub.f90 \
 	interactions.f90 \
 	interactions_sub.f90 \
 	CppStringsWrap_dummy.f90 \
 	FastjetWrap_dummy.f90 \
 	cpp_strings.f90 \
 	cpp_strings_sub.f90 \
 	fastjet.f90 \
 	fastjet_sub.f90 \
 	jets.f90 \
 	subevents.f90 \
 	su_algebra.f90 \
 	su_algebra_sub.f90 \
 	bloch_vectors.f90 \
 	bloch_vectors_sub.f90 \
 	polarizations.f90 \
 	polarizations_sub.f90 \
 	particles.f90 \
 	particles_sub.f90 \
 	event_base.f90 \
 	event_base_sub.f90 \
 	eio_data.f90 \
 	eio_data_sub.f90 \
 	event_handles.f90 \
 	eio_base.f90 \
 	eio_base_sub.f90 \
 	eio_base_uti.f90 \
 	eio_base_ut.f90 \
 	variables.f90 \
 	variables_sub.f90 \
 	rng_base.f90 \
 	rng_base_sub.f90 \
 	tao_random_numbers.f90 \
 	rng_tao.f90 \
 	rng_tao_sub.f90 \
 	rng_stream.f90 \
 	rng_stream_sub.f90 \
 	rng_base_uti.f90 \
 	rng_base_ut.f90 \
 	dispatch_rng.f90 \
 	dispatch_rng_sub.f90 \
 	dispatch_rng_uti.f90 \
 	dispatch_rng_ut.f90 \
 	beam_structures.f90 \
 	beam_structures_sub.f90 \
 	evaluators.f90 \
 	evaluators_sub.f90 \
 	beams.f90 \
 	beams_sub.f90 \
 	sm_physics.f90 \
 	sm_physics_sub.f90 \
 	file_registries.f90 \
 	file_registries_sub.f90 \
 	sf_aux.f90 \
 	sf_aux_sub.f90 \
 	sf_mappings.f90 \
 	sf_mappings_sub.f90 \
 	sf_base.f90 \
 	sf_base_sub.f90 \
 	electron_pdfs.f90 \
 	electron_pdfs_sub.f90 \
 	sf_isr.f90 \
 	sf_isr_sub.f90 \
 	sf_epa.f90 \
 	sf_epa_sub.f90 \
 	sf_ewa.f90 \
 	sf_ewa_sub.f90 \
 	sf_escan.f90 \
 	sf_escan_sub.f90 \
 	sf_gaussian.f90 \
 	sf_gaussian_sub.f90 \
 	sf_beam_events.f90 \
 	sf_beam_events_sub.f90 \
 	circe1.f90 \
 	sf_circe1.f90 \
 	sf_circe1_sub.f90 \
 	circe2.f90 \
 	selectors.f90 \
 	selectors_sub.f90 \
 	sf_circe2.f90 \
 	sf_circe2_sub.f90 \
 	sm_qcd.f90 \
 	sm_qcd_sub.f90 \
 	sm_qed.f90 \
 	sm_qed_sub.f90 \
 	mrst2004qed.f90 \
 	cteq6pdf.f90 \
 	mstwpdf.f90 \
 	ct10pdf.f90 \
 	CJpdf.f90 \
 	ct14pdf.f90 \
 	pdf_builtin.f90 \
 	pdf_builtin_sub.f90 \
 	LHAPDFWrap_dummy.f90 \
 	lhapdf5_full_dummy.f90 \
 	lhapdf5_has_photon_dummy.f90 \
 	lhapdf.f90 \
 	hoppet_dummy.f90 \
 	hoppet_interface.f90 \
 	sf_pdf_builtin.f90 \
 	sf_pdf_builtin_sub.f90 \
 	sf_lhapdf.f90 \
 	sf_lhapdf_sub.f90 \
 	dispatch_beams.f90 \
 	dispatch_beams_sub.f90 \
 	process_constants.f90 \
 	process_constants_sub.f90 \
 	prclib_interfaces.f90 \
 	prc_core_def.f90 \
 	prc_core_def_sub.f90 \
 	particle_specifiers.f90 \
 	particle_specifiers_sub.f90 \
 	process_libraries.f90 \
 	process_libraries_sub.f90 \
 	prc_test.f90 \
 	prc_test_sub.f90 \
 	prc_core.f90 \
 	prc_core_sub.f90 \
 	prc_test_core.f90 \
 	prc_test_core_sub.f90 \
 	sm_qed.f90 \
 	sm_qed_sub.f90 \
 	prc_omega.f90 \
 	prc_omega_sub.f90 \
 	phs_base.f90 \
 	phs_base_sub.f90 \
 	ifiles.f90 \
 	lexers.f90 \
 	syntax_rules.f90 \
 	parser.f90 \
 	expr_base.f90 \
 	formats.f90 \
 	formats_sub.f90 \
 	analysis.f90 \
 	user_code_interface.f90 \
 	observables.f90 \
 	observables_sub.f90 \
 	eval_trees.f90 \
 	eval_trees_sub.f90 \
 	interpolation.f90 \
 	interpolation_sub.f90 \
 	nr_tools.f90 \
 	ttv_formfactors.f90 \
 	ttv_formfactors_use.f90 \
 	ttv_formfactors_uti.f90 \
 	ttv_formfactors_ut.f90 \
 	models.f90 \
 	prclib_stacks.f90 \
 	prclib_stacks_sub.f90 \
 	user_files.f90 \
 	user_files_sub.f90 \
 	cputime.f90 \
 	cputime_sub.f90 \
 	mci_base.f90 \
 	mci_base_sub.f90 \
 	integration_results.f90 \
 	integration_results_sub.f90 \
 	integration_results_uti.f90 \
 	integration_results_ut.f90 \
 	mappings.f90 \
 	mappings_sub.f90 \
 	permutations.f90 \
 	permutations_sub.f90 \
 	resonances.f90 \
 	resonances_sub.f90 \
 	phs_trees.f90 \
 	phs_trees_sub.f90 \
 	phs_forests.f90 \
 	phs_forests_sub.f90 \
 	prc_external.f90 \
 	blha_config.f90 \
 	blha_config_sub.f90 \
 	blha_olp_interfaces.f90 \
 	blha_olp_interfaces_sub.f90 \
 	prc_openloops.f90 \
 	prc_openloops_sub.f90 \
 	prc_threshold.f90 \
 	prc_threshold_sub.f90 \
 	process_config.f90 \
 	process_config_sub.f90 \
 	process_counter.f90 \
 	process_counter_sub.f90 \
 	process_mci.f90 \
 	pcm_base.f90 \
 	pcm_base_sub.f90 \
 	nlo_data.f90 \
 	nlo_data_sub.f90 \
 	cascades.f90 \
 	cascades_sub.f90 \
 	cascades2_lexer.f90 \
 	cascades2_lexer_sub.f90 \
 	cascades2_lexer_uti.f90 \
 	cascades2_lexer_ut.f90 \
 	cascades2.f90 \
 	cascades2_sub.f90 \
 	cascades2_uti.f90 \
 	cascades2_ut.f90 \
 	phs_none.f90 \
 	phs_none_sub.f90 \
 	phs_rambo.f90 \
 	phs_rambo_sub.f90 \
 	phs_wood.f90 \
 	phs_wood_sub.f90 \
 	phs_fks.f90 \
 	phs_fks_sub.f90 \
 	phs_single.f90 \
 	phs_single_sub.f90 \
 	fks_regions.f90 \
 	fks_regions_sub.f90 \
 	virtual.f90 \
 	virtual_sub.f90 \
 	pdf.f90 \
 	pdf_sub.f90 \
 	real_subtraction.f90 \
 	real_subtraction_sub.f90 \
 	dglap_remnant.f90 \
 	dispatch_fks.f90 \
 	dispatch_fks_sub.f90 \
 	dispatch_phase_space.f90 \
 	dispatch_phase_space_sub.f90 \
 	pcm.f90 \
 	pcm_sub.f90 \
 	recola_wrapper_dummy.f90 \
 	prc_recola.f90 \
 	subevt_expr.f90 \
 	subevt_expr_sub.f90 \
 	parton_states.f90 \
 	parton_states_sub.f90 \
 	prc_template_me.f90 \
 	prc_template_me_sub.f90 \
 	process.f90 \
 	process_sub.f90 \
 	process_stacks.f90 \
 	process_stacks_sub.f90 \
 	iterations.f90 \
 	rt_data.f90 \
 	rt_data_sub.f90 \
 	file_utils.f90 \
 	file_utils_sub.f90 \
 	prc_gosam.f90 \
 	prc_gosam_sub.f90 \
 	dispatch_me_methods.f90 \
 	dispatch_me_methods_sub.f90 \
 	sf_base_uti.f90 \
 	sf_base_ut.f90 \
 	dispatch_uti.f90 \
 	dispatch_ut.f90 \
 	formats_uti.f90 \
 	formats_ut.f90 \
 	md5_uti.f90 \
 	md5_ut.f90 \
 	os_interface_uti.f90 \
 	os_interface_ut.f90 \
 	sorting_uti.f90 \
 	sorting_ut.f90 \
 	grids.f90 \
 	grids_uti.f90 \
 	grids_ut.f90 \
 	solver.f90 \
 	solver_uti.f90 \
 	solver_ut.f90 \
 	cputime_uti.f90 \
 	cputime_ut.f90 \
 	sm_qcd_uti.f90 \
 	sm_qcd_ut.f90 \
 	sm_physics_uti.f90 \
 	sm_physics_ut.f90 \
 	lexers_uti.f90 \
 	lexers_ut.f90 \
 	parser_uti.f90 \
 	parser_ut.f90 \
 	xml.f90 \
 	xml_uti.f90 \
 	xml_ut.f90 \
 	colors_uti.f90 \
 	colors_ut.f90 \
 	state_matrices_uti.f90 \
 	state_matrices_ut.f90 \
 	analysis_uti.f90 \
 	analysis_ut.f90 \
 	particles_uti.f90 \
 	particles_ut.f90 \
 	radiation_generator.f90 \
 	radiation_generator_sub.f90 \
 	radiation_generator_uti.f90 \
 	radiation_generator_ut.f90 \
 	blha_uti.f90 \
 	blha_ut.f90 \
 	evaluators_uti.f90 \
 	evaluators_ut.f90 \
 	models_uti.f90 \
 	models_ut.f90 \
 	eval_trees_uti.f90 \
 	eval_trees_ut.f90 \
 	resonances_uti.f90 \
 	resonances_ut.f90 \
 	phs_trees_uti.f90 \
 	phs_trees_ut.f90 \
 	phs_forests_uti.f90 \
 	phs_forests_ut.f90 \
 	beams_uti.f90 \
 	beams_ut.f90 \
 	su_algebra_uti.f90 \
 	su_algebra_ut.f90 \
 	bloch_vectors_uti.f90 \
 	bloch_vectors_ut.f90 \
 	polarizations_uti.f90 \
 	polarizations_ut.f90 \
 	sf_aux_uti.f90 \
 	sf_aux_ut.f90 \
 	sf_mappings_uti.f90 \
 	sf_mappings_ut.f90 \
 	sf_pdf_builtin_uti.f90 \
 	sf_pdf_builtin_ut.f90 \
 	sf_lhapdf_uti.f90 \
 	sf_lhapdf_ut.f90 \
 	sf_isr_uti.f90 \
 	sf_isr_ut.f90 \
 	sf_epa_uti.f90 \
 	sf_epa_ut.f90 \
 	sf_ewa_uti.f90 \
 	sf_ewa_ut.f90 \
 	sf_circe1_uti.f90 \
 	sf_circe1_ut.f90 \
 	sf_circe2_uti.f90 \
 	sf_circe2_ut.f90 \
 	sf_gaussian_uti.f90 \
 	sf_gaussian_ut.f90 \
 	sf_beam_events_uti.f90 \
 	sf_beam_events_ut.f90 \
 	sf_escan_uti.f90 \
 	sf_escan_ut.f90 \
 	phs_base_uti.f90 \
 	phs_base_ut.f90 \
 	phs_none_uti.f90 \
 	phs_none_ut.f90 \
 	phs_single_uti.f90 \
 	phs_single_ut.f90 \
 	phs_rambo_uti.f90 \
 	phs_rambo_ut.f90 \
 	phs_wood_uti.f90 \
 	phs_wood_ut.f90 \
 	phs_fks_uti.f90 \
 	phs_fks_ut.f90 \
 	fks_regions_uti.f90 \
 	fks_regions_ut.f90 \
 	mci_midpoint.f90 \
 	mci_midpoint_sub.f90 \
 	mci_base_uti.f90 \
 	mci_base_ut.f90 \
 	mci_midpoint_uti.f90 \
 	mci_midpoint_ut.f90 \
 	kinematics.f90 \
 	kinematics_sub.f90 \
 	instances.f90 \
 	instances_sub.f90 \
 	mci_none.f90 \
 	mci_none_sub.f90 \
 	mci_none_uti.f90 \
 	mci_none_ut.f90 \
 	processes_uti.f90 \
 	processes_ut.f90 \
 	process_stacks_uti.f90 \
 	process_stacks_ut.f90 \
 	prc_recola_uti.f90 \
 	prc_recola_ut.f90 \
 	rng_tao_uti.f90 \
 	rng_tao_ut.f90 \
 	rng_stream_uti.f90 \
 	rng_stream_ut.f90 \
 	selectors_uti.f90 \
 	selectors_ut.f90 \
 	vegas.f90 \
 	vegas_sub.f90 \
 	vegas_uti.f90 \
 	vegas_ut.f90 \
 	vamp2.f90 \
 	vamp2_sub.f90 \
 	vamp2_uti.f90 \
 	vamp2_ut.f90 \
 	exceptions.f90 \
 	vamp_stat.f90 \
 	utils.f90 \
 	divisions.f90 \
 	linalg.f90 \
 	vamp.f90 \
 	mci_vamp.f90 \
 	mci_vamp_sub.f90 \
 	mci_vamp_uti.f90 \
 	mci_vamp_ut.f90 \
 	mci_vamp2.f90 \
 	mci_vamp2_sub.f90 \
 	mci_vamp2_uti.f90 \
 	mci_vamp2_ut.f90 \
 	prclib_interfaces_uti.f90 \
 	prclib_interfaces_ut.f90 \
 	particle_specifiers_uti.f90 \
 	particle_specifiers_ut.f90 \
 	process_libraries_uti.f90 \
 	process_libraries_ut.f90 \
 	prclib_stacks_uti.f90 \
 	prclib_stacks_ut.f90 \
 	slha_interface.f90 \
 	slha_interface_sub.f90 \
 	slha_interface_uti.f90 \
 	slha_interface_ut.f90 \
 	cascades_uti.f90 \
 	cascades_ut.f90 \
 	prc_test_uti.f90 \
 	prc_test_ut.f90 \
 	prc_template_me_uti.f90 \
 	prc_template_me_ut.f90 \
 	prc_omega_uti.f90 \
 	prc_omega_ut.f90 \
 	event_transforms.f90 \
 	event_transforms_sub.f90 \
 	event_transforms_uti.f90 \
 	event_transforms_ut.f90 \
 	hep_common.f90 \
 	hep_common_sub.f90 \
 	hepev4_aux.f90 \
 	tauola_dummy.f90 \
 	tauola_interface.f90 \
 	tauola_interface_sub.f90 \
 	shower_base.f90 \
 	shower_base_sub.f90 \
 	shower_partons.f90 \
 	shower_partons_sub.f90 \
 	muli.f90 \
 	matching_base.f90 \
 	matching_base_sub.f90 \
 	powheg_matching.f90 \
 	powheg_matching_sub.f90 \
 	shower_core.f90 \
 	shower_core_sub.f90 \
 	shower_base_uti.f90 \
 	shower_base_ut.f90 \
 	shower.f90 \
 	shower_sub.f90 \
 	shower_uti.f90 \
 	shower_ut.f90 \
 	shower_pythia6.f90 \
 	shower_pythia6_sub.f90 \
 	whizard_lha.f90 \
 	whizard_lha_uti.f90 \
 	whizard_lha_ut.f90 \
 	LHAWhizard_dummy.f90 \
 	Pythia8Wrap_dummy.f90 \
 	pythia8.f90 \
 	pythia8_uti.f90 \
 	pythia8_ut.f90 \
 	shower_pythia8.f90 \
 	shower_pythia8_sub.f90 \
 	hadrons.f90 \
 	hadrons_sub.f90 \
 	ktclus.f90 \
 	mlm_matching.f90 \
 	mlm_matching_sub.f90 \
 	ckkw_matching.f90 \
 	ckkw_matching_sub.f90 \
 	jets_uti.f90 \
 	jets_ut.f90 \
 	pdg_arrays_uti.f90 \
 	pdg_arrays_ut.f90 \
 	interactions_uti.f90 \
 	interactions_ut.f90 \
 	decays.f90 \
 	decays_sub.f90 \
 	decays_uti.f90 \
 	decays_ut.f90 \
 	evt_nlo.f90 \
 	evt_nlo_sub.f90 \
 	events.f90 \
 	events_sub.f90 \
 	events_uti.f90 \
 	events_ut.f90 \
 	HepMCWrap_dummy.f90 \
 	hepmc_interface.f90 \
 	hepmc_interface_sub.f90 \
 	hepmc_interface_uti.f90 \
 	hepmc_interface_ut.f90 \
 	LCIOWrap_dummy.f90 \
 	lcio_interface.f90 \
 	lcio_interface_sub.f90 \
 	lcio_interface_uti.f90 \
 	lcio_interface_ut.f90 \
 	hep_events.f90 \
 	hep_events_sub.f90 \
 	hep_events_uti.f90 \
 	hep_events_ut.f90 \
 	expr_tests_uti.f90 \
 	expr_tests_ut.f90 \
 	parton_states_uti.f90 \
 	parton_states_ut.f90 \
 	eio_data_uti.f90 \
 	eio_data_ut.f90 \
 	eio_raw.f90 \
 	eio_raw_sub.f90 \
 	eio_raw_uti.f90 \
 	eio_raw_ut.f90 \
 	eio_checkpoints.f90 \
 	eio_checkpoints_sub.f90 \
 	eio_checkpoints_uti.f90 \
 	eio_checkpoints_ut.f90 \
 	eio_lhef.f90 \
 	eio_lhef_sub.f90 \
 	eio_lhef_uti.f90 \
 	eio_lhef_ut.f90 \
 	eio_hepmc.f90 \
 	eio_hepmc_sub.f90 \
 	eio_hepmc_uti.f90 \
 	eio_hepmc_ut.f90 \
 	eio_lcio.f90 \
 	eio_lcio_sub.f90 \
 	eio_lcio_uti.f90 \
 	eio_lcio_ut.f90 \
 	stdhep_dummy.f90 \
 	xdr_wo_stdhep.f90 \
 	eio_stdhep.f90 \
 	eio_stdhep_sub.f90 \
 	eio_stdhep_uti.f90 \
 	eio_stdhep_ut.f90 \
 	eio_ascii.f90 \
 	eio_ascii_sub.f90 \
 	eio_ascii_uti.f90 \
 	eio_ascii_ut.f90 \
 	eio_weights.f90 \
 	eio_weights_sub.f90 \
 	eio_weights_uti.f90 \
 	eio_weights_ut.f90 \
 	eio_dump.f90 \
 	eio_dump_sub.f90 \
 	eio_dump_uti.f90 \
 	eio_dump_ut.f90 \
 	eio_callback.f90 \
 	eio_callback_sub.f90 \
 	real_subtraction_uti.f90 \
 	real_subtraction_ut.f90 \
 	iterations_uti.f90 \
 	iterations_ut.f90 \
 	rt_data_uti.f90 \
 	rt_data_ut.f90 \
 	dispatch_mci.f90 \
 	dispatch_mci_sub.f90 \
 	dispatch_mci_uti.f90 \
 	dispatch_mci_ut.f90 \
 	dispatch_phs_uti.f90 \
 	dispatch_phs_ut.f90 \
 	resonance_insertion.f90 \
 	resonance_insertion_sub.f90 \
 	resonance_insertion_uti.f90 \
 	resonance_insertion_ut.f90 \
 	recoil_kinematics.f90 \
 	recoil_kinematics_sub.f90 \
 	recoil_kinematics_uti.f90 \
 	recoil_kinematics_ut.f90 \
 	isr_epa_handler.f90 \
 	isr_epa_handler_sub.f90 \
 	isr_epa_handler_uti.f90 \
 	isr_epa_handler_ut.f90 \
 	dispatch_transforms.f90 \
 	dispatch_transforms_uti.f90 \
 	dispatch_transforms_ut.f90 \
 	beam_structures_uti.f90 \
 	beam_structures_ut.f90 \
 	process_configurations.f90 \
 	process_configurations_sub.f90 \
 	process_configurations_uti.f90 \
 	process_configurations_ut.f90 \
 	compilations.f90 \
 	compilations_sub.f90 \
 	compilations_uti.f90 \
 	compilations_ut.f90 \
 	integrations.f90 \
 	integrations_sub.f90 \
 	integrations_uti.f90 \
 	integrations_ut.f90 \
 	event_streams.f90 \
 	event_streams_sub.f90 \
 	event_streams_uti.f90 \
 	event_streams_ut.f90 \
 	restricted_subprocesses.f90 \
 	restricted_subprocesses_sub.f90 \
 	eio_direct.f90 \
 	eio_direct_sub.f90 \
 	eio_direct_uti.f90 \
 	eio_direct_ut.f90 \
 	simulations.f90 \
 	simulations_sub.f90 \
 	restricted_subprocesses_uti.f90 \
 	restricted_subprocesses_ut.f90 \
 	simulations_uti.f90 \
 	simulations_ut.f90 \
 	commands.f90 \
 	commands_sub.f90 \
 	commands_uti.f90 \
 	commands_ut.f90 \
 	cmdline_options.f90 \
 	libmanager.f90 \
 	features.f90 \
 	features_sub.f90 \
 	whizard.f90 \
 	whizard_sub.f90 \
 	api.f90 \
 	api_hepmc_uti.f90 \
 	api_hepmc_ut.f90 \
 	api_lcio_uti.f90 \
 	api_lcio_ut.f90 \
 	api_uti.f90 \
 	api_ut.f90
 
 FC_OBJ = $(FC0_SRC:.f90=.o) $(F77_SRC:.f=.o) $(FC_SRC:.f90=.o) 
 CC_OBJ = $(CC_SRC:.c=.o)
 
 all: whizard_test 
 check: whizard_test
 	./whizard_test --check resonances
 
 whizard_test: $(FC_OBJ) $(CC_OBJ) main_ut.f90
 	$(FC) $(FC_OBJ) $(CC_OBJ) -ldl -o $@ main_ut.f90
 
 whizard: $(FC_OBJ) $(CC_OBJ) main.f90
 	$(FC) $(FC_OBJ) $(CC_OBJ) -ldl -o $@ main.f90
 
 %.o: %.f90
 	$(FC) $(FCFLAGS) -c $<
 
 %.o: %.f
 	$(FC) $(FCFLAGS) -c $<
 
 %.o: %.c
 	$(CC) $(CCFLAGS) -c $<
 
 tar: $(FC_SRC) $(F77_SRC) $(FC0_SRC) $(CC_SRC) $(MODELS)
 	tar cvvzf whizard-`date +%y%m%d`-`date +%H%M`.tar.gz $(FC_SRC) $(FC0_SRC) \
 	$(F77_SRC) $(CC_SRC) main_ut.f90 Makefile $(MODELS)
 
 clean:
 	rm -f *.mod *.o whizard_test
Index: trunk/tests/unit_tests/phs_points.sh
===================================================================
--- trunk/tests/unit_tests/phs_points.sh	(revision 8834)
+++ trunk/tests/unit_tests/phs_points.sh	(revision 8835)
@@ -1,4 +1,4 @@
 #!/bin/sh
-### Check WHIZARD module sm_physics
+### Check WHIZARD module phs_points
 echo "Running script $0"
 exec ./run_whizard_ut.sh --check phs_points
Index: trunk/tests/unit_tests/lorentz.sh
===================================================================
--- trunk/tests/unit_tests/lorentz.sh	(revision 0)
+++ trunk/tests/unit_tests/lorentz.sh	(revision 8835)
@@ -0,0 +1,4 @@
+#!/bin/sh
+### Check WHIZARD module lorentz
+echo "Running script $0"
+exec ./run_whizard_ut.sh --check lorentz
Index: trunk/tests/unit_tests/Makefile.am
===================================================================
--- trunk/tests/unit_tests/Makefile.am	(revision 8834)
+++ trunk/tests/unit_tests/Makefile.am	(revision 8835)
@@ -1,455 +1,456 @@
 ## Makefile.am -- Makefile for executable WHIZARD test scripts
 ##
 ## Process this file with automake to produce Makefile.in
 ##
 ########################################################################
 #
 # Copyright (C) 1999-2022 by 
 #     Wolfgang Kilian <kilian@physik.uni-siegen.de>
 #     Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
 #     Juergen Reuter <juergen.reuter@desy.de>
 #     with contributions from
 #     cf. main AUTHORS file
 #
 # WHIZARD is free software; you can redistribute it and/or modify it
 # under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 2, or (at your option)
 # any later version.
 #
 # WHIZARD is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
 #
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 #
 ########################################################################
 
 WHIZARD_UT_DRIVER = run_whizard_ut.sh
 WHIZARD_C_TEST_DRIVER = run_whizard_c_test.sh
 WHIZARD_CC_TEST_DRIVER = run_whizard_cc_test.sh
 
 UNIT_TESTS = \
     analysis.run \
     commands.run \
     pdg_arrays.run \
     expressions.run \
     beams.run \
     su_algebra.run \
     bloch_vectors.run \
     polarizations.run \
     numeric_utils.run \
     binary_tree.run \
     array_list.run \
     iterator.run \
     md5.run \
     cputime.run \
     lexers.run \
     parser.run \
     color.run \
     os_interface.run \
     evaluators.run \
     formats.run \
     sorting.run \
     grids.run \
     solver.run \
     state_matrices.run \
     interactions.run \
     xml.run \
+    lorentz.run \
     phs_points.run \
     sm_qcd.run \
     sm_qed.run \
     sm_physics.run \
     electron_pdfs.run \
     models.run \
     auto_components.run \
     radiation_generator.run \
     blha.run \
     particles.run \
     beam_structures.run \
     sf_aux.run \
     sf_mappings.run \
     sf_base.run \
     sf_pdf_builtin.run \
     sf_isr.run \
     sf_epa.run \
     sf_ewa.run \
     sf_circe1.run \
     sf_circe2.run \
     sf_gaussian.run \
     sf_beam_events.run \
     sf_escan.run \
     phs_base.run \
     phs_none.run \
     phs_single.run \
     phs_rambo.run \
     resonances.run \
     phs_trees.run \
     phs_forests.run \
     phs_wood.run \
     phs_fks_generator.run \
     fks_regions.run \
     real_subtraction.run \
     rng_base.run \
     rng_tao.run \
     rng_stream.run \
     selectors.run \
     vegas.run \
     vamp2.run \
     mci_base.run \
     mci_none.run \
     mci_midpoint.run \
     mci_vamp.run \
     mci_vamp2.run \
     integration_results.run \
     prclib_interfaces.run \
     particle_specifiers.run \
     process_libraries.run \
     prclib_stacks.run \
     slha_interface.run \
     prc_test.run \
     prc_template_me.run \
     parton_states.run \
     subevt_expr.run \
     processes.run \
     process_stacks.run \
     cascades.run \
     cascades2_lexer.run \
     cascades2.run \
     event_transforms.run \
     resonance_insertion.run \
     recoil_kinematics.run \
     isr_handler.run \
     epa_handler.run \
     decays.run \
     shower.run \
     shower_base.run \
     events.run \
     hep_events.run \
     whizard_lha.run \
     pythia8.run \
     eio_data.run \
     eio_base.run \
     eio_direct.run \
     eio_raw.run \
     eio_checkpoints.run \
     eio_lhef.run \
     eio_stdhep.run \
     eio_ascii.run \
     eio_weights.run \
     eio_dump.run \
     iterations.run \
     rt_data.run \
     dispatch.run \
     dispatch_rng.run \
     dispatch_mci.run \
     dispatch_phs.run \
     dispatch_transforms.run \
     process_configurations.run \
     event_streams.run \
     integrations.run \
     ttv_formfactors.run
 
 XFAIL_UNIT_TESTS =
 
 UNIT_TESTS_REQ_EV_ANA = \
 		phs_wood_vis.run \
 		prc_omega_diags.run \
 		integrations_history.run
 
 UNIT_TESTS_REQ_FASTJET = \
 		jets.run
 
 UNIT_TESTS_REQ_HEPMC2 = \
     hepmc2.run \
     eio_hepmc2.run \
     api_hepmc2.run
 
 UNIT_TESTS_REQ_HEPMC3 = \
     hepmc3.run \
     eio_hepmc3.run \
     api_hepmc3.run
 
 UNIT_TESTS_REQ_LCIO = \
     lcio.run \
     eio_lcio.run \
     api_lcio.run
 
 UNIT_TESTS_REQ_OCAML = \
     prc_omega.run \
     compilations.run \
     compilations_static.run \
     restricted_subprocesses.run \
     simulations.run \
     api.run \
     api_c.run \
     api_cc.run
 
 UNIT_TESTS_REQ_RECOLA = \
 	 prc_recola.run
 
 UNIT_TESTS_REQ_LHAPDF5 = \
 		sf_lhapdf5.run
 UNIT_TESTS_REQ_LHAPDF6 = \
 		sf_lhapdf6.run
 
 TEST_DRIVERS_RUN = \
     $(UNIT_TESTS) \
     $(UNIT_TESTS_REQ_HEPMC2) \
     $(UNIT_TESTS_REQ_HEPMC3) \
     $(UNIT_TESTS_REQ_LCIO) \
     $(UNIT_TESTS_REQ_FASTJET) \
     $(UNIT_TESTS_REQ_LHAPDF5) \
     $(UNIT_TESTS_REQ_LHAPDF6) \
     $(UNIT_TESTS_REQ_OCAML) \
     $(UNIT_TESTS_REQ_RECOLA)
 TEST_DRIVERS_SH = $(TEST_DRIVERS_RUN:.run=.sh)
 
 ########################################################################
 
 TESTS =
 XFAIL_TESTS =
 TESTS_SRC =
 
 UNIT_TESTS += $(UNIT_TESTS_REQ_FASTJET)
 UNIT_TESTS += $(UNIT_TESTS_REQ_HEPMC2)
 UNIT_TESTS += $(UNIT_TESTS_REQ_HEPMC3)
 UNIT_TESTS += $(UNIT_TESTS_REQ_LCIO)
 UNIT_TESTS += $(UNIT_TESTS_REQ_LHAPDF5)
 UNIT_TESTS += $(UNIT_TESTS_REQ_LHAPDF6)
 UNIT_TESTS += $(UNIT_TESTS_REQ_OCAML)
 UNIT_TESTS += $(UNIT_TESTS_REQ_EV_ANA)
 UNIT_TESTS += $(UNIT_TESTS_REQ_RECOLA)
 
 TESTS += $(UNIT_TESTS)
 XFAIL_TESTS += $(XFAIL_UNIT_TESTS)
 
 
 EXTRA_DIST = $(TEST_DRIVERS_SH)
 		$(TESTS_SRC)
 
 ########################################################################
 # Force building the whizard_ut executable in the main src directory.
 # This depends on the unit-test libraries which will be built recursively.
 
 WHIZARD_UT = ../../src/whizard_ut
 
 $(TEST_DRIVERS_RUN): $(WHIZARD_UT)
 
 $(WHIZARD_UT):
 	$(MAKE) -C ../../src check
 
 ########################################################################
 # Force building the whizard_c_test executable in the main src directory.
 # This depends on the unit-test libraries which will be built recursively.
 
 WHIZARD_C_TEST = ../../src/whizard_c_test
 
 $(TEST_DRIVERS_RUN): $(WHIZARD_C_TEST)
 
 $(WHIZARD_C_TEST): $(WHIZARD_UT)
 
 ########################################################################
 # Force building the whizard_c_test executable in the main src directory.
 # This depends on the unit-test libraries which will be built recursively.
 
 WHIZARD_CC_TEST = ../../src/whizard_cc_test
 
 $(TEST_DRIVERS_RUN): $(WHIZARD_CC_TEST)
 
 $(WHIZARD_CC_TEST): $(WHIZARD_C_TEST)
 
 ########################################################################
 
 VPATH = $(srcdir)
 
 SUFFIXES = .sh .run
 
 .sh.run:
 	@rm -f $@
 	@cp $< $@
 	@chmod +x $@
 
 sf_beam_events.run: test_beam_events.dat
 test_beam_events.dat: $(top_builddir)/share/beam-sim/test_beam_events.dat
 	cp $< $@
 
 cascades2_lexer.run: cascades2_lexer_1.fds
 cascades2_lexer_1.fds: $(top_srcdir)/share/tests/cascades2_lexer_1.fds
 	cp $< $@
 cascades2.run: cascades2_1.fds cascades2_2.fds
 cascades2_1.fds: $(top_srcdir)/share/tests/cascades2_1.fds
 	cp $< $@
 cascades2_2.fds: $(top_srcdir)/share/tests/cascades2_2.fds
 	cp $< $@
 
 WT_OCAML_NATIVE_EXT=opt
 
 if MPOST_AVAILABLE
 commands.run: gamelan.sty sps1ap_decays.slha
 gamelan.sty: $(top_builddir)/src/gamelan/gamelan.sty
 	cp $< $@
 
 $(top_builddir)/src/gamelan/gamelan.sty:
 	$(MAKE) -C $(top_builddir)/src/gamelan gamelan.sty
 else
 commands.run: sps1ap_decays.slha
 endif
 
 sps1ap_decays.slha: $(top_builddir)/share/susy/sps1ap_decays.slha
 	cp $< $@
 
 if OCAML_AVAILABLE
 
 UFO_TAG_FILE = __init__.py
 UFO_MODELPATH = ../models/UFO
 
 models.run: $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
 
 $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE): $(top_srcdir)/omega/tests/UFO/SM/$(UFO_TAG_FILE)
 	$(MAKE) -C $(UFO_MODELPATH)/SM all
 
 endif
 
 BUILT_SOURCES = \
     TESTFLAG  \
     HEPMC2_FLAG \
     HEPMC3_FLAG \
     LCIO_FLAG \
     FASTJET_FLAG \
     LHAPDF5_FLAG \
     LHAPDF6_FLAG \
     EVENT_ANALYSIS_FLAG \
     OCAML_FLAG \
     RECOLA_FLAG \
     PYTHIA6_FLAG \
     PYTHIA8_FLAG \
     STATIC_FLAG \
     ref-output \
     err-output
 
 # If this file is found in the working directory, WHIZARD
 # will use the paths for the uninstalled version (source/build tree),
 # otherwise it uses the installed version
 TESTFLAG:
 	touch $@
 
 FASTJET_FLAG:
 if FASTJET_AVAILABLE
 	touch $@
 endif
 
 HEPMC2_FLAG:
 if HEPMC2_AVAILABLE
 	touch $@
 endif
 
 HEPMC3_FLAG:
 if HEPMC3_AVAILABLE
 	touch $@
 endif
 
 LCIO_FLAG:
 if LCIO_AVAILABLE
 	touch $@
 endif
 
 LHAPDF5_FLAG:
 if LHAPDF5_AVAILABLE
 	touch $@
 endif
 
 LHAPDF6_FLAG:
 if LHAPDF6_AVAILABLE
 	touch $@
 endif
 
 OCAML_FLAG:
 if OCAML_AVAILABLE
 	touch $@
 endif
 
 RECOLA_FLAG:
 if RECOLA_AVAILABLE
 	touch $@
 endif
 
 PYTHIA6_FLAG:
 if PYTHIA6_AVAILABLE
 	touch $@
 endif
 
 PYTHIA8_FLAG:
 if PYTHIA8_AVAILABLE
 	touch $@
 endif
 
 EVENT_ANALYSIS_FLAG:
 if EVENT_ANALYSIS_AVAILABLE
 	touch $@
 endif
 
 STATIC_FLAG:
 if STATIC_AVAILABLE
 	touch $@
 endif
 
 # The reference output files are in the source directory.  Copy them here.
 ref-output: $(top_srcdir)/share/tests/unit_tests/ref-output
 	mkdir -p ref-output
 	for f in $</*.ref; do cp $$f $@; done
 
 # The output files from self tests go here.
 err-output:
 	mkdir -p err-output
 
 ## installcheck runs the test scripts with the TESTFLAG removed.
 ## NOTE: disabled for unit tests, because whizard_ut will not be installed.
 installcheck-local:
 #installcheck-local: notestflag check-am
 notestflag:
 	rm -f TESTFLAG
 .PHONY: notestflag
 
 ### Remove DWARF debug information on MAC OS X
 clean-macosx:
 	-rm -rf compilations_static_1.dSYM
 	-rm -rf compilations_static_2.dSYM
 .PHONY: clean-macosx
 
 ## Remove generated files
 clean-local: clean-macosx
 	rm -f gamelan.sty
 	rm -f TESTFLAG 
 	rm -f OCAML_FLAG FASTJET_FLAG HEPMC2_FLAG HEPMC3_FLAG LCIO_FLAG 
 	rm -f RECOLA_FLAG EVENT_ANALYSIS_FLAG PYTHIA6_FLAG PYTHIA8_FLAG 
 	rm -f LHAPDF5_FLAG LHAPDF6_FLAG STATIC_FLAG static_1.exe
 	rm -f *.run *.log slha_test.out
 	rm -f core* 
 	rm -f *.f90 *.c *.$(FCMOD) *.o *.la
 	rm -f *.makefile
 	rm -f *.grid output.rcl
 	rm -rf err-output
 	rm -rf ref-output
 	rm -f *.sin *.hbc *_fks_regions.out
 	rm -f *.phs *.vg *.vgb *.evt *.evx *.lhe *.hepmc *.dat *.debug *.mdl
 	rm -f *.tmp *.hepevt *.hepevt.verb *.lha *.lha.verb *.slcio
 	rm -f prc_omega_diags_1_p_i1_diags.out prc_omega_diags_1_p_i1_diags.toc
 	rm -f *.hep *.up.hep *.hep.out *.[1-9] *.[1-9][0-9] *.[1-9][0-9][0-9]
 	rm -f *.tex *.mp *.mpx *.t[1-9] *.t[1-9][0-9] *.t[1-9][0-9][0-9]
 	rm -f *.ltp *.aux *.dvi *.ps *.pdf so_test.*
 	rm -f *.tbl sps1ap_decays.slha bar structure_6[a-b].out
 	rm -f *.fds api_*.out
 	rm -f *.vg2 *.vegas *.grids grids_2_test
 	rm -rf output_cll
 	rm -rf *.dSYM
 if FC_SUBMODULES
 	rm -f *.smod
 endif
 
 ## Remove backup files
 maintainer-clean-local: maintainer-clean-fc
 	-rm -f *~
 .PHONY: maintainer-clean-local