Index: trunk/src/beams/beams.nw
===================================================================
--- trunk/src/beams/beams.nw	(revision 8370)
+++ trunk/src/beams/beams.nw	(revision 8371)
@@ -1,25258 +1,25258 @@
 %% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
 % WHIZARD code as NOWEB source: beams and beam structure
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Beams}
 \includemodulegraph{beams}
 
 These modules implement beam configuration and beam structure, the
 latter in abstract terms.
 \begin{description}
 \item[beam\_structures]
   The [[beam_structure_t]] type is a messenger type that communicates
   the user settings to the \whizard\ core.
 \item[beams]
   Beam configuration.
 \item[sf\_aux]
   Tools for handling structure functions and splitting
 \item[sf\_mappings]
   Mapping functions, useful for structure function implementation
 \item[sf\_base]
   The abstract structure-function interaction and structure-function
   chain types.
 \end{description}
 
 These are the implementation modules, the concrete counterparts of
 [[sf_base]]:
 \begin{description}
 \item[sf\_isr]
   ISR structure function (photon radiation inclusive and resummed in
   collinear and IR regions).
 \item[sf\_epa]
   Effective Photon Approximation.
 \item[sf\_ewa]
   Effective $W$ (and $Z$) approximation.
 \item[sf\_escan]
   Energy spectrum that emulates a uniform energy scan.
 \item[sf\_gaussian]
   Gaussian beam spread
 \item[sf\_beam\_events]
   Beam-event generator that reads its input from an external file.
 \item[sf\_circe1]
   CIRCE1 beam spectra for electrons and photons.
 \item[sf\_circe2]
   CIRCE2 beam spectra for electrons and photons.
 \item[hoppet\_interface]
   Support for $b$-quark matching, addon to PDF modules.
 \item[sf\_pdf\_builtin]
   Direct support for selected hadron PDFs.
 \item[sf\_lhapdf]
   LHAPDF library support.
 \end{description}
 
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Beam structure}
 
 This module stores the beam structure definition as it is declared in
 the SINDARIN script.  The structure definition is not analyzed, just
 recorded for later use.
 
 We do not capture any numerical parameters, just names of particles and
 structure functions.
 <<[[beam_structures.f90]]>>=
 <<File header>>
 
 module beam_structures
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_defs, only: FMT_19
   use diagnostics
   use lorentz
   use polarizations
 
 <<Standard module head>>
 
 <<Beam structures: public>>
 
 <<Beam structures: types>>
 
 <<Beam structures: interfaces>>
 
 contains
 
 <<Beam structures: procedures>>
 
 end module beam_structures
 @ %def beam_structures
 @
 \subsection{Beam structure elements}
 An entry in a beam-structure record consists of a string
 that denotes a type of structure function.
 <<Beam structures: types>>=
   type :: beam_structure_entry_t
      logical :: is_valid = .false.
      type(string_t) :: name
    contains
    <<Beam structures: beam structure entry: TBP>>
   end type beam_structure_entry_t
 
 @ %def beam_structure_entry_t
 @ Output.
 <<Beam structures: beam structure entry: TBP>>=
   procedure :: to_string => beam_structure_entry_to_string
 <<Beam structures: procedures>>=
   function beam_structure_entry_to_string (object) result (string)
     class(beam_structure_entry_t), intent(in) :: object
     type(string_t) :: string
     if (object%is_valid) then
        string = object%name
     else
        string = "none"
     end if
   end function beam_structure_entry_to_string
 
 @ %def beam_structure_entry_to_string
 @
 A record in the beam-structure sequence denotes either a
 structure-function entry, a pair of such entries, or a pair spectrum.
 <<Beam structures: types>>=
   type :: beam_structure_record_t
      type(beam_structure_entry_t), dimension(:), allocatable :: entry
   end type beam_structure_record_t
 
 @ %def beam_structure_record_t
 @
 \subsection{Beam structure type}
 The beam-structure object contains the beam particle(s) as simple strings.
 The sequence of records indicates the structure functions by name.  No
 numerical parameters are stored.
 <<Beam structures: public>>=
   public :: beam_structure_t
 <<Beam structures: types>>=
   type :: beam_structure_t
      private
      integer :: n_beam = 0
      type(string_t), dimension(:), allocatable :: prt
      type(beam_structure_record_t), dimension(:), allocatable :: record
      type(smatrix_t), dimension(:), allocatable :: smatrix
      real(default), dimension(:), allocatable :: pol_f
      real(default), dimension(:), allocatable :: p
      real(default), dimension(:), allocatable :: theta
      real(default), dimension(:), allocatable :: phi
    contains
    <<Beam structures: beam structure: TBP>>
   end type beam_structure_t
 
 @ %def beam_structure_t
 @ The finalizer deletes all contents explicitly, so we can continue
 with an empty beam record.  (It is not needed for deallocation.)  We
 have distinct finalizers for the independent parts of the beam structure.
 <<Beam structures: beam structure: TBP>>=
   procedure :: final_sf => beam_structure_final_sf
 <<Beam structures: procedures>>=
   subroutine beam_structure_final_sf (object)
     class(beam_structure_t), intent(inout) :: object
     if (allocated (object%prt))  deallocate (object%prt)
     if (allocated (object%record))  deallocate (object%record)
     object%n_beam = 0
   end subroutine beam_structure_final_sf
 
 @ %def beam_structure_final_sf
 @ Output.  The actual information fits in a single line, therefore we can
 provide a [[to_string]] method.  The [[show]] method also lists the
 current values of relevant global variables.
 <<Beam structures: beam structure: TBP>>=
   procedure :: write => beam_structure_write
   procedure :: to_string => beam_structure_to_string
 <<Beam structures: procedures>>=
   subroutine beam_structure_write (object, unit)
     class(beam_structure_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A,A)")  "Beam structure: ", char (object%to_string ())
     if (allocated (object%smatrix)) then
        do i = 1, size (object%smatrix)
           write (u, "(3x,A,I0,A)") "polarization (beam ", i, "):"
           call object%smatrix(i)%write (u, indent=2)
        end do
     end if
     if (allocated (object%pol_f)) then
        write (u, "(3x,A,F10.7,:,',',F10.7)")  "polarization degree =", &
             object%pol_f
     end if
     if (allocated (object%p)) then
        write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
             ")")  "momentum =", object%p
     end if
     if (allocated (object%theta)) then
        write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
             ")")  "angle th =", object%theta
     end if
     if (allocated (object%phi)) then
        write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
             ")")  "angle ph =", object%phi
     end if
   end subroutine beam_structure_write
 
   function beam_structure_to_string (object, sf_only) result (string)
     class(beam_structure_t), intent(in) :: object
     logical, intent(in), optional :: sf_only
     type(string_t) :: string
     integer :: i, j
     logical :: with_beams
     with_beams = .true.;  if (present (sf_only))  with_beams = .not. sf_only
     select case (object%n_beam)
     case (1)
        if (with_beams) then
           string = object%prt(1)
        else
           string = ""
        end if
     case (2)
        if (with_beams) then
           string = object%prt(1) // ", " // object%prt(2)
        else
           string = ""
        end if
        if (allocated (object%record)) then
           if (size (object%record) > 0) then
              if (with_beams)  string = string // " => "
              do i = 1, size (object%record)
                 if (i > 1)  string = string // " => "
                 do j = 1, size (object%record(i)%entry)
                    if (j > 1)  string = string // ", "
                    string = string // object%record(i)%entry(j)%to_string ()
                 end do
              end do
           end if
        end if
     case default
        string = "[any particles]"
     end select
   end function beam_structure_to_string
 
 @ %def beam_structure_write beam_structure_to_string
 @ Initializer: dimension the beam structure record.  Each array
 element denotes the number of entries for a record within the
 beam-structure sequence.  The number of entries is either one or two,
 while the number of records is unlimited.
 <<Beam structures: beam structure: TBP>>=
   procedure :: init_sf => beam_structure_init_sf
 <<Beam structures: procedures>>=
   subroutine beam_structure_init_sf (beam_structure, prt, dim_array)
     class(beam_structure_t), intent(inout) :: beam_structure
     type(string_t), dimension(:), intent(in) :: prt
     integer, dimension(:), intent(in), optional :: dim_array
     integer :: i
     call beam_structure%final_sf ()
     beam_structure%n_beam = size (prt)
     allocate (beam_structure%prt (size (prt)))
     beam_structure%prt = prt
     if (present (dim_array)) then
        allocate (beam_structure%record (size (dim_array)))
        do i = 1, size (dim_array)
           allocate (beam_structure%record(i)%entry (dim_array(i)))
        end do
     else
        allocate (beam_structure%record (0))
     end if
   end subroutine beam_structure_init_sf
 
 @ %def beam_structure_init_sf
 @ Set an entry, specified by record number and entry number.
 <<Beam structures: beam structure: TBP>>=
   procedure :: set_sf => beam_structure_set_sf
 <<Beam structures: procedures>>=
   subroutine beam_structure_set_sf (beam_structure, i, j, name)
     class(beam_structure_t), intent(inout) :: beam_structure
     integer, intent(in) :: i, j
     type(string_t), intent(in) :: name
     associate (entry => beam_structure%record(i)%entry(j))
       entry%name = name
       entry%is_valid = .true.
     end associate
   end subroutine beam_structure_set_sf
 
 @ %def beam_structure_set_sf
 @ Expand the beam-structure object.  (i) For a pair spectrum, keep the
 entry.  (ii) For a single-particle structure function written as a
 single entry, replace this by a record with two entries.
 (ii) For a record with two nontrivial entries, separate this into two
 records with one trivial entry each.
 
 To achieve this, we need a function that tells us whether an entry is
 a spectrum or a structure function.  It returns 0 for a trivial entry,
 1 for a single-particle structure function, and 2 for a two-particle
 spectrum.
 <<Beam structures: interfaces>>=
   abstract interface
      function strfun_mode_fun (name) result (n)
        import
        type(string_t), intent(in) :: name
        integer :: n
      end function strfun_mode_fun
   end interface
 
 @ %def is_spectrum_t
 @ Algorithm: (1) Mark entries as invalid where necessary.  (2) Count
 the number of entries that we will need.  (3) Expand and copy
 entries to a new record array.  (4) Replace the old array by the new one.
 <<Beam structures: beam structure: TBP>>=
   procedure :: expand => beam_structure_expand
 <<Beam structures: procedures>>=
   subroutine beam_structure_expand (beam_structure, strfun_mode)
     class(beam_structure_t), intent(inout) :: beam_structure
     procedure(strfun_mode_fun) :: strfun_mode
     type(beam_structure_record_t), dimension(:), allocatable :: new
     integer :: n_record, i, j
     if (.not. allocated (beam_structure%record))  return
     do i = 1, size (beam_structure%record)
        associate (entry => beam_structure%record(i)%entry)
          do j = 1, size (entry)
             select case (strfun_mode (entry(j)%name))
             case (0);  entry(j)%is_valid = .false.
             end select
          end do
        end associate
     end do
     n_record = 0
     do i = 1, size (beam_structure%record)
        associate (entry => beam_structure%record(i)%entry)
          select case (size (entry))
          case (1)
             if (entry(1)%is_valid) then
                select case (strfun_mode (entry(1)%name))
                case (1);  n_record = n_record + 2
                case (2);  n_record = n_record + 1
                end select
             end if
          case (2)
             do j = 1, 2
                if (entry(j)%is_valid) then
                   select case (strfun_mode (entry(j)%name))
                   case (1);  n_record = n_record + 1
                   case (2)
                      call beam_structure%write ()
                      call msg_fatal ("Pair spectrum used as &
                           &single-particle structure function")
                   end select
                end if
             end do
          end select
        end associate
     end do
     allocate (new (n_record))
     n_record = 0
     do i = 1, size (beam_structure%record)
        associate (entry => beam_structure%record(i)%entry)
          select case (size (entry))
          case (1)
             if (entry(1)%is_valid) then
                select case (strfun_mode (entry(1)%name))
                case (1)
                   n_record = n_record + 1
                   allocate (new(n_record)%entry (2))
                   new(n_record)%entry(1) = entry(1)
                   n_record = n_record + 1
                   allocate (new(n_record)%entry (2))
                   new(n_record)%entry(2) = entry(1)
                case (2)
                   n_record = n_record + 1
                   allocate (new(n_record)%entry (1))
                   new(n_record)%entry(1) = entry(1)
                end select
             end if
          case (2)
             do j = 1, 2
                if (entry(j)%is_valid) then
                   n_record = n_record + 1
                   allocate (new(n_record)%entry (2))
                   new(n_record)%entry(j) = entry(j)
                end if
             end do
          end select
        end associate
     end do
     call move_alloc (from = new, to = beam_structure%record)
   end subroutine beam_structure_expand
 
 @ %def beam_structure_expand
 @
 \subsection{Polarization}
 To record polarization, we provide an allocatable array of [[smatrix]]
 objects, sparse matrices.  The polarization structure is independent of the
 structure-function setup, they are combined only when an actual beam object is
 constructed.
 <<Beam structures: beam structure: TBP>>=
   procedure :: final_pol => beam_structure_final_pol
   procedure :: init_pol => beam_structure_init_pol
 <<Beam structures: procedures>>=
   subroutine beam_structure_final_pol (beam_structure)
     class(beam_structure_t), intent(inout) :: beam_structure
     if (allocated (beam_structure%smatrix))  deallocate (beam_structure%smatrix)
     if (allocated (beam_structure%pol_f))  deallocate (beam_structure%pol_f)
   end subroutine beam_structure_final_pol
 
   subroutine beam_structure_init_pol (beam_structure, n)
     class(beam_structure_t), intent(inout) :: beam_structure
     integer, intent(in) :: n
     if (allocated (beam_structure%smatrix))  deallocate (beam_structure%smatrix)
     allocate (beam_structure%smatrix (n))
     if (.not. allocated (beam_structure%pol_f)) &
          allocate (beam_structure%pol_f (n), source = 1._default)
   end subroutine beam_structure_init_pol
 
 @ %def beam_structure_final_pol
 @ %def beam_structure_init_pol
 @ Check if polarized beams are used.
 <<Beam structures: beam structure: TBP>>=
   procedure :: has_polarized_beams => beam_structure_has_polarized_beams
 <<Beam structures: procedures>>=
   elemental function beam_structure_has_polarized_beams (beam_structure) result (pol)
     logical :: pol
     class(beam_structure_t), intent(in) :: beam_structure
     if (allocated (beam_structure%pol_f)) then
        pol = any (beam_structure%pol_f /= 0)
     else
        pol = .false.
     end if
   end function beam_structure_has_polarized_beams
 
 @ %def beam_structure_has_polarized_beams
 @ Directly copy the spin density matrices.
 <<Beam structures: beam structure: TBP>>=
   procedure :: set_smatrix => beam_structure_set_smatrix
 <<Beam structures: procedures>>=
   subroutine beam_structure_set_smatrix (beam_structure, i, smatrix)
     class(beam_structure_t), intent(inout) :: beam_structure
     integer, intent(in) :: i
     type(smatrix_t), intent(in) :: smatrix
     beam_structure%smatrix(i) = smatrix
   end subroutine beam_structure_set_smatrix
 
 @ %def beam_structure_set_smatrix
 @ Initialize one of the spin density matrices manually.
 <<Beam structures: beam structure: TBP>>=
   procedure :: init_smatrix => beam_structure_init_smatrix
 <<Beam structures: procedures>>=
   subroutine beam_structure_init_smatrix (beam_structure, i, n_entry)
     class(beam_structure_t), intent(inout) :: beam_structure
     integer, intent(in) :: i
     integer, intent(in) :: n_entry
     call beam_structure%smatrix(i)%init (2, n_entry)
   end subroutine beam_structure_init_smatrix
 
 @ %def beam_structure_init_smatrix
 @ Set a polarization entry.
 <<Beam structures: beam structure: TBP>>=
   procedure :: set_sentry => beam_structure_set_sentry
 <<Beam structures: procedures>>=
   subroutine beam_structure_set_sentry &
        (beam_structure, i, i_entry, index, value)
     class(beam_structure_t), intent(inout) :: beam_structure
     integer, intent(in) :: i
     integer, intent(in) :: i_entry
     integer, dimension(:), intent(in) :: index
     complex(default), intent(in) :: value
     call beam_structure%smatrix(i)%set_entry (i_entry, index, value)
   end subroutine beam_structure_set_sentry
 
 @ %def beam_structure_set_sentry
 @ Set the array of polarization fractions.
 <<Beam structures: beam structure: TBP>>=
   procedure :: set_pol_f => beam_structure_set_pol_f
 <<Beam structures: procedures>>=
   subroutine beam_structure_set_pol_f (beam_structure, f)
     class(beam_structure_t), intent(inout) :: beam_structure
     real(default), dimension(:), intent(in) :: f
     if (allocated (beam_structure%pol_f))  deallocate (beam_structure%pol_f)
     allocate (beam_structure%pol_f (size (f)), source = f)
   end subroutine beam_structure_set_pol_f
 
 @ %def beam_structure_set_pol_f
 @
 \subsection{Beam momenta}
 By default, beam momenta are deduced from the [[sqrts]] value or from
 the mass of the decaying particle, assuming a c.m.\ setup.  Here we
 set them explicitly.
 <<Beam structures: beam structure: TBP>>=
   procedure :: final_mom => beam_structure_final_mom
 <<Beam structures: procedures>>=
   subroutine beam_structure_final_mom (beam_structure)
     class(beam_structure_t), intent(inout) :: beam_structure
     if (allocated (beam_structure%p))  deallocate (beam_structure%p)
     if (allocated (beam_structure%theta))  deallocate (beam_structure%theta)
     if (allocated (beam_structure%phi))  deallocate (beam_structure%phi)
   end subroutine beam_structure_final_mom
 
 @ %def beam_structure_final_mom
 <<Beam structures: beam structure: TBP>>=
   procedure :: set_momentum => beam_structure_set_momentum
   procedure :: set_theta => beam_structure_set_theta
   procedure :: set_phi => beam_structure_set_phi
 <<Beam structures: procedures>>=
   subroutine beam_structure_set_momentum (beam_structure, p)
     class(beam_structure_t), intent(inout) :: beam_structure
     real(default), dimension(:), intent(in) :: p
     if (allocated (beam_structure%p))  deallocate (beam_structure%p)
     allocate (beam_structure%p (size (p)), source = p)
   end subroutine beam_structure_set_momentum
 
   subroutine beam_structure_set_theta (beam_structure, theta)
     class(beam_structure_t), intent(inout) :: beam_structure
     real(default), dimension(:), intent(in) :: theta
     if (allocated (beam_structure%theta))  deallocate (beam_structure%theta)
     allocate (beam_structure%theta (size (theta)), source = theta)
   end subroutine beam_structure_set_theta
 
   subroutine beam_structure_set_phi (beam_structure, phi)
     class(beam_structure_t), intent(inout) :: beam_structure
     real(default), dimension(:), intent(in) :: phi
     if (allocated (beam_structure%phi))  deallocate (beam_structure%phi)
     allocate (beam_structure%phi (size (phi)), source = phi)
   end subroutine beam_structure_set_phi
 
 @ %def beam_structure_set_momentum
 @ %def beam_structure_set_theta
 @ %def beam_structure_set_phi
 @
 \subsection{Get contents}
 Look at the incoming particles.  We may also have the case that beam
 particles are not specified, but polarization.
 <<Beam structures: beam structure: TBP>>=
   procedure :: is_set => beam_structure_is_set
   procedure :: get_n_beam => beam_structure_get_n_beam
   procedure :: get_prt => beam_structure_get_prt
 <<Beam structures: procedures>>=
   function beam_structure_is_set (beam_structure) result (flag)
     class(beam_structure_t), intent(in) :: beam_structure
     logical :: flag
     flag = beam_structure%n_beam > 0 .or. beam_structure%asymmetric ()
   end function beam_structure_is_set
 
   function beam_structure_get_n_beam (beam_structure) result (n)
     class(beam_structure_t), intent(in) :: beam_structure
     integer :: n
     n = beam_structure%n_beam
   end function beam_structure_get_n_beam
 
   function beam_structure_get_prt (beam_structure) result (prt)
     class(beam_structure_t), intent(in) :: beam_structure
     type(string_t), dimension(:), allocatable :: prt
     allocate (prt (size (beam_structure%prt)))
     prt = beam_structure%prt
   end function beam_structure_get_prt
 
 @ %def beam_structure_is_set
 @ %def beam_structure_get_n_beam
 @ %def beam_structure_get_prt
 @
 Return the number of records.
 <<Beam structures: beam structure: TBP>>=
   procedure :: get_n_record => beam_structure_get_n_record
 <<Beam structures: procedures>>=
   function beam_structure_get_n_record (beam_structure) result (n)
     class(beam_structure_t), intent(in) :: beam_structure
     integer :: n
     if (allocated (beam_structure%record)) then
        n = size (beam_structure%record)
     else
        n = 0
     end if
   end function beam_structure_get_n_record
 
 @ %def beam_structure_get_n_record
 @ Return an array consisting of the beam indices affected by the valid
 entries within a record.  After expansion, there should be exactly one
 valid entry per record.
 <<Beam structures: beam structure: TBP>>=
   procedure :: get_i_entry => beam_structure_get_i_entry
 <<Beam structures: procedures>>=
   function beam_structure_get_i_entry (beam_structure, i) result (i_entry)
     class(beam_structure_t), intent(in) :: beam_structure
     integer, intent(in) :: i
     integer, dimension(:), allocatable :: i_entry
     associate (record => beam_structure%record(i))
       select case (size (record%entry))
       case (1)
          if (record%entry(1)%is_valid) then
             allocate (i_entry (2), source = [1, 2])
          else
             allocate (i_entry (0))
          end if
       case (2)
          if (all (record%entry%is_valid)) then
             allocate (i_entry (2), source = [1, 2])
          else if (record%entry(1)%is_valid) then
             allocate (i_entry (1), source = [1])
          else if (record%entry(2)%is_valid) then
             allocate (i_entry (1), source = [2])
          else
             allocate (i_entry (0))
          end if
       end select
     end associate
   end function beam_structure_get_i_entry
 
 @ %def beam_structure_get_i_entry
 @ Return the name of the first valid entry within a record.  After
 expansion, there should be exactly one valid entry per record.
 <<Beam structures: beam structure: TBP>>=
   procedure :: get_name => beam_structure_get_name
 <<Beam structures: procedures>>=
   function beam_structure_get_name (beam_structure, i) result (name)
     type(string_t) :: name
     class(beam_structure_t), intent(in) :: beam_structure
     integer, intent(in) :: i
     associate (record => beam_structure%record(i))
       if (record%entry(1)%is_valid) then
          name = record%entry(1)%name
       else if (size (record%entry) == 2) then
          name = record%entry(2)%name
       end if
     end associate
   end function beam_structure_get_name
 
 @ %def beam_structure_get_name
 @
 <<Beam structures: beam structure: TBP>>=
   procedure :: has_pdf => beam_structure_has_pdf
 <<Beam structures: procedures>>=
   function beam_structure_has_pdf (beam_structure) result (has_pdf)
     logical :: has_pdf
     class(beam_structure_t), intent(in) :: beam_structure
     integer :: i
     type(string_t) :: name
     has_pdf = .false.
     do i = 1, beam_structure%get_n_record ()
        name = beam_structure%get_name (i)
        has_pdf = has_pdf .or. name == var_str ("pdf_builtin") .or. name == var_str ("lhapdf")
     end do
   end function beam_structure_has_pdf
 
 @ %def beam_structure_has_pdf
 @ Return true if the beam structure contains a particular structure
 function identifier (such as [[lhapdf]], [[isr]], etc.)
 <<Beam structures: beam structure: TBP>>=
   procedure :: contains => beam_structure_contains
 <<Beam structures: procedures>>=
   function beam_structure_contains (beam_structure, name) result (flag)
     class(beam_structure_t), intent(in) :: beam_structure
     character(*), intent(in) :: name
     logical :: flag
     integer :: i, j
     flag = .false.
     if (allocated (beam_structure%record)) then
        do i = 1, size (beam_structure%record)
           do j = 1, size (beam_structure%record(i)%entry)
              flag = beam_structure%record(i)%entry(j)%name == name
              if (flag)  return
           end do
        end do
     end if
   end function beam_structure_contains
 
 @ %def beam_structure_contains
 @ Return polarization data.
 <<Beam structures: beam structure: TBP>>=
   procedure :: polarized => beam_structure_polarized
   procedure :: get_smatrix => beam_structure_get_smatrix
   procedure :: get_pol_f => beam_structure_get_pol_f
   procedure :: asymmetric => beam_structure_asymmetric
 <<Beam structures: procedures>>=
   function beam_structure_polarized (beam_structure) result (flag)
     class(beam_structure_t), intent(in) :: beam_structure
     logical :: flag
     flag = allocated (beam_structure%smatrix)
   end function beam_structure_polarized
 
   function beam_structure_get_smatrix (beam_structure) result (smatrix)
     class(beam_structure_t), intent(in) :: beam_structure
     type(smatrix_t), dimension(:), allocatable :: smatrix
     allocate (smatrix (size (beam_structure%smatrix)), &
          source = beam_structure%smatrix)
   end function beam_structure_get_smatrix
 
   function beam_structure_get_pol_f (beam_structure) result (pol_f)
     class(beam_structure_t), intent(in) :: beam_structure
     real(default), dimension(:), allocatable :: pol_f
     allocate (pol_f (size (beam_structure%pol_f)), &
          source = beam_structure%pol_f)
   end function beam_structure_get_pol_f
 
   function beam_structure_asymmetric (beam_structure) result (flag)
     class(beam_structure_t), intent(in) :: beam_structure
     logical :: flag
     flag = allocated (beam_structure%p) &
          .or. allocated (beam_structure%theta) &
          .or. allocated (beam_structure%phi)
   end function beam_structure_asymmetric
 
 @ %def beam_structure_polarized
 @ %def beam_structure_get_smatrix
 @ %def beam_structure_get_pol_f
 @ %def beam_structure_asymmetric
 @ Return the beam momenta (the space part, i.e., three-momenta).  This
 is meaningful only if momenta and, optionally, angles have been set.
 <<Beam structures: beam structure: TBP>>=
   procedure :: get_momenta => beam_structure_get_momenta
 <<Beam structures: procedures>>=
   function beam_structure_get_momenta (beam_structure) result (p)
     class(beam_structure_t), intent(in) :: beam_structure
     type(vector3_t), dimension(:), allocatable :: p
     real(default), dimension(:), allocatable :: theta, phi
     integer :: n, i
     if (allocated (beam_structure%p)) then
        n = size (beam_structure%p)
        if (allocated (beam_structure%theta)) then
           if (size (beam_structure%theta) == n) then
              allocate (theta (n), source = beam_structure%theta)
           else
              call msg_fatal ("Beam structure: mismatch in momentum vs. &
                   &angle theta specification")
           end if
        else
           allocate (theta (n), source = 0._default)
        end if
        if (allocated (beam_structure%phi)) then
           if (size (beam_structure%phi) == n) then
              allocate (phi (n), source = beam_structure%phi)
           else
              call msg_fatal ("Beam structure: mismatch in momentum vs. &
                   &angle phi specification")
           end if
        else
           allocate (phi (n), source = 0._default)
        end if
        allocate (p (n))
        do i = 1, n
           p(i) = beam_structure%p(i) * vector3_moving ([ &
                sin (theta(i)) * cos (phi(i)), &
                sin (theta(i)) * sin (phi(i)), &
                cos (theta(i))])
        end do
        if (n == 2)  p(2) = - p(2)
     else
        call msg_fatal ("Beam structure: angle theta/phi specified but &
             &momentum/a p undefined")
     end if
   end function beam_structure_get_momenta
 
 @ %def beam_structure_get_momenta
 @ Check for a complete beam structure.  The [[applies]] flag tells if
 the beam structure should actually be used for a process with the
 given [[n_in]] number of incoming particles.
 
 It set if the beam structure matches the process as either decay or
 scattering.  It is unset if beam structure references a scattering
 setup but the process is a decay.  It is also unset if the beam
 structure itself is empty.
 
 If the beam structure cannot be used, terminate with fatal error.
 <<Beam structures: beam structure: TBP>>=
   procedure :: check_against_n_in => beam_structure_check_against_n_in
 <<Beam structures: procedures>>=
   subroutine beam_structure_check_against_n_in (beam_structure, n_in, applies)
     class(beam_structure_t), intent(in) :: beam_structure
     integer, intent(in) :: n_in
     logical, intent(out) :: applies
     if (beam_structure%is_set ()) then
        if (n_in == beam_structure%get_n_beam ()) then
           applies = .true.
        else if (beam_structure%get_n_beam () == 0) then
           call msg_fatal &
                ("Asymmetric beams: missing beam particle specification")
           applies = .false.
        else
           call msg_fatal &
                ("Mismatch of process and beam setup (scattering/decay)")
           applies = .false.
        end if
     else
        applies = .false.
     end if
   end subroutine beam_structure_check_against_n_in
 
 @ %def beam_structure_check_against_n_in
 @
 \subsection{Unit Tests}
 Test module, followed by the corresponding implementation module.
 <<[[beam_structures_ut.f90]]>>=
 <<File header>>
 
 module beam_structures_ut
   use unit_tests
   use beam_structures_uti
 
 <<Standard module head>>
 
 <<Beam structures: public test>>
 
 contains
 
 <<Beam structures: test driver>>
 
 end module beam_structures_ut
 @ %def beam_structures_ut
 @
 <<[[beam_structures_uti.f90]]>>=
 <<File header>>
 
 module beam_structures_uti
 
 <<Use kinds>>
 <<Use strings>>
 
   use beam_structures
 
 <<Standard module head>>
 
 <<Beam structures: test declarations>>
 
 contains
 
 <<Beam structures: tests>>
 
 <<Beam structures: test auxiliary>>
 
 end module beam_structures_uti
 @ %def beam_structures_ut
 @ API: driver for the unit tests below.
 <<Beam structures: public test>>=
   public :: beam_structures_test
 <<Beam structures: test driver>>=
   subroutine beam_structures_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Beam structures: execute tests>>
 end subroutine beam_structures_test
 
 @ %def beam_structures_tests
 @
 \subsubsection{Empty structure}
 <<Beam structures: execute tests>>=
   call test (beam_structures_1, "beam_structures_1", &
        "empty beam structure record", &
        u, results)
 <<Beam structures: test declarations>>=
   public :: beam_structures_1
 <<Beam structures: tests>>=
   subroutine beam_structures_1 (u)
     integer, intent(in) :: u
     type(beam_structure_t) :: beam_structure
 
     write (u, "(A)")  "* Test output: beam_structures_1"
     write (u, "(A)")  "*   Purpose: display empty beam structure record"
     write (u, "(A)")
 
     call beam_structure%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: beam_structures_1"
 
   end subroutine beam_structures_1
 
 @ %def beam_structures_1
 @
 \subsubsection{Nontrivial configurations}
 <<Beam structures: execute tests>>=
   call test (beam_structures_2, "beam_structures_2", &
        "beam structure records", &
        u, results)
 <<Beam structures: test declarations>>=
   public :: beam_structures_2
 <<Beam structures: tests>>=
   subroutine beam_structures_2 (u)
     integer, intent(in) :: u
     type(beam_structure_t) :: beam_structure
     integer, dimension(0) :: empty_array
     type(string_t) :: s
 
     write (u, "(A)")  "* Test output: beam_structures_2"
     write (u, "(A)")  "*   Purpose: setup beam structure records"
     write (u, "(A)")
 
     s = "s"
 
     call beam_structure%init_sf ([s], empty_array)
     call beam_structure%write (u)
 
     write (u, "(A)")
 
     call beam_structure%init_sf ([s, s], [1])
     call beam_structure%set_sf (1, 1, var_str ("a"))
     call beam_structure%write (u)
 
     write (u, "(A)")
 
     call beam_structure%init_sf ([s, s], [2])
     call beam_structure%set_sf (1, 1, var_str ("a"))
     call beam_structure%set_sf (1, 2, var_str ("b"))
     call beam_structure%write (u)
 
     write (u, "(A)")
 
     call beam_structure%init_sf ([s, s], [2, 1])
     call beam_structure%set_sf (1, 1, var_str ("a"))
     call beam_structure%set_sf (1, 2, var_str ("b"))
     call beam_structure%set_sf (2, 1, var_str ("c"))
     call beam_structure%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: beam_structures_2"
 
   end subroutine beam_structures_2
 
 @ %def beam_structures_2
 @
 \subsubsection{Expansion}
 Provide a function that tells, for the dummy structure function names
 used here, whether they are considered a two-particle spectrum or a
 single-particle structure function:
 <<Beam structures: test auxiliary>>=
   function test_strfun_mode (name) result (n)
     type(string_t), intent(in) :: name
     integer :: n
     select case (char (name))
     case ("a");  n = 2
     case ("b");  n = 1
     case default;  n = 0
     end select
   end function test_strfun_mode
 
 @ %def test_ist_pair_spectrum
 @
 <<Beam structures: execute tests>>=
   call test (beam_structures_3, "beam_structures_3", &
        "beam structure expansion", &
        u, results)
 <<Beam structures: test declarations>>=
   public :: beam_structures_3
 <<Beam structures: tests>>=
   subroutine beam_structures_3 (u)
     integer, intent(in) :: u
     type(beam_structure_t) :: beam_structure
     type(string_t) :: s
 
     write (u, "(A)")  "* Test output: beam_structures_3"
     write (u, "(A)")  "*   Purpose: expand beam structure records"
     write (u, "(A)")
 
     s = "s"
 
     write (u, "(A)")  "* Pair spectrum (keep as-is)"
     write (u, "(A)")
 
     call beam_structure%init_sf ([s, s], [1])
     call beam_structure%set_sf (1, 1, var_str ("a"))
     call beam_structure%write (u)
 
     write (u, "(A)")
 
     call beam_structure%expand (test_strfun_mode)
     call beam_structure%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Structure function pair (expand)"
     write (u, "(A)")
 
     call beam_structure%init_sf ([s, s], [2])
     call beam_structure%set_sf (1, 1, var_str ("b"))
     call beam_structure%set_sf (1, 2, var_str ("b"))
     call beam_structure%write (u)
 
     write (u, "(A)")
 
     call beam_structure%expand (test_strfun_mode)
     call beam_structure%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Structure function (separate and expand)"
     write (u, "(A)")
 
     call beam_structure%init_sf ([s, s], [1])
     call beam_structure%set_sf (1, 1, var_str ("b"))
     call beam_structure%write (u)
 
     write (u, "(A)")
 
     call beam_structure%expand (test_strfun_mode)
     call beam_structure%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Combination"
     write (u, "(A)")
 
     call beam_structure%init_sf ([s, s], [1, 1])
     call beam_structure%set_sf (1, 1, var_str ("a"))
     call beam_structure%set_sf (2, 1, var_str ("b"))
     call beam_structure%write (u)
 
     write (u, "(A)")
 
     call beam_structure%expand (test_strfun_mode)
     call beam_structure%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: beam_structures_3"
 
   end subroutine beam_structures_3
 
 @ %def beam_structures_3
 @
 \subsubsection{Public methods}
 Check the methods that can be called to get the beam-structure
 contents.
 <<Beam structures: execute tests>>=
   call test (beam_structures_4, "beam_structures_4", &
        "beam structure contents", &
        u, results)
 <<Beam structures: test declarations>>=
   public :: beam_structures_4
 <<Beam structures: tests>>=
   subroutine beam_structures_4 (u)
     integer, intent(in) :: u
     type(beam_structure_t) :: beam_structure
     type(string_t) :: s
     type(string_t), dimension(2) :: prt
     integer :: i
 
     write (u, "(A)")  "* Test output: beam_structures_4"
     write (u, "(A)")  "*   Purpose: check the API"
     write (u, "(A)")
 
     s = "s"
 
     write (u, "(A)")  "* Structure-function combination"
     write (u, "(A)")
 
     call beam_structure%init_sf ([s, s], [1, 2, 2])
     call beam_structure%set_sf (1, 1, var_str ("a"))
     call beam_structure%set_sf (2, 1, var_str ("b"))
     call beam_structure%set_sf (3, 2, var_str ("c"))
     call beam_structure%write (u)
 
     write (u, *)
     write (u, "(1x,A,I0)")  "n_beam = ", beam_structure%get_n_beam ()
     prt = beam_structure%get_prt ()
     write (u, "(1x,A,2(1x,A))")  "prt =", char (prt(1)), char (prt(2))
 
     write (u, *)
     write (u, "(1x,A,I0)")  "n_record = ", beam_structure%get_n_record ()
 
     do i = 1, 3
        write (u, "(A)")
        write (u, "(1x,A,I0,A,A)")  "name(", i, ") = ", &
             char (beam_structure%get_name (i))
        write (u, "(1x,A,I0,A,2(1x,I0))")  "i_entry(", i, ") =", &
             beam_structure%get_i_entry (i)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: beam_structures_4"
 
   end subroutine beam_structures_4
 
 @ %def beam_structures_4
 @
 \subsubsection{Polarization}
 The polarization properties are independent from the structure-function setup.
 <<Beam structures: execute tests>>=
   call test (beam_structures_5, "beam_structures_5", &
        "polarization", &
        u, results)
 <<Beam structures: test declarations>>=
   public :: beam_structures_5
 <<Beam structures: tests>>=
   subroutine beam_structures_5 (u)
     integer, intent(in) :: u
     type(beam_structure_t) :: beam_structure
     integer, dimension(0) :: empty_array
     type(string_t) :: s
 
     write (u, "(A)")  "* Test output: beam_structures_5"
     write (u, "(A)")  "*   Purpose: setup polarization in beam structure records"
     write (u, "(A)")
 
     s = "s"
 
     call beam_structure%init_sf ([s], empty_array)
     call beam_structure%init_pol (1)
     call beam_structure%init_smatrix (1, 1)
     call beam_structure%set_sentry (1, 1, [0,0], (1._default, 0._default))
     call beam_structure%set_pol_f ([0.5_default])
     call beam_structure%write (u)
 
 
     write (u, "(A)")
     call beam_structure%final_sf ()
     call beam_structure%final_pol ()
 
     call beam_structure%init_sf ([s, s], [1])
     call beam_structure%set_sf (1, 1, var_str ("a"))
     call beam_structure%init_pol (2)
     call beam_structure%init_smatrix (1, 2)
     call beam_structure%set_sentry (1, 1, [-1,1], (0.5_default,-0.5_default))
     call beam_structure%set_sentry (1, 2, [ 1,1], (1._default, 0._default))
     call beam_structure%init_smatrix (2, 0)
     call beam_structure%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: beam_structures_5"
 
   end subroutine beam_structures_5
 
 @ %def beam_structures_5
 @
 \subsubsection{Momenta}
 The momenta are independent from the structure-function setup.
 <<Beam structures: execute tests>>=
   call test (beam_structures_6, "beam_structures_6", &
        "momenta", &
        u, results)
 <<Beam structures: test declarations>>=
   public :: beam_structures_6
 <<Beam structures: tests>>=
   subroutine beam_structures_6 (u)
     integer, intent(in) :: u
     type(beam_structure_t) :: beam_structure
     integer, dimension(0) :: empty_array
     type(string_t) :: s
 
     write (u, "(A)")  "* Test output: beam_structures_6"
     write (u, "(A)")  "*   Purpose: setup momenta in beam structure records"
     write (u, "(A)")
 
     s = "s"
 
     call beam_structure%init_sf ([s], empty_array)
     call beam_structure%set_momentum ([500._default])
     call beam_structure%write (u)
 
 
     write (u, "(A)")
     call beam_structure%final_sf ()
     call beam_structure%final_mom ()
 
     call beam_structure%init_sf ([s, s], [1])
     call beam_structure%set_momentum ([500._default, 700._default])
     call beam_structure%set_theta ([0._default, 0.1_default])
     call beam_structure%set_phi ([0._default, 1.51_default])
     call beam_structure%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: beam_structures_6"
 
   end subroutine beam_structures_6
 
 @ %def beam_structures_6
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Beams for collisions and decays}
 
 <<[[beams.f90]]>>=
 <<File header>>
 
 module beams
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_defs, only: FMT_19
   use numeric_utils
   use diagnostics
   use md5
   use lorentz
   use model_data
   use flavors
   use quantum_numbers
   use state_matrices
   use interactions
   use polarizations
   use beam_structures
 
 <<Standard module head>>
 
 <<Beams: public>>
 
 <<Beams: types>>
 
 <<Beams: interfaces>>
 
 contains
 
 <<Beams: procedures>>
 
 end module beams
 @ %def beams
 @
 \subsection{Beam data}
 The beam data type contains beam data for one or two beams, depending
 on whether we are dealing with beam collisions or particle decay.  In
 addition, it holds the c.m.\ energy [[sqrts]], the Lorentz
 transformation [[L]] that transforms the c.m.\ system into the lab
 system, and the pair of c.m.\ momenta.
 <<Beams: public>>=
   public :: beam_data_t
 <<Beams: types>>=
   type :: beam_data_t
      logical :: initialized = .false.
      integer :: n = 0
      type(flavor_t), dimension(:), allocatable :: flv
      real(default), dimension(:), allocatable :: mass
      type(pmatrix_t), dimension(:), allocatable :: pmatrix
      logical :: lab_is_cm_frame = .true.
      type(vector4_t), dimension(:), allocatable :: p_cm
      type(vector4_t), dimension(:), allocatable :: p
      type(lorentz_transformation_t), allocatable  :: L_cm_to_lab
      real(default) :: sqrts = 0
      character(32) :: md5sum = ""
    contains
    <<Beams: beam data: TBP>>
   end type beam_data_t
 
 @ %def beam_data_t
 @ Generic initializer.  This is called by the specific initializers
 below.  Initialize either for decay or for collision.
 <<Beams: procedures>>=
   subroutine beam_data_init (beam_data, n)
     type(beam_data_t), intent(out) :: beam_data
     integer, intent(in) :: n
     beam_data%n = n
     allocate (beam_data%flv (n))
     allocate (beam_data%mass (n))
     allocate (beam_data%pmatrix (n))
     allocate (beam_data%p_cm (n))
     allocate (beam_data%p (n))
     beam_data%initialized = .true.
   end subroutine beam_data_init
 
 @ %def beam_data_init
 @ Finalizer: needed for the polarization components of the beams.
 <<Beams: beam data: TBP>>=
   procedure :: final => beam_data_final
 <<Beams: procedures>>=
   subroutine beam_data_final (beam_data)
     class(beam_data_t), intent(inout) :: beam_data
     beam_data%initialized = .false.
   end subroutine beam_data_final
 
 @ %def beam_data_final
 @ The verbose (default) version is for debugging.  The short version
 is for screen output in the UI.
 <<Beams: beam data: TBP>>=
   procedure :: write => beam_data_write
 <<Beams: procedures>>=
   subroutine beam_data_write (beam_data, unit, verbose, write_md5sum)
     class(beam_data_t), intent(in) :: beam_data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose, write_md5sum
     integer :: prt_name_len
     logical :: verb, write_md5
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     verb = .false.;  if (present (verbose))  verb = verbose
     write_md5 = verb;  if (present (write_md5sum)) write_md5 = write_md5sum
     if (.not. beam_data%initialized) then
        write (u, "(1x,A)") "Beam data: [undefined]"
        return
     end if
     prt_name_len = maxval (len (beam_data%flv%get_name ()))
     select case (beam_data%n)
     case (1)
        write (u, "(1x,A)") "Beam data (decay):"
        if (verb) then
           call write_prt (1)
           call beam_data%pmatrix(1)%write (u)
           write (u, *) "R.f. momentum:"
           call vector4_write (beam_data%p_cm(1), u)
           write (u, *) "Lab momentum:"
           call vector4_write (beam_data%p(1), u)
        else
           call write_prt (1)
        end if
     case (2)
        write (u, "(1x,A)") "Beam data (collision):"
        if (verb) then
           call write_prt (1)
           call beam_data%pmatrix(1)%write (u)
           call write_prt (2)
           call beam_data%pmatrix(2)%write (u)
           call write_sqrts
           write (u, *) "C.m. momenta:"
           call vector4_write (beam_data%p_cm(1), u)
           call vector4_write (beam_data%p_cm(2), u)
           write (u, *) "Lab momenta:"
           call vector4_write (beam_data%p(1), u)
           call vector4_write (beam_data%p(2), u)
        else
           call write_prt (1)
           call write_prt (2)
           call write_sqrts
        end if
     end select
     if (allocated (beam_data%L_cm_to_lab)) then
        if (verb) then
           call lorentz_transformation_write (beam_data%L_cm_to_lab, u)
        else
           write (u, "(1x,A)")  "Beam structure: lab and c.m. frame differ"
        end if
     end if
     if (write_md5) then
        write (u, *) "MD5 sum: ", beam_data%md5sum
     end if
   contains
     subroutine write_sqrts
       character(80) :: sqrts_str
       write (sqrts_str, "(" // FMT_19 // ")")  beam_data%sqrts
       write (u, "(3x,A)")  "sqrts = " // trim (adjustl (sqrts_str)) // " GeV"
     end subroutine write_sqrts
     subroutine write_prt (i)
       integer, intent(in) :: i
       character(80) :: name_str, mass_str
       write (name_str, "(A)")  char (beam_data%flv(i)%get_name ())
       write (mass_str, "(ES13.7)")  beam_data%mass(i)
       write (u, "(3x,A)", advance="no") &
            name_str(:prt_name_len) // "  (mass = " &
            // trim (adjustl (mass_str)) // " GeV)"
       if (beam_data%pmatrix(i)%is_polarized ()) then
          write (u, "(2x,A)")  "polarized"
       else
          write (u, *)
       end if
     end subroutine write_prt
   end subroutine beam_data_write
 
 @ %def beam_data_write
 @ Return initialization status:
 <<Beams: beam data: TBP>>=
   procedure :: are_valid => beam_data_are_valid
 <<Beams: procedures>>=
   function beam_data_are_valid (beam_data) result (flag)
     class(beam_data_t), intent(in) :: beam_data
     logical :: flag
     flag = beam_data%initialized
   end function beam_data_are_valid
 
 @ %def beam_data_are_valid
 @ Check whether beam data agree with the current values of relevant
 parameters.
 <<Beams: beam data: TBP>>=
   procedure :: check_scattering => beam_data_check_scattering
 <<Beams: procedures>>=
   subroutine beam_data_check_scattering (beam_data, sqrts)
     class(beam_data_t), intent(in) :: beam_data
     real(default), intent(in), optional :: sqrts
     if (beam_data_are_valid (beam_data)) then
        if (present (sqrts)) then
           if (.not. nearly_equal (sqrts, beam_data%sqrts)) then
              call msg_error ("Current setting of sqrts is inconsistent " &
                   // "with beam setup (ignored).")
           end if
        end if
     else
        call msg_bug ("Beam setup: invalid beam data")
     end if
   end subroutine beam_data_check_scattering
 
 @ %def beam_data_check_scattering
 @ Return the number of beams (1 for decays, 2 for collisions).
 <<Beams: beam data: TBP>>=
   procedure :: get_n_in => beam_data_get_n_in
 <<Beams: procedures>>=
   function beam_data_get_n_in (beam_data) result (n_in)
     class(beam_data_t), intent(in) :: beam_data
     integer :: n_in
     n_in = beam_data%n
   end function beam_data_get_n_in
 
 @ %def beam_data_get_n_in
 @ Return the beam flavor
 <<Beams: beam data: TBP>>=
   procedure :: get_flavor => beam_data_get_flavor
 <<Beams: procedures>>=
   function beam_data_get_flavor (beam_data) result (flv)
     class(beam_data_t), intent(in) :: beam_data
     type(flavor_t), dimension(:), allocatable :: flv
     allocate (flv (beam_data%n))
     flv = beam_data%flv
   end function beam_data_get_flavor
 
 @ %def beam_data_get_flavor
 @ Return the beam energies
 <<Beams: beam data: TBP>>=
   procedure :: get_energy => beam_data_get_energy
 <<Beams: procedures>>=
   function beam_data_get_energy (beam_data) result (e)
     class(beam_data_t), intent(in) :: beam_data
     real(default), dimension(:), allocatable :: e
     integer :: i
     allocate (e (beam_data%n))
     if (beam_data%initialized) then
        do i = 1, beam_data%n
           e(i) = energy (beam_data%p(i))
        end do
     else
        e = 0
     end if
   end function beam_data_get_energy
 
 @ %def beam_data_get_energy
 @ Return the c.m.\ energy.
 <<Beams: beam data: TBP>>=
   procedure :: get_sqrts => beam_data_get_sqrts
 <<Beams: procedures>>=
   function beam_data_get_sqrts (beam_data) result (sqrts)
     class(beam_data_t), intent(in) :: beam_data
     real(default) :: sqrts
     sqrts = beam_data%sqrts
   end function beam_data_get_sqrts
 
 @ %def beam_data_get_sqrts
 @ Return true if the lab and c.m.\ frame are specified as identical.
 <<Beams: beam data: TBP>>=
   procedure :: cm_frame => beam_data_cm_frame
 <<Beams: procedures>>=
   function beam_data_cm_frame (beam_data) result (flag)
     class(beam_data_t), intent(in) :: beam_data
     logical :: flag
     flag = beam_data%lab_is_cm_frame
   end function beam_data_cm_frame
 
 @ %def beam_data_cm_frame
 @ Return the polarization in case it is just two degrees
 <<Beams: beam data: TBP>>=
   procedure :: get_polarization => beam_data_get_polarization
 <<Beams: procedures>>=
   function beam_data_get_polarization (beam_data) result (pol)
     class(beam_data_t), intent(in) :: beam_data
     real(default), dimension(2) :: pol
     if (beam_data%n /= 2) &
          call msg_fatal ("Beam data: can only treat scattering processes.")
     pol = beam_data%pmatrix%get_simple_pol ()
   end function beam_data_get_polarization
 
 @ %def beam_data_get_polarization
 @
 <<Beams: beam data: TBP>>=
   procedure :: get_helicity_state_matrix => beam_data_get_helicity_state_matrix
 <<Beams: procedures>>=
   function beam_data_get_helicity_state_matrix (beam_data) result (state_hel)
     type(state_matrix_t) :: state_hel
     class(beam_data_t), intent(in) :: beam_data
     type(polarization_t), dimension(:), allocatable :: pol
     integer :: i
     allocate (pol (beam_data%n))
     do i = 1, beam_data%n
        call pol(i)%init_pmatrix (beam_data%pmatrix(i))
     end do
     call combine_polarization_states (pol, state_hel)
   end function beam_data_get_helicity_state_matrix
 
 @ %def beam_data_get_helicity_state_matrix
 @
 <<Beams: beam data: TBP>>=
   procedure :: is_initialized => beam_data_is_initialized
 <<Beams: procedures>>=
   function beam_data_is_initialized (beam_data) result (initialized)
     logical :: initialized
     class(beam_data_t), intent(in) :: beam_data
     initialized = any (beam_data%pmatrix%exists ())
   end function beam_data_is_initialized
 
 @ %def beam_data_is_initialized
 @ Return a MD5 checksum for beam data.  If no checksum is present
 (because beams have not been initialized), compute the checksum of the
 sqrts value.
 <<Beams: beam data: TBP>>=
   procedure :: get_md5sum => beam_data_get_md5sum
 <<Beams: procedures>>=
   function beam_data_get_md5sum (beam_data, sqrts) result (md5sum_beams)
     class(beam_data_t), intent(in) :: beam_data
     real(default), intent(in) :: sqrts
     character(32) :: md5sum_beams
     character(80) :: buffer
     if (beam_data%md5sum /= "") then
        md5sum_beams = beam_data%md5sum
     else
        write (buffer, *)  sqrts
        md5sum_beams = md5sum (buffer)
     end if
   end function beam_data_get_md5sum
 
 @ %def beam_data_get_md5sum
 @
 \subsection{Initializers: beam structure}
 Initialize the beam data object from a beam structure object, given energy and
 model.
 <<Beams: beam data: TBP>>=
   procedure :: init_structure => beam_data_init_structure
 <<Beams: procedures>>=
   subroutine beam_data_init_structure &
        (beam_data, structure, sqrts, model, decay_rest_frame)
     class(beam_data_t), intent(out) :: beam_data
     type(beam_structure_t), intent(in) :: structure
     integer :: n_beam
     real(default), intent(in) :: sqrts
     class(model_data_t), intent(in), target :: model
     logical, intent(in), optional :: decay_rest_frame
     type(flavor_t), dimension(:), allocatable :: flv
     n_beam = structure%get_n_beam ()
     allocate (flv (n_beam))
     call flv%init (structure%get_prt (), model)
     if (structure%asymmetric ()) then
        if (structure%polarized ()) then
           call beam_data%init_momenta (structure%get_momenta (), flv, &
                structure%get_smatrix (), structure%get_pol_f ())
        else
           call beam_data%init_momenta (structure%get_momenta (), flv)
        end if
     else
        select case (n_beam)
        case (1)
           if (structure%polarized ()) then
              call beam_data%init_decay (flv, &
                   structure%get_smatrix (), structure%get_pol_f (), &
                   rest_frame = decay_rest_frame)
           else
              call beam_data%init_decay (flv, &
                   rest_frame = decay_rest_frame)
           end if
        case (2)
           if (structure%polarized ()) then
              call beam_data%init_sqrts (sqrts, flv, &
                   structure%get_smatrix (), structure%get_pol_f ())
           else
              call beam_data%init_sqrts (sqrts, flv)
           end if
        case default
           call msg_bug ("Beam data: invalid beam structure object")
        end select
     end if
   end subroutine beam_data_init_structure
 
 @ %def beam_data_init_structure
 @
 \subsection{Initializers: collisions}
 This is the simplest one: just the two flavors, c.m.\ energy,
 polarization.  Color is inferred from flavor.  Beam momenta and c.m.\
 momenta coincide.
 <<Beams: beam data: TBP>>=
   procedure :: init_sqrts => beam_data_init_sqrts
 <<Beams: procedures>>=
   subroutine beam_data_init_sqrts (beam_data, sqrts, flv, smatrix, pol_f)
     class(beam_data_t), intent(out) :: beam_data
     real(default), intent(in) :: sqrts
     type(flavor_t), dimension(:), intent(in) :: flv
     type(smatrix_t), dimension(:), intent(in), optional :: smatrix
     real(default), dimension(:), intent(in), optional :: pol_f
     real(default), dimension(size(flv)) :: E, p
     call beam_data_init (beam_data, size (flv))
     beam_data%sqrts = sqrts
     beam_data%lab_is_cm_frame = .true.
     select case (beam_data%n)
     case (1)
        E = sqrts;  p = 0
        beam_data%p_cm = vector4_moving (E, p, 3)
        beam_data%p = beam_data%p_cm
     case (2)
        beam_data%p_cm = colliding_momenta (sqrts, flv%get_mass ())
        beam_data%p = colliding_momenta (sqrts, flv%get_mass ())
     end select
     call beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
   end subroutine beam_data_init_sqrts
 
 @ %def beam_data_init_sqrts
 @ This version sets beam momenta directly, assuming that they are
 asymmetric, i.e., lab frame and c.m.\ frame do not coincide.
 Polarization info is deferred to a common initializer.
 
 The Lorentz transformation that we compute here is not actually used
 in the calculation; instead, it will be recomputed for each event in
 the subroutine [[phs_set_incoming_momenta]].  We compute it here for
 the nominal beam setup nevertheless, so we can print it and, in
 particular, include it in the MD5 sum.
 <<Beams: beam data: TBP>>=
   procedure :: init_momenta => beam_data_init_momenta
 <<Beams: procedures>>=
   subroutine beam_data_init_momenta (beam_data, p3, flv, smatrix, pol_f)
     class(beam_data_t), intent(out) :: beam_data
     type(vector3_t), dimension(:), intent(in) :: p3
     type(flavor_t), dimension(:), intent(in) :: flv
     type(smatrix_t), dimension(:), intent(in), optional :: smatrix
     real(default), dimension(:), intent(in), optional :: pol_f
     type(vector4_t) :: p0
     type(vector4_t), dimension(:), allocatable :: p, p_cm_rot
     real(default), dimension(size(p3)) :: e
     real(default), dimension(size(flv)) :: m
     type(lorentz_transformation_t) :: L_boost, L_rot
     call beam_data_init (beam_data, size (flv))
     m = flv%get_mass ()
     e = sqrt (p3 ** 2 + m ** 2)
     allocate (p (beam_data%n))
     p = vector4_moving (e, p3)
     p0 = sum (p)
     beam_data%p = p
     beam_data%lab_is_cm_frame = .false.
     beam_data%sqrts = p0 ** 1
     L_boost = boost (p0, beam_data%sqrts)
     allocate (p_cm_rot (beam_data%n))
     p_cm_rot = inverse (L_boost) * p
     allocate (beam_data%L_cm_to_lab)
     select case (beam_data%n)
     case (1)
        beam_data%L_cm_to_lab = L_boost
        beam_data%p_cm = vector4_at_rest (beam_data%sqrts)
     case (2)
        L_rot = rotation_to_2nd (3, space_part (p_cm_rot(1)))
        beam_data%L_cm_to_lab = L_boost * L_rot
        beam_data%p_cm = &
             colliding_momenta (beam_data%sqrts, flv%get_mass ())
     end select
     call beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
   end subroutine beam_data_init_momenta
 
 @ %def beam_data_init_momenta
 @
 Final steps:
 If requested, rotate the beams in the lab frame, and set
 the beam-data components.
 <<Beams: procedures>>=
   subroutine beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
     type(beam_data_t), intent(inout) :: beam_data
     type(flavor_t), dimension(:), intent(in) :: flv
     type(smatrix_t), dimension(:), intent(in), optional :: smatrix
     real(default), dimension(:), intent(in), optional :: pol_f
     integer :: i
     do i = 1, beam_data%n
        beam_data%flv(i) = flv(i)
        beam_data%mass(i) = flv(i)%get_mass ()
        if (present (smatrix)) then
           if (size (smatrix) /= beam_data%n) &
                call msg_fatal ("Beam data: &
                &polarization density array has wrong dimension")
           beam_data%pmatrix(i) = smatrix(i)
           if (present (pol_f)) then
              if (size (pol_f) /= size (smatrix)) &
                   call msg_fatal ("Beam data: &
                   &polarization fraction array has wrong dimension")
              call beam_data%pmatrix(i)%normalize (flv(i), pol_f(i))
           else
              call beam_data%pmatrix(i)%normalize (flv(i), 1._default)
           end if
        else
           call beam_data%pmatrix(i)%init (2, 0)
           call beam_data%pmatrix(i)%normalize (flv(i), 0._default)
        end if
     end do
     call beam_data%compute_md5sum ()
   end subroutine beam_data_finish_initialization
 
 @ %def beam_data_finish_initialization
 @
 The MD5 sum is stored within the beam-data record, so it can be
 checked for integrity in subsequent runs.
 <<Beams: beam data: TBP>>=
   procedure :: compute_md5sum => beam_data_compute_md5sum
 <<Beams: procedures>>=
   subroutine beam_data_compute_md5sum (beam_data)
     class(beam_data_t), intent(inout) :: beam_data
     integer :: unit
     unit = free_unit ()
     open (unit = unit, status = "scratch", action = "readwrite")
     call beam_data%write (unit, write_md5sum = .false., &
        verbose = .true.)
     rewind (unit)
     beam_data%md5sum = md5sum (unit)
     close (unit)
   end subroutine beam_data_compute_md5sum
 
 @ %def beam_data_compute_md5sum
 @
 \subsection{Initializers: decays}
 This is the simplest one: decay in rest frame.  We need just flavor
 and polarization.  Color is inferred from flavor.  Beam momentum and
 c.m.\ momentum coincide.
 <<Beams: beam data: TBP>>=
   procedure :: init_decay => beam_data_init_decay
 <<Beams: procedures>>=
   subroutine beam_data_init_decay (beam_data, flv, smatrix, pol_f, rest_frame)
     class(beam_data_t), intent(out) :: beam_data
     type(flavor_t), dimension(1), intent(in) :: flv
     type(smatrix_t), dimension(1), intent(in), optional :: smatrix
     real(default), dimension(:), intent(in), optional :: pol_f
     logical, intent(in), optional :: rest_frame
     real(default), dimension(1) :: m
     m = flv%get_mass ()
     if (present (smatrix)) then
        call beam_data%init_sqrts (m(1), flv, smatrix, pol_f)
     else
        call beam_data%init_sqrts (m(1), flv, smatrix, pol_f)
     end if
     if (present (rest_frame))  beam_data%lab_is_cm_frame = rest_frame
   end subroutine beam_data_init_decay
 
 @ %def beam_data_init_decay
 @
 \subsection{The beams type}
 Beam objects are interaction objects that contain the actual beam
 data including polarization and density matrix.  For collisions, the
 beam object actually contains two beams.
 <<Beams: public>>=
   public :: beam_t
 <<Beams: types>>=
   type :: beam_t
      private
      type(interaction_t) :: int
   end type beam_t
 
 @ %def beam_t
 @ The constructor contains code that converts beam data into the
 (entangled) particle-pair quantum state.  First, we set the number of
 particles and polarization mask.  (The polarization mask is handed
 over to all later interactions, so if helicity is diagonal or absent, this fact
 is used when constructing the hard-interaction events.)  Then, we
 construct the entangled state that combines helicity, flavor and color
 of the two particles (where flavor and color are unique, while several
 helicity states are possible).  Then, we transfer this state together
 with the associated values from the spin density matrix into the
 [[interaction_t]] object.
 
 Calling the [[add_state]] method of the interaction object, we keep
 the entries of the helicity density matrix without adding them up.
 This ensures that for unpolarized states, we do not normalize but end
 up with an $1/N$ entry, where $N$ is the initial-state multiplicity.
 <<Beams: public>>=
   public :: beam_init
 <<Beams: procedures>>=
   subroutine beam_init (beam, beam_data)
     type(beam_t), intent(out) :: beam
     type(beam_data_t), intent(in), target :: beam_data
     logical, dimension(beam_data%n) :: polarized, diagonal
     type(quantum_numbers_mask_t), dimension(beam_data%n) :: mask, mask_d
     type(state_matrix_t), target :: state_hel, state_fc, state_tmp
     type(state_iterator_t) :: it_hel, it_tmp
     type(quantum_numbers_t), dimension(:), allocatable :: qn
     complex(default) :: value
     real(default), parameter :: tolerance = 100 * epsilon (1._default)
     polarized = beam_data%pmatrix%is_polarized ()
     diagonal = beam_data%pmatrix%is_diagonal ()
     mask = quantum_numbers_mask (.false., .false., &
          mask_h = .not. polarized, &
          mask_hd = diagonal)
     mask_d = quantum_numbers_mask (.false., .false., .false., &
          mask_hd = polarized .and. diagonal)
     call beam%int%basic_init &
          (0, 0, beam_data%n, mask = mask, store_values = .true.)
     state_hel = beam_data%get_helicity_state_matrix ()
     allocate (qn (beam_data%n))
     call qn%init (beam_data%flv, color_from_flavor (beam_data%flv, 1))
     call state_fc%init ()
     call state_fc%add_state (qn)
     call merge_state_matrices (state_hel, state_fc, state_tmp)
     call it_hel%init (state_hel)
     call it_tmp%init (state_tmp)
     do while (it_hel%is_valid ())
        qn = it_tmp%get_quantum_numbers ()
        value = it_hel%get_matrix_element ()
        if (any (qn%are_redundant (mask_d))) then
           ! skip off-diagonal elements for diagonal polarization
        else if (abs (value) <= tolerance) then
           ! skip zero entries
        else
           call beam%int%add_state (qn, value = value)
        end if
        call it_hel%advance ()
        call it_tmp%advance ()
     end do
     call beam%int%freeze ()
     call beam%int%set_momenta (beam_data%p, outgoing = .true.)
     call state_hel%final ()
     call state_fc%final ()
     call state_tmp%final ()
   end subroutine beam_init
 
 @ %def beam_init
 @ Finalizer:
 <<Beams: public>>=
   public :: beam_final
 <<Beams: procedures>>=
   subroutine beam_final (beam)
     type(beam_t), intent(inout) :: beam
     call beam%int%final ()
   end subroutine beam_final
 
 @ %def beam_final
 @ I/O:
 <<Beams: public>>=
   public :: beam_write
 <<Beams: procedures>>=
   subroutine beam_write (beam, unit, verbose, show_momentum_sum, show_mass, col_verbose)
     type(beam_t), intent(in) :: beam
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose, show_momentum_sum, show_mass
     logical, intent(in), optional :: col_verbose
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     select case (beam%int%get_n_out ())
     case (1);  write (u, *) "Decaying particle:"
     case (2);  write (u, *) "Colliding beams:"
     end select
     call beam%int%basic_write &
          (unit, verbose = verbose, show_momentum_sum = &
           show_momentum_sum, show_mass = show_mass, &
           col_verbose = col_verbose)
   end subroutine beam_write
 
 @ %def beam_write
 @ Defined assignment: deep copy
 <<Beams: public>>=
   public :: assignment(=)
 <<Beams: interfaces>>=
   interface assignment(=)
      module procedure beam_assign
   end interface
 
 <<Beams: procedures>>=
   subroutine beam_assign (beam_out, beam_in)
     type(beam_t), intent(out) :: beam_out
     type(beam_t), intent(in) :: beam_in
     beam_out%int = beam_in%int
   end subroutine beam_assign
 
 @ %def beam_assign
 @
 \subsection{Inherited procedures}
 <<Beams: public>>=
   public :: interaction_set_source_link
 <<Beams: interfaces>>=
   interface interaction_set_source_link
      module procedure interaction_set_source_link_beam
   end interface
 <<Beams: procedures>>=
   subroutine interaction_set_source_link_beam (int, i, beam1, i1)
     type(interaction_t), intent(inout) :: int
     type(beam_t), intent(in), target :: beam1
     integer, intent(in) :: i, i1
     call int%set_source_link (i, beam1%int, i1)
   end subroutine interaction_set_source_link_beam
 
 @ %def interaction_set_source_link_beam
 @
 \subsection{Accessing contents}
 Return the interaction component -- as a pointer, to avoid any copying.
 <<Beams: public>>=
   public :: beam_get_int_ptr
 <<Beams: procedures>>=
   function beam_get_int_ptr (beam) result (int)
     type(interaction_t), pointer :: int
     type(beam_t), intent(in), target :: beam
     int => beam%int
   end function beam_get_int_ptr
 
 @ %def beam_get_int_ptr
 @ Set beam momenta directly.  (Used for cascade decays.)
 <<Beams: public>>=
   public :: beam_set_momenta
 <<Beams: procedures>>=
   subroutine beam_set_momenta (beam, p)
     type(beam_t), intent(inout) :: beam
     type(vector4_t), dimension(:), intent(in) :: p
     call beam%int%set_momenta (p)
   end subroutine beam_set_momenta
 
 @ %def beam_set_momenta
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[beams_ut.f90]]>>=
 <<File header>>
 
 module beams_ut
   use unit_tests
   use beams_uti
 
 <<Standard module head>>
 
 <<Beams: public test>>
 
 contains
 
 <<Beams: test driver>>
 
 end module beams_ut
 @ %def beams_ut
 @
 <<[[beams_uti.f90]]>>=
 <<File header>>
 
 module beams_uti
 
 <<Use kinds>>
   use lorentz
   use flavors
   use interactions, only: reset_interaction_counter
   use polarizations, only: smatrix_t
   use model_data
   use beam_structures
 
   use beams
 
 <<Standard module head>>
 
 <<Beams: test declarations>>
 
 contains
 
 <<Beams: tests>>
 
 end module beams_uti
 @ %def beams_ut
 @ API: driver for the unit tests below.
 <<Beams: public test>>=
   public :: beams_test
 <<Beams: test driver>>=
   subroutine beams_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Beams: execute tests>>
   end subroutine beams_test
 
 @  %def beams_test
 @ Test the basic beam setup.
 <<Beams: execute tests>>=
   call test (beam_1, "beam_1", &
        "check basic beam setup", &
        u, results)
 <<Beams: test declarations>>=
   public :: beam_1
 <<Beams: tests>>=
   subroutine beam_1 (u)
     integer, intent(in) :: u
     type(beam_data_t), target :: beam_data
     type(beam_t) :: beam
     real(default) :: sqrts
     type(flavor_t), dimension(2) :: flv
     type(smatrix_t), dimension(2) :: smatrix
     real(default), dimension(2) :: pol_f
     type(model_data_t), target :: model
 
     write (u, "(A)")  "* Test output: beam_1"
     write (u, "(A)")  "*   Purpose: test basic beam setup"
     write (u, "(A)")
 
     write (u, "(A)")  "* Reading model file"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call model%init_sm_test ()
 
     write (u, "(A)")  "* Unpolarized scattering, massless fermions"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([1,-1], model)
 
     call beam_data%init_sqrts (sqrts, flv)
     call beam_data%write (u)
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
     call beam_final (beam)
     call beam_data%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Unpolarized scattering, massless bosons"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([22,22], model)
 
     call beam_data%init_sqrts (sqrts, flv)
     call beam_data%write (u)
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
     call beam_final (beam)
     call beam_data%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Unpolarized scattering, massive bosons"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([24,-24], model)
 
     call beam_data%init_sqrts (sqrts, flv)
     call beam_data%write (u)
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
     call beam_final (beam)
     call beam_data%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Polarized scattering, massless fermions"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([1,-1], model)
 
     call smatrix(1)%init (2, 1)
     call smatrix(1)%set_entry (1, [1,1], (1._default, 0._default))
     pol_f(1) = 0.5_default
 
     call smatrix(2)%init (2, 3)
     call smatrix(2)%set_entry (1, [1,1], (1._default, 0._default))
     call smatrix(2)%set_entry (2, [-1,-1], (1._default, 0._default))
     call smatrix(2)%set_entry (3, [-1,1], (1._default, 0._default))
     pol_f(2) = 1._default
 
     call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
     call beam_data%write (u)
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
     call beam_final (beam)
     call beam_data%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Semi-polarized scattering, massless bosons"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([22,22], model)
 
     call smatrix(1)%init (2, 0)
     pol_f(1) = 0._default
 
     call smatrix(2)%init (2, 1)
     call smatrix(2)%set_entry (1, [1,1], (1._default, 0._default))
     pol_f(2) = 1._default
 
     call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
     call beam_data%write (u)
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
     call beam_final (beam)
     call beam_data%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Semi-polarized scattering, massive bosons"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([24,-24], model)
 
     call smatrix(1)%init (2, 0)
     pol_f(1) = 0._default
 
     call smatrix(2)%init (2, 1)
     call smatrix(2)%set_entry (1, [0,0], (1._default, 0._default))
     pol_f(2) = 1._default
 
     call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
     call beam_data%write (u)
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
     call beam_final (beam)
     call beam_data%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Unpolarized decay, massive boson"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call flv(1)%init (23, model)
 
     call beam_data%init_decay (flv(1:1))
     call beam_data%write (u)
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Polarized decay, massive boson"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call flv(1)%init (23, model)
     call smatrix(1)%init (2, 1)
     call smatrix(1)%set_entry (1, [0,0], (1._default, 0._default))
     pol_f(1) = 0.4_default
 
     call beam_data%init_decay (flv(1:1), smatrix(1:1), pol_f(1:1))
     call beam_data%write (u)
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call beam_final (beam)
     call beam_data%final ()
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: beam_1"
 
   end subroutine beam_1
 
 @ %def beam_1
 @ Test advanced beam setup.
 <<Beams: execute tests>>=
   call test (beam_2, "beam_2", &
        "beam initialization", &
        u, results)
 <<Beams: test declarations>>=
   public :: beam_2
 <<Beams: tests>>=
   subroutine beam_2 (u)
     integer, intent(in) :: u
     type(beam_data_t), target :: beam_data
     type(beam_t) :: beam
     real(default) :: sqrts
     type(flavor_t), dimension(2) :: flv
     integer, dimension(0) :: no_records
     type(beam_structure_t) :: beam_structure
     type(model_data_t), target :: model
 
     write (u, "(A)")  "* Test output: beam_2"
     write (u, "(A)")  "*   Purpose: transfer beam polarization using &
          &beam structure"
     write (u, "(A)")
 
     write (u, "(A)")  "* Reading model file"
     write (u, "(A)")
 
     call model%init_sm_test ()
 
     write (u, "(A)")  "* Unpolarized scattering, massless fermions"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([1,-1], model)
     call beam_structure%init_sf (flv%get_name (), no_records)
     call beam_structure%final_pol ()
 
     call beam_structure%write (u)
     write (u, *)
 
     call beam_data%init_structure (beam_structure, sqrts, model)
     call beam_data%write (u)
 
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
     call beam_final (beam)
     call beam_data%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Unpolarized scattering, massless bosons"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([22,22], model)
 
     call beam_structure%init_sf (flv%get_name (), no_records)
     call beam_structure%final_pol ()
 
     call beam_structure%write (u)
     write (u, *)
 
     call beam_data%init_structure (beam_structure, sqrts, model)
     call beam_data%write (u)
 
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
     call beam_final (beam)
     call beam_data%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Unpolarized scattering, massive bosons"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([24,-24], model)
 
     call beam_structure%init_sf (flv%get_name (), no_records)
     call beam_structure%final_pol ()
 
     call beam_structure%write (u)
     write (u, *)
 
     call beam_data%init_structure (beam_structure, sqrts, model)
     call beam_data%write (u)
 
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
     call beam_final (beam)
     call beam_data%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Polarized scattering, massless fermions"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([1,-1], model)
     call beam_structure%init_sf (flv%get_name (), no_records)
     call beam_structure%init_pol (2)
 
     call beam_structure%init_smatrix (1, 1)
     call beam_structure%set_sentry (1, 1, [1,1], (1._default, 0._default))
 
     call beam_structure%init_smatrix (2, 3)
     call beam_structure%set_sentry (2, 1, [1,1], (1._default, 0._default))
     call beam_structure%set_sentry (2, 2, [-1,-1], (1._default, 0._default))
     call beam_structure%set_sentry (2, 3, [-1,1], (1._default, 0._default))
 
     call beam_structure%set_pol_f ([0.5_default, 1._default])
     call beam_structure%write (u)
     write (u, *)
 
     call beam_data%init_structure (beam_structure, sqrts, model)
     call beam_data%write (u)
     write (u, *)
 
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
 
     call beam_final (beam)
     call beam_data%final ()
     call beam_structure%final_pol ()
     call beam_structure%final_sf ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Semi-polarized scattering, massless bosons"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([22,22], model)
 
     call beam_structure%init_sf (flv%get_name (), no_records)
     call beam_structure%init_pol (2)
 
     call beam_structure%init_smatrix (1, 0)
 
     call beam_structure%init_smatrix (2, 1)
     call beam_structure%set_sentry (2, 1, [1,1], (1._default, 0._default))
 
     call beam_structure%set_pol_f ([0._default, 1._default])
     call beam_structure%write (u)
     write (u, *)
 
     call beam_data%init_structure (beam_structure, sqrts, model)
     call beam_data%write (u)
 
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
     call beam_final (beam)
     call beam_data%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Semi-polarized scattering, massive bosons"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     sqrts = 500
     call flv%init ([24,-24], model)
 
     call beam_structure%init_sf (flv%get_name (), no_records)
     call beam_structure%init_pol (2)
 
     call beam_structure%init_smatrix (1, 0)
 
     call beam_structure%init_smatrix (2, 1)
     call beam_structure%set_sentry (2, 1, [0,0], (1._default, 0._default))
     call beam_structure%write (u)
 
     write (u, "(A)")
     call beam_data%init_structure (beam_structure, sqrts, model)
     call beam_data%write (u)
 
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
     call beam_final (beam)
     call beam_data%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Unpolarized decay, massive boson"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call flv(1)%init (23, model)
 
     call beam_structure%init_sf ([flv(1)%get_name ()], no_records)
     call beam_structure%final_pol ()
     call beam_structure%write (u)
 
     write (u, "(A)")
     call beam_data%init_structure (beam_structure, sqrts, model)
     call beam_data%write (u)
 
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Polarized decay, massive boson"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call flv(1)%init (23, model)
     call beam_structure%init_sf ([flv(1)%get_name ()], no_records)
 
     call beam_structure%init_pol (1)
 
     call beam_structure%init_smatrix (1, 1)
     call beam_structure%set_sentry (1, 1, [0,0], (1._default, 0._default))
     call beam_structure%set_pol_f ([0.4_default])
     call beam_structure%write (u)
     write (u, *)
 
     call beam_data%init_structure (beam_structure, sqrts, model)
     call beam_data%write (u)
     write (u, "(A)")
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call beam_final (beam)
     call beam_data%final ()
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: beam_2"
 
   end subroutine beam_2
 
 @ %def beam_2
 @ Test advanced beam setup, completely arbitrary momenta.
 <<Beams: execute tests>>=
   call test (beam_3, "beam_3", &
        "generic beam momenta", &
        u, results)
 <<Beams: test declarations>>=
   public :: beam_3
 <<Beams: tests>>=
   subroutine beam_3 (u)
     integer, intent(in) :: u
     type(beam_data_t), target :: beam_data
     type(beam_t) :: beam
     type(flavor_t), dimension(2) :: flv
     integer, dimension(0) :: no_records
     type(model_data_t), target :: model
     type(beam_structure_t) :: beam_structure
     type(vector3_t), dimension(2) :: p3
     type(vector4_t), dimension(2) :: p
 
     write (u, "(A)")  "* Test output: beam_3"
     write (u, "(A)")  "*   Purpose: set up beams with generic momenta"
     write (u, "(A)")
 
     write (u, "(A)")  "* Reading model file"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call model%init_sm_test ()
 
     write (u, "(A)")  "* 1: Scattering process"
     write (u, "(A)")
 
     call flv%init ([2212,2212], model)
 
     p3(1) = vector3_moving ([5._default, 0._default, 10._default])
     p3(2) = -vector3_moving ([1._default, 1._default, -10._default])
 
     call beam_structure%init_sf (flv%get_name (), no_records)
     call beam_structure%set_momentum (p3 ** 1)
     call beam_structure%set_theta (polar_angle (p3))
     call beam_structure%set_phi (azimuthal_angle (p3))
     call beam_structure%write (u)
     write (u, *)
 
     call beam_data%init_structure (beam_structure, 0._default, model)
     call pacify (beam_data%l_cm_to_lab, 1e-20_default)
     call beam_data%compute_md5sum ()
     call beam_data%write (u, verbose = .true.)
     write (u, *)
 
     write (u, "(1x,A)")  "Beam momenta reconstructed from LT:"
     p = beam_data%L_cm_to_lab * beam_data%p_cm
     call pacify (p, 1e-12_default)
     call vector4_write (p(1), u)
     call vector4_write (p(2), u)
     write (u, "(A)")
 
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
 
     call beam_final (beam)
     call beam_data%final ()
     call beam_structure%final_sf ()
     call beam_structure%final_mom ()
 
     write (u, "(A)")
     write (u, "(A)")  "* 2: Decay"
     write (u, "(A)")
 
     call flv(1)%init (23, model)
     p3(1) = vector3_moving ([10._default, 5._default, 50._default])
 
     call beam_structure%init_sf ([flv(1)%get_name ()], no_records)
     call beam_structure%set_momentum ([p3(1) ** 1])
     call beam_structure%set_theta ([polar_angle (p3(1))])
     call beam_structure%set_phi ([azimuthal_angle (p3(1))])
     call beam_structure%write (u)
     write (u, *)
 
     call beam_data%init_structure (beam_structure, 0._default, model)
     call beam_data%write (u, verbose = .true.)
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Beam momentum reconstructed from LT:"
     p(1) = beam_data%L_cm_to_lab * beam_data%p_cm(1)
     call pacify (p(1), 1e-12_default)
     call vector4_write (p(1), u)
     write (u, "(A)")
 
     call beam_init (beam, beam_data)
     call beam_write (beam, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call beam_final (beam)
     call beam_data%final ()
     call beam_structure%final_sf ()
     call beam_structure%final_mom ()
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: beam_3"
 
   end subroutine beam_3
 
 @ %def beam_3
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Tools}
 
 This module contains auxiliary procedures that can be accessed by the
 structure function code.
 
 <<[[sf_aux.f90]]>>=
 <<File header>>
 
 module sf_aux
 
 <<Use kinds>>
   use io_units
   use constants, only: twopi
   use numeric_utils
 
   use lorentz
 
 <<Standard module head>>
 
 <<SF aux: public>>
 
 <<SF aux: parameters>>
 
 <<SF aux: types>>
 
 contains
 
 <<SF aux: procedures>>
 
 end module sf_aux
 
 @ %def sf_aux
 @
 \subsection{Momentum splitting}
 Let us consider first an incoming parton with momentum $k$ and
 invariant mass squared $s=k^2$ that splits into two partons with
 momenta $q,p$ and invariant masses $t=q^2$ and $u=p^2$.  (This is an
 abuse of the Mandelstam notation.  $t$ is actually the momentum
 transfer, assuming that $p$ is radiated and $q$ initiates the hard
 process.) The energy is split among the partons such that if $E=k^0$,
 we have $q^0 = xE$ and $p^0=\bar x E$, where $\bar x\equiv 1-x$.
 
 We define the angle $\theta$ as the polar angle of $p$ w.r.t.\ the
 momentum axis of the incoming momentum $k$.  Ignoring azimuthal angle,
 we can write the four-momenta in the basis $(E,p_T,p_L)$ as
 \begin{equation}
   k =
   \begin{pmatrix}
     E \\ 0 \\ p
   \end{pmatrix},
   \qquad
   p =
   \begin{pmatrix}
     \bar x E \\ \bar x\bar p\sin\theta \\ \bar x\bar p\cos\theta
   \end{pmatrix},
   \qquad
   q =
   \begin{pmatrix}
     x E \\ -\bar x\bar p\sin\theta \\ p - \bar x\bar p\cos\theta
   \end{pmatrix},
 \end{equation}
 where the first two mass-shell conditions are
 \begin{equation}
   p^2 = E^2 - s,
   \qquad
   \bar p^2 = E^2 - \frac{u}{\bar x^2}.
 \end{equation}
 The second condition implies that, for positive $u$, $\bar x^2 >
 u/E^2$, or equivalently
 \begin{equation}
   x < 1 - \sqrt{u} / E.
 \end{equation}
 
 We are interested in the third mass-shell conditions: $s$ and $u$ are
 fixed, so we need $t$ as a function of $\cos\theta$:
 \begin{equation}
   t = -2\bar x \left(E^2 - p\bar p\cos\theta\right) + s + u.
 \end{equation}
 Solving for $\cos\theta$, we get
 \begin{equation}
   \cos\theta = \frac{2\bar x E^2 + t - s - u}{2\bar x p\bar p}.
 \end{equation}
 We can compute $\sin\theta$ numerically as
 $\sin^2\theta=1-\cos^2\theta$, but it is important to reexpress this
 in view of numerical stability.  To this end, we first determine the
 bounds for $t$.  The cosine must be between $-1$ and $1$, so the
 bounds are
 \begin{align}
   t_0 &= -2\bar x\left(E^2 + p\bar p\right) + s + u,
 \\
   t_1 &= -2\bar x\left(E^2 - p\bar p\right) + s + u.
 \end{align}
 Computing $\sin^2\theta$ from $\cos\theta$ above, we observe that the
 numerator is a quadratic polynomial in $t$ which has the zeros $t_0$
 and $t_1$, while the common denominator is given by $(2\bar x p\bar
 p)^2$.  Hence, we can write
 \begin{equation}
   \sin^2\theta = -\frac{(t - t_0)(t - t_1)}{(2\bar x p\bar p)^2}
   \qquad\text{and}\qquad
   \cos\theta = \frac{(t-t_0) + (t-t_1)}{4\bar x p\bar p},
 \end{equation}
 which is free of large cancellations near $t=t_0$ or $t=t_1$.
 
 If all is massless, i.e., $s=u=0$, this simplifies to
 \begin{align}
   t_0 &= -4\bar x E^2,
 &
   t_1 &= 0,
 \\
   \sin^2\theta &= -\frac{t}{\bar x E^2}
                    \left(1 + \frac{t}{4\bar x E^2}\right),
 &
   \cos\theta &= 1 + \frac{t}{2\bar x E^2}.
 \end{align}
 
 Here is the implementation.  First, we define a container for the
 kinematical integration limits and some further data.
 
 Note: contents are public only for easy access in unit test.
 <<SF aux: public>>=
   public :: splitting_data_t
 <<SF aux: types>>=
   type :: splitting_data_t
 !     private
      logical :: collinear = .false.
      real(default) :: x0 = 0
      real(default) :: x1
      real(default) :: t0
      real(default) :: t1
      real(default) :: phi0 = 0
      real(default) :: phi1 = twopi
      real(default) :: E, p, s, u, m2
      real(default) :: x, xb, pb
      real(default) :: t = 0
      real(default) :: phi = 0
    contains
    <<SF aux: splitting data: TBP>>
   end type splitting_data_t
 
 @ %def splitting_data_t
 @ I/O for debugging:
 <<SF aux: splitting data: TBP>>=
   procedure :: write => splitting_data_write
 <<SF aux: procedures>>=
   subroutine splitting_data_write (d, unit)
     class(splitting_data_t), intent(in) :: d
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(A)") "Splitting data:"
     write (u, "(2x,A,L1)")  "collinear = ", d%collinear
 1   format (2x,A,1x,ES15.8)
     write (u, 1) "x0   =", d%x0
     write (u, 1) "x    =", d%x
     write (u, 1) "xb   =", d%xb
     write (u, 1) "x1   =", d%x1
     write (u, 1) "t0   =", d%t0
     write (u, 1) "t    =", d%t
     write (u, 1) "t1   =", d%t1
     write (u, 1) "phi0 =", d%phi0
     write (u, 1) "phi  =", d%phi
     write (u, 1) "phi1 =", d%phi1
     write (u, 1) "E    =", d%E
     write (u, 1) "p    =", d%p
     write (u, 1) "pb   =", d%pb
     write (u, 1) "s    =", d%s
     write (u, 1) "u    =", d%u
     write (u, 1) "m2   =", d%m2
   end subroutine splitting_data_write
 
 @ %def splitting_data_write
 @
 \subsection{Constant data}
 This is the initializer for the data.  The input consists of the
 incoming momentum, its invariant mass squared, and the invariant mass
 squared of the radiated particle.  $m2$ is the \emph{physical} mass
 squared of the outgoing particle.  The $t$ bounds depend on the chosen $x$
 value and cannot be determined yet.
 <<SF aux: splitting data: TBP>>=
   procedure :: init => splitting_data_init
 <<SF aux: procedures>>=
   subroutine splitting_data_init (d, k, mk2, mr2, mo2, collinear)
     class(splitting_data_t), intent(out) :: d
     type(vector4_t), intent(in) :: k
     real(default), intent(in) :: mk2, mr2, mo2
     logical, intent(in), optional :: collinear
     if (present (collinear))  d%collinear = collinear
     d%E = energy (k)
     d%x1 = 1 - sqrt (max (mr2, 0._default)) / d%E
     d%p = sqrt (d%E**2 - mk2)
     d%s = mk2
     d%u = mr2
     d%m2 = mo2
   end subroutine splitting_data_init
 
 @ %def splitting_data_init
 @ Retrieve the $x$ bounds, if needed for $x$ sampling.  Generating an
 $x$ value is done by the caller, since this is the part that depends
 on the nature of the structure function.
 <<SF aux: splitting data: TBP>>=
   procedure :: get_x_bounds => splitting_get_x_bounds
 <<SF aux: procedures>>=
   function splitting_get_x_bounds (d) result (x)
     class(splitting_data_t), intent(in) :: d
     real(default), dimension(2) :: x
     x = [ d%x0, d%x1 ]
   end function splitting_get_x_bounds
 
 @ %def splitting_get_x_bounds
 @ Now set the momentum fraction and compute $t_0$ and $t_1$.
 
 [The calculation of $t_1$ is subject to numerical problems.  The exact
 formula is ($s=m_i^2$, $u=m_r^2$)
 \begin{equation}
   t_1 = -2\bar x E^2 + m_i^2 + m_r^2
   + 2\bar x \sqrt{E^2-m_i^2}\,\sqrt{E^2 - m_r^2/\bar x^2}.
 \end{equation}
 The structure-function paradigm is useful only if $E\gg m_i,m_r$.  In
 a Taylor expansion for large $E$, the leading term cancels.  The
 expansion of the square roots (to subleading order) yields
 \begin{equation}
   t_1 = xm_i^2 - \frac{x}{\bar x}m_r^2.
 \end{equation}
 There are two cases of interest: $m_i=m_o$ and $m_r=0$,
 \begin{equation}
   t_1 = xm_o^2
 \end{equation}
 and $m_i=m_r$ and $m_o=0$,
 \begin{equation}
   t_1 = -\frac{x^2}{\bar x}m_i^2.
 \end{equation}
 In both cases, $t_1\leq m_o^2$.]
 
 That said, it turns out that taking the $t_1$ evaluation at face value
 leads to less problems than the approximation.  We express the angles
 in terms of $t-t_0$ and $t-t_1$.  Numerical noise in $t_1$ can then be
 tolerated.
 <<SF aux: splitting data: TBP>>=
   procedure :: set_t_bounds => splitting_set_t_bounds
 <<SF aux: procedures>>=
   elemental subroutine splitting_set_t_bounds (d, x, xb)
     class(splitting_data_t), intent(inout) :: d
     real(default), intent(in), optional :: x, xb
     real(default) :: tp, tm
     if (present (x))  d%x = x
     if (present (xb)) d%xb = xb
     if (vanishes (d%u)) then
        d%pb = d%E
     else
        if (.not. vanishes (d%xb)) then
           d%pb = sqrt (max (d%E**2 - d%u / d%xb**2, 0._default))
        else
           d%pb = 0
        end if
     end if
     tp = -2 * d%xb * d%E**2 + d%s + d%u
     tm = -2 * d%xb * d%p * d%pb
     d%t0 = tp + tm
     d%t1 = tp - tm
     d%t = d%t1
   end subroutine splitting_set_t_bounds
 
 @ %def splitting_set_t_bounds
 @
 \subsection{Sampling recoil}
 Compute a value for the momentum transfer $t$, using a random number
 $r$.  We assume a logarithmic distribution for $t-m^2$, corresponding
 to the propagator $1/(t-m^2)$ with the physical mass $m$ for the
 outgoing particle.  Optionally, we can narrow the kinematical bounds.
 
 If all three masses in the splitting vanish, the upper limit for $t$
 is zero.  In that case, the $t$ value is set to zero and the splitting
 will be collinear.
 <<SF aux: splitting data: TBP>>=
   procedure :: sample_t => splitting_sample_t
 <<SF aux: procedures>>=
   subroutine splitting_sample_t (d, r, t0, t1)
     class(splitting_data_t), intent(inout) :: d
     real(default), intent(in) :: r
     real(default), intent(in), optional :: t0, t1
     real(default) :: tt0, tt1, tt0m, tt1m
     if (d%collinear) then
        d%t = d%t1
     else
        tt0 = d%t0;  if (present (t0))  tt0 = max (t0, tt0)
        tt1 = d%t1;  if (present (t1))  tt1 = min (t1, tt1)
        tt0m = tt0 - d%m2
        tt1m = tt1 - d%m2
        if (tt0m < 0 .and. tt1m < 0 .and. abs(tt0m) > &
             epsilon(tt0m) .and. abs(tt1m) > epsilon(tt0m)) then
           d%t = d%m2 + tt0m * exp (r * log (tt1m / tt0m))
        else
           d%t = tt1
        end if
     end if
   end subroutine splitting_sample_t
 
 @ %def splitting_sample_t
 @ The inverse operation: Given $t$, we recover the value of $r$ that
 would have produced this value.
 <<SF aux: splitting data: TBP>>=
   procedure :: inverse_t => splitting_inverse_t
 <<SF aux: procedures>>=
   subroutine splitting_inverse_t (d, r, t0, t1)
     class(splitting_data_t), intent(in) :: d
     real(default), intent(out) :: r
     real(default), intent(in), optional :: t0, t1
     real(default) :: tt0, tt1, tt0m, tt1m
     if (d%collinear) then
        r = 0
     else
        tt0 = d%t0;  if (present (t0))  tt0 = max (t0, tt0)
        tt1 = d%t1;  if (present (t1))  tt1 = min (t1, tt1)
        tt0m = tt0 - d%m2
        tt1m = tt1 - d%m2
        if (tt0m < 0 .and. tt1m < 0) then
           r = log ((d%t - d%m2) / tt0m) / log (tt1m / tt0m)
        else
           r = 0
        end if
     end if
   end subroutine splitting_inverse_t
 
 @ %def splitting_inverse_t
 @ This is trivial, but provided for convenience:
 <<SF aux: splitting data: TBP>>=
   procedure :: sample_phi => splitting_sample_phi
 <<SF aux: procedures>>=
   subroutine splitting_sample_phi (d, r)
     class(splitting_data_t), intent(inout) :: d
     real(default), intent(in) :: r
     if (d%collinear) then
        d%phi = 0
     else
        d%phi = (1-r) * d%phi0 + r * d%phi1
     end if
   end subroutine splitting_sample_phi
 
 @ %def splitting_sample_phi
 @ Inverse:
 <<SF aux: splitting data: TBP>>=
   procedure :: inverse_phi => splitting_inverse_phi
 <<SF aux: procedures>>=
   subroutine splitting_inverse_phi (d, r)
     class(splitting_data_t), intent(in) :: d
     real(default), intent(out) :: r
     if (d%collinear) then
        r = 0
     else
        r = (d%phi - d%phi0) / (d%phi1 - d%phi0)
     end if
   end subroutine splitting_inverse_phi
 
 @ %def splitting_inverse_phi
 @
 \subsection{Splitting}
 In this function, we actually perform the splitting.  The incoming momentum
 $k$ is split into (if no recoil) $q_1=(1-x)k$ and $q_2=xk$.
 
 Apart from the splitting data, we need the incoming momentum $k$, the momentum
 transfer $t$, and the azimuthal angle $\phi$.  The momentum fraction $x$ is
 already known here.
 
 Alternatively, we can split without recoil.  The azimuthal angle is
 irrelevant, and the momentum transfer is always equal to the upper
 limit $t_1$, so the polar angle is zero.  Obviously, if there are
 nonzero masses it is not possible to keep both energy-momentum
 conservation and at the same time all particles on shell.  We choose
 for dropping the on-shell condition here.
 <<SF aux: splitting data: TBP>>=
   procedure :: split_momentum => splitting_split_momentum
 <<SF aux: procedures>>=
   function splitting_split_momentum (d, k) result (q)
     class(splitting_data_t), intent(in) :: d
     type(vector4_t), dimension(2) :: q
     type(vector4_t), intent(in) :: k
     real(default) :: st2, ct2, st, ct, cp, sp
     type(lorentz_transformation_t) :: rot
     real(default) :: tt0, tt1, den
     type(vector3_t) :: kk, q1, q2
     if (d%collinear) then
        if (vanishes (d%s) .and. vanishes(d%u)) then
           q(1) = d%xb * k
           q(2) = d%x * k
        else
           kk = space_part (k)
           q1 = d%xb * (d%pb / d%p) * kk
           q2 = kk - q1
           q(1) = vector4_moving (d%xb * d%E, q1)
           q(2) = vector4_moving (d%x * d%E, q2)
        end if
     else
        den = 2 * d%xb * d%p * d%pb
        tt0 = max (d%t - d%t0, 0._default)
        tt1 = min (d%t - d%t1, 0._default)
        if (den**2 <= epsilon(den)) then
           st2 = 0
        else
           st2 = - (tt0 * tt1) / den ** 2
        end if
        if (st2 > 1) then
           st2 = 1
        end if
        ct2 = 1 - st2
        st = sqrt (max (st2, 0._default))
        ct = sqrt (max (ct2, 0._default))
        if ((d%t - d%t0 + d%t - d%t1) < 0) then
           ct = - ct
        end if
        sp = sin (d%phi)
        cp = cos (d%phi)
        rot = rotation_to_2nd (3, space_part (k))
        q1 = vector3_moving (d%xb * d%pb * [st * cp, st * sp, ct])
        q2 = vector3_moving (d%p, 3) - q1
        q(1) = rot * vector4_moving (d%xb * d%E, q1)
        q(2) = rot * vector4_moving (d%x * d%E, q2)
     end if
   end function splitting_split_momentum
 
 @ %def splitting_split_momentum
 @
 Momenta generated by splitting will in general be off-shell.  They are
 on-shell only if they are collinear and massless.  This subroutine
 puts them on shell by brute force, violating either momentum or energy
 conservation.  The direction of three-momentum is always retained.
 
 If the energy is below mass shell, we return a zero momentum.
 <<SF aux: parameters>>=
   integer, parameter, public :: KEEP_ENERGY = 0, KEEP_MOMENTUM = 1
 @ %def KEEP_ENERGY KEEP_MOMENTUM
 <<SF aux: public>>=
   public :: on_shell
 <<SF aux: procedures>>=
   elemental subroutine on_shell (p, m2, keep)
     type(vector4_t), intent(inout) :: p
     real(default), intent(in) :: m2
     integer, intent(in) :: keep
     real(default) :: E, E2, pn
     select case (keep)
     case (KEEP_ENERGY)
        E = energy (p)
        E2 = E ** 2
        if (E2 >= m2) then
           pn = sqrt (E2 - m2)
           p = vector4_moving (E, pn * direction (space_part (p)))
        else
           p = vector4_null
        end if
     case (KEEP_MOMENTUM)
        E = sqrt (space_part (p) ** 2 + m2)
        p = vector4_moving (E, space_part (p))
     end select
   end subroutine on_shell
 
 @ %def on_shell
 @
 \subsection{Recovering the splitting}
 This is the inverse problem.  We have on-shell momenta and want to
 deduce the splitting parameters $x$, $t$, and $\phi$.
 
 Update 2018-08-22: As a true inverse to [[splitting_split_momentum]], we now use
 not just a single momentum [[q2]] as before, but the momentum pair [[q1]], [[q2]]
 for recovering $x$ and $\bar x$ separately.  If $x$ happens to be
 close to $1$, we would completely lose the tiny $\bar x$ value,
 otherwise, and thus get a meaningless result.
 <<SF aux: splitting data: TBP>>=
   procedure :: recover => splitting_recover
 <<SF aux: procedures>>=
   subroutine splitting_recover (d, k, q, keep)
     class(splitting_data_t), intent(inout) :: d
     type(vector4_t), intent(in) :: k
     type(vector4_t), dimension(2), intent(in) :: q
     integer, intent(in) :: keep
     type(lorentz_transformation_t) :: rot
     type(vector4_t) :: k0
     type(vector4_t), dimension(2) :: q0
     real(default) :: p1, p2, p3, pt2, pp2, pl
     real(default) :: aux, den, norm
     real(default) :: st2, ct2, ct
     rot = inverse (rotation_to_2nd (3, space_part (k)))
     q0 = rot * q
     p1 = vector4_get_component (q0(2), 1)
     p2 = vector4_get_component (q0(2), 2)
     p3 = vector4_get_component (q0(2), 3)
     pt2 = p1 ** 2 + p2 ** 2
     pp2 = p1 ** 2 + p2 ** 2 + p3 ** 2
     pl = abs (p3)
     k0 = vector4_moving (d%E, d%p, 3)
     select case (keep)
     case (KEEP_ENERGY)
        d%x = energy (q0(2)) / d%E
        d%xb = energy (q0(1)) / d%E
        call d%set_t_bounds ()
        if (.not. d%collinear) then
           aux = (d%xb * d%pb) ** 2 * pp2 - d%p ** 2 * pt2
           den = d%p ** 2 - (d%xb * d%pb) ** 2
           if (aux >= 0 .and. den > 0) then
              norm = (d%p * pl + sqrt (aux)) / den
           else
              norm = 1
           end if
        end if
     case (KEEP_MOMENTUM)
        d%xb = sqrt (space_part (q0(1)) ** 2 + d%u) / d%E
        d%x = 1 - d%xb
        call d%set_t_bounds ()
        norm = 1
     end select
     if (d%collinear) then
        d%t = d%t1
        d%phi = 0
     else
        if ((d%xb * d%pb * norm)**2 < epsilon(d%xb)) then
           st2 = 1
        else
           st2 = pt2 / (d%xb * d%pb * norm ) ** 2
        end if
        if (st2 > 1) then
           st2 = 1
        end if
        ct2 = 1 - st2
        ct = sqrt (max (ct2, 0._default))
        if (.not. vanishes (1 + ct)) then
           d%t = d%t1 - 2 * d%xb * d%p * d%pb * st2 / (1 + ct)
        else
           d%t = d%t0
        end if
        if (.not. vanishes (p1) .or. .not. vanishes (p2)) then
           d%phi = atan2 (-p2, -p1)
        else
           d%phi = 0
        end if
     end if
   end subroutine splitting_recover
 
 @ %def splitting_recover
 @
 \subsection{Extract data}
 <<SF aux: splitting data: TBP>>=
   procedure :: get_x => splitting_get_x
   procedure :: get_xb => splitting_get_xb
 <<SF aux: procedures>>=
   function splitting_get_x (sd) result (x)
     class(splitting_data_t), intent(in) :: sd
     real(default) :: x
     x = sd%x
   end function splitting_get_x
 
   function splitting_get_xb (sd) result (xb)
     class(splitting_data_t), intent(in) :: sd
     real(default) :: xb
     xb = sd%xb
   end function splitting_get_xb
 
 @ %def splitting_get_x
 @ %def splitting_get_xb
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_aux_ut.f90]]>>=
 <<File header>>
 
 module sf_aux_ut
   use unit_tests
   use sf_aux_uti
 
 <<Standard module head>>
 
 <<SF aux: public test>>
 
 contains
 
 <<SF aux: test driver>>
 
 end module sf_aux_ut
 @ %def sf_aux_ut
 @
 <<[[sf_aux_uti.f90]]>>=
 <<File header>>
 
 module sf_aux_uti
 
 <<Use kinds>>
   use lorentz
 
   use sf_aux
 
 <<Standard module head>>
 
 <<SF aux: test declarations>>
 
 contains
 
 <<SF aux: tests>>
 
 end module sf_aux_uti
 @ %def sf_aux_ut
 @ API: driver for the unit tests below.
 <<SF aux: public test>>=
   public :: sf_aux_test
 <<SF aux: test driver>>=
   subroutine sf_aux_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF aux: execute tests>>
   end subroutine sf_aux_test
 
 @ %def sf_aux_test
 @
 \subsubsection{Momentum splitting: massless radiation}
 Compute momentum splitting for generic kinematics.  It turns out that
 for $x=0.5$, where $t-m^2$ is the geometric mean between its upper and
 lower bounds (this can be directly seen from the logarithmic
 distribution in the function [[sample_t]] for $r \equiv x = 1 - x =
 0.5$), we arrive at an exact number $t=-0.15$ for the given
 input values.
 <<SF aux: execute tests>>=
   call test (sf_aux_1, "sf_aux_1", &
        "massless radiation", &
        u, results)
 <<SF aux: test declarations>>=
   public :: sf_aux_1
 <<SF aux: tests>>=
   subroutine sf_aux_1 (u)
     integer, intent(in) :: u
     type(splitting_data_t) :: sd
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q, q0
     real(default) :: E, mk, mp, mq
     real(default) :: x, r1, r2, r1o, r2o
     real(default) :: k2, q0_2, q1_2, q2_2
 
     write (u, "(A)")  "* Test output: sf_aux_1"
     write (u, "(A)")  "*   Purpose: compute momentum splitting"
     write (u, "(A)")  "             (massless radiated particle)"
     write (u, "(A)")
 
     E = 1
     mk = 0.3_default
     mp = 0
     mq = mk
 
     k = vector4_moving (E, sqrt (E**2 - mk**2), 3)
     k2 = k ** 2;  call pacify (k2, 1e-10_default)
 
     x = 0.6_default
     r1 = 0.5_default
     r2 = 0.125_default
 
     write (u, "(A)")  "* (1) Non-collinear setup"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%set_t_bounds (x, 1 - x)
     call sd%sample_t (r1)
     call sd%sample_phi (r2)
 
     call sd%write (u)
 
     q = sd%split_momentum (k)
     q1_2 = q(1) ** 2;  call pacify (q1_2, 1e-10_default)
     q2_2 = q(2) ** 2;  call pacify (q2_2, 1e-10_default)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: s"
     write (u, "(2(1x,F11.8))")  sd%s, k2
 
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  sd%t, q2_2
 
     write (u, "(A)")  "Compare: u"
     write (u, "(2(1x,F11.8))")  sd%u, q1_2
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  sd%x, energy (q(2)) / energy (k)
 
     write (u, "(A)")  "Compare: 1-x"
     write (u, "(2(1x,F11.8))")  sd%xb, energy (q(1)) / energy (k)
 
     write (u, "(A)")
     write (u, "(A)")  "Extract: x, 1-x"
     write (u, "(2(1x,F11.8))")  sd%get_x (), sd%get_xb ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep energy)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q0_2 = q0(2) ** 2;  call pacify (q0_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q0_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%recover (k, q0, KEEP_ENERGY)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
 
     call sd%inverse_t (r1o)
 
     write (u, "(A)")  "Compare: r1"
     write (u, "(2(1x,F11.8))")  r1, r1o
 
     call sd%inverse_phi (r2o)
 
     write (u, "(A)")  "Compare: r2"
     write (u, "(2(1x,F11.8))")  r2, r2o
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep momentum)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q0_2 = q0(2) ** 2;  call pacify (q0_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q0_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%recover (k, q0, KEEP_MOMENTUM)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
     call sd%inverse_t (r1o)
 
     write (u, "(A)")  "Compare: r1"
     write (u, "(2(1x,F11.8))")  r1, r1o
 
     call sd%inverse_phi (r2o)
 
     write (u, "(A)")  "Compare: r2"
     write (u, "(2(1x,F11.8))")  r2, r2o
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* (2) Collinear setup"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
     call sd%set_t_bounds (x, 1 - x)
 
     call sd%write (u)
 
     q = sd%split_momentum (k)
     q1_2 = q(1) ** 2;  call pacify (q1_2, 1e-10_default)
     q2_2 = q(2) ** 2;  call pacify (q2_2, 1e-10_default)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: s"
     write (u, "(2(1x,F11.8))")  sd%s, k2
 
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  sd%t, q2_2
 
     write (u, "(A)")  "Compare: u"
     write (u, "(2(1x,F11.8))")  sd%u, q1_2
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  sd%x, energy (q(2)) / energy (k)
 
     write (u, "(A)")  "Compare: 1-x"
     write (u, "(2(1x,F11.8))")  sd%xb, energy (q(1)) / energy (k)
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep energy)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q0_2 = q0(2) ** 2;  call pacify (q0_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q0_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%recover (k, q0, KEEP_ENERGY)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep momentum)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q0_2 = q0(2) ** 2;  call pacify (q0_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q0_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%recover (k, q0, KEEP_MOMENTUM)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_aux_1"
 
   end subroutine sf_aux_1
 
 @ %def sf_aux_1
 @
 \subsubsection{Momentum splitting: massless parton}
 Compute momentum splitting for generic kinematics.  It turns out that
 for $x=0.5$, where $t-m^2$ is the geometric mean between its upper and
 lower bounds, we arrive at an exact number $t=-0.36$ for the given
 input values.
 <<SF aux: execute tests>>=
   call test (sf_aux_2, "sf_aux_2", &
        "massless parton", &
        u, results)
 <<SF aux: test declarations>>=
   public :: sf_aux_2
 <<SF aux: tests>>=
   subroutine sf_aux_2 (u)
     integer, intent(in) :: u
     type(splitting_data_t) :: sd
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q, q0
     real(default) :: E, mk, mp, mq
     real(default) :: x, r1, r2, r1o, r2o
     real(default) :: k2, q02_2, q1_2, q2_2
 
     write (u, "(A)")  "* Test output: sf_aux_2"
     write (u, "(A)")  "*   Purpose: compute momentum splitting"
     write (u, "(A)")  "             (massless outgoing particle)"
     write (u, "(A)")
 
     E = 1
     mk = 0.3_default
     mp = mk
     mq = 0
 
     k = vector4_moving (E, sqrt (E**2 - mk**2), 3)
     k2 = k ** 2;  call pacify (k2, 1e-10_default)
 
     x = 0.6_default
     r1 = 0.5_default
     r2 = 0.125_default
 
     write (u, "(A)")  "* (1) Non-collinear setup"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%set_t_bounds (x, 1 - x)
     call sd%sample_t (r1)
     call sd%sample_phi (r2)
 
     call sd%write (u)
 
     q = sd%split_momentum (k)
     q1_2 = q(1) ** 2;  call pacify (q1_2, 1e-10_default)
     q2_2 = q(2) ** 2;  call pacify (q2_2, 1e-10_default)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: s"
     write (u, "(2(1x,F11.8))")  sd%s, k2
 
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  sd%t, q2_2
 
     write (u, "(A)")  "Compare: u"
     write (u, "(2(1x,F11.8))")  sd%u, q1_2
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  sd%x, energy (q(2)) / energy (k)
 
     write (u, "(A)")  "Compare: 1-x"
     write (u, "(2(1x,F11.8))")  sd%xb, energy (q(1)) / energy (k)
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep energy)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q02_2 = q0(2) ** 2;  call pacify (q02_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q02_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%set_t_bounds (x, 1 - x)
     call sd%recover (k, q0, KEEP_ENERGY)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
 
     call sd%inverse_t (r1o)
 
     write (u, "(A)")  "Compare: r1"
     write (u, "(2(1x,F11.8))")  r1, r1o
 
     call sd%inverse_phi (r2o)
 
     write (u, "(A)")  "Compare: r2"
     write (u, "(2(1x,F11.8))")  r2, r2o
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep momentum)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q02_2 = q0(2) ** 2;  call pacify (q02_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q02_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%set_t_bounds (x, 1 - x)
     call sd%recover (k, q0, KEEP_MOMENTUM)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
     call sd%inverse_t (r1o)
 
     write (u, "(A)")  "Compare: r1"
     write (u, "(2(1x,F11.8))")  r1, r1o
 
     call sd%inverse_phi (r2o)
 
     write (u, "(A)")  "Compare: r2"
     write (u, "(2(1x,F11.8))")  r2, r2o
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* (2) Collinear setup"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
     call sd%set_t_bounds (x, 1 - x)
 
     call sd%write (u)
 
     q = sd%split_momentum (k)
     q1_2 = q(1) ** 2;  call pacify (q1_2, 1e-10_default)
     q2_2 = q(2) ** 2;  call pacify (q2_2, 1e-10_default)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: s"
     write (u, "(2(1x,F11.8))")  sd%s, k2
 
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  sd%t, q2_2
 
     write (u, "(A)")  "Compare: u"
     write (u, "(2(1x,F11.8))")  sd%u, q1_2
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  sd%x, energy (q(2)) / energy (k)
 
     write (u, "(A)")  "Compare: 1-x"
     write (u, "(2(1x,F11.8))")  sd%xb, energy (q(1)) / energy (k)
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep energy)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q02_2 = q0(2) ** 2;  call pacify (q02_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q02_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%set_t_bounds (x, 1 - x)
     call sd%recover (k, q0, KEEP_ENERGY)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep momentum)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q02_2 = q0(2) ** 2;  call pacify (q02_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q02_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%set_t_bounds (x, 1 - x)
     call sd%recover (k, q0, KEEP_MOMENTUM)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_aux_2"
 
   end subroutine sf_aux_2
 
 @ %def sf_aux_2
 @
 \subsubsection{Momentum splitting: all massless}
 Compute momentum splitting for massless kinematics.  In the non-collinear
 case, we need a lower cutoff for $|t|$, otherwise a logarithmic distribution
 is not possible.
 <<SF aux: execute tests>>=
   call test (sf_aux_3, "sf_aux_3", &
        "massless parton", &
        u, results)
 <<SF aux: test declarations>>=
   public :: sf_aux_3
 <<SF aux: tests>>=
   subroutine sf_aux_3 (u)
     integer, intent(in) :: u
     type(splitting_data_t) :: sd
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q, q0
     real(default) :: E, mk, mp, mq, qmin, qmax
     real(default) :: x, r1, r2, r1o, r2o
     real(default) :: k2, q02_2, q1_2, q2_2
 
     write (u, "(A)")  "* Test output: sf_aux_3"
     write (u, "(A)")  "*   Purpose: compute momentum splitting"
     write (u, "(A)")  "             (all massless, q cuts)"
     write (u, "(A)")
 
     E = 1
     mk = 0
     mp = 0
     mq = 0
     qmin = 1e-2_default
     qmax = 1e0_default
 
     k = vector4_moving (E, sqrt (E**2 - mk**2), 3)
     k2 = k ** 2;  call pacify (k2, 1e-10_default)
 
     x = 0.6_default
     r1 = 0.5_default
     r2 = 0.125_default
 
     write (u, "(A)")  "* (1) Non-collinear setup"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%set_t_bounds (x, 1 - x)
     call sd%sample_t (r1, t1 = - qmin ** 2, t0 = - qmax **2)
     call sd%sample_phi (r2)
 
     call sd%write (u)
 
     q = sd%split_momentum (k)
     q1_2 = q(1) ** 2;  call pacify (q1_2, 1e-10_default)
     q2_2 = q(2) ** 2;  call pacify (q2_2, 1e-10_default)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: s"
     write (u, "(2(1x,F11.8))")  sd%s, k2
 
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  sd%t, q2_2
 
     write (u, "(A)")  "Compare: u"
     write (u, "(2(1x,F11.8))")  sd%u, q1_2
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  sd%x, energy (q(2)) / energy (k)
 
     write (u, "(A)")  "Compare: 1-x"
     write (u, "(2(1x,F11.8))")  sd%xb, energy (q(1)) / energy (k)
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep energy)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q02_2 = q0(2) ** 2;  call pacify (q02_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q02_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%set_t_bounds (x, 1 - x)
     call sd%recover (k, q0, KEEP_ENERGY)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
 
     call sd%inverse_t (r1o, t1 = - qmin ** 2, t0 = - qmax **2)
 
     write (u, "(A)")  "Compare: r1"
     write (u, "(2(1x,F11.8))")  r1, r1o
 
     call sd%inverse_phi (r2o)
 
     write (u, "(A)")  "Compare: r2"
     write (u, "(2(1x,F11.8))")  r2, r2o
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep momentum)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q02_2 = q0(2) ** 2;  call pacify (q02_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q02_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%set_t_bounds (x, 1 - x)
     call sd%recover (k, q0, KEEP_MOMENTUM)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
     call sd%inverse_t (r1o, t1 = - qmin ** 2, t0 = - qmax **2)
 
     write (u, "(A)")  "Compare: r1"
     write (u, "(2(1x,F11.8))")  r1, r1o
 
     call sd%inverse_phi (r2o)
 
     write (u, "(A)")  "Compare: r2"
     write (u, "(2(1x,F11.8))")  r2, r2o
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* (2) Collinear setup"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
     call sd%set_t_bounds (x, 1 - x)
 
     call sd%write (u)
 
     q = sd%split_momentum (k)
     q1_2 = q(1) ** 2;  call pacify (q1_2, 1e-10_default)
     q2_2 = q(2) ** 2;  call pacify (q2_2, 1e-10_default)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: s"
     write (u, "(2(1x,F11.8))")  sd%s, k2
 
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  sd%t, q2_2
 
     write (u, "(A)")  "Compare: u"
     write (u, "(2(1x,F11.8))")  sd%u, q1_2
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  sd%x, energy (q(2)) / energy (k)
 
     write (u, "(A)")  "Compare: 1-x"
     write (u, "(2(1x,F11.8))")  sd%xb, energy (q(1)) / energy (k)
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep energy)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_ENERGY)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q02_2 = q0(2) ** 2;  call pacify (q02_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q02_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%set_t_bounds (x, 1 - x)
     call sd%recover (k, q0, KEEP_ENERGY)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Project on-shell (keep momentum)"
 
     q0 = q
     call on_shell (q0, [mp**2, mq**2], KEEP_MOMENTUM)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q0), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q0(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q0(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "Compare: mo^2"
     q02_2 = q0(2) ** 2;  call pacify (q02_2, 1e-10_default)
     write (u, "(2(1x,F11.8))")  sd%m2, q02_2
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momentum"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2)
     call sd%set_t_bounds (x, 1 - x)
     call sd%recover (k, q0, KEEP_MOMENTUM)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
     write (u, "(A)")  "Compare: t"
     write (u, "(2(1x,F11.8))")  q2_2, sd%t
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_aux_3"
 
   end subroutine sf_aux_3
 
 @ %def sf_aux_3
 @
 \subsubsection{Endpoint stability}
 Compute momentum splitting for collinear kinematics close to both
 endpoints.  In particular, check both directions $x\to$ momenta and
 momenta $\to x$.
 
 For purely massless collinear splitting, the [[KEEP_XXX]] flag is
 irrelevant.  We choose [[KEEP_ENERGY]] here.
 <<SF aux: execute tests>>=
   call test (sf_aux_4, "sf_aux_4", &
        "endpoint numerics", &
        u, results)
 <<SF aux: test declarations>>=
   public :: sf_aux_4
 <<SF aux: tests>>=
   subroutine sf_aux_4 (u)
     integer, intent(in) :: u
     type(splitting_data_t) :: sd
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E, mk, mp, mq, qmin, qmax
     real(default) :: x, xb
 
     write (u, "(A)")  "* Test output: sf_aux_4"
     write (u, "(A)")  "*   Purpose: compute massless collinear splitting near endpoint"
 
     E = 1
     mk = 0
     mp = 0
     mq = 0
     qmin = 1e-2_default
     qmax = 1e0_default
 
     k = vector4_moving (E, sqrt (E**2 - mk**2), 3)
 
     x = 0.1_default
     xb = 1 - x
 
     write (u, "(A)")
     write (u, "(A)")  "* (1) Collinear setup, moderate kinematics"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
     call sd%set_t_bounds (x, xb)
 
     call sd%write (u)
 
     q = sd%split_momentum (k)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momenta"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
     call sd%set_t_bounds (x, xb)
     call sd%recover (k, q, KEEP_ENERGY)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
 
     write (u, "(A)")  "Compare: 1-x"
     write (u, "(2(1x,F11.8))")  xb, sd%xb
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* (2) Close to x=0"
     write (u, "(A)")
 
     x = 1e-9_default
     xb = 1 - x
 
     call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
     call sd%set_t_bounds (x, xb)
 
     call sd%write (u)
 
     q = sd%split_momentum (k)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momenta"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
     call sd%set_t_bounds (x, xb)
     call sd%recover (k, q, KEEP_ENERGY)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
 
     write (u, "(A)")  "Compare: 1-x"
     write (u, "(2(1x,F11.8))")  xb, sd%xb
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* (3) Close to x=1"
     write (u, "(A)")
 
     xb = 1e-9_default
     x = 1 - xb
 
     call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
     call sd%set_t_bounds (x, xb)
 
     call sd%write (u)
 
     q = sd%split_momentum (k)
 
     write (u, "(A)")
     write (u, "(A)")  "Incoming momentum k ="
     call vector4_write (k, u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum sum p + q ="
     call vector4_write (sum (q), u)
     write (u, "(A)")
     write (u, "(A)")  "Radiated momentum p ="
     call vector4_write (q(1), u)
     write (u, "(A)")
     write (u, "(A)")  "Outgoing momentum q ="
     call vector4_write (q(2), u)
     write (u, "(A)")
 
     write (u, "(A)")  "* Recover parameters from outgoing momenta"
     write (u, "(A)")
 
     call sd%init (k, mk**2, mp**2, mq**2, collinear = .true.)
     call sd%set_t_bounds (x, xb)
     call sd%recover (k, q, KEEP_ENERGY)
 
     write (u, "(A)")  "Compare: x"
     write (u, "(2(1x,F11.8))")  x, sd%x
 
     write (u, "(A)")  "Compare: 1-x"
     write (u, "(2(1x,F11.8))")  xb, sd%xb
 
     write (u, "(A)")
     call sd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_aux_4"
 
   end subroutine sf_aux_4
 
 @ %def sf_aux_4
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Mappings for structure functions}
 In this module, we provide a wrapper for useful mappings of the unit
 (hyper-)square that we can apply to a set of structure functions.
 
 In some cases it is useful, or even mandatory, to map the MC input
 parameters nontrivially onto a set of structure functions for the two
 beams.  In all cases considered here, instead of $x_1,x_2,\ldots$ as
 parameters for the beams, we generate one parameter that is equal, or
 related to, the product $x_1x_2\cdots$ (so it directly corresponds to
 $\sqrt{s}$).  The other parameters describe the distribution of energy
 (loss) between beams and radiations.
 <<[[sf_mappings.f90]]>>=
 <<File header>>
 
 module sf_mappings
 
 <<Use kinds>>
   use kinds, only: double
   use io_units
   use constants, only: pi, zero, one
   use numeric_utils
   use diagnostics
 
 <<Standard module head>>
 
 <<SF mappings: public>>
 
 <<SF mappings: parameters>>
 
 <<SF mappings: types>>
 
 <<SF mappings: interfaces>>
 
 contains
 
 <<SF mappings: procedures>>
 
 end module sf_mappings
 @ %def sf_mappings
 @
 \subsection{Base type}
 First, we define an abstract base type for the mapping.  In all cases
 we need to store the indices of the parameters on which the mapping
 applies.   Additional parameters can be stored in the extensions of
 this type.
 <<SF mappings: public>>=
   public :: sf_mapping_t
 <<SF mappings: types>>=
   type, abstract :: sf_mapping_t
      integer, dimension(:), allocatable :: i
    contains
    <<SF mappings: sf mapping: TBP>>
   end type sf_mapping_t
 
 @ %def sf_mapping_t
 @ The output routine is deferred:
 <<SF mappings: sf mapping: TBP>>=
   procedure (sf_mapping_write), deferred :: write
 <<SF mappings: interfaces>>=
   abstract interface
      subroutine sf_mapping_write (object, unit)
        import
        class(sf_mapping_t), intent(in) :: object
        integer, intent(in), optional :: unit
      end subroutine sf_mapping_write
   end interface
 
 @ %def sf_mapping_write
 @ Initializer for the base type.  The array of parameter indices is
 allocated but initialized to zero.
 <<SF mappings: sf mapping: TBP>>=
   procedure :: base_init => sf_mapping_base_init
 <<SF mappings: procedures>>=
   subroutine sf_mapping_base_init (mapping, n_par)
     class(sf_mapping_t), intent(out) :: mapping
     integer, intent(in) :: n_par
     allocate (mapping%i (n_par))
     mapping%i = 0
   end subroutine sf_mapping_base_init
 
 @ %def sf_mapping_base_init
 @ Set an index value.
 <<SF mappings: sf mapping: TBP>>=
   procedure :: set_index => sf_mapping_set_index
 <<SF mappings: procedures>>=
   subroutine sf_mapping_set_index (mapping, j, i)
     class(sf_mapping_t), intent(inout) :: mapping
     integer, intent(in) :: j, i
     mapping%i(j) = i
   end subroutine sf_mapping_set_index
 
 @ %def sf_mapping_set_index
 @ Retrieve an index value.
 <<SF mappings: sf mapping: TBP>>=
   procedure :: get_index => sf_mapping_get_index
 <<SF mappings: procedures>>=
   function sf_mapping_get_index (mapping, j) result (i)
     class(sf_mapping_t), intent(inout) :: mapping
     integer, intent(in) :: j
     integer :: i
     i = mapping%i(j)
   end function sf_mapping_get_index
 
 @ %def sf_mapping_get_index
 @ Return the dimensionality, i.e., the number of parameters.
 <<SF mappings: sf mapping: TBP>>=
   procedure :: get_n_dim => sf_mapping_get_n_dim
 <<SF mappings: procedures>>=
   function sf_mapping_get_n_dim (mapping) result (n)
     class(sf_mapping_t), intent(in) :: mapping
     integer :: n
     n = size (mapping%i)
   end function sf_mapping_get_n_dim
 
 @ %def sf_mapping_get_n_dim
 @ Computation: the values [[p]] are the input parameters, the values
 [[r]] are the output parameters.  The values [[rb]] are defined as
 $\bar r = 1 - r$, but provided explicitly.  They allow us to avoid
 numerical problems near $r=1$.
 
 The extra parameter [[x_free]]
 indicates that the total energy has already been renormalized by this
 factor.  We have to take such a factor into account in a resonance or
 on-shell mapping.
 
 The Jacobian is [[f]].  We modify only
 the two parameters indicated by the indices [[i]].
 <<SF mappings: sf mapping: TBP>>=
   procedure (sf_mapping_compute), deferred :: compute
 <<SF mappings: interfaces>>=
   abstract interface
      subroutine sf_mapping_compute (mapping, r, rb, f, p, pb, x_free)
        import
        class(sf_mapping_t), intent(inout) :: mapping
        real(default), dimension(:), intent(out) :: r, rb
        real(default), intent(out) :: f
        real(default), dimension(:), intent(in) :: p, pb
        real(default), intent(inout), optional :: x_free
      end subroutine sf_mapping_compute
   end interface
 
 @ %def sf_mapping_compute
 @ The inverse mapping.  Use [[r]] and/or [[rb]] to reconstruct [[p]]
 and also compute [[f]].
 <<SF mappings: sf mapping: TBP>>=
   procedure (sf_mapping_inverse), deferred :: inverse
 <<SF mappings: interfaces>>=
   abstract interface
      subroutine sf_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
        import
        class(sf_mapping_t), intent(inout) :: mapping
        real(default), dimension(:), intent(in) :: r, rb
        real(default), intent(out) :: f
        real(default), dimension(:), intent(out) :: p, pb
        real(default), intent(inout), optional :: x_free
      end subroutine sf_mapping_inverse
   end interface
 
 @ %def sf_mapping_inverse
 @
 \subsection{Methods for self-tests}
 This is a shorthand for: inject parameters, compute the mapping,
 display results, compute the inverse, display again.  We provide an
 output format for the parameters and, optionally, a different output
 format for the Jacobians.
 <<SF mappings: sf mapping: TBP>>=
   procedure :: check => sf_mapping_check
 <<SF mappings: procedures>>=
   subroutine sf_mapping_check (mapping, u, p_in, pb_in, fmt_p, fmt_f)
     class(sf_mapping_t), intent(inout) :: mapping
     integer, intent(in) :: u
     real(default), dimension(:), intent(in) :: p_in, pb_in
     character(*), intent(in) :: fmt_p
     character(*), intent(in), optional :: fmt_f
     real(default), dimension(size(p_in)) :: p, pb, r, rb
     real(default) :: f, tolerance
     tolerance = 1.5E-17
     p = p_in
     pb= pb_in
     call mapping%compute (r, rb, f, p, pb)
     call pacify (p, tolerance)
     call pacify (pb, tolerance)
     call pacify (r, tolerance)
     call pacify (rb, tolerance)
     write (u, "(3x,A,9(1x," // fmt_p // "))")  "p =", p
     write (u, "(3x,A,9(1x," // fmt_p // "))")  "pb=", pb
     write (u, "(3x,A,9(1x," // fmt_p // "))")  "r =", r
     write (u, "(3x,A,9(1x," // fmt_p // "))")  "rb=", rb
     if (present (fmt_f)) then
        write (u, "(3x,A,9(1x," // fmt_f // "))")  "f =", f
     else
        write (u, "(3x,A,9(1x," // fmt_p // "))")  "f =", f
     end if
     write (u, *)
     call mapping%inverse (r, rb, f, p, pb)
     call pacify (p, tolerance)
     call pacify (pb, tolerance)
     call pacify (r, tolerance)
     call pacify (rb, tolerance)
     write (u, "(3x,A,9(1x," // fmt_p // "))")  "p =", p
     write (u, "(3x,A,9(1x," // fmt_p // "))")  "pb=", pb
     write (u, "(3x,A,9(1x," // fmt_p // "))")  "r =", r
     write (u, "(3x,A,9(1x," // fmt_p // "))")  "rb=", rb
     if (present (fmt_f)) then
        write (u, "(3x,A,9(1x," // fmt_f // "))")  "f =", f
     else
        write (u, "(3x,A,9(1x," // fmt_p // "))")  "f =", f
     end if
     write (u, *)
     write (u, "(3x,A,9(1x," // fmt_p // "))")  "*r=", product (r)
   end subroutine sf_mapping_check
 
 @ %def sf_mapping_check
 @ This is a consistency check for the self-tests: the integral over the unit
 square should be unity.  We estimate this by a simple binning and adding up
 the values; this should be sufficient for a self-test.
 
 The argument is the requested number of sampling points.  We take the square
 root for binning in both dimensions, so the precise number might be
 different.
 <<SF mappings: sf mapping: TBP>>=
   procedure :: integral => sf_mapping_integral
 <<SF mappings: procedures>>=
   function sf_mapping_integral (mapping, n_calls) result (integral)
     class(sf_mapping_t), intent(inout) :: mapping
     integer, intent(in) :: n_calls
     real(default) :: integral
     integer :: n_dim, n_bin, k
     real(default), dimension(:), allocatable :: p, pb, r, rb
     integer, dimension(:), allocatable :: ii
     real(default) :: dx, f, s
 
     n_dim = mapping%get_n_dim ()
     allocate (p (n_dim))
     allocate (pb(n_dim))
     allocate (r (n_dim))
     allocate (rb(n_dim))
     allocate (ii(n_dim))
     n_bin = nint (real (n_calls, default) ** (1._default / n_dim))
     dx = 1._default / n_bin
     s = 0
     ii = 1
 
     SAMPLE: do
        do k = 1, n_dim
           p(k)  = ii(k) * dx - dx/2
           pb(k) = (n_bin - ii(k)) * dx + dx/2
        end do
        call mapping%compute (r, rb, f, p, pb)
        s = s + f
        INCR: do k = 1, n_dim
           ii(k) = ii(k) + 1
           if (ii(k) <= n_bin) then
              exit INCR
           else if (k < n_dim) then
              ii(k) = 1
           else
              exit SAMPLE
           end if
        end do INCR
     end do SAMPLE
 
     integral = s / real (n_bin, default) ** n_dim
 
   end function sf_mapping_integral
 
 @ %def sf_mapping_integral
 @
 \subsection{Implementation: standard mapping}
 This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
 while $p_2$ is related to the ratio.
 <<SF mappings: public>>=
   public :: sf_s_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_s_mapping_t
      logical :: power_set = .false.
      real(default) :: power = 1
    contains
    <<SF mappings: sf standard mapping: TBP>>
   end type sf_s_mapping_t
 
 @ %def sf_s_mapping_t
 @ Output.
 <<SF mappings: sf standard mapping: TBP>>=
   procedure :: write => sf_s_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_s_mapping_write (object, unit)
     class(sf_s_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,',',I0,')')", advance="no")  object%i
     end if
     write (u, "(A,F7.5,A)")  ": standard (", object%power, ")"
   end subroutine sf_s_mapping_write
 
 @ %def sf_s_mapping_write
 @ Initialize: index pair and power parameter.
 <<SF mappings: sf standard mapping: TBP>>=
   procedure :: init => sf_s_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_s_mapping_init (mapping, power)
     class(sf_s_mapping_t), intent(out) :: mapping
     real(default), intent(in), optional :: power
     call mapping%base_init (2)
     if (present (power)) then
        mapping%power_set = .true.
        mapping%power = power
     end if
   end subroutine sf_s_mapping_init
 
 @ %def sf_s_mapping_init
 @ Apply mapping.
 <<SF mappings: sf standard mapping: TBP>>=
   procedure :: compute => sf_s_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_s_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_s_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: r2
     integer :: j
     if (mapping%power_set) then
        call map_unit_square (r2, f, p(mapping%i), mapping%power)
     else
        call map_unit_square (r2, f, p(mapping%i))
     end if
     r = p
     rb= pb
     do j = 1, 2
        r (mapping%i(j)) = r2(j)
        rb(mapping%i(j)) = 1 - r2(j)
     end do
   end subroutine sf_s_mapping_compute
 
 @ %def sf_s_mapping_compute
 @ Apply inverse.
 <<SF mappings: sf standard mapping: TBP>>=
   procedure :: inverse => sf_s_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_s_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_s_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: p2
     integer :: j
     if (mapping%power_set) then
        call map_unit_square_inverse (r(mapping%i), f, p2, mapping%power)
     else
        call map_unit_square_inverse (r(mapping%i), f, p2)
     end if
     p = r
     pb= rb
     do j = 1, 2
        p (mapping%i(j)) = p2(j)
        pb(mapping%i(j)) = 1 - p2(j)
     end do
   end subroutine sf_s_mapping_inverse
 
 @ %def sf_s_mapping_inverse
 @
 \subsection{Implementation: resonance pair mapping}
 This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
 while $p_2$ is related to the ratio, then it maps $p_1$ to itself
 according to a Breit-Wigner shape, i.e., a flat prior distribution in $p_1$
 results in a Breit-Wigner distribution.  Mass and width of the BW are
 rescaled by the energy, thus dimensionless fractions.
 <<SF mappings: public>>=
   public :: sf_res_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_res_mapping_t
      real(default) :: m = 0
      real(default) :: w = 0
    contains
    <<SF mappings: sf resonance mapping: TBP>>
   end type sf_res_mapping_t
 
 @ %def sf_res_mapping_t
 @ Output.
 <<SF mappings: sf resonance mapping: TBP>>=
   procedure :: write => sf_res_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_res_mapping_write (object, unit)
     class(sf_res_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,',',I0,')')", advance="no")  object%i
     end if
     write (u, "(A,F7.5,', ',F7.5,A)")  ": resonance (", object%m, object%w, ")"
   end subroutine sf_res_mapping_write
 
 @ %def sf_res_mapping_write
 @ Initialize: index pair and dimensionless mass and width parameters.
 <<SF mappings: sf resonance mapping: TBP>>=
   procedure :: init => sf_res_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_res_mapping_init (mapping, m, w)
     class(sf_res_mapping_t), intent(out) :: mapping
     real(default), intent(in) :: m, w
     call mapping%base_init (2)
     mapping%m = m
     mapping%w = w
   end subroutine sf_res_mapping_init
 
 @ %def sf_res_mapping_init
 @ Apply mapping.
 <<SF mappings: sf resonance mapping: TBP>>=
   procedure :: compute => sf_res_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_res_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_res_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: r2, p2
     real(default) :: fbw, f2, p1m
     integer :: j
     p2 = p(mapping%i)
     call map_breit_wigner &
          (p1m, fbw, p2(1), mapping%m, mapping%w, x_free)
     call map_unit_square (r2, f2, [p1m, p2(2)])
     f = fbw * f2
     r = p
     rb= pb
     do j = 1, 2
        r (mapping%i(j)) = r2(j)
        rb(mapping%i(j)) = 1 - r2(j)
     end do
   end subroutine sf_res_mapping_compute
 
 @ %def sf_res_mapping_compute
 @ Apply inverse.
 <<SF mappings: sf resonance mapping: TBP>>=
   procedure :: inverse => sf_res_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_res_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_res_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: p2
     real(default) :: fbw, f2, p1m
     call map_unit_square_inverse (r(mapping%i), f2, p2)
     call map_breit_wigner_inverse &
          (p2(1), fbw, p1m, mapping%m, mapping%w, x_free)
     p = r
     pb= rb
     p (mapping%i(1)) = p1m
     pb(mapping%i(1)) = 1 - p1m
     p (mapping%i(2)) = p2(2)
     pb(mapping%i(2)) = 1 - p2(2)
     f = fbw * f2
   end subroutine sf_res_mapping_inverse
 
 @ %def sf_res_mapping_inverse
 @
 \subsection{Implementation: resonance single mapping}
 While simpler, this is needed for structure-function setups only in
 exceptional cases.
 
 This maps the unit interval ($r_1$) to itself
 according to a Breit-Wigner shape, i.e., a flat prior distribution in $r_1$
 results in a Breit-Wigner distribution.  Mass and width of the BW are
 rescaled by the energy, thus dimensionless fractions.
 <<SF mappings: public>>=
   public :: sf_res_mapping_single_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_res_mapping_single_t
      real(default) :: m = 0
      real(default) :: w = 0
    contains
    <<SF mappings: sf resonance single mapping: TBP>>
   end type sf_res_mapping_single_t
 
 @ %def sf_res_mapping_single_t
 @ Output.
 <<SF mappings: sf resonance single mapping: TBP>>=
   procedure :: write => sf_res_mapping_single_write
 <<SF mappings: procedures>>=
   subroutine sf_res_mapping_single_write (object, unit)
     class(sf_res_mapping_single_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,')')", advance="no")  object%i
     end if
     write (u, "(A,F7.5,', ',F7.5,A)")  ": resonance (", object%m, object%w, ")"
   end subroutine sf_res_mapping_single_write
 
 @ %def sf_res_mapping_single_write
 @ Initialize: single index (!) and dimensionless mass and width parameters.
 <<SF mappings: sf resonance single mapping: TBP>>=
   procedure :: init => sf_res_mapping_single_init
 <<SF mappings: procedures>>=
   subroutine sf_res_mapping_single_init (mapping, m, w)
     class(sf_res_mapping_single_t), intent(out) :: mapping
     real(default), intent(in) :: m, w
     call mapping%base_init (1)
     mapping%m = m
     mapping%w = w
   end subroutine sf_res_mapping_single_init
 
 @ %def sf_res_mapping_single_init
 @ Apply mapping.
 <<SF mappings: sf resonance single mapping: TBP>>=
   procedure :: compute => sf_res_mapping_single_compute
 <<SF mappings: procedures>>=
   subroutine sf_res_mapping_single_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_res_mapping_single_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(1) :: r2, p2
     real(default) :: fbw
     integer :: j
     p2 = p(mapping%i)
     call map_breit_wigner &
          (r2(1), fbw, p2(1), mapping%m, mapping%w, x_free)
     f = fbw
     r = p
     rb= pb
     r (mapping%i(1)) = r2(1)
     rb(mapping%i(1)) = 1 - r2(1)
   end subroutine sf_res_mapping_single_compute
 
 @ %def sf_res_mapping_single_compute
 @ Apply inverse.
 <<SF mappings: sf resonance single mapping: TBP>>=
   procedure :: inverse => sf_res_mapping_single_inverse
 <<SF mappings: procedures>>=
   subroutine sf_res_mapping_single_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_res_mapping_single_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(1) :: p2
     real(default) :: fbw
     call map_breit_wigner_inverse &
          (r(mapping%i(1)), fbw, p2(1), mapping%m, mapping%w, x_free)
     p = r
     pb= rb
     p (mapping%i(1)) = p2(1)
     pb(mapping%i(1)) = 1 - p2(1)
     f = fbw
   end subroutine sf_res_mapping_single_inverse
 
 @ %def sf_res_mapping_single_inverse
 @
 \subsection{Implementation: on-shell mapping}
 This is a degenerate version of the unit-square mapping where the
 product $r_1r_2$ is constant.  This product is given by the rescaled
 squared mass.  We introduce an artificial first parameter $p_1$ to
 keep the counting, but nothing depends on it.  The second parameter is
 the same $p_2$ as for the standard unit-square mapping for $\alpha=1$,
 it parameterizes the ratio of $r_1$ and $r_2$.
 <<SF mappings: public>>=
   public :: sf_os_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_os_mapping_t
      real(default) :: m = 0
      real(default) :: lm2 = 0
    contains
    <<SF mappings: sf on-shell mapping: TBP>>
   end type sf_os_mapping_t
 
 @ %def sf_os_mapping_t
 @ Output.
 <<SF mappings: sf on-shell mapping: TBP>>=
   procedure :: write => sf_os_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_os_mapping_write (object, unit)
     class(sf_os_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,',',I0,')')", advance="no")  object%i
     end if
     write (u, "(A,F7.5,A)")  ": on-shell (", object%m, ")"
   end subroutine sf_os_mapping_write
 
 @ %def sf_os_mapping_write
 @ Initialize: index pair and dimensionless mass parameter.
 <<SF mappings: sf on-shell mapping: TBP>>=
   procedure :: init => sf_os_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_os_mapping_init (mapping, m)
     class(sf_os_mapping_t), intent(out) :: mapping
     real(default), intent(in) :: m
     call mapping%base_init (2)
     mapping%m = m
     mapping%lm2 = abs (2 * log (mapping%m))
   end subroutine sf_os_mapping_init
 
 @ %def sf_os_mapping_init
 @ Apply mapping.  The [[x_free]] parameter rescales the total energy,
 which must be accounted for in the enclosed mapping.
 <<SF mappings: sf on-shell mapping: TBP>>=
   procedure :: compute => sf_os_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_os_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_os_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: r2, p2
     integer :: j
     p2 = p(mapping%i)
     call map_on_shell (r2, f, p2, mapping%lm2, x_free)
     r = p
     rb= pb
     do j = 1, 2
        r (mapping%i(j)) = r2(j)
        rb(mapping%i(j)) = 1 - r2(j)
     end do
   end subroutine sf_os_mapping_compute
 
 @ %def sf_os_mapping_compute
 @ Apply inverse.  The irrelevant parameter $p_1$ is always set zero.
 <<SF mappings: sf on-shell mapping: TBP>>=
   procedure :: inverse => sf_os_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_os_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_os_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: p2, r2
     r2 = r(mapping%i)
     call map_on_shell_inverse (r2, f, p2, mapping%lm2, x_free)
     p = r
     pb= rb
     p (mapping%i(1)) = p2(1)
     pb(mapping%i(1)) = 1 - p2(1)
     p (mapping%i(2)) = p2(2)
     pb(mapping%i(2)) = 1 - p2(2)
   end subroutine sf_os_mapping_inverse
 
 @ %def sf_os_mapping_inverse
 @
 \subsection{Implementation: on-shell single mapping}
 This is a degenerate version of the unit-interval mapping where the
 result $r$ is constant.  The value is given by the rescaled squared
 mass.  The input parameter $p_1$ is actually ignored, nothing depends
 on it.
 <<SF mappings: public>>=
   public :: sf_os_mapping_single_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_os_mapping_single_t
      real(default) :: m = 0
      real(default) :: lm2 = 0
    contains
    <<SF mappings: sf on-shell mapping single: TBP>>
   end type sf_os_mapping_single_t
 
 @ %def sf_os_mapping_single_t
 @ Output.
 <<SF mappings: sf on-shell mapping single: TBP>>=
   procedure :: write => sf_os_mapping_single_write
 <<SF mappings: procedures>>=
   subroutine sf_os_mapping_single_write (object, unit)
     class(sf_os_mapping_single_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,')')", advance="no")  object%i
     end if
     write (u, "(A,F7.5,A)")  ": on-shell (", object%m, ")"
   end subroutine sf_os_mapping_single_write
 
 @ %def sf_os_mapping_single_write
 @ Initialize: index pair and dimensionless mass parameter.
 <<SF mappings: sf on-shell mapping single: TBP>>=
   procedure :: init => sf_os_mapping_single_init
 <<SF mappings: procedures>>=
   subroutine sf_os_mapping_single_init (mapping, m)
     class(sf_os_mapping_single_t), intent(out) :: mapping
     real(default), intent(in) :: m
     call mapping%base_init (1)
     mapping%m = m
     mapping%lm2 = abs (2 * log (mapping%m))
   end subroutine sf_os_mapping_single_init
 
 @ %def sf_os_mapping_single_init
 @ Apply mapping.  The [[x_free]] parameter rescales the total energy,
 which must be accounted for in the enclosed mapping.
 <<SF mappings: sf on-shell mapping single: TBP>>=
   procedure :: compute => sf_os_mapping_single_compute
 <<SF mappings: procedures>>=
   subroutine sf_os_mapping_single_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_os_mapping_single_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(1) :: r2, p2
     integer :: j
     p2 = p(mapping%i)
     call map_on_shell_single (r2, f, p2, mapping%lm2, x_free)
     r = p
     rb= pb
     r (mapping%i(1)) = r2(1)
     rb(mapping%i(1)) = 1 - r2(1)
   end subroutine sf_os_mapping_single_compute
 
 @ %def sf_os_mapping_single_compute
 @ Apply inverse.  The irrelevant parameter $p_1$ is always set zero.
 <<SF mappings: sf on-shell mapping single: TBP>>=
   procedure :: inverse => sf_os_mapping_single_inverse
 <<SF mappings: procedures>>=
   subroutine sf_os_mapping_single_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_os_mapping_single_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(1) :: p2, r2
     r2 = r(mapping%i)
     call map_on_shell_single_inverse (r2, f, p2, mapping%lm2, x_free)
     p = r
     pb= rb
     p (mapping%i(1)) = p2(1)
     pb(mapping%i(1)) = 1 - p2(1)
   end subroutine sf_os_mapping_single_inverse
 
 @ %def sf_os_mapping_single_inverse
 @
 \subsection{Implementation: endpoint mapping}
 This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
 while $p_2$ is related to the ratio.  Furthermore, we enhance the
 region at $r_1=1$ and $r_2=1$, which translates into $p_1=1$ and
 $p_2=0,1$.  The enhancement is such that any power-like singularity is
 caught.  This is useful for beamstrahlung spectra.
 
 In addition, we allow for a delta-function singularity in $r_1$ and/or
 $r_2$.  The singularity is smeared to an interval of width
 $\epsilon$.  If nonzero, we distinguish the kinematical momentum
 fractions $r_i$ from effective values $x_i$, which should go into the
 structure-function evaluation.  A bin of width $\epsilon$ in $r$ is
 mapped to $x=1$ exactly, while the interval $(0,1-\epsilon)$ is mapped
 to $(0,1)$ in $x$.  The Jacobian reflects this distinction, and the
 logical [[in_peak]] allows for an unambiguous distinction.
 
 The delta-peak fraction is used only for the integration self-test.
 <<SF mappings: public>>=
   public :: sf_ep_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_ep_mapping_t
      real(default) :: a = 1
    contains
    <<SF mappings: sf endpoint mapping: TBP>>
   end type sf_ep_mapping_t
 
 @ %def sf_ep_mapping_t
 @ Output.
 <<SF mappings: sf endpoint mapping: TBP>>=
   procedure :: write => sf_ep_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_ep_mapping_write (object, unit)
     class(sf_ep_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,',',I0,')')", advance="no")  object%i
     end if
     write (u, "(A,ES12.5,A)")  ": endpoint (a =", object%a, ")"
   end subroutine sf_ep_mapping_write
 
 @ %def sf_ep_mapping_write
 @ Initialize: no extra parameters.
 <<SF mappings: sf endpoint mapping: TBP>>=
   procedure :: init => sf_ep_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_ep_mapping_init (mapping, a)
     class(sf_ep_mapping_t), intent(out) :: mapping
     real(default), intent(in), optional :: a
     call mapping%base_init (2)
     if (present (a))  mapping%a = a
   end subroutine sf_ep_mapping_init
 
 @ %def sf_ep_mapping_init
 @ Apply mapping.
 <<SF mappings: sf endpoint mapping: TBP>>=
   procedure :: compute => sf_ep_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_ep_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_ep_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: px, r2
     real(default) :: f1, f2
     integer :: j
     call map_endpoint_1 (px(1), f1, p(mapping%i(1)), mapping%a)
     call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
     call map_unit_square (r2, f, px)
     f = f * f1 * f2
     r = p
     rb= pb
     do j = 1, 2
        r (mapping%i(j)) = r2(j)
        rb(mapping%i(j)) = 1 - r2(j)
     end do
   end subroutine sf_ep_mapping_compute
 
 @ %def sf_ep_mapping_compute
 @ Apply inverse.
 <<SF mappings: sf endpoint mapping: TBP>>=
   procedure :: inverse => sf_ep_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_ep_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_ep_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: r2, px, p2
     real(default) :: f1, f2
     integer :: j
     do j = 1, 2
        r2(j) = r(mapping%i(j))
     end do
     call map_unit_square_inverse (r2, f, px)
     call map_endpoint_inverse_1 (px(1), f1, p2(1), mapping%a)
     call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
     f = f * f1 * f2
     p = r
     pb= rb
     do j = 1, 2
        p (mapping%i(j)) = p2(j)
        pb(mapping%i(j)) = 1 - p2(j)
     end do
   end subroutine sf_ep_mapping_inverse
 
 @ %def sf_ep_mapping_inverse
 @
 \subsection{Implementation: endpoint mapping with resonance}
 Like the endpoint mapping for $p_2$, but replace the endpoint mapping
 by a Breit-Wigner mapping for $p_1$.  This covers resonance production
 in the presence of beamstrahlung.
 
 If the flag [[resonance]] is unset, we skip the resonance mapping, so
 the parameter $p_1$ remains equal to $r_1r_2$, as in the standard
 s-channel mapping.
 <<SF mappings: public>>=
   public :: sf_epr_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_epr_mapping_t
      real(default) :: a = 1
      real(default) :: m = 0
      real(default) :: w = 0
      logical :: resonance = .true.
    contains
    <<SF mappings: sf endpoint/res mapping: TBP>>
   end type sf_epr_mapping_t
 
 @ %def sf_epr_mapping_t
 @ Output.
 <<SF mappings: sf endpoint/res mapping: TBP>>=
   procedure :: write => sf_epr_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_epr_mapping_write (object, unit)
     class(sf_epr_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,',',I0,')')", advance="no")  object%i
     end if
     if (object%resonance) then
        write (u, "(A,F7.5,A,F7.5,', ',F7.5,A)")  ": ep/res (a = ", object%a, &
             " | ", object%m, object%w, ")"
     else
        write (u, "(A,F7.5,A)")  ": ep/nores (a = ", object%a, ")"
     end if
   end subroutine sf_epr_mapping_write
 
 @ %def sf_epr_mapping_write
 @ Initialize: if mass and width are not given, we initialize a
 non-resonant version of the mapping.
 <<SF mappings: sf endpoint/res mapping: TBP>>=
   procedure :: init => sf_epr_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_epr_mapping_init (mapping, a, m, w)
     class(sf_epr_mapping_t), intent(out) :: mapping
     real(default), intent(in) :: a
     real(default), intent(in), optional :: m, w
     call mapping%base_init (2)
     mapping%a = a
     if (present (m) .and. present (w)) then
        mapping%m = m
        mapping%w = w
     else
        mapping%resonance = .false.
     end if
   end subroutine sf_epr_mapping_init
 
 @ %def sf_epr_mapping_init
 @ Apply mapping.
 <<SF mappings: sf endpoint/res mapping: TBP>>=
   procedure :: compute => sf_epr_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_epr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_epr_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: px, r2
     real(default) :: f1, f2
     integer :: j
     if (mapping%resonance) then
        call map_breit_wigner &
             (px(1), f1, p(mapping%i(1)), mapping%m, mapping%w, x_free)
     else
        px(1) = p(mapping%i(1))
        f1 = 1
     end if
     call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
     call map_unit_square (r2, f, px)
     f = f * f1 * f2
     r = p
     rb= pb
     do j = 1, 2
        r (mapping%i(j)) = r2(j)
        rb(mapping%i(j)) = 1 - r2(j)
     end do
   end subroutine sf_epr_mapping_compute
 
 @ %def sf_epr_mapping_compute
 @ Apply inverse.
 <<SF mappings: sf endpoint/res mapping: TBP>>=
   procedure :: inverse => sf_epr_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_epr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_epr_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: px, p2
     real(default) :: f1, f2
     integer :: j
     call map_unit_square_inverse (r(mapping%i), f, px)
     if (mapping%resonance) then
        call map_breit_wigner_inverse &
             (px(1), f1, p2(1), mapping%m, mapping%w, x_free)
     else
        p2(1) = px(1)
        f1 = 1
     end if
     call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
     f = f * f1 * f2
     p = r
     pb= rb
     do j = 1, 2
        p (mapping%i(j)) = p2(j)
        pb(mapping%i(j)) = 1 - p2(j)
     end do
   end subroutine sf_epr_mapping_inverse
 
 @ %def sf_epr_mapping_inverse
 @
 \subsection{Implementation: endpoint mapping for on-shell particle}
 Analogous to the resonance mapping, but the $p_1$ input is ignored
 altogether.  This covers on-shell particle production
 in the presence of beamstrahlung.
 <<SF mappings: public>>=
   public :: sf_epo_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_epo_mapping_t
      real(default) :: a = 1
      real(default) :: m = 0
      real(default) :: lm2 = 0
    contains
    <<SF mappings: sf endpoint/os mapping: TBP>>
   end type sf_epo_mapping_t
 
 @ %def sf_epo_mapping_t
 @ Output.
 <<SF mappings: sf endpoint/os mapping: TBP>>=
   procedure :: write => sf_epo_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_epo_mapping_write (object, unit)
     class(sf_epo_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,',',I0,')')", advance="no")  object%i
     end if
     write (u, "(A,F7.5,A,F7.5,A)")  ": ep/on-shell (a = ", object%a, &
          " | ", object%m, ")"
   end subroutine sf_epo_mapping_write
 
 @ %def sf_epo_mapping_write
 @ Initialize: no extra parameters.
 <<SF mappings: sf endpoint/os mapping: TBP>>=
   procedure :: init => sf_epo_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_epo_mapping_init (mapping, a, m)
     class(sf_epo_mapping_t), intent(out) :: mapping
     real(default), intent(in) :: a, m
     call mapping%base_init (2)
     mapping%a = a
     mapping%m = m
     mapping%lm2 = abs (2 * log (mapping%m))
   end subroutine sf_epo_mapping_init
 
 @ %def sf_epo_mapping_init
 @ Apply mapping.
 <<SF mappings: sf endpoint/os mapping: TBP>>=
   procedure :: compute => sf_epo_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_epo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_epo_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: px, r2
     real(default) :: f2
     integer :: j
     px(1) = 0
     call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
     call map_on_shell (r2, f, px, mapping%lm2)
     f = f * f2
     r = p
     rb= pb
     do j = 1, 2
        r (mapping%i(j)) = r2(j)
        rb(mapping%i(j)) = 1 - r2(j)
     end do
   end subroutine sf_epo_mapping_compute
 
 @ %def sf_epo_mapping_compute
 @ Apply inverse.
 <<SF mappings: sf endpoint/os mapping: TBP>>=
   procedure :: inverse => sf_epo_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_epo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_epo_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: px, p2
     real(default) :: f2
     integer :: j
     call map_on_shell_inverse (r(mapping%i), f, px, mapping%lm2)
     p2(1) = 0
     call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
     f = f * f2
     p = r
     pb= rb
     do j = 1, 2
        p (mapping%i(j)) = p2(j)
        pb(mapping%i(j)) = 1 - p2(j)
     end do
   end subroutine sf_epo_mapping_inverse
 
 @ %def sf_epo_mapping_inverse
 @
 \subsection{Implementation: ISR endpoint mapping}
 Similar to the endpoint mapping above: This maps the unit square
 ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$, while $p_2$ is
 related to the ratio.  Furthermore, we enhance the region at $r_1=1$
 and $r_2=1$, which translates into $p_1=1$ and $p_2=0,1$.
 
 The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
 flattened.  This would be easy in one dimension, but becomes
 nontrivial in two dimensions.
 <<SF mappings: public>>=
   public :: sf_ip_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_ip_mapping_t
      real(default) :: eps = 0
    contains
    <<SF mappings: sf power mapping: TBP>>
   end type sf_ip_mapping_t
 
 @ %def sf_ip_mapping_t
 @ Output.
 <<SF mappings: sf power mapping: TBP>>=
   procedure :: write => sf_ip_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_ip_mapping_write (object, unit)
     class(sf_ip_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,',',I0,')')", advance="no")  object%i
     end if
     write (u, "(A,ES12.5,A)")  ": isr (eps =", object%eps, ")"
   end subroutine sf_ip_mapping_write
 
 @ %def sf_ip_mapping_write
 @ Initialize: no extra parameters.
 <<SF mappings: sf power mapping: TBP>>=
   procedure :: init => sf_ip_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_ip_mapping_init (mapping, eps)
     class(sf_ip_mapping_t), intent(out) :: mapping
     real(default), intent(in), optional :: eps
     call mapping%base_init (2)
     if (present (eps))  mapping%eps = eps
     if (mapping%eps <= 0) &
          call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
   end subroutine sf_ip_mapping_init
 
 @ %def sf_ip_mapping_init
 @ Apply mapping.
 <<SF mappings: sf power mapping: TBP>>=
   procedure :: compute => sf_ip_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_ip_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_ip_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: px, pxb, r2, r2b
     real(default) :: f1, f2, xb, y, yb
     integer :: j
     call map_power_1 (xb, f1, pb(mapping%i(1)), 2 * mapping%eps)
     call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
     px(1)  = 1 - xb
     pxb(1) = xb
     px(2)  = y
     pxb(2) = yb
     call map_unit_square_prec (r2, r2b, f, px, pxb)
     f = f * f1 * f2
     r = p
     rb= pb
     do j = 1, 2
        r (mapping%i(j)) = r2 (j)
        rb(mapping%i(j)) = r2b(j)
     end do
   end subroutine sf_ip_mapping_compute
 
 @ %def sf_ip_mapping_compute
 @ Apply inverse.
 <<SF mappings: sf power mapping: TBP>>=
   procedure :: inverse => sf_ip_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_ip_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_ip_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
     real(default) :: f1, f2, xb, y, yb
     integer :: j
     do j = 1, 2
        r2 (j) = r (mapping%i(j))
        r2b(j) = rb(mapping%i(j))
     end do
     call map_unit_square_inverse_prec (r2, r2b, f, px, pxb)
     xb = pxb(1)
     if (px(1) > 0) then
        y  = px(2)
        yb = pxb(2)
     else
        y  = 0.5_default
        yb = 0.5_default
     end if
     call map_power_inverse_1 (xb, f1, p2b(1), 2 * mapping%eps)
     call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
     p2 = 1 - p2b
     f = f * f1 * f2
     p = r
     pb= rb
     do j = 1, 2
        p (mapping%i(j)) = p2(j)
        pb(mapping%i(j)) = p2b(j)
     end do
   end subroutine sf_ip_mapping_inverse
 
 @ %def sf_ip_mapping_inverse
 @
 \subsection{Implementation: ISR endpoint mapping, resonant}
 Similar to the endpoint mapping above: This maps the unit square
 ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$, while $p_2$ is
 related to the ratio.  Furthermore, we enhance the region at $r_1=1$
 and $r_2=1$, which translates into $p_1=1$ and $p_2=0,1$.
 
 The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
 flattened.  This would be easy in one dimension, but becomes
 nontrivial in two dimensions.
 
 The resonance can be turned off by the flag [[resonance]].
 <<SF mappings: public>>=
   public :: sf_ipr_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_ipr_mapping_t
      real(default) :: eps = 0
      real(default) :: m = 0
      real(default) :: w = 0
      logical :: resonance = .true.
    contains
    <<SF mappings: sf power/res mapping: TBP>>
   end type sf_ipr_mapping_t
 
 @ %def sf_ipr_mapping_t
 @ Output.
 <<SF mappings: sf power/res mapping: TBP>>=
   procedure :: write => sf_ipr_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_ipr_mapping_write (object, unit)
     class(sf_ipr_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,',',I0,')')", advance="no")  object%i
     end if
     if (object%resonance) then
        write (u, "(A,F7.5,A,F7.5,', ',F7.5,A)")  ": isr/res (eps = ", &
             object%eps, " | ", object%m, object%w, ")"
     else
        write (u, "(A,F7.5,A)")  ": isr/res (eps = ", object%eps, ")"
     end if
   end subroutine sf_ipr_mapping_write
 
 @ %def sf_ipr_mapping_write
 @ Initialize:
 <<SF mappings: sf power/res mapping: TBP>>=
   procedure :: init => sf_ipr_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_ipr_mapping_init (mapping, eps, m, w)
     class(sf_ipr_mapping_t), intent(out) :: mapping
     real(default), intent(in), optional :: eps, m, w
     call mapping%base_init (2)
     if (present (eps))  mapping%eps = eps
     if (mapping%eps <= 0) &
          call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
     if (present (m) .and. present (w)) then
        mapping%m = m
        mapping%w = w
     else
        mapping%resonance = .false.
     end if
   end subroutine sf_ipr_mapping_init
 
 @ %def sf_ipr_mapping_init
 @ Apply mapping.
 <<SF mappings: sf power/res mapping: TBP>>=
   procedure :: compute => sf_ipr_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_ipr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_ipr_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: px, pxb, r2, r2b
     real(default) :: f1, f2, y, yb
     integer :: j
     if (mapping%resonance) then
        call map_breit_wigner &
             (px(1), f1, p(mapping%i(1)), mapping%m, mapping%w, x_free)
     else
        px(1) = p(mapping%i(1))
        f1 = 1
     end if
     call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
     pxb(1) = 1 - px(1)
     px(2)  = y
     pxb(2) = yb
     call map_unit_square_prec (r2, r2b, f, px, pxb)
     f = f * f1 * f2
     r = p
     rb= pb
     do j = 1, 2
        r (mapping%i(j)) = r2 (j)
        rb(mapping%i(j)) = r2b(j)
     end do
   end subroutine sf_ipr_mapping_compute
 
 @ %def sf_ipr_mapping_compute
 @ Apply inverse.
 <<SF mappings: sf power/res mapping: TBP>>=
   procedure :: inverse => sf_ipr_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_ipr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_ipr_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
     real(default) :: f1, f2, y, yb
     integer :: j
     do j = 1, 2
        r2 (j) = r (mapping%i(j))
        r2b(j) = rb(mapping%i(j))
     end do
     call map_unit_square_inverse_prec (r2, r2b, f, px, pxb)
     if (px(1) > 0) then
        y  = px(2)
        yb = pxb(2)
     else
        y  = 0.5_default
        yb = 0.5_default
     end if
     if (mapping%resonance) then
        call map_breit_wigner_inverse &
             (px(1), f1, p2(1), mapping%m, mapping%w, x_free)
     else
        p2(1) = px(1)
        f1 = 1
     end if
     call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
     p2b(1) = 1 - p2(1)
     p2 (2) = 1 - p2b(2)
     f = f * f1 * f2
     p = r
     pb= rb
     do j = 1, 2
        p (mapping%i(j)) = p2(j)
        pb(mapping%i(j)) = p2b(j)
     end do
   end subroutine sf_ipr_mapping_inverse
 
 @ %def sf_ipr_mapping_inverse
 @
 \subsection{Implementation: ISR on-shell mapping}
 Similar to the endpoint mapping above: This maps the unit square
 ($r_1,r_2$) such that $p_1$ is ignored while the product $r_1r_2$ is
 constant.  $p_2$ is related to the ratio.  Furthermore, we enhance the
 region at $r_1=1$ and $r_2=1$, which translates into $p_1=1$ and
 $p_2=0,1$.
 
 The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
 flattened.  This would be easy in one dimension, but becomes
 nontrivial in two dimensions.
 <<SF mappings: public>>=
   public :: sf_ipo_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_ipo_mapping_t
      real(default) :: eps = 0
      real(default) :: m = 0
    contains
    <<SF mappings: sf power/os mapping: TBP>>
   end type sf_ipo_mapping_t
 
 @ %def sf_ipo_mapping_t
 @ Output.
 <<SF mappings: sf power/os mapping: TBP>>=
   procedure :: write => sf_ipo_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_ipo_mapping_write (object, unit)
     class(sf_ipo_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,',',I0,')')", advance="no")  object%i
     end if
     write (u, "(A,F7.5,A,F7.5,A)")  ": isr/os (eps = ", object%eps, &
          " | ", object%m, ")"
   end subroutine sf_ipo_mapping_write
 
 @ %def sf_ipo_mapping_write
 @ Initialize: no extra parameters.
 <<SF mappings: sf power/os mapping: TBP>>=
   procedure :: init => sf_ipo_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_ipo_mapping_init (mapping, eps, m)
     class(sf_ipo_mapping_t), intent(out) :: mapping
     real(default), intent(in), optional :: eps, m
     call mapping%base_init (2)
     if (present (eps))  mapping%eps = eps
     if (mapping%eps <= 0) &
          call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
     mapping%m = m
   end subroutine sf_ipo_mapping_init
 
 @ %def sf_ipo_mapping_init
 @ Apply mapping.
 <<SF mappings: sf power/os mapping: TBP>>=
   procedure :: compute => sf_ipo_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_ipo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_ipo_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: px, pxb, r2, r2b
     real(default) :: f1, f2, y, yb
     integer :: j
     call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
     px(1)  = mapping%m ** 2
     if (present (x_free))  px(1) = px(1) / x_free
     pxb(1) = 1 - px(1)
     px(2)  = y
     pxb(2) = yb
     call map_unit_square_prec (r2, r2b, f1, px, pxb)
     f = f1 * f2
     r = p
     rb= pb
     do j = 1, 2
        r (mapping%i(j)) = r2 (j)
        rb(mapping%i(j)) = r2b(j)
     end do
   end subroutine sf_ipo_mapping_compute
 
 @ %def sf_ipo_mapping_compute
 @ Apply inverse.
 <<SF mappings: sf power/os mapping: TBP>>=
   procedure :: inverse => sf_ipo_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_ipo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_ipo_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
     real(default) :: f1, f2, y, yb
     integer :: j
     do j = 1, 2
        r2 (j) = r (mapping%i(j))
        r2b(j) = rb(mapping%i(j))
     end do
     call map_unit_square_inverse_prec (r2, r2b, f1, px, pxb)
     y  = px(2)
     yb = pxb(2)
     call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
     p2(1) = 0
     p2b(1)= 1
     p2(2) = 1 - p2b(2)
     f = f1 * f2
     p = r
     pb= rb
     do j = 1, 2
        p (mapping%i(j)) = p2(j)
        pb(mapping%i(j)) = p2b(j)
     end do
   end subroutine sf_ipo_mapping_inverse
 
 @ %def sf_ipo_mapping_inverse
 @
 \subsection{Implementation: Endpoint + ISR power mapping}
 This is a combination of endpoint (i.e., beamstrahlung) and ISR power
 mapping.  The first two parameters apply to the beamstrahlung
 spectrum, the last two to the ISR function for the first and second
 beam, respectively.
 <<SF mappings: public>>=
   public :: sf_ei_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_ei_mapping_t
      type(sf_ep_mapping_t) :: ep
      type(sf_ip_mapping_t) :: ip
    contains
    <<SF mappings: sf ep-ip mapping: TBP>>
   end type sf_ei_mapping_t
 
 @ %def sf_ei_mapping_t
 @ Output.
 <<SF mappings: sf ep-ip mapping: TBP>>=
   procedure :: write => sf_ei_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_ei_mapping_write (object, unit)
     class(sf_ei_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,3(',',I0),')')", advance="no")  object%i
     end if
     write (u, "(A,ES12.5,A,ES12.5,A)")  ": ep/isr (a =", object%ep%a, &
          ", eps =", object%ip%eps, ")"
   end subroutine sf_ei_mapping_write
 
 @ %def sf_ei_mapping_write
 @ Initialize: no extra parameters.
 <<SF mappings: sf ep-ip mapping: TBP>>=
   procedure :: init => sf_ei_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_ei_mapping_init (mapping, a, eps)
     class(sf_ei_mapping_t), intent(out) :: mapping
     real(default), intent(in), optional :: a, eps
     call mapping%base_init (4)
     call mapping%ep%init (a)
     call mapping%ip%init (eps)
   end subroutine sf_ei_mapping_init
 
 @ %def sf_ei_mapping_init
 @ Set an index value.  We should communicate the appropriate indices to the
 enclosed sub-mappings, therefore override the method.
 <<SF mappings: sf ep-ip mapping: TBP>>=
   procedure :: set_index => sf_ei_mapping_set_index
 <<SF mappings: procedures>>=
   subroutine sf_ei_mapping_set_index (mapping, j, i)
     class(sf_ei_mapping_t), intent(inout) :: mapping
     integer, intent(in) :: j, i
     mapping%i(j) = i
     select case (j)
     case (1:2);  call mapping%ep%set_index (j, i)
     case (3:4);  call mapping%ip%set_index (j-2, i)
     end select
   end subroutine sf_ei_mapping_set_index
 
 @ %def sf_mapping_set_index
 @ Apply mapping.  Now, the beamstrahlung and ISR mappings are
 independent of each other.  The parameter subsets that are actually
 used should not overlap.  The Jacobians are multiplied.
 <<SF mappings: sf ep-ip mapping: TBP>>=
   procedure :: compute => sf_ei_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_ei_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_ei_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(size(p)) :: q, qb
     real(default) :: f1, f2
     call mapping%ep%compute (q, qb, f1, p, pb, x_free)
     call mapping%ip%compute (r, rb, f2, q, qb, x_free)
     f = f1 * f2
   end subroutine sf_ei_mapping_compute
 
 @ %def sf_ei_mapping_compute
 @ Apply inverse.
 <<SF mappings: sf ep-ip mapping: TBP>>=
   procedure :: inverse => sf_ei_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_ei_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_ei_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(size(p)) :: q, qb
     real(default) :: f1, f2
     call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
     call mapping%ep%inverse (q, qb, f1, p, pb, x_free)
     f = f1 * f2
   end subroutine sf_ei_mapping_inverse
 
 @ %def sf_ei_mapping_inverse
 @
 \subsection{Implementation: Endpoint + ISR + resonance}
 This is a combination of endpoint (i.e., beamstrahlung) and ISR power
 mapping, adapted for an s-channel resonance.  The first two internal
 parameters apply to the beamstrahlung spectrum, the last two to the
 ISR function for the first and second beam, respectively.  The first
 and third parameters are the result of an overall resonance mapping,
 so on the outside, the first parameter is the total momentum fraction,
 the third one describes the distribution between beamstrahlung and ISR.
 <<SF mappings: public>>=
   public :: sf_eir_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_eir_mapping_t
      type(sf_res_mapping_t) :: res
      type(sf_epr_mapping_t) :: ep
      type(sf_ipr_mapping_t) :: ip
    contains
    <<SF mappings: sf ep-ip-res mapping: TBP>>
   end type sf_eir_mapping_t
 
 @ %def sf_eir_mapping_t
 @ Output.
 <<SF mappings: sf ep-ip-res mapping: TBP>>=
   procedure :: write => sf_eir_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_eir_mapping_write (object, unit)
     class(sf_eir_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,3(',',I0),')')", advance="no")  object%i
     end if
     write (u, "(A,F7.5,A,F7.5,A,F7.5,', ',F7.5,A)")  &
          ": ep/isr/res (a =", object%ep%a, &
          ", eps =", object%ip%eps, " | ", object%res%m, object%res%w, ")"
   end subroutine sf_eir_mapping_write
 
 @ %def sf_eir_mapping_write
 @ Initialize: no extra parameters.
 <<SF mappings: sf ep-ip-res mapping: TBP>>=
   procedure :: init => sf_eir_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_eir_mapping_init (mapping, a, eps, m, w)
     class(sf_eir_mapping_t), intent(out) :: mapping
     real(default), intent(in) :: a, eps, m, w
     call mapping%base_init (4)
     call mapping%res%init (m, w)
     call mapping%ep%init (a)
     call mapping%ip%init (eps)
   end subroutine sf_eir_mapping_init
 
 @ %def sf_eir_mapping_init
 @ Set an index value.  We should communicate the appropriate indices to the
 enclosed sub-mappings, therefore override the method.
 <<SF mappings: sf ep-ip-res mapping: TBP>>=
   procedure :: set_index => sf_eir_mapping_set_index
 <<SF mappings: procedures>>=
   subroutine sf_eir_mapping_set_index (mapping, j, i)
     class(sf_eir_mapping_t), intent(inout) :: mapping
     integer, intent(in) :: j, i
     mapping%i(j) = i
     select case (j)
     case (1);  call mapping%res%set_index (1, i)
     case (3);  call mapping%res%set_index (2, i)
     end select
     select case (j)
     case (1:2);  call mapping%ep%set_index (j, i)
     case (3:4);  call mapping%ip%set_index (j-2, i)
     end select
   end subroutine sf_eir_mapping_set_index
 
 @ %def sf_mapping_set_index
 @ Apply mapping.  Now, the beamstrahlung and ISR mappings are
 independent of each other.  The parameter subsets that are actually
 used should not overlap.  The Jacobians are multiplied.
 <<SF mappings: sf ep-ip-res mapping: TBP>>=
   procedure :: compute => sf_eir_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_eir_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_eir_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(size(p)) :: px, pxb, q, qb
     real(default) :: f0, f1, f2
     call mapping%res%compute (px, pxb, f0, p, pb, x_free)
     call mapping%ep%compute (q, qb, f1, px, pxb, x_free)
     call mapping%ip%compute (r, rb, f2, q, qb, x_free)
     f = f0 * f1 * f2
   end subroutine sf_eir_mapping_compute
 
 @ %def sf_eir_mapping_compute
 @ Apply inverse.
 <<SF mappings: sf ep-ip-res mapping: TBP>>=
   procedure :: inverse => sf_eir_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_eir_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_eir_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(size(p)) :: px, pxb, q, qb
     real(default) :: f0, f1, f2
     call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
     call mapping%ep%inverse (q, qb, f1, px, pxb, x_free)
     call mapping%res%inverse (px, pxb, f0, p, pb, x_free)
     f = f0 * f1 * f2
   end subroutine sf_eir_mapping_inverse
 
 @ %def sf_eir_mapping_inverse
 @
 \subsection{Implementation: Endpoint + ISR power mapping, on-shell}
 This is a combination of endpoint (i.e., beamstrahlung) and ISR power
 mapping.  The first two parameters apply to the beamstrahlung
 spectrum, the last two to the ISR function for the first and second
 beam, respectively.  On top of that, we map the first and third parameter
 such that the product is constant.  From the outside, the first
 parameter is irrelevant while the third parameter describes the
 distribution of energy (loss) among beamstrahlung and ISR.
 <<SF mappings: public>>=
   public :: sf_eio_mapping_t
 <<SF mappings: types>>=
   type, extends (sf_mapping_t) :: sf_eio_mapping_t
      type(sf_os_mapping_t) :: os
      type(sf_epr_mapping_t) :: ep
      type(sf_ipr_mapping_t) :: ip
    contains
    <<SF mappings: sf ep-ip-os mapping: TBP>>
   end type sf_eio_mapping_t
 
 @ %def sf_eio_mapping_t
 @ Output.
 <<SF mappings: sf ep-ip-os mapping: TBP>>=
   procedure :: write => sf_eio_mapping_write
 <<SF mappings: procedures>>=
   subroutine sf_eio_mapping_write (object, unit)
     class(sf_eio_mapping_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "map"
     if (any (object%i /= 0)) then
        write (u, "('(',I0,3(',',I0),')')", advance="no")  object%i
     end if
     write (u, "(A,F7.5,A,F7.5,A,F7.5,A)")  ": ep/isr/os (a =", object%ep%a, &
          ", eps =", object%ip%eps, " | ", object%os%m, ")"
   end subroutine sf_eio_mapping_write
 
 @ %def sf_eio_mapping_write
 @ Initialize: no extra parameters.
 <<SF mappings: sf ep-ip-os mapping: TBP>>=
   procedure :: init => sf_eio_mapping_init
 <<SF mappings: procedures>>=
   subroutine sf_eio_mapping_init (mapping, a, eps, m)
     class(sf_eio_mapping_t), intent(out) :: mapping
     real(default), intent(in), optional :: a, eps, m
     call mapping%base_init (4)
     call mapping%os%init (m)
     call mapping%ep%init (a)
     call mapping%ip%init (eps)
   end subroutine sf_eio_mapping_init
 
 @ %def sf_eio_mapping_init
 @ Set an index value.  We should communicate the appropriate indices to the
 enclosed sub-mappings, therefore override the method.
 <<SF mappings: sf ep-ip-os mapping: TBP>>=
   procedure :: set_index => sf_eio_mapping_set_index
 <<SF mappings: procedures>>=
   subroutine sf_eio_mapping_set_index (mapping, j, i)
     class(sf_eio_mapping_t), intent(inout) :: mapping
     integer, intent(in) :: j, i
     mapping%i(j) = i
     select case (j)
     case (1);  call mapping%os%set_index (1, i)
     case (3);  call mapping%os%set_index (2, i)
     end select
     select case (j)
     case (1:2);  call mapping%ep%set_index (j, i)
     case (3:4);  call mapping%ip%set_index (j-2, i)
     end select
   end subroutine sf_eio_mapping_set_index
 
 @ %def sf_mapping_set_index
 @ Apply mapping.  Now, the beamstrahlung and ISR mappings are
 independent of each other.  The parameter subsets that are actually
 used should not overlap.  The Jacobians are multiplied.
 <<SF mappings: sf ep-ip-os mapping: TBP>>=
   procedure :: compute => sf_eio_mapping_compute
 <<SF mappings: procedures>>=
   subroutine sf_eio_mapping_compute (mapping, r, rb, f, p, pb, x_free)
     class(sf_eio_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(size(p)) :: px, pxb, q, qb
     real(default) :: f0, f1, f2
     call mapping%os%compute (px, pxb, f0, p, pb, x_free)
     call mapping%ep%compute (q, qb, f1, px, pxb, x_free)
     call mapping%ip%compute (r, rb, f2, q, qb, x_free)
     f = f0 * f1 * f2
   end subroutine sf_eio_mapping_compute
 
 @ %def sf_eio_mapping_compute
 @ Apply inverse.
 <<SF mappings: sf ep-ip-os mapping: TBP>>=
   procedure :: inverse => sf_eio_mapping_inverse
 <<SF mappings: procedures>>=
   subroutine sf_eio_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
     class(sf_eio_mapping_t), intent(inout) :: mapping
     real(default), dimension(:), intent(in) :: r, rb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: p, pb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(size(p)) :: px, pxb, q, qb
     real(default) :: f0, f1, f2
     call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
     call mapping%ep%inverse (q, qb, f1, px, pxb, x_free)
     call mapping%os%inverse (px, pxb, f0, p, pb, x_free)
     f = f0 * f1 * f2
   end subroutine sf_eio_mapping_inverse
 
 @ %def sf_eio_mapping_inverse
 @
 \subsection{Basic formulas}
 \subsubsection{Standard mapping of the unit square}
 This mapping of the unit square is appropriate in particular for
 structure functions which are concentrated at the lower end.  Instead
 of a rectangular grid, one set of grid lines corresponds to constant
 parton c.m. energy.  The other set is chosen such that the jacobian is
 only mildly singular ($\ln x$ which is zero at $x=1$), corresponding
 to an initial concentration of sampling points at the maximum energy.
 If [[power]] is greater than one (the default), points are also
 concentrated at the lower end.
 
 The formula is ([[power]]=$\alpha$):
 \begin{align}
   r_1 &= (p_1 ^ {p_2})^\alpha \\
   r_2 &= (p_1 ^ {1 - p_2})^\alpha\\
   f   &= \alpha^2 p_1 ^ {\alpha - 1} |\log p_1|
 \end{align}
 and for the default case $\alpha=1$:
 \begin{align}
   r_1 &= p_1 ^ {p_2} \\
   r_2 &= p_1 ^ {1 - p_2} \\
   f   &= |\log p_1|
 \end{align}
 <<SF mappings: procedures>>=
   subroutine map_unit_square (r, factor, p, power)
     real(default), dimension(2), intent(out) :: r
     real(default), intent(out) :: factor
     real(default), dimension(2), intent(in) :: p
     real(default), intent(in), optional :: power
     real(default) :: xx, yy
     factor = 1
     xx = p(1)
     yy = p(2)
     if (present(power)) then
        if (p(1) > 0 .and. power > 1) then
           xx = p(1)**power
           factor = factor * power * xx / p(1)
        end if
     end if
     if (.not. vanishes (xx)) then
        r(1) = xx ** yy
        r(2) = xx / r(1)
        factor = factor * abs (log (xx))
     else
        r = 0
     end if
   end subroutine map_unit_square
 
 @ %def map_unit_square
 @ This is the inverse mapping.
 <<SF mappings: procedures>>=
   subroutine map_unit_square_inverse (r, factor, p, power)
     real(kind=default), dimension(2), intent(in) :: r
     real(kind=default), intent(out) :: factor
     real(kind=default), dimension(2), intent(out) :: p
     real(kind=default), intent(in), optional :: power
     real(kind=default) :: lg, xx, yy
     factor = 1
     xx = r(1) * r(2)
     if (.not. vanishes (xx)) then
        lg = log (xx)
        if (.not. vanishes (lg)) then
           yy = log (r(1)) / lg
        else
           yy = 0
        end if
        p(2) = yy
        factor = factor * abs (lg)
        if (present(power)) then
           p(1) = xx**(1._default/power)
           factor = factor * power * xx / p(1)
        else
           p(1) = xx
        end if
     else
        p = 0
     end if
   end subroutine map_unit_square_inverse
 
 @ %def map_unit_square_inverse
 @
 \subsubsection{Precise mapping of the unit square}
 A more precise version (with unit power parameter).  This version
 should be numerically stable near $x=1$ and $y=0,1$.  The formulas are again
 \begin{equation}
   r_1 = p_1^{p_2}, \qquad
   r_2 = p_1^{\bar p_2}, \qquad
   f = - \log p_1
 \end{equation}
 but we compute both $r_i$ and $\bar r_i$ simultaneously and make
 direct use of both $p_i$ and $\bar p_i$ as appropriate.
 <<SF mappings: procedures>>=
   subroutine map_unit_square_prec (r, rb, factor, p, pb)
     real(default), dimension(2), intent(out) :: r
     real(default), dimension(2), intent(out) :: rb
     real(default), intent(out) :: factor
     real(default), dimension(2), intent(in) :: p
     real(default), dimension(2), intent(in) :: pb
     if (p(1) > 0.5_default) then
        call compute_prec_xy_1 (r(1), rb(1), p(1), pb(1), p (2))
        call compute_prec_xy_1 (r(2), rb(2), p(1), pb(1), pb(2))
        factor = - log_prec (p(1), pb(1))
     else if (.not. vanishes (p(1))) then
        call compute_prec_xy_0 (r(1), rb(1), p(1), pb(1), p (2))
        call compute_prec_xy_0 (r(2), rb(2), p(1), pb(1), pb(2))
        factor = - log_prec (p(1), pb(1))
     else
        r  = 0
        rb = 1
        factor = 0
     end if
   end subroutine map_unit_square_prec
 
 @ %def map_unit_square_prec
 @ This is the inverse mapping.
 <<SF mappings: procedures>>=
   subroutine map_unit_square_inverse_prec (r, rb, factor, p, pb)
     real(default), dimension(2), intent(in) :: r
     real(default), dimension(2), intent(in) :: rb
     real(default), intent(out) :: factor
     real(default), dimension(2), intent(out) :: p
     real(default), dimension(2), intent(out) :: pb
     call inverse_prec_x (r, rb, p(1), pb(1))
     if (all (r > 0)) then
        if (rb(1) < rb(2)) then
           call inverse_prec_y (r, rb, p(2), pb(2))
        else
           call inverse_prec_y ([r(2),r(1)], [rb(2),rb(1)], pb(2), p(2))
        end if
        factor = - log_prec (p(1), pb(1))
     else
        p(1)  = 0
        pb(1) = 1
        p(2)  = 0.5_default
        pb(2) = 0.5_default
        factor = 0
     end if
   end subroutine map_unit_square_inverse_prec
 
 @ %def map_unit_square_prec_inverse
 @ This is an auxiliary function: evaluate the expression $\bar z = 1 -
 x^y$ in a numerically stable way.  Instabilities occur for $y=0$ and
 $x=1$.  The idea is to replace the bracket by the first terms of its
 Taylor expansion around $x=1$ (read $\bar x\equiv 1 -x$)
 \begin{equation}
   1 - x^y = y\bar x\left(1 + \frac12(1-y)\bar x +
     \frac16(2-y)(1-y)\bar x^2\right)
 \end{equation}
 whenever this is the better approximation.  Actually, the relative
 numerical error of the exact formula is about $\eta/(y\bar x)$ where
 $\eta$ is given by [[epsilon(KIND)]] in Fortran.  The relative error
 of the approximation is better than the last included term divided by
 $(y\bar x)$.
 
 The first subroutine computes $z$ and $\bar z$ near $x=1$ where $\log
 x$ should be expanded, the second one near $x=0$ where $\log x$ can be
 kept.
 <<SF mappings: procedures>>=
   subroutine compute_prec_xy_1 (z, zb, x, xb, y)
     real(default), intent(out) :: z, zb
     real(default), intent(in) :: x, xb, y
     real(default) :: a1, a2, a3
     a1 = y * xb
     a2 = a1 * (1 - y) * xb / 2
     a3 = a2 * (2 - y) * xb / 3
     if (abs (a3) < epsilon (a3)) then
        zb = a1 + a2 + a3
        z = 1 - zb
     else
        z = x ** y
        zb = 1 - z
     end if
   end subroutine compute_prec_xy_1
 
   subroutine compute_prec_xy_0 (z, zb, x, xb, y)
     real(default), intent(out) :: z, zb
     real(default), intent(in) :: x, xb, y
     real(default) :: a1, a2, a3, lx
     lx = -log (x)
     a1 = y * lx
     a2 = a1 * y * lx / 2
     a3 = a2 * y * lx / 3
     if (abs (a3) < epsilon (a3)) then
        zb = a1 + a2 + a3
        z = 1 - zb
     else
        z = x ** y
        zb = 1 - z
     end if
   end subroutine compute_prec_xy_0
 
 @ %def compute_prec_xy_1
 @ %def compute_prec_xy_0
 @ For the inverse calculation, we evaluate $x=r_1r_2$ in a stable way.
 Since it is just a polynomial, the expansion near $x=1$ is
 analytically exact, and we don't need to choose based on precision.
 <<SF mappings: procedures>>=
   subroutine inverse_prec_x (r, rb, x, xb)
     real(default), dimension(2), intent(in) :: r, rb
     real(default), intent(out) :: x, xb
     real(default) :: a0, a1
     a0 = rb(1) + rb(2)
     a1 = rb(1) * rb(2)
     if (a0 > 0.5_default) then
        xb = a0 - a1
        x = 1 - xb
     else
        x = r(1) * r(2)
        xb = 1 - x
     end if
   end subroutine inverse_prec_x
 
 @ %def inverse_prec_x
 @ The inverse calculation for the relative momentum fraction
 \begin{equation}
   y = \frac{1}{1 + \frac{\log{r_2}}{\log{r_1}}}
 \end{equation}
 is slightly more complicated.  We should take the precise form of the
 logarithm, so we are safe near $r_i=1$.  A series expansion is
 required if $r_1\ll r_2$, since then $y$ becomes small.  (We assume
 $r_1<r_2$ here; for the opposite case, the arguments can be
 exchanged.)
 <<SF mappings: procedures>>=
   subroutine inverse_prec_y (r, rb, y, yb)
     real(default), dimension(2), intent(in) :: r, rb
     real(default), intent(out) :: y, yb
     real(default) :: log1, log2, a1, a2, a3
     log1 = log_prec (r(1), rb(1))
     log2 = log_prec (r(2), rb(2))
     if (abs (log2**3) < epsilon (one)) then
        if (abs(log1) < epsilon (one)) then
           y = zero
        else
           y = one / (one + log2 / log1)
        end if
        if (abs(log2) < epsilon (one)) then
           yb = zero
        else
           yb = one / (one + log1 / log2)
        end if
        return
     end if
     a1 = - rb(1) / log2
     a2 = - rb(1) ** 2 * (one / log2**2 + one / (2 * log2))
     a3 = - rb(1) ** 3 * (one / log2**3 + one / log2**2 + one/(3 * log2))
     if (abs (a3) < epsilon (a3)) then
        y  = a1 + a2 + a3
        yb = one - y
     else
        y  = one / (one + log2 / log1)
        yb = one / (one + log1 / log2)
     end if
   end subroutine inverse_prec_y
 
 @ %def inverse_prec_y
 @
 \subsubsection{Mapping for on-shell s-channel}
 The limiting case, if the product $r_1r_2$ is fixed for on-shell
 production.  The parameter $p_1$ is ignored.  In the inverse mapping,
 it is returned zero.
 
 The parameter [[x_free]], if present, rescales the total energy.  If
 it is less than one, the rescaled mass parameter $m^2$ should be increased
 accordingly.
 
 Public for access in unit test.
 <<SF mappings: public>>=
   public :: map_on_shell
   public :: map_on_shell_inverse
 <<SF mappings: procedures>>=
   subroutine map_on_shell (r, factor, p, lm2, x_free)
     real(default), dimension(2), intent(out) :: r
     real(default), intent(out) :: factor
     real(default), dimension(2), intent(in) :: p
     real(default), intent(in) :: lm2
     real(default), intent(in), optional :: x_free
     real(default) :: lx
     lx = lm2;  if (present (x_free))  lx = lx + log (x_free)
     r(1) = exp (- p(2) * lx)
     r(2) = exp (- (1 - p(2)) * lx)
     factor = lx
   end subroutine map_on_shell
 
   subroutine map_on_shell_inverse (r, factor, p, lm2, x_free)
     real(default), dimension(2), intent(in) :: r
     real(default), intent(out) :: factor
     real(default), dimension(2), intent(out) :: p
     real(default), intent(in) :: lm2
     real(default), intent(in), optional :: x_free
     real(default) :: lx
     lx = lm2;  if (present (x_free))  lx = lx + log (x_free)
     p(1) = 0
     p(2) = abs (log (r(1))) / lx
     factor = lx
   end subroutine map_on_shell_inverse
 
 @ %def map_on_shell
 @ %def map_on_shell_inverse
 @
 \subsubsection{Mapping for on-shell s-channel, single parameter}
 This is a pseudo-mapping which applies if there is actually just one
 parameter [[p]].  The output parameter [[r]] is fixed for on-shell
 production.  The lone parameter $p_1$ is ignored.  In the inverse mapping,
 it is returned zero.
 
 The parameter [[x_free]], if present, rescales the total energy.  If
 it is less than one, the rescaled mass parameter $m^2$ should be increased
 accordingly.
 
 Public for access in unit test.
 <<SF mappings: public>>=
   public :: map_on_shell_single
   public :: map_on_shell_single_inverse
 <<SF mappings: procedures>>=
   subroutine map_on_shell_single (r, factor, p, lm2, x_free)
     real(default), dimension(1), intent(out) :: r
     real(default), intent(out) :: factor
     real(default), dimension(1), intent(in) :: p
     real(default), intent(in) :: lm2
     real(default), intent(in), optional :: x_free
     real(default) :: lx
     lx = lm2;  if (present (x_free))  lx = lx + log (x_free)
     r(1) = exp (- lx)
     factor = 1
   end subroutine map_on_shell_single
 
   subroutine map_on_shell_single_inverse (r, factor, p, lm2, x_free)
     real(default), dimension(1), intent(in) :: r
     real(default), intent(out) :: factor
     real(default), dimension(1), intent(out) :: p
     real(default), intent(in) :: lm2
     real(default), intent(in), optional :: x_free
     real(default) :: lx
     lx = lm2;  if (present (x_free))  lx = lx + log (x_free)
     p(1) = 0
     factor = 1
   end subroutine map_on_shell_single_inverse
 
 @ %def map_on_shell_single
 @ %def map_on_shell_single_inverse
 @
 \subsubsection{Mapping for a Breit-Wigner resonance}
 This is the standard Breit-Wigner mapping.  We apply it to a single
 variable, independently of or in addition to a unit-square mapping.  We
 assume here that the limits for the variable are 0 and 1, and that the
 mass $m$ and width $w$ are rescaled appropriately, so they are
 dimensionless and usually between 0 and 1.
 
 If [[x_free]] is set, it rescales the total energy and thus mass and
 width, since these are defined with respect to the total energy.
 <<SF mappings: procedures>>=
   subroutine map_breit_wigner (r, factor, p, m, w, x_free)
     real(default), intent(out) :: r
     real(default), intent(out) :: factor
     real(default), intent(in) :: p
     real(default), intent(in) :: m
     real(default), intent(in) :: w
     real(default), intent(in), optional :: x_free
     real(default) :: m2, mw, a1, a2, a3, z, tmp
     m2 = m ** 2
     mw = m * w
     if (present (x_free)) then
        m2 = m2 / x_free
        mw = mw / x_free
     end if
     a1 = atan (- m2 / mw)
     a2 = atan ((1 - m2) / mw)
     a3 = (a2 - a1) * mw
     z = (1-p) * a1 + p * a2
     if (-pi/2 < z .and. z < pi/2) then
        tmp = tan (z)
        r = max (m2 + mw * tmp, 0._default)
        factor = a3 * (1 + tmp ** 2)
     else
        r = 0
        factor = 0
     end if
   end subroutine map_breit_wigner
 
   subroutine map_breit_wigner_inverse (r, factor, p, m, w, x_free)
     real(default), intent(in) :: r
     real(default), intent(out) :: factor
     real(default), intent(out) :: p
     real(default), intent(in) :: m
     real(default), intent(in) :: w
     real(default) :: m2, mw, a1, a2, a3, tmp
     real(default), intent(in), optional :: x_free
     m2 = m ** 2
     mw = m * w
     if (present (x_free)) then
        m2 = m2 / x_free
        mw = mw / x_free
     end if
     a1 = atan (- m2 / mw)
     a2 = atan ((1 - m2) / mw)
     a3 = (a2 - a1) * mw
     tmp = (r - m2) / mw
     p = (atan (tmp) - a1) / (a2 - a1)
     factor = a3 * (1 + tmp ** 2)
   end subroutine map_breit_wigner_inverse
 
 @ %def map_breit_wigner
 @ %def map_breit_wigner_inverse
 @
 \subsubsection{Mapping with endpoint enhancement}
 This is a mapping which is close to the unit mapping, except that at
 the endpoint(s), the output values are exponentially enhanced.
 \begin{equation}
   y = \tanh (a \tan (\frac{\pi}{2}x))
 \end{equation}
 We have two variants: one covers endpoints at $0$ and $1$
 symmetrically, while the other one (which essentially maps one-half of
 the range), covers only the endpoint at $1$.
 <<SF mappings: procedures>>=
   subroutine map_endpoint_1 (x3, factor, x1, a)
     real(default), intent(out) :: x3, factor
     real(default), intent(in) :: x1
     real(default), intent(in) :: a
     real(default) :: x2
     if (abs (x1) < 1) then
        x2 = tan (x1 * pi / 2)
        x3 = tanh (a * x2)
        factor = a * pi/2 * (1 + x2 ** 2) * (1 - x3 ** 2)
     else
        x3 = x1
        factor = 0
     end if
   end subroutine map_endpoint_1
 
   subroutine map_endpoint_inverse_1 (x3, factor, x1, a)
     real(default), intent(in) :: x3
     real(default), intent(out) :: x1, factor
     real(default), intent(in) :: a
     real(default) :: x2
     if (abs (x3) < 1) then
        x2 = atanh (x3) / a
        x1 = 2 / pi * atan (x2)
        factor = a * pi/2 * (1 + x2 ** 2) * (1 - x3 ** 2)
     else
        x1 = x3
        factor = 0
     end if
   end subroutine map_endpoint_inverse_1
 
   subroutine map_endpoint_01 (x4, factor, x0, a)
     real(default), intent(out) :: x4, factor
     real(default), intent(in) :: x0
     real(default), intent(in) :: a
     real(default) :: x1, x3
     x1 = 2 * x0 - 1
     call map_endpoint_1 (x3, factor, x1, a)
     x4 = (x3 + 1) / 2
   end subroutine map_endpoint_01
 
   subroutine map_endpoint_inverse_01 (x4, factor, x0, a)
     real(default), intent(in) :: x4
     real(default), intent(out) :: x0, factor
     real(default), intent(in) :: a
     real(default) :: x1, x3
     x3 = 2 * x4 - 1
     call map_endpoint_inverse_1 (x3, factor, x1, a)
     x0 = (x1 + 1) / 2
   end subroutine map_endpoint_inverse_01
 
 @ %def map_endpoint_1
 @ %def map_endpoint_inverse_1
 @ %def map_endpoint_01
 @ %def map_endpoint_inverse_01
 @
 \subsubsection{Mapping with endpoint enhancement (ISR)}
 This is another endpoint mapping.  It is designed to flatten the ISR
 singularity which is of power type at $x=1$, i.e., if
 \begin{equation}
   \sigma = \int_0^1 dx\,f(x)\,G(x)
   = \int_0^1 dx\,\epsilon(1-x)^{-1+\epsilon} G(x),
 \end{equation}
 we replace this by
 \begin{equation}
   r = x^\epsilon \quad\Longrightarrow\quad
   \sigma = \int_0^1 dr\,G(1- (1-r)^{1/\epsilon}).
 \end{equation}
 We expect that $\epsilon$ is small.
 
 The actual mapping is $r\to x$ (so $x$ emerges closer to $1$).  The
 Jacobian that we return is thus $1/f(x)$.  We compute the mapping in
 terms of $\bar x\equiv 1 - x$, so we can achieve the required precision.
 Because some compilers show quite wild numeric fluctuations, we
 internally convert numeric types to explicit [[double]] precision.
 <<SF mappings: public>>=
   public :: map_power_1
   public :: map_power_inverse_1
 <<SF mappings: procedures>>=
   subroutine map_power_1 (xb, factor, rb, eps)
     real(default), intent(out) :: xb, factor
     real(default), intent(in) :: rb
     real(double) :: rb_db, factor_db, eps_db, xb_db
     real(default), intent(in) :: eps
     rb_db = real (rb, kind=double)
     eps_db = real (eps, kind=double)
     xb_db = rb_db ** (1 / eps_db)
     if (rb_db > 0) then
        factor_db = xb_db / rb_db / eps_db
        factor = real (factor_db, kind=default)
     else
        factor = 0
     end if
     xb = real (xb_db, kind=default)
   end subroutine map_power_1
 
   subroutine map_power_inverse_1 (xb, factor, rb, eps)
     real(default), intent(in) :: xb
     real(default), intent(out) :: rb, factor
     real(double) :: xb_db, factor_db, eps_db, rb_db
     real(default), intent(in) :: eps
     xb_db = real (xb, kind=double)
     eps_db = real (eps, kind=double)
     rb_db = xb_db ** eps_db
     if (xb_db > 0) then
        factor_db = xb_db / rb_db / eps_db
        factor = real (factor_db, kind=default)
     else
        factor = 0
     end if
     rb = real (rb_db, kind=default)
   end subroutine map_power_inverse_1
 
 @ %def map_power_1
 @ %def map_power_inverse_1
 @ Here we apply a power mapping to both endpoints.  We divide the
 interval in two equal halves and apply the power mapping for the
 nearest endpoint, either $0$ or $1$.
 <<SF mappings: procedures>>=
   subroutine map_power_01 (y, yb, factor, r, eps)
     real(default), intent(out) :: y, yb, factor
     real(default), intent(in) :: r
     real(default), intent(in) :: eps
     real(default) :: u, ub, zp, zm
     u = 2 * r - 1
     if (u > 0) then
        ub = 2 * (1 - r)
        call map_power_1 (zm, factor, ub, eps)
        zp = 2 - zm
     else if (u < 0) then
        ub = 2 * r
        call map_power_1 (zp, factor, ub, eps)
        zm = 2 - zp
     else
        factor = 1 / eps
        zp = 1
        zm = 1
     end if
     y  = zp / 2
     yb = zm / 2
   end subroutine map_power_01
 
   subroutine map_power_inverse_01 (y, yb, factor, r, eps)
     real(default), intent(in) :: y, yb
     real(default), intent(out) :: r, factor
     real(default), intent(in) :: eps
     real(default) :: ub, zp, zm
     zp = 2 * y
     zm = 2 * yb
     if (zm < zp) then
        call map_power_inverse_1 (zm, factor, ub, eps)
        r = 1 - ub / 2
     else if (zp < zm) then
        call map_power_inverse_1 (zp, factor, ub, eps)
        r = ub / 2
     else
        factor = 1 / eps
        ub = 1
        r = ub / 2
     end if
   end subroutine map_power_inverse_01
 
 @ %def map_power_01
 @ %def map_power_inverse_01
 @
 \subsubsection{Structure-function channels}
 A structure-function chain parameterization (channel) may contain a
 mapping that applies to multiple structure functions.  This is
 described by an extension of the [[sf_mapping_t]] type.  In addition,
 it may contain mappings that apply to (other) individual structure
 functions.  The details of these mappings are implementation-specific.
 
 The [[sf_channel_t]] type combines this information.  It contains an
 array of map codes, one for each structure-function entry.  The code
 values are:
 \begin{description}
 \item[none] MC input parameters $r$ directly become energy fractions $x$
 \item[single] default mapping for a single structure-function entry
 \item[multi/s] map $r\to x$ such that one MC input parameter is $\hat s/s$
 \item[multi/resonance] as before, adapted to s-channel resonance
 \item[multi/on-shell] as before, adapted to an on-shell particle in
   the s channel
 \item[multi/endpoint] like multi/s, but enhance the region near $r_i=1$
 \item[multi/endpoint/res] endpoint mapping with resonance
 \item[multi/endpoint/os] endpoint mapping for on-shell
 \item[multi/power/os] like multi/endpoint, regulating a power singularity
 \end{description}
 <<SF mappings: parameters>>=
   integer, parameter :: SFMAP_NONE = 0
   integer, parameter :: SFMAP_SINGLE = 1
   integer, parameter :: SFMAP_MULTI_S = 2
   integer, parameter :: SFMAP_MULTI_RES = 3
   integer, parameter :: SFMAP_MULTI_ONS = 4
   integer, parameter :: SFMAP_MULTI_EP = 5
   integer, parameter :: SFMAP_MULTI_EPR = 6
   integer, parameter :: SFMAP_MULTI_EPO = 7
   integer, parameter :: SFMAP_MULTI_IP = 8
   integer, parameter :: SFMAP_MULTI_IPR = 9
   integer, parameter :: SFMAP_MULTI_IPO = 10
   integer, parameter :: SFMAP_MULTI_EI = 11
   integer, parameter :: SFMAP_MULTI_SRS = 13
   integer, parameter :: SFMAP_MULTI_SON = 14
 
 @ %def SFMAP_NONE SFMAP_SINGLE
 @ %def SFMAP_MULTI_S SFMAP_MULTI_RES SFMAP_MULTI_ONS
 @ %def SFMAP_MULTI_EP SFMAP_MULTI_EPR SFMAP_MULTI_EPO
 @ %def SFMAP_MULTI_IP SFMAP_MULTI_IPR SFMAP_MULTI_IPO
 @ %def SFMAP_MULTI_EI
 @ %def SFMAP_MULTI_SRS SFMAP_MULTI_SON
 @ Then, it contains an allocatable entry for the multi mapping.  This
 entry holds the MC-parameter indices on which the mapping applies
 (there may be more than one MC parameter per structure-function entry)
 and any parameters associated with the mapping.
 
 There can be only one multi-mapping per channel.
 <<SF mappings: public>>=
   public :: sf_channel_t
 <<SF mappings: types>>=
   type :: sf_channel_t
      integer, dimension(:), allocatable :: map_code
      class(sf_mapping_t), allocatable :: multi_mapping
    contains
    <<SF mappings: sf channel: TBP>>
   end type sf_channel_t
 
 @ %def sf_channel_t
 @ The output format prints a single character for each
 structure-function entry and, if applicable, an account of the mapping
 parameters.
 <<SF mappings: sf channel: TBP>>=
   procedure :: write => sf_channel_write
 <<SF mappings: procedures>>=
   subroutine sf_channel_write (object, unit)
     class(sf_channel_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     if (allocated (object%map_code)) then
        do i = 1, size (object%map_code)
           select case (object%map_code (i))
           case (SFMAP_NONE)
              write (u, "(1x,A)", advance="no") "-"
           case (SFMAP_SINGLE)
              write (u, "(1x,A)", advance="no") "+"
           case (SFMAP_MULTI_S)
              write (u, "(1x,A)", advance="no") "s"
           case (SFMAP_MULTI_RES, SFMAP_MULTI_SRS)
              write (u, "(1x,A)", advance="no") "r"
           case (SFMAP_MULTI_ONS, SFMAP_MULTI_SON)
              write (u, "(1x,A)", advance="no") "o"
           case (SFMAP_MULTI_EP)
              write (u, "(1x,A)", advance="no") "e"
           case (SFMAP_MULTI_EPR)
              write (u, "(1x,A)", advance="no") "p"
           case (SFMAP_MULTI_EPO)
              write (u, "(1x,A)", advance="no") "q"
           case (SFMAP_MULTI_IP)
              write (u, "(1x,A)", advance="no") "i"
           case (SFMAP_MULTI_IPR)
              write (u, "(1x,A)", advance="no") "i"
           case (SFMAP_MULTI_IPO)
              write (u, "(1x,A)", advance="no") "i"
           case (SFMAP_MULTI_EI)
              write (u, "(1x,A)", advance="no") "i"
           case default
              write (u, "(1x,A)", advance="no") "?"
           end select
        end do
     else
        write (u, "(1x,A)", advance="no") "-"
     end if
     if (allocated (object%multi_mapping)) then
        write (u, "(1x,'/')", advance="no")
        call object%multi_mapping%write (u)
     else
        write (u, *)
     end if
   end subroutine sf_channel_write
 
 @ %def sf_channel_write
 @ Initializer for a single [[sf_channel]] object.
 <<SF mappings: sf channel: TBP>>=
   procedure :: init => sf_channel_init
 <<SF mappings: procedures>>=
   subroutine sf_channel_init (channel, n_strfun)
     class(sf_channel_t), intent(out) :: channel
     integer, intent(in) :: n_strfun
     allocate (channel%map_code (n_strfun))
     channel%map_code = SFMAP_NONE
   end subroutine sf_channel_init
 
 @ %def sf_channel_init
 @ Assignment.  This merely copies intrinsic assignment.
 <<SF mappings: sf channel: TBP>>=
   generic :: assignment (=) => sf_channel_assign
   procedure :: sf_channel_assign
 <<SF mappings: procedures>>=
   subroutine sf_channel_assign (copy, original)
     class(sf_channel_t), intent(out) :: copy
     type(sf_channel_t), intent(in) :: original
     allocate (copy%map_code (size (original%map_code)))
     copy%map_code = original%map_code
     if (allocated (original%multi_mapping)) then
          allocate (copy%multi_mapping, source = original%multi_mapping)
     end if
   end subroutine sf_channel_assign
 
 @ %def sf_channel_assign
 @ This initializer allocates an array of channels with common number of
 structure-function entries, therefore it is not a type-bound procedure.
 <<SF mappings: public>>=
   public :: allocate_sf_channels
 <<SF mappings: procedures>>=
   subroutine allocate_sf_channels (channel, n_channel, n_strfun)
     type(sf_channel_t), dimension(:), intent(out), allocatable :: channel
     integer, intent(in) :: n_channel
     integer, intent(in) :: n_strfun
     integer :: c
     allocate (channel (n_channel))
     do c = 1, n_channel
        call channel(c)%init (n_strfun)
     end do
   end subroutine allocate_sf_channels
 
 @ %def allocate_sf_channels
 @ This marks a given subset of indices as single-mapping.
 <<SF mappings: sf channel: TBP>>=
   procedure :: activate_mapping => sf_channel_activate_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_activate_mapping (channel, i_sf)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     channel%map_code(i_sf) = SFMAP_SINGLE
   end subroutine sf_channel_activate_mapping
 
 @ %def sf_channel_activate_mapping
 @ This sets an s-channel multichannel mapping.  The parameter indices
 are not yet set.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_s_mapping => sf_channel_set_s_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_s_mapping (channel, i_sf, power)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in), optional :: power
     channel%map_code(i_sf) = SFMAP_MULTI_S
     allocate (sf_s_mapping_t :: channel%multi_mapping)
     select type (mapping => channel%multi_mapping)
     type is (sf_s_mapping_t)
        call mapping%init (power)
     end select
   end subroutine sf_channel_set_s_mapping
 
 @ %def sf_channel_set_s_mapping
 @ This sets an s-channel resonance multichannel mapping.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_res_mapping => sf_channel_set_res_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_res_mapping (channel, i_sf, m, w, single)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in) :: m, w
     logical, intent(in) :: single
     if (single) then
        channel%map_code(i_sf) = SFMAP_MULTI_SRS
        allocate (sf_res_mapping_single_t :: channel%multi_mapping)
        select type (mapping => channel%multi_mapping)
        type is (sf_res_mapping_single_t)
           call mapping%init (m, w)
        end select
     else
        channel%map_code(i_sf) = SFMAP_MULTI_RES
        allocate (sf_res_mapping_t :: channel%multi_mapping)
        select type (mapping => channel%multi_mapping)
        type is (sf_res_mapping_t)
           call mapping%init (m, w)
        end select
     end if
   end subroutine sf_channel_set_res_mapping
 
 @ %def sf_channel_set_res_mapping
 @ This sets an s-channel on-shell multichannel mapping.  The length of the
 [[i_sf]] array must be 2.  (The first parameter actually becomes an
 irrelevant dummy.)
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_os_mapping => sf_channel_set_os_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_os_mapping (channel, i_sf, m, single)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in) :: m
     logical, intent(in) :: single
     if (single) then
        channel%map_code(i_sf) = SFMAP_MULTI_SON
        allocate (sf_os_mapping_single_t :: channel%multi_mapping)
        select type (mapping => channel%multi_mapping)
        type is (sf_os_mapping_single_t)
           call mapping%init (m)
        end select
     else
        channel%map_code(i_sf) = SFMAP_MULTI_ONS
        allocate (sf_os_mapping_t :: channel%multi_mapping)
        select type (mapping => channel%multi_mapping)
        type is (sf_os_mapping_t)
           call mapping%init (m)
        end select
     end if
   end subroutine sf_channel_set_os_mapping
 
 @ %def sf_channel_set_os_mapping
 @ This sets an s-channel endpoint mapping.  The parameter $a$ is the
 slope parameter (default 1); increasing it moves the endpoint region
 (at $x=1$ to lower values in the input parameter.
 region even more.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_ep_mapping => sf_channel_set_ep_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_ep_mapping (channel, i_sf, a)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in), optional :: a
     channel%map_code(i_sf) = SFMAP_MULTI_EP
     allocate (sf_ep_mapping_t :: channel%multi_mapping)
     select type (mapping => channel%multi_mapping)
     type is (sf_ep_mapping_t)
        call mapping%init (a = a)
     end select
   end subroutine sf_channel_set_ep_mapping
 
 @ %def sf_channel_set_ep_mapping
 @ This sets a resonant endpoint mapping.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_epr_mapping => sf_channel_set_epr_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_epr_mapping (channel, i_sf, a, m, w)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in) :: a, m, w
     channel%map_code(i_sf) = SFMAP_MULTI_EPR
     allocate (sf_epr_mapping_t :: channel%multi_mapping)
     select type (mapping => channel%multi_mapping)
     type is (sf_epr_mapping_t)
        call mapping%init (a, m, w)
     end select
   end subroutine sf_channel_set_epr_mapping
 
 @ %def sf_channel_set_epr_mapping
 @ This sets an on-shell endpoint mapping.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_epo_mapping => sf_channel_set_epo_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_epo_mapping (channel, i_sf, a, m)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in) :: a, m
     channel%map_code(i_sf) = SFMAP_MULTI_EPO
     allocate (sf_epo_mapping_t :: channel%multi_mapping)
     select type (mapping => channel%multi_mapping)
     type is (sf_epo_mapping_t)
        call mapping%init (a, m)
     end select
   end subroutine sf_channel_set_epo_mapping
 
 @ %def sf_channel_set_epo_mapping
 @ This sets an s-channel power mapping, regulating a singularity of
 type $(1-x)^{-1+\epsilon}$.  The parameter $\epsilon$ depends on the
 structure function.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_ip_mapping => sf_channel_set_ip_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_ip_mapping (channel, i_sf, eps)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in), optional :: eps
     channel%map_code(i_sf) = SFMAP_MULTI_IP
     allocate (sf_ip_mapping_t :: channel%multi_mapping)
     select type (mapping => channel%multi_mapping)
     type is (sf_ip_mapping_t)
        call mapping%init (eps)
     end select
   end subroutine sf_channel_set_ip_mapping
 
 @ %def sf_channel_set_ip_mapping
 @ This sets an s-channel resonant power mapping, regulating a
 singularity of type $(1-x)^{-1+\epsilon}$ in the presence of an
 s-channel resonance.  The parameter $\epsilon$ depends on the
 structure function.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_ipr_mapping => sf_channel_set_ipr_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_ipr_mapping (channel, i_sf, eps, m, w)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in), optional :: eps, m, w
     channel%map_code(i_sf) = SFMAP_MULTI_IPR
     allocate (sf_ipr_mapping_t :: channel%multi_mapping)
     select type (mapping => channel%multi_mapping)
     type is (sf_ipr_mapping_t)
        call mapping%init (eps, m, w)
     end select
   end subroutine sf_channel_set_ipr_mapping
 
 @ %def sf_channel_set_ipr_mapping
 @ This sets an on-shell power mapping, regulating a
 singularity of type $(1-x)^{-1+\epsilon}$ for the production of a
 single on-shell particle..  The parameter $\epsilon$ depends on the
 structure function.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_ipo_mapping => sf_channel_set_ipo_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_ipo_mapping (channel, i_sf, eps, m)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in), optional :: eps, m
     channel%map_code(i_sf) = SFMAP_MULTI_IPO
     allocate (sf_ipo_mapping_t :: channel%multi_mapping)
     select type (mapping => channel%multi_mapping)
     type is (sf_ipo_mapping_t)
        call mapping%init (eps, m)
     end select
   end subroutine sf_channel_set_ipo_mapping
 
 @ %def sf_channel_set_ipo_mapping
 @ This sets a combined endpoint/ISR mapping.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_ei_mapping => sf_channel_set_ei_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_ei_mapping (channel, i_sf, a, eps)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in), optional :: a, eps
     channel%map_code(i_sf) = SFMAP_MULTI_EI
     allocate (sf_ei_mapping_t :: channel%multi_mapping)
     select type (mapping => channel%multi_mapping)
     type is (sf_ei_mapping_t)
        call mapping%init (a, eps)
     end select
   end subroutine sf_channel_set_ei_mapping
 
 @ %def sf_channel_set_ei_mapping
 @ This sets a combined endpoint/ISR mapping with resonance.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_eir_mapping => sf_channel_set_eir_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_eir_mapping (channel, i_sf, a, eps, m, w)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in), optional :: a, eps, m, w
     channel%map_code(i_sf) = SFMAP_MULTI_EI
     allocate (sf_eir_mapping_t :: channel%multi_mapping)
     select type (mapping => channel%multi_mapping)
     type is (sf_eir_mapping_t)
        call mapping%init (a, eps, m, w)
     end select
   end subroutine sf_channel_set_eir_mapping
 
 @ %def sf_channel_set_eir_mapping
 @ This sets a combined endpoint/ISR mapping, on-shell.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_eio_mapping => sf_channel_set_eio_mapping
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_eio_mapping (channel, i_sf, a, eps, m)
     class(sf_channel_t), intent(inout) :: channel
     integer, dimension(:), intent(in) :: i_sf
     real(default), intent(in), optional :: a, eps, m
     channel%map_code(i_sf) = SFMAP_MULTI_EI
     allocate (sf_eio_mapping_t :: channel%multi_mapping)
     select type (mapping => channel%multi_mapping)
     type is (sf_eio_mapping_t)
        call mapping%init (a, eps, m)
     end select
   end subroutine sf_channel_set_eio_mapping
 
 @ %def sf_channel_set_eio_mapping
 @ Return true if the mapping code at position [[i_sf]] is [[SFMAP_SINGLE]].
 <<SF mappings: sf channel: TBP>>=
   procedure :: is_single_mapping => sf_channel_is_single_mapping
 <<SF mappings: procedures>>=
   function sf_channel_is_single_mapping (channel, i_sf) result (flag)
     class(sf_channel_t), intent(in) :: channel
     integer, intent(in) :: i_sf
     logical :: flag
     flag = channel%map_code(i_sf) == SFMAP_SINGLE
   end function sf_channel_is_single_mapping
 
 @ %def sf_channel_is_single_mapping
 @ Return true if the mapping code at position [[i_sf]] is any of the
 [[SFMAP_MULTI]] mappings.
 <<SF mappings: sf channel: TBP>>=
   procedure :: is_multi_mapping => sf_channel_is_multi_mapping
 <<SF mappings: procedures>>=
   function sf_channel_is_multi_mapping (channel, i_sf) result (flag)
     class(sf_channel_t), intent(in) :: channel
     integer, intent(in) :: i_sf
     logical :: flag
     select case (channel%map_code(i_sf))
     case (SFMAP_NONE, SFMAP_SINGLE)
        flag = .false.
     case default
        flag = .true.
     end select
   end function sf_channel_is_multi_mapping
 
 @ %def sf_channel_is_multi_mapping
 @ Return the number of parameters that the multi-mapping requires.  The
 mapping object must be allocated.
 <<SF mappings: sf channel: TBP>>=
   procedure :: get_multi_mapping_n_par => sf_channel_get_multi_mapping_n_par
 <<SF mappings: procedures>>=
   function sf_channel_get_multi_mapping_n_par (channel) result (n_par)
     class(sf_channel_t), intent(in) :: channel
     integer :: n_par
     if (allocated (channel%multi_mapping)) then
        n_par = channel%multi_mapping%get_n_dim ()
     else
        n_par = 0
     end if
   end function sf_channel_get_multi_mapping_n_par
 
 @ %def sf_channel_is_multi_mapping
 @ Return true if there is any nontrivial mapping in any of the channels.
 <<SF mappings: public>>=
   public :: any_sf_channel_has_mapping
 <<SF mappings: procedures>>=
   function any_sf_channel_has_mapping (channel) result (flag)
     type(sf_channel_t), dimension(:), intent(in) :: channel
     logical :: flag
     integer :: c
     flag = .false.
     do c = 1, size (channel)
        flag = flag .or. any (channel(c)%map_code /= SFMAP_NONE)
     end do
   end function any_sf_channel_has_mapping
 
 @ %def any_sf_channel_has_mapping
 @ Set a parameter index for an active multi mapping.  We assume that
 the index array is allocated properly.
 <<SF mappings: sf channel: TBP>>=
   procedure :: set_par_index => sf_channel_set_par_index
 <<SF mappings: procedures>>=
   subroutine sf_channel_set_par_index (channel, j, i_par)
     class(sf_channel_t), intent(inout) :: channel
     integer, intent(in) :: j
     integer, intent(in) :: i_par
     associate (mapping => channel%multi_mapping)
       if (j >= 1 .and. j <= mapping%get_n_dim ()) then
          if (mapping%get_index (j) == 0) then
             call channel%multi_mapping%set_index (j, i_par)
          else
             call msg_bug ("Structure-function setup: mapping index set twice")
          end if
       else
          call msg_bug ("Structure-function setup: mapping index out of range")
       end if
     end associate
   end subroutine sf_channel_set_par_index
 
 @ %def sf_channel_set_par_index
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_mappings_ut.f90]]>>=
 <<File header>>
 
 module sf_mappings_ut
   use unit_tests
   use sf_mappings_uti
 
 <<Standard module head>>
 
 <<SF mappings: public test>>
 
 contains
 
 <<SF mappings: test driver>>
 
 end module sf_mappings_ut
 @ %def sf_mappings_ut
 @
 <<[[sf_mappings_uti.f90]]>>=
 <<File header>>
 
 module sf_mappings_uti
 
 <<Use kinds>>
   use format_defs, only: FMT_11, FMT_12, FMT_13, FMT_14, FMT_15, FMT_16
 
   use sf_mappings
 
 <<Standard module head>>
 
 <<SF mappings: test declarations>>
 
 contains
 
 <<SF mappings: tests>>
 
 end module sf_mappings_uti
 @ %def sf_mappings_ut
 @ API: driver for the unit tests below.
 <<SF mappings: public test>>=
   public :: sf_mappings_test
 <<SF mappings: test driver>>=
   subroutine sf_mappings_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF mappings: execute tests>>
   end subroutine sf_mappings_test
 
 @ %def sf_mappings_test
 @
 \subsubsection{Check standard mapping}
 Probe the standard mapping of the unit square for different parameter
 values.  Also calculates integrals.  For a finite number of bins, they differ
 slightly from $1$, but the result is well-defined because we are not using
 random points.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_1, "sf_mappings_1", &
        "standard pair mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_1
 <<SF mappings: tests>>=
   subroutine sf_mappings_1 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(2) :: p
 
     write (u, "(A)")  "* Test output: sf_mappings_1"
     write (u, "(A)")  "*   Purpose: probe standard mapping"
     write (u, "(A)")
 
     allocate (sf_s_mapping_t :: mapping)
     select type (mapping)
     type is (sf_s_mapping_t)
        call mapping%init ()
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0):"
     p = [0._default, 0._default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5,0.5):"
     p = [0.5_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.1,0.5):"
     p = [0.1_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.1,0.1):"
     p = [0.1_default, 0.1_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
     allocate (sf_s_mapping_t :: mapping)
     select type (mapping)
     type is (sf_s_mapping_t)
        call mapping%init (power=2._default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     write (u, *)
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0):"
     p = [0._default, 0._default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5,0.5):"
     p = [0.5_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.1,0.5):"
     p = [0.1_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.1,0.1):"
     p = [0.1_default, 0.1_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)")  "I =", mapping%integral (100000)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_1"
 
   end subroutine sf_mappings_1
 
 @ %def sf_mappings_1
 @
 \subsubsection{Channel entries}
 Construct channel entries and print them.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_2, "sf_mappings_2", &
        "structure-function mapping channels", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_2
 <<SF mappings: tests>>=
   subroutine sf_mappings_2 (u)
     integer, intent(in) :: u
     type(sf_channel_t), dimension(:), allocatable :: channel
     integer :: c
 
     write (u, "(A)")  "* Test output: sf_mappings_2"
     write (u, "(A)")  "*   Purpose: construct and display &
          &mapping-channel objects"
     write (u, "(A)")
 
     call allocate_sf_channels (channel, n_channel = 8, n_strfun = 2)
     call channel(2)%activate_mapping ([1])
     call channel(3)%set_s_mapping ([1,2])
     call channel(4)%set_s_mapping ([1,2], power=2._default)
     call channel(5)%set_res_mapping ([1,2], m = 0.5_default, w = 0.1_default, single = .false.)
     call channel(6)%set_os_mapping ([1,2], m = 0.5_default, single = .false.)
     call channel(7)%set_res_mapping ([1], m = 0.5_default, w = 0.1_default, single = .true.)
     call channel(8)%set_os_mapping ([1], m = 0.5_default, single = .true.)
 
     call channel(3)%set_par_index (1, 1)
     call channel(3)%set_par_index (2, 4)
 
     call channel(4)%set_par_index (1, 1)
     call channel(4)%set_par_index (2, 4)
 
     call channel(5)%set_par_index (1, 1)
     call channel(5)%set_par_index (2, 3)
 
     call channel(6)%set_par_index (1, 1)
     call channel(6)%set_par_index (2, 2)
 
     call channel(7)%set_par_index (1, 1)
 
     call channel(8)%set_par_index (1, 1)
 
     do c = 1, size (channel)
        write (u, "(I0,':')", advance="no")  c
        call channel(c)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_2"
 
   end subroutine sf_mappings_2
 
 @ %def sf_mappings_2
 @
 \subsubsection{Check resonance mapping}
 Probe the resonance mapping of the unit square for different parameter
 values.  Also calculates integrals.  For a finite number of bins, they differ
 slightly from $1$, but the result is well-defined because we are not using
 random points.
 
 The resonance mass is at $1/2$ the energy, the width is $1/10$.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_3, "sf_mappings_3", &
        "resonant pair mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_3
 <<SF mappings: tests>>=
   subroutine sf_mappings_3 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(2) :: p
 
     write (u, "(A)")  "* Test output: sf_mappings_3"
     write (u, "(A)")  "*   Purpose: probe resonance pair mapping"
     write (u, "(A)")
 
     allocate (sf_res_mapping_t :: mapping)
     select type (mapping)
     type is (sf_res_mapping_t)
        call mapping%init (0.5_default, 0.1_default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0):"
     p = [0._default, 0._default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5,0.5):"
     p = [0.5_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.1,0.5):"
     p = [0.1_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.1,0.1):"
     p = [0.1_default, 0.1_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_3"
 
   end subroutine sf_mappings_3
 
 @ %def sf_mappings_3
 @
 \subsubsection{Check on-shell mapping}
 Probe the on-shell mapping of the unit square for different parameter
 values.  Also calculates integrals.  In this case, the Jacobian is
 constant and given by $|\log m^2|$, so this is also the value of the
 integral.  The factor results from the variable change in the $\delta$
 function $\delta (m^2 - x_1x_2)$ which multiplies the cross section
 for the case at hand.
 
 For the test, the (rescaled) resonance mass is set at $1/2$ the
 energy.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_4, "sf_mappings_4", &
        "on-shell pair mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_4
 <<SF mappings: tests>>=
   subroutine sf_mappings_4 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(2) :: p
 
     write (u, "(A)")  "* Test output: sf_mappings_4"
     write (u, "(A)")  "*   Purpose: probe on-shell pair mapping"
     write (u, "(A)")
 
     allocate (sf_os_mapping_t :: mapping)
     select type (mapping)
     type is (sf_os_mapping_t)
        call mapping%init (0.5_default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0):"
     p = [0._default, 0._default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5,0.5):"
     p = [0.5_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0.1):"
     p = [0._default, 0.1_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,1.0):"
     p = [0._default, 1.0_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_4"
 
   end subroutine sf_mappings_4
 
 @ %def sf_mappings_4
 @
 \subsubsection{Check endpoint mapping}
 Probe the endpoint mapping of the unit square for different parameter
 values.  Also calculates integrals.  For a finite number of bins, they differ
 slightly from $1$, but the result is well-defined because we are not using
 random points.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_5, "sf_mappings_5", &
        "endpoint pair mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_5
 <<SF mappings: tests>>=
   subroutine sf_mappings_5 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(2) :: p
 
     write (u, "(A)")  "* Test output: sf_mappings_5"
     write (u, "(A)")  "*   Purpose: probe endpoint pair mapping"
     write (u, "(A)")
 
     allocate (sf_ep_mapping_t :: mapping)
     select type (mapping)
     type is (sf_ep_mapping_t)
        call mapping%init ()
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0):"
     p = [0._default, 0._default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5,0.5):"
     p = [0.5_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.1,0.5):"
     p = [0.1_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7,0.2):"
     p = [0.7_default, 0.2_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_5"
 
   end subroutine sf_mappings_5
 
 @ %def sf_mappings_5
 @
 \subsubsection{Check endpoint resonant mapping}
 Probe the endpoint mapping with resonance.  Also calculates integrals.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_6, "sf_mappings_6", &
        "endpoint resonant mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_6
 <<SF mappings: tests>>=
   subroutine sf_mappings_6 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(2) :: p
 
     write (u, "(A)")  "* Test output: sf_mappings_6"
     write (u, "(A)")  "*   Purpose: probe endpoint resonant mapping"
     write (u, "(A)")
 
     allocate (sf_epr_mapping_t :: mapping)
     select type (mapping)
     type is (sf_epr_mapping_t)
        call mapping%init (a = 1._default, m = 0.5_default, w = 0.1_default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0):"
     p = [0._default, 0._default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5,0.5):"
     p = [0.5_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.1,0.5):"
     p = [0.1_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7,0.2):"
     p = [0.7_default, 0.2_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Same mapping without resonance:"
     write (u, "(A)")
 
     allocate (sf_epr_mapping_t :: mapping)
     select type (mapping)
     type is (sf_epr_mapping_t)
        call mapping%init (a = 1._default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0):"
     p = [0._default, 0._default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5,0.5):"
     p = [0.5_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.1,0.5):"
     p = [0.1_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7,0.2):"
     p = [0.7_default, 0.2_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_6"
 
   end subroutine sf_mappings_6
 
 @ %def sf_mappings_6
 @
 \subsubsection{Check endpoint on-shell mapping}
 Probe the endpoint mapping with an on-shell particle.  Also calculates
 integrals.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_7, "sf_mappings_7", &
        "endpoint on-shell mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_7
 <<SF mappings: tests>>=
   subroutine sf_mappings_7 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(2) :: p
 
     write (u, "(A)")  "* Test output: sf_mappings_7"
     write (u, "(A)")  "*   Purpose: probe endpoint on-shell mapping"
     write (u, "(A)")
 
     allocate (sf_epo_mapping_t :: mapping)
     select type (mapping)
     type is (sf_epo_mapping_t)
        call mapping%init (a = 1._default, m = 0.5_default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0):"
     p = [0._default, 0._default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5,0.5):"
     p = [0.5_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.1,0.5):"
     p = [0.1_default, 0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7,0.2):"
     p = [0.7_default, 0.2_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_7"
 
   end subroutine sf_mappings_7
 
 @ %def sf_mappings_7
 @
 \subsubsection{Check power mapping}
 Probe the power mapping of the unit square for different parameter
 values.  Also calculates integrals.  For a finite number of bins, they differ
 slightly from $1$, but the result is well-defined because we are not using
 random points.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_8, "sf_mappings_8", &
        "power pair mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_8
 <<SF mappings: tests>>=
   subroutine sf_mappings_8 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(2) :: p, pb
 
     write (u, "(A)")  "* Test output: sf_mappings_8"
     write (u, "(A)")  "*   Purpose: probe power pair mapping"
     write (u, "(A)")
 
     allocate (sf_ip_mapping_t :: mapping)
     select type (mapping)
     type is (sf_ip_mapping_t)
        call mapping%init (eps = 0.1_default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0.5):"
     p = [0._default, 0.5_default]
     pb= [1._default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5,0.5):"
     p = [0.5_default, 0.5_default]
     pb= [0.5_default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.9,0.5):"
     p = [0.9_default, 0.5_default]
     pb= [0.1_default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7,0.2):"
     p = [0.7_default, 0.2_default]
     pb= [0.3_default, 0.8_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7,0.8):"
     p = [0.7_default, 0.8_default]
     pb= [0.3_default, 0.2_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.99,0.02):"
     p = [0.99_default, 0.02_default]
     pb= [0.01_default, 0.98_default]
     call mapping%check (u, p, pb, FMT_14, FMT_12)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.99,0.98):"
     p = [0.99_default, 0.98_default]
     pb= [0.01_default, 0.02_default]
     call mapping%check (u, p, pb, FMT_14, FMT_12)
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_8"
 
   end subroutine sf_mappings_8
 
 @ %def sf_mappings_8
 @
 \subsubsection{Check resonant power mapping}
 Probe the power mapping of the unit square, adapted for an s-channel
 resonance, for different parameter values.  Also calculates integrals.
 For a finite number of bins, they differ slightly from $1$, but the
 result is well-defined because we are not using random points.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_9, "sf_mappings_9", &
        "power resonance mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_9
 <<SF mappings: tests>>=
   subroutine sf_mappings_9 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(2) :: p, pb
 
     write (u, "(A)")  "* Test output: sf_mappings_9"
     write (u, "(A)")  "*   Purpose: probe power resonant pair mapping"
     write (u, "(A)")
 
     allocate (sf_ipr_mapping_t :: mapping)
     select type (mapping)
     type is (sf_ipr_mapping_t)
        call mapping%init (eps = 0.1_default, m = 0.5_default, w = 0.1_default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0.5):"
     p = [0._default, 0.5_default]
     pb= [1._default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5,0.5):"
     p = [0.5_default, 0.5_default]
     pb= [0.5_default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.9,0.5):"
     p = [0.9_default, 0.5_default]
     pb= [0.1_default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7,0.2):"
     p = [0.7_default, 0.2_default]
     pb= [0.3_default, 0.8_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7,0.8):"
     p = [0.7_default, 0.8_default]
     pb= [0.3_default, 0.2_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.9999,0.02):"
     p = [0.9999_default, 0.02_default]
     pb= [0.0001_default, 0.98_default]
     call mapping%check (u, p, pb, FMT_11, FMT_12)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.9999,0.98):"
     p = [0.9999_default, 0.98_default]
     pb= [0.0001_default, 0.02_default]
     call mapping%check (u, p, pb, FMT_11, FMT_12)
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Same mapping without resonance:"
     write (u, "(A)")
 
     allocate (sf_ipr_mapping_t :: mapping)
     select type (mapping)
     type is (sf_ipr_mapping_t)
        call mapping%init (eps = 0.1_default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0.5):"
     p = [0._default, 0.5_default]
     pb= [1._default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5,0.5):"
     p = [0.5_default, 0.5_default]
     pb= [0.5_default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.9,0.5):"
     p = [0.9_default, 0.5_default]
     pb= [0.1_default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7,0.2):"
     p = [0.7_default, 0.2_default]
     pb= [0.3_default, 0.8_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7,0.8):"
     p = [0.7_default, 0.8_default]
     pb= [0.3_default, 0.2_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_9"
 
   end subroutine sf_mappings_9
 
 @ %def sf_mappings_9
 @
 \subsubsection{Check on-shell power mapping}
 Probe the power mapping of the unit square, adapted for
 single-particle production, for different parameter values.  Also
 calculates integrals.  For a finite number of bins, they differ
 slightly from $1$, but the result is well-defined because we are not
 using random points.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_10, "sf_mappings_10", &
        "power on-shell mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_10
 <<SF mappings: tests>>=
   subroutine sf_mappings_10 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(2) :: p, pb
 
     write (u, "(A)")  "* Test output: sf_mappings_10"
     write (u, "(A)")  "*   Purpose: probe power on-shell mapping"
     write (u, "(A)")
 
     allocate (sf_ipo_mapping_t :: mapping)
     select type (mapping)
     type is (sf_ipo_mapping_t)
        call mapping%init (eps = 0.1_default, m = 0.5_default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0.5):"
     p = [0._default, 0.5_default]
     pb= [1._default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0.02):"
     p = [0._default, 0.02_default]
     pb= [1._default, 0.98_default]
     call mapping%check (u, p, pb, FMT_15, FMT_12)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0,0.98):"
     p = [0._default, 0.98_default]
     pb= [1._default, 0.02_default]
     call mapping%check (u, p, pb, FMT_15, FMT_12)
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_10"
 
   end subroutine sf_mappings_10
 
 @ %def sf_mappings_10
 @
 \subsubsection{Check combined endpoint-power mapping}
 Probe the mapping for the beamstrahlung/ISR combination.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_11, "sf_mappings_11", &
        "endpoint/power combined mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_11
 <<SF mappings: tests>>=
   subroutine sf_mappings_11 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(4) :: p, pb
 
     write (u, "(A)")  "* Test output: sf_mappings_11"
     write (u, "(A)")  "*   Purpose: probe power pair mapping"
     write (u, "(A)")
 
     allocate (sf_ei_mapping_t :: mapping)
     select type (mapping)
     type is (sf_ei_mapping_t)
        call mapping%init (eps = 0.1_default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
        call mapping%set_index (3, 3)
        call mapping%set_index (4, 4)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5, 0.5, 0.5, 0.5):"
     p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
     pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7, 0.2, 0.4, 0.8):"
     p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
     pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.9, 0.06, 0.95, 0.1):"
     p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
     pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
     call mapping%check (u, p, pb, FMT_13, FMT_12)
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_11"
 
   end subroutine sf_mappings_11
 
 @ %def sf_mappings_11
 @
 \subsubsection{Check resonant endpoint-power mapping}
 Probe the mapping for the beamstrahlung/ISR combination.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_12, "sf_mappings_12", &
        "endpoint/power resonant combined mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_12
 <<SF mappings: tests>>=
   subroutine sf_mappings_12 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(4) :: p, pb
 
     write (u, "(A)")  "* Test output: sf_mappings_12"
     write (u, "(A)")  "*   Purpose: probe resonant combined mapping"
     write (u, "(A)")
 
     allocate (sf_eir_mapping_t :: mapping)
     select type (mapping)
     type is (sf_eir_mapping_t)
        call mapping%init (a = 1._default, &
             eps = 0.1_default, m = 0.5_default, w = 0.1_default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
        call mapping%set_index (3, 3)
        call mapping%set_index (4, 4)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5, 0.5, 0.5, 0.5):"
     p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
     pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7, 0.2, 0.4, 0.8):"
     p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
     pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.9, 0.06, 0.95, 0.1):"
     p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
     pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
     call mapping%check (u, p, pb, FMT_15, FMT_12)
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_12"
 
   end subroutine sf_mappings_12
 
 @ %def sf_mappings_12
 @
 \subsubsection{Check on-shell endpoint-power mapping}
 Probe the mapping for the beamstrahlung/ISR combination.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_13, "sf_mappings_13", &
        "endpoint/power on-shell combined mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_13
 <<SF mappings: tests>>=
   subroutine sf_mappings_13 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(4) :: p, pb
 
     write (u, "(A)")  "* Test output: sf_mappings_13"
     write (u, "(A)")  "*   Purpose: probe on-shell combined mapping"
     write (u, "(A)")
 
     allocate (sf_eio_mapping_t :: mapping)
     select type (mapping)
     type is (sf_eio_mapping_t)
        call mapping%init (a = 1._default, eps = 0.1_default, m = 0.5_default)
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
        call mapping%set_index (3, 3)
        call mapping%set_index (4, 4)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5, 0.5, 0.5, 0.5):"
     p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
     pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.7, 0.2, 0.4, 0.8):"
     p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
     pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
     call mapping%check (u, p, pb, FMT_16)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.9, 0.06, 0.95, 0.1):"
     p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
     pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
     call mapping%check (u, p, pb, FMT_14, FMT_12)
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_13"
 
   end subroutine sf_mappings_13
 
 @ %def sf_mappings_13
 @
 \subsubsection{Check rescaling}
 Check the rescaling factor in on-shell basic mapping.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_14, "sf_mappings_14", &
        "rescaled on-shell mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_14
 <<SF mappings: tests>>=
   subroutine sf_mappings_14 (u)
     integer, intent(in) :: u
     real(default), dimension(2) :: p2, r2
     real(default), dimension(1) :: p1, r1
     real(default) :: f, x_free, m2
 
     write (u, "(A)")  "* Test output: sf_mappings_14"
     write (u, "(A)")  "*   Purpose: probe rescaling in os mapping"
     write (u, "(A)")
 
     x_free = 0.9_default
     m2 = 0.5_default
 
     write (u, "(A)")  "* Two parameters"
     write (u, "(A)")
 
     p2 = [0.1_default, 0.2_default]
 
     call map_on_shell (r2, f, p2, -log (m2), x_free)
 
     write (u, "(A,9(1x," // FMT_14 // "))")  "p =", p2
     write (u, "(A,9(1x," // FMT_14 // "))")  "r =", r2
     write (u, "(A,9(1x," // FMT_14 // "))")  "f =", f
     write (u, "(A,9(1x," // FMT_14 // "))")  "*r=", x_free * product (r2)
 
     write (u, *)
 
     call map_on_shell_inverse (r2, f, p2, -log (m2), x_free)
 
     write (u, "(A,9(1x," // FMT_14 // "))")  "p =", p2
     write (u, "(A,9(1x," // FMT_14 // "))")  "r =", r2
     write (u, "(A,9(1x," // FMT_14 // "))")  "f =", f
     write (u, "(A,9(1x," // FMT_14 // "))")  "*r=", x_free * product (r2)
 
     write (u, "(A)")
     write (u, "(A)")  "* One parameter"
     write (u, "(A)")
 
     p1 = [0.1_default]
 
     call map_on_shell_single (r1, f, p1, -log (m2), x_free)
 
     write (u, "(A,9(1x," // FMT_14 // "))")  "p =", p1
     write (u, "(A,9(1x," // FMT_14 // "))")  "r =", r1
     write (u, "(A,9(1x," // FMT_14 // "))")  "f =", f
     write (u, "(A,9(1x," // FMT_14 // "))")  "*r=", x_free * product (r1)
 
     write (u, *)
 
     call map_on_shell_single_inverse (r1, f, p1, -log (m2), x_free)
 
     write (u, "(A,9(1x," // FMT_14 // "))")  "p =", p1
     write (u, "(A,9(1x," // FMT_14 // "))")  "r =", r1
     write (u, "(A,9(1x," // FMT_14 // "))")  "f =", f
     write (u, "(A,9(1x," // FMT_14 // "))")  "*r=", x_free * product (r1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_14"
 
   end subroutine sf_mappings_14
 
 @ %def sf_mappings_14
 @
 \subsubsection{Check single parameter resonance mapping}
 Probe the resonance mapping of the unit interval for different parameter
 values.  Also calculates integrals.
 
 The resonance mass is at $1/2$ the energy, the width is $1/10$.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_15, "sf_mappings_15", &
        "resonant single mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_15
 <<SF mappings: tests>>=
   subroutine sf_mappings_15 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(1) :: p
 
     write (u, "(A)")  "* Test output: sf_mappings_15"
     write (u, "(A)")  "*   Purpose: probe resonance single mapping"
     write (u, "(A)")
 
     allocate (sf_res_mapping_single_t :: mapping)
     select type (mapping)
     type is (sf_res_mapping_single_t)
        call mapping%init (0.5_default, 0.1_default)
        call mapping%set_index (1, 1)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0):"
     p = [0._default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5):"
     p = [0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.1):"
     p = [0.1_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_15"
 
   end subroutine sf_mappings_15
 
 @ %def sf_mappings_15
 @
 \subsubsection{Check single parameter on-shell mapping}
 Probe the on-shell (pseudo) mapping of the unit interval for different parameter
 values.  Also calculates integrals.
 
 The resonance mass is at $1/2$ the energy.
 <<SF mappings: execute tests>>=
   call test (sf_mappings_16, "sf_mappings_16", &
        "on-shell single mapping", &
        u, results)
 <<SF mappings: test declarations>>=
   public :: sf_mappings_16
 <<SF mappings: tests>>=
   subroutine sf_mappings_16 (u)
     integer, intent(in) :: u
     class(sf_mapping_t), allocatable :: mapping
     real(default), dimension(1) :: p
 
     write (u, "(A)")  "* Test output: sf_mappings_16"
     write (u, "(A)")  "*   Purpose: probe on-shell single mapping"
     write (u, "(A)")
 
     allocate (sf_os_mapping_single_t :: mapping)
     select type (mapping)
     type is (sf_os_mapping_single_t)
        call mapping%init (0.5_default)
        call mapping%set_index (1, 1)
     end select
 
     call mapping%write (u)
 
     write (u, *)
     write (u, "(A)")  "Probe at (0):"
     p = [0._default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Probe at (0.5):"
     p = [0.5_default]
     call mapping%check (u, p, 1-p, "F7.5")
 
     write (u, *)
     write (u, "(A)")  "Compute integral:"
     write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)
 
     deallocate (mapping)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_mappings_16"
 
   end subroutine sf_mappings_16
 
 @ %def sf_mappings_16
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Structure function base}
 
 <<[[sf_base.f90]]>>=
 <<File header>>
 
 module sf_base
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_utils, only: write_separator
   use format_defs, only: FMT_17, FMT_19
   use diagnostics
   use lorentz
   use quantum_numbers
   use interactions
   use evaluators
   use pdg_arrays
   use beams
   use sf_aux
   use sf_mappings
   use constants, only: one, two
   use physics_defs, only: n_beams_rescaled
 
 <<Standard module head>>
 
 <<SF base: public>>
 
 <<SF base: parameters>>
 
 <<SF base: types>>
 
 <<SF base: interfaces>>
 
 contains
 
 <<SF base: procedures>>
 
 end module sf_base
 @ %def sf_base
 @
 \subsection{Abstract rescale data-type}
 
 NLO calculations require the treatment of initial state parton radiation.
 The radiation of a parton rescales the energy fraction which enters the hard process.
 We allow for different rescale settings by extending the abstract.
 [[sf_rescale_t]] data type.
 <<SF base: public>>=
   public :: sf_rescale_t
 <<SF base: types>>=
   type, abstract :: sf_rescale_t
     integer :: i_beam = 0
   contains
   <<SF base: rescaling function: TBP>>
   end type sf_rescale_t
 
 @ %def sf_rescale_t
 @
 <<SF base: rescaling function: TBP>>=
   procedure (sf_rescale_apply), deferred :: apply
 <<SF base: interfaces>>=
   abstract interface
      subroutine sf_rescale_apply (func, x)
        import
        class(sf_rescale_t), intent(in) :: func
        real(default), intent(inout) :: x
      end subroutine sf_rescale_apply
   end interface
 
 @ %def rescale_apply
 @
 <<SF base: rescaling function: TBP>>=
   procedure :: set_i_beam => sf_rescale_set_i_beam
 <<SF base: procedures>>=
   subroutine sf_rescale_set_i_beam (func, i_beam)
     class(sf_rescale_t), intent(inout) :: func
     integer, intent(in) :: i_beam
     func%i_beam = i_beam
   end subroutine sf_rescale_set_i_beam
 
 @ %def rescale_set_i_beam
 @
 <<SF base: public>>=
   public :: sf_rescale_collinear_t
 <<SF base: types>>=
   type, extends (sf_rescale_t) :: sf_rescale_collinear_t
      real(default) :: xi_tilde
   contains
   <<SF base: rescale collinear: TBP>>
   end type sf_rescale_collinear_t
 
 @ %def sf_rescale_collinear_t
 @ For the subtraction terms we need to rescale the Born $x$ of both beams in the
 collinear limit. This leaves one beam unaffected and rescales the other according to
 \begin{equation}
   x = \frac{\overline{x}}{1-\xi}
 \end{equation}
 which is the collinear limit of [[sf_rescale_real_apply]].
 <<SF base: rescale collinear: TBP>>=
   procedure :: apply => sf_rescale_collinear_apply
 <<SF base: procedures>>=
   subroutine sf_rescale_collinear_apply (func, x)
     class(sf_rescale_collinear_t), intent(in) :: func
     real(default), intent(inout) :: x
     real(default) :: xi
     if (debug2_active (D_BEAMS)) then
        print *, 'Rescaling function - Collinear: '
        print *, 'Input, unscaled x: ', x
        print *, 'xi_tilde: ', func%xi_tilde
     end if
     xi = func%xi_tilde * (one - x)
     x = x / (one - xi)
     if (debug2_active (D_BEAMS))  print *, 'rescaled x: ', x
   end subroutine sf_rescale_collinear_apply
 
 @ %def sf_rescale_collinear_apply
 @
 <<SF base: rescale collinear: TBP>>=
   procedure :: set => sf_rescale_collinear_set
 <<SF base: procedures>>=
   subroutine sf_rescale_collinear_set (func, xi_tilde)
     class(sf_rescale_collinear_t), intent(inout) :: func
     real(default), intent(in) :: xi_tilde
     func%xi_tilde = xi_tilde
   end subroutine sf_rescale_collinear_set
 
 @ %def sf_rescale_collinear_set
 @
 <<SF base: public>>=
   public :: sf_rescale_real_t
 <<SF base: types>>=
   type, extends (sf_rescale_t) :: sf_rescale_real_t
      real(default) :: xi, y
   contains
   <<SF base: rescale real: TBP>>
   end type sf_rescale_real_t
 
 @ %def sf_rescale_real_t
 @ In case of IS Splittings, the beam $x$ changes from Born to real and thus needs to be rescaled according to
 \begin{equation}
   x_\oplus = \frac{\overline{x}_\oplus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1-y)}{2-\xi(1+y)}}
   , \qquad
   x_\ominus = \frac{\overline{x}_\ominus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1+y)}{2-\xi(1-y)}}
 \end{equation}
 Refs:
 \begin{itemize}
   \item[\textbullet] [0709.2092] Eq. (5.7).
   \item[\textbullet] [0907.4076] Eq. (2.21).
   \item Christian Weiss' PhD Thesis (DESY-THESIS-2017-025), Eq. (A.2.3).
 \end{itemize}
 <<SF base: rescale real: TBP>>=
   procedure :: apply => sf_rescale_real_apply
 <<SF base: procedures>>=
   subroutine sf_rescale_real_apply (func, x)
     class(sf_rescale_real_t), intent(in) :: func
     real(default), intent(inout) :: x
     real(default) :: onepy, onemy
     if (debug2_active (D_BEAMS)) then
        print *, 'Rescaling function - Real: '
        print *, 'Input, unscaled: ', x
        print *, 'Beam index: ', func%i_beam
        print *, 'xi: ', func%xi, 'y: ', func%y
     end if
     x = x / sqrt (one - func%xi)
     onepy = one + func%y; onemy = one - func%y
     if (func%i_beam == 1) then
        x = x * sqrt ((two - func%xi * onemy) / (two - func%xi * onepy))
     else if (func%i_beam == 2) then
        x = x * sqrt ((two - func%xi * onepy) / (two - func%xi * onemy))
     else
        call msg_fatal ("sf_rescale_real_apply - invalid beam index")
     end if
     if (debug2_active (D_BEAMS))  print *, 'rescaled x: ', x
   end subroutine sf_rescale_real_apply
 
 @ %def sf_rescale_real_apply
 @
 <<SF base: rescale real: TBP>>=
   procedure :: set => sf_rescale_real_set
 <<SF base: procedures>>=
   subroutine sf_rescale_real_set (func, xi, y)
     class(sf_rescale_real_t), intent(inout) :: func
     real(default), intent(in) :: xi, y
     func%xi = xi; func%y = y
   end subroutine sf_rescale_real_set
 
 @ %def sf_rescale_real_set
 <<SF base: public>>=
   public :: sf_rescale_dglap_t
 <<SF base: types>>=
   type, extends(sf_rescale_t) :: sf_rescale_dglap_t
      real(default), dimension(:), allocatable :: z
    contains
    <<SF base: rescale dglap: TBP>>
   end type sf_rescale_dglap_t
 
 @ %def sf_rescale_dglap_t
 @
 <<SF base: rescale dglap: TBP>>=
   procedure :: apply => sf_rescale_dglap_apply
 <<SF base: procedures>>=
   subroutine sf_rescale_dglap_apply (func, x)
     class(sf_rescale_dglap_t), intent(in) :: func
     real(default), intent(inout) :: x
     if (debug2_active (D_BEAMS))  then
        print *, "Rescaling function - DGLAP:"
        print *, "Input: ", x
        print *, "Beam index: ", func%i_beam
        print *, "z: ", func%z
     end if
     x = x / func%z(func%i_beam)
     if (debug2_active (D_BEAMS)) print *, "scaled x: ", x
   end subroutine sf_rescale_dglap_apply
 
 @ %def sf_rescale_dglap_apply
 @
 <<SF base: rescale dglap: TBP>>=
   procedure :: set => sf_rescale_dglap_set
 <<SF base: procedures>>=
   subroutine sf_rescale_dglap_set (func, z)
     class(sf_rescale_dglap_t), intent(inout) :: func
     real(default), dimension(:), intent(in) :: z
     ! allocate-on-assginment
     func%z = z
   end subroutine sf_rescale_dglap_set
 
 @  %def sf_rescale_dglap_set
 @
 \subsection{Abstract structure-function data type}
 This type should hold all configuration data for a specific type of
 structure function.  The base object is empty; the implementations
 will fill it.
 <<SF base: public>>=
   public :: sf_data_t
 <<SF base: types>>=
   type, abstract :: sf_data_t
    contains
    <<SF base: sf data: TBP>>
   end type sf_data_t
 
 @ %def sf_data_t
 @ Output.
 <<SF base: sf data: TBP>>=
   procedure (sf_data_write), deferred :: write
 <<SF base: interfaces>>=
   abstract interface
      subroutine sf_data_write (data, unit, verbose)
        import
        class(sf_data_t), intent(in) :: data
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: verbose
      end subroutine sf_data_write
   end interface
 
 @ %def sf_data_write
 @ Return true if this structure function is in generator mode.  In
 that case, all parameters are free, otherwise bound.  (We do not
 support mixed cases.)  Default is: no generator.
 <<SF base: sf data: TBP>>=
   procedure :: is_generator => sf_data_is_generator
 <<SF base: procedures>>=
   function sf_data_is_generator (data) result (flag)
     class(sf_data_t), intent(in) :: data
     logical :: flag
     flag = .false.
   end function sf_data_is_generator
 
 @ %def sf_data_is_generator
 @ Return the number of input parameters that determine the
 structure function.
 <<SF base: sf data: TBP>>=
   procedure (sf_data_get_int), deferred :: get_n_par
 <<SF base: interfaces>>=
   abstract interface
      function sf_data_get_int (data) result (n)
        import
        class(sf_data_t), intent(in) :: data
        integer :: n
      end function sf_data_get_int
   end interface
 
 @ %def sf_data_get_int
 @ Return the outgoing particle PDG codes for the current setup.  The codes can
 be an array of particles, for each beam.
 <<SF base: sf data: TBP>>=
   procedure (sf_data_get_pdg_out), deferred :: get_pdg_out
 <<SF base: interfaces>>=
   abstract interface
      subroutine sf_data_get_pdg_out (data, pdg_out)
        import
        class(sf_data_t), intent(in) :: data
        type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
      end subroutine sf_data_get_pdg_out
   end interface
 
 @ %def sf_data_get_pdg_out
 @ Allocate a matching structure function interaction object and
 properly initialize it.
 
 <<SF base: sf data: TBP>>=
   procedure (sf_data_allocate_sf_int), deferred :: allocate_sf_int
 <<SF base: interfaces>>=
   abstract interface
      subroutine sf_data_allocate_sf_int (data, sf_int)
        import
        class(sf_data_t), intent(in) :: data
        class(sf_int_t), intent(inout), allocatable :: sf_int
      end subroutine sf_data_allocate_sf_int
   end interface
 
 @ %def sf_data_allocate_sf_int
 @ Return the PDF set index, if applicable.  We implement a default
 method which returns zero.  The PDF (builtin and LHA) implementations
 will override this.
 <<SF base: sf data: TBP>>=
   procedure :: get_pdf_set => sf_data_get_pdf_set
 <<SF base: procedures>>=
   elemental function sf_data_get_pdf_set (data) result (pdf_set)
     class(sf_data_t), intent(in) :: data
     integer :: pdf_set
     pdf_set = 0
   end function sf_data_get_pdf_set
 
 @ %def sf_data_get_pdf_set
 @ Return the spectrum file, if applicable. We implement a default
 method which returns zero. CIRCE1, CIRCE2 and the beam spectrum will
 override this.
 <<SF base: sf data: TBP>>=
   procedure :: get_beam_file => sf_data_get_beam_file
 <<SF base: procedures>>=
   function sf_data_get_beam_file (data) result (file)
     class(sf_data_t), intent(in) :: data
     type(string_t) :: file
     file = ""
   end function sf_data_get_beam_file
 
 @ %def sf_data_get_beam_file
 @
 \subsection{Structure-function chain configuration}
 This is the data type that the [[process]] module uses for setting
 up its structure-function chain.  For each structure function described
 by the beam data, there is an entry.  The [[i]] array indicates the
 beam(s) to which this structure function applies, and the [[data]]
 object contains the actual configuration data.
 <<SF base: public>>=
   public :: sf_config_t
 <<SF base: types>>=
   type :: sf_config_t
      integer, dimension(:), allocatable :: i
      class(sf_data_t), allocatable :: data
    contains
    <<SF base: sf config: TBP>>
   end type sf_config_t
 
 @ %def sf_config_t
 @ Output:
 <<SF base: sf config: TBP>>=
   procedure :: write => sf_config_write
 <<SF base: procedures>>=
   subroutine sf_config_write (object, unit, verbose)
     class(sf_config_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     u = given_output_unit (unit)
     if (allocated (object%i)) then
        write (u, "(1x,A,2(1x,I0))")  "Structure-function configuration: &
             &beam(s)", object%i
        if (allocated (object%data)) &
             call object%data%write (u, verbose = verbose)
     else
        write (u, "(1x,A)")  "Structure-function configuration: [undefined]"
     end if
   end subroutine sf_config_write
 
 @ %def sf_config_write
 @ Initialize.
 <<SF base: sf config: TBP>>=
   procedure :: init => sf_config_init
 <<SF base: procedures>>=
   subroutine sf_config_init (sf_config, i_beam, sf_data)
     class(sf_config_t), intent(out) :: sf_config
     integer, dimension(:), intent(in) :: i_beam
     class(sf_data_t), intent(in) :: sf_data
     allocate (sf_config%i (size (i_beam)), source = i_beam)
     allocate (sf_config%data, source = sf_data)
   end subroutine sf_config_init
 
 @ %def sf_config_init
 @ Return the PDF set, if any.
 <<SF base: sf config: TBP>>=
   procedure :: get_pdf_set => sf_config_get_pdf_set
 <<SF base: procedures>>=
   elemental function sf_config_get_pdf_set (sf_config) result (pdf_set)
     class(sf_config_t), intent(in) :: sf_config
     integer :: pdf_set
     pdf_set = sf_config%data%get_pdf_set ()
   end function sf_config_get_pdf_set
 
 @ %def sf_config_get_pdf_set
 @ Return the beam spectrum file, if any.
 <<SF base: sf config: TBP>>=
   procedure :: get_beam_file => sf_config_get_beam_file
 <<SF base: procedures>>=
   function sf_config_get_beam_file (sf_config) result (file)
     class(sf_config_t), intent(in) :: sf_config
     type(string_t) :: file
     file = sf_config%data%get_beam_file ()
   end function sf_config_get_beam_file
 
 @ %def sf_config_get_beam_file
 @
 \subsection{Structure-function instance}
 The [[sf_int_t]] data type contains an [[interaction_t]] object (it is
 an extension of this type) and a pointer to the [[sf_data_t]]
 configuration data.  This interaction, or copies of it, is used to
 implement structure-function kinematics and dynamics in the context of
 process evaluation.
 
 The status code [[status]] tells whether the interaction is undefined,
 has defined kinematics (but matrix elements invalid), or is completely
 defined.  There is also a status code for failure.  The implementation
 is responsible for updating the status.
 
 The entries [[mi2]], [[mr2]], and [[mo2]] hold the squared
 invariant masses of the incoming, radiated, and outgoing particle,
 respectively.  They are supposed to be set upon initialization, but
 could also be varied event by event.
 
 If the radiated or outgoing mass is nonzero, we may need to apply an
 on-shell projection.  The projection mode is stored as
 [[on_shell_mode]].
 
 The array [[beam_index]] is the list of beams on which this structure
 function applies ($1$, $2$, or both).  The arrays [[incoming]],
 [[radiated]], and [[outgoing]] contain the indices of the respective
 particle sets within the interaction, for convenient lookup.  The
 array [[par_index]] indicates the MC input parameters that this entry
 will use up in the structure-function chain.  The first parameter (or
 the first two, for a spectrum) in this array determines the momentum
 fraction and is thus subject to global mappings.
 
 In the abstract base type, we do not implement the data pointer.  This
 allows us to restrict its type in the implementations.
 <<SF base: public>>=
   public :: sf_int_t
 <<SF base: types>>=
   type, abstract, extends (interaction_t) :: sf_int_t
      integer :: status = SF_UNDEFINED
      real(default), dimension(:), allocatable :: mi2
      real(default), dimension(:), allocatable :: mr2
      real(default), dimension(:), allocatable :: mo2
      integer :: on_shell_mode = KEEP_ENERGY
      logical :: qmin_defined = .false.
      logical :: qmax_defined = .false.
      real(default), dimension(:), allocatable :: qmin
      real(default), dimension(:), allocatable :: qmax
      integer, dimension(:), allocatable :: beam_index
      integer, dimension(:), allocatable :: incoming
      integer, dimension(:), allocatable :: radiated
      integer, dimension(:), allocatable :: outgoing
      integer, dimension(:), allocatable :: par_index
      integer, dimension(:), allocatable :: par_primary
    contains
    <<SF base: sf int: TBP>>
   end type sf_int_t
 
 @ %def sf_int_t
 @ Status codes.  The codes that refer to links, masks, and
 connections, apply to structure-function chains only.
 
 The status codes are public.
 <<SF base: parameters>>=
   integer, parameter, public :: SF_UNDEFINED = 0
   integer, parameter, public :: SF_INITIAL = 1
   integer, parameter, public :: SF_DONE_LINKS = 2
   integer, parameter, public :: SF_FAILED_MASK = 3
   integer, parameter, public :: SF_DONE_MASK = 4
   integer, parameter, public :: SF_FAILED_CONNECTIONS = 5
   integer, parameter, public :: SF_DONE_CONNECTIONS = 6
   integer, parameter, public :: SF_SEED_KINEMATICS = 10
   integer, parameter, public :: SF_FAILED_KINEMATICS = 11
   integer, parameter, public :: SF_DONE_KINEMATICS = 12
   integer, parameter, public :: SF_FAILED_EVALUATION = 13
   integer, parameter, public :: SF_EVALUATED = 20
 
 @ %def SF_UNDEFINED SF_INITIAL
 @ %def SF_DONE_LINKS SF_DONE_MASK SF_DONE_CONNECTIONS
 @ %def SF_DONE_KINEMATICS SF_EVALUATED
 @ %def SF_FAILED_MASK SF_FAILED_CONNECTIONS
 @ %def SF_FAILED_KINEMATICS SF_FAILED_EVALUATION
 @ Write a string version of the status code:
 <<SF base: procedures>>=
   subroutine write_sf_status (status, u)
     integer, intent(in) :: status
     integer, intent(in) :: u
     select case (status)
     case (SF_UNDEFINED)
        write (u, "(1x,'[',A,']')")  "undefined"
     case (SF_INITIAL)
        write (u, "(1x,'[',A,']')")  "initialized"
     case (SF_DONE_LINKS)
        write (u, "(1x,'[',A,']')")  "links set"
     case (SF_FAILED_MASK)
        write (u, "(1x,'[',A,']')")  "mask mismatch"
     case (SF_DONE_MASK)
        write (u, "(1x,'[',A,']')")  "mask set"
     case (SF_FAILED_CONNECTIONS)
        write (u, "(1x,'[',A,']')")  "connections failed"
     case (SF_DONE_CONNECTIONS)
        write (u, "(1x,'[',A,']')")  "connections set"
     case (SF_SEED_KINEMATICS)
        write (u, "(1x,'[',A,']')")  "incoming momenta set"
     case (SF_FAILED_KINEMATICS)
        write (u, "(1x,'[',A,']')")  "kinematics failed"
     case (SF_DONE_KINEMATICS)
        write (u, "(1x,'[',A,']')")  "kinematics set"
     case (SF_FAILED_EVALUATION)
        write (u, "(1x,'[',A,']')")  "evaluation failed"
     case (SF_EVALUATED)
        write (u, "(1x,'[',A,']')")  "evaluated"
     end select
   end subroutine write_sf_status
 
 @ %def write_sf_status
 @ This is the basic output routine.  Display status and interaction.
 <<SF base: sf int: TBP>>=
   procedure :: base_write => sf_int_base_write
 <<SF base: procedures>>=
   subroutine sf_int_base_write (object, unit, testflag)
     class(sf_int_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "SF instance:"
     call write_sf_status (object%status, u)
     if (allocated (object%beam_index)) &
          write (u, "(3x,A,2(1x,I0))")  "beam      =", object%beam_index
     if (allocated (object%incoming)) &
          write (u, "(3x,A,2(1x,I0))")  "incoming  =", object%incoming
     if (allocated (object%radiated)) &
          write (u, "(3x,A,2(1x,I0))")  "radiated  =", object%radiated
     if (allocated (object%outgoing)) &
          write (u, "(3x,A,2(1x,I0))")  "outgoing  =", object%outgoing
     if (allocated (object%par_index)) &
          write (u, "(3x,A,2(1x,I0))")  "parameter =", object%par_index
     if (object%qmin_defined) &
          write (u, "(3x,A,1x," // FMT_19 // ")")  "q_min     =", object%qmin
     if (object%qmax_defined) &
          write (u, "(3x,A,1x," // FMT_19 // ")")  "q_max     =", object%qmax
     call object%interaction_t%basic_write (u, testflag = testflag)
   end subroutine sf_int_base_write
 
 @ %def sf_int_base_write
 @ The type string identifies the structure function class, and possibly more
 details about the structure function.
 <<SF base: sf int: TBP>>=
   procedure (sf_int_type_string), deferred :: type_string
 <<SF base: interfaces>>=
   abstract interface
      function sf_int_type_string (object) result (string)
        import
        class(sf_int_t), intent(in) :: object
        type(string_t) :: string
      end function sf_int_type_string
   end interface
 
 @ %def sf_int_type_string
 @ Output of the concrete object.  We should not forget to call the
 output routine for the base type.
 <<SF base: sf int: TBP>>=
   procedure (sf_int_write), deferred :: write
 <<SF base: interfaces>>=
   abstract interface
      subroutine sf_int_write (object, unit, testflag)
        import
        class(sf_int_t), intent(in) :: object
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: testflag
      end subroutine sf_int_write
   end interface
 
 @ %def sf_int_write
 @ Basic initialization: set the invariant masses for the particles and
 initialize the interaction.  The caller should then add states to the
 interaction and freeze it.
 
 The dimension of the mask should be equal to the sum of the dimensions
 of the mass-squared arrays, which determine incoming, radiated, and
 outgoing particles, respectively.
 
 Optionally, we can define minimum and maximum values for the momentum
 transfer to the outgoing particle(s).  If all masses are zero, this is
 actually required for non-collinear splitting.
 <<SF base: sf int: TBP>>=
   procedure :: base_init => sf_int_base_init
 <<SF base: procedures>>=
   subroutine sf_int_base_init &
        (sf_int, mask, mi2, mr2, mo2, qmin, qmax, hel_lock)
     class(sf_int_t), intent(out) :: sf_int
     type (quantum_numbers_mask_t), dimension(:), intent(in) :: mask
     real(default), dimension(:), intent(in) :: mi2, mr2, mo2
     real(default), dimension(:), intent(in), optional :: qmin, qmax
     integer, dimension(:), intent(in), optional :: hel_lock
     allocate (sf_int%mi2 (size (mi2)))
     sf_int%mi2 = mi2
     allocate (sf_int%mr2 (size (mr2)))
     sf_int%mr2 = mr2
     allocate (sf_int%mo2 (size (mo2)))
     sf_int%mo2 = mo2
     if (present (qmin)) then
        sf_int%qmin_defined = .true.
        allocate (sf_int%qmin (size (qmin)))
        sf_int%qmin = qmin
     end if
     if (present (qmax)) then
        sf_int%qmax_defined = .true.
        allocate (sf_int%qmax (size (qmax)))
        sf_int%qmax = qmax
     end if
     call sf_int%interaction_t%basic_init &
          (size (mi2), 0, size (mr2) + size (mo2), &
          mask = mask, hel_lock = hel_lock, set_relations = .true.)
   end subroutine sf_int_base_init
 
 @ %def sf_int_base_init
 @ Set the indices of the incoming, radiated, and outgoing particles,
 respectively.
 <<SF base: sf int: TBP>>=
   procedure :: set_incoming => sf_int_set_incoming
   procedure :: set_radiated => sf_int_set_radiated
   procedure :: set_outgoing => sf_int_set_outgoing
 <<SF base: procedures>>=
   subroutine sf_int_set_incoming (sf_int, incoming)
     class(sf_int_t), intent(inout) :: sf_int
     integer, dimension(:), intent(in) :: incoming
     allocate (sf_int%incoming (size (incoming)))
     sf_int%incoming = incoming
   end subroutine sf_int_set_incoming
 
   subroutine sf_int_set_radiated (sf_int, radiated)
     class(sf_int_t), intent(inout) :: sf_int
     integer, dimension(:), intent(in) :: radiated
     allocate (sf_int%radiated (size (radiated)))
     sf_int%radiated = radiated
   end subroutine sf_int_set_radiated
 
   subroutine sf_int_set_outgoing (sf_int, outgoing)
     class(sf_int_t), intent(inout) :: sf_int
     integer, dimension(:), intent(in) :: outgoing
     allocate (sf_int%outgoing (size (outgoing)))
     sf_int%outgoing = outgoing
   end subroutine sf_int_set_outgoing
 
 @ %def sf_int_set_incoming
 @ %def sf_int_set_radiated
 @ %def sf_int_set_outgoing
 @ Initialization.  This proceeds via an abstract data object, which
 for the actual implementation should have the matching concrete type.
 Since all implementations have the same signature, we can prepare a
 deferred procedure.  The data object will become the target of a
 corresponding pointer within the [[sf_int_t]] implementation.
 
 This should call the previous procedure.
 <<SF base: sf int: TBP>>=
   procedure (sf_int_init), deferred :: init
 <<SF base: interfaces>>=
   abstract interface
      subroutine sf_int_init (sf_int, data)
        import
        class(sf_int_t), intent(out) :: sf_int
        class(sf_data_t), intent(in), target :: data
      end subroutine sf_int_init
   end interface
 
 @ %def sf_int_init
 @ Complete initialization.  This routine contains initializations that can
 only be performed after the interaction object got its final shape, i.e.,
 redundant helicities have been eliminated by matching with beams and process.
 
 The default implementation does nothing.
 
 The [[target]] attribute is formally required since some overriding
 implementations use a temporary pointer (iterator) to the state-matrix
 component.  It doesn't appear to make a real difference, though.
 <<SF base: sf int: TBP>>=
   procedure :: setup_constants => sf_int_setup_constants
 <<SF base: procedures>>=
   subroutine sf_int_setup_constants (sf_int)
     class(sf_int_t), intent(inout), target :: sf_int
   end subroutine sf_int_setup_constants
 
 @ %def sf_int_setup_constants
 @ Set beam indices, i.e., the beam(s) on which
 this structure function applies.
 <<SF base: sf int: TBP>>=
   procedure :: set_beam_index => sf_int_set_beam_index
 <<SF base: procedures>>=
   subroutine sf_int_set_beam_index (sf_int, beam_index)
     class(sf_int_t), intent(inout) :: sf_int
     integer, dimension(:), intent(in) :: beam_index
     allocate (sf_int%beam_index (size (beam_index)))
     sf_int%beam_index = beam_index
   end subroutine sf_int_set_beam_index
 
 @ %def sf_int_set_beam_index
 @ Set parameter indices, indicating which MC input parameters are to
 be used for evaluating this structure function.
 <<SF base: sf int: TBP>>=
   procedure :: set_par_index => sf_int_set_par_index
 <<SF base: procedures>>=
   subroutine sf_int_set_par_index (sf_int, par_index)
     class(sf_int_t), intent(inout) :: sf_int
     integer, dimension(:), intent(in) :: par_index
     allocate (sf_int%par_index (size (par_index)))
     sf_int%par_index = par_index
   end subroutine sf_int_set_par_index
 
 @ %def sf_int_set_par_index
 @ Initialize the structure-function kinematics, setting incoming
 momenta.  We assume that array shapes match.
 
 Three versions.  The first version relies on the momenta being linked
 to another interaction.  The second version sets the momenta
 explicitly.  In the third version, we first compute momenta for the
 specified energies and store those.
 <<SF base: sf int: TBP>>=
   generic :: seed_kinematics => sf_int_receive_momenta
   generic :: seed_kinematics => sf_int_seed_momenta
   generic :: seed_kinematics => sf_int_seed_energies
   procedure :: sf_int_receive_momenta
   procedure :: sf_int_seed_momenta
   procedure :: sf_int_seed_energies
 <<SF base: procedures>>=
   subroutine sf_int_receive_momenta (sf_int)
     class(sf_int_t), intent(inout) :: sf_int
     if (sf_int%status >= SF_INITIAL) then
        call sf_int%receive_momenta ()
        sf_int%status = SF_SEED_KINEMATICS
     end if
   end subroutine sf_int_receive_momenta
 
   subroutine sf_int_seed_momenta (sf_int, k)
     class(sf_int_t), intent(inout) :: sf_int
     type(vector4_t), dimension(:), intent(in) :: k
     if (sf_int%status >= SF_INITIAL) then
        call sf_int%set_momenta (k, outgoing=.false.)
        sf_int%status = SF_SEED_KINEMATICS
     end if
   end subroutine sf_int_seed_momenta
 
   subroutine sf_int_seed_energies (sf_int, E)
     class(sf_int_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: E
     type(vector4_t), dimension(:), allocatable :: k
     integer :: j
     if (sf_int%status >= SF_INITIAL) then
        allocate (k (size (E)))
        if (all (E**2 >= sf_int%mi2)) then
           do j = 1, size (E)
              k(j) = vector4_moving (E(j), &
                   (3-2*j) * sqrt (E(j)**2 - sf_int%mi2(j)), 3)
           end do
           call sf_int%seed_kinematics (k)
        end if
     end if
   end subroutine sf_int_seed_energies
 
 @ %def sf_int_seed_momenta
 @ %def sf_int_seed_energies
 @ Tell if in generator mode.  By default, this is false.  To be
 overridden where appropriate; we may refer to the [[is_generator]]
 method of the [[data]] component in the concrete type.
 <<SF base: sf int: TBP>>=
   procedure :: is_generator => sf_int_is_generator
 <<SF base: procedures>>=
   function sf_int_is_generator (sf_int) result (flag)
     class(sf_int_t), intent(in) :: sf_int
     logical :: flag
     flag = .false.
   end function sf_int_is_generator
 
 @ %def sf_int_is_generator
 @ Generate free parameters [[r]].  Parameters are free if they do not
 correspond to integration parameters (i.e., are bound), but are
 generated by the structure function object itself.  By default, all
 parameters are bound, and the output values of this procedure will be
 discarded.  With free parameters, we have to override this procedure.
 
 The value [[x_free]] is the renormalization factor of the total energy
 that corresponds to the free parameters.  If there are no free
 parameters, the procedure will not change its value, which starts as
 unity.  Otherwise, the fraction is typically decreased, but may also
 be increased in some cases.
 <<SF base: sf int: TBP>>=
   procedure :: generate_free => sf_int_generate_free
 <<SF base: procedures>>=
   subroutine sf_int_generate_free (sf_int, r, rb,  x_free)
     class(sf_int_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(inout) :: x_free
     r = 0
     rb= 1
   end subroutine sf_int_generate_free
 
 @ %def sf_int_generate_free
 @ Complete the structure-function kinematics, derived from an input
 parameter (array) $r$ between 0 and 1.  The interaction momenta are
 calculated, and we return $x$ (the momentum fraction), and $f$ (the
 Jacobian factor for the map $r\to x$), if [[map]] is set.
 
 If the [[map]] flag is unset, $r$ and $x$ values will coincide, and $f$ will
 become unity.  If it is set, the structure-function implementation chooses a
 convenient mapping from $r$ to $x$ with Jacobian $f$.
 
 In the [[inverse_kinematics]] variant, we exchange the intent of [[x]]
 and [[r]].  The momenta are calculated only if the optional flag
 [[set_momenta]] is present and set.  Internal parameters of [[sf_int]]
 are calculated only if the optional flag [[set_x]] is present and set.
 
 Update 2018-08-22: Throughout this algorithm, we now carry
 [[xb]]=$1-x$ together with [[x]] values, as we did for [[r]] before.
 This allows us to handle unstable endpoint numerics wherever
 necessary.  The only place where the changes actually did matter was
 for inverse kinematics in the ISR setup, with a very soft photon, but
 it might be most sensible to apply the extension with [[xb]] everywhere.
 <<SF base: sf int: TBP>>=
   procedure (sf_int_complete_kinematics), deferred :: complete_kinematics
   procedure (sf_int_inverse_kinematics), deferred :: inverse_kinematics
 <<SF base: interfaces>>=
   abstract interface
      subroutine sf_int_complete_kinematics (sf_int, x, xb, f, r, rb, map)
        import
        class(sf_int_t), intent(inout) :: sf_int
        real(default), dimension(:), intent(out) :: x
        real(default), dimension(:), intent(out) :: xb
        real(default), intent(out) :: f
        real(default), dimension(:), intent(in) :: r
        real(default), dimension(:), intent(in) :: rb
        logical, intent(in) :: map
      end subroutine sf_int_complete_kinematics
   end interface
 
   abstract interface
      subroutine sf_int_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
        import
        class(sf_int_t), intent(inout) :: sf_int
        real(default), dimension(:), intent(in) :: x
        real(default), dimension(:), intent(in) :: xb
        real(default), intent(out) :: f
        real(default), dimension(:), intent(out) :: r
        real(default), dimension(:), intent(out) :: rb
        logical, intent(in) :: map
        logical, intent(in), optional :: set_momenta
      end subroutine sf_int_inverse_kinematics
   end interface
 
 @ %def sf_int_complete_kinematics
 @ %def sf_int_inverse_kinematics
 @ Single splitting: compute momenta, given $x$ input parameters.  We
 assume that the incoming momentum is set.  The status code is set to
 [[SF_FAILED_KINEMATICS]] if
 the $x$ array does not correspond to a valid momentum configuration.
 Otherwise, it is updated to [[SF_DONE_KINEMATICS]].
 
 We force the outgoing particle on-shell.  The on-shell projection is
 determined by the [[on_shell_mode]].  The radiated particle should already be
 on shell.
 <<SF base: sf int: TBP>>=
   procedure :: split_momentum => sf_int_split_momentum
 <<SF base: procedures>>=
   subroutine sf_int_split_momentum (sf_int, x, xb)
     class(sf_int_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     type(splitting_data_t) :: sd
     real(default) :: E1, E2
     logical :: fail
     if (sf_int%status >= SF_SEED_KINEMATICS) then
        k = sf_int%get_momentum (1)
        call sd%init (k, &
             sf_int%mi2(1), sf_int%mr2(1), sf_int%mo2(1), &
             collinear = size (x) == 1)
        call sd%set_t_bounds (x(1), xb(1))
        select case (size (x))
        case (1)
        case (3)
           if (sf_int%qmax_defined) then
              if (sf_int%qmin_defined) then
                 call sd%sample_t (x(2), &
                      t0 = - sf_int%qmax(1) ** 2, t1 = - sf_int%qmin(1) ** 2)
              else
                 call sd%sample_t (x(2), &
                      t0 = - sf_int%qmax(1) ** 2)
              end if
           else
              if (sf_int%qmin_defined) then
                 call sd%sample_t (x(2), t1 = - sf_int%qmin(1) ** 2)
              else
                 call sd%sample_t (x(2))
              end if
           end if
           call sd%sample_phi (x(3))
        case default
           call msg_bug ("Structure function: impossible number of parameters")
        end select
        q = sd%split_momentum (k)
        call on_shell (q, [sf_int%mr2, sf_int%mo2], &
             sf_int%on_shell_mode)
        call sf_int%set_momenta (q, outgoing=.true.)
        E1 = energy (q(1))
        E2 = energy (q(2))
        fail = E1 < 0 .or. E2 < 0 &
             .or. E1 ** 2 < sf_int%mr2(1) &
             .or. E2 ** 2 < sf_int%mo2(1)
        if (fail) then
           sf_int%status = SF_FAILED_KINEMATICS
        else
           sf_int%status = SF_DONE_KINEMATICS
        end if
     end if
   end subroutine sf_int_split_momentum
 
 @ %def sf_test_split_momentum
 @ Pair splitting: two incoming momenta, two radiated, two outgoing.
 This is simple because we insist on all momenta being collinear.
 <<SF base: sf int: TBP>>=
   procedure :: split_momenta => sf_int_split_momenta
 <<SF base: procedures>>=
   subroutine sf_int_split_momenta (sf_int, x, xb)
     class(sf_int_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     type(vector4_t), dimension(2) :: k
     type(vector4_t), dimension(4) :: q
     real(default), dimension(4) :: E
     logical :: fail
     if (sf_int%status >= SF_SEED_KINEMATICS) then
        select case (size (x))
        case (2)
        case default
           call msg_bug ("Pair structure function: recoil requested &
                &but not implemented yet")
        end select
        k(1) = sf_int%get_momentum (1)
        k(2) = sf_int%get_momentum (2)
        q(1:2) = xb * k
        q(3:4) = x * k
        select case (size (sf_int%mr2))
        case (2)
           call on_shell (q, &
                [sf_int%mr2(1), sf_int%mr2(2), &
                sf_int%mo2(1), sf_int%mo2(2)], &
                sf_int%on_shell_mode)
           call sf_int%set_momenta (q, outgoing=.true.)
           E = energy (q)
           fail = any (E < 0) &
                .or. any (E(1:2) ** 2 < sf_int%mr2) &
                .or. any (E(3:4) ** 2 < sf_int%mo2)
        case default;  call msg_bug ("split momenta: incorrect use")
        end select
        if (fail) then
           sf_int%status = SF_FAILED_KINEMATICS
        else
           sf_int%status = SF_DONE_KINEMATICS
        end if
     end if
   end subroutine sf_int_split_momenta
 
 @ %def sf_int_split_momenta
 @ Pair spectrum: the reduced version of the previous splitting,
 without radiated momenta.
 <<SF base: sf int: TBP>>=
   procedure :: reduce_momenta => sf_int_reduce_momenta
 <<SF base: procedures>>=
   subroutine sf_int_reduce_momenta (sf_int, x)
     class(sf_int_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     type(vector4_t), dimension(2) :: k
     type(vector4_t), dimension(2) :: q
     real(default), dimension(2) :: E
     logical :: fail
     if (sf_int%status >= SF_SEED_KINEMATICS) then
        select case (size (x))
        case (2)
        case default
           call msg_bug ("Pair spectrum: recoil requested &
                &but not implemented yet")
        end select
        k(1) = sf_int%get_momentum (1)
        k(2) = sf_int%get_momentum (2)
        q = x * k
        call on_shell (q, &
             [sf_int%mo2(1), sf_int%mo2(2)], &
             sf_int%on_shell_mode)
        call sf_int%set_momenta (q, outgoing=.true.)
        E = energy (q)
        fail = any (E < 0) &
             .or. any (E ** 2 < sf_int%mo2)
        if (fail) then
           sf_int%status = SF_FAILED_KINEMATICS
        else
           sf_int%status = SF_DONE_KINEMATICS
        end if
     end if
   end subroutine sf_int_reduce_momenta
 
 @ %def sf_int_reduce_momenta
 @ The inverse procedure: we compute the [[x]] array from the momentum
 configuration.  In an overriding TBP, we may also set internal data
 that depend on this, for convenience.
 
 NOTE: Here and above, the single-particle case is treated in detail,
 allowing for non-collinearity and non-vanishing masses and nontrivial
 momentum-transfer bounds.  For the pair case, we currently implement
 only collinear splitting and assume massless particles.  This should
 be improved.
 
 Update 2017-08-22: recover also [[xb]], using the updated [[recover]]
 method of the splitting-data object.  Th
 <<SF base: sf int: TBP>>=
   procedure :: recover_x => sf_int_recover_x
   procedure :: base_recover_x => sf_int_recover_x
 <<SF base: procedures>>=
   subroutine sf_int_recover_x (sf_int, x, xb, x_free)
     class(sf_int_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(inout), optional :: x_free
     type(vector4_t), dimension(:), allocatable :: k
     type(vector4_t), dimension(:), allocatable :: q
     type(splitting_data_t) :: sd
     if (sf_int%status >= SF_SEED_KINEMATICS) then
        allocate (k (sf_int%interaction_t%get_n_in ()))
        allocate (q (sf_int%interaction_t%get_n_out ()))
        k = sf_int%get_momenta (outgoing=.false.)
        q = sf_int%get_momenta (outgoing=.true.)
        select case (size (k))
        case (1)
           call sd%init (k(1), &
                sf_int%mi2(1), sf_int%mr2(1), sf_int%mo2(1), &
                collinear = size (x) == 1)
           call sd%recover (k(1), q, sf_int%on_shell_mode)
           x(1)  = sd%get_x ()
           xb(1) = sd%get_xb ()
           select case (size (x))
           case (1)
           case (3)
              if (sf_int%qmax_defined) then
                 if (sf_int%qmin_defined) then
                    call sd%inverse_t (x(2), &
                         t0 = - sf_int%qmax(1) ** 2, t1 = - sf_int%qmin(1) ** 2)
                 else
                    call sd%inverse_t (x(2), &
                         t0 = - sf_int%qmax(1) ** 2)
                 end if
              else
                 if (sf_int%qmin_defined) then
                    call sd%inverse_t (x(2), t1 = - sf_int%qmin(1) ** 2)
                 else
                    call sd%inverse_t (x(2))
                 end if
              end if
              call sd%inverse_phi (x(3))
              xb(2:3) = 1 - x(2:3)
           case default
              call msg_bug ("Structure function: impossible number &
                   &of parameters")
           end select
        case (2)
           select case (size (x))
           case (2)
           case default
              call msg_bug ("Pair structure function: recoil requested &
                   &but not implemented yet")
           end select
           select case (sf_int%on_shell_mode)
           case (KEEP_ENERGY)
              select case (size (q))
              case (4)
                 x = energy (q(3:4)) / energy (k)
                 xb= energy (q(1:2)) / energy (k)
              case (2)
                 x = energy (q) / energy (k)
                 xb= 1 - x
              end select
           case (KEEP_MOMENTUM)
              select case (size (q))
              case (4)
                 x = longitudinal_part (q(3:4)) / longitudinal_part (k)
                 xb= longitudinal_part (q(1:2)) / longitudinal_part (k)
              case (2)
                 x = longitudinal_part (q) / longitudinal_part (k)
                 xb= 1 - x
              end select
           end select
        end select
     end if
   end subroutine sf_int_recover_x
 
 @ %def sf_int_recover_x
 @ Apply the structure function, i.e., evaluate the interaction.  For
 the calculation, we may use the stored momenta, any further
 information stored inside the [[sf_int]] implementation during
 kinematics setup, and the given energy scale.  It may happen that for
 the given kinematics the value is not defined.  This should be
 indicated by the status code.
 <<SF base: sf int: TBP>>=
   procedure (sf_int_apply), deferred :: apply
 <<SF base: interfaces>>=
   abstract interface
      subroutine sf_int_apply (sf_int, scale, rescale, i_sub)
        import
        class(sf_int_t), intent(inout) :: sf_int
        real(default), intent(in) :: scale
        class(sf_rescale_t), intent(in), optional :: rescale
        integer, intent(in), optional :: i_sub
      end subroutine sf_int_apply
   end interface
 
 @ %def sf_int_apply
 @
 \subsection{Accessing the structure function}
 Return metadata.  Once [[interaction_t]] is rewritten in OO, some of this will
 be inherited.
 
 The number of outgoing particles is equal to the number of incoming particles.
 The radiated particles are the difference.
 <<SF base: sf int: TBP>>=
   procedure :: get_n_in => sf_int_get_n_in
   procedure :: get_n_rad => sf_int_get_n_rad
   procedure :: get_n_out => sf_int_get_n_out
 <<SF base: procedures>>=
   pure function sf_int_get_n_in (object) result (n_in)
     class(sf_int_t), intent(in) :: object
     integer :: n_in
     n_in = object%interaction_t%get_n_in ()
   end function sf_int_get_n_in
 
   pure function sf_int_get_n_rad (object) result (n_rad)
     class(sf_int_t), intent(in) :: object
     integer :: n_rad
     n_rad = object%interaction_t%get_n_out () &
          - object%interaction_t%get_n_in ()
   end function sf_int_get_n_rad
 
   pure function sf_int_get_n_out (object) result (n_out)
     class(sf_int_t), intent(in) :: object
     integer :: n_out
     n_out = object%interaction_t%get_n_in ()
   end function sf_int_get_n_out
 
 @ %def sf_int_get_n_in
 @ %def sf_int_get_n_rad
 @ %def sf_int_get_n_out
 @ Number of matrix element entries in the interaction:
 <<SF base: sf int: TBP>>=
   procedure :: get_n_states => sf_int_get_n_states
 <<SF base: procedures>>=
   function sf_int_get_n_states (sf_int) result (n_states)
     class(sf_int_t), intent(in) :: sf_int
     integer :: n_states
     n_states = sf_int%get_n_matrix_elements ()
   end function sf_int_get_n_states
 
 @ %def sf_int_get_n_states
 @ Return a specific state as a quantum-number array.
 <<SF base: sf int: TBP>>=
   procedure :: get_state => sf_int_get_state
 <<SF base: procedures>>=
   function sf_int_get_state (sf_int, i) result (qn)
     class(sf_int_t), intent(in) :: sf_int
     type(quantum_numbers_t), dimension(:), allocatable :: qn
     integer, intent(in) :: i
     allocate (qn (sf_int%get_n_tot ()))
     qn = sf_int%get_quantum_numbers (i)
   end function sf_int_get_state
 
 @ %def sf_int_get_state
 @ Return the matrix-element values for all states.  We can assume that
 the matrix elements are real, so we take the real part.
 <<SF base: sf int: TBP>>=
   procedure :: get_values => sf_int_get_values
 <<SF base: procedures>>=
   subroutine sf_int_get_values (sf_int, value)
     class(sf_int_t), intent(in) :: sf_int
     real(default), dimension(:), intent(out) :: value
     integer :: i
     if (sf_int%status >= SF_EVALUATED) then
        do i = 1, size (value)
           value(i) = real (sf_int%get_matrix_element (i))
        end do
     else
        value = 0
     end if
   end subroutine sf_int_get_values
 
 @ %def sf_int_get_values
 @
 \subsection{Direct calculations}
 Compute a structure function value (array) directly, given an array of $x$
 values and a scale.  If the energy is also given, we initialize the
 kinematics for that energy, otherwise take it from a previous run.
 
 We assume that the [[E]] array has dimension [[n_in]], and the [[x]]
 array has [[n_par]].
 
 Note: the output x values ([[xx]] and [[xxb]]) are unused in this use case.
 <<SF base: sf int: TBP>>=
   procedure :: compute_values => sf_int_compute_values
 <<SF base: procedures>>=
   subroutine sf_int_compute_values (sf_int, value, x, xb, scale, E)
     class(sf_int_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: value
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(in) :: scale
     real(default), dimension(:), intent(in), optional :: E
     real(default), dimension(size (x)) :: xx, xxb
     real(default) :: f
     if (present (E))  call sf_int%seed_kinematics (E)
     if (sf_int%status >= SF_SEED_KINEMATICS) then
        call sf_int%complete_kinematics (xx, xxb, f, x, xb, map=.false.)
        call sf_int%apply (scale)
        call sf_int%get_values (value)
        value = value * f
     else
        value = 0
     end if
   end subroutine sf_int_compute_values
 
 @ %def sf_int_compute_values
 @ Compute just a single value for one of the states, i.e., throw the
 others away.
 <<SF base: sf int: TBP>>=
   procedure :: compute_value => sf_int_compute_value
 <<SF base: procedures>>=
   subroutine sf_int_compute_value &
        (sf_int, i_state, value, x, xb, scale, E)
     class(sf_int_t), intent(inout) :: sf_int
     integer, intent(in) :: i_state
     real(default), intent(out) :: value
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(in) :: scale
     real(default), dimension(:), intent(in), optional :: E
     real(default), dimension(:), allocatable :: value_array
     if (sf_int%status >= SF_INITIAL) then
        allocate (value_array (sf_int%get_n_states ()))
        call sf_int%compute_values (value_array, x, xb, scale, E)
        value = value_array(i_state)
     else
        value = 0
     end if
   end subroutine sf_int_compute_value
 
 @ %def sf_int_compute_value
 @
 \subsection{Structure-function instance}
 This is a wrapper for [[sf_int_t]] objects, such that we can
 build an array with different structure-function types.  The
 structure-function contains an array (a sequence) of [[sf_int_t]]
 objects.
 
 The object, it holds the evaluator that connects the preceding part of the
 structure-function chain to the current interaction.
 
 It also stores the input and output parameter values for the
 contained structure function.  The [[r]] array has a second dimension,
 corresponding to the mapping channels in a multi-channel
 configuration.  There is a Jacobian entry [[f]] for each channel.  The
 corresponding logical array [[mapping]] tells whether we apply the
 mapping appropriate for the current structure function in this channel.
 The [[x]] parameter values (energy fractions) are common to all
 channels.
 <<SF base: types>>=
   type :: sf_instance_t
      class(sf_int_t), allocatable :: int
      type(evaluator_t) :: eval
      real(default), dimension(:,:), allocatable :: r
      real(default), dimension(:,:), allocatable :: rb
      real(default), dimension(:), allocatable :: f
      logical, dimension(:), allocatable :: m
      real(default), dimension(:), allocatable :: x
      real(default), dimension(:), allocatable :: xb
   end type sf_instance_t
 
 @ %def sf_instance_t
 @
 \subsection{Structure-function chain}
 A chain is an array of structure functions [[sf]], initiated by a beam setup.
 We do not use this directly for evaluation, but create instances with
 copies of the contained interactions.
 
 [[n_par]] is the total number of parameters that is necessary for
 completely determining the structure-function chain.  [[n_bound]] is
 the number of MC input parameters that are requested from the
 integrator.  The difference of [[n_par]] and [[n_bound]] is the number
 of free parameters, which are generated by a structure-function
 object in generator mode.
 <<SF base: public>>=
   public :: sf_chain_t
 <<SF base: types>>=
   type, extends (beam_t) :: sf_chain_t
      type(beam_data_t), pointer :: beam_data => null ()
      integer :: n_in = 0
      integer :: n_strfun = 0
      integer :: n_par = 0
      integer :: n_bound = 0
      type(sf_instance_t), dimension(:), allocatable :: sf
      logical :: trace_enable = .false.
      integer :: trace_unit = 0
    contains
    <<SF base: sf chain: TBP>>
   end type sf_chain_t
 
 @ %def sf_chain_t
 @ Finalizer.
 <<SF base: sf chain: TBP>>=
   procedure :: final => sf_chain_final
 <<SF base: procedures>>=
   subroutine sf_chain_final (object)
     class(sf_chain_t), intent(inout) :: object
     integer :: i
     call object%final_tracing ()
     if (allocated (object%sf)) then
        do i = 1, size (object%sf, 1)
           associate (sf => object%sf(i))
             if (allocated (sf%int)) then
                call sf%int%final ()
             end if
           end associate
        end do
     end if
     call beam_final (object%beam_t)
   end subroutine sf_chain_final
 
 @ %def sf_chain_final
 @ Output.
 <<SF base: sf chain: TBP>>=
   procedure :: write => sf_chain_write
 <<SF base: procedures>>=
   subroutine sf_chain_write (object, unit)
     class(sf_chain_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Incoming particles / structure-function chain:"
     if (associated (object%beam_data)) then
        write (u, "(3x,A,I0)")  "n_in      = ", object%n_in
        write (u, "(3x,A,I0)")  "n_strfun  = ", object%n_strfun
        write (u, "(3x,A,I0)")  "n_par     = ", object%n_par
        if (object%n_par /= object%n_bound) then
           write (u, "(3x,A,I0)")  "n_bound   = ", object%n_bound
        end if
        call object%beam_data%write (u)
        call write_separator (u)
        call beam_write (object%beam_t, u)
        if (allocated (object%sf)) then
           do i = 1, object%n_strfun
              associate (sf => object%sf(i))
                call write_separator (u)
                if (allocated (sf%int)) then
                   call sf%int%write (u)
                else
                   write (u, "(1x,A)")  "SF instance: [undefined]"
                end if
              end associate
           end do
        end if
     else
        write (u, "(3x,A)")  "[undefined]"
     end if
   end subroutine sf_chain_write
 
 @ %def sf_chain_write
 @ Initialize: setup beams.  The [[beam_data]] target must remain valid
 for the lifetime of the chain, since we just establish a pointer.  The
 structure-function configuration array is used to initialize the
 individual structure-function entries.  The target attribute is needed
 because the [[sf_int]] entries establish pointers to the configuration data.
 <<SF base: sf chain: TBP>>=
   procedure :: init => sf_chain_init
 <<SF base: procedures>>=
   subroutine sf_chain_init (sf_chain, beam_data, sf_config)
     class(sf_chain_t), intent(out) :: sf_chain
     type(beam_data_t), intent(in), target :: beam_data
     type(sf_config_t), dimension(:), intent(in), optional, target :: sf_config
     integer :: i
     sf_chain%beam_data => beam_data
     sf_chain%n_in = beam_data%get_n_in ()
     call beam_init (sf_chain%beam_t, beam_data)
     if (present (sf_config)) then
        sf_chain%n_strfun = size (sf_config)
        allocate (sf_chain%sf (sf_chain%n_strfun))
        do i = 1, sf_chain%n_strfun
           call sf_chain%set_strfun (i, sf_config(i)%i, sf_config(i)%data)
        end do
     end if
   end subroutine sf_chain_init
 
 @ %def sf_chain_init
 @ Receive the beam momenta from a source to which the beam interaction
 is linked.
 <<SF base: sf chain: TBP>>=
   procedure :: receive_beam_momenta => sf_chain_receive_beam_momenta
 <<SF base: procedures>>=
   subroutine sf_chain_receive_beam_momenta (sf_chain)
     class(sf_chain_t), intent(inout), target :: sf_chain
     type(interaction_t), pointer :: beam_int
     beam_int => sf_chain%get_beam_int_ptr ()
     call beam_int%receive_momenta ()
   end subroutine sf_chain_receive_beam_momenta
 
 @ %def sf_chain_receive_beam_momenta
 @ Explicitly set the beam momenta.
 <<SF base: sf chain: TBP>>=
   procedure :: set_beam_momenta => sf_chain_set_beam_momenta
 <<SF base: procedures>>=
   subroutine sf_chain_set_beam_momenta (sf_chain, p)
     class(sf_chain_t), intent(inout) :: sf_chain
     type(vector4_t), dimension(:), intent(in) :: p
     call beam_set_momenta (sf_chain%beam_t, p)
   end subroutine sf_chain_set_beam_momenta
 
 @ %def sf_chain_set_beam_momenta
 @ Set a structure-function entry.  We use the [[data]] input to
 allocate the [[int]] structure-function instance with appropriate
 type, then initialize the entry.  The entry establishes a pointer to
 [[data]].
 
 The index [[i]] is the structure-function index in the chain.
 <<SF base: sf chain: TBP>>=
   procedure :: set_strfun => sf_chain_set_strfun
 <<SF base: procedures>>=
   subroutine sf_chain_set_strfun (sf_chain, i, beam_index, data)
     class(sf_chain_t), intent(inout) :: sf_chain
     integer, intent(in) :: i
     integer, dimension(:), intent(in) :: beam_index
     class(sf_data_t), intent(in), target :: data
     integer :: n_par, j
     n_par = data%get_n_par ()
     call data%allocate_sf_int (sf_chain%sf(i)%int)
     associate (sf_int => sf_chain%sf(i)%int)
       call sf_int%init (data)
       call sf_int%set_beam_index (beam_index)
       call sf_int%set_par_index &
            ([(j, j = sf_chain%n_par + 1, sf_chain%n_par + n_par)])
       sf_chain%n_par = sf_chain%n_par + n_par
       if (.not. data%is_generator ()) then
          sf_chain%n_bound = sf_chain%n_bound + n_par
       end if
     end associate
   end subroutine sf_chain_set_strfun
 
 @ %def sf_chain_set_strfun
 @ Return the number of structure-function parameters.
 <<SF base: sf chain: TBP>>=
   procedure :: get_n_par => sf_chain_get_n_par
   procedure :: get_n_bound => sf_chain_get_n_bound
 <<SF base: procedures>>=
   function sf_chain_get_n_par (sf_chain) result (n)
     class(sf_chain_t), intent(in) :: sf_chain
     integer :: n
     n = sf_chain%n_par
   end function sf_chain_get_n_par
 
   function sf_chain_get_n_bound (sf_chain) result (n)
     class(sf_chain_t), intent(in) :: sf_chain
     integer :: n
     n = sf_chain%n_bound
   end function sf_chain_get_n_bound
 
 @ %def sf_chain_get_n_par
 @ %def sf_chain_get_n_bound
 @ Return a pointer to the beam interaction.
 <<SF base: sf chain: TBP>>=
   procedure :: get_beam_int_ptr => sf_chain_get_beam_int_ptr
 <<SF base: procedures>>=
   function sf_chain_get_beam_int_ptr (sf_chain) result (int)
     type(interaction_t), pointer :: int
     class(sf_chain_t), intent(in), target :: sf_chain
     int => beam_get_int_ptr (sf_chain%beam_t)
   end function sf_chain_get_beam_int_ptr
 
 @ %def sf_chain_get_beam_int_ptr
 @ Enable the trace feature: record structure function data (input
 parameters, $x$ values, evaluation result) to an external file.
 <<SF base: sf chain: TBP>>=
   procedure :: setup_tracing => sf_chain_setup_tracing
   procedure :: final_tracing => sf_chain_final_tracing
 <<SF base: procedures>>=
   subroutine sf_chain_setup_tracing (sf_chain, file)
     class(sf_chain_t), intent(inout) :: sf_chain
     type(string_t), intent(in) :: file
     if (sf_chain%n_strfun > 0) then
        sf_chain%trace_enable = .true.
        sf_chain%trace_unit = free_unit ()
        open (sf_chain%trace_unit, file = char (file), action = "write", &
             status = "replace")
        call sf_chain%write_trace_header ()
     else
        call msg_error ("Beam structure: no structure functions, tracing &
             &disabled")
     end if
   end subroutine sf_chain_setup_tracing
 
   subroutine sf_chain_final_tracing (sf_chain)
     class(sf_chain_t), intent(inout) :: sf_chain
     if (sf_chain%trace_enable) then
        close (sf_chain%trace_unit)
        sf_chain%trace_enable = .false.
     end if
   end subroutine sf_chain_final_tracing
 
 @ %def sf_chain_setup_tracing
 @ %def sf_chain_final_tracing
 @ Write the header for the tracing file.
 <<SF base: sf chain: TBP>>=
   procedure :: write_trace_header => sf_chain_write_trace_header
 <<SF base: procedures>>=
   subroutine sf_chain_write_trace_header (sf_chain)
     class(sf_chain_t), intent(in) :: sf_chain
     integer :: u
     if (sf_chain%trace_enable) then
        u = sf_chain%trace_unit
        write (u, "('# ',A)")  "WHIZARD output: &
             &structure-function sampling data"
        write (u, "('# ',A,1x,I0)")  "Number of sf records:", sf_chain%n_strfun
        write (u, "('# ',A,1x,I0)")  "Number of parameters:", sf_chain%n_par
        write (u, "('# ',A)")  "Columns: channel, p(n_par), x(n_par), f, Jac * f"
     end if
   end subroutine sf_chain_write_trace_header
 
 @ %def sf_chain_write_trace_header
 @ Write a record which collects the structure function data for the
 current data point.  For the selected channel, we print first the
 input integration parameters, then the $x$ values, then the
 structure-function value summed over all quantum numbers, then the
 structure function value times the mapping Jacobian.
 <<SF base: sf chain: TBP>>=
   procedure :: trace => sf_chain_trace
 <<SF base: procedures>>=
   subroutine sf_chain_trace (sf_chain, c_sel, p, x, f, sf_sum)
     class(sf_chain_t), intent(in) :: sf_chain
     integer, intent(in) :: c_sel
     real(default), dimension(:,:), intent(in) :: p
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: f
     real(default), intent(in) :: sf_sum
     real(default) :: sf_sum_pac, f_sf_sum_pac
     integer :: u, i
     if (sf_chain%trace_enable) then
        u = sf_chain%trace_unit
        write (u, "(1x,I0)", advance="no")  c_sel
        write (u, "(2x)", advance="no")
        do i = 1, sf_chain%n_par
           write (u, "(1x," // FMT_17 // ")", advance="no")  p(i,c_sel)
        end do
        write (u, "(2x)", advance="no")
        do i = 1, sf_chain%n_par
           write (u, "(1x," // FMT_17 // ")", advance="no")  x(i)
        end do
        write (u, "(2x)", advance="no")
        sf_sum_pac = sf_sum
        f_sf_sum_pac = f(c_sel) * sf_sum
        call pacify (sf_sum_pac, 1.E-28_default)
        call pacify (f_sf_sum_pac, 1.E-28_default)
        write (u, "(2(1x," // FMT_17 // "))")  sf_sum_pac, f_sf_sum_pac
     end if
   end subroutine sf_chain_trace
 
 @ %def sf_chain_trace
 @
 \subsection{Chain instances}
 A structure-function chain instance contains copies of the
 interactions in the configuration chain, suitably linked to each other
 and connected by evaluators.
 
 After initialization, [[out_sf]] should point, for each beam, to the
 last structure function that affects this beam.  [[out_sf_i]] should
 indicate the index of the corresponding outgoing particle within that
 structure-function interaction.
 
 Analogously, [[out_eval]] is the last evaluator in the
 structure-function chain, which contains the complete set of outgoing
 particles. [[out_eval_i]] should indicate the index of the outgoing
 particles, within that evaluator, which will initiate the collision.
 
 When calculating actual kinematics, we fill the [[p]], [[r]], and
 [[x]] arrays and the [[f]] factor.  The [[p]] array denotes the MC
 input parameters as they come from the random-number generator.  The
 [[r]] array results from applying global mappings.  The [[x]] array
 results from applying structure-function local mappings.  The $x$
 values can be interpreted directly as momentum fractions (or angle
 fractions, where recoil is involved).  The [[f]] factor is the
 Jacobian that results from applying all mappings.
 
 Update 2017-08-22: carry and output all complements ([[pb]], [[rb]],
 [[xb]]).  Previously, [[xb]] was not included in the record, and the
 output did not contain either.  It does become more verbose, however.
 
 The [[mapping]] entry may store a global mapping that is applied to a
 combination of $x$ values and structure functions, as opposed to mappings that
 affect only a single structure function.  It is applied before the latter
 mappings, in the transformation from the [[p]] array to the [[r]] array.  For
 parameters affected by this mapping, we should ensure that they are not
 involved in a local mapping.
 <<SF base: public>>=
   public :: sf_chain_instance_t
 <<SF base: types>>=
   type, extends (beam_t) :: sf_chain_instance_t
      type(sf_chain_t), pointer :: config => null ()
      integer :: status = SF_UNDEFINED
      type(sf_instance_t), dimension(:), allocatable :: sf
      integer, dimension(:), allocatable :: out_sf
      integer, dimension(:), allocatable :: out_sf_i
      integer :: out_eval = 0
      integer, dimension(:), allocatable :: out_eval_i
      integer :: selected_channel = 0
      real(default), dimension(:,:), allocatable :: p, pb
      real(default), dimension(:,:), allocatable :: r, rb
      real(default), dimension(:), allocatable :: f
      real(default), dimension(:), allocatable :: x, xb
      logical, dimension(:), allocatable :: bound
      real(default) :: x_free = 1
      type(sf_channel_t), dimension(:), allocatable :: channel
    contains
    <<SF base: sf chain instance: TBP>>
   end type sf_chain_instance_t
 
 @ %def sf_chain_instance_t
 @ Finalizer.
 <<SF base: sf chain instance: TBP>>=
   procedure :: final => sf_chain_instance_final
 <<SF base: procedures>>=
   subroutine sf_chain_instance_final (object)
     class(sf_chain_instance_t), intent(inout) :: object
     integer :: i
     if (allocated (object%sf)) then
        do i = 1, size (object%sf, 1)
           associate (sf => object%sf(i))
             if (allocated (sf%int)) then
                call sf%eval%final ()
                call sf%int%final ()
             end if
           end associate
        end do
     end if
     call beam_final (object%beam_t)
   end subroutine sf_chain_instance_final
 
 @ %def sf_chain_instance_final
 @ Output.
 <<SF base: sf chain instance: TBP>>=
   procedure :: write => sf_chain_instance_write
 <<SF base: procedures>>=
   subroutine sf_chain_instance_write (object, unit, col_verbose)
     class(sf_chain_instance_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: col_verbose
     integer :: u, i, c
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "Structure-function chain instance:"
     call write_sf_status (object%status, u)
     if (allocated (object%out_sf)) then
        write (u, "(3x,A)", advance="no")  "outgoing (interactions) ="
        do i = 1, size (object%out_sf)
           write (u, "(1x,I0,':',I0)", advance="no") &
                object%out_sf(i), object%out_sf_i(i)
        end do
        write (u, *)
     end if
     if (object%out_eval /= 0) then
        write (u, "(3x,A)", advance="no")  "outgoing (evaluators)   ="
        do i = 1, size (object%out_sf)
           write (u, "(1x,I0,':',I0)", advance="no") &
                object%out_eval, object%out_eval_i(i)
        end do
        write (u, *)
     end if
     if (allocated (object%sf)) then
        if (size (object%sf) /= 0) then
           write (u, "(1x,A)")  "Structure-function parameters:"
           do c = 1, size (object%f)
              write (u, "(1x,A,I0,A)", advance="no")  "Channel #", c, ":"
              if (c == object%selected_channel) then
                 write (u, "(1x,A)")  "[selected]"
              else
                 write (u, *)
              end if
              write (u, "(3x,A,9(1x,F9.7))")  "p =", object%p(:,c)
              write (u, "(3x,A,9(1x,F9.7))")  "pb=", object%pb(:,c)
              write (u, "(3x,A,9(1x,F9.7))")  "r =", object%r(:,c)
              write (u, "(3x,A,9(1x,F9.7))")  "rb=", object%rb(:,c)
              write (u, "(3x,A,9(1x,ES13.7))")  "f =", object%f(c)
              write (u, "(3x,A)", advance="no") "m ="
              call object%channel(c)%write (u)
           end do
           write (u, "(3x,A,9(1x,F9.7))")  "x =", object%x
           write (u, "(3x,A,9(1x,F9.7))")  "xb=", object%xb
           if (.not. all (object%bound)) then
              write (u, "(3x,A,9(1x,L1))")  "bound =", object%bound
           end if
        end if
     end if
     call write_separator (u)
     call beam_write (object%beam_t, u, col_verbose = col_verbose)
     if (allocated (object%sf)) then
        do i = 1, size (object%sf)
           associate (sf => object%sf(i))
             call write_separator (u)
             if (allocated (sf%int)) then
                if (allocated (sf%r)) then
                   write (u, "(1x,A)")  "Structure-function parameters:"
                   do c = 1, size (sf%f)
                      write (u, "(1x,A,I0,A)", advance="no")  "Channel #", c, ":"
                      if (c == object%selected_channel) then
                         write (u, "(1x,A)")  "[selected]"
                      else
                         write (u, *)
                      end if
                      write (u, "(3x,A,9(1x,F9.7))")  "r =", sf%r(:,c)
                      write (u, "(3x,A,9(1x,F9.7))")  "rb=", sf%rb(:,c)
                      write (u, "(3x,A,9(1x,ES13.7))")  "f =", sf%f(c)
                      write (u, "(3x,A,9(1x,L1,7x))") "m =", sf%m(c)
                   end do
                   write (u, "(3x,A,9(1x,F9.7))")  "x =", sf%x
                   write (u, "(3x,A,9(1x,F9.7))")  "xb=", sf%xb
                end if
                call sf%int%write(u)
                if (.not. sf%eval%is_empty ()) then
                      call sf%eval%write (u, col_verbose = col_verbose)
                end if
             end if
           end associate
        end do
     end if
   end subroutine sf_chain_instance_write
 
 @ %def sf_chain_instance_write
 @ Initialize.  This creates a copy of the interactions in the
 configuration chain, assumed to be properly initialized.  In the copy,
 we allocate the [[p]] etc.\ arrays.
 
 The brute-force assignment of the [[sf]] component would be
 straightforward, but we provide a more fine-grained copy.
 In any case, the copy is deep as far as allocatables are concerned,
 but for the contained [[interaction_t]] objects the copy is shallow,
 as long as we do not bind defined assignment to the type.  Therefore,
 we have to re-assign the [[interaction_t]] components explicitly, this
 time calling the proper defined assignment.  Furthermore, we allocate
 the parameter arrays for each structure function.
 <<SF base: sf chain instance: TBP>>=
   procedure :: init => sf_chain_instance_init
 <<SF base: procedures>>=
   subroutine sf_chain_instance_init (chain, config, n_channel)
     class(sf_chain_instance_t), intent(out), target :: chain
     type(sf_chain_t), intent(in), target :: config
     integer, intent(in) :: n_channel
     integer :: i, j
     integer :: n_par_tot, n_par, n_strfun
     chain%config => config
     n_strfun = config%n_strfun
     chain%beam_t = config%beam_t
     allocate (chain%out_sf (config%n_in), chain%out_sf_i (config%n_in))
     allocate (chain%out_eval_i (config%n_in))
     chain%out_sf = 0
     chain%out_sf_i = [(i, i = 1, config%n_in)]
     chain%out_eval_i = chain%out_sf_i
     n_par_tot = 0
     if (n_strfun /= 0) then
        allocate (chain%sf (n_strfun))
        do i = 1, n_strfun
           associate (sf => chain%sf(i))
             allocate (sf%int, source=config%sf(i)%int)
             sf%int%interaction_t = config%sf(i)%int%interaction_t
             n_par = size (sf%int%par_index)
             allocate (sf%r (n_par, n_channel));  sf%r = 0
             allocate (sf%rb(n_par, n_channel));  sf%rb= 0
             allocate (sf%f (n_channel));         sf%f = 0
             allocate (sf%m (n_channel));         sf%m = .false.
             allocate (sf%x (n_par));             sf%x = 0
             allocate (sf%xb(n_par));             sf%xb= 0
             n_par_tot = n_par_tot + n_par
           end associate
        end do
        allocate (chain%p (n_par_tot, n_channel));  chain%p = 0
        allocate (chain%pb(n_par_tot, n_channel));  chain%pb= 0
        allocate (chain%r (n_par_tot, n_channel));  chain%r = 0
        allocate (chain%rb(n_par_tot, n_channel));  chain%rb= 0
        allocate (chain%f (n_channel));             chain%f = 0
        allocate (chain%x (n_par_tot));             chain%x = 0
        allocate (chain%xb(n_par_tot));             chain%xb= 0
        call allocate_sf_channels &
             (chain%channel, n_channel=n_channel, n_strfun=n_strfun)
     end if
     allocate (chain%bound (n_par_tot), source = .true.)
     do i = 1, n_strfun
        associate (sf => chain%sf(i))
          if (sf%int%is_generator ()) then
             do j = 1, size (sf%int%par_index)
                chain%bound(sf%int%par_index(j)) = .false.
             end do
          end if
        end associate
     end do
     chain%status = SF_INITIAL
   end subroutine sf_chain_instance_init
 
 @ %def sf_chain_instance_init
 @ Manually select a channel.
 <<SF base: sf chain instance: TBP>>=
   procedure :: select_channel => sf_chain_instance_select_channel
 <<SF base: procedures>>=
   subroutine sf_chain_instance_select_channel (chain, channel)
     class(sf_chain_instance_t), intent(inout) :: chain
     integer, intent(in), optional :: channel
     if (present (channel)) then
        chain%selected_channel = channel
     else
        chain%selected_channel = 0
     end if
   end subroutine sf_chain_instance_select_channel
 
 @ %def sf_chain_instance_select_channel
 @ Copy a channel-mapping object to the structure-function
 chain instance.  We assume that assignment is sufficient, i.e., any
 non-static components of the [[channel]] object are allocatable und
 thus recursively copied.
 
 After the copy, we extract the single-entry mappings and activate them
 for the individual structure functions.  If there is a multi-entry
 mapping, we obtain the corresponding MC parameter indices and set them
 in the copy of the channel object.
 <<SF base: sf chain instance: TBP>>=
   procedure :: set_channel => sf_chain_instance_set_channel
 <<SF base: procedures>>=
   subroutine sf_chain_instance_set_channel (chain, c, channel)
     class(sf_chain_instance_t), intent(inout) :: chain
     integer, intent(in) :: c
     type(sf_channel_t), intent(in) :: channel
     integer :: i, j, k
     if (chain%status >= SF_INITIAL) then
        chain%channel(c) = channel
        j = 0
        do i = 1, chain%config%n_strfun
           associate (sf => chain%sf(i))
             sf%m(c) = channel%is_single_mapping (i)
             if (channel%is_multi_mapping (i)) then
                do k = 1, size (sf%int%beam_index)
                   j = j + 1
                   call chain%channel(c)%set_par_index &
                        (j, sf%int%par_index(k))
                end do
             end if
           end associate
        end do
        if (j /= chain%channel(c)%get_multi_mapping_n_par ()) then
           print *, "index last filled    = ", j
           print *, "number of parameters = ", &
                chain%channel(c)%get_multi_mapping_n_par ()
           call msg_bug ("Structure-function setup: mapping index mismatch")
        end if
        chain%status = SF_INITIAL
     end if
   end subroutine sf_chain_instance_set_channel
 
 @ %def sf_chain_instance_set_channel
 @ Link the interactions in the chain.  First, link the beam instance
 to its template in the configuration chain, which should have the
 appropriate momenta fixed.
 
 Then, we follow the chain via the
 arrays [[out_sf]] and [[out_sf_i]].  The arrays are (up to)
 two-dimensional, the entries correspond to the beam particle(s).
 For each beam, the entry [[out_sf]] points to the last interaction
 that affected this beam, and [[out_sf_i]] is the
 out-particle index within that interaction.  For the initial beam,
 [[out_sf]] is zero by definition.
 
 For each entry in the chain, we scan the affected beams (one or two).
 We look for [[out_sf]] and link the out-particle there to the
 corresponding in-particle in the current interaction.  Then, we update
 the entry in [[out_sf]] and [[out_sf_i]] to point to the current
 interaction.
 <<SF base: sf chain instance: TBP>>=
   procedure :: link_interactions => sf_chain_instance_link_interactions
 <<SF base: procedures>>=
   subroutine sf_chain_instance_link_interactions (chain)
     class(sf_chain_instance_t), intent(inout), target :: chain
     type(interaction_t), pointer :: int
     integer :: i, j, b
     if (chain%status >= SF_INITIAL) then
        do b = 1, chain%config%n_in
           int => beam_get_int_ptr (chain%beam_t)
           call interaction_set_source_link (int, b, &
                chain%config%beam_t, b)
        end do
        if (allocated (chain%sf)) then
           do i = 1, size (chain%sf)
              associate (sf_int => chain%sf(i)%int)
                do j = 1, size (sf_int%beam_index)
                   b = sf_int%beam_index(j)
                   call link (sf_int%interaction_t, b, sf_int%incoming(j))
                   chain%out_sf(b) = i
                   chain%out_sf_i(b) = sf_int%outgoing(j)
                end do
              end associate
           end do
        end if
        chain%status = SF_DONE_LINKS
     end if
   contains
     subroutine link (int, b, in_index)
       type(interaction_t), intent(inout) :: int
       integer, intent(in) :: b, in_index
       integer :: i
       i = chain%out_sf(b)
       select case (i)
       case (0)
          call interaction_set_source_link (int, in_index, &
               chain%beam_t, chain%out_sf_i(b))
       case default
          call int%set_source_link (in_index, &
               chain%sf(i)%int, chain%out_sf_i(b))
       end select
     end subroutine link
   end subroutine sf_chain_instance_link_interactions
 
 @ %def sf_chain_instance_link_interactions
 @ Exchange the quantum-number masks between the interactions in the
 chain, so we can combine redundant entries and detect any obvious mismatch.
 
 We proceed first in the forward direction and then backwards again.
 
 After this is finished, we finalize initialization by calling the
 [[setup_constants]] method, which prepares constant data that depend on the
 matrix element structure.
 <<SF base: sf chain instance: TBP>>=
   procedure :: exchange_mask => sf_chain_exchange_mask
 <<SF base: procedures>>=
   subroutine sf_chain_exchange_mask (chain)
     class(sf_chain_instance_t), intent(inout), target :: chain
     type(interaction_t), pointer :: int
     type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
     integer :: i
     if (chain%status >= SF_DONE_LINKS) then
        if (allocated (chain%sf)) then
           int => beam_get_int_ptr (chain%beam_t)
           allocate (mask (int%get_n_out ()))
           mask = int%get_mask ()
           if (size (chain%sf) /= 0) then
              do i = 1, size (chain%sf) - 1
                 call interaction_exchange_mask (chain%sf(i)%int%interaction_t)
              end do
              do i = size (chain%sf), 1, -1
                 call interaction_exchange_mask (chain%sf(i)%int%interaction_t)
              end do
              if (any (mask .neqv. int%get_mask ())) then
                 chain%status = SF_FAILED_MASK
                 return
              end if
              do i = 1, size (chain%sf)
                 call chain%sf(i)%int%setup_constants ()
              end do
           end if
        end if
        chain%status = SF_DONE_MASK
     end if
   end subroutine sf_chain_exchange_mask
 
 @ %def sf_chain_exchange_mask
 @ Initialize the evaluators that connect the interactions in the
 chain.
 <<SF base: sf chain instance: TBP>>=
   procedure :: init_evaluators => sf_chain_instance_init_evaluators
 <<SF base: procedures>>=
   subroutine sf_chain_instance_init_evaluators (chain, extended_sf)
     class(sf_chain_instance_t), intent(inout), target :: chain
     logical, intent(in), optional :: extended_sf
     type(interaction_t), pointer :: int
     type(quantum_numbers_mask_t) :: mask
     integer :: i
     logical :: yorn
     yorn = .false.; if (present (extended_sf)) yorn = extended_sf
     if (chain%status >= SF_DONE_MASK) then
        if (allocated (chain%sf)) then
           if (size (chain%sf) /= 0) then
              mask = quantum_numbers_mask (.false., .false., .true.)
              int => beam_get_int_ptr (chain%beam_t)
              do i = 1, size (chain%sf)
                 associate (sf => chain%sf(i))
                    if (yorn) then
                       if (int%get_n_sub () == 0) then
                          call int%declare_subtraction (n_beams_rescaled)
                       end if
                       if (sf%int%interaction_t%get_n_sub () == 0) then
                          call sf%int%interaction_t%declare_subtraction (n_beams_rescaled)
                       end if
                    end if
                    call sf%eval%init_product (int, sf%int%interaction_t, mask,&
                         & ignore_sub_for_qn = .true.)
                    if (sf%eval%is_empty ()) then
                       chain%status = SF_FAILED_CONNECTIONS
                       return
                    end if
                    int => sf%eval%interaction_t
                 end associate
              end do
              call find_outgoing_particles ()
           end if
        else if (chain%out_eval == 0) then
           int => beam_get_int_ptr (chain%beam_t)
           call int%tag_hard_process ()
        end if
        chain%status = SF_DONE_CONNECTIONS
     end if
   contains
   <<SF base: init evaluators: find outgoing particles>>
   end subroutine sf_chain_instance_init_evaluators
 
 @ %def sf_chain_instance_init_evaluators
 @ For debug purposes
 <<SF base: sf chain instance: TBP>>=
   procedure :: write_interaction => sf_chain_instance_write_interaction
 <<SF base: procedures>>=
   subroutine sf_chain_instance_write_interaction (chain, i_sf, i_int, unit)
     class(sf_chain_instance_t), intent(in) :: chain
     integer, intent(in) :: i_sf, i_int
     integer, intent(in) :: unit
     class(interaction_t), pointer :: int_in1 => null ()
     class(interaction_t), pointer :: int_in2 => null ()
     integer :: u
     u = given_output_unit (unit); if (u < 0) return
     if (chain%status >= SF_DONE_MASK) then
        if (allocated (chain%sf)) then
           int_in1 => evaluator_get_int_in_ptr (chain%sf(i_sf)%eval, 1)
           int_in2 => evaluator_get_int_in_ptr (chain%sf(i_sf)%eval, 2)
           if (int_in1%get_tag () == i_int) then
              call int_in1%basic_write (u)
           else if (int_in2%get_tag () == i_int) then
              call int_in2%basic_write (u)
           else
              write (u, "(A,1x,I0,1x,A,1x,I0)") 'No tag of sf', i_sf, 'matches' , i_int
           end if
        else
           write (u, "(A)") 'No sf_chain allocated!'
        end if
     else
        write (u, "(A)") 'sf_chain not ready!'
     end if
   end subroutine sf_chain_instance_write_interaction
 
 @ %def sf_chain_instance_write_interaction
 @ This is an internal subroutine of the previous one: After evaluators
 are set, trace the outgoing particles to the last evaluator.  We only
 need the first channel, all channels are equivalent for this purpose.
 
 For each beam, the outgoing particle is located by [[out_sf]] (the
 structure-function object where it originates) and [[out_sf_i]] (the
 index within that object).  This particle is referenced by the
 corresponding evaluator, which in turn is referenced by the next
 evaluator, until we are at the end of the chain.  We can trace back
 references by [[interaction_find_link]].  Knowing that [[out_eval]] is
 the index of the last evaluator, we thus determine [[out_eval_i]], the
 index of the outgoing particle within that evaluator.
 <<SF base: init evaluators: find outgoing particles>>=
   subroutine find_outgoing_particles ()
     type(interaction_t), pointer :: int, int_next
     integer :: i, j, out_sf, out_i
     chain%out_eval = size (chain%sf)
     do j = 1, size (chain%out_eval_i)
        out_sf = chain%out_sf(j)
        out_i = chain%out_sf_i(j)
        if (out_sf == 0) then
           int => beam_get_int_ptr (chain%beam_t)
           out_sf = 1
        else
           int => chain%sf(out_sf)%int%interaction_t
        end if
        do i = out_sf, chain%out_eval
           int_next => chain%sf(i)%eval%interaction_t
           out_i = interaction_find_link (int_next, int, out_i)
           int => int_next
        end do
        chain%out_eval_i(j) = out_i
     end do
     call int%tag_hard_process (chain%out_eval_i)
   end subroutine find_outgoing_particles
 
 @ %def find_outgoing_particles
 @ Compute the kinematics in the chain instance.  We can assume that
 the seed momenta are set in the configuration beams.  Scanning the
 chain, we first transfer the incoming momenta.  Then, the use up the MC input
 parameter array [[p]] to compute the radiated and outgoing momenta.
 
 In the multi-channel case, [[c_sel]] is the channel which we use for
 computing the kinematics and the [[x]] values.  In the other channels,
 we invert the kinematics in order to recover the corresponding rows in
 the [[r]] array, and the Jacobian [[f]].
 
 We first apply any global mapping to transform the input [[p]] into
 the array [[r]].  This is then given to the structure functions which
 compute the final array [[x]] and Jacobian factors [[f]], which we
 multiply to obtain the overall Jacobian.
 <<SF base: sf chain instance: TBP>>=
   procedure :: compute_kinematics => sf_chain_instance_compute_kinematics
 <<SF base: procedures>>=
   subroutine sf_chain_instance_compute_kinematics (chain, c_sel, p_in)
     class(sf_chain_instance_t), intent(inout), target :: chain
     integer, intent(in) :: c_sel
     real(default), dimension(:), intent(in) :: p_in
     type(interaction_t), pointer :: int
     real(default) :: f_mapping
     integer :: i, j, c
     if (chain%status >= SF_DONE_CONNECTIONS) then
        call chain%select_channel (c_sel)
        int => beam_get_int_ptr (chain%beam_t)
        call int%receive_momenta ()
        if (allocated (chain%sf)) then
           if (size (chain%sf) /= 0) then
              forall (i = 1:size (chain%sf))  chain%sf(i)%int%status = SF_INITIAL
              chain%p (:,c_sel) = unpack (p_in, chain%bound, 0._default)
              chain%pb(:,c_sel) = 1 - chain%p(:,c_sel)
              chain%f = 1
              chain%x_free = 1
              do i = 1, size (chain%sf)
                 associate (sf => chain%sf(i))
                   call sf%int%generate_free (sf%r(:,c_sel), sf%rb(:,c_sel), &
                        chain%x_free)
                   do j = 1, size (sf%x)
                      if (.not. chain%bound(sf%int%par_index(j))) then
                         chain%p (sf%int%par_index(j),c_sel) = sf%r (j,c_sel)
                         chain%pb(sf%int%par_index(j),c_sel) = sf%rb(j,c_sel)
                      end if
                   end do
                 end associate
              end do
              if (allocated (chain%channel(c_sel)%multi_mapping)) then
                 call chain%channel(c_sel)%multi_mapping%compute &
                      (chain%r(:,c_sel), chain%rb(:,c_sel), &
                       f_mapping, &
                       chain%p(:,c_sel), chain%pb(:,c_sel), &
                       chain%x_free)
                 chain%f(c_sel) = f_mapping
              else
                 chain%r (:,c_sel) = chain%p (:,c_sel)
                 chain%rb(:,c_sel) = chain%pb(:,c_sel)
                 chain%f(c_sel) = 1
              end if
              do i = 1, size (chain%sf)
                 associate (sf => chain%sf(i))
                   call sf%int%seed_kinematics ()
                   do j = 1, size (sf%x)
                      sf%r (j,c_sel) = chain%r (sf%int%par_index(j),c_sel)
                      sf%rb(j,c_sel) = chain%rb(sf%int%par_index(j),c_sel)
                   end do
                   call sf%int%complete_kinematics &
                        (sf%x, sf%xb, sf%f(c_sel), sf%r(:,c_sel), sf%rb(:,c_sel), &
                         sf%m(c_sel))
                   do j = 1, size (sf%x)
                      chain%x(sf%int%par_index(j)) = sf%x(j)
                      chain%xb(sf%int%par_index(j)) = sf%xb(j)
                   end do
                   if (sf%int%status <= SF_FAILED_KINEMATICS) then
                      chain%status = SF_FAILED_KINEMATICS
                      return
                   end if
                   do c = 1, size (sf%f)
                      if (c /= c_sel) then
                         call sf%int%inverse_kinematics &
                              (sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c))
                         do j = 1, size (sf%x)
                            chain%r (sf%int%par_index(j),c) = sf%r (j,c)
                            chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
                         end do
                      end if
                      chain%f(c) = chain%f(c) * sf%f(c)
                   end do
                   if (.not. sf%eval%is_empty ()) then
                      call sf%eval%receive_momenta ()
                   end if
                 end associate
              end do
              do c = 1, size (chain%f)
                 if (c /= c_sel) then
                    if (allocated (chain%channel(c)%multi_mapping)) then
                       call chain%channel(c)%multi_mapping%inverse &
                            (chain%r(:,c), chain%rb(:,c), &
                             f_mapping, &
                             chain%p(:,c), chain%pb(:,c), &
                             chain%x_free)
                       chain%f(c) = chain%f(c) * f_mapping
                    else
                       chain%p (:,c) = chain%r (:,c)
                       chain%pb(:,c) = chain%rb(:,c)
                    end if
                 end if
              end do
           end if
        end if
        chain%status = SF_DONE_KINEMATICS
     end if
   end subroutine sf_chain_instance_compute_kinematics
 
 @ %def sf_chain_instance_compute_kinematics
 @ This is a variant of the previous procedure.  We know the $x$ parameters and
 reconstruct the momenta and the MC input parameters [[p]].  We do not need to
 select a channel.
 
 Note: this is probably redundant, since the method we actually want
 starts from the momenta, recovers all $x$ parameters, and then
 inverts mappings.  See below [[recover_kinematics]].
 <<SF base: sf chain instance: TBP>>=
   procedure :: inverse_kinematics => sf_chain_instance_inverse_kinematics
 <<SF base: procedures>>=
   subroutine sf_chain_instance_inverse_kinematics (chain, x, xb)
     class(sf_chain_instance_t), intent(inout), target :: chain
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     type(interaction_t), pointer :: int
     real(default) :: f_mapping
     integer :: i, j, c
     if (chain%status >= SF_DONE_CONNECTIONS) then
        call chain%select_channel ()
        int => beam_get_int_ptr (chain%beam_t)
        call int%receive_momenta ()
        if (allocated (chain%sf)) then
           chain%f = 1
           if (size (chain%sf) /= 0) then
              forall (i = 1:size (chain%sf))  chain%sf(i)%int%status = SF_INITIAL
              chain%x = x
              chain%xb= xb
              do i = 1, size (chain%sf)
                 associate (sf => chain%sf(i))
                   call sf%int%seed_kinematics ()
                   do j = 1, size (sf%x)
                      sf%x(j)  = chain%x(sf%int%par_index(j))
                      sf%xb(j) = chain%xb(sf%int%par_index(j))
                   end do
                   do c = 1, size (sf%f)
                      call sf%int%inverse_kinematics &
                           (sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c), &
                           set_momenta = c==1)
                      chain%f(c) = chain%f(c) * sf%f(c)
                      do j = 1, size (sf%x)
                         chain%r (sf%int%par_index(j),c) = sf%r (j,c)
                         chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
                      end do
                   end do
                   if (.not. sf%eval%is_empty ()) then
                      call sf%eval%receive_momenta ()
                   end if
                 end associate
              end do
              do c = 1, size (chain%f)
                 if (allocated (chain%channel(c)%multi_mapping)) then
                    call chain%channel(c)%multi_mapping%inverse &
                         (chain%r(:,c), chain%rb(:,c), &
                         f_mapping, &
                         chain%p(:,c), chain%pb(:,c), &
                         chain%x_free)
                    chain%f(c) = chain%f(c) * f_mapping
                 else
                    chain%p (:,c) = chain%r (:,c)
                    chain%pb(:,c) = chain%rb(:,c)
                 end if
              end do
           end if
        end if
        chain%status = SF_DONE_KINEMATICS
     end if
   end subroutine sf_chain_instance_inverse_kinematics
 
 @ %def sf_chain_instance_inverse_kinematics
 @ Recover the kinematics: assuming that the last evaluator has
 been filled with a valid set of momenta, we travel the momentum links
 backwards and fill the preceding evaluators and, as a side effect,
 interactions.  We stop at the beam interaction.
 
 After all momenta are set, apply the [[inverse_kinematics]] procedure
 above, suitably modified, to recover the $x$ and $p$ parameters and
 the Jacobian factors.
 
 The [[c_sel]] (channel) argument is just used to mark a selected
 channel for the records, otherwise the recovery procedure is
 independent of this.
 <<SF base: sf chain instance: TBP>>=
   procedure :: recover_kinematics => sf_chain_instance_recover_kinematics
 <<SF base: procedures>>=
   subroutine sf_chain_instance_recover_kinematics (chain, c_sel)
     class(sf_chain_instance_t), intent(inout), target :: chain
     integer, intent(in) :: c_sel
     real(default) :: f_mapping
     integer :: i, j, c
     if (chain%status >= SF_DONE_CONNECTIONS) then
        call chain%select_channel (c_sel)
        if (allocated (chain%sf)) then
           do i = size (chain%sf), 1, -1
              associate (sf => chain%sf(i))
                if (.not. sf%eval%is_empty ()) then
                   call interaction_send_momenta (sf%eval%interaction_t)
                end if
              end associate
           end do
           chain%f = 1
           if (size (chain%sf) /= 0) then
              forall (i = 1:size (chain%sf))  chain%sf(i)%int%status = SF_INITIAL
              chain%x_free = 1
              do i = 1, size (chain%sf)
                 associate (sf => chain%sf(i))
                   call sf%int%seed_kinematics ()
                   call sf%int%recover_x (sf%x, sf%xb, chain%x_free)
                   do j = 1, size (sf%x)
                      chain%x(sf%int%par_index(j))  = sf%x(j)
                      chain%xb(sf%int%par_index(j)) = sf%xb(j)
                   end do
                   do c = 1, size (sf%f)
                      call sf%int%inverse_kinematics &
                           (sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c), &
                           set_momenta = .false.)
                      chain%f(c) = chain%f(c) * sf%f(c)
                      do j = 1, size (sf%x)
                         chain%r (sf%int%par_index(j),c) = sf%r (j,c)
                         chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
                      end do
                   end do
                 end associate
              end do
              do c = 1, size (chain%f)
                 if (allocated (chain%channel(c)%multi_mapping)) then
                    call chain%channel(c)%multi_mapping%inverse &
                         (chain%r(:,c), chain%rb(:,c), &
                         f_mapping, &
                         chain%p(:,c), chain%pb(:,c), &
                         chain%x_free)
                    chain%f(c) = chain%f(c) * f_mapping
                 else
                    chain%p (:,c) = chain%r (:,c)
                    chain%pb(:,c) = chain%rb(:,c)
                 end if
              end do
           end if
        end if
        chain%status = SF_DONE_KINEMATICS
     end if
   end subroutine sf_chain_instance_recover_kinematics
 
 @ %def sf_chain_instance_recover_kinematics
 @ Return the initial beam momenta to their source, thus completing
 kinematics recovery.  Obviously, this works as a side effect.
 <<SF base: sf chain instance: TBP>>=
   procedure :: return_beam_momenta => sf_chain_instance_return_beam_momenta
 <<SF base: procedures>>=
   subroutine sf_chain_instance_return_beam_momenta (chain)
     class(sf_chain_instance_t), intent(in), target :: chain
     type(interaction_t), pointer :: int
     if (chain%status >= SF_DONE_KINEMATICS) then
        int => beam_get_int_ptr (chain%beam_t)
        call interaction_send_momenta (int)
     end if
   end subroutine sf_chain_instance_return_beam_momenta
 
 @ %def sf_chain_instance_return_beam_momenta
 @ Evaluate all interactions in the chain and the product evaluators.
 We provide a [[scale]] argument that is given to all structure
 functions in the chain.
 
 Hadronic NLO calculations involve rescaled fractions of the original beam
 momentum. In particular, we have to handle the following cases:
 \begin{itemize}
   \item normal evaluation (where [[i_sub = 0]]) for all terms except the
     real non-subtracted,
   \item rescaled momentum fraction for both beams in the case of the
     real non-subtracted term ([[i_sub = 0]]),
   \item and rescaled momentum fraction for one of both beams in the case of the
     subtraction and DGLAP component ([[i_sub = 1,2]]).
 \end{itemize}
 For the collinear final or intial state counter terms, we apply a rescaling to
 one beam, and keep the other beam as is. We redo it then vice versa having now two subtractions.
 <<SF base: sf chain instance: TBP>>=
   procedure :: evaluate => sf_chain_instance_evaluate
 <<SF base: procedures>>=
   subroutine sf_chain_instance_evaluate (chain, scale, sf_rescale)
     class(sf_chain_instance_t), intent(inout), target :: chain
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(inout), optional :: sf_rescale
     type(interaction_t), pointer :: out_int
     real(default) :: sf_sum
     integer :: i_beam, i_sub, n_sub
     logical :: rescale
     n_sub = 0
     rescale = .false.; if (present (sf_rescale)) rescale = .true.
     if (rescale) then
        n_sub = chain%get_n_sub ()
     end if
     if (chain%status >= SF_DONE_KINEMATICS) then
        if (allocated (chain%sf)) then
           if (size (chain%sf) /= 0) then
              do i_beam = 1, size (chain%sf)
                 associate (sf => chain%sf(i_beam))
                    if (rescale) then
                       call sf_rescale%set_i_beam (i_beam)
                       do i_sub = 0, n_sub
                          select case (i_sub)
                          case (0)
                             if (n_sub == 0) then
                                call sf%int%apply (scale, sf_rescale, i_sub = i_sub)
                             else
                                call sf%int%apply (scale, i_sub = i_sub)
                             end if
                          case default
                             if (i_beam == i_sub) then
                                call sf%int%apply (scale, sf_rescale, i_sub = i_sub)
                             else
                                call sf%int%apply (scale, i_sub = i_sub)
                             end if
                          end select
                       end do
                    else
                       call sf%int%apply (scale, i_sub = n_sub)
                    end if
                    if (sf%int%status <= SF_FAILED_EVALUATION) then
                       chain%status = SF_FAILED_EVALUATION
                       return
                    end if
                    if (.not. sf%eval%is_empty ())  call sf%eval%evaluate ()
                 end associate
              end do
              out_int => chain%get_out_int_ptr ()
              sf_sum = real (out_int%sum ())
              call chain%config%trace &
                   (chain%selected_channel, chain%p, chain%x, chain%f, sf_sum)
           end if
        end if
        chain%status = SF_EVALUATED
     end if
   end subroutine sf_chain_instance_evaluate
 
 @ %def sf_chain_instance_evaluate
 @
 \subsection{Access to the chain instance}
 Transfer the outgoing momenta to the array [[p]].  We assume that
 array sizes match.
 <<SF base: sf chain instance: TBP>>=
   procedure :: get_out_momenta => sf_chain_instance_get_out_momenta
 <<SF base: procedures>>=
   subroutine sf_chain_instance_get_out_momenta (chain, p)
     class(sf_chain_instance_t), intent(in), target :: chain
     type(vector4_t), dimension(:), intent(out) :: p
     type(interaction_t), pointer :: int
     integer :: i, j
     if (chain%status >= SF_DONE_KINEMATICS) then
        do j = 1, size (chain%out_sf)
           i = chain%out_sf(j)
           select case (i)
           case (0)
              int => beam_get_int_ptr (chain%beam_t)
           case default
              int => chain%sf(i)%int%interaction_t
           end select
           p(j) = int%get_momentum (chain%out_sf_i(j))
        end do
     end if
   end subroutine sf_chain_instance_get_out_momenta
 
 @ %def sf_chain_instance_get_out_momenta
 @ Return a pointer to the last evaluator in the chain (to the interaction).
 <<SF base: sf chain instance: TBP>>=
   procedure :: get_out_int_ptr => sf_chain_instance_get_out_int_ptr
 <<SF base: procedures>>=
   function sf_chain_instance_get_out_int_ptr (chain) result (int)
     class(sf_chain_instance_t), intent(in), target :: chain
     type(interaction_t), pointer :: int
     if (chain%out_eval == 0) then
        int => beam_get_int_ptr (chain%beam_t)
     else
        int => chain%sf(chain%out_eval)%eval%interaction_t
     end if
   end function sf_chain_instance_get_out_int_ptr
 
 @ %def sf_chain_instance_get_out_int_ptr
 @ Return the index of the [[j]]-th outgoing particle, within the last
 evaluator.
 <<SF base: sf chain instance: TBP>>=
   procedure :: get_out_i => sf_chain_instance_get_out_i
 <<SF base: procedures>>=
   function sf_chain_instance_get_out_i (chain, j) result (i)
     class(sf_chain_instance_t), intent(in) :: chain
     integer, intent(in) :: j
     integer :: i
     i = chain%out_eval_i(j)
   end function sf_chain_instance_get_out_i
 
 @ %def sf_chain_instance_get_out_i
 @ Return the mask for the outgoing particle(s), within the last evaluator.
 <<SF base: sf chain instance: TBP>>=
   procedure :: get_out_mask => sf_chain_instance_get_out_mask
 <<SF base: procedures>>=
   function sf_chain_instance_get_out_mask (chain) result (mask)
     class(sf_chain_instance_t), intent(in), target :: chain
     type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
     type(interaction_t), pointer :: int
     allocate (mask (chain%config%n_in))
     int => chain%get_out_int_ptr ()
     mask = int%get_mask (chain%out_eval_i)
   end function sf_chain_instance_get_out_mask
 
 @ %def sf_chain_instance_get_out_mask
 @ Return the array of MC input parameters that corresponds to channel [[c]].
 This is the [[p]] array, the parameters before all mappings.
 
 The [[p]] array may be deallocated.  This should correspond to a
 zero-size [[r]] argument, so nothing to do then.
 <<SF base: sf chain instance: TBP>>=
   procedure :: get_mcpar => sf_chain_instance_get_mcpar
 <<SF base: procedures>>=
   subroutine sf_chain_instance_get_mcpar (chain, c, r)
     class(sf_chain_instance_t), intent(in) :: chain
     integer, intent(in) :: c
     real(default), dimension(:), intent(out) :: r
     if (allocated (chain%p))  r = pack (chain%p(:,c), chain%bound)
   end subroutine sf_chain_instance_get_mcpar
 
 @ %def sf_chain_instance_get_mcpar
 @ Return the Jacobian factor that corresponds to channel [[c]].
 <<SF base: sf chain instance: TBP>>=
   procedure :: get_f => sf_chain_instance_get_f
 <<SF base: procedures>>=
   function sf_chain_instance_get_f (chain, c) result (f)
     class(sf_chain_instance_t), intent(in) :: chain
     integer, intent(in) :: c
     real(default) :: f
     if (allocated (chain%f)) then
        f = chain%f(c)
     else
        f = 1
     end if
   end function sf_chain_instance_get_f
 
 @ %def sf_chain_instance_get_f
 @ Return the evaluation status.
 <<SF base: sf chain instance: TBP>>=
   procedure :: get_status => sf_chain_instance_get_status
 <<SF base: procedures>>=
   function sf_chain_instance_get_status (chain) result (status)
     class(sf_chain_instance_t), intent(in) :: chain
     integer :: status
     status = chain%status
   end function sf_chain_instance_get_status
 
 @ %def sf_chain_instance_get_status
 @
 <<SF base: sf chain instance: TBP>>=
   procedure :: get_matrix_elements => sf_chain_instance_get_matrix_elements
 <<SF base: procedures>>=
   subroutine sf_chain_instance_get_matrix_elements (chain, i, ff)
      class(sf_chain_instance_t), intent(in) :: chain
      integer, intent(in) :: i
      real(default), intent(out), dimension(:), allocatable :: ff
 
      associate (sf => chain%sf(i))
         ff = real (sf%int%get_matrix_element ())
      end associate
   end subroutine sf_chain_instance_get_matrix_elements
 
 @ %def sf_chain_instance_get_matrix_elements
 @
 <<SF base: sf chain instance: TBP>>=
   procedure :: get_beam_int_ptr => sf_chain_instance_get_beam_int_ptr
 <<SF base: procedures>>=
   function sf_chain_instance_get_beam_int_ptr (chain) result (int)
     type(interaction_t), pointer :: int
     class(sf_chain_instance_t), intent(in), target :: chain
     int => beam_get_int_ptr (chain%beam_t)
   end function sf_chain_instance_get_beam_int_ptr
 
 @ %def sf_chain_instance_get_beam_ptr
 @
 <<SF base: sf chain instance: TBP>>=
   procedure :: get_n_sub => sf_chain_instance_get_n_sub
 <<SF base: procedures>>=
   integer function sf_chain_instance_get_n_sub (chain) result (n_sub)
     type(interaction_t), pointer :: int
     class(sf_chain_instance_t), intent(in), target :: chain
     int => beam_get_int_ptr (chain%beam_t)
     n_sub = int%get_n_sub ()
   end function sf_chain_instance_get_n_sub
 
 @ %def sf_chain_instance_get_n_sub
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_base_ut.f90]]>>=
 <<File header>>
 
 module sf_base_ut
   use unit_tests
   use sf_base_uti
 
 <<Standard module head>>
 
 <<SF base: public test auxiliary>>
 
 <<SF base: public test>>
 
 contains
 
 <<SF base: test driver>>
 
 end module sf_base_ut
 @ %def sf_base_ut
 @
 <<[[sf_base_uti.f90]]>>=
 <<File header>>
 
 module sf_base_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_defs, only: FMT_19
   use format_utils, only: write_separator
   use diagnostics
   use lorentz
   use pdg_arrays
   use flavors
   use colors
   use helicities
   use quantum_numbers
   use state_matrices, only: FM_IGNORE_HELICITY
   use interactions
   use particles
   use model_data
   use beams
   use sf_aux
   use sf_mappings
 
   use sf_base
 
 <<Standard module head>>
 
 <<SF base: test declarations>>
 
 <<SF base: public test auxiliary>>
 
 <<SF base: test types>>
 
 contains
 
 <<SF base: tests>>
 
 <<SF base: test auxiliary>>
 
 end module sf_base_uti
 @ %def sf_base_ut
 @ API: driver for the unit tests below.
 <<SF base: public test>>=
   public :: sf_base_test
 <<SF base: test driver>>=
   subroutine sf_base_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF base: execute tests>>
   end subroutine sf_base_test
 
 @ %def sf_base_test
 @
 \subsection{Test implementation: structure function}
 This is a template for the actual structure-function implementation
 which will be defined in separate modules.
 
 \subsubsection{Configuration data}
 The test structure function uses the [[Test]] model.  It describes a
 scalar within an arbitrary initial particle, which is given in the
 initialization.  The radiated particle is also a scalar, the same one,
 but we set its mass artificially to zero.
 <<SF base: public test auxiliary>>=
   public :: sf_test_data_t
 <<SF base: test types>>=
   type, extends (sf_data_t) :: sf_test_data_t
      class(model_data_t), pointer :: model => null ()
      integer :: mode = 0
      type(flavor_t) :: flv_in
      type(flavor_t) :: flv_out
      type(flavor_t) :: flv_rad
      real(default) :: m = 0
      logical :: collinear = .true.
      real(default), dimension(:), allocatable :: qbounds
    contains
    <<SF base: sf test data: TBP>>
   end type sf_test_data_t
 
 @ %def sf_test_data_t
 @ Output.
 <<SF base: sf test data: TBP>>=
   procedure :: write => sf_test_data_write
 <<SF base: test auxiliary>>=
   subroutine sf_test_data_write (data, unit, verbose)
     class(sf_test_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "SF test data:"
     write (u, "(3x,A,A)") "model     = ", char (data%model%get_name ())
     write (u, "(3x,A)", advance="no") "incoming  = "
     call data%flv_in%write (u);  write (u, *)
     write (u, "(3x,A)", advance="no") "outgoing  = "
     call data%flv_out%write (u);  write (u, *)
     write (u, "(3x,A)", advance="no") "radiated  = "
     call data%flv_rad%write (u);  write (u, *)
     write (u, "(3x,A," // FMT_19 // ")")  "mass      = ", data%m
     write (u, "(3x,A,L1)")  "collinear = ", data%collinear
     if (.not. data%collinear .and. allocated (data%qbounds)) then
        write (u, "(3x,A," // FMT_19 // ")")  "qmin      = ", data%qbounds(1)
        write (u, "(3x,A," // FMT_19 // ")")  "qmax      = ", data%qbounds(2)
     end if
   end subroutine sf_test_data_write
 
 @ %def sf_test_data_write
 @ Initialization.
 <<SF base: sf test data: TBP>>=
   procedure :: init => sf_test_data_init
 <<SF base: test auxiliary>>=
   subroutine sf_test_data_init (data, model, pdg_in, collinear, qbounds, mode)
     class(sf_test_data_t), intent(out) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), intent(in) :: pdg_in
     logical, intent(in), optional :: collinear
     real(default), dimension(2), intent(in), optional :: qbounds
     integer, intent(in), optional :: mode
     data%model => model
     if (present (mode))  data%mode = mode
     if (pdg_array_get (pdg_in, 1) /= 25) then
        call msg_fatal ("Test spectrum function: input flavor must be 's'")
     end if
     call data%flv_in%init (25, model)
     data%m = data%flv_in%get_mass ()
     if (present (collinear))  data%collinear = collinear
     call data%flv_out%init (25, model)
     call data%flv_rad%init (25, model)
     if (present (qbounds)) then
        allocate (data%qbounds (2))
        data%qbounds = qbounds
     end if
   end subroutine sf_test_data_init
 
 @ %def sf_test_data_init
 @ Return the number of parameters: 1 if only consider collinear
 splitting, 3 otherwise.
 <<SF base: sf test data: TBP>>=
   procedure :: get_n_par => sf_test_data_get_n_par
 <<SF base: test auxiliary>>=
   function sf_test_data_get_n_par (data) result (n)
     class(sf_test_data_t), intent(in) :: data
     integer :: n
     if (data%collinear) then
        n = 1
     else
        n = 3
     end if
   end function sf_test_data_get_n_par
 
 @ %def sf_test_data_get_n_par
 @ Return the outgoing particle PDG code: 25
 <<SF base: sf test data: TBP>>=
   procedure :: get_pdg_out => sf_test_data_get_pdg_out
 <<SF base: test auxiliary>>=
   subroutine sf_test_data_get_pdg_out (data, pdg_out)
     class(sf_test_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     pdg_out(1) = 25
   end subroutine sf_test_data_get_pdg_out
 
 @ %def sf_test_data_get_pdg_out
 @ Allocate the matching interaction.
 <<SF base: sf test data: TBP>>=
   procedure :: allocate_sf_int => sf_test_data_allocate_sf_int
 <<SF base: test auxiliary>>=
   subroutine sf_test_data_allocate_sf_int (data, sf_int)
     class(sf_test_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     if (allocated (sf_int)) deallocate (sf_int)
     allocate (sf_test_t :: sf_int)
   end subroutine sf_test_data_allocate_sf_int
 
 @ %def sf_test_data_allocate_sf_int
 @
 \subsubsection{Interaction}
 <<SF base: test types>>=
   type, extends (sf_int_t) :: sf_test_t
      type(sf_test_data_t), pointer :: data => null ()
      real(default) :: x = 0
    contains
    <<SF base: sf test int: TBP>>
   end type sf_test_t
 
 @ %def sf_test_t
 @ Type string: constant
 <<SF base: sf test int: TBP>>=
   procedure :: type_string => sf_test_type_string
 <<SF base: test auxiliary>>=
   function sf_test_type_string (object) result (string)
     class(sf_test_t), intent(in) :: object
     type(string_t) :: string
     string = "Test"
   end function sf_test_type_string
 
 @ %def sf_test_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF base: sf test int: TBP>>=
   procedure :: write => sf_test_write
 <<SF base: test auxiliary>>=
   subroutine sf_test_write (object, unit, testflag)
     class(sf_test_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "SF test data: [undefined]"
     end if
   end subroutine sf_test_write
 
 @ %def sf_test_write
 @ Initialize.  We know that [[data]] will be of concrete type
 [[sf_test_data_t]], but we have to cast this explicitly.
 
 For this implementation, we set the incoming and outgoing masses equal
 to the physical particle mass, but keep the radiated mass zero.
 
 Optionally, we can provide minimum and maximum values for the momentum
 transfer.
 <<SF base: sf test int: TBP>>=
   procedure :: init => sf_test_init
 <<SF base: test auxiliary>>=
   subroutine sf_test_init (sf_int, data)
     class(sf_test_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     type(quantum_numbers_mask_t), dimension(3) :: mask
     type(helicity_t) :: hel0
     type(color_t) :: col0
     type(quantum_numbers_t), dimension(3) :: qn
     mask = quantum_numbers_mask (.false., .false., .false.)
     select type (data)
     type is (sf_test_data_t)
        if (allocated (data%qbounds)) then
           call sf_int%base_init (mask, &
                [data%m**2], [0._default], [data%m**2], &
                [data%qbounds(1)], [data%qbounds(2)])
        else
           call sf_int%base_init (mask, &
                [data%m**2], [0._default], [data%m**2])
        end if
        sf_int%data => data
        call hel0%init (0)
        call col0%init ()
        call qn(1)%init (data%flv_in,  col0, hel0)
        call qn(2)%init (data%flv_rad, col0, hel0)
        call qn(3)%init (data%flv_out, col0, hel0)
        call sf_int%add_state (qn)
        call sf_int%freeze ()
        call sf_int%set_incoming ([1])
        call sf_int%set_radiated ([2])
        call sf_int%set_outgoing ([3])
     end select
     sf_int%status = SF_INITIAL
   end subroutine sf_test_init
 
 @ %def sf_test_init
 @ Set kinematics.  If [[map]] is unset, the $r$ and $x$ values
 coincide, and the Jacobian $f(r)$ is trivial.
 
 If [[map]] is set, we are asked to provide an efficient mapping.
 For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
 <<SF base: sf test int: TBP>>=
   procedure :: complete_kinematics => sf_test_complete_kinematics
 <<SF base: test auxiliary>>=
   subroutine sf_test_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(sf_test_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     if (map) then
        x(1) = r(1)**2
        f = 2 * r(1)
     else
        x(1) = r(1)
        f = 1
     end if
     xb(1) = 1 - x(1)
     if (size (x) == 3) then
        x(2:3)  = r(2:3)
        xb(2:3) = rb(2:3)
     end if
     call sf_int%split_momentum (x, xb)
     sf_int%x = x(1)
     select case (sf_int%status)
     case (SF_FAILED_KINEMATICS);  f = 0
     end select
   end subroutine sf_test_complete_kinematics
 
 @ %def sf_test_complete_kinematics
 @ Compute inverse kinematics.  Here, we start with the $x$ array and
 compute the ``input'' $r$ values and the Jacobian $f$.  After this, we
 can set momenta by the same formula as for normal kinematics.
 <<SF base: sf test int: TBP>>=
   procedure :: inverse_kinematics => sf_test_inverse_kinematics
 <<SF base: test auxiliary>>=
   subroutine sf_test_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(sf_test_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     if (map) then
        r(1) = sqrt (x(1))
        f = 2 * r(1)
     else
        r(1) = x(1)
        f = 1
     end if
     if (size (x) == 3)  r(2:3) = x(2:3)
     rb = 1 - r
     sf_int%x = x(1)
     if (set_mom) then
        call sf_int%split_momentum (x, xb)
        select case (sf_int%status)
        case (SF_FAILED_KINEMATICS);  f = 0
        end select
     end if
   end subroutine sf_test_inverse_kinematics
 
 @ %def sf_test_inverse_kinematics
 @ Apply the structure function.  The matrix element becomes unity and
 the application always succeeds.
 
 If the [[mode]] indicator is one, the matrix element is equal to the
 parameter~$x$.
 <<SF base: sf test int: TBP>>=
   procedure :: apply => sf_test_apply
 <<SF base: test auxiliary>>=
   subroutine sf_test_apply (sf_int, scale, rescale, i_sub)
     class(sf_test_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     select case (sf_int%data%mode)
     case (0)
        call sf_int%set_matrix_element &
             (cmplx (1._default, kind=default))
     case (1)
        call sf_int%set_matrix_element &
             (cmplx (sf_int%x, kind=default))
     end select
     sf_int%status = SF_EVALUATED
   end subroutine sf_test_apply
 
 @ %def sf_test_apply
 @
 \subsection{Test implementation: pair spectrum}
 Another template, this time for a incoming particle pair, splitting
 into two radiated and two outgoing particles.
 
 \subsubsection{Configuration data}
 For simplicity, the spectrum contains two mirror images of the
 previous structure-function configuration: the incoming and all
 outgoing particles are test scalars.
 
 We have two versions, one with radiated particles, one without.
 <<SF base: test types>>=
   type, extends (sf_data_t) :: sf_test_spectrum_data_t
      class(model_data_t), pointer :: model => null ()
      type(flavor_t) :: flv_in
      type(flavor_t) :: flv_out
      type(flavor_t) :: flv_rad
      logical :: with_radiation = .true.
      real(default) :: m = 0
    contains
    <<SF base: sf test spectrum data: TBP>>
   end type sf_test_spectrum_data_t
 
 @ %def sf_test_spectrum_data_t
 @ Output.
 <<SF base: sf test spectrum data: TBP>>=
   procedure :: write => sf_test_spectrum_data_write
 <<SF base: test auxiliary>>=
   subroutine sf_test_spectrum_data_write (data, unit, verbose)
     class(sf_test_spectrum_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "SF test spectrum data:"
     write (u, "(3x,A,A)") "model     = ", char (data%model%get_name ())
     write (u, "(3x,A)", advance="no") "incoming  = "
     call data%flv_in%write (u);  write (u, *)
     write (u, "(3x,A)", advance="no") "outgoing  = "
     call data%flv_out%write (u);  write (u, *)
     write (u, "(3x,A)", advance="no") "radiated  = "
     call data%flv_rad%write (u);  write (u, *)
     write (u, "(3x,A," // FMT_19 // ")")  "mass      = ", data%m
   end subroutine sf_test_spectrum_data_write
 
 @ %def sf_test_spectrum_data_write
 @ Initialization.
 <<SF base: sf test spectrum data: TBP>>=
   procedure :: init => sf_test_spectrum_data_init
 <<SF base: test auxiliary>>=
   subroutine sf_test_spectrum_data_init (data, model, pdg_in, with_radiation)
     class(sf_test_spectrum_data_t), intent(out) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), intent(in) :: pdg_in
     logical, intent(in) :: with_radiation
     data%model => model
     data%with_radiation = with_radiation
     if (pdg_array_get (pdg_in, 1) /= 25) then
        call msg_fatal ("Test structure function: input flavor must be 's'")
     end if
     call data%flv_in%init (25, model)
     data%m = data%flv_in%get_mass ()
     call data%flv_out%init (25, model)
     if (with_radiation) then
        call data%flv_rad%init (25, model)
     end if
   end subroutine sf_test_spectrum_data_init
 
 @ %def sf_test_spectrum_data_init
 @ Return the number of parameters: 2, since we have only collinear
 splitting here.
 <<SF base: sf test spectrum data: TBP>>=
   procedure :: get_n_par => sf_test_spectrum_data_get_n_par
 <<SF base: test auxiliary>>=
   function sf_test_spectrum_data_get_n_par (data) result (n)
     class(sf_test_spectrum_data_t), intent(in) :: data
     integer :: n
     n = 2
   end function sf_test_spectrum_data_get_n_par
 
 @ %def sf_test_spectrum_data_get_n_par
 @ Return the outgoing particle PDG codes: 25
 <<SF base: sf test spectrum data: TBP>>=
   procedure :: get_pdg_out => sf_test_spectrum_data_get_pdg_out
 <<SF base: test auxiliary>>=
   subroutine sf_test_spectrum_data_get_pdg_out (data, pdg_out)
     class(sf_test_spectrum_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     pdg_out(1) = 25
     pdg_out(2) = 25
   end subroutine sf_test_spectrum_data_get_pdg_out
 
 @ %def sf_test_spectrum_data_get_pdg_out
 @ Allocate the matching interaction.
 <<SF base: sf test spectrum data: TBP>>=
   procedure :: allocate_sf_int => &
        sf_test_spectrum_data_allocate_sf_int
 <<SF base: test auxiliary>>=
   subroutine sf_test_spectrum_data_allocate_sf_int (data, sf_int)
     class(sf_test_spectrum_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (sf_test_spectrum_t :: sf_int)
   end subroutine sf_test_spectrum_data_allocate_sf_int
 
 @ %def sf_test_spectrum_data_allocate_sf_int
 @
 \subsubsection{Interaction}
 <<SF base: test types>>=
   type, extends (sf_int_t) :: sf_test_spectrum_t
      type(sf_test_spectrum_data_t), pointer :: data => null ()
    contains
    <<SF base: sf test spectrum: TBP>>
   end type sf_test_spectrum_t
 
 @ %def sf_test_spectrum_t
 <<SF base: sf test spectrum: TBP>>=
   procedure :: type_string => sf_test_spectrum_type_string
 <<SF base: test auxiliary>>=
   function sf_test_spectrum_type_string (object) result (string)
     class(sf_test_spectrum_t), intent(in) :: object
     type(string_t) :: string
     string = "Test Spectrum"
   end function sf_test_spectrum_type_string
 
 @ %def sf_test_spectrum_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF base: sf test spectrum: TBP>>=
   procedure :: write => sf_test_spectrum_write
 <<SF base: test auxiliary>>=
   subroutine sf_test_spectrum_write (object, unit, testflag)
     class(sf_test_spectrum_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "SF test spectrum data: [undefined]"
     end if
   end subroutine sf_test_spectrum_write
 
 @ %def sf_test_spectrum_write
 @ Initialize.  We know that [[data]] will be of concrete type
 [[sf_test_spectrum_data_t]], but we have to cast this explicitly.
 
 For this implementation, we set the incoming and outgoing masses equal
 to the physical particle mass, but keep the radiated mass zero.
 
 Optionally, we can provide minimum and maximum values for the momentum
 transfer.
 <<SF base: sf test spectrum: TBP>>=
   procedure :: init => sf_test_spectrum_init
 <<SF base: test auxiliary>>=
   subroutine sf_test_spectrum_init (sf_int, data)
     class(sf_test_spectrum_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     type(quantum_numbers_mask_t), dimension(6) :: mask
     type(helicity_t) :: hel0
     type(color_t) :: col0
     type(quantum_numbers_t), dimension(6) :: qn
     mask = quantum_numbers_mask (.false., .false., .false.)
     select type (data)
     type is (sf_test_spectrum_data_t)
        if (data%with_radiation) then
           call sf_int%base_init (mask(1:6), &
                [data%m**2, data%m**2], &
                [0._default, 0._default], &
                [data%m**2, data%m**2])
           sf_int%data => data
           call hel0%init (0)
           call col0%init ()
           call qn(1)%init (data%flv_in,  col0, hel0)
           call qn(2)%init (data%flv_in,  col0, hel0)
           call qn(3)%init (data%flv_rad, col0, hel0)
           call qn(4)%init (data%flv_rad, col0, hel0)
           call qn(5)%init (data%flv_out, col0, hel0)
           call qn(6)%init (data%flv_out, col0, hel0)
           call sf_int%add_state (qn(1:6))
           call sf_int%set_incoming ([1,2])
           call sf_int%set_radiated ([3,4])
           call sf_int%set_outgoing ([5,6])
        else
           call sf_int%base_init (mask(1:4), &
                [data%m**2, data%m**2], &
                [real(default) :: ], &
                [data%m**2, data%m**2])
           sf_int%data => data
           call hel0%init (0)
           call col0%init ()
           call qn(1)%init (data%flv_in,  col0, hel0)
           call qn(2)%init (data%flv_in,  col0, hel0)
           call qn(3)%init (data%flv_out, col0, hel0)
           call qn(4)%init (data%flv_out, col0, hel0)
           call sf_int%add_state (qn(1:4))
           call sf_int%set_incoming ([1,2])
           call sf_int%set_outgoing ([3,4])
        end if
        call sf_int%freeze ()
     end select
     sf_int%status = SF_INITIAL
   end subroutine sf_test_spectrum_init
 
 @ %def sf_test_spectrum_init
 @ Set kinematics.  If [[map]] is unset, the $r$ and $x$ values
 coincide, and the Jacobian $f(r)$ is trivial.
 
 If [[map]] is set, we are asked to provide an efficient mapping.
 For the test case, we set $x=r^2$ (as above) for both $x$ parameters
 and consequently $f(r)=4r_1r_2$.
 
 <<SF base: sf test spectrum: TBP>>=
   procedure :: complete_kinematics => sf_test_spectrum_complete_kinematics
 <<SF base: test auxiliary>>=
   subroutine sf_test_spectrum_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(sf_test_spectrum_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     real(default), dimension(2) :: xb1
     if (map) then
        x = r**2
        f = 4 * r(1) * r(2)
     else
        x = r
        f = 1
     end if
     xb = 1 - x
     if (sf_int%data%with_radiation) then
        call sf_int%split_momenta (x, xb)
     else
        call sf_int%reduce_momenta (x)
     end if
     select case (sf_int%status)
     case (SF_FAILED_KINEMATICS);  f = 0
     end select
   end subroutine sf_test_spectrum_complete_kinematics
 
 @ %def sf_test_spectrum_complete_kinematics
 @ Compute inverse kinematics.  Here, we start with the $x$ array and
 compute the ``input'' $r$ values and the Jacobian $f$.  After this, we
 can set momenta by the same formula as for normal kinematics.
 <<SF base: sf test spectrum: TBP>>=
   procedure :: inverse_kinematics => sf_test_spectrum_inverse_kinematics
 <<SF base: test auxiliary>>=
   subroutine sf_test_spectrum_inverse_kinematics &
        (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(sf_test_spectrum_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
      real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     real(default), dimension(2) :: xb1
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     if (map) then
        r = sqrt (x)
        f = 4 * r(1) * r(2)
     else
        r = x
        f = 1
     end if
     rb = 1 - r
     if (set_mom)  then
        if (sf_int%data%with_radiation) then
           call sf_int%split_momenta (x, xb)
        else
           call sf_int%reduce_momenta (x)
        end if
        select case (sf_int%status)
        case (SF_FAILED_KINEMATICS);  f = 0
        end select
     end if
   end subroutine sf_test_spectrum_inverse_kinematics
 
 @ %def sf_test_spectrum_inverse_kinematics
 @ Apply the structure function.  The matrix element becomes unity and
 the application always succeeds.
 <<SF base: sf test spectrum: TBP>>=
   procedure :: apply => sf_test_spectrum_apply
 <<SF base: test auxiliary>>=
   subroutine sf_test_spectrum_apply (sf_int, scale, rescale, i_sub)
     class(sf_test_spectrum_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     call sf_int%set_matrix_element &
          (cmplx (1._default, kind=default))
     sf_int%status = SF_EVALUATED
   end subroutine sf_test_spectrum_apply
 
 @ %def sf_test_spectrum_apply
 @
 \subsection{Test implementation: generator spectrum}
 A generator for two beams, no radiation (for simplicity).
 
 \subsubsection{Configuration data}
 For simplicity, the spectrum contains two mirror images of the
 previous structure-function configuration: the incoming and all
 outgoing particles are test scalars.
 
 We have two versions, one with radiated particles, one without.
 <<SF base: test types>>=
   type, extends (sf_data_t) :: sf_test_generator_data_t
      class(model_data_t), pointer :: model => null ()
      type(flavor_t) :: flv_in
      type(flavor_t) :: flv_out
      type(flavor_t) :: flv_rad
      real(default) :: m = 0
    contains
    <<SF base: sf test generator data: TBP>>
   end type sf_test_generator_data_t
 
 @ %def sf_test_generator_data_t
 @ Output.
 <<SF base: sf test generator data: TBP>>=
   procedure :: write => sf_test_generator_data_write
 <<SF base: test auxiliary>>=
   subroutine sf_test_generator_data_write (data, unit, verbose)
     class(sf_test_generator_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "SF test generator data:"
     write (u, "(3x,A,A)") "model     = ", char (data%model%get_name ())
     write (u, "(3x,A)", advance="no") "incoming  = "
     call data%flv_in%write (u);  write (u, *)
     write (u, "(3x,A)", advance="no") "outgoing  = "
     call data%flv_out%write (u);  write (u, *)
     write (u, "(3x,A," // FMT_19 // ")")  "mass      = ", data%m
   end subroutine sf_test_generator_data_write
 
 @ %def sf_test_generator_data_write
 @ Initialization.
 <<SF base: sf test generator data: TBP>>=
   procedure :: init => sf_test_generator_data_init
 <<SF base: test auxiliary>>=
   subroutine sf_test_generator_data_init (data, model, pdg_in)
     class(sf_test_generator_data_t), intent(out) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), intent(in) :: pdg_in
     data%model => model
     if (pdg_array_get (pdg_in, 1) /= 25) then
        call msg_fatal ("Test generator: input flavor must be 's'")
     end if
     call data%flv_in%init (25, model)
     data%m = data%flv_in%get_mass ()
     call data%flv_out%init (25, model)
   end subroutine sf_test_generator_data_init
 
 @ %def sf_test_generator_data_init
 @ This structure function is a generator.
 <<SF base: sf test generator data: TBP>>=
   procedure :: is_generator => sf_test_generator_data_is_generator
 <<SF base: test auxiliary>>=
   function sf_test_generator_data_is_generator (data) result (flag)
     class(sf_test_generator_data_t), intent(in) :: data
     logical :: flag
     flag = .true.
   end function sf_test_generator_data_is_generator
 
 @ %def sf_test_generator_data_is_generator
 @ Return the number of parameters: 2, since we have only collinear
 splitting here.
 <<SF base: sf test generator data: TBP>>=
   procedure :: get_n_par => sf_test_generator_data_get_n_par
 <<SF base: test auxiliary>>=
   function sf_test_generator_data_get_n_par (data) result (n)
     class(sf_test_generator_data_t), intent(in) :: data
     integer :: n
     n = 2
   end function sf_test_generator_data_get_n_par
 
 @ %def sf_test_generator_data_get_n_par
 @ Return the outgoing particle PDG codes: 25
 <<SF base: sf test generator data: TBP>>=
   procedure :: get_pdg_out => sf_test_generator_data_get_pdg_out
 <<SF base: test auxiliary>>=
   subroutine sf_test_generator_data_get_pdg_out (data, pdg_out)
     class(sf_test_generator_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     pdg_out(1) = 25
     pdg_out(2) = 25
   end subroutine sf_test_generator_data_get_pdg_out
 
 @ %def sf_test_generator_data_get_pdg_out
 @ Allocate the matching interaction.
 <<SF base: sf test generator data: TBP>>=
   procedure :: allocate_sf_int => &
        sf_test_generator_data_allocate_sf_int
 <<SF base: test auxiliary>>=
   subroutine sf_test_generator_data_allocate_sf_int (data, sf_int)
     class(sf_test_generator_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (sf_test_generator_t :: sf_int)
   end subroutine sf_test_generator_data_allocate_sf_int
 
 @ %def sf_test_generator_data_allocate_sf_int
 @
 \subsubsection{Interaction}
 <<SF base: test types>>=
   type, extends (sf_int_t) :: sf_test_generator_t
      type(sf_test_generator_data_t), pointer :: data => null ()
    contains
    <<SF base: sf test generator: TBP>>
   end type sf_test_generator_t
 
 @ %def sf_test_generator_t
 <<SF base: sf test generator: TBP>>=
   procedure :: type_string => sf_test_generator_type_string
 <<SF base: test auxiliary>>=
   function sf_test_generator_type_string (object) result (string)
     class(sf_test_generator_t), intent(in) :: object
     type(string_t) :: string
     string = "Test Generator"
   end function sf_test_generator_type_string
 
 @ %def sf_test_generator_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF base: sf test generator: TBP>>=
   procedure :: write => sf_test_generator_write
 <<SF base: test auxiliary>>=
   subroutine sf_test_generator_write (object, unit, testflag)
     class(sf_test_generator_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "SF test generator data: [undefined]"
     end if
   end subroutine sf_test_generator_write
 
 @ %def sf_test_generator_write
 @ Initialize.  We know that [[data]] will be of concrete type
 [[sf_test_generator_data_t]], but we have to cast this explicitly.
 
 For this implementation, we set the incoming and outgoing masses equal
 to the physical particle mass.  No radiation.
 <<SF base: sf test generator: TBP>>=
   procedure :: init => sf_test_generator_init
 <<SF base: test auxiliary>>=
   subroutine sf_test_generator_init (sf_int, data)
     class(sf_test_generator_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     type(quantum_numbers_mask_t), dimension(4) :: mask
     type(helicity_t) :: hel0
     type(color_t) :: col0
     type(quantum_numbers_t), dimension(4) :: qn
     mask = quantum_numbers_mask (.false., .false., .false.)
     select type (data)
     type is (sf_test_generator_data_t)
        call sf_int%base_init (mask(1:4), &
             [data%m**2, data%m**2], &
             [real(default) :: ], &
             [data%m**2, data%m**2])
        sf_int%data => data
        call hel0%init (0)
        call col0%init ()
        call qn(1)%init (data%flv_in,  col0, hel0)
        call qn(2)%init (data%flv_in,  col0, hel0)
        call qn(3)%init (data%flv_out, col0, hel0)
        call qn(4)%init (data%flv_out, col0, hel0)
        call sf_int%add_state (qn(1:4))
        call sf_int%set_incoming ([1,2])
        call sf_int%set_outgoing ([3,4])
        call sf_int%freeze ()
     end select
     sf_int%status = SF_INITIAL
   end subroutine sf_test_generator_init
 
 @ %def sf_test_generator_init
 @ This structure function is a generator.
 <<SF base: sf test generator: TBP>>=
   procedure :: is_generator => sf_test_generator_is_generator
 <<SF base: test auxiliary>>=
   function sf_test_generator_is_generator (sf_int) result (flag)
     class(sf_test_generator_t), intent(in) :: sf_int
     logical :: flag
     flag = sf_int%data%is_generator ()
   end function sf_test_generator_is_generator
 
 @ %def sf_test_generator_is_generator
 @ Generate free parameters.  This mock generator always produces the
 nubmers 0.8 and 0.5.
 <<SF base: sf test generator: TBP>>=
   procedure :: generate_free => sf_test_generator_generate_free
 <<SF base: test auxiliary>>=
   subroutine sf_test_generator_generate_free (sf_int, r, rb,  x_free)
     class(sf_test_generator_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(inout) :: x_free
     r = [0.8, 0.5]
     rb= 1 - r
     x_free = x_free * product (r)
   end subroutine sf_test_generator_generate_free
 
 @ %def sf_test_generator_generate_free
 @ Recover momentum fractions.  Since the x values are free, we also set the [[x_free]] parameter.
 <<SF base: sf test generator: TBP>>=
   procedure :: recover_x => sf_test_generator_recover_x
 <<SF base: test auxiliary>>=
   subroutine sf_test_generator_recover_x (sf_int, x, xb, x_free)
     class(sf_test_generator_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(inout), optional :: x_free
     call sf_int%base_recover_x (x, xb)
     if (present (x_free))  x_free = x_free * product (x)
   end subroutine sf_test_generator_recover_x
 
 @ %def sf_test_generator_recover_x
 @ Set kinematics.  Since this is a generator, just transfer input to output.
 <<SF base: sf test generator: TBP>>=
   procedure :: complete_kinematics => sf_test_generator_complete_kinematics
 <<SF base: test auxiliary>>=
   subroutine sf_test_generator_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(sf_test_generator_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     x = r
     xb= rb
     f = 1
     call sf_int%reduce_momenta (x)
   end subroutine sf_test_generator_complete_kinematics
 
 @ %def sf_test_generator_complete_kinematics
 @ Compute inverse kinematics.  Here, we start with the $x$ array and
 compute the ``input'' $r$ values and the Jacobian $f$.  After this, we
 can set momenta by the same formula as for normal kinematics.
 <<SF base: sf test generator: TBP>>=
   procedure :: inverse_kinematics => sf_test_generator_inverse_kinematics
 <<SF base: test auxiliary>>=
   subroutine sf_test_generator_inverse_kinematics &
        (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(sf_test_generator_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     r = x
     rb= xb
     f = 1
     if (set_mom)  call sf_int%reduce_momenta (x)
   end subroutine sf_test_generator_inverse_kinematics
 
 @ %def sf_test_generator_inverse_kinematics
 @ Apply the structure function.  The matrix element becomes unity and
 the application always succeeds.
 <<SF base: sf test generator: TBP>>=
   procedure :: apply => sf_test_generator_apply
 <<SF base: test auxiliary>>=
   subroutine sf_test_generator_apply (sf_int, scale, rescale, i_sub)
     class(sf_test_generator_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     call sf_int%set_matrix_element &
          (cmplx (1._default, kind=default))
     sf_int%status = SF_EVALUATED
   end subroutine sf_test_generator_apply
 
 @ %def sf_test_generator_apply
 @
 \subsubsection{Test structure function data}
 Construct and display a test structure function data object.
 <<SF base: execute tests>>=
   call test (sf_base_1, "sf_base_1", &
        "structure function configuration", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_1
 <<SF base: tests>>=
   subroutine sf_base_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(pdg_array_t), dimension(1) :: pdg_out
     integer, dimension(:), allocatable :: pdg1
     class(sf_data_t), allocatable :: data
 
     write (u, "(A)")  "* Test output: sf_base_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &test structure function data"
     write (u, "(A)")
 
     call model%init_test ()
     pdg_in = 25
 
     allocate (sf_test_data_t :: data)
     select type (data)
     type is (sf_test_data_t)
        call data%init (model, pdg_in)
     end select
 
     call data%write (u)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle code:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     write (u, "(2x,99(1x,I0))")  pdg1
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_1"
 
   end subroutine sf_base_1
 
 @ %def sf_base_1
 @
 \subsubsection{Test and probe structure function}
 Construct and display a structure function object based on the test
 structure function.
 <<SF base: execute tests>>=
   call test (sf_base_2, "sf_base_2", &
        "structure function instance", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_2
 <<SF base: tests>>=
   subroutine sf_base_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_base_2"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     pdg_in = 25
     call flv%init (25, model)
 
     call reset_interaction_counter ()
 
     allocate (sf_test_data_t :: data)
     select type (data)
     type is (sf_test_data_t)
        call data%init (model, pdg_in)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
 
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = 0
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=1"
     write (u, "(A)")
 
     r = 1
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5"
     write (u, "(A)")
 
     r = 0.5_default
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics with mapping for r=0.8"
     write (u, "(A)")
 
     r = 0.8_default
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
 
     call sf_int%seed_kinematics ([k])
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
 
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute inverse kinematics for x=0.64 and evaluate"
     write (u, "(A)")
 
     x = 0.64_default
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
     call sf_int%apply (scale=0._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_2"
 
   end subroutine sf_base_2
 
 @ %def sf_base_2
 @
 \subsubsection{Collinear kinematics}
 Scan over the possibilities for mass assignment and on-shell
 projections, collinear case.
 <<SF base: execute tests>>=
   call test (sf_base_3, "sf_base_3", &
        "alternatives for collinear kinematics", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_3
 <<SF base: tests>>=
   subroutine sf_base_3 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(flavor_t) :: flv
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_base_3"
     write (u, "(A)")  "*   Purpose: check various kinematical setups"
     write (u, "(A)")  "*            for collinear structure-function splitting."
     write (u, "(A)")  "             (two masses equal, one zero)"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     pdg_in = 25
     call flv%init (25, model)
 
     call reset_interaction_counter ()
 
     allocate (sf_test_data_t :: data)
     select type (data)
     type is (sf_test_data_t)
        call data%init (model, pdg_in)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
 
     call sf_int%write (u)
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
 
     E = 500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set radiated mass to zero"
 
     sf_int%mr2 = 0
     sf_int%mo2 = sf_int%mi2
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5, keeping energy"
     write (u, "(A)")
 
     r = 0.5_default
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_ENERGY
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5, keeping momentum"
     write (u, "(A)")
 
     r = 0.5_default
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_MOMENTUM
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set outgoing mass to zero"
 
     sf_int%mr2 = sf_int%mi2
     sf_int%mo2 = 0
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5, keeping energy"
     write (u, "(A)")
 
     r = 0.5_default
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_ENERGY
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5, keeping momentum"
     write (u, "(A)")
 
     r = 0.5_default
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_MOMENTUM
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set incoming mass to zero"
 
     k = vector4_moving (E, E, 3)
     call sf_int%seed_kinematics ([k])
 
     sf_int%mr2 = sf_int%mi2
     sf_int%mo2 = sf_int%mi2
     sf_int%mi2 = 0
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5, keeping energy"
     write (u, "(A)")
 
     r = 0.5_default
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_ENERGY
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5, keeping momentum"
     write (u, "(A)")
 
     r = 0.5_default
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_MOMENTUM
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set all masses to zero"
 
     sf_int%mr2 = 0
     sf_int%mo2 = 0
     sf_int%mi2 = 0
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5, keeping energy"
     write (u, "(A)")
 
     r = 0.5_default
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_ENERGY
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5, keeping momentum"
     write (u, "(A)")
 
     r = 0.5_default
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_MOMENTUM
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_3"
 
   end subroutine sf_base_3
 
 @ %def sf_base_3
 @
 \subsubsection{Non-collinear kinematics}
 Scan over the possibilities for mass assignment and on-shell
 projections, non-collinear case.
 <<SF base: execute tests>>=
   call test (sf_base_4, "sf_base_4", &
        "alternatives for non-collinear kinematics", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_4
 <<SF base: tests>>=
   subroutine sf_base_4 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(flavor_t) :: flv
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_base_4"
     write (u, "(A)")  "*   Purpose: check various kinematical setups"
     write (u, "(A)")  "*            for free structure-function splitting."
     write (u, "(A)")  "             (two masses equal, one zero)"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     pdg_in = 25
     call flv%init (25, model)
 
     call reset_interaction_counter ()
 
     allocate (sf_test_data_t :: data)
     select type (data)
     type is (sf_test_data_t)
        call data%init (model, pdg_in, collinear=.false.)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
 
     call sf_int%write (u)
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
 
     E = 500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set radiated mass to zero"
 
     sf_int%mr2 = 0
     sf_int%mo2 = sf_int%mi2
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
     write (u, "(A)")
 
     r = [0.5_default, 0.5_default, 0.125_default]
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_ENERGY
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
     write (u, "(A)")
 
     r = [0.5_default, 0.5_default, 0.125_default]
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_MOMENTUM
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set outgoing mass to zero"
 
     sf_int%mr2 = sf_int%mi2
     sf_int%mo2 = 0
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
     write (u, "(A)")
 
     r = [0.5_default, 0.5_default, 0.125_default]
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_ENERGY
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
     write (u, "(A)")
 
     r = [0.5_default, 0.5_default, 0.125_default]
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_MOMENTUM
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set incoming mass to zero"
 
     k = vector4_moving (E, E, 3)
     call sf_int%seed_kinematics ([k])
 
     sf_int%mr2 = sf_int%mi2
     sf_int%mo2 = sf_int%mi2
     sf_int%mi2 = 0
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
     write (u, "(A)")
 
     r = [0.5_default, 0.5_default, 0.125_default]
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_ENERGY
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
     write (u, "(A)")
 
     r = [0.5_default, 0.5_default, 0.125_default]
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_MOMENTUM
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set all masses to zero"
 
     sf_int%mr2 = 0
     sf_int%mo2 = 0
     sf_int%mi2 = 0
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-Initialize structure-function object with Q bounds"
 
     call reset_interaction_counter ()
 
     select type (data)
     type is (sf_test_data_t)
        call data%init (model, pdg_in, collinear=.false., &
             qbounds = [1._default, 100._default])
     end select
 
     call sf_int%init (data)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
     write (u, "(A)")
 
     r = [0.5_default, 0.5_default, 0.125_default]
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_ENERGY
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
     write (u, "(A)")
 
     r = [0.5_default, 0.5_default, 0.125_default]
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_MOMENTUM
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_4"
 
   end subroutine sf_base_4
 
 @ %def sf_base_4
 @
 \subsubsection{Pair spectrum}
 Construct and display a structure function object for a pair spectrum
 (a structure function involving two particles simultaneously).
 <<SF base: execute tests>>=
   call test (sf_base_5, "sf_base_5", &
        "pair spectrum with radiation", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_5
 <<SF base: tests>>=
   subroutine sf_base_5 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(pdg_array_t), dimension(2) :: pdg_out
     integer, dimension(:), allocatable :: pdg1, pdg2
     type(flavor_t) :: flv
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t), dimension(2) :: k
     type(vector4_t), dimension(4) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_base_5"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &a pair spectrum object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
     pdg_in = 25
 
     call reset_interaction_counter ()
 
     allocate (sf_test_spectrum_data_t :: data)
     select type (data)
     type is (sf_test_spectrum_data_t)
        call data%init (model, pdg_in, with_radiation=.true.)
     end select
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     pdg2 = pdg_out(2)
     write (u, "(2x,99(1x,I0))")  pdg1, pdg2
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize spectrum object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
 
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize incoming momenta with sqrts=1000"
 
     E = 500
     k(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     k(2) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call sf_int%seed_kinematics (k)
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.4,0.8"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = [0.4_default, 0.8_default]
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics with mapping for r=0.6,0.8"
     write (u, "(A)")
 
     r = [0.6_default, 0.8_default]
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call reset_interaction_counter ()
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
 
     call sf_int%seed_kinematics (k)
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute inverse kinematics for x=0.36,0.64 &
          &and evaluate"
     write (u, "(A)")
 
     x = [0.36_default, 0.64_default]
     xb = 1 - x
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
     call sf_int%apply (scale=0._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_5"
 
   end subroutine sf_base_5
 
 @ %def sf_base_5
 @
 \subsubsection{Pair spectrum without radiation}
 Construct and display a structure function object for a pair spectrum
 (a structure function involving two particles simultaneously).
 <<SF base: execute tests>>=
   call test (sf_base_6, "sf_base_6", &
        "pair spectrum without radiation", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_6
 <<SF base: tests>>=
   subroutine sf_base_6 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(flavor_t) :: flv
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t), dimension(2) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_base_6"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &a pair spectrum object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
     pdg_in = 25
 
     call reset_interaction_counter ()
 
     allocate (sf_test_spectrum_data_t :: data)
     select type (data)
     type is (sf_test_spectrum_data_t)
        call data%init (model, pdg_in, with_radiation=.false.)
     end select
 
     write (u, "(A)")  "* Initialize spectrum object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
 
     write (u, "(A)")  "* Initialize incoming momenta with sqrts=1000"
 
     E = 500
     k(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     k(2) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call sf_int%seed_kinematics (k)
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.4,0.8"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = [0.4_default, 0.8_default]
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call reset_interaction_counter ()
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
 
     call sf_int%seed_kinematics (k)
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute inverse kinematics for x=0.4,0.8 &
          &and evaluate"
     write (u, "(A)")
 
     x = [0.4_default, 0.8_default]
     xb = 1 - x
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%apply (scale=0._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_6"
 
   end subroutine sf_base_6
 
 @ %def sf_base_6
 @
 \subsubsection{Direct access to structure function}
 Probe a structure function directly.
 <<SF base: execute tests>>=
   call test (sf_base_7, "sf_base_7", &
        "direct access", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_7
 <<SF base: tests>>=
   subroutine sf_base_7 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(flavor_t) :: flv
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     real(default), dimension(:), allocatable :: value
 
     write (u, "(A)")  "* Test output: sf_base_7"
     write (u, "(A)")  "*   Purpose: check direct access method"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
     pdg_in = 25
 
     call reset_interaction_counter ()
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     allocate (sf_test_data_t :: data)
     select type (data)
     type is (sf_test_data_t)
        call data%init (model, pdg_in)
     end select
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
 
     write (u, "(A)")  "* Probe structure function: states"
     write (u, "(A)")
 
     write (u, "(A,I0)")  "n_states = ", sf_int%get_n_states ()
     write (u, "(A,I0)")  "n_in     = ", sf_int%get_n_in ()
     write (u, "(A,I0)")  "n_rad    = ", sf_int%get_n_rad ()
     write (u, "(A,I0)")  "n_out    = ", sf_int%get_n_out ()
     write (u, "(A)")
     write (u, "(A)", advance="no")  "state(1)  = "
     call quantum_numbers_write (sf_int%get_state (1), u)
     write (u, *)
 
     allocate (value (sf_int%get_n_states ()))
     call sf_int%compute_values (value, &
          E=[500._default], x=[0.5_default], xb=[0.5_default], scale=0._default)
 
     write (u, "(A)")
     write (u, "(A)", advance="no")  "value (E=500, x=0.5) ="
     write (u, "(9(1x," // FMT_19 // "))")  value
 
     call sf_int%compute_values (value, &
          x=[0.1_default], xb=[0.9_default], scale=0._default)
 
     write (u, "(A)")
     write (u, "(A)", advance="no")  "value (E=500, x=0.1) ="
     write (u, "(9(1x," // FMT_19 // "))")  value
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize spectrum object"
     write (u, "(A)")
 
     deallocate (value)
     call sf_int%final ()
     deallocate (sf_int)
     deallocate (data)
 
     allocate (sf_test_spectrum_data_t :: data)
     select type (data)
     type is (sf_test_spectrum_data_t)
        call data%init (model, pdg_in, with_radiation=.false.)
     end select
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
 
     write (u, "(A)")  "* Probe spectrum: states"
     write (u, "(A)")
 
     write (u, "(A,I0)")  "n_states = ", sf_int%get_n_states ()
     write (u, "(A,I0)")  "n_in     = ", sf_int%get_n_in ()
     write (u, "(A,I0)")  "n_rad    = ", sf_int%get_n_rad ()
     write (u, "(A,I0)")  "n_out    = ", sf_int%get_n_out ()
     write (u, "(A)")
     write (u, "(A)", advance="no")  "state(1)  = "
     call quantum_numbers_write (sf_int%get_state (1), u)
     write (u, *)
 
     allocate (value (sf_int%get_n_states ()))
     call sf_int%compute_value (1, value(1), &
          E = [500._default, 500._default], &
          x = [0.5_default, 0.6_default], &
          xb= [0.5_default, 0.4_default], &
          scale = 0._default)
 
     write (u, "(A)")
     write (u, "(A)", advance="no")  "value (E=500,500, x=0.5,0.6) ="
     write (u, "(9(1x," // FMT_19 // "))")  value
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_7"
 
   end subroutine sf_base_7
 
 @ %def sf_base_7
 @
 \subsubsection{Structure function chain configuration}
 <<SF base: execute tests>>=
   call test (sf_base_8, "sf_base_8", &
        "structure function chain configuration", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_8
 <<SF base: tests>>=
   subroutine sf_base_8 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     type(beam_data_t), target :: beam_data
     class(sf_data_t), allocatable, target :: data_strfun
     class(sf_data_t), allocatable, target :: data_spectrum
     type(sf_config_t), dimension(:), allocatable :: sf_config
     type(sf_chain_t) :: sf_chain
 
     write (u, "(A)")  "* Test output: sf_base_8"
     write (u, "(A)")  "*   Purpose: set up a structure-function chain"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
     pdg_in = 25
 
     call reset_interaction_counter ()
 
     call beam_data%init_sqrts (1000._default, [flv, flv])
 
     allocate (sf_test_data_t :: data_strfun)
     select type (data_strfun)
     type is (sf_test_data_t)
        call data_strfun%init (model, pdg_in)
     end select
 
     allocate (sf_test_spectrum_data_t :: data_spectrum)
     select type (data_spectrum)
     type is (sf_test_spectrum_data_t)
        call data_spectrum%init (model, pdg_in, with_radiation=.true.)
     end select
 
     write (u, "(A)")  "* Set up chain with beams only"
     write (u, "(A)")
 
     call sf_chain%init (beam_data)
     call write_separator (u, 2)
     call sf_chain%write (u)
     call write_separator (u, 2)
     call sf_chain%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Set up chain with structure function"
     write (u, "(A)")
 
     allocate (sf_config (1))
     call sf_config(1)%init ([1], data_strfun)
     call sf_chain%init (beam_data, sf_config)
 
     call write_separator (u, 2)
     call sf_chain%write (u)
     call write_separator (u, 2)
     call sf_chain%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Set up chain with spectrum and structure function"
     write (u, "(A)")
 
     deallocate (sf_config)
     allocate (sf_config (2))
     call sf_config(1)%init ([1,2], data_spectrum)
     call sf_config(2)%init ([2], data_strfun)
     call sf_chain%init (beam_data, sf_config)
 
     call write_separator (u, 2)
     call sf_chain%write (u)
     call write_separator (u, 2)
     call sf_chain%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_8"
 
   end subroutine sf_base_8
 
 @ %def sf_base_8
 @
 \subsubsection{Structure function instance configuration}
 We create a structure-function chain instance which implements a
 configured structure-function chain.  We link the momentum entries in
 the interactions and compute kinematics.
 
 We do not actually connect the interactions and create evaluators.  We
 skip this step and manually advance the status of the chain instead.
 <<SF base: execute tests>>=
   call test (sf_base_9, "sf_base_9", &
        "structure function chain instance", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_9
 <<SF base: tests>>=
   subroutine sf_base_9 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     type(beam_data_t), target :: beam_data
     class(sf_data_t), allocatable, target :: data_strfun
     class(sf_data_t), allocatable, target :: data_spectrum
     type(sf_config_t), dimension(:), allocatable, target :: sf_config
     type(sf_chain_t), target :: sf_chain
     type(sf_chain_instance_t), target :: sf_chain_instance
     type(sf_channel_t), dimension(2) :: sf_channel
     type(vector4_t), dimension(2) :: p
     integer :: j
 
     write (u, "(A)")  "* Test output: sf_base_9"
     write (u, "(A)")  "*   Purpose: set up a structure-function chain &
          &and create an instance"
     write (u, "(A)")  "*            compute kinematics"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
     pdg_in = 25
 
     call reset_interaction_counter ()
 
     call beam_data%init_sqrts (1000._default, [flv, flv])
 
     allocate (sf_test_data_t :: data_strfun)
     select type (data_strfun)
     type is (sf_test_data_t)
        call data_strfun%init (model, pdg_in)
     end select
 
     allocate (sf_test_spectrum_data_t :: data_spectrum)
     select type (data_spectrum)
     type is (sf_test_spectrum_data_t)
        call data_spectrum%init (model, pdg_in, with_radiation=.true.)
     end select
 
     write (u, "(A)")  "* Set up chain with beams only"
     write (u, "(A)")
 
     call sf_chain%init (beam_data)
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
 
     call sf_chain_instance%link_interactions ()
     sf_chain_instance%status = SF_DONE_CONNECTIONS
     call sf_chain_instance%compute_kinematics (1, [real(default) ::])
 
     call write_separator (u, 2)
     call sf_chain%write (u)
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     call sf_chain_instance%get_out_momenta (p)
 
     write (u, "(A)")
     write (u, "(A)")  "* Outgoing momenta:"
 
     do j = 1, 2
        write (u, "(A)")
        call vector4_write (p(j), u)
     end do
 
     call sf_chain_instance%final ()
     call sf_chain%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Set up chain with structure function"
     write (u, "(A)")
 
     allocate (sf_config (1))
     call sf_config(1)%init ([1], data_strfun)
     call sf_chain%init (beam_data, sf_config)
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
 
     call sf_channel(1)%init (1)
     call sf_channel(1)%activate_mapping ([1])
     call sf_chain_instance%set_channel (1, sf_channel(1))
 
     call sf_chain_instance%link_interactions ()
     sf_chain_instance%status = SF_DONE_CONNECTIONS
     call sf_chain_instance%compute_kinematics (1, [0.8_default])
 
     call write_separator (u, 2)
     call sf_chain%write (u)
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     call sf_chain_instance%get_out_momenta (p)
 
     write (u, "(A)")
     write (u, "(A)")  "* Outgoing momenta:"
 
     do j = 1, 2
        write (u, "(A)")
        call vector4_write (p(j), u)
     end do
 
     call sf_chain_instance%final ()
     call sf_chain%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Set up chain with spectrum and structure function"
     write (u, "(A)")
 
     deallocate (sf_config)
     allocate (sf_config (2))
     call sf_config(1)%init ([1,2], data_spectrum)
     call sf_config(2)%init ([2], data_strfun)
     call sf_chain%init (beam_data, sf_config)
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
 
     call sf_channel(2)%init (2)
     call sf_channel(2)%activate_mapping ([2])
     call sf_chain_instance%set_channel (1, sf_channel(2))
 
     call sf_chain_instance%link_interactions ()
     sf_chain_instance%status = SF_DONE_CONNECTIONS
     call sf_chain_instance%compute_kinematics &
          (1, [0.5_default, 0.6_default, 0.8_default])
 
     call write_separator (u, 2)
     call sf_chain%write (u)
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     call sf_chain_instance%get_out_momenta (p)
 
     write (u, "(A)")
     write (u, "(A)")  "* Outgoing momenta:"
 
     do j = 1, 2
        write (u, "(A)")
        call vector4_write (p(j), u)
     end do
 
     call sf_chain_instance%final ()
     call sf_chain%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_9"
 
   end subroutine sf_base_9
 
 @ %def sf_base_9
 @
 \subsubsection{Structure function chain mappings}
 Set up a structure function chain instance with a pair of
 single-particle structure functions.  We test different global
 mappings for this setup.
 
 Again, we skip evaluators.
 <<SF base: execute tests>>=
  call test (sf_base_10, "sf_base_10", &
       "structure function chain mapping", &
       u, results)
 <<SF base: test declarations>>=
   public :: sf_base_10
 <<SF base: tests>>=
   subroutine sf_base_10 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     type(beam_data_t), target :: beam_data
     class(sf_data_t), allocatable, target :: data_strfun
     type(sf_config_t), dimension(:), allocatable, target :: sf_config
     type(sf_chain_t), target :: sf_chain
     type(sf_chain_instance_t), target :: sf_chain_instance
     type(sf_channel_t), dimension(2) :: sf_channel
     real(default), dimension(2) :: x_saved
 
     write (u, "(A)")  "* Test output: sf_base_10"
     write (u, "(A)")  "*   Purpose: set up a structure-function chain"
     write (u, "(A)")  "*            and check mappings"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
     pdg_in = 25
 
     call reset_interaction_counter ()
 
     call beam_data%init_sqrts (1000._default, [flv, flv])
 
     allocate (sf_test_data_t :: data_strfun)
     select type (data_strfun)
     type is (sf_test_data_t)
        call data_strfun%init (model, pdg_in)
     end select
 
     write (u, "(A)")  "* Set up chain with structure function pair &
          &and standard mapping"
     write (u, "(A)")
 
     allocate (sf_config (2))
     call sf_config(1)%init ([1], data_strfun)
     call sf_config(2)%init ([2], data_strfun)
     call sf_chain%init (beam_data, sf_config)
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
 
     call sf_channel(1)%init (2)
     call sf_channel(1)%set_s_mapping ([1,2])
     call sf_chain_instance%set_channel (1, sf_channel(1))
 
     call sf_chain_instance%link_interactions ()
     sf_chain_instance%status = SF_DONE_CONNECTIONS
     call sf_chain_instance%compute_kinematics (1, [0.8_default, 0.6_default])
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Invert the kinematics calculation"
     write (u, "(A)")
 
     x_saved = sf_chain_instance%x
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
 
     call sf_channel(2)%init (2)
     call sf_channel(2)%set_s_mapping ([1, 2])
     call sf_chain_instance%set_channel (1, sf_channel(2))
 
     call sf_chain_instance%link_interactions ()
     sf_chain_instance%status = SF_DONE_CONNECTIONS
     call sf_chain_instance%inverse_kinematics (x_saved, 1 - x_saved)
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
 
     call sf_chain_instance%final ()
     call sf_chain%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_10"
 
   end subroutine sf_base_10
 
 @ %def sf_base_10
 @
 \subsubsection{Structure function chain evaluation}
 Here, we test the complete workflow for structure-function chains.
 First, we create the template chain, then initialize an instance.  We
 set up links, mask, and evaluators.  Finally, we set kinematics and
 evaluate the matrix elements and their products.
 <<SF base: execute tests>>=
   call test (sf_base_11, "sf_base_11", &
        "structure function chain evaluation", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_11
 <<SF base: tests>>=
   subroutine sf_base_11 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     type(beam_data_t), target :: beam_data
     class(sf_data_t), allocatable, target :: data_strfun
     class(sf_data_t), allocatable, target :: data_spectrum
     type(sf_config_t), dimension(:), allocatable, target :: sf_config
     type(sf_chain_t), target :: sf_chain
     type(sf_chain_instance_t), target :: sf_chain_instance
     type(sf_channel_t), dimension(2) :: sf_channel
     type(particle_set_t) :: pset
     type(interaction_t), pointer :: int
     logical :: ok
 
     write (u, "(A)")  "* Test output: sf_base_11"
     write (u, "(A)")  "*   Purpose: set up a structure-function chain"
     write (u, "(A)")  "*            create an instance and evaluate"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
     pdg_in = 25
 
     call reset_interaction_counter ()
 
     call beam_data%init_sqrts (1000._default, [flv, flv])
 
     allocate (sf_test_data_t :: data_strfun)
     select type (data_strfun)
     type is (sf_test_data_t)
        call data_strfun%init (model, pdg_in)
     end select
 
     allocate (sf_test_spectrum_data_t :: data_spectrum)
     select type (data_spectrum)
     type is (sf_test_spectrum_data_t)
        call data_spectrum%init (model, pdg_in, with_radiation=.true.)
     end select
 
     write (u, "(A)")  "* Set up chain with beams only"
     write (u, "(A)")
 
     call sf_chain%init (beam_data)
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
     call sf_chain_instance%link_interactions ()
     call sf_chain_instance%exchange_mask ()
     call sf_chain_instance%init_evaluators ()
 
     call sf_chain_instance%compute_kinematics (1, [real(default) ::])
     call sf_chain_instance%evaluate (scale=0._default)
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     int => sf_chain_instance%get_out_int_ptr ()
     call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
          [0._default, 0._default], .false., .true.)
     call sf_chain_instance%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Particle content:"
     write (u, "(A)")
 
     call write_separator (u)
     call pset%write (u)
     call write_separator (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover chain:"
     write (u, "(A)")
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
     call sf_chain_instance%link_interactions ()
     call sf_chain_instance%exchange_mask ()
     call sf_chain_instance%init_evaluators ()
 
     int => sf_chain_instance%get_out_int_ptr ()
     call pset%fill_interaction (int, 2, check_match=.false.)
 
     call sf_chain_instance%recover_kinematics (1)
     call sf_chain_instance%evaluate (scale=0._default)
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     call pset%final ()
     call sf_chain_instance%final ()
     call sf_chain%final ()
 
     write (u, "(A)")
     write (u, "(A)")
     write (u, "(A)")
     write (u, "(A)")  "* Set up chain with structure function"
     write (u, "(A)")
 
     allocate (sf_config (1))
     call sf_config(1)%init ([1], data_strfun)
     call sf_chain%init (beam_data, sf_config)
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
     call sf_channel(1)%init (1)
     call sf_channel(1)%activate_mapping ([1])
     call sf_chain_instance%set_channel (1, sf_channel(1))
     call sf_chain_instance%link_interactions ()
     call sf_chain_instance%exchange_mask ()
     call sf_chain_instance%init_evaluators ()
 
     call sf_chain_instance%compute_kinematics (1, [0.8_default])
     call sf_chain_instance%evaluate (scale=0._default)
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     int => sf_chain_instance%get_out_int_ptr ()
     call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
          [0._default, 0._default], .false., .true.)
     call sf_chain_instance%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Particle content:"
     write (u, "(A)")
 
     call write_separator (u)
     call pset%write (u)
     call write_separator (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover chain:"
     write (u, "(A)")
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
     call sf_channel(1)%init (1)
     call sf_channel(1)%activate_mapping ([1])
     call sf_chain_instance%set_channel (1, sf_channel(1))
     call sf_chain_instance%link_interactions ()
     call sf_chain_instance%exchange_mask ()
     call sf_chain_instance%init_evaluators ()
 
     int => sf_chain_instance%get_out_int_ptr ()
     call pset%fill_interaction (int, 2, check_match=.false.)
 
     call sf_chain_instance%recover_kinematics (1)
     call sf_chain_instance%evaluate (scale=0._default)
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     call pset%final ()
     call sf_chain_instance%final ()
     call sf_chain%final ()
 
     write (u, "(A)")
     write (u, "(A)")
     write (u, "(A)")
     write (u, "(A)")  "* Set up chain with spectrum and structure function"
     write (u, "(A)")
 
     deallocate (sf_config)
     allocate (sf_config (2))
     call sf_config(1)%init ([1,2], data_spectrum)
     call sf_config(2)%init ([2], data_strfun)
     call sf_chain%init (beam_data, sf_config)
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
     call sf_channel(2)%init (2)
     call sf_channel(2)%activate_mapping ([2])
     call sf_chain_instance%set_channel (1, sf_channel(2))
     call sf_chain_instance%link_interactions ()
     call sf_chain_instance%exchange_mask ()
     call sf_chain_instance%init_evaluators ()
 
     call sf_chain_instance%compute_kinematics &
          (1, [0.5_default, 0.6_default, 0.8_default])
     call sf_chain_instance%evaluate (scale=0._default)
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     int => sf_chain_instance%get_out_int_ptr ()
     call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
          [0._default, 0._default], .false., .true.)
     call sf_chain_instance%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Particle content:"
     write (u, "(A)")
 
     call write_separator (u)
     call pset%write (u)
     call write_separator (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover chain:"
     write (u, "(A)")
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
     call sf_channel(2)%init (2)
     call sf_channel(2)%activate_mapping ([2])
     call sf_chain_instance%set_channel (1, sf_channel(2))
     call sf_chain_instance%link_interactions ()
     call sf_chain_instance%exchange_mask ()
     call sf_chain_instance%init_evaluators ()
 
     int => sf_chain_instance%get_out_int_ptr ()
     call pset%fill_interaction (int, 2, check_match=.false.)
 
     call sf_chain_instance%recover_kinematics (1)
     call sf_chain_instance%evaluate (scale=0._default)
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     call pset%final ()
     call sf_chain_instance%final ()
     call sf_chain%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_11"
 
   end subroutine sf_base_11
 
 @ %def sf_base_11
 @
 \subsubsection{Multichannel case}
 We set up a structure-function chain as before, but with three
 different parameterizations.  The first instance is without mappings,
 the second one with single-particle mappings, and the third one with
 two-particle mappings.
 <<SF base: execute tests>>=
   call test (sf_base_12, "sf_base_12", &
        "multi-channel structure function chain", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_12
 <<SF base: tests>>=
   subroutine sf_base_12 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     type(beam_data_t), target :: beam_data
     class(sf_data_t), allocatable, target :: data
     type(sf_config_t), dimension(:), allocatable, target :: sf_config
     type(sf_chain_t), target :: sf_chain
     type(sf_chain_instance_t), target :: sf_chain_instance
     real(default), dimension(2) :: x_saved
     real(default), dimension(2,3) :: p_saved
     type(sf_channel_t), dimension(:), allocatable :: sf_channel
 
     write (u, "(A)")  "* Test output: sf_base_12"
     write (u, "(A)")  "*   Purpose: set up and evaluate a multi-channel &
          &structure-function chain"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
     pdg_in = 25
 
     call reset_interaction_counter ()
 
     call beam_data%init_sqrts (1000._default, [flv, flv])
 
     allocate (sf_test_data_t :: data)
     select type (data)
     type is (sf_test_data_t)
        call data%init (model, pdg_in)
     end select
 
     write (u, "(A)")  "* Set up chain with structure function pair &
          &and three different mappings"
     write (u, "(A)")
 
     allocate (sf_config (2))
     call sf_config(1)%init ([1], data)
     call sf_config(2)%init ([2], data)
     call sf_chain%init (beam_data, sf_config)
 
     call sf_chain_instance%init (sf_chain, n_channel = 3)
 
     call allocate_sf_channels (sf_channel, n_channel = 3, n_strfun = 2)
 
     ! channel 1: no mapping
     call sf_chain_instance%set_channel (1, sf_channel(1))
 
     ! channel 2: single-particle mappings
     call sf_channel(2)%activate_mapping ([1,2])
     ! call sf_chain_instance%activate_mapping (2, [1,2])
     call sf_chain_instance%set_channel (2, sf_channel(2))
 
     ! channel 3: two-particle mapping
     call sf_channel(3)%set_s_mapping ([1,2])
     ! call sf_chain_instance%set_s_mapping (3, [1, 2])
     call sf_chain_instance%set_channel (3, sf_channel(3))
 
     call sf_chain_instance%link_interactions ()
     call sf_chain_instance%exchange_mask ()
     call sf_chain_instance%init_evaluators ()
 
     write (u, "(A)")  "* Compute kinematics in channel 1 and evaluate"
     write (u, "(A)")
 
     call sf_chain_instance%compute_kinematics (1, [0.8_default, 0.6_default])
     call sf_chain_instance%evaluate (scale=0._default)
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Invert the kinematics calculation"
     write (u, "(A)")
 
     x_saved = sf_chain_instance%x
 
     call sf_chain_instance%inverse_kinematics (x_saved, 1 - x_saved)
     call sf_chain_instance%evaluate (scale=0._default)
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute kinematics in channel 2 and evaluate"
     write (u, "(A)")
 
     p_saved = sf_chain_instance%p
 
     call sf_chain_instance%compute_kinematics (2, p_saved(:,2))
     call sf_chain_instance%evaluate (scale=0._default)
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute kinematics in channel 3 and evaluate"
     write (u, "(A)")
 
     call sf_chain_instance%compute_kinematics (3, p_saved(:,3))
     call sf_chain_instance%evaluate (scale=0._default)
 
     call write_separator (u, 2)
     call sf_chain_instance%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_chain_instance%final ()
     call sf_chain%final ()
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_12"
 
   end subroutine sf_base_12
 
 @ %def sf_base_12
 @
 \subsubsection{Generated spectrum}
 Construct and evaluate a structure function object for a pair spectrum
 which is evaluated as a beam-event generator.
 <<SF base: execute tests>>=
   call test (sf_base_13, "sf_base_13", &
        "pair spectrum generator", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_13
 <<SF base: tests>>=
   subroutine sf_base_13 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t), dimension(2) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f, x_free
 
     write (u, "(A)")  "* Test output: sf_base_13"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &a pair generator object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
     pdg_in = 25
 
     call reset_interaction_counter ()
 
     allocate (sf_test_generator_data_t :: data)
     select type (data)
     type is (sf_test_generator_data_t)
        call data%init (model, pdg_in)
     end select
 
     write (u, "(A)")  "* Initialize generator object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     write (u, "(A)")  "* Generate free r values"
     write (u, "(A)")
 
     x_free = 1
     call sf_int%generate_free (r, rb, x_free)
 
     write (u, "(A)")  "* Initialize incoming momenta with sqrts=1000"
 
     E = 500
     k(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     k(2) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call sf_int%seed_kinematics (k)
 
     write (u, "(A)")
     write (u, "(A)")  "* Complete kinematics"
     write (u, "(A)")
 
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
     write (u, "(A,9(1x,F10.7))")  "xf=", x_free
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call reset_interaction_counter ()
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
 
     call sf_int%seed_kinematics (k)
     call sf_int%set_momenta (q, outgoing=.true.)
     x_free = 1
     call sf_int%recover_x (x, xb, x_free)
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "xf=", x_free
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute inverse kinematics &
          &and evaluate"
     write (u, "(A)")
 
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%apply (scale=0._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_13"
 
   end subroutine sf_base_13
 
 @ %def sf_base_13
 @
 \subsubsection{Structure function chain evaluation}
 Here, we test the complete workflow for a structure-function chain
 with generator.  First, we create the template chain, then initialize
 an instance.  We set up links, mask, and evaluators.  Finally, we set
 kinematics and evaluate the matrix elements and their products.
 <<SF base: execute tests>>=
   call test (sf_base_14, "sf_base_14", &
        "structure function generator evaluation", &
        u, results)
 <<SF base: test declarations>>=
   public :: sf_base_14
 <<SF base: tests>>=
   subroutine sf_base_14 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     type(beam_data_t), target :: beam_data
     class(sf_data_t), allocatable, target :: data_strfun
     class(sf_data_t), allocatable, target :: data_generator
     type(sf_config_t), dimension(:), allocatable, target :: sf_config
     real(default), dimension(:), allocatable :: p_in
     type(sf_chain_t), target :: sf_chain
     type(sf_chain_instance_t), target :: sf_chain_instance
 
     write (u, "(A)")  "* Test output: sf_base_14"
     write (u, "(A)")  "*   Purpose: set up a structure-function chain"
     write (u, "(A)")  "*            create an instance and evaluate"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
     pdg_in = 25
 
     call reset_interaction_counter ()
 
     call beam_data%init_sqrts (1000._default, [flv, flv])
 
     allocate (sf_test_data_t :: data_strfun)
     select type (data_strfun)
     type is (sf_test_data_t)
        call data_strfun%init (model, pdg_in)
     end select
 
     allocate (sf_test_generator_data_t :: data_generator)
     select type (data_generator)
     type is (sf_test_generator_data_t)
        call data_generator%init (model, pdg_in)
     end select
 
     write (u, "(A)")  "* Set up chain with generator and structure function"
     write (u, "(A)")
 
     allocate (sf_config (2))
     call sf_config(1)%init ([1,2], data_generator)
     call sf_config(2)%init ([2], data_strfun)
     call sf_chain%init (beam_data, sf_config)
 
     call sf_chain_instance%init (sf_chain, n_channel = 1)
     call sf_chain_instance%link_interactions ()
     call sf_chain_instance%exchange_mask ()
     call sf_chain_instance%init_evaluators ()
 
     write (u, "(A)")  "* Inject integration parameter"
     write (u, "(A)")
 
     allocate (p_in (sf_chain%get_n_bound ()), source = 0.9_default)
     write (u, "(A,9(1x,F10.7))")  "p_in =", p_in
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate"
     write (u, "(A)")
 
     call sf_chain_instance%compute_kinematics (1, p_in)
     call sf_chain_instance%evaluate (scale=0._default)
 
     call sf_chain_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract integration parameter"
     write (u, "(A)")
 
     call sf_chain_instance%get_mcpar (1, p_in)
     write (u, "(A,9(1x,F10.7))")  "p_in =", p_in
 
     call sf_chain_instance%final ()
     call sf_chain%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_base_14"
 
   end subroutine sf_base_14
 
 @ %def sf_base_14
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Photon radiation: ISR}
 
 <<[[sf_isr.f90]]>>=
 <<File header>>
 
 module sf_isr
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use constants, only: pi
   use format_defs, only: FMT_15, FMT_19
   use numeric_utils
   use diagnostics
   use physics_defs, only: PHOTON
   use lorentz
   use sm_physics, only: Li2
   use pdg_arrays
   use model_data
   use flavors
   use colors
   use quantum_numbers
   use polarizations
   use sf_aux
   use sf_mappings
   use sf_base
   use electron_pdfs
 
 <<Standard module head>>
 
 <<SF isr: public>>
 
 <<SF isr: parameters>>
 
 <<SF isr: types>>
 
 contains
 
 <<SF isr: procedures>>
 
 end module sf_isr
 @ %def sf_isr
 @
 \subsection{Physics}
 The ISR structure function is in the most crude approximation (LLA
 without $\alpha$ corrections, i.e. $\epsilon^0$)
 \begin{equation}
   f_0(x) = \epsilon (1-x)^{-1+\epsilon} \qquad\text{with}\qquad
   \epsilon = \frac{\alpha}{\pi}q_e^2\ln\frac{s}{m^2},
 \end{equation}
 where $m$ is the mass of the incoming (and outgoing) particle, which
 is initially assumed on-shell.
 
 In $f_0(x)$, there is an integrable singularity at $x=1$ which does
 not spoil the integration, but would lead to an unbounded $f_{\rm
 max}$.  Therefore, we map this singularity like
 \begin{equation}\label{ISR-mapping}
   x = 1 - (1-x')^{1/\epsilon}
 \end{equation}
 such that
 \begin{equation}
   \int dx\,f_0(x) = \int dx'
 \end{equation}
 
 For the detailed form of the QED ISR structure function
 cf. Chap.~\ref{chap:qed_pdf}.
 
 \subsection{Implementation}
 
 In the concrete implementation, the zeroth order mapping
 (\ref{ISR-mapping}) is implemented, and the Jacobian is equal to
 $f_i(x)/f_0(x)$.  This can be written as
 \begin{align}
   \frac{f_0(x)}{f_0(x)} &= 1 \\
   \frac{f_1(x)}{f_0(x)} &= 1 + \frac34\epsilon - \frac{1-x^2}{2(1-x')} \\
 \begin{split}\label{ISR-f2}
   \frac{f_2(x)}{f_0(x)} &= 1 + \frac34\epsilon
     + \frac{27 - 8\pi^2}{96}\epsilon^2
     - \frac{1-x^2}{2(1-x')} \\
   &\quad - \frac{(1+3x^2)\ln x
     + (1-x)\left(4(1+x)\ln(1-x) + 5 + x\right)}{8(1-x')}\epsilon
 \end{split}
 \end{align}
 %'
 For $x=1$ (i.e., numerically indistinguishable from $1$), this reduces to
 \begin{align}
   \frac{f_0(x)}{f_0(x)} &= 1 \\
   \frac{f_1(x)}{f_0(x)} &= 1 + \frac34\epsilon \\
   \frac{f_2(x)}{f_0(x)} &= 1 + \frac34\epsilon
     + \frac{27 - 8\pi^2}{96}\epsilon^2
 \end{align}
 The last line in (\ref{ISR-f2}) is zero for
 \begin{equation}
   x_{\rm min} = 0.00714053329734592839549879772019
 \end{equation}
 (Mathematica result), independent of $\epsilon$.  For $x$ values less
 than this we ignore this correction because of the logarithmic
 singularity which should in principle be resummed.
 
 
 \subsection{The ISR data block}
 <<SF isr: public>>=
   public :: isr_data_t
 <<SF isr: types>>=
   type, extends (sf_data_t) :: isr_data_t
      private
      class(model_data_t), pointer :: model => null ()
      type(flavor_t), dimension(:), allocatable :: flv_in
      type(qed_pdf_t) :: pdf
      real(default) :: alpha = 0
      real(default) :: q_max = 0
      real(default) :: real_mass = 0
      real(default) :: mass = 0
      real(default) :: eps = 0
      real(default) :: log = 0
      logical :: recoil = .false.
      logical :: keep_energy = .true.
      integer :: order = 3
      integer :: error = NONE
    contains
    <<SF isr: isr data: TBP>>
   end type isr_data_t
 
 @ %def isr_data_t
 @ Error codes
 <<SF isr: parameters>>=
   integer, parameter :: NONE = 0
   integer, parameter :: ZERO_MASS = 1
   integer, parameter :: Q_MAX_TOO_SMALL = 2
   integer, parameter :: EPS_TOO_LARGE = 3
   integer, parameter :: INVALID_ORDER = 4
   integer, parameter :: CHARGE_MIX = 5
   integer, parameter :: CHARGE_ZERO = 6
   integer, parameter :: MASS_MIX = 7
 @ Generate flavor-dependent ISR data:
 <<SF isr: isr data: TBP>>=
   procedure :: init => isr_data_init
 <<SF isr: procedures>>=
   subroutine isr_data_init (data, model, pdg_in, alpha, q_max, &
        mass, order, recoil, keep_energy)
     class(isr_data_t), intent(out) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), intent(in) :: pdg_in
     real(default), intent(in) :: alpha
     real(default), intent(in) :: q_max
     real(default), intent(in), optional :: mass
     integer, intent(in), optional :: order
     logical, intent(in), optional :: recoil
     logical, intent(in), optional :: keep_energy
     integer :: i, n_flv
     real(default) :: charge
     data%model => model
     n_flv = pdg_array_get_length (pdg_in)
     allocate (data%flv_in (n_flv))
     do i = 1, n_flv
        call data%flv_in(i)%init (pdg_array_get (pdg_in, i), model)
     end do
     data%alpha = alpha
     data%q_max = q_max
     if (present (order)) then
        call data%set_order (order)
     end if
     if (present (recoil)) then
        data%recoil = recoil
     end if
     if (present (keep_energy)) then
        data%keep_energy = keep_energy
     end if
     data%real_mass = data%flv_in(1)%get_mass ()
     if (present (mass)) then
        if (mass > 0) then
           data%mass = mass
        else
           data%mass = data%real_mass
           if (any (data%flv_in%get_mass () /= data%mass)) then
              data%error = MASS_MIX;  return
           end if
        end if
     else
        data%mass = data%real_mass
        if (any (data%flv_in%get_mass () /= data%mass)) then
           data%error = MASS_MIX;  return
        end if
     end if
     if (vanishes (data%mass)) then
        data%error = ZERO_MASS;  return
     else if (data%mass >= data%q_max) then
        data%error = Q_MAX_TOO_SMALL;  return
     end if
     data%log = log (1 + (data%q_max / data%mass)**2)
     charge = data%flv_in(1)%get_charge ()
     if (any (abs (data%flv_in%get_charge ()) /= abs (charge))) then
        data%error = CHARGE_MIX;  return
     else if (charge == 0) then
        data%error = CHARGE_ZERO;  return
     end if
     data%eps = data%alpha / pi * charge ** 2 &
          * (2 * log (data%q_max / data%mass) - 1)
     if (data%eps > 1) then
        data%error = EPS_TOO_LARGE;  return
     end if
     call data%pdf%init &
          (data%mass, data%alpha, charge, data%q_max, data%order)
   end subroutine isr_data_init
 
 @ %def isr_data_init
 @ Explicitly set ISR order
 <<SF isr: isr data: TBP>>=
   procedure :: set_order => isr_data_set_order
 <<SF isr: procedures>>=
   elemental subroutine isr_data_set_order (data, order)
     class(isr_data_t), intent(inout) :: data
     integer, intent(in) :: order
     if (order < 0 .or. order > 3) then
        data%error = INVALID_ORDER
     else
        data%order = order
     end if
   end subroutine isr_data_set_order
 
 @ %def isr_data_set_order
 @ Handle error conditions.  Should always be done after
 initialization, unless we are sure everything is ok.
 <<SF isr: isr data: TBP>>=
   procedure :: check => isr_data_check
 <<SF isr: procedures>>=
   subroutine isr_data_check (data)
     class(isr_data_t), intent(in) :: data
     select case (data%error)
     case (ZERO_MASS)
        call msg_fatal ("ISR: Particle mass is zero")
     case (Q_MAX_TOO_SMALL)
        call msg_fatal ("ISR: Particle mass exceeds Qmax")
     case (EPS_TOO_LARGE)
        call msg_fatal ("ISR: Expansion parameter too large, " // &
             "perturbative expansion breaks down")
     case (INVALID_ORDER)
        call msg_error ("ISR: LLA order invalid (valid values are 0,1,2,3)")
     case (MASS_MIX)
        call msg_fatal ("ISR: Incoming particle masses must be uniform")
     case (CHARGE_MIX)
        call msg_fatal ("ISR: Incoming particle charges must be uniform")
     case (CHARGE_ZERO)
        call msg_fatal ("ISR: Incoming particle must be charged")
     end select
   end subroutine isr_data_check
 
 @ %def isr_data_check
 @ Output
 <<SF isr: isr data: TBP>>=
   procedure :: write => isr_data_write
 <<SF isr: procedures>>=
   subroutine isr_data_write (data, unit, verbose)
     class(isr_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)") "ISR data:"
     if (allocated (data%flv_in)) then
        write (u, "(3x,A)", advance="no") "  flavor =  "
        do i = 1, size (data%flv_in)
           if (i > 1)  write (u, "(',',1x)", advance="no")
           call data%flv_in(i)%write (u)
        end do
        write (u, *)
        write (u, "(3x,A," // FMT_19 // ")") "  alpha    = ", data%alpha
        write (u, "(3x,A," // FMT_19 // ")") "  q_max    = ", data%q_max
        write (u, "(3x,A," // FMT_19 // ")") "  mass     = ", data%mass
        write (u, "(3x,A," // FMT_19 // ")") "  eps      = ", data%eps
        write (u, "(3x,A," // FMT_19 // ")") "  log      = ", data%log
        write (u, "(3x,A,I2)")      "  order    = ", data%order
        write (u, "(3x,A,L2)")      "  recoil   = ", data%recoil
        write (u, "(3x,A,L2)")      "  keep en. = ", data%keep_energy
     else
        write (u, "(3x,A)") "[undefined]"
     end if
   end subroutine isr_data_write
 
 @ %def isr_data_write
 @ For ISR, there is the option to generate transverse momentum is
 generated. Hence, there can be up to three parameters, $x$, and two
 angles.
 <<SF isr: isr data: TBP>>=
   procedure :: get_n_par => isr_data_get_n_par
 <<SF isr: procedures>>=
   function isr_data_get_n_par (data) result (n)
     class(isr_data_t), intent(in) :: data
     integer :: n
     if (data%recoil) then
        n = 3
     else
        n = 1
     end if
   end function isr_data_get_n_par
 
 @ %def isr_data_get_n_par
 @ Return the outgoing particles PDG codes.  For ISR, these are
 identical to the incoming particles.
 <<SF isr: isr data: TBP>>=
   procedure :: get_pdg_out => isr_data_get_pdg_out
 <<SF isr: procedures>>=
   subroutine isr_data_get_pdg_out (data, pdg_out)
     class(isr_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     pdg_out(1) = data%flv_in%get_pdg ()
   end subroutine isr_data_get_pdg_out
 
 @ %def isr_data_get_pdg_out
 @ Return the [[eps]] value.  We need it for an appropriate mapping of
 structure-function parameters.
 <<SF isr: isr data: TBP>>=
   procedure :: get_eps => isr_data_get_eps
 <<SF isr: procedures>>=
   function isr_data_get_eps (data) result (eps)
     class(isr_data_t), intent(in) :: data
     real(default) :: eps
     eps = data%eps
   end function isr_data_get_eps
 
 @ %def isr_data_get_eps
 @ Allocate the interaction record.
 <<SF isr: isr data: TBP>>=
   procedure :: allocate_sf_int => isr_data_allocate_sf_int
 <<SF isr: procedures>>=
   subroutine isr_data_allocate_sf_int (data, sf_int)
     class(isr_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (isr_t :: sf_int)
   end subroutine isr_data_allocate_sf_int
 
 @ %def isr_data_allocate_sf_int
 @
 \subsection{The ISR object}
 The [[isr_t]] data type is a $1\to 2$ interaction, i.e., we allow for
 single-photon emission only (but use the multi-photon resummed
 radiator function).  The particles are ordered as (incoming, photon,
 outgoing).
 
 There is no need to handle several flavors (and data blocks) in
 parallel, since ISR is always applied immediately after beam
 collision.  (ISR for partons is accounted for by the PDFs themselves.)
 Polarization is carried through, i.e., we retain the polarization of
 the incoming particle and treat the emitted photon as unpolarized.
 Color is trivially carried through.  This implies that particles 1 and
 3 should be locked together. For ISR we don't need the q variable.
 <<SF isr: public>>=
   public :: isr_t
 <<SF isr: types>>=
   type, extends (sf_int_t) :: isr_t
      private
      type(isr_data_t), pointer :: data => null ()
      real(default) :: x = 0
      real(default) :: xb= 0
    contains
    <<SF isr: isr: TBP>>
   end type isr_t
 
 @ %def isr_t
 @ Type string: has to be here, but there is no string variable on which ISR
 depends. Hence, a dummy routine.
 <<SF isr: isr: TBP>>=
   procedure :: type_string => isr_type_string
 <<SF isr: procedures>>=
   function isr_type_string (object) result (string)
     class(isr_t), intent(in) :: object
     type(string_t) :: string
     if (associated (object%data)) then
        string = "ISR: e+ e- ISR spectrum"
     else
        string = "ISR: [undefined]"
     end if
   end function isr_type_string
 
 @ %def isr_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF isr: isr: TBP>>=
   procedure :: write => isr_write
 <<SF isr: procedures>>=
   subroutine isr_write (object, unit, testflag)
     class(isr_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        if (object%status >= SF_DONE_KINEMATICS) then
           write (u, "(1x,A)")  "SF parameters:"
           write (u, "(3x,A," // FMT_15 // ")")  "x =", object%x
           write (u, "(3x,A," // FMT_15 // ")")  "xb=", object%xb
        end if
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "ISR data: [undefined]"
     end if
   end subroutine isr_write
 
 @ %def isr_write
 @ Explicitly set ISR order (for unit test).
 <<SF isr: isr: TBP>>=
   procedure :: set_order => isr_set_order
 <<SF isr: procedures>>=
   subroutine isr_set_order (object, order)
     class(isr_t), intent(inout) :: object
     integer, intent(in) :: order
     call object%data%set_order (order)
     call object%data%pdf%set_order (order)
   end subroutine isr_set_order
 
 @ %def isr_set_order
 @
 \subsection{Kinematics}
 Set kinematics.  If [[map]] is unset, the $r$ and $x$ values
 coincide, and the Jacobian $f(r)$ were trivial. The ISR structure
 function allows for a straightforward mapping of the unit interval.
 So, to leading order, the structure function value is unity, but the
 $x$ value is transformed.  Higher orders affect the function value.
 
 The structure function implementation applies the above mapping to the
 input (random) number [[r]] to generate the momentum fraction [[x]]
 and the function value [[f]].  For numerical stability reasons, we
 also output [[xb]], which is $\bar x=1-x$.
 
 For the ISR structure function, the mapping Jacobian cancels the
 structure function (to order zero).  We apply the cancellation
 explicitly, therefore both the Jacobian [[f]] and the zeroth-order value
 (see the [[apply]] method) are unity if mapping is turned on.  If
 mapping is turned off, the Jacobian [[f]] includes the value of the
 (zeroth-order) structure function, and strongly peaked.
 <<SF isr: isr: TBP>>=
   procedure :: complete_kinematics => isr_complete_kinematics
 <<SF isr: procedures>>=
   subroutine isr_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(isr_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     real(default) :: eps
     eps = sf_int%data%eps
     if (map) then
        call map_power_1 (sf_int%xb, f, rb(1), eps)
     else
        sf_int%xb = rb(1)
        if (rb(1) > 0) then
           f = 1
        else
           f = 0
        end if
     end if
     sf_int%x = 1 - sf_int%xb
     x(1) = sf_int%x
     xb(1) = sf_int%xb
     if (size (x) == 3) then
        x(2:3) = r(2:3)
        xb(2:3) = rb(2:3)
     end if
     call sf_int%split_momentum (x, xb)
     select case (sf_int%status)
     case (SF_FAILED_KINEMATICS)
        sf_int%x = 0
        sf_int%xb= 0
        f = 0
     end select
   end subroutine isr_complete_kinematics
 
 @ %def isr_complete_kinematics
 @ Overriding the default method: we compute the [[x]] array from the
 momentum configuration.  In the specific case of ISR, we also set the
 internally stored $x$ and $\bar x$ values, so they can be used in the
 following routine.
 <<SF isr: isr: TBP>>=
   procedure :: recover_x => sf_isr_recover_x
 <<SF isr: procedures>>=
   subroutine sf_isr_recover_x (sf_int, x, xb, x_free)
     class(isr_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(inout), optional :: x_free
     call sf_int%base_recover_x (x, xb, x_free)
     sf_int%x  = x(1)
     sf_int%xb = xb(1)
   end subroutine sf_isr_recover_x
 
 @ %def sf_isr_recover_x
 @ Compute inverse kinematics.  Here, we start with the $x$ array and
 compute the ``input'' $r$ values and the Jacobian $f$.  After this, we
 can set momenta by the same formula as for normal kinematics.
 
 For extracting $x$, we rely on the stored $\bar x$ value, since the
 $x$ value in the argument is likely imprecise.  This means that either
 [[complete_kinematics]] or [[recover_x]] must be called first, for the
 current sampling point (but maybe another channel).
 <<SF isr: isr: TBP>>=
   procedure :: inverse_kinematics => isr_inverse_kinematics
 <<SF isr: procedures>>=
   subroutine isr_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(isr_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     real(default) :: eps
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     eps = sf_int%data%eps
     if (map) then
        call map_power_inverse_1 (xb(1), f, rb(1), eps)
     else
        rb(1) = xb(1)
        if (rb(1) > 0) then
           f = 1
        else
           f = 0
        end if
     end if
     r(1) = 1 - rb(1)
     if (size(r) == 3) then
        r(2:3) = x(2:3)
        rb(2:3)= xb(2:3)
     end if
     if (set_mom) then
        call sf_int%split_momentum (x, xb)
        select case (sf_int%status)
        case (SF_FAILED_KINEMATICS)
           r = 0
           rb= 0
           f = 0
        end select
     end if
   end subroutine isr_inverse_kinematics
 
 @ %def isr_inverse_kinematics
 @
 <<SF isr: isr: TBP>>=
   procedure :: init => isr_init
 <<SF isr: procedures>>=
   subroutine isr_init (sf_int, data)
     class(isr_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     type(quantum_numbers_mask_t), dimension(3) :: mask
     integer, dimension(3) :: hel_lock
     type(polarization_t), target :: pol
     type(quantum_numbers_t), dimension(1) :: qn_fc
     type(flavor_t) :: flv_photon
     type(color_t) :: col_photon
     type(quantum_numbers_t) :: qn_hel, qn_photon, qn
     type(polarization_iterator_t) :: it_hel
     real(default) :: m2
     integer :: i
     mask = quantum_numbers_mask (.false., .false., &
          mask_h = [.false., .true., .false.])
     hel_lock = [3, 0, 1]
     select type (data)
     type is (isr_data_t)
        m2 = data%mass**2
        call sf_int%base_init (mask, [m2], [0._default], [m2], &
             hel_lock = hel_lock)
        sf_int%data => data
        call flv_photon%init (PHOTON, data%model)
        call col_photon%init ()
        call qn_photon%init (flv_photon, col_photon)
        call qn_photon%tag_radiated ()
        do i = 1, size (data%flv_in)
           call pol%init_generic (data%flv_in(i))
           call qn_fc(1)%init (&
                flv = data%flv_in(i), &
                col = color_from_flavor (data%flv_in(i), 1))
           call it_hel%init (pol)
           do while (it_hel%is_valid ())
              qn_hel = it_hel%get_quantum_numbers ()
              qn = qn_hel .merge. qn_fc(1)
              call sf_int%add_state ([qn, qn_photon, qn])
              call it_hel%advance ()
           end do
           ! call pol%final ()  !!! Obsolete
        end do
        call sf_int%freeze ()
        if (data%keep_energy) then
           sf_int%on_shell_mode = KEEP_ENERGY
        else
           sf_int%on_shell_mode = KEEP_MOMENTUM
        end if
        call sf_int%set_incoming ([1])
        call sf_int%set_radiated ([2])
        call sf_int%set_outgoing ([3])
        sf_int%status = SF_INITIAL
     end select
   end subroutine isr_init
 
 @ %def isr_init
 @
 \subsection{ISR application}
 For ISR, we could in principle compute kinematics and function value
 in a single step. In order to be able to reweight matrix elements
 including structure functions we split kinematics and structure
 function calculation. The structure function works on a single beam,
 assuming that the input momentum has been set.
 
 For the structure-function evaluation, we rely on the fact that the
 power mapping, which we apply in the kinematics method (if the [[map]]
 flag is set), has a Jacobian which is just the inverse lowest-order
 structure function.  With mapping active, the two should cancel
 exactly.
 
 After splitting momenta, we set the outgoing momenta on-shell.  We
 choose to conserve momentum, so energy conservation may be violated.
 <<SF isr: isr: TBP>>=
   procedure :: apply => isr_apply
 <<SF isr: procedures>>=
   subroutine isr_apply (sf_int, scale, rescale, i_sub)
     class(isr_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     real(default) :: f, finv, x, xb, eps, rb
     real(default) :: log_x, log_xb, x_2
     associate (data => sf_int%data)
       eps = sf_int%data%eps
       x = sf_int%x
       xb = sf_int%xb
       call map_power_inverse_1 (xb, finv, rb, eps)
       if (finv > 0) then
          f = 1 / finv
       else
          f = 0
       end if
       call data%pdf%evolve_qed_pdf (x, xb, rb, f)
     end associate
     call sf_int%set_matrix_element (cmplx (f, kind=default))
     sf_int%status = SF_EVALUATED
   end subroutine isr_apply
 
 @ %def isr_apply
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_isr_ut.f90]]>>=
 <<File header>>
 
 module sf_isr_ut
   use unit_tests
   use sf_isr_uti
 
 <<Standard module head>>
 
 <<SF isr: public test>>
 
 contains
 
 <<SF isr: test driver>>
 
 end module sf_isr_ut
 @ %def sf_isr_ut
 @
 <<[[sf_isr_uti.f90]]>>=
 <<File header>>
 
 module sf_isr_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_defs, only: FMT_12
   use physics_defs, only: ELECTRON
   use lorentz
   use pdg_arrays
   use flavors
   use interactions, only: reset_interaction_counter
   use interactions, only: interaction_pacify_momenta
   use model_data
   use sf_aux, only: KEEP_ENERGY
   use sf_mappings
   use sf_base
 
   use sf_isr
 
 <<Standard module head>>
 
 <<SF isr: test declarations>>
 
 contains
 
 <<SF isr: tests>>
 
 end module sf_isr_uti
 @ %def sf_isr_ut
 @ API: driver for the unit tests below.
 <<SF isr: public test>>=
   public :: sf_isr_test
 <<SF isr: test driver>>=
   subroutine sf_isr_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF isr: execute tests>>
   end subroutine sf_isr_test
 
 @ %def sf_isr_test
 @
 \subsubsection{Test structure function data}
 Construct and display a test structure function data object.
 <<SF isr: execute tests>>=
   call test (sf_isr_1, "sf_isr_1", &
        "structure function configuration", &
        u, results)
 <<SF isr: test declarations>>=
   public :: sf_isr_1
 <<SF isr: tests>>=
   subroutine sf_isr_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(pdg_array_t), dimension(1) :: pdg_out
     integer, dimension(:), allocatable :: pdg1
     class(sf_data_t), allocatable :: data
 
     write (u, "(A)")  "* Test output: sf_isr_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &test structure function data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Create empty data object"
     write (u, "(A)")
 
     call model%init_qed_test ()
     pdg_in = ELECTRON
 
     allocate (isr_data_t :: data)
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     select type (data)
     type is (isr_data_t)
        call data%init (model, pdg_in, 1./137._default, 10._default, &
             0.000511_default, order = 3, recoil = .false.)
     end select
 
     call data%write (u)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     write (u, "(2x,99(1x,I0))")  pdg1
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_isr_1"
 
   end subroutine sf_isr_1
 
 @ %def sf_isr_1
 @
 \subsubsection{Structure function without mapping}
 Direct ISR evaluation.  This is the use case for a double-beam
 structure function.  The parameter pair is mapped in the calling program.
 <<SF isr: execute tests>>=
   call test (sf_isr_2, "sf_isr_2", &
        "no ISR mapping", &
        u, results)
 <<SF isr: test declarations>>=
   public :: sf_isr_2
 <<SF isr: tests>>=
   subroutine sf_isr_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(flavor_t) :: flv
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f, f_isr
 
     write (u, "(A)")  "* Test output: sf_isr_2"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     pdg_in = ELECTRON
     call flv%init (ELECTRON, model)
 
     call reset_interaction_counter ()
 
     allocate (isr_data_t :: data)
     select type (data)
     type is (isr_data_t)
        call data%init (model, pdg_in, 1./137._default, 500._default, &
             0.000511_default, order = 3, recoil = .false.)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call pacify (k, 1e-10_default)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for r=0.9, no ISR mapping, &
          &collinear"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = 0.9_default
     rb = 1 - r
     write (u, "(A,9(1x," // FMT_12 // "))")  "r =", r
     write (u, "(A,9(1x," // FMT_12 // "))")  "rb=", rb
 
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
 
     write (u, "(A)")
     write (u, "(A,9(1x," // FMT_12 // "))")  "x =", x
     write (u, "(A,9(1x," // FMT_12 // "))")  "xb=", xb
     write (u, "(A,9(1x," // FMT_12 // "))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Invert kinematics"
     write (u, "(A)")
 
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
     write (u, "(A,9(1x," // FMT_12 // "))")  "r =", r
     write (u, "(A,9(1x," // FMT_12 // "))")  "rb=", rb
     write (u, "(A,9(1x," // FMT_12 // "))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate ISR structure function"
     write (u, "(A)")
 
     call sf_int%apply (scale = 100._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Structure-function value, default order"
     write (u, "(A)")
 
     f_isr = sf_int%get_matrix_element (1)
 
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr         =", f_isr
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr * f_map =", f_isr * f
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-evaluate structure function, leading order"
     write (u, "(A)")
 
     select type (sf_int)
     type is (isr_t)
        call sf_int%set_order (0)
     end select
     call sf_int%apply (scale = 100._default)
     f_isr = sf_int%get_matrix_element (1)
 
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr         =", f_isr
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr * f_map =", f_isr * f
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_isr_2"
 
   end subroutine sf_isr_2
 
 @ %def sf_isr_2
 @
 \subsubsection{Structure function with mapping}
 Apply the optimal ISR mapping.  This is the use case for a single-beam
 structure function.
 <<SF isr: execute tests>>=
   call test (sf_isr_3, "sf_isr_3", &
        "ISR mapping", &
        u, results)
 <<SF isr: test declarations>>=
   public :: sf_isr_3
 <<SF isr: tests>>=
   subroutine sf_isr_3 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f, f_isr
 
     write (u, "(A)")  "* Test output: sf_isr_3"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     call flv%init (ELECTRON, model)
     pdg_in = ELECTRON
 
     call reset_interaction_counter ()
 
     allocate (isr_data_t :: data)
     select type (data)
     type is (isr_data_t)
        call data%init (model, pdg_in, 1./137._default, 500._default, &
             0.000511_default, order = 3, recoil = .false.)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call pacify (k, 1e-10_default)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for r=0.7, with ISR mapping, &
          &collinear"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = 0.7_default
     rb = 1 - r
     write (u, "(A,9(1x," // FMT_12 // "))")  "r =", r
     write (u, "(A,9(1x," // FMT_12 // "))")  "rb=", rb
 
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
 
     write (u, "(A)")
     write (u, "(A,9(1x," // FMT_12 // "))")  "x =", x
     write (u, "(A,9(1x," // FMT_12 // "))")  "xb=", xb
     write (u, "(A,9(1x," // FMT_12 // "))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Invert kinematics"
     write (u, "(A)")
 
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
     write (u, "(A,9(1x," // FMT_12 // "))")  "r =", r
     write (u, "(A,9(1x," // FMT_12 // "))")  "rb=", rb
     write (u, "(A,9(1x," // FMT_12 // "))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate ISR structure function"
     write (u, "(A)")
 
     call sf_int%apply (scale = 100._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Structure-function value, default order"
     write (u, "(A)")
 
     f_isr = sf_int%get_matrix_element (1)
 
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr         =", f_isr
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr * f_map =", f_isr * f
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-evaluate structure function, leading order"
     write (u, "(A)")
 
     select type (sf_int)
     type is (isr_t)
        call sf_int%set_order (0)
     end select
     call sf_int%apply (scale = 100._default)
     f_isr = sf_int%get_matrix_element (1)
 
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr         =", f_isr
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr * f_map =", f_isr * f
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_isr_3"
 
   end subroutine sf_isr_3
 
 @ %def sf_isr_3
 @
 \subsubsection{Non-collinear ISR splitting}
 Construct and display a structure function object based on the ISR
 structure function. We blank out numerical fluctuations for 32bit.
 <<SF isr: execute tests>>=
   call test (sf_isr_4, "sf_isr_4", &
        "ISR non-collinear", &
        u, results)
 <<SF isr: test declarations>>=
   public :: sf_isr_4
 <<SF isr: tests>>=
   subroutine sf_isr_4 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f, f_isr
     character(len=80) :: buffer
     integer :: u_scratch, iostat
 
     write (u, "(A)")  "* Test output: sf_isr_4"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     call flv%init (ELECTRON, model)
     pdg_in = ELECTRON
 
     call reset_interaction_counter ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     allocate (isr_data_t :: data)
     select type (data)
     type is (isr_data_t)
        call data%init (model, pdg_in, 1./137._default, 500._default, &
             0.000511_default, order = 3, recoil = .true.)
     end select
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call pacify (k, 1e-10_default)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5/0.5/0.25, with ISR mapping, "
     write (u, "(A)")  "          non-coll., keeping energy"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = [0.5_default, 0.5_default, 0.25_default]
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_ENERGY
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
     call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)
 
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
 
     call sf_int%seed_kinematics ([k])
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
 
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "r =", r
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate ISR structure function"
     write (u, "(A)")
 
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
     call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)
     call sf_int%apply (scale = 10._default)
     u_scratch = free_unit ()
     open (u_scratch, status="scratch", action = "readwrite")
     call sf_int%write (u_scratch, testflag = .true.)
     rewind (u_scratch)
     do
        read (u_scratch, "(A)", iostat=iostat) buffer
        if (iostat /= 0) exit
        if (buffer(1:25) == " P =   0.000000E+00  9.57") then
           buffer = replace (buffer, 26, "XXXX")
        end if
        if (buffer(1:25) == " P =   0.000000E+00 -9.57") then
           buffer = replace (buffer, 26, "XXXX")
        end if
        write (u, "(A)") buffer
     end do
     close (u_scratch)
 
     write (u, "(A)")
     write (u, "(A)")  "* Structure-function value"
     write (u, "(A)")
 
     f_isr = sf_int%get_matrix_element (1)
 
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr         =", f_isr
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr * f_map =", f_isr * f
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_isr_4"
 
   end subroutine sf_isr_4
 
 @ %def sf_isr_4
 @
 \subsubsection{Structure function pair with mapping}
 Apply the ISR mapping for a ISR pair.
 structure function.
 <<SF isr: execute tests>>=
   call test (sf_isr_5, "sf_isr_5", &
        "ISR pair mapping", &
        u, results)
 <<SF isr: test declarations>>=
   public :: sf_isr_5
 <<SF isr: tests>>=
   subroutine sf_isr_5 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_mapping_t), allocatable :: mapping
     class(sf_int_t), dimension(:), allocatable :: sf_int
     type(vector4_t), dimension(2) :: k
     real(default) :: E, f_map
     real(default), dimension(:), allocatable :: p, pb, r, rb, x, xb
     real(default), dimension(2) :: f, f_isr
     integer :: i
 
     write (u, "(A)")  "* Test output: sf_isr_5"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     call flv%init (ELECTRON, model)
     pdg_in = ELECTRON
 
     call reset_interaction_counter ()
 
     allocate (isr_data_t :: data)
     select type (data)
     type is (isr_data_t)
        call data%init (model, pdg_in, 1./137._default, 500._default, &
             0.000511_default, order = 3, recoil = .false.)
     end select
 
     allocate (sf_ip_mapping_t :: mapping)
     select type (mapping)
     type is (sf_ip_mapping_t)
        select type (data)
        type is (isr_data_t)
           call mapping%init (eps = data%get_eps ())
        end select
        call mapping%set_index (1, 1)
        call mapping%set_index (2, 2)
     end select
 
     call mapping%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     allocate (isr_t :: sf_int (2))
 
     do i = 1, 2
        call sf_int(i)%init (data)
        call sf_int(i)%set_beam_index ([i])
     end do
 
     write (u, "(A)")  "* Initialize incoming momenta with E=500"
     write (u, "(A)")
     E = 500
     k(1) = vector4_moving (E,   sqrt (E**2 - flv%get_mass ()**2), 3)
     k(2) = vector4_moving (E, - sqrt (E**2 - flv%get_mass ()**2), 3)
     call pacify (k, 1e-10_default)
     do i = 1, 2
        call vector4_write (k(i), u)
        call sf_int(i)%seed_kinematics (k(i:i))
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for p=[0.7,0.4], collinear"
     write (u, "(A)")
 
     allocate (p (2 * data%get_n_par ()))
     allocate (pb(size (p)))
     allocate (r (size (p)))
     allocate (rb(size (p)))
     allocate (x (size (p)))
     allocate (xb(size (p)))
 
     p = [0.7_default, 0.4_default]
     pb= 1 - p
     call mapping%compute (r, rb, f_map, p, pb)
 
     write (u, "(A,9(1x," // FMT_12 // "))")  "p =", p
     write (u, "(A,9(1x," // FMT_12 // "))")  "pb=", pb
     write (u, "(A,9(1x," // FMT_12 // "))")  "r =", r
     write (u, "(A,9(1x," // FMT_12 // "))")  "rb=", rb
     write (u, "(A,9(1x," // FMT_12 // "))")  "fm=", f_map
 
     do i = 1, 2
        call sf_int(i)%complete_kinematics (x(i:i), xb(i:i), f(i), r(i:i), rb(i:i), &
             map=.false.)
     end do
 
     write (u, "(A)")
     write (u, "(A,9(1x," // FMT_12 // "))")  "x =", x
     write (u, "(A,9(1x," // FMT_12 // "))")  "xb=", xb
     write (u, "(A,9(1x," // FMT_12 // "))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Invert kinematics"
     write (u, "(A)")
 
     do i = 1, 2
        call sf_int(i)%inverse_kinematics (x(i:i), xb(i:i), f(i), r(i:i), rb(i:i), &
             map=.false.)
     end do
     call mapping%inverse (r, rb, f_map, p, pb)
 
     write (u, "(A,9(1x," // FMT_12 // "))")  "p =", p
     write (u, "(A,9(1x," // FMT_12 // "))")  "pb=", pb
     write (u, "(A,9(1x," // FMT_12 // "))")  "r =", r
     write (u, "(A,9(1x," // FMT_12 // "))")  "rb=", rb
     write (u, "(A,9(1x," // FMT_12 // "))")  "fm=", f_map
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate ISR structure function"
 
     call sf_int(1)%apply (scale = 100._default)
     call sf_int(2)%apply (scale = 100._default)
 
     write (u, "(A)")
     write (u, "(A)")  "* Structure function #1"
     write (u, "(A)")
     call sf_int(1)%write (u, testflag = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Structure function #2"
     write (u, "(A)")
     call sf_int(2)%write (u, testflag = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Structure-function value, default order"
     write (u, "(A)")
 
     do i = 1, 2
        f_isr(i) = sf_int(i)%get_matrix_element (1)
     end do
 
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr         =", &
          product (f_isr)
     write (u, "(A,9(1x," // FMT_12 // "))")  "f_isr * f_map =", &
          product (f_isr * f) * f_map
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     do i = 1, 2
        call sf_int(i)%final ()
     end do
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_isr_5"
 
   end subroutine sf_isr_5
 
 @ %def sf_isr_5
 @
 \clearpage
 %------------------------------------------------------------------------
 \section{EPA}
 
 <<[[sf_epa.f90]]>>=
 <<File header>>
 
 module sf_epa
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use constants, only: pi
   use format_defs, only: FMT_17, FMT_19
   use numeric_utils
   use diagnostics
   use physics_defs, only: PHOTON
   use lorentz
   use pdg_arrays
   use model_data
   use flavors
   use colors
   use quantum_numbers
   use state_matrices
   use polarizations
   use interactions
   use sf_aux
   use sf_base
 
 <<Standard module head>>
 
 <<SF epa: public>>
 
 <<SF epa: parameters>>
 
 <<SF epa: types>>
 
 contains
 
 <<SF epa: procedures>>
 
 end module sf_epa
 @ %def sf_epa
 @
 \subsection{Physics}
 The EPA structure function for a photon inside an (elementary)
 particle $p$ with energy $E$, mass $m$ and charge $q_p$ (e.g.,
 electron) is given by ($\bar x \equiv 1-x$)
 %% %\cite{Budnev:1974de}
 %% \bibitem{Budnev:1974de}
 %%   V.~M.~Budnev, I.~F.~Ginzburg, G.~V.~Meledin and V.~G.~Serbo,
 %%   %``The Two photon particle production mechanism. Physical problems.
 %%   %Applications. Equivalent photon approximation,''
 %%   Phys.\ Rept.\  {\bf 15} (1974) 181.
 %%   %%CITATION = PRPLC,15,181;%%
 \begin{multline}
 \label{EPA}
   f(x) =
   \frac{\alpha}{\pi}\,q_p^2\,
   \frac{1}{x}\,
   \biggl[\left(\bar x + \frac{x^2}{2}\right)
         \ln\frac{Q^2_{\rm max}}{Q^2_{\rm min}}
         \\
   - \left(1 - \frac{x}{2}\right)^2
     \ln\frac{x^2+\frac{Q^2_{\rm max}}{E^2}}
                   {x^2+\frac{Q^2_{\rm min}}{E^2}}
         - x^2\frac{m^2}{Q^2_{\rm min}}
           \left(1 - \frac{Q^2_{\rm min}}{Q^2_{\rm max}}\right)
   \biggr].
 \end{multline}
 If no explicit $Q$ bounds are provided, the kinematical bounds are
 \begin{align}
   -Q^2_{\rm max} &= t_0 = -2\bar x(E^2+p\bar p) + 2m^2 \approx -4\bar x E^2,
 \\
   -Q^2_{\rm min} &= t_1 = -2\bar x(E^2-p\bar p) + 2m^2
   \approx
   -\frac{x^2}{\bar x}m^2.
 \end{align}
 
 The second and third terms in (\ref{EPA}) are negative definite (and
 subleading).  Noting that $\bar x + x^2/2$ is bounded between
 $1/2$ and $1$, we derive that $f(x)$ is always smaller than
 \begin{equation}
   \bar f(x) = \frac{\alpha}{\pi}\,q_p^2\,\frac{L - 2\ln x}{x}
   \qquad\text{where}\qquad
   L = \ln\frac{\min(4E_{\rm max}^2,Q^2_{\rm max})}{\max(m^2,Q_{\rm min}^2)},
 \end{equation}
 where we allow for explicit $Q$ bounds that narrow the kinematical range.
 Therefore, we generate this distribution:
 \begin{equation}\label{EPA-subst}
   \int_{x_0}^{x_1} dx\,\bar f(x) = C(x_0,x_1)\int_0^1 dx'
 \end{equation}
 We set
 \begin{equation}\label{EPA-x(x')}
   \ln x = \frac12\left\{ L - \sqrt{L^2 - 4\left[ x'\ln x_1(L-\ln x_1)
   + \bar x'\ln x_0(L-\ln x_0) \right]} \right\}
 \end{equation}
 such that $x(0)=x_0$ and $x(1)=x_1$ and
 \begin{equation}
   \frac{dx}{dx'} = \left(\frac{\alpha}{\pi} q_p^2 \right)^{-1}
   x\frac{C(x_0,x_1)}{L - 2\ln x}
 \end{equation}
 with
 \begin{equation}
   C(x_0,x_1) = \frac{\alpha}{\pi} q_p^2\,\left[\ln x_1(L-\ln x_1) - \ln
   x_0(L-\ln x_0)\right]
 \end{equation}
 such that (\ref{EPA-subst}) is satisfied.  Finally, we have
 \begin{equation}
   \int_{x_0}^{x_1} dx\,f(x) = C(x_0,x_1)\int_0^1 dx'\,
   \frac{f(x(x'))}{\bar f(x(x'))}
 \end{equation}
 where $x'$ is calculated from $x$ via (\ref{EPA-x(x')}).
 
 The structure of the mapping is most obvious from:
 \begin{equation}
   x'(x) = \frac{\log x ( L - \log x) - \log x_0 (L - \log x_0)}
   {\log x_1 ( L - \log x_1) - \log x_0 (L - \log x_0)} \; .
 \end{equation}
 
 
 
 \subsection{The EPA data block}
 The EPA parameters are: $\alpha$, $E_{\rm max}$, $m$, $Q_{\rm min}$, and
 $x_{\rm min}$.  Instead of $m$ we can use the incoming particle PDG
 code as input; from this we can deduce the mass and charge.
 
 Internally we store in addition $C_{0/1} = \frac{\alpha}{\pi}q_e^2\ln
 x_{0/1} (L - \ln x_{0/1})$, the c.m. energy squared and the incoming
 particle mass.
 <<SF epa: public>>=
   public :: epa_data_t
 <<SF epa: types>>=
   type, extends(sf_data_t) :: epa_data_t
      private
      class(model_data_t), pointer :: model => null ()
      type(flavor_t), dimension(:), allocatable :: flv_in
      real(default) :: alpha
      real(default) :: x_min
      real(default) :: x_max
      real(default) :: q_min
      real(default) :: q_max
      real(default) :: E_max
      real(default) :: mass
      real(default) :: log
      real(default) :: a
      real(default) :: c0
      real(default) :: c1
      real(default) :: dc
      integer :: error = NONE
      logical :: recoil = .false.
      logical :: keep_energy = .true.
    contains
    <<SF epa: epa data: TBP>>
   end type epa_data_t
 
 @ %def epa_data_t
 @ Error codes
 <<SF epa: parameters>>=
   integer, parameter :: NONE = 0
   integer, parameter :: ZERO_QMIN = 1
   integer, parameter :: Q_MAX_TOO_SMALL = 2
   integer, parameter :: ZERO_XMIN = 3
   integer, parameter :: MASS_MIX = 4
   integer, parameter :: NO_EPA = 5
 <<SF epa: epa data: TBP>>=
   procedure :: init => epa_data_init
 <<SF epa: procedures>>=
   subroutine epa_data_init (data, model, pdg_in, alpha, &
-       x_min, q_min, E_max, mass, recoil, keep_energy)
+       x_min, q_min, q_max, mass, recoil, keep_energy)
     class(epa_data_t), intent(inout) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), intent(in) :: pdg_in
-    real(default), intent(in) :: alpha, x_min, q_min, E_max
+    real(default), intent(in) :: alpha, x_min, q_min, q_max
     real(default), intent(in), optional :: mass
     logical, intent(in), optional :: recoil
     logical, intent(in), optional :: keep_energy
     integer :: n_flv, i
     data%model => model
     n_flv = pdg_array_get_length (pdg_in)
     allocate (data%flv_in (n_flv))
     do i = 1, n_flv
        call data%flv_in(i)%init (pdg_array_get (pdg_in, i), model)
     end do
     data%alpha = alpha
-    data%E_max = E_max
+    data%E_max = q_max / 2
     data%x_min = x_min
     data%x_max = 1
     if (vanishes (data%x_min)) then
        data%error = ZERO_XMIN;  return
     end if
     data%q_min = q_min
-    data%q_max = 2 * data%E_max
+    data%q_max = q_max
     select case (char (data%model%get_name ()))
     case ("QCD","Test")
        data%error = NO_EPA;  return
     end select
     if (present (recoil)) then
        data%recoil = recoil
     end if
     if (present (keep_energy)) then
        data%keep_energy = keep_energy
     end if
     if (present (mass)) then
        data%mass = mass
     else
        data%mass = data%flv_in(1)%get_mass ()
        if (any (data%flv_in%get_mass () /= data%mass)) then
           data%error = MASS_MIX;  return
        end if
     end if
     if (max (data%mass, data%q_min) == 0) then
        data%error = ZERO_QMIN;  return
     else if (max (data%mass, data%q_min) >= data%E_max) then
        data%error = Q_MAX_TOO_SMALL;  return
     end if
-    data%log = log (4 * (data%E_max / max (data%mass, data%q_min)) ** 2 )
+    data%log = log ((data%q_max / max (data%mass, data%q_min)) ** 2 )
     data%a  = data%alpha / pi
     data%c0 = log (data%x_min) * (data%log - log (data%x_min))
     data%c1 = log (data%x_max) * (data%log - log (data%x_max))
     data%dc = data%c1 - data%c0
   end subroutine epa_data_init
 
 @ %def epa_data_init
 @ Handle error conditions.  Should always be done after
 initialization, unless we are sure everything is ok.
 <<SF epa: epa data: TBP>>=
   procedure :: check => epa_data_check
 <<SF epa: procedures>>=
   subroutine epa_data_check (data)
     class(epa_data_t), intent(in) :: data
     select case (data%error)
     case (NO_EPA)
        call msg_fatal ("EPA structure function not available for model " &
             // char (data%model%get_name ()) // ".")
     case (ZERO_QMIN)
        call msg_fatal ("EPA: Particle mass is zero")
     case (Q_MAX_TOO_SMALL)
        call msg_fatal ("EPA: Particle mass exceeds Qmax")
     case (ZERO_XMIN)
        call msg_fatal ("EPA: x_min must be larger than zero")
     case (MASS_MIX)
        call msg_fatal ("EPA: incoming particle masses must be uniform")
     end select
   end subroutine epa_data_check
 
 @ %def epa_data_check
 @ Output
 <<SF epa: epa data: TBP>>=
   procedure :: write => epa_data_write
 <<SF epa: procedures>>=
   subroutine epa_data_write (data, unit, verbose)
     class(epa_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)") "EPA data:"
     if (allocated (data%flv_in)) then
        write (u, "(3x,A)", advance="no") "  flavor =  "
        do i = 1, size (data%flv_in)
           if (i > 1)  write (u, "(',',1x)", advance="no")
           call data%flv_in(i)%write (u)
        end do
        write (u, *)
        write (u, "(3x,A," // FMT_19 // ")") "  alpha    = ", data%alpha
        write (u, "(3x,A," // FMT_19 // ")") "  x_min    = ", data%x_min
        write (u, "(3x,A," // FMT_19 // ")") "  x_max    = ", data%x_max
        write (u, "(3x,A," // FMT_19 // ")") "  q_min    = ", data%q_min
        write (u, "(3x,A," // FMT_19 // ")") "  q_max    = ", data%q_max
        write (u, "(3x,A," // FMT_19 // ")") "  E_max    = ", data%e_max
        write (u, "(3x,A," // FMT_19 // ")") "  mass     = ", data%mass
        write (u, "(3x,A," // FMT_19 // ")") "  a        = ", data%a
        write (u, "(3x,A," // FMT_19 // ")") "  c0       = ", data%c0
        write (u, "(3x,A," // FMT_19 // ")") "  c1       = ", data%c1
        write (u, "(3x,A," // FMT_19 // ")") "  log      = ", data%log
        write (u, "(3x,A,L2)")      "  recoil   = ", data%recoil
        write (u, "(3x,A,L2)")      "  keep en. = ", data%keep_energy
     else
        write (u, "(3x,A)") "[undefined]"
     end if
   end subroutine epa_data_write
 
 @ %def epa_data_write
 @ The number of kinematic parameters.
 <<SF epa: epa data: TBP>>=
   procedure :: get_n_par => epa_data_get_n_par
 <<SF epa: procedures>>=
   function epa_data_get_n_par (data) result (n)
     class(epa_data_t), intent(in) :: data
     integer :: n
     if (data%recoil) then
        n = 3
     else
        n = 1
     end if
   end function epa_data_get_n_par
 
 @ %def epa_data_get_n_par
 @ Return the outgoing particles PDG codes. The outgoing particle is always
 the photon while the radiated particle is identical to the incoming one.
 <<SF epa: epa data: TBP>>=
   procedure :: get_pdg_out => epa_data_get_pdg_out
 <<SF epa: procedures>>=
   subroutine epa_data_get_pdg_out (data, pdg_out)
     class(epa_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     pdg_out(1) = PHOTON
   end subroutine epa_data_get_pdg_out
 
 @ %def epa_data_get_pdg_out
 @ Allocate the interaction record.
 <<SF epa: epa data: TBP>>=
   procedure :: allocate_sf_int => epa_data_allocate_sf_int
 <<SF epa: procedures>>=
   subroutine epa_data_allocate_sf_int (data, sf_int)
     class(epa_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (epa_t :: sf_int)
   end subroutine epa_data_allocate_sf_int
 
 @ %def epa_data_allocate_sf_int
 @
 \subsection{The EPA object}
 The [[epa_t]] data type is a $1\to 2$ interaction.  We should be able
 to handle several flavors in parallel, since EPA is not necessarily
 applied immediately after beam collision:  Photons may be radiated
 from quarks.  In that case, the partons are massless and $q_{\rm min}$
 applies instead, so we do not need to generate several kinematical
 configurations in parallel.
 
 The squared charge values multiply the matrix elements, depending on the
 flavour.  We scan the interaction after building it, so we have the correct
 assignments.
 
 The particles are ordered as (incoming, radiated, photon), where the
 photon initiates the hard interaction.
 
 We generate an unpolarized photon and transfer initial polarization to
 the radiated parton.  Color is transferred in the same way.
 <<SF epa: types>>=
   type, extends (sf_int_t) :: epa_t
      type(epa_data_t), pointer :: data => null ()
      real(default) :: x  = 0
      real(default) :: xb = 0
      real(default) :: E  = 0
      real(default), dimension(:), allocatable :: charge2
    contains
    <<SF epa: epa: TBP>>
   end type epa_t
 
 @ %def epa_t
 @ Type string: has to be here, but there is no string variable on which EPA
 depends. Hence, a dummy routine.
 <<SF epa: epa: TBP>>=
   procedure :: type_string => epa_type_string
 <<SF epa: procedures>>=
   function epa_type_string (object) result (string)
     class(epa_t), intent(in) :: object
     type(string_t) :: string
     if (associated (object%data)) then
        string = "EPA: equivalent photon approx."
     else
        string = "EPA: [undefined]"
     end if
   end function epa_type_string
 
 @ %def epa_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF epa: epa: TBP>>=
   procedure :: write => epa_write
 <<SF epa: procedures>>=
   subroutine epa_write (object, unit, testflag)
     class(epa_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        if (object%status >= SF_DONE_KINEMATICS) then
           write (u, "(1x,A)")  "SF parameters:"
           write (u, "(3x,A," // FMT_17 // ")")  "x =", object%x
           if (object%status >= SF_FAILED_EVALUATION) then
              write (u, "(3x,A," // FMT_17 // ")")  "E =", object%E
           end if
        end if
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "EPA data: [undefined]"
     end if
   end subroutine epa_write
 
 @ %def epa_write
 @ Prepare the interaction object.  We have to construct transition matrix
 elements for all flavor and helicity combinations.
 <<SF epa: epa: TBP>>=
   procedure :: init => epa_init
 <<SF epa: procedures>>=
   subroutine epa_init (sf_int, data)
     class(epa_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     type(quantum_numbers_mask_t), dimension(3) :: mask
     integer, dimension(3) :: hel_lock
     type(polarization_t), target :: pol
     type(quantum_numbers_t), dimension(1) :: qn_fc
     type(flavor_t) :: flv_photon
     type(color_t) :: col_photon
     type(quantum_numbers_t) :: qn_hel, qn_photon, qn, qn_rad
     type(polarization_iterator_t) :: it_hel
     integer :: i
     mask = quantum_numbers_mask (.false., .false., &
          mask_h = [.false., .false., .true.])
     hel_lock = [2, 1, 0]
     select type (data)
     type is (epa_data_t)
        call sf_int%base_init (mask, [data%mass**2], &
             [data%mass**2], [0._default], hel_lock = hel_lock)
        sf_int%data => data
        call flv_photon%init (PHOTON, data%model)
        call col_photon%init ()
        call qn_photon%init (flv_photon, col_photon)
        do i = 1, size (data%flv_in)
           call pol%init_generic (data%flv_in(i))
           call qn_fc(1)%init ( &
                flv = data%flv_in(i), &
                col = color_from_flavor (data%flv_in(i), 1))
           call it_hel%init (pol)
           do while (it_hel%is_valid ())
              qn_hel = it_hel%get_quantum_numbers ()
              qn = qn_hel .merge. qn_fc(1)
              qn_rad = qn
              call qn_rad%tag_radiated ()
              call sf_int%add_state ([qn, qn_rad, qn_photon])
              call it_hel%advance ()
           end do
           !  call pol%final ()
        end do
        call sf_int%freeze ()
        if (data%keep_energy) then
           sf_int%on_shell_mode = KEEP_ENERGY
        else
           sf_int%on_shell_mode = KEEP_MOMENTUM
        end if
        call sf_int%set_incoming ([1])
        call sf_int%set_radiated ([2])
        call sf_int%set_outgoing ([3])
     end select
   end subroutine epa_init
 
 @ %def epa_init
 @ Prepare the charge array.  This is separate from the previous routine since
 the state matrix may be helicity-contracted.
 <<SF epa: epa: TBP>>=
   procedure :: setup_constants => epa_setup_constants
 <<SF epa: procedures>>=
   subroutine epa_setup_constants (sf_int)
     class(epa_t), intent(inout), target :: sf_int
     type(state_iterator_t) :: it
     type(flavor_t) :: flv
     integer :: i, n_me
     n_me = sf_int%get_n_matrix_elements ()
     allocate (sf_int%charge2 (n_me))
     call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
     do while (it%is_valid ())
        i = it%get_me_index ()
        flv = it%get_flavor (1)
        sf_int%charge2(i) = flv%get_charge () ** 2
        call it%advance ()
     end do
     sf_int%status = SF_INITIAL
   end subroutine epa_setup_constants
 
 @ %def epa_setup_constants
 @
 \subsection{Kinematics}
 Set kinematics.  If [[map]] is unset, the $r$ and $x$ values
 coincide, and the Jacobian $f(r)$ is trivial.
 
 The EPA structure function allows for a straightforward mapping of the
 unit interval. The $x$ value is transformed, and the mapped structure
 function becomes unity at its upper boundary.
 
 The structure function implementation applies the above mapping to the
 input (random) number [[r]] to generate the momentum fraction [[x]]
 and the function value [[f]].  For numerical stability reasons, we
 also output [[xb]], which is $\bar x=1-x$.
 <<SF epa: epa: TBP>>=
   procedure :: complete_kinematics => epa_complete_kinematics
 <<SF epa: procedures>>=
   subroutine epa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(epa_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     real(default) :: delta, sqrt_delta, lx
     if (map) then
        associate (data => sf_int%data)
          delta = data%log ** 2 -  4 * (r(1) * data%c1 + rb(1) * data%c0)
          if (delta > 0) then
             sqrt_delta = sqrt (delta)
             lx = (data%log - sqrt_delta) / 2
          else
             sf_int%status = SF_FAILED_KINEMATICS
             f = 0
             return
          end if
          x(1) = exp (lx)
          f = x(1) * data%dc / sqrt_delta
        end associate
     else
        x(1) = r(1)
        if (sf_int%data%x_min < x(1) .and. x(1) < sf_int%data%x_max) then
           f = 1
        else
           sf_int%status = SF_FAILED_KINEMATICS
           f = 0
           return
        end if
     end if
     xb(1) = 1 - x(1)
     if (size(x) == 3) then
        x(2:3) = r(2:3)
        xb(2:3) = rb(2:3)
     end if
     call sf_int%split_momentum (x, xb)
     select case (sf_int%status)
     case (SF_DONE_KINEMATICS)
        sf_int%x = x(1)
        sf_int%xb= xb(1)
        sf_int%E  = energy (sf_int%get_momentum (1))
     case (SF_FAILED_KINEMATICS)
        sf_int%x = 0
        sf_int%xb= 0
        f = 0
     end select
   end subroutine epa_complete_kinematics
 
 @ %def epa_complete_kinematics
 @ Overriding the default method: we compute the [[x]] array from the
 momentum configuration.  In the specific case of EPA, we also set the
 internally stored $x$ and $\bar x$ values, so they can be used in the
 following routine.
 
 Note: the extraction of $\bar x$ is not numerically safe, but it cannot
 be as long as the base [[recover_x]] is not.
 <<SF epa: epa: TBP>>=
   procedure :: recover_x => sf_epa_recover_x
 <<SF epa: procedures>>=
   subroutine sf_epa_recover_x (sf_int, x, xb, x_free)
     class(epa_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(inout), optional :: x_free
     call sf_int%base_recover_x (x, xb, x_free)
     sf_int%x  = x(1)
     sf_int%xb = xb(1)
   end subroutine sf_epa_recover_x
 
 @ %def sf_epa_recover_x
 @ Compute inverse kinematics.  Here, we start with the $x$ array and
 compute the ``input'' $r$ values and the Jacobian $f$.  After this, we
 can set momenta by the same formula as for normal kinematics.
 <<SF epa: epa: TBP>>=
   procedure :: inverse_kinematics => epa_inverse_kinematics
 <<SF epa: procedures>>=
   subroutine epa_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(epa_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     real(default) :: lx, delta, sqrt_delta, c
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     if (map) then
        associate (data => sf_int%data)
          lx = log (x(1))
          sqrt_delta = data%log - 2 * lx
          delta = sqrt_delta ** 2
          c = (data%log ** 2 - delta) / 4
          r (1) = (c - data%c0) / data%dc
          rb(1) = (data%c1 - c) / data%dc
          f = x(1) * data%dc / sqrt_delta
        end associate
     else
        r (1) = x(1)
        rb(1) = xb(1)
        if (sf_int%data%x_min < x(1) .and. x(1) < sf_int%data%x_max) then
           f = 1
        else
           f = 0
        end if
     end if
     if (size(r) == 3) then
        r (2:3) = x(2:3)
        rb(2:3) = xb(2:3)
     end if
     if (set_mom) then
        call sf_int%split_momentum (x, xb)
        select case (sf_int%status)
        case (SF_FAILED_KINEMATICS);  f = 0
        end select
     end if
     sf_int%E  = energy (sf_int%get_momentum (1))
   end subroutine epa_inverse_kinematics
 
 @ %def epa_inverse_kinematics
 @
 \subsection{EPA application}
 For EPA, we can in principle compute kinematics and function value in
 a single step. In order to be able to reweight events, kinematics and
 structure function application are separated. This function works on a
 single beam, assuming that the input momentum has been set.  We need
 three random numbers as input: one for $x$, and two for the polar and
 azimuthal angles. Alternatively, for the no-recoil case, we can skip
 $p_T$ generation; in this case, we only need one.
 
 For obtaining splitting kinematics, we rely on the assumption that all
 in-particles are mass-degenerate (or there is only one), so the
 generated $x$ values are identical.
 <<SF epa: epa: TBP>>=
   procedure :: apply => epa_apply
 <<SF epa: procedures>>=
   subroutine epa_apply (sf_int, scale, rescale, i_sub)
     class(epa_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     real(default) :: x, xb, qminsq, qmaxsq, f, E
     associate (data => sf_int%data)
       x = sf_int%x
       xb= sf_int%xb
       E = sf_int%E
       qminsq = max (x ** 2 / xb * data%mass ** 2, data%q_min ** 2)
       qmaxsq = min (4 * xb * E ** 2, data%q_max ** 2)
       if (qminsq < qmaxsq) then
          f = data%a / x &
               * ((xb + x ** 2 / 2) * log (qmaxsq / qminsq) &
               - (1 - x / 2) ** 2 &
               * log ((x**2 + qmaxsq / E ** 2) / (x**2 + qminsq / E ** 2)) &
               - x ** 2 * data%mass ** 2 / qminsq * (1 - qminsq / qmaxsq))
       else
          f = 0
       end if
       call sf_int%set_matrix_element &
            (cmplx (f, kind=default) * sf_int%charge2)
     end associate
     sf_int%status = SF_EVALUATED
   end subroutine epa_apply
 
 @ %def epa_apply
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_epa_ut.f90]]>>=
 <<File header>>
 
 module sf_epa_ut
   use unit_tests
   use sf_epa_uti
 
 <<Standard module head>>
 
 <<SF epa: public test>>
 
 contains
 
 <<SF epa: test driver>>
 
 end module sf_epa_ut
 @ %def sf_epa_ut
 @
 <<[[sf_epa_uti.f90]]>>=
 <<File header>>
 
 module sf_epa_uti
 
 <<Use kinds>>
   use physics_defs, only: ELECTRON
   use lorentz
   use pdg_arrays
   use flavors
   use interactions, only: reset_interaction_counter
   use interactions, only: interaction_pacify_momenta
   use model_data
   use sf_aux
   use sf_base
 
   use sf_epa
 
 <<Standard module head>>
 
 <<SF epa: test declarations>>
 
 contains
 
 <<SF epa: tests>>
 
 end module sf_epa_uti
 @ %def sf_epa_ut
 @ API: driver for the unit tests below.
 <<SF epa: public test>>=
   public :: sf_epa_test
 <<SF epa: test driver>>=
   subroutine sf_epa_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF epa: execute tests>>
   end subroutine sf_epa_test
 
 @ %def sf_epa_test
 @
 \subsubsection{Test structure function data}
 Construct and display a test structure function data object.
 <<SF epa: execute tests>>=
   call test (sf_epa_1, "sf_epa_1", &
        "structure function configuration", &
        u, results)
 <<SF epa: test declarations>>=
   public :: sf_epa_1
 <<SF epa: tests>>=
   subroutine sf_epa_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(pdg_array_t), dimension(1) :: pdg_out
     integer, dimension(:), allocatable :: pdg1
     class(sf_data_t), allocatable :: data
 
     write (u, "(A)")  "* Test output: sf_epa_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &test structure function data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Create empty data object"
     write (u, "(A)")
 
     call model%init_qed_test ()
     pdg_in = ELECTRON
 
     allocate (epa_data_t :: data)
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     select type (data)
     type is (epa_data_t)
        call data%init (model, pdg_in, 1./137._default, 0.01_default, &
-            10._default, 50._default, 0.000511_default, recoil = .false.)
+            10._default, 100._default, 0.000511_default, recoil = .false.)
     end select
 
     call data%write (u)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     write (u, "(2x,99(1x,I0))")  pdg1
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_epa_1"
 
   end subroutine sf_epa_1
 
 @ %def sf_epa_1
 @
 \subsubsection{Test and probe structure function}
 Construct and display a structure function object based on the EPA
 structure function.
 <<SF epa: execute tests>>=
   call test (sf_epa_2, "sf_epa_2", &
        "structure function instance", &
        u, results)
 <<SF epa: test declarations>>=
   public :: sf_epa_2
 <<SF epa: tests>>=
   subroutine sf_epa_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_epa_2"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     call flv%init (ELECTRON, model)
     pdg_in = ELECTRON
 
     call reset_interaction_counter ()
 
     allocate (epa_data_t :: data)
     select type (data)
     type is (epa_data_t)
        call data%init (model, pdg_in, 1./137._default, 0.01_default, &
-            10._default, 50._default, 0.000511_default, recoil = .false.)
+            10._default, 100._default, 0.000511_default, recoil = .false.)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call pacify (k, 1e-10_default)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for r=0.4, no EPA mapping, collinear"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = 0.4_default
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     call sf_int%seed_kinematics ([k])
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false., &
          set_momenta=.true.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate EPA structure function"
     write (u, "(A)")
 
     call sf_int%apply (scale = 100._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_epa_2"
 
   end subroutine sf_epa_2
 
 @ %def sf_epa_2
 @
 \subsubsection{Standard mapping}
 Construct and display a structure function object based on the EPA
 structure function, applying the standard single-particle mapping.
 <<SF epa: execute tests>>=
   call test (sf_epa_3, "sf_epa_3", &
        "apply mapping", &
        u, results)
 <<SF epa: test declarations>>=
   public :: sf_epa_3
 <<SF epa: tests>>=
   subroutine sf_epa_3 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_epa_3"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     call flv%init (ELECTRON, model)
     pdg_in = ELECTRON
 
     call reset_interaction_counter ()
 
     allocate (epa_data_t :: data)
     select type (data)
     type is (epa_data_t)
        call data%init (model, pdg_in, 1./137._default, 0.01_default, &
-            10._default, 50._default, 0.000511_default, recoil = .false.)
+            10._default, 100._default, 0.000511_default, recoil = .false.)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call pacify (k, 1e-10_default)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for r=0.4, with EPA mapping, collinear"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = 0.4_default
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     call sf_int%seed_kinematics ([k])
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
          set_momenta=.true.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate EPA structure function"
     write (u, "(A)")
 
     call sf_int%apply (scale = 100._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_epa_3"
 
   end subroutine sf_epa_3
 
 @ %def sf_epa_3
 @
 \subsubsection{Non-collinear case}
 Construct and display a structure function object based on the EPA
 structure function.
 <<SF epa: execute tests>>=
   call test (sf_epa_4, "sf_epa_4", &
        "non-collinear", &
        u, results)
 <<SF epa: test declarations>>=
   public :: sf_epa_4
 <<SF epa: tests>>=
   subroutine sf_epa_4 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E, m
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_epa_4"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     call flv%init (ELECTRON, model)
     pdg_in = ELECTRON
 
     call reset_interaction_counter ()
 
     allocate (epa_data_t :: data)
     select type (data)
     type is (epa_data_t)
        call data%init (model, pdg_in, 1./137._default, 0.01_default, &
-            10._default, 50._default, 5.0_default, recoil = .true.)
+            10._default, 100._default, 5.0_default, recoil = .true.)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500, me = 5 GeV"
     write (u, "(A)")
     E = 500
     m = 5
     k = vector4_moving (E, sqrt (E**2 - m**2), 3)
     call pacify (k, 1e-10_default)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for r=0.5/0.5/0.25, with EPA mapping, "
     write (u, "(A)")  "          non-coll., keeping energy, me = 5 GeV"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = [0.5_default, 0.5_default, 0.25_default]
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_ENERGY
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
     call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     call sf_int%seed_kinematics ([k])
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
          set_momenta=.true.)
     call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate EPA structure function"
     write (u, "(A)")
 
     call sf_int%apply (scale = 100._default)
     call sf_int%write (u, testflag = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_epa_4"
 
   end subroutine sf_epa_4
 
 @ %def sf_epa_4
 @
 \subsubsection{Structure function for multiple flavors}
 Construct and display a structure function object based on the EPA
 structure function.  The incoming state has multiple particles with
 non-uniform charge.
 <<SF epa: execute tests>>=
   call test (sf_epa_5, "sf_epa_5", &
        "multiple flavors", &
        u, results)
 <<SF epa: test declarations>>=
   public :: sf_epa_5
 <<SF epa: tests>>=
   subroutine sf_epa_5 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_epa_5"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_sm_test ()
     call flv%init (1, model)
     pdg_in = [1, 2, -1, -2]
 
     call reset_interaction_counter ()
 
     allocate (epa_data_t :: data)
     select type (data)
     type is (epa_data_t)
        call data%init (model, pdg_in, 1./137._default, 0.01_default, &
-            10._default, 50._default, 0.000511_default, recoil = .false.)
+            10._default, 100._default, 0.000511_default, recoil = .false.)
        call data%check ()
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call pacify (k, 1e-10_default)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for r=0.4, no EPA mapping, collinear"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = 0.4_default
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate EPA structure function"
     write (u, "(A)")
 
     call sf_int%apply (scale = 100._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_epa_5"
 
   end subroutine sf_epa_5
 
 @ %def sf_epa_5
 @
 \clearpage
 %------------------------------------------------------------------------
 \section{EWA}
 
 <<[[sf_ewa.f90]]>>=
 <<File header>>
 
 module sf_ewa
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use constants, only: pi
   use format_defs, only: FMT_17, FMT_19
   use numeric_utils
   use diagnostics
   use physics_defs, only: W_BOSON, Z_BOSON
   use lorentz
   use pdg_arrays
   use model_data
   use flavors
   use colors
   use quantum_numbers
   use state_matrices
   use polarizations
   use interactions
   use sf_aux
   use sf_base
 
 <<Standard module head>>
 
 <<SF ewa: public>>
 
 <<SF ewa: parameters>>
 
 <<SF ewa: types>>
 
 contains
 
 <<SF ewa: procedures>>
 
 end module sf_ewa
 @ %def sf_ewa
 @
 \subsection{Physics}
 The EWA structure function for a $Z$ or $W$ inside a fermion (lepton
 or quark) depends on the vector-boson polarization.  We distinguish
 transversal ($\pm$) and longitudinal ($0$) polarization.
 \begin{align}
   F_{+}(x) &= \frac{1}{16\pi^2}\,\frac{(v-a)^2 + (v+a)^2\bar x^2}{x}
   \left[
   \ln\left(\frac{p_{\perp,\textrm{max}}^2 + \bar x M^2}{\bar x M^2}\right)
   -
   \frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
   \right]
   \\
   F_{-}(x) &= \frac{1}{16\pi^2}\,\frac{(v+a)^2 + (v-a)^2\bar x^2}{x}
   \left[
   \ln\left(\frac{p_{\perp,\textrm{max}}^2 + \bar x M^2}{\bar x M^2}\right)
   -
   \frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
   \right]
   \\
   F_0(x) &= \frac{v^2+a^2}{8\pi^2}\,\frac{2\bar x}{x}\,
   \frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
 \end{align}
 where $p_{\perp,\textrm{max}}$ is the cutoff in transversal momentum, $M$ is
 the vector-boson mass, $v$ and $a$ are the vector and axial-vector
 couplings, and $\bar x\equiv 1-x$.  Note that the longitudinal
 structure function is finite for large cutoff, while the transversal
 structure function is logarithmically divergent.
 
 The maximal transverse momentum is given by the kinematical limit, it is
 \begin{equation}
 p_{\perp,\textrm{max}} = \bar x \sqrt{s}/2.
 \end{equation}
 The vector and axial couplings for a fermion branching into a $W$ are
 \begin{align}
   v_W &= \frac{g}{2\sqrt 2},
 & a_W &= \frac{g}{2\sqrt 2}.
 \end{align}
 For $Z$ emission, this is replaced by
 \begin{align}
   v_Z &= \frac{g}{2\cos\theta_w}\left(t_3 - 2q\sin^2\theta_w\right),
 & a_Z &= \frac{g}{2\cos\theta_w}t_3,
 \end{align}
 where $t_3=\pm\frac12$ is the fermion isospin, and $q$ its charge.
 
 For an initial antifermion, the signs of the axial couplings are
 inverted.  Note that a common sign change of $v$ and $a$ is
 irrelevant.
 
 %% Differentiating with respect to the cutoff, we get structure functions
 %% \begin{align}
 %%   f_{W,\pm}(x,p_T) &= \frac{g^2}{16\pi^2}\,
 %%   \frac{1+\bar x^2}{x}
 %%   \frac{p_\perp}{p_\perp^2 + \bar x M^2}
 %%   \\
 %%   f_{W,0}(x,p_T) &= \frac{g^2}{16\pi^2}\,
 %%   \frac{2\bar x}{x}\,
 %%   \frac{p_\perp \bar xM^2}{(p_\perp^2 + \bar x M^2)^2}
 %%   \\
 %%   F_{Z,\pm}(x,p_T) &= \frac{g^2}{16\pi^2\cos\theta_w^2}
 %%   \left[(t_3^f-2q^2\sin\theta_w^2)^2 + (t_3^f)^2\right]\,
 %%   \frac{1+\bar x^2}{x}
 %%   \frac{p_\perp}{p_\perp^2 + \bar x M^2}
 %%   \\
 %%   F_{Z,0}(x,p_T) &= \frac{g^2}{16\pi^2\cos\theta_w^2}\,
 %%   \left[(t_3^f-2q^2\sin\theta_w^2)^2 + (t_3^f)^2\right]\,
 %%   \frac{2\bar x}{x}\,
 %%   \frac{p_\perp \bar xM^2}{(p_\perp^2 + \bar x M^2)^2}
 %% \end{align}
 %% Here, $t_3^f$ is the $SU(2)_L$ quantum number of the fermion
 %% $(\pm\frac12)$, and $q^f$ is the fermion charge in units of the
 %% positron charge.
 
 The EWA depends on the parameters $g$, $\sin^2\theta_w$, $M_W$, and
 $M_Z$.  These can all be taken from the SM input, and the prefactors
 are calculated from those and the incoming particle type.
 
 Since these structure functions have a $1/x$ singularity (which is not
 really relevant in practice, however, since the vector boson mass is
 finite), we map this singularity allowing for nontrivial $x$ bounds:
 \begin{equation}
   x = \exp(\bar r\ln x_0 + r\ln x_1)
 \end{equation}
 such that
 \begin{equation}
   \int_{x_0}^{x_1}\frac{dx}{x} = (\ln x_1 - \ln x_0)\int_0^1 dr.
 \end{equation}
 
 As a user parameter, we have the cutoff $p_{\perp,\textrm{max}}$.
 The divergence $1/x$ also requires a $x_0$ cutoff; and for
 completeness we introduce a corresponding $x_1$.  Physically, the
 minimal sensible value of $x$ is $M^2/s$, although the approximation
 loses its value already at higher $x$ values.
 
 
 \subsection{The EWA data block}
 The EWA parameters are: $p_{T,\rm max}$, $c_V$, $c_A$, and
 $m$. Instead of $m$ we can use the incoming particle PDG code as
 input; from this we can deduce the mass and charges. In the
 initialization phase it is not yet determined whether a $W$ or a $Z$
 is radiated, hence we set the vector and axial-vector couplings equal
 to the common prefactors $g/2 = e/2/\sin\theta_W$.
 
 In principle, for EWA it would make sense to allow the user to also
 set the upper bound for $x$, $x_{\rm max}$, but we fix it to one here.
 <<SF ewa: public>>=
   public :: ewa_data_t
 <<SF ewa: types>>=
   type, extends(sf_data_t) :: ewa_data_t
      private
      class(model_data_t), pointer :: model => null ()
      type(flavor_t), dimension(:), allocatable :: flv_in
      type(flavor_t), dimension(:), allocatable :: flv_out
      real(default) :: pt_max
      real(default) :: sqrts
      real(default) :: x_min
      real(default) :: x_max
      real(default) :: mass
      real(default) :: m_out
      real(default) :: q_min
      real(default) :: cv
      real(default) :: ca
      real(default) :: costhw
      real(default) :: sinthw
      real(default) :: mW
      real(default) :: mZ
      real(default) :: coeff
      logical :: mass_set = .false.
      logical :: recoil = .false.
      logical :: keep_energy = .false.
      integer :: id = 0
      integer :: error = NONE
    contains
    <<SF ewa: ewa data: TBP>>
   end type ewa_data_t
 
 @ %def ewa_data_t
 @ Error codes
 <<SF ewa: parameters>>=
   integer, parameter :: NONE = 0
   integer, parameter :: ZERO_QMIN = 1
   integer, parameter :: Q_MAX_TOO_SMALL = 2
   integer, parameter :: ZERO_XMIN = 3
   integer, parameter :: MASS_MIX = 4
   integer, parameter :: ZERO_SW = 5
   integer, parameter :: ISOSPIN_MIX = 6
   integer, parameter :: WRONG_PRT = 7
   integer, parameter :: MASS_MIX_OUT = 8
   integer, parameter :: NO_EWA = 9
 <<SF ewa: ewa data: TBP>>=
   procedure :: init => ewa_data_init
 <<SF ewa: procedures>>=
   subroutine ewa_data_init (data, model, pdg_in, x_min, pt_max, &
         sqrts, recoil, keep_energy, mass)
     class(ewa_data_t), intent(inout) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), intent(in) :: pdg_in
     real(default), intent(in) :: x_min, pt_max, sqrts
     logical, intent(in) :: recoil, keep_energy
     real(default), intent(in), optional :: mass
     real(default) :: g, ee
     integer :: n_flv, i
     data%model => model
     if (.not. any (pdg_in .match. &
          [1,2,3,4,5,6,11,13,15,-1,-2,-3,-4,-5,-6,-11,-13,-15])) then
        data%error = WRONG_PRT;  return
     end if
     n_flv = pdg_array_get_length (pdg_in)
     allocate (data%flv_in (n_flv))
     allocate (data%flv_out(n_flv))
     do i = 1, n_flv
        call data%flv_in(i)%init (pdg_array_get (pdg_in, i), model)
     end do
     data%pt_max = pt_max
     data%sqrts = sqrts
     data%x_min = x_min
     data%x_max = 1
     if (vanishes (data%x_min)) then
        data%error = ZERO_XMIN;  return
     end if
     select case (char (data%model%get_name ()))
     case ("QCD","QED","Test")
        data%error = NO_EWA;  return
     end select
     ee = data%model%get_real (var_str ("ee"))
     data%sinthw = data%model%get_real (var_str ("sw"))
     data%costhw = data%model%get_real (var_str ("cw"))
     data%mZ = data%model%get_real (var_str ("mZ"))
     data%mW = data%model%get_real (var_str ("mW"))
     if (data%sinthw /= 0) then
        g = ee / data%sinthw
     else
        data%error = ZERO_SW;  return
     end if
     data%cv = g / 2._default
     data%ca = g / 2._default
     data%coeff = 1._default / (8._default * PI**2)
     data%recoil = recoil
     data%keep_energy = keep_energy
     if (present (mass)) then
        data%mass = mass
        data%m_out = mass
        data%mass_set = .true.
     else
        data%mass = data%flv_in(1)%get_mass ()
        if (any (data%flv_in%get_mass () /= data%mass)) then
           data%error = MASS_MIX;  return
        end if
     end if
   end subroutine ewa_data_init
 
 @ %def ewa_data_init
 @ Set the vector boson ID for distinguishing $W$ and $Z$ bosons.
 <<SF ewa: ewa data: TBP>>=
   procedure :: set_id => ewa_set_id
 <<SF ewa: procedures>>=
   subroutine ewa_set_id (data, id)
     class(ewa_data_t), intent(inout) :: data
     integer, intent(in) :: id
     integer :: i, isospin, pdg
     if (.not. allocated (data%flv_in)) &
          call msg_bug ("EWA: incoming particles not set")
     data%id = id
     select case (data%id)
     case (23)
        data%m_out = data%mass
        data%flv_out = data%flv_in
     case (24)
        do i = 1, size (data%flv_in)
           pdg = data%flv_in(i)%get_pdg ()
           isospin = data%flv_in(i)%get_isospin_type ()
           if (isospin > 0) then
              !!! up-type quark or neutrinos
              if (data%flv_in(i)%is_antiparticle ()) then
                 call data%flv_out(i)%init (pdg + 1, data%model)
              else
                 call data%flv_out(i)%init (pdg - 1, data%model)
              end if
           else
              !!! down-type quark or lepton
              if (data%flv_in(i)%is_antiparticle ()) then
                 call data%flv_out(i)%init (pdg - 1, data%model)
              else
                 call data%flv_out(i)%init (pdg + 1, data%model)
              end if
           end if
        end do
        if (.not. data%mass_set) then
           data%m_out = data%flv_out(1)%get_mass ()
           if (any (data%flv_out%get_mass () /= data%m_out)) then
              data%error = MASS_MIX_OUT;  return
           end if
        end if
     end select
   end subroutine ewa_set_id
 
 @ %def ewa_set_id
 @ Handle error conditions.  Should always be done after
 initialization, unless we are sure everything is ok.
 <<SF ewa: ewa data: TBP>>=
   procedure :: check => ewa_data_check
 <<SF ewa: procedures>>=
   subroutine ewa_data_check (data)
     class(ewa_data_t), intent(in) :: data
     select case (data%error)
     case (WRONG_PRT)
        call msg_fatal ("EWA structure function only accessible for " &
             // "SM quarks and leptons.")
     case (NO_EWA)
        call msg_fatal ("EWA structure function not available for model " &
             // char (data%model%get_name ()))
     case (ZERO_SW)
        call msg_fatal ("EWA: Vanishing value of sin(theta_w)")
     case (ZERO_QMIN)
        call msg_fatal ("EWA: Particle mass is zero")
     case (Q_MAX_TOO_SMALL)
        call msg_fatal ("EWA: Particle mass exceeds Qmax")
     case (ZERO_XMIN)
        call msg_fatal ("EWA: x_min must be larger than zero")
     case (MASS_MIX)
        call msg_fatal ("EWA: incoming particle masses must be uniform")
     case (MASS_MIX_OUT)
        call msg_fatal ("EWA: outgoing particle masses must be uniform")
     case (ISOSPIN_MIX)
        call msg_fatal ("EWA: incoming particle isospins must be uniform")
     end select
   end subroutine ewa_data_check
 
 @ %def ewa_data_check
 @ Output
 <<SF ewa: ewa data: TBP>>=
   procedure :: write => ewa_data_write
 <<SF ewa: procedures>>=
   subroutine ewa_data_write (data, unit, verbose)
     class(ewa_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)") "EWA data:"
     if (allocated (data%flv_in) .and. allocated (data%flv_out)) then
        write (u, "(3x,A)", advance="no") "  flavor(in)  =  "
        do i = 1, size (data%flv_in)
           if (i > 1)  write (u, "(',',1x)", advance="no")
           call data%flv_in(i)%write (u)
        end do
        write (u, *)
        write (u, "(3x,A)", advance="no") "  flavor(out) =  "
        do i = 1, size (data%flv_out)
           if (i > 1)  write (u, "(',',1x)", advance="no")
           call data%flv_out(i)%write (u)
        end do
        write (u, *)
        write (u, "(3x,A," // FMT_19 // ")") "  x_min     = ", data%x_min
        write (u, "(3x,A," // FMT_19 // ")") "  x_max     = ", data%x_max
        write (u, "(3x,A," // FMT_19 // ")") "  pt_max    = ", data%pt_max
        write (u, "(3x,A," // FMT_19 // ")") "  sqrts     = ", data%sqrts
        write (u, "(3x,A," // FMT_19 // ")") "  mass      = ", data%mass
        write (u, "(3x,A," // FMT_19 // ")") "  cv        = ", data%cv
        write (u, "(3x,A," // FMT_19 // ")") "  ca        = ", data%ca
        write (u, "(3x,A," // FMT_19 // ")") "  coeff     = ", data%coeff
        write (u, "(3x,A," // FMT_19 // ")") "  costhw    = ", data%costhw
        write (u, "(3x,A," // FMT_19 // ")") "  sinthw    = ", data%sinthw
        write (u, "(3x,A," // FMT_19 // ")") "  mZ        = ", data%mZ
        write (u, "(3x,A," // FMT_19 // ")") "  mW        = ", data%mW
        write (u, "(3x,A,L2)")      "  recoil    = ", data%recoil
        write (u, "(3x,A,L2)")      "  keep en.  = ", data%keep_energy
        write (u, "(3x,A,I2)")      "  PDG (VB)  = ", data%id
     else
        write (u, "(3x,A)") "[undefined]"
     end if
   end subroutine ewa_data_write
 
 @ %def ewa_data_write
 @ The number of parameters is one for collinear splitting, in case the
 [[recoil]] option is set, we take the recoil into account.
 <<SF ewa: ewa data: TBP>>=
   procedure :: get_n_par => ewa_data_get_n_par
 <<SF ewa: procedures>>=
   function ewa_data_get_n_par (data) result (n)
     class(ewa_data_t), intent(in) :: data
     integer :: n
     if (data%recoil) then
        n = 3
     else
        n = 1
     end if
   end function ewa_data_get_n_par
 
 @ %def ewa_data_get_n_par
 @ Return the outgoing particles PDG codes. This depends, whether this
 is a charged-current or neutral-current interaction.
 <<SF ewa: ewa data: TBP>>=
   procedure :: get_pdg_out => ewa_data_get_pdg_out
 <<SF ewa: procedures>>=
   subroutine ewa_data_get_pdg_out (data, pdg_out)
     class(ewa_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     integer, dimension(:), allocatable :: pdg1
     integer :: i, n_flv
     if (allocated (data%flv_out)) then
        n_flv = size (data%flv_out)
     else
        n_flv = 0
     end if
     allocate (pdg1 (n_flv))
     do i = 1, n_flv
        pdg1(i) = data%flv_out(i)%get_pdg ()
     end do
     pdg_out(1) = pdg1
   end subroutine ewa_data_get_pdg_out
 
 @ %def ewa_data_get_pdg_out
 @ Allocate the interaction record.
 <<SF ewa: ewa data: TBP>>=
   procedure :: allocate_sf_int => ewa_data_allocate_sf_int
 <<SF ewa: procedures>>=
   subroutine ewa_data_allocate_sf_int (data, sf_int)
     class(ewa_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (ewa_t :: sf_int)
   end subroutine ewa_data_allocate_sf_int
 
 @ %def ewa_data_allocate_sf_int
 @
 \subsection{The EWA object}
 The [[ewa_t]] data type is a $1\to 2$ interaction.  We should be able
 to handle several flavors in parallel, since EWA is not necessarily
 applied immediately after beam collision:  $W/Z$ bosons may be radiated
 from quarks.  In that case, the partons are massless and $q_{\rm min}$
 applies instead, so we do not need to generate several kinematical
 configurations in parallel.
 
 The particles are ordered as (incoming, radiated, W/Z), where the
 W/Z initiates the hard interaction.
 
 In the case of EPA, we generated an unpolarized photon and transferred
 initial polarization to the radiated parton.  Color is transferred in
 the same way. I do not know whether the same can/should be done for
 EWA, as the structure functions depend on the W/Z polarization. If we
 are having $Z$ bosons, both up- and down-type fermions can
 participate. Otherwise, with a $W^+$ an up-type fermion is transferred
 to a down-type fermion, and the other way round.
 <<SF ewa: types>>=
   type, extends (sf_int_t) :: ewa_t
      type(ewa_data_t), pointer :: data => null ()
      real(default) :: x  = 0
      real(default) :: xb = 0
      integer :: n_me = 0
      real(default), dimension(:), allocatable :: cv
      real(default), dimension(:), allocatable :: ca
    contains
    <<SF ewa: ewa: TBP>>
   end type ewa_t
 
 @ %def ewa_t
 @ Type string: has to be here, but there is no string variable on which EWA
 depends. Hence, a dummy routine.
 <<SF ewa: ewa: TBP>>=
   procedure :: type_string => ewa_type_string
 <<SF ewa: procedures>>=
   function ewa_type_string (object) result (string)
     class(ewa_t), intent(in) :: object
     type(string_t) :: string
     if (associated (object%data)) then
        string = "EWA: equivalent W/Z approx."
     else
        string = "EWA: [undefined]"
     end if
   end function ewa_type_string
 
 @ %def ewa_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF ewa: ewa: TBP>>=
   procedure :: write => ewa_write
 <<SF ewa: procedures>>=
   subroutine ewa_write (object, unit, testflag)
     class(ewa_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        if (object%status >= SF_DONE_KINEMATICS) then
           write (u, "(1x,A)")  "SF parameters:"
           write (u, "(3x,A," // FMT_17 // ")")  "x =", object%x
           write (u, "(3x,A," // FMT_17 // ")")  "xb=", object%xb
        end if
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "EWA data: [undefined]"
     end if
   end subroutine ewa_write
 
 @ %def ewa_write
 @ The current implementation requires uniform isospin for all incoming
 particles, therefore we need to probe only the first one.
 <<SF ewa: ewa: TBP>>=
   procedure :: init => ewa_init
 <<SF ewa: procedures>>=
   subroutine ewa_init (sf_int, data)
     class(ewa_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     type(quantum_numbers_mask_t), dimension(3) :: mask
     integer, dimension(3) :: hel_lock
     type(polarization_t), target :: pol
     type(quantum_numbers_t), dimension(1) :: qn_fc, qn_fc_fin
     type(flavor_t) :: flv_z, flv_wp, flv_wm
     type(color_t) :: col0
     type(quantum_numbers_t) :: qn_hel, qn_z, qn_wp, qn_wm, qn, qn_rad, qn_w
     type(polarization_iterator_t) :: it_hel
     integer :: i, isospin
     select type (data)
     type is (ewa_data_t)
        mask = quantum_numbers_mask (.false., .false., &
             mask_h = [.false., .false., .true.])
        hel_lock = [2, 1, 0]
        call col0%init ()
        select case (data%id)
        case (23)
           !!! Z boson, flavor is not changing
           call sf_int%base_init (mask, [data%mass**2], [data%mass**2], &
                [data%mZ**2], hel_lock = hel_lock)
           sf_int%data => data
           call flv_z%init (Z_BOSON, data%model)
           call qn_z%init (flv_z, col0)
           do i = 1, size (data%flv_in)
              call pol%init_generic (data%flv_in(i))
              call qn_fc(1)%init ( &
                   flv = data%flv_in(i), &
                   col = color_from_flavor (data%flv_in(i), 1))
              call it_hel%init (pol)
              do while (it_hel%is_valid ())
                 qn_hel = it_hel%get_quantum_numbers ()
                 qn = qn_hel .merge. qn_fc(1)
                 qn_rad = qn
                 call qn_rad%tag_radiated ()
                 call sf_int%add_state ([qn, qn_rad, qn_z])
                 call it_hel%advance ()
              end do
              !  call pol%final ()
           end do
        case (24)
           call sf_int%base_init (mask, [data%mass**2], [data%m_out**2], &
                [data%mW**2], hel_lock = hel_lock)
           sf_int%data => data
           call flv_wp%init (W_BOSON, data%model)
           call flv_wm%init (- W_BOSON, data%model)
           call qn_wp%init (flv_wp, col0)
           call qn_wm%init (flv_wm, col0)
           do i = 1, size (data%flv_in)
              isospin = data%flv_in(i)%get_isospin_type ()
              if (isospin > 0) then
                 !!! up-type quark or neutrinos
                 if (data%flv_in(i)%is_antiparticle ()) then
                    qn_w = qn_wm
                 else
                    qn_w = qn_wp
                 end if
              else
                 !!! down-type quark or lepton
                 if (data%flv_in(i)%is_antiparticle ()) then
                    qn_w = qn_wp
                 else
                    qn_w = qn_wm
                 end if
              end if
              call pol%init_generic (data%flv_in(i))
              call qn_fc(1)%init ( &
                   flv = data%flv_in(i), &
                   col = color_from_flavor (data%flv_in(i), 1))
              call qn_fc_fin(1)%init ( &
                   flv = data%flv_out(i), &
                   col = color_from_flavor (data%flv_out(i), 1))
              call it_hel%init (pol)
              do while (it_hel%is_valid ())
                 qn_hel = it_hel%get_quantum_numbers ()
                 qn = qn_hel .merge. qn_fc(1)
                 qn_rad = qn_hel .merge. qn_fc_fin(1)
                 call qn_rad%tag_radiated ()
                 call sf_int%add_state ([qn, qn_rad, qn_w])
                 call it_hel%advance ()
              end do
              ! call pol%final ()
           end do
        case default
           call msg_fatal ("EWA initialization failed: wrong particle type.")
        end select
        call sf_int%freeze ()
        if (data%keep_energy) then
           sf_int%on_shell_mode = KEEP_ENERGY
        else
           sf_int%on_shell_mode = KEEP_MOMENTUM
        end if
        call sf_int%set_incoming ([1])
        call sf_int%set_radiated ([2])
        call sf_int%set_outgoing ([3])
     end select
   end subroutine ewa_init
 
 @ %def ewa_init
 @ Prepare the coupling arrays.  This is separate from the previous routine since
 the state matrix may be helicity-contracted.
 <<SF ewa: ewa: TBP>>=
   procedure :: setup_constants => ewa_setup_constants
 <<SF ewa: procedures>>=
   subroutine ewa_setup_constants (sf_int)
     class(ewa_t), intent(inout), target :: sf_int
     type(state_iterator_t) :: it
     type(flavor_t) :: flv
     real(default) :: q, t3
     integer :: i
     sf_int%n_me = sf_int%get_n_matrix_elements ()
     allocate (sf_int%cv (sf_int%n_me))
     allocate (sf_int%ca (sf_int%n_me))
     associate (data => sf_int%data)
       select case (data%id)
       case (23)
          call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
          do while (it%is_valid ())
             i = it%get_me_index ()
             flv = it%get_flavor (1)
             q = flv%get_charge ()
             t3 = flv%get_isospin ()
             if (flv%is_antiparticle ()) then
                sf_int%cv(i) = - data%cv &
                     * (t3 - 2._default * q * data%sinthw**2) / data%costhw
                sf_int%ca(i) = data%ca *  t3 / data%costhw
             else
                sf_int%cv(i) = data%cv &
                     * (t3 - 2._default * q * data%sinthw**2) / data%costhw
                sf_int%ca(i) = data%ca *  t3 / data%costhw
             end if
             call it%advance ()
          end do
       case (24)
          call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
          do while (it%is_valid ())
             i = it%get_me_index ()
             flv = it%get_flavor (1)
             if (flv%is_antiparticle ()) then
                sf_int%cv(i) = data%cv / sqrt(2._default)
                sf_int%ca(i) = - data%ca / sqrt(2._default)
             else
                sf_int%cv(i) = data%cv / sqrt(2._default)
                sf_int%ca(i) = data%ca / sqrt(2._default)
             end if
             call it%advance ()
          end do
       end select
     end associate
     sf_int%status = SF_INITIAL
   end subroutine ewa_setup_constants
 
 @ %def ewa_setup_constants
 @
 \subsection{Kinematics}
 Set kinematics.  The EWA structure function allows for a
 straightforward mapping of the unit interval.  So, to leading order,
 the structure function value is unity, but the $x$ value is
 transformed.  Higher orders affect the function value.
 If [[map]] is unset, the $r$ and $x$ values coincide, and the Jacobian
 $f(r)$ is trivial.
 
 If [[map]] is set, the exponential mapping for the $1/x$ singularity
 discussed above is applied.
 <<SF ewa: ewa: TBP>>=
   procedure :: complete_kinematics => ewa_complete_kinematics
 <<SF ewa: procedures>>=
   subroutine ewa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(ewa_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     real(default) :: e_1
     real(default) :: x0, x1, lx0, lx1, lx
     e_1 = energy (sf_int%get_momentum (1))
     if (sf_int%data%recoil) then
        select case (sf_int%data%id)
        case (23)
           x0 = max (sf_int%data%x_min, sf_int%data%mz / e_1)
        case (24)
           x0 = max (sf_int%data%x_min, sf_int%data%mw / e_1)
        end select
     else
        x0 = sf_int%data%x_min
     end if
     x1 = sf_int%data%x_max
     if ( x0 >= x1) then
        f = 0
        sf_int%status = SF_FAILED_KINEMATICS
        return
     end if
     if (map) then
        lx0 = log (x0)
        lx1 = log (x1)
        lx = lx1 * r(1) + lx0 * rb(1)
        x(1) = exp(lx)
        f = x(1) * (lx1 - lx0)
     else
        x(1) = r(1)
        if (x0 < x(1) .and. x(1) < x1) then
           f = 1
        else
           sf_int%status = SF_FAILED_KINEMATICS
           f = 0
           return
        end if
     end if
     xb(1) = 1 - x(1)
     if (size(x) == 3) then
        x(2:3) = r(2:3)
        xb(2:3) = rb(2:3)
     end if
     call sf_int%split_momentum (x, xb)
     select case (sf_int%status)
     case (SF_DONE_KINEMATICS)
        sf_int%x  = x(1)
        sf_int%xb = xb(1)
     case (SF_FAILED_KINEMATICS)
        sf_int%x  = 0
        sf_int%xb = 0
        f = 0
     end select
   end subroutine ewa_complete_kinematics
 
 @ %def ewa_complete_kinematics
 @ Overriding the default method: we compute the [[x]] array from the
 momentum configuration.  In the specific case of EWA, we also set the
 internally stored $x$ and $\bar x$ values, so they can be used in the
 following routine.
 <<SF ewa: ewa: TBP>>=
   procedure :: recover_x => sf_ewa_recover_x
 <<SF ewa: procedures>>=
   subroutine sf_ewa_recover_x (sf_int, x, xb, x_free)
     class(ewa_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(inout), optional :: x_free
     call sf_int%base_recover_x (x, xb, x_free)
     sf_int%x  = x(1)
     sf_int%xb = xb(1)
   end subroutine sf_ewa_recover_x
 
 @ %def sf_ewa_recover_x
 @ Compute inverse kinematics.  Here, we start with the $x$ array and
 compute the ``input'' $r$ values and the Jacobian $f$.  After this, we
 can set momenta by the same formula as for normal kinematics.
 <<SF ewa: ewa: TBP>>=
   procedure :: inverse_kinematics => ewa_inverse_kinematics
 <<SF ewa: procedures>>=
   subroutine ewa_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(ewa_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     real(default) :: x0, x1, lx0, lx1, lx, e_1
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     e_1 = energy (sf_int%get_momentum (1))
     if (sf_int%data%recoil) then
        select case (sf_int%data%id)
        case (23)
           x0 = max (sf_int%data%x_min, sf_int%data%mz / e_1)
        case (24)
           x0 = max (sf_int%data%x_min, sf_int%data%mw / e_1)
        end select
     else
        x0 = sf_int%data%x_min
     end if
     x1 = sf_int%data%x_max
     if (map) then
        lx0 = log (x0)
        lx1 = log (x1)
        lx = log (x(1))
        r(1)  = (lx - lx0) / (lx1 - lx0)
        rb(1) = (lx1 - lx) / (lx1 - lx0)
        f = x(1) * (lx1 - lx0)
     else
        r (1) = x(1)
        rb(1) = 1 - x(1)
        if (x0 < x(1) .and. x(1) < x1) then
           f = 1
        else
           f = 0
        end if
     end if
     if (size(r) == 3) then
        r (2:3) = x(2:3)
        rb(2:3) = xb(2:3)
     end if
     if (set_mom) then
        call sf_int%split_momentum (x, xb)
        select case (sf_int%status)
        case (SF_FAILED_KINEMATICS);  f = 0
        end select
     end if
   end subroutine ewa_inverse_kinematics
 
 @ %def ewa_inverse_kinematics
 @
 \subsection{EWA application}
 For EWA, we can compute kinematics and function value in a single
 step.  This function works on a single beam, assuming that the input
 momentum has been set.  We need four random numbers as input: one for
 $x$, one for $Q^2$, and two for the polar and azimuthal angles.
 Alternatively, we can skip $p_T$ generation; in this case, we only
 need one.
 
 For obtaining splitting kinematics, we rely on the assumption that all
 in-particles are mass-degenerate (or there is only one), so the
 generated $x$ values are identical.
 <<SF ewa: ewa: TBP>>=
   procedure :: apply => ewa_apply
 <<SF ewa: procedures>>=
   subroutine ewa_apply (sf_int, scale, rescale, i_sub)
     class(ewa_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     real(default) :: x, xb, pt2, c1, c2
     real(default) :: cv, ca
     real(default) :: f, fm, fp, fL
     integer :: i
     associate (data => sf_int%data)
       x  = sf_int%x
       xb = sf_int%xb
       pt2 = min ((data%pt_max)**2, (xb * data%sqrts / 2)**2)
       select case (data%id)
       case (23)
          !!! Z boson structure function
          c1 = log (1 + pt2 / (xb * (data%mZ)**2))
          c2 = 1 / (1 + (xb * (data%mZ)**2) / pt2)
       case (24)
          !!! W boson structure function
          c1 = log (1 + pt2 / (xb * (data%mW)**2))
          c2 = 1 / (1 + (xb * (data%mW)**2) / pt2)
       end select
       do i = 1, sf_int%n_me
          cv = sf_int%cv(i)
          ca = sf_int%ca(i)
          fm = data%coeff * &
               ((cv + ca)**2 + ((cv - ca) * xb)**2) * (c1 - c2) / (2 * x)
          fp = data%coeff * &
               ((cv - ca)**2 + ((cv + ca) * xb)**2) * (c1 - c2) / (2 * x)
          fL = data%coeff * &
               (cv**2 + ca**2) * (2 * xb / x) * c2
          f = fp + fm + fL
          if (.not. vanishes (f)) then
             fp = fp / f
             fm = fm / f
             fL = fL / f
          end if
          call sf_int%set_matrix_element (i, cmplx (f, kind=default))
       end do
     end associate
     sf_int%status = SF_EVALUATED
   end subroutine ewa_apply
 
 @ %def ewa_apply
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_ewa_ut.f90]]>>=
 <<File header>>
 
 module sf_ewa_ut
   use unit_tests
   use sf_ewa_uti
 
 <<Standard module head>>
 
 <<SF ewa: public test>>
 
 contains
 
 <<SF ewa: test driver>>
 
 end module sf_ewa_ut
 @ %def sf_ewa_ut
 @
 <<[[sf_ewa_uti.f90]]>>=
 <<File header>>
 
 module sf_ewa_uti
 
 <<Use kinds>>
   use lorentz
   use pdg_arrays
   use flavors
   use interactions, only: reset_interaction_counter
   use interactions, only: interaction_pacify_momenta
   use model_data
   use sf_aux
   use sf_base
 
   use sf_ewa
 
 <<Standard module head>>
 
 <<SF ewa: test declarations>>
 
 contains
 
 <<SF ewa: tests>>
 
 end module sf_ewa_uti
 @ %def sf_ewa_ut
 @ API: driver for the unit tests below.
 <<SF ewa: public test>>=
   public :: sf_ewa_test
 <<SF ewa: test driver>>=
   subroutine sf_ewa_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF ewa: execute tests>>
   end subroutine sf_ewa_test
 
 @ %def sf_ewa_test
 @
 \subsubsection{Test structure function data}
 Construct and display a test structure function data object.
 <<SF ewa: execute tests>>=
   call test (sf_ewa_1, "sf_ewa_1", &
        "structure function configuration", &
        u, results)
 <<SF ewa: test declarations>>=
   public :: sf_ewa_1
 <<SF ewa: tests>>=
   subroutine sf_ewa_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(pdg_array_t), dimension(1) :: pdg_out
     integer, dimension(:), allocatable :: pdg1
     class(sf_data_t), allocatable :: data
 
     write (u, "(A)")  "* Test output: sf_ewa_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &test structure function data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Create empty data object"
     write (u, "(A)")
 
     call model%init_sm_test ()
     pdg_in = 2
 
     allocate (ewa_data_t :: data)
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize for Z boson"
     write (u, "(A)")
 
     select type (data)
     type is (ewa_data_t)
        call data%init (model, pdg_in, 0.01_default, &
             500._default, 5000._default, .false., .false.)
        call data%set_id (23)
     end select
 
     call data%write (u)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     write (u, "(2x,99(1x,I0))")  pdg1
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize for W boson"
     write (u, "(A)")
 
     deallocate (data)
     allocate (ewa_data_t :: data)
     select type (data)
     type is (ewa_data_t)
        call data%init (model, pdg_in, 0.01_default, &
             500._default, 5000._default, .false., .false.)
        call data%set_id (24)
     end select
 
     call data%write (u)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     write (u, "(2x,99(1x,I0))")  pdg1
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_ewa_1"
 
   end subroutine sf_ewa_1
 
 @ %def sf_ewa_1
 @
 \subsubsection{Test and probe structure function}
 Construct and display a structure function object based on the EWA
 structure function.
 <<SF ewa: execute tests>>=
   call test (sf_ewa_2, "sf_ewa_2", &
        "structure function instance", &
        u, results)
 <<SF ewa: test declarations>>=
   public :: sf_ewa_2
 <<SF ewa: tests>>=
   subroutine sf_ewa_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_ewa_2"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_sm_test ()
     call flv%init (2, model)
     pdg_in = 2
 
     call reset_interaction_counter ()
 
     allocate (ewa_data_t :: data)
     select type (data)
     type is (ewa_data_t)
        call data%init (model, pdg_in, 0.01_default, &
             500._default, 3000._default, .false., .true.)
        call data%set_id (24)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize incoming momentum with E=1500"
     write (u, "(A)")
     E = 1500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call pacify (k, 1e-10_default)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for r=0.4, no EWA mapping, collinear"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = 0.4_default
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     call sf_int%seed_kinematics ([k])
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false., &
          set_momenta=.true.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate EWA structure function"
     write (u, "(A)")
 
     call sf_int%apply (scale = 100._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_ewa_2"
 
   end subroutine sf_ewa_2
 
 @ %def sf_ewa_2
 @
 \subsubsection{Standard mapping}
 Construct and display a structure function object based on the EWA
 structure function, applying the standard single-particle mapping.
 <<SF ewa: execute tests>>=
   call test (sf_ewa_3, "sf_ewa_3", &
        "apply mapping", &
        u, results)
 <<SF ewa: test declarations>>=
   public :: sf_ewa_3
 <<SF ewa: tests>>=
   subroutine sf_ewa_3 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_ewa_3"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_sm_test ()
     call flv%init (2, model)
     pdg_in = 2
 
     call reset_interaction_counter ()
 
     allocate (ewa_data_t :: data)
     select type (data)
     type is (ewa_data_t)
        call data%init (model, pdg_in, 0.01_default, &
             500._default, 3000._default, .false., .true.)
        call data%set_id (24)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize incoming momentum with E=1500"
     write (u, "(A)")
     E = 1500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call pacify (k, 1e-10_default)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for r=0.4, with EWA mapping, collinear"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = 0.4_default
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     call sf_int%seed_kinematics ([k])
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
          set_momenta=.true.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate EWA structure function"
     write (u, "(A)")
 
     call sf_int%apply (scale = 100._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_ewa_3"
 
   end subroutine sf_ewa_3
 
 @ %def sf_ewa_3
 @
 \subsubsection{Non-collinear case}
 Construct and display a structure function object based on the EPA
 structure function.
 <<SF ewa: execute tests>>=
   call test (sf_ewa_4, "sf_ewa_4", &
        "non-collinear", &
        u, results)
 <<SF ewa: test declarations>>=
   public :: sf_ewa_4
 <<SF ewa: tests>>=
   subroutine sf_ewa_4 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_ewa_4"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call modeL%init_sm_test ()
     call flv%init (2, model)
     pdg_in = 2
 
     call reset_interaction_counter ()
 
     allocate (ewa_data_t :: data)
     select type (data)
     type is (ewa_data_t)
        call data%init (model, pdg_in, 0.01_default, &
             500._default, 3000.0_default, .true., .true.)
        call data%set_id (24)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     write (u, "(A)")  "* Initialize incoming momentum with E=1500"
     write (u, "(A)")
     E = 1500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call pacify (k, 1e-10_default)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for r=0.5/0.5/0.25, with EWA mapping, "
     write (u, "(A)")  "          non-coll., keeping energy"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = [0.5_default, 0.5_default, 0.25_default]
     rb = 1 - r
     sf_int%on_shell_mode = KEEP_ENERGY
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
     call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x and r from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     call sf_int%seed_kinematics ([k])
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
          set_momenta=.true.)
     call interaction_pacify_momenta (sf_int%interaction_t, 1e-10_default)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate EWA structure function"
     write (u, "(A)")
 
     call sf_int%apply (scale = 1500._default)
     call sf_int%write (u, testflag = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_ewa_4"
 
   end subroutine sf_ewa_4
 
 @ %def sf_ewa_4
 @
 \subsubsection{Structure function for multiple flavors}
 Construct and display a structure function object based on the EWA
 structure function.  The incoming state has multiple particles with
 non-uniform quantum numbers.
 <<SF ewa: execute tests>>=
   call test (sf_ewa_5, "sf_ewa_5", &
        "structure function instance", &
        u, results)
 <<SF ewa: test declarations>>=
   public :: sf_ewa_5
 <<SF ewa: tests>>=
   subroutine sf_ewa_5 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_ewa_5"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_sm_test ()
     call flv%init (2, model)
     pdg_in = [1, 2, -1, -2]
 
     call reset_interaction_counter ()
 
     allocate (ewa_data_t :: data)
     select type (data)
     type is (ewa_data_t)
        call data%init (model, pdg_in, 0.01_default, &
             500._default, 3000._default, .false., .true.)
        call data%set_id (24)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
     call sf_int%setup_constants ()
 
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize incoming momentum with E=1500"
     write (u, "(A)")
     E = 1500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call pacify (k, 1e-10_default)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for r=0.4, no EWA mapping, collinear"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = 0.4_default
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate EWA structure function"
     write (u, "(A)")
 
     call sf_int%apply (scale = 100._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_ewa_5"
 
   end subroutine sf_ewa_5
 
 @ %def sf_ewa_5
 @
 \clearpage
 %------------------------------------------------------------------------
 \section{Energy-scan spectrum}
 
 This spectrum is actually a trick that allows us to plot the c.m.\ energy
 dependence of a cross section without scanning the input energy.  We
 start with the observation that a spectrum $f(x)$, applied to one of
 the incoming beams only, results in a cross section
 \begin{equation}
   \sigma = \int dx\,f(x)\,\hat\sigma(xs).
 \end{equation}
 We want to compute the distribution of $E=\sqrt{\hat s}=\sqrt{xs}$, i.e.,
 \begin{equation}
   \frac{d\sigma}{dE} = \frac{2\sqrt{x}}{\sqrt{s}}\,\frac{d\sigma}{dx}
   = \frac{2\sqrt{x}}{\sqrt{s}}\,f(x)\,\hat\sigma(xs),
 \end{equation}
 so if we set
 \begin{equation}
   f(x) = \frac{\sqrt{s}}{2\sqrt{x}},
 \end{equation}
 we get the distribution
 \begin{equation}
   \frac{d\sigma}{dE} = \hat\sigma(\hat s=E^2).
 \end{equation}
 We implement this as a spectrum with a single parameter $x$.  The
 parameters for the individual beams are computed as $x_i=\sqrt{x}$, so
 they are equal and the kinematics is always symmetric.
 <<[[sf_escan.f90]]>>=
 <<File header>>
 
 module sf_escan
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_defs, only: FMT_12
   use numeric_utils
   use diagnostics
   use lorentz
   use pdg_arrays
   use model_data
   use flavors
   use quantum_numbers
   use state_matrices
   use polarizations
   use sf_base
 
 <<Standard module head>>
 
 <<SF escan: public>>
 
 <<SF escan: types>>
 
 contains
 
 <<SF escan: procedures>>
 
 end module sf_escan
 @ %def sf_escan
 @
 \subsection{Data type}
 The [[norm]] is unity if the total cross section should be normalized
 to one, and $\sqrt{s}$ if it should be normalized to the total
 energy.  In the latter case, the differential distribution
 $d\sigma/d\sqrt{\hat s}$ coincides with the partonic cross section
 $\hat\sigma$ as a function of $\sqrt{\hat s}$.
 <<SF escan: public>>=
   public :: escan_data_t
 <<SF escan: types>>=
   type, extends(sf_data_t) :: escan_data_t
      private
      type(flavor_t), dimension(:,:), allocatable :: flv_in
      integer, dimension(2) :: n_flv = 0
      real(default) :: norm = 1
    contains
    <<SF escan: escan data: TBP>>
   end type escan_data_t
 
 @  %def escan_data_t
 <<SF escan: escan data: TBP>>=
   procedure :: init => escan_data_init
 <<SF escan: procedures>>=
   subroutine escan_data_init (data, model, pdg_in, norm)
     class(escan_data_t), intent(out) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), dimension(2), intent(in) :: pdg_in
     real(default), intent(in), optional :: norm
     real(default), dimension(2) :: m2
     integer :: i, j
     data%n_flv = pdg_array_get_length (pdg_in)
     allocate (data%flv_in (maxval (data%n_flv), 2))
     do i = 1, 2
        do j = 1, data%n_flv(i)
           call data%flv_in(j, i)%init (pdg_array_get (pdg_in(i), j), model)
        end do
     end do
     m2 = data%flv_in(1,:)%get_mass ()
     do i = 1, 2
        if (.not. any (nearly_equal (data%flv_in(1:data%n_flv(i),i)%get_mass (), m2(i)))) then
           call msg_fatal ("Energy scan: incoming particle mass must be uniform")
        end if
     end do
     if (present (norm))  data%norm = norm
   end subroutine escan_data_init
 
 @ %def escan_data_init
 @ Output
 <<SF escan: escan data: TBP>>=
   procedure :: write => escan_data_write
 <<SF escan: procedures>>=
   subroutine escan_data_write (data, unit, verbose)
     class(escan_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u, i, j
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)") "Energy-scan data:"
     write (u, "(3x,A)", advance="no")  "prt_in = "
     do i = 1, 2
        if (i > 1)  write (u, "(',',1x)", advance="no")
        do j = 1, data%n_flv(i)
           if (j > 1)  write (u, "(':')", advance="no")
           write (u, "(A)", advance="no")  char (data%flv_in(j,i)%get_name ())
        end do
     end do
     write (u, *)
     write (u, "(3x,A," // FMT_12 // ")")  "norm   =", data%norm
   end subroutine escan_data_write
 
 @ %def escan_data_write
 @ Kinematics is completely collinear, hence there is only one
 parameter for a pair spectrum.
 <<SF escan: escan data: TBP>>=
   procedure :: get_n_par => escan_data_get_n_par
 <<SF escan: procedures>>=
   function escan_data_get_n_par (data) result (n)
     class(escan_data_t), intent(in) :: data
     integer :: n
     n = 1
   end function escan_data_get_n_par
 
 @ %def escan_data_get_n_par
 @ Return the outgoing particles PDG codes. This is always the same as
 the incoming particle, where we use two indices for the two beams.
 <<SF escan: escan data: TBP>>=
   procedure :: get_pdg_out => escan_data_get_pdg_out
 <<SF escan: procedures>>=
   subroutine escan_data_get_pdg_out (data, pdg_out)
     class(escan_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     integer :: i, n
     n = 2
     do i = 1, n
        pdg_out(i) = data%flv_in(1:data%n_flv(i),i)%get_pdg ()
     end do
   end subroutine escan_data_get_pdg_out
 
 @ %def escan_data_get_pdg_out
 @ Allocate the interaction record.
 <<SF escan: escan data: TBP>>=
   procedure :: allocate_sf_int => escan_data_allocate_sf_int
 <<SF escan: procedures>>=
   subroutine escan_data_allocate_sf_int (data, sf_int)
     class(escan_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (escan_t :: sf_int)
   end subroutine escan_data_allocate_sf_int
 
 @ %def escan_data_allocate_sf_int
 @
 \subsection{The Energy-scan object}
 This is a spectrum, not a radiation.  We create an interaction with
 two incoming and two outgoing particles, flavor, color, and helicity
 being carried through. $x$ nevertheless is only one-dimensional, as we
 are always using only one beam parameter.
 <<SF escan: types>>=
   type, extends (sf_int_t) :: escan_t
      type(escan_data_t), pointer :: data => null ()
    contains
    <<SF escan: escan: TBP>>
   end type escan_t
 
 @ %def escan_t
 @ Type string: for the energy scan this is just a dummy function.
 <<SF escan: escan: TBP>>=
   procedure :: type_string => escan_type_string
 <<SF escan: procedures>>=
   function escan_type_string (object) result (string)
     class(escan_t), intent(in) :: object
     type(string_t) :: string
     if (associated (object%data)) then
        string = "Escan: energy scan"
     else
        string = "Escan: [undefined]"
     end if
   end function escan_type_string
 
 @ %def escan_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF escan: escan: TBP>>=
   procedure :: write => escan_write
 <<SF escan: procedures>>=
   subroutine escan_write (object, unit, testflag)
     class(escan_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "Energy scan data: [undefined]"
     end if
   end subroutine escan_write
 
 @ %def escan_write
 @
 <<SF escan: escan: TBP>>=
   procedure :: init => escan_init
 <<SF escan: procedures>>=
   subroutine escan_init (sf_int, data)
     class(escan_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     type(quantum_numbers_mask_t), dimension(4) :: mask
     integer, dimension(4) :: hel_lock
     real(default), dimension(2) :: m2
     real(default), dimension(0) :: mr2
     type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
     type(polarization_t), target :: pol1, pol2
     type(polarization_iterator_t) :: it_hel1, it_hel2
     integer :: j1, j2
     select type (data)
     type is (escan_data_t)
        hel_lock = [3, 4, 1, 2]
        m2 = data%flv_in(1,:)%get_mass ()
        call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
        sf_int%data => data
        do j1 = 1, data%n_flv(1)
           call qn_fc(1)%init ( &
                flv = data%flv_in(j1,1), &
                col = color_from_flavor (data%flv_in(j1,1)))
           call qn_fc(3)%init ( &
                flv = data%flv_in(j1,1), &
                col = color_from_flavor (data%flv_in(j1,1)))
           call pol1%init_generic (data%flv_in(j1,1))
           do j2 = 1, data%n_flv(2)
              call qn_fc(2)%init ( &
                   flv = data%flv_in(j2,2), &
                   col = color_from_flavor (data%flv_in(j2,2)))
              call qn_fc(4)%init ( &
                   flv = data%flv_in(j2,2), &
                   col = color_from_flavor (data%flv_in(j2,2)))
              call pol2%init_generic (data%flv_in(j2,2))
              call it_hel1%init (pol1)
              do while (it_hel1%is_valid ())
                 qn_hel(1) = it_hel1%get_quantum_numbers ()
                 qn_hel(3) = it_hel1%get_quantum_numbers ()
                 call it_hel2%init (pol2)
                 do while (it_hel2%is_valid ())
                    qn_hel(2) = it_hel2%get_quantum_numbers ()
                    qn_hel(4) = it_hel2%get_quantum_numbers ()
                    qn = qn_hel .merge. qn_fc
                    call sf_int%add_state (qn)
                    call it_hel2%advance ()
                 end do
                 call it_hel1%advance ()
              end do
              ! call pol2%final ()
           end do
           ! call pol1%final ()
        end do
        call sf_int%set_incoming ([1,2])
        call sf_int%set_outgoing ([3,4])
        call sf_int%freeze ()
        sf_int%status = SF_INITIAL
     end select
   end subroutine escan_init
 
 @ %def escan_init
 @
 \subsection{Kinematics}
 Set kinematics.  We have a single parameter, but reduce both beams.
 The [[map]] flag is ignored.
 <<SF escan: escan: TBP>>=
   procedure :: complete_kinematics => escan_complete_kinematics
 <<SF escan: procedures>>=
   subroutine escan_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(escan_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default) :: sqrt_x
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     x = r
     xb= rb
     sqrt_x = sqrt (x(1))
     if (sqrt_x > 0) then
        f = 1 / (2 * sqrt_x)
     else
        f = 0
        sf_int%status = SF_FAILED_KINEMATICS
        return
     end if
     call sf_int%reduce_momenta ([sqrt_x, sqrt_x])
   end subroutine escan_complete_kinematics
 
 @ %def escan_complete_kinematics
 @ Recover $x$.  The base procedure should return two momentum
 fractions for the two beams, while we have only one parameter.  This
 is the product of the extracted momentum fractions.
 <<SF escan: escan: TBP>>=
   procedure :: recover_x => escan_recover_x
 <<SF escan: procedures>>=
   subroutine escan_recover_x (sf_int, x, xb, x_free)
     class(escan_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(inout), optional :: x_free
     real(default), dimension(2) :: xi, xib
     call sf_int%base_recover_x (xi, xib, x_free)
     x = product (xi)
     xb= 1 - x
   end subroutine escan_recover_x
 
 @ %def escan_recover_x
 @ Compute inverse kinematics.
 <<SF escan: escan: TBP>>=
   procedure :: inverse_kinematics => escan_inverse_kinematics
 <<SF escan: procedures>>=
   subroutine escan_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(escan_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     real(default) :: sqrt_x
     logical :: set_mom
 
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     sqrt_x = sqrt (x(1))
     if (sqrt_x > 0) then
        f = 1 / (2 * sqrt_x)
     else
        f = 0
        sf_int%status = SF_FAILED_KINEMATICS
        return
     end if
     r = x
     rb = xb
     if (set_mom) then
        call sf_int%reduce_momenta ([sqrt_x, sqrt_x])
     end if
   end subroutine escan_inverse_kinematics
 
 @ %def escan_inverse_kinematics
 @
 \subsection{Energy scan application}
 Here, we insert the predefined norm.
 <<SF escan: escan: TBP>>=
   procedure :: apply => escan_apply
 <<SF escan: procedures>>=
   subroutine escan_apply (sf_int, scale, rescale, i_sub)
     class(escan_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     real(default) :: f
     associate (data => sf_int%data)
       f = data%norm
     end associate
     call sf_int%set_matrix_element (cmplx (f, kind=default))
     sf_int%status = SF_EVALUATED
   end subroutine escan_apply
 
 @ %def escan_apply
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_escan_ut.f90]]>>=
 <<File header>>
 
 module sf_escan_ut
   use unit_tests
   use sf_escan_uti
 
 <<Standard module head>>
 
 <<SF escan: public test>>
 
 contains
 
 <<SF escan: test driver>>
 
 end module sf_escan_ut
 @ %def sf_escan_ut
 @
 <<[[sf_escan_uti.f90]]>>=
 <<File header>>
 
 module sf_escan_uti
 
 <<Use kinds>>
   use physics_defs, only: ELECTRON
   use lorentz
   use pdg_arrays
   use flavors
   use interactions, only: reset_interaction_counter
   use model_data
   use sf_aux
   use sf_base
 
   use sf_escan
 
 <<Standard module head>>
 
 <<SF escan: test declarations>>
 
 contains
 
 <<SF escan: tests>>
 
 end module sf_escan_uti
 @ %def sf_escan_ut
 @ API: driver for the unit tests below.
 <<SF escan: public test>>=
   public :: sf_escan_test
 <<SF escan: test driver>>=
   subroutine sf_escan_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF escan: execute tests>>
   end subroutine sf_escan_test
 
 @ %def sf_escan_test
 @
 \subsubsection{Test structure function data}
 Construct and display a test structure function data object.
 <<SF escan: execute tests>>=
   call test (sf_escan_1, "sf_escan_1", &
        "structure function configuration", &
        u, results)
 <<SF escan: test declarations>>=
   public :: sf_escan_1
 <<SF escan: tests>>=
   subroutine sf_escan_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t), dimension(2) :: pdg_in
     type(pdg_array_t), dimension(2) :: pdg_out
     integer, dimension(:), allocatable :: pdg1, pdg2
     class(sf_data_t), allocatable :: data
 
     write (u, "(A)")  "* Test output: sf_escan_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &energy-scan structure function data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     pdg_in(1) = ELECTRON
     pdg_in(2) = -ELECTRON
 
     allocate (escan_data_t :: data)
     select type (data)
     type is (escan_data_t)
        call data%init (model, pdg_in, norm = 2._default)
     end select
 
     call data%write (u)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     pdg2 = pdg_out(2)
     write (u, "(2x,99(1x,I0))")  pdg1, pdg2
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_escan_1"
 
   end subroutine sf_escan_1
 
 @ %def sf_escan_1
 g@
 \subsubsection{Probe the structure-function object}
 Active the beam event reader, generate an event.
 <<SF escan: execute tests>>=
   call test (sf_escan_2, "sf_escan_2", &
        "generate event", &
        u, results)
 <<SF escan: test declarations>>=
   public :: sf_escan_2
 <<SF escan: tests>>=
   subroutine sf_escan_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t), dimension(2) :: flv
     type(pdg_array_t), dimension(2) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k1, k2
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: x_free, f
 
     write (u, "(A)")  "* Test output: sf_escan_2"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &beam-events structure function data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     call flv(1)%init (ELECTRON, model)
     call flv(2)%init (-ELECTRON, model)
     pdg_in(1) = ELECTRON
     pdg_in(2) = -ELECTRON
 
     call reset_interaction_counter ()
 
     allocate (escan_data_t :: data)
     select type (data)
     type is (escan_data_t)
        call data%init (model, pdg_in)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1,2])
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 250
     k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
     k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
     call vector4_write (k1, u)
     call vector4_write (k2, u)
     call sf_int%seed_kinematics ([k1, k2])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set dummy parameters and generate x"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r  = 0.8
     rb = 1 - r
     x_free = 1
 
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
     write (u, "(A,9(1x,F10.7))")  "xf=", x_free
 
     write (u, "(A)")
     write (u, "(A)")  "* Inverse kinematics"
     write (u, "(A)")
 
     call sf_int%recover_x (x, xb, x_free)
     call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
     write (u, "(A,9(1x,F10.7))")  "xf=", x_free
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate"
     write (u, "(A)")
 
     call sf_int%apply (scale = 0._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_escan_2"
 
   end subroutine sf_escan_2
 
 @ %def sf_escan_2
 @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Gaussian beam spread}
 
 Instead of an analytic beam description, beam data may be provided in
 form of an event file.  In its most simple form, the event file
 contains pairs of $x$ values, relative to nominal beam energies.  More
 advanced formats may include polarization, etc.  The current
 implementation carries beam polarization through, if specified.
 
 The code is very similar to the energy scan described above.
 
 However, we must include a file-handle manager for the beam-event
 files.  Two different processes may access a given beam-event file at
 the same time (i.e., serially but alternating).  Accessing an open
 file from two different units is non-standard and not supported by all
 compilers.  Therefore, we keep a global registry of open files,
 associated units, and reference counts.  The [[gaussian_t]] objects
 act as proxies to this registry.
 <<[[sf_gaussian.f90]]>>=
 <<File header>>
 
 module sf_gaussian
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_defs, only: FMT_12
   use file_registries
   use diagnostics
   use lorentz
   use rng_base
   use pdg_arrays
   use model_data
   use flavors
   use quantum_numbers
   use state_matrices
   use polarizations
   use sf_base
 
 <<Standard module head>>
 
 <<SF gaussian: public>>
 
 <<SF gaussian: types>>
 
 contains
 
 <<SF gaussian: procedures>>
 
 end module sf_gaussian
 @ %def sf_gaussian
 @
 \subsection{The beam-data file registry}
 We manage data files via the [[file_registries]] module.  To this end,
 we keep the registry as a private module variable here.
 <<CCC SF gaussian: variables>>=
   type(file_registry_t), save :: beam_file_registry
 
 @ %def beam_file_registry
 @
 \subsection{Data type}
 We store the spread for each beam, as a relative number related to the beam
 energy.  For the actual generation, we include an (abstract) random-number
 generator factory.
 <<SF gaussian: public>>=
   public :: gaussian_data_t
 <<SF gaussian: types>>=
   type, extends(sf_data_t) :: gaussian_data_t
      private
      type(flavor_t), dimension(2) :: flv_in
      real(default), dimension(2) :: spread
      class(rng_factory_t), allocatable :: rng_factory
    contains
    <<SF gaussian: gaussian data: TBP>>
   end type gaussian_data_t
 
 @  %def gaussian_data_t
 <<SF gaussian: gaussian data: TBP>>=
   procedure :: init => gaussian_data_init
 <<SF gaussian: procedures>>=
   subroutine gaussian_data_init (data, model, pdg_in, spread, rng_factory)
     class(gaussian_data_t), intent(out) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), dimension(2), intent(in) :: pdg_in
     real(default), dimension(2), intent(in) :: spread
     class(rng_factory_t), intent(inout), allocatable :: rng_factory
     if (any (spread < 0)) then
        call msg_fatal ("Gaussian beam spread: must not be negative")
     end if
     call data%flv_in(1)%init (pdg_array_get (pdg_in(1), 1), model)
     call data%flv_in(2)%init (pdg_array_get (pdg_in(2), 1), model)
     data%spread = spread
     call move_alloc (from = rng_factory, to = data%rng_factory)
   end subroutine gaussian_data_init
 
 @ %def gaussian_data_init
 @ Return true since this spectrum is always in generator mode.
 <<SF gaussian: gaussian data: TBP>>=
   procedure :: is_generator => gaussian_data_is_generator
 <<SF gaussian: procedures>>=
   function gaussian_data_is_generator (data) result (flag)
     class(gaussian_data_t), intent(in) :: data
     logical :: flag
     flag = .true.
   end function gaussian_data_is_generator
 
 @ %def gaussian_data_is_generator
 @ The number of parameters is two.  They are free parameters.
 <<SF gaussian: gaussian data: TBP>>=
   procedure :: get_n_par => gaussian_data_get_n_par
 <<SF gaussian: procedures>>=
   function gaussian_data_get_n_par (data) result (n)
     class(gaussian_data_t), intent(in) :: data
     integer :: n
     n = 2
   end function gaussian_data_get_n_par
 
 @ %def gaussian_data_get_n_par
 <<SF gaussian: gaussian data: TBP>>=
   procedure :: get_pdg_out => gaussian_data_get_pdg_out
 <<SF gaussian: procedures>>=
   subroutine gaussian_data_get_pdg_out (data, pdg_out)
     class(gaussian_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     integer :: i, n
     n = 2
     do i = 1, n
        pdg_out(i) = data%flv_in(i)%get_pdg ()
     end do
   end subroutine gaussian_data_get_pdg_out
 
 @ %def gaussian_data_get_pdg_out
 @ Allocate the interaction record.
 <<SF gaussian: gaussian data: TBP>>=
   procedure :: allocate_sf_int => gaussian_data_allocate_sf_int
 <<SF gaussian: procedures>>=
   subroutine gaussian_data_allocate_sf_int (data, sf_int)
     class(gaussian_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (gaussian_t :: sf_int)
   end subroutine gaussian_data_allocate_sf_int
 
 @ %def gaussian_data_allocate_sf_int
 @ Output
 <<SF gaussian: gaussian data: TBP>>=
   procedure :: write => gaussian_data_write
 <<SF gaussian: procedures>>=
   subroutine gaussian_data_write (data, unit, verbose)
     class(gaussian_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)") "Gaussian beam spread data:"
     write (u, "(3x,A,A,A,A)") "prt_in = ", &
          char (data%flv_in(1)%get_name ()), &
          ", ", char (data%flv_in(2)%get_name ())
     write (u, "(3x,A,2(1x," // FMT_12 // "))") "spread =", data%spread
     call data%rng_factory%write (u)
   end subroutine gaussian_data_write
 
 @ %def gaussian_data_write
 @
 \subsection{The gaussian object}
 Flavor and polarization carried through, no radiated particles.  The generator
 needs a random-number generator, obviously.
 <<SF gaussian: public>>=
   public :: gaussian_t
 <<SF gaussian: types>>=
   type, extends (sf_int_t) :: gaussian_t
      type(gaussian_data_t), pointer :: data => null ()
      class(rng_t), allocatable :: rng
    contains
    <<SF gaussian: gaussian: TBP>>
   end type gaussian_t
 
 @ %def gaussian_t
 @ Type string: show gaussian file.
 <<SF gaussian: gaussian: TBP>>=
   procedure :: type_string => gaussian_type_string
 <<SF gaussian: procedures>>=
   function gaussian_type_string (object) result (string)
     class(gaussian_t), intent(in) :: object
     type(string_t) :: string
     if (associated (object%data)) then
        string = "Gaussian: gaussian beam-energy spread"
     else
        string = "Gaussian: [undefined]"
     end if
   end function gaussian_type_string
 
 @ %def gaussian_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF gaussian: gaussian: TBP>>=
   procedure :: write => gaussian_write
 <<SF gaussian: procedures>>=
   subroutine gaussian_write (object, unit, testflag)
     class(gaussian_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        call object%rng%write (u)
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "gaussian data: [undefined]"
     end if
   end subroutine gaussian_write
 
 @ %def gaussian_write
 @
 <<SF gaussian: gaussian: TBP>>=
   procedure :: init => gaussian_init
 <<SF gaussian: procedures>>=
   subroutine gaussian_init (sf_int, data)
     class(gaussian_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     real(default), dimension(2) :: m2
     real(default), dimension(0) :: mr2
     type(quantum_numbers_mask_t), dimension(4) :: mask
     integer, dimension(4) :: hel_lock
     type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
     type(polarization_t), target :: pol1, pol2
     type(polarization_iterator_t) :: it_hel1, it_hel2
     integer :: i
     select type (data)
     type is (gaussian_data_t)
        m2 = data%flv_in%get_mass () ** 2
        hel_lock = [3, 4, 1, 2]
        mask = quantum_numbers_mask (.false., .false., .false.)
        call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
        sf_int%data => data
        do i = 1, 2
           call qn_fc(i)%init ( &
                flv = data%flv_in(i), &
                col = color_from_flavor (data%flv_in(i)))
           call qn_fc(i+2)%init ( &
                flv = data%flv_in(i), &
                col = color_from_flavor (data%flv_in(i)))
        end do
        call pol1%init_generic (data%flv_in(1))
        call it_hel1%init (pol1)
        do while (it_hel1%is_valid ())
           qn_hel(1) = it_hel1%get_quantum_numbers ()
           qn_hel(3) = it_hel1%get_quantum_numbers ()
           call pol2%init_generic (data%flv_in(2))
           call it_hel2%init (pol2)
           do while (it_hel2%is_valid ())
              qn_hel(2) = it_hel2%get_quantum_numbers ()
              qn_hel(4) = it_hel2%get_quantum_numbers ()
              qn = qn_hel .merge. qn_fc
              call sf_int%add_state (qn)
              call it_hel2%advance ()
           end do
           ! call pol2%final ()
           call it_hel1%advance ()
        end do
        ! call pol1%final ()
        call sf_int%freeze ()
        call sf_int%set_incoming ([1,2])
        call sf_int%set_outgoing ([3,4])
        sf_int%status = SF_INITIAL
     end select
     call sf_int%data%rng_factory%make (sf_int%rng)
   end subroutine gaussian_init
 
 @ %def gaussian_init
 @ This spectrum type needs a finalizer, which closes the data file.
 <<SF gaussian: gaussian: TBP>>=
   procedure :: final => sf_gaussian_final
 <<SF gaussian: procedures>>=
   subroutine sf_gaussian_final (object)
     class(gaussian_t), intent(inout) :: object
     call object%interaction_t%final ()
   end subroutine sf_gaussian_final
 
 @ %def sf_gaussian_final
 @
 \subsection{Kinematics}
 Refer to the [[data]] component.
 <<SF gaussian: gaussian: TBP>>=
   procedure :: is_generator => gaussian_is_generator
 <<SF gaussian: procedures>>=
   function gaussian_is_generator (sf_int) result (flag)
     class(gaussian_t), intent(in) :: sf_int
     logical :: flag
     flag = sf_int%data%is_generator ()
   end function gaussian_is_generator
 
 @ %def gaussian_is_generator
 @ Generate free parameters.  The $x$ value should be distributed with mean $1$
 and $\sigma$ given by the spread.  We reject negative $x$ values.  (This
 cut slightly biases the distribution, but for reasonable (small)
 spreads negative $r$ should not occur.
 <<SF gaussian: gaussian: TBP>>=
   procedure :: generate_free => gaussian_generate_free
 <<SF gaussian: procedures>>=
   subroutine gaussian_generate_free (sf_int, r, rb, x_free)
     class(gaussian_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(inout) :: x_free
     real(default), dimension(size(r)) :: z
     associate (data => sf_int%data)
       do
          call sf_int%rng%generate_gaussian (z)
          rb = z * data%spread
          r = 1 - rb
          x_free = x_free * product (r)
          if (all (r > 0))  exit
       end do
     end associate
   end subroutine gaussian_generate_free
 
 @ %def gaussian_generate_free
 @ Set kinematics.  Trivial transfer since this is a pure generator.
 The [[map]] flag doesn't apply.
 <<SF gaussian: gaussian: TBP>>=
   procedure :: complete_kinematics => gaussian_complete_kinematics
 <<SF gaussian: procedures>>=
   subroutine gaussian_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(gaussian_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     if (map) then
        call msg_fatal ("gaussian: map flag not supported")
     else
        x = r
        xb= rb
        f = 1
     end if
     call sf_int%reduce_momenta (x)
   end subroutine gaussian_complete_kinematics
 
 @ %def gaussian_complete_kinematics
 @ Compute inverse kinematics.  Trivial in this case.
 <<SF gaussian: gaussian: TBP>>=
   procedure :: inverse_kinematics => gaussian_inverse_kinematics
 <<SF gaussian: procedures>>=
   subroutine gaussian_inverse_kinematics &
        (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(gaussian_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     if (map) then
        call msg_fatal ("gaussian: map flag not supported")
     else
        r = x
        rb= xb
        f = 1
     end if
     if (set_mom) then
        call sf_int%reduce_momenta (x)
     end if
   end subroutine gaussian_inverse_kinematics
 
 @ %def gaussian_inverse_kinematics
 @
 \subsection{gaussian application}
 Trivial, just set the unit weight.
 <<SF gaussian: gaussian: TBP>>=
   procedure :: apply => gaussian_apply
 <<SF gaussian: procedures>>=
   subroutine gaussian_apply (sf_int, scale, rescale, i_sub)
     class(gaussian_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     real(default) :: f
     f = 1
     call sf_int%set_matrix_element (cmplx (f, kind=default))
     sf_int%status = SF_EVALUATED
   end subroutine gaussian_apply
 
 @ %def gaussian_apply
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_gaussian_ut.f90]]>>=
 <<File header>>
 
 module sf_gaussian_ut
   use unit_tests
   use sf_gaussian_uti
 
 <<Standard module head>>
 
 <<SF gaussian: public test>>
 
 contains
 
 <<SF gaussian: test driver>>
 
 end module sf_gaussian_ut
 @ %def sf_gaussian_ut
 @
 <<[[sf_gaussian_uti.f90]]>>=
 <<File header>>
 
 module sf_gaussian_uti
 
 <<Use kinds>>
   use physics_defs, only: ELECTRON
   use lorentz
   use pdg_arrays
   use flavors
   use interactions, only: reset_interaction_counter
   use model_data
   use rng_base
   use sf_aux
   use sf_base
 
   use sf_gaussian
 
   use rng_base_ut, only: rng_test_factory_t
 
 <<Standard module head>>
 
 <<SF gaussian: test declarations>>
 
 contains
 
 <<SF gaussian: tests>>
 
 end module sf_gaussian_uti
 @ %def sf_gaussian_ut
 @ API: driver for the unit tests below.
 <<SF gaussian: public test>>=
   public :: sf_gaussian_test
 <<SF gaussian: test driver>>=
   subroutine sf_gaussian_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF gaussian: execute tests>>
   end subroutine sf_gaussian_test
 
 @ %def sf_gaussian_test
 @
 \subsubsection{Test structure function data}
 Construct and display a test structure function data object.
 <<SF gaussian: execute tests>>=
   call test (sf_gaussian_1, "sf_gaussian_1", &
        "structure function configuration", &
        u, results)
 <<SF gaussian: test declarations>>=
   public :: sf_gaussian_1
 <<SF gaussian: tests>>=
   subroutine sf_gaussian_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t), dimension(2) :: pdg_in
     type(pdg_array_t), dimension(2) :: pdg_out
     integer, dimension(:), allocatable :: pdg1, pdg2
     class(sf_data_t), allocatable :: data
     class(rng_factory_t), allocatable :: rng_factory
 
     write (u, "(A)")  "* Test output: sf_gaussian_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &gaussian-spread structure function data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     pdg_in(1) = ELECTRON
     pdg_in(2) = -ELECTRON
 
     allocate (gaussian_data_t :: data)
     allocate (rng_test_factory_t :: rng_factory)
     select type (data)
     type is (gaussian_data_t)
        call data%init (model, pdg_in, [1e-2_default, 2e-2_default], rng_factory)
     end select
 
     call data%write (u)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     pdg2 = pdg_out(2)
     write (u, "(2x,99(1x,I0))")  pdg1, pdg2
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_gaussian_1"
 
   end subroutine sf_gaussian_1
 
 @ %def sf_gaussian_1
 @
 \subsubsection{Probe the structure-function object}
 Active the beam event reader, generate an event.
 <<SF gaussian: execute tests>>=
   call test (sf_gaussian_2, "sf_gaussian_2", &
        "generate event", &
        u, results)
 <<SF gaussian: test declarations>>=
   public :: sf_gaussian_2
 <<SF gaussian: tests>>=
   subroutine sf_gaussian_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t), dimension(2) :: flv
     type(pdg_array_t), dimension(2) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(rng_factory_t), allocatable :: rng_factory
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k1, k2
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: x_free, f
     integer :: i
 
     write (u, "(A)")  "* Test output: sf_gaussian_2"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &gaussian-spread structure function data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     call flv(1)%init (ELECTRON, model)
     call flv(2)%init (-ELECTRON, model)
     pdg_in(1) = ELECTRON
     pdg_in(2) = -ELECTRON
 
     call reset_interaction_counter ()
 
     allocate (gaussian_data_t :: data)
     allocate (rng_test_factory_t :: rng_factory)
     select type (data)
     type is (gaussian_data_t)
        call data%init (model, pdg_in, [1e-2_default, 2e-2_default], rng_factory)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1,2])
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 250
     k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
     k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
     call vector4_write (k1, u)
     call vector4_write (k2, u)
     call sf_int%seed_kinematics ([k1, k2])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set dummy parameters and generate x."
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r  = 0
     rb = 0
     x_free = 1
     call sf_int%generate_free (r, rb, x_free)
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call pacify (rb, 1.e-8_default)
     call pacify (xb, 1.e-8_default)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
     write (u, "(A,9(1x,F10.7))")  "xf=", x_free
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate"
     write (u, "(A)")
 
     call sf_int%apply (scale = 0._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate more events"
     write (u, "(A)")
 
     select type (sf_int)
     type is (gaussian_t)
        do i = 1, 3
           call sf_int%generate_free (r, rb, x_free)
           write (u, "(A,9(1x,F10.7))")  "r =", r
        end do
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_gaussian_2"
 
   end subroutine sf_gaussian_2
 
 @ %def sf_gaussian_2
 @
 \clearpage
 @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Using beam event data}
 
 Instead of an analytic beam description, beam data may be provided in
 form of an event file.  In its most simple form, the event file
 contains pairs of $x$ values, relative to nominal beam energies.  More
 advanced formats may include polarization, etc.  The current
 implementation carries beam polarization through, if specified.
 
 The code is very similar to the energy scan described above.
 
 However, we must include a file-handle manager for the beam-event
 files.  Two different processes may access a given beam-event file at
 the same time (i.e., serially but alternating).  Accessing an open
 file from two different units is non-standard and not supported by all
 compilers.  Therefore, we keep a global registry of open files,
 associated units, and reference counts.  The [[beam_events_t]] objects
 act as proxies to this registry.
 <<[[sf_beam_events.f90]]>>=
 <<File header>>
 
 module sf_beam_events
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use file_registries
   use diagnostics
   use lorentz
   use pdg_arrays
   use model_data
   use flavors
   use quantum_numbers
   use state_matrices
   use polarizations
   use sf_base
 
 <<Standard module head>>
 
 <<SF beam events: public>>
 
 <<SF beam events: types>>
 
 <<SF beam events: variables>>
 
 contains
 
 <<SF beam events: procedures>>
 
 end module sf_beam_events
 @ %def sf_beam_events
 @
 \subsection{The beam-data file registry}
 We manage data files via the [[file_registries]] module.  To this end,
 we keep the registry as a private module variable here.
 
 This is public only for the unit tests.
 <<SF beam events: public>>=
   public :: beam_file_registry
 <<SF beam events: variables>>=
   type(file_registry_t), save :: beam_file_registry
 
 @ %def beam_file_registry
 @
 \subsection{Data type}
 <<SF beam events: public>>=
   public :: beam_events_data_t
 <<SF beam events: types>>=
   type, extends(sf_data_t) :: beam_events_data_t
      private
      type(flavor_t), dimension(2) :: flv_in
      type(string_t) :: dir
      type(string_t) :: file
      type(string_t) :: fqn
      integer :: unit = 0
      logical :: warn_eof = .true.
    contains
    <<SF beam events: beam events data: TBP>>
   end type beam_events_data_t
 
 @  %def beam_events_data_t
 <<SF beam events: beam events data: TBP>>=
   procedure :: init => beam_events_data_init
 <<SF beam events: procedures>>=
   subroutine beam_events_data_init (data, model, pdg_in, dir, file, warn_eof)
     class(beam_events_data_t), intent(out) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), dimension(2), intent(in) :: pdg_in
     type(string_t), intent(in) :: dir
     type(string_t), intent(in) :: file
     logical, intent(in), optional :: warn_eof
     if (any (pdg_array_get_length (pdg_in) /= 1)) then
        call msg_fatal ("Beam events: incoming beam particles must be unique")
     end if
     call data%flv_in(1)%init (pdg_array_get (pdg_in(1), 1), model)
     call data%flv_in(2)%init (pdg_array_get (pdg_in(2), 1), model)
     data%dir = dir
     data%file = file
     if (present (warn_eof))  data%warn_eof = warn_eof
   end subroutine beam_events_data_init
 
 @ %def beam_events_data_init
 @ Return true since this spectrum is always in generator mode.
 <<SF beam events: beam events data: TBP>>=
   procedure :: is_generator => beam_events_data_is_generator
 <<SF beam events: procedures>>=
   function beam_events_data_is_generator (data) result (flag)
     class(beam_events_data_t), intent(in) :: data
     logical :: flag
     flag = .true.
   end function beam_events_data_is_generator
 
 @ %def beam_events_data_is_generator
 @ The number of parameters is two.  They are free parameters.
 <<SF beam events: beam events data: TBP>>=
   procedure :: get_n_par => beam_events_data_get_n_par
 <<SF beam events: procedures>>=
   function beam_events_data_get_n_par (data) result (n)
     class(beam_events_data_t), intent(in) :: data
     integer :: n
     n = 2
   end function beam_events_data_get_n_par
 
 @ %def beam_events_data_get_n_par
 <<SF beam events: beam events data: TBP>>=
   procedure :: get_pdg_out => beam_events_data_get_pdg_out
 <<SF beam events: procedures>>=
   subroutine beam_events_data_get_pdg_out (data, pdg_out)
     class(beam_events_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     integer :: i, n
     n = 2
     do i = 1, n
        pdg_out(i) = data%flv_in(i)%get_pdg ()
     end do
   end subroutine beam_events_data_get_pdg_out
 
 @ %def beam_events_data_get_pdg_out
 @ Allocate the interaction record.
 <<SF beam events: beam events data: TBP>>=
   procedure :: allocate_sf_int => beam_events_data_allocate_sf_int
 <<SF beam events: procedures>>=
   subroutine beam_events_data_allocate_sf_int (data, sf_int)
     class(beam_events_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (beam_events_t :: sf_int)
   end subroutine beam_events_data_allocate_sf_int
 
 @ %def beam_events_data_allocate_sf_int
 @ Output
 <<SF beam events: beam events data: TBP>>=
   procedure :: write => beam_events_data_write
 <<SF beam events: procedures>>=
   subroutine beam_events_data_write (data, unit, verbose)
     class(beam_events_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)") "Beam-event file data:"
     write (u, "(3x,A,A,A,A)") "prt_in = ", &
          char (data%flv_in(1)%get_name ()), &
          ", ", char (data%flv_in(2)%get_name ())
     write (u, "(3x,A,A,A)") "file   = '", char (data%file), "'"
     write (u, "(3x,A,I0)")  "unit   = ", data%unit
     write (u, "(3x,A,L1)")  "warn   = ", data%warn_eof
   end subroutine beam_events_data_write
 
 @ %def beam_events_data_write
 @ The data file needs to be opened and closed explicitly.  The
 open/close message is communicated to the file handle registry, which
 does the actual work.
 
 We determine first whether to look in the local directory or in the
 given system directory.
 <<SF beam events: beam events data: TBP>>=
   procedure :: open => beam_events_data_open
   procedure :: close => beam_events_data_close
 <<SF beam events: procedures>>=
   subroutine beam_events_data_open (data)
     class(beam_events_data_t), intent(inout) :: data
     logical :: exist
     if (data%unit == 0) then
        data%fqn = data%file
        if (data%fqn == "") &
             call msg_fatal ("Beam events: $beam_events_file is not set")
        inquire (file = char (data%fqn), exist = exist)
        if (.not. exist) then
           data%fqn = data%dir // "/" // data%file
           inquire (file = char (data%fqn), exist = exist)
           if (.not. exist) then
              data%fqn = ""
              call msg_fatal ("Beam events: file '" &
                   // char (data%file) // "' not found")
              return
           end if
        end if
        call msg_message ("Beam events: reading from file '" &
             // char (data%file) // "'")
        call beam_file_registry%open (data%fqn, data%unit)
     else
        call msg_bug ("Beam events: file '" &
          // char (data%file) // "' is already open")
     end if
   end subroutine beam_events_data_open
 
   subroutine beam_events_data_close (data)
     class(beam_events_data_t), intent(inout) :: data
     if (data%unit /= 0) then
        call beam_file_registry%close (data%fqn)
        call msg_message ("Beam events: closed file '" &
          // char (data%file) // "'")
        data%unit = 0
     end if
   end subroutine beam_events_data_close
 
 @ %def beam_events_data_close
 @ Return the beam event file.
 <<SF beam events: beam events data: TBP>>=
   procedure :: get_beam_file => beam_events_data_get_beam_file
 <<SF beam events: procedures>>=
   function beam_events_data_get_beam_file (data) result (file)
     class(beam_events_data_t), intent(in) :: data
     type(string_t) :: file
     file = "Beam events: " // data%file
   end function beam_events_data_get_beam_file
 
 @ %def beam_events_data_get_beam_file
 @
 \subsection{The beam events object}
 Flavor and polarization carried through, no radiated particles.
 <<SF beam events: public>>=
   public :: beam_events_t
 <<SF beam events: types>>=
   type, extends (sf_int_t) :: beam_events_t
      type(beam_events_data_t), pointer :: data => null ()
      integer :: count = 0
    contains
    <<SF beam events: beam events: TBP>>
   end type beam_events_t
 
 @ %def beam_events_t
 @ Type string: show beam events file.
 <<SF beam events: beam events: TBP>>=
   procedure :: type_string => beam_events_type_string
 <<SF beam events: procedures>>=
   function beam_events_type_string (object) result (string)
     class(beam_events_t), intent(in) :: object
     type(string_t) :: string
     if (associated (object%data)) then
        string = "Beam events: " // object%data%file
     else
        string = "Beam events: [undefined]"
     end if
   end function beam_events_type_string
 
 @ %def beam_events_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF beam events: beam events: TBP>>=
   procedure :: write => beam_events_write
 <<SF beam events: procedures>>=
   subroutine beam_events_write (object, unit, testflag)
     class(beam_events_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "Beam events data: [undefined]"
     end if
   end subroutine beam_events_write
 
 @ %def beam_events_write
 @
 <<SF beam events: beam events: TBP>>=
   procedure :: init => beam_events_init
 <<SF beam events: procedures>>=
   subroutine beam_events_init (sf_int, data)
     class(beam_events_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     real(default), dimension(2) :: m2
     real(default), dimension(0) :: mr2
     type(quantum_numbers_mask_t), dimension(4) :: mask
     integer, dimension(4) :: hel_lock
     type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
     type(polarization_t), target :: pol1, pol2
     type(polarization_iterator_t) :: it_hel1, it_hel2
     integer :: i
     select type (data)
     type is (beam_events_data_t)
        m2 = data%flv_in%get_mass () ** 2
        hel_lock = [3, 4, 1, 2]
        mask = quantum_numbers_mask (.false., .false., .false.)
        call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
        sf_int%data => data
        do i = 1, 2
           call qn_fc(i)%init ( &
                flv = data%flv_in(i), &
                col = color_from_flavor (data%flv_in(i)))
           call qn_fc(i+2)%init ( &
                flv = data%flv_in(i), &
                col = color_from_flavor (data%flv_in(i)))
        end do
        call pol1%init_generic (data%flv_in(1))
        call it_hel1%init (pol1)
        do while (it_hel1%is_valid ())
           qn_hel(1) = it_hel1%get_quantum_numbers ()
           qn_hel(3) = it_hel1%get_quantum_numbers ()
           call pol2%init_generic (data%flv_in(2))
           call it_hel2%init (pol2)
           do while (it_hel2%is_valid ())
              qn_hel(2) = it_hel2%get_quantum_numbers ()
              qn_hel(4) = it_hel2%get_quantum_numbers ()
              qn = qn_hel .merge. qn_fc
              call sf_int%add_state (qn)
              call it_hel2%advance ()
           end do
           ! call pol2%final ()
           call it_hel1%advance ()
        end do
        ! call pol1%final ()
        call sf_int%freeze ()
        call sf_int%set_incoming ([1,2])
        call sf_int%set_outgoing ([3,4])
        call sf_int%data%open ()
        sf_int%status = SF_INITIAL
     end select
   end subroutine beam_events_init
 
 @ %def beam_events_init
 @ This spectrum type needs a finalizer, which closes the data file.
 <<SF beam events: beam events: TBP>>=
   procedure :: final => sf_beam_events_final
 <<SF beam events: procedures>>=
   subroutine sf_beam_events_final (object)
     class(beam_events_t), intent(inout) :: object
     call object%data%close ()
     call object%interaction_t%final ()
   end subroutine sf_beam_events_final
 
 @ %def sf_beam_events_final
 @
 \subsection{Kinematics}
 Refer to the [[data]] component.
 <<SF beam events: beam events: TBP>>=
   procedure :: is_generator => beam_events_is_generator
 <<SF beam events: procedures>>=
   function beam_events_is_generator (sf_int) result (flag)
     class(beam_events_t), intent(in) :: sf_int
     logical :: flag
     flag = sf_int%data%is_generator ()
   end function beam_events_is_generator
 
 @ %def beam_events_is_generator
 @ Generate free parameters.  We read them from file.
 <<SF beam events: beam events: TBP>>=
   procedure :: generate_free => beam_events_generate_free
 <<SF beam events: procedures>>=
   recursive subroutine beam_events_generate_free (sf_int, r, rb,  x_free)
     class(beam_events_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(inout) :: x_free
     integer :: iostat
     associate (data => sf_int%data)
       if (data%unit /= 0) then
          read (data%unit, fmt=*, iostat=iostat)  r
          if (iostat > 0) then
             write (msg_buffer, "(A,I0,A)") &
                  "Beam events: I/O error after reading ", sf_int%count, &
                  " events"
             call msg_fatal ()
          else if (iostat < 0) then
             if (sf_int%count == 0) then
                call msg_fatal ("Beam events: file is empty")
             else if (sf_int%data%warn_eof) then
                write (msg_buffer, "(A,I0,A)") &
                     "Beam events: End of file after reading ", sf_int%count, &
                     " events, rewinding"
                call msg_warning ()
             end if
             rewind (data%unit)
             sf_int%count = 0
             call sf_int%generate_free (r, rb, x_free)
          else
             sf_int%count = sf_int%count + 1
             rb = 1 - r
             x_free = x_free * product (r)
          end if
       else
          call msg_bug ("Beam events: file is not open for reading")
       end if
     end associate
   end subroutine beam_events_generate_free
 
 @ %def beam_events_generate_free
 @ Set kinematics.  Trivial transfer since this is a pure generator.
 The [[map]] flag doesn't apply.
 <<SF beam events: beam events: TBP>>=
   procedure :: complete_kinematics => beam_events_complete_kinematics
 <<SF beam events: procedures>>=
   subroutine beam_events_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(beam_events_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     if (map) then
        call msg_fatal ("Beam events: map flag not supported")
     else
        x = r
        xb= rb
        f = 1
     end if
     call sf_int%reduce_momenta (x)
   end subroutine beam_events_complete_kinematics
 
 @ %def beam_events_complete_kinematics
 @ Compute inverse kinematics.  Trivial in this case.
 <<SF beam events: beam events: TBP>>=
   procedure :: inverse_kinematics => beam_events_inverse_kinematics
 <<SF beam events: procedures>>=
   subroutine beam_events_inverse_kinematics &
        (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(beam_events_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     if (map) then
        call msg_fatal ("Beam events: map flag not supported")
     else
        r = x
        rb= xb
        f = 1
     end if
     if (set_mom) then
        call sf_int%reduce_momenta (x)
     end if
   end subroutine beam_events_inverse_kinematics
 
 @ %def beam_events_inverse_kinematics
 @
 \subsection{Beam events application}
 Trivial, just set the unit weight.
 <<SF beam events: beam events: TBP>>=
   procedure :: apply => beam_events_apply
 <<SF beam events: procedures>>=
   subroutine beam_events_apply (sf_int, scale, rescale, i_sub)
     class(beam_events_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     real(default) :: f
     f = 1
     call sf_int%set_matrix_element (cmplx (f, kind=default))
     sf_int%status = SF_EVALUATED
   end subroutine beam_events_apply
 
 @ %def beam_events_apply
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_beam_events_ut.f90]]>>=
 <<File header>>
 
 module sf_beam_events_ut
   use unit_tests
   use sf_beam_events_uti
 
 <<Standard module head>>
 
 <<SF beam events: public test>>
 
 contains
 
 <<SF beam events: test driver>>
 
 end module sf_beam_events_ut
 @ %def sf_beam_events_ut
 @
 <<[[sf_beam_events_uti.f90]]>>=
 <<File header>>
 
 module sf_beam_events_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use physics_defs, only: ELECTRON
   use lorentz
   use pdg_arrays
   use flavors
   use interactions, only: reset_interaction_counter
   use model_data
   use sf_aux
   use sf_base
 
   use sf_beam_events
 
 <<Standard module head>>
 
 <<SF beam events: test declarations>>
 
 contains
 
 <<SF beam events: tests>>
 
 end module sf_beam_events_uti
 @ %def sf_beam_events_ut
 @ API: driver for the unit tests below.
 <<SF beam events: public test>>=
   public :: sf_beam_events_test
 <<SF beam events: test driver>>=
   subroutine sf_beam_events_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF beam events: execute tests>>
   end subroutine sf_beam_events_test
 
 @ %def sf_beam_events_test
 @
 \subsubsection{Test structure function data}
 Construct and display a test structure function data object.
 <<SF beam events: execute tests>>=
   call test (sf_beam_events_1, "sf_beam_events_1", &
        "structure function configuration", &
        u, results)
 <<SF beam events: test declarations>>=
   public :: sf_beam_events_1
 <<SF beam events: tests>>=
   subroutine sf_beam_events_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t), dimension(2) :: pdg_in
     type(pdg_array_t), dimension(2) :: pdg_out
     integer, dimension(:), allocatable :: pdg1, pdg2
     class(sf_data_t), allocatable :: data
 
     write (u, "(A)")  "* Test output: sf_beam_events_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &beam-events structure function data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     pdg_in(1) = ELECTRON
     pdg_in(2) = -ELECTRON
 
     allocate (beam_events_data_t :: data)
     select type (data)
     type is (beam_events_data_t)
        call data%init (model, pdg_in, var_str (""), var_str ("beam_events.dat"))
     end select
 
     call data%write (u)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     pdg2 = pdg_out(2)
     write (u, "(2x,99(1x,I0))")  pdg1, pdg2
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_beam_events_1"
 
   end subroutine sf_beam_events_1
 
 @ %def sf_beam_events_1
 @
 \subsubsection{Probe the structure-function object}
 Active the beam event reader, generate an event.
 <<SF beam events: execute tests>>=
   call test (sf_beam_events_2, "sf_beam_events_2", &
        "generate event", &
        u, results)
 <<SF beam events: test declarations>>=
   public :: sf_beam_events_2
 <<SF beam events: tests>>=
   subroutine sf_beam_events_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t), dimension(2) :: flv
     type(pdg_array_t), dimension(2) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k1, k2
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: x_free, f
     integer :: i
 
     write (u, "(A)")  "* Test output: sf_beam_events_2"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &beam-events structure function data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     call flv(1)%init (ELECTRON, model)
     call flv(2)%init (-ELECTRON, model)
     pdg_in(1) = ELECTRON
     pdg_in(2) = -ELECTRON
 
     call reset_interaction_counter ()
 
     allocate (beam_events_data_t :: data)
     select type (data)
     type is (beam_events_data_t)
        call data%init (model, pdg_in, &
             var_str (""), var_str ("test_beam_events.dat"))
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1,2])
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 250
     k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
     k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
     call vector4_write (k1, u)
     call vector4_write (k2, u)
     call sf_int%seed_kinematics ([k1, k2])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set dummy parameters and generate x."
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r  = 0
     rb = 0
     x_free = 1
     call sf_int%generate_free (r, rb, x_free)
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
 
     write (u, "(A,9(1x,F10.7))")  "r =", r
     write (u, "(A,9(1x,F10.7))")  "rb=", rb
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
     write (u, "(A,9(1x,F10.7))")  "xf=", x_free
     select type (sf_int)
     type is (beam_events_t)
        write (u, "(A,1x,I0)")  "count =", sf_int%count
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate"
     write (u, "(A)")
 
     call sf_int%apply (scale = 0._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate more events, rewind"
     write (u, "(A)")
 
     select type (sf_int)
     type is (beam_events_t)
        do i = 1, 3
           call sf_int%generate_free (r, rb, x_free)
           write (u, "(A,9(1x,F10.7))")  "r =", r
           write (u, "(A,1x,I0)")  "count =", sf_int%count
        end do
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_beam_events_2"
 
   end subroutine sf_beam_events_2
 
 @ %def sf_beam_events_2
 @
 \subsubsection{Check the file handle registry}
 Open and close some files, checking the registry contents.
 <<SF beam events: execute tests>>=
   call test (sf_beam_events_3, "sf_beam_events_3", &
        "check registry", &
        u, results)
 <<SF beam events: test declarations>>=
   public :: sf_beam_events_3
 <<SF beam events: tests>>=
   subroutine sf_beam_events_3 (u)
     integer, intent(in) :: u
     integer :: u1
 
     write (u, "(A)")  "* Test output: sf_beam_events_2"
     write (u, "(A)")  "*   Purpose: check file handle registry"
     write (u, "(A)")
 
     write (u, "(A)")  "* Create some empty files"
     write (u, "(A)")
 
     u1 = free_unit ()
     open (u1, file = "sf_beam_events_f1.tmp", action="write", status="new")
     close (u1)
     open (u1, file = "sf_beam_events_f2.tmp", action="write", status="new")
     close (u1)
     open (u1, file = "sf_beam_events_f3.tmp", action="write", status="new")
     close (u1)
 
     write (u, "(A)")  "* Empty registry"
     write (u, "(A)")
 
     call beam_file_registry%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Insert three entries"
     write (u, "(A)")
 
     call beam_file_registry%open (var_str ("sf_beam_events_f3.tmp"))
     call beam_file_registry%open (var_str ("sf_beam_events_f2.tmp"))
     call beam_file_registry%open (var_str ("sf_beam_events_f1.tmp"))
     call beam_file_registry%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Open a second channel"
     write (u, "(A)")
 
     call beam_file_registry%open (var_str ("sf_beam_events_f2.tmp"))
     call beam_file_registry%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Close second entry twice"
     write (u, "(A)")
 
     call beam_file_registry%close (var_str ("sf_beam_events_f2.tmp"))
     call beam_file_registry%close (var_str ("sf_beam_events_f2.tmp"))
     call beam_file_registry%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Close last entry"
     write (u, "(A)")
 
     call beam_file_registry%close (var_str ("sf_beam_events_f3.tmp"))
     call beam_file_registry%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Close remaining entry"
     write (u, "(A)")
 
     call beam_file_registry%close (var_str ("sf_beam_events_f1.tmp"))
     call beam_file_registry%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     open (u1, file = "sf_beam_events_f1.tmp", action="write")
     close (u1, status = "delete")
     open (u1, file = "sf_beam_events_f2.tmp", action="write")
     close (u1, status = "delete")
     open (u1, file = "sf_beam_events_f3.tmp", action="write")
     close (u1, status = "delete")
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_beam_events_3"
 
   end subroutine sf_beam_events_3
 
 @ %def sf_beam_events_3
 @
 \clearpage
 %------------------------------------------------------------------------
 \section{Lepton collider beamstrahlung: CIRCE1}
 
 <<[[sf_circe1.f90]]>>=
 <<File header>>
 
 module sf_circe1
 
 <<Use kinds>>
   use kinds, only: double
 <<Use strings>>
   use io_units
   use format_defs, only: FMT_17, FMT_19
   use diagnostics
   use physics_defs, only: ELECTRON, PHOTON
   use lorentz
   use rng_base
   use pdg_arrays
   use model_data
   use flavors
   use colors
   use quantum_numbers
   use state_matrices
   use polarizations
   use sf_mappings
   use sf_base
   use circe1, circe1_rng_t => rng_type !NODEP!
 
 <<Standard module head>>
 
 <<SF circe1: public>>
 
 <<SF circe1: types>>
 
 contains
 
 <<SF circe1: procedures>>
 
 end module sf_circe1
 @ %def sf_circe1
 @
 \subsection{Physics}
 Beamstrahlung is applied before ISR.  The [[CIRCE1]] implementation has
 a single structure function for both beams (which makes sense since it
 has to be switched on or off for both beams simultaneously).
 Nevertheless it is factorized:
 
 The functional form in the [[CIRCE1]] parameterization is defined for
 electrons or photons
 \begin{equation}
   f(x) = \alpha\,x^\beta\,(1-x)^\gamma
 \end{equation}
 for $x<1-\epsilon$ (resp.\ $x>\epsilon$ in the photon case).  In the
 remaining interval, the standard form is zero, with a delta
 singularity at $x=1$ (resp.\ $x=0$).  Equivalently, the delta part may be
 distributed uniformly among this interval.  This latter form is
 implemented in the [[kirke]] version of the [[CIRCE1]] subroutines, and
 is used here.
 
 The parameter [[circe1\_eps]] sets the peak mapping of the [[CIRCE1]]
 structure function. Its default value is $10^{-5}$.
 The other parameters are the parameterization version and revision
 number, the accelerator type, and the $\sqrt{s}$ value used by
 [[CIRCE1]]. The chattiness can also be set.
 
 Since the energy is distributed in a narrow region around unity (for
 electrons) or zero (for photons), it is advantageous to map the
 interval first.  The mapping is controlled by the parameter
 [[circe1\_epsilon]] which is taken from the [[CIRCE1]]
 internal data structure.
 
 The $\sqrt{s}$ value, if not explicitly set, is taken from the
 process data.  Note that interpolating $\sqrt{s}$ is not recommended;
 one should rather choose one of the distinct values known to [[CIRCE1]].
 
 \subsection{The CIRCE1 data block}
 The CIRCE1 parameters are: The incoming flavors, the flags whether the photon
 or the lepton is the parton in the hard interaction, the flags for the
 generation mode (generator/mapping/no mapping), the mapping parameter
 $\epsilon$, $\sqrt{s}$ and several steering parameters: [[ver]],
 [[rev]], [[acc]], [[chat]].
 
 In generator mode, the $x$ values are actually discarded and a random number
 generator is used instead.
 <<SF circe1: public>>=
   public :: circe1_data_t
 <<SF circe1: types>>=
   type, extends (sf_data_t) :: circe1_data_t
      private
      class(model_data_t), pointer :: model => null ()
      type(flavor_t), dimension(2) :: flv_in
      integer, dimension(2) :: pdg_in
      real(default), dimension(2) :: m_in = 0
      logical, dimension(2) :: photon = .false.
      logical :: generate = .false.
      class(rng_factory_t), allocatable :: rng_factory
      real(default) :: sqrts = 0
      real(default) :: eps = 0
      integer :: ver = 0
      integer :: rev = 0
      character(6) :: acc = "?"
      integer :: chat = 0
      logical :: with_radiation = .false.
    contains
      <<SF circe1: circe1 data: TBP>>
   end type circe1_data_t
 
 @ %def circe1_data_t
 @
 <<SF circe1: circe1 data: TBP>>=
   procedure :: init => circe1_data_init
 <<SF circe1: procedures>>=
   subroutine circe1_data_init &
        (data, model, pdg_in, sqrts, eps, out_photon, &
         ver, rev, acc, chat, with_radiation)
     class(circe1_data_t), intent(out) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), dimension(2), intent(in) :: pdg_in
     real(default), intent(in) :: sqrts
     real(default), intent(in) :: eps
     logical, dimension(2), intent(in) :: out_photon
     character(*), intent(in) :: acc
     integer, intent(in) :: ver, rev, chat
     logical, intent(in) :: with_radiation
     data%model => model
     if (any (pdg_array_get_length (pdg_in) /= 1)) then
        call msg_fatal ("CIRCE1: incoming beam particles must be unique")
     end if
     call data%flv_in(1)%init (pdg_array_get (pdg_in(1), 1), model)
     call data%flv_in(2)%init (pdg_array_get (pdg_in(2), 1), model)
     data%pdg_in = data%flv_in%get_pdg ()
     data%m_in = data%flv_in%get_mass ()
     data%sqrts = sqrts
     data%eps = eps
     data%photon = out_photon
     data%ver = ver
     data%rev = rev
     data%acc = acc
     data%chat = chat
     data%with_radiation = with_radiation
     call data%check ()
     call circex (0.d0, 0.d0, dble (data%sqrts), &
          data%acc, data%ver, data%rev, data%chat)
   end subroutine circe1_data_init
 
 @ %def circe1_data_init
 @ Activate the generator mode.  We import a RNG factory into the data
 type, which can then spawn RNG generator objects.
 <<SF circe1: circe1 data: TBP>>=
   procedure :: set_generator_mode => circe1_data_set_generator_mode
 <<SF circe1: procedures>>=
   subroutine circe1_data_set_generator_mode (data, rng_factory)
     class(circe1_data_t), intent(inout) :: data
     class(rng_factory_t), intent(inout), allocatable :: rng_factory
     data%generate = .true.
     call move_alloc (from = rng_factory, to = data%rng_factory)
   end subroutine circe1_data_set_generator_mode
 
 @ %def circe1_data_set_generator_mode
 @ Handle error conditions.
 <<SF circe1: circe1 data: TBP>>=
   procedure :: check => circe1_data_check
 <<SF circe1: procedures>>=
   subroutine circe1_data_check (data)
     class(circe1_data_t), intent(in) :: data
     type(flavor_t) :: flv_electron, flv_photon
     call flv_electron%init (ELECTRON, data%model)
     call flv_photon%init (PHOTON, data%model)
     if (.not. flv_electron%is_defined () &
          .or. .not. flv_photon%is_defined ()) then
        call msg_fatal ("CIRCE1: model must contain photon and electron")
     end if
     if (any (abs (data%pdg_in) /= ELECTRON) &
          .or. (data%pdg_in(1) /= - data%pdg_in(2))) then
        call msg_fatal ("CIRCE1: applicable only for e+e- or e-e+ collisions")
     end if
     if (data%eps <= 0) then
        call msg_error ("CIRCE1: circe1_eps = 0: integration will &
             &miss x=1 peak")
     end if
   end subroutine circe1_data_check
 
 @ %def circe1_data_check
 @ Output
 <<SF circe1: circe1 data: TBP>>=
   procedure :: write => circe1_data_write
 <<SF circe1: procedures>>=
   subroutine circe1_data_write (data, unit, verbose)
     class(circe1_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     logical :: verb
     verb = .false.;  if (present (verbose))  verb = verbose
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)") "CIRCE1 data:"
     write (u, "(3x,A,2(1x,A))") "prt_in   =", &
          char (data%flv_in(1)%get_name ()), &
          char (data%flv_in(2)%get_name ())
     write (u, "(3x,A,2(1x,L1))")  "photon   =", data%photon
     write (u, "(3x,A,L1)")        "generate = ", data%generate
     write (u, "(3x,A,2(1x," // FMT_19 // "))") "m_in     =", data%m_in
     write (u, "(3x,A," // FMT_19 // ")") "sqrts    = ", data%sqrts
     write (u, "(3x,A," // FMT_19 // ")") "eps      = ", data%eps
     write (u, "(3x,A,I0)") "ver      = ", data%ver
     write (u, "(3x,A,I0)") "rev      = ", data%rev
     write (u, "(3x,A,A)")  "acc      = ", data%acc
     write (u, "(3x,A,I0)") "chat     = ", data%chat
     write (u, "(3x,A,L1)") "with rad.= ", data%with_radiation
     if (data%generate) then
        if (verb) then
           call data%rng_factory%write (u)
        end if
     end if
   end subroutine circe1_data_write
 
 @ %def circe1_data_write
 @ Return true if this structure function is in generator mode.  In
 that case, all parameters are free, otherwise bound.  (We do not
 support mixed cases.)  Default is: no generator.
 <<SF circe1: circe1 data: TBP>>=
   procedure :: is_generator => circe1_data_is_generator
 <<SF circe1: procedures>>=
   function circe1_data_is_generator (data) result (flag)
     class(circe1_data_t), intent(in) :: data
     logical :: flag
     flag = data%generate
   end function circe1_data_is_generator
 
 @ %def circe1_data_is_generator
 @ The number of parameters is two, collinear splitting for the two beams.
 <<SF circe1: circe1 data: TBP>>=
   procedure :: get_n_par => circe1_data_get_n_par
 <<SF circe1: procedures>>=
   function circe1_data_get_n_par (data) result (n)
     class(circe1_data_t), intent(in) :: data
     integer :: n
     n = 2
   end function circe1_data_get_n_par
 
 @ %def circe1_data_get_n_par
 @ Return the outgoing particles PDG codes. This is either the incoming
 particle (if a photon is radiated), or the photon if that is the particle
 of the hard interaction. The latter is determined via the [[photon]]
 flag. There are two entries for the two beams.
 <<SF circe1: circe1 data: TBP>>=
   procedure :: get_pdg_out => circe1_data_get_pdg_out
 <<SF circe1: procedures>>=
   subroutine circe1_data_get_pdg_out (data, pdg_out)
     class(circe1_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     integer :: i, n
     n = 2
     do i = 1, n
        if (data%photon(i)) then
           pdg_out(i) = PHOTON
        else
           pdg_out(i) = data%pdg_in(i)
        end if
     end do
   end subroutine circe1_data_get_pdg_out
 
 @ %def circe1_data_get_pdg_out
 @ This variant is not inherited, it returns integers.
 <<SF circe1: circe1 data: TBP>>=
   procedure :: get_pdg_int => circe1_data_get_pdg_int
 <<SF circe1: procedures>>=
   function circe1_data_get_pdg_int (data) result (pdg)
     class(circe1_data_t), intent(in) :: data
     integer, dimension(2) :: pdg
     integer :: i
     do i = 1, 2
        if (data%photon(i)) then
           pdg(i) = PHOTON
        else
           pdg(i) = data%pdg_in(i)
        end if
     end do
   end function circe1_data_get_pdg_int
 
 @ %def circe1_data_get_pdg_int
 @ Allocate the interaction record.
 <<SF circe1: circe1 data: TBP>>=
   procedure :: allocate_sf_int => circe1_data_allocate_sf_int
 <<SF circe1: procedures>>=
   subroutine circe1_data_allocate_sf_int (data, sf_int)
     class(circe1_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (circe1_t :: sf_int)
   end subroutine circe1_data_allocate_sf_int
 
 @ %def circe1_data_allocate_sf_int
 @ Return the accelerator type.
 <<SF circe1: circe1 data: TBP>>=
   procedure :: get_beam_file => circe1_data_get_beam_file
 <<SF circe1: procedures>>=
   function circe1_data_get_beam_file (data) result (file)
     class(circe1_data_t), intent(in) :: data
     type(string_t) :: file
     file = "CIRCE1: " // data%acc
   end function circe1_data_get_beam_file
 
 @ %def circe1_data_get_beam_file
 @
 \subsection{Random Number Generator for CIRCE}
 The CIRCE implementation now supports a generic random-number
 generator object that allows for a local state as a component.  To
 support this, we must extend the abstract type provided by CIRCE and
 delegate the generator call to the (also abstract) RNG used by WHIZARD.
 <<SF circe1: types>>=
   type, extends (circe1_rng_t) :: rng_obj_t
      class(rng_t), allocatable :: rng
    contains
      procedure :: generate => rng_obj_generate
   end type rng_obj_t
 
 @ %def rng_obj_t
 <<SF circe1: procedures>>=
   subroutine rng_obj_generate (rng_obj, u)
     class(rng_obj_t), intent(inout) :: rng_obj
     real(double), intent(out) :: u
     real(default) :: x
     call rng_obj%rng%generate (x)
     u = x
   end subroutine rng_obj_generate
 
 @ %def rng_obj_generate
 @
 \subsection{The CIRCE1 object}
 This is a $2\to 4$ interaction, where, depending on the parameters, any two of
 the four outgoing particles are connected to the hard interactions, the others
 are radiated.  Knowing that all particles are colorless, we do not have to
 deal with color.
 
 The flavors are sorted such that the first two particles are the incoming
 leptons, the next two are the radiated particles, and the last two are the
 partons initiating the hard interaction.
 
 CIRCE1 does not support polarized beams explicitly.  For simplicity, we
 nevertheless carry beam polarization through to the outgoing electrons and
 make the photons unpolarized.
 
 In the case that no radiated particle is kept (which actually is the
 default), polarization is always transferred to the electrons, too. If
 there is a recoil photon in the event, the radiated particles are 3
 and 4, respectively, and 5 and 6 are the outgoing ones (triggering the
 hard scattering process), while in the case of no radiation, the
 outgoing particles are 3 and 4, respectively. In the case of the
 electron being the radiated particle, helicity is not kept.
 <<SF circe1: public>>=
   public :: circe1_t
 <<SF circe1: types>>=
   type, extends (sf_int_t) :: circe1_t
      type(circe1_data_t), pointer :: data => null ()
      real(default), dimension(2) :: x = 0
      real(default), dimension(2) :: xb= 0
      real(default) :: f = 0
      logical, dimension(2) :: continuum = .true.
      logical, dimension(2) :: peak = .true.
      type(rng_obj_t) :: rng_obj
    contains
    <<SF circe1: circe1: TBP>>
   end type circe1_t
 
 @ %def circe1_t
 @ Type string: has to be here, but there is no string variable on which CIRCE1
 depends. Hence, a dummy routine.
 <<SF circe1: circe1: TBP>>=
   procedure :: type_string => circe1_type_string
 <<SF circe1: procedures>>=
   function circe1_type_string (object) result (string)
     class(circe1_t), intent(in) :: object
     type(string_t) :: string
     if (associated (object%data)) then
        string = "CIRCE1: beamstrahlung"
     else
        string = "CIRCE1: [undefined]"
     end if
   end function circe1_type_string
 
 @ %def circe1_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF circe1: circe1: TBP>>=
   procedure :: write => circe1_write
 <<SF circe1: procedures>>=
   subroutine circe1_write (object, unit, testflag)
     class(circe1_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        if (object%data%generate)  call object%rng_obj%rng%write (u)
        if (object%status >= SF_DONE_KINEMATICS) then
           write (u, "(3x,A,2(1x," // FMT_17 // "))")  "x =", object%x
           write (u, "(3x,A,2(1x," // FMT_17 // "))")  "xb=", object%xb
           if (object%status >= SF_FAILED_EVALUATION) then
              write (u, "(3x,A,1x," // FMT_17 // ")")  "f =", object%f
           end if
        end if
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "CIRCE1 data: [undefined]"
     end if
   end subroutine circe1_write
 
 @ %def circe1_write
 @
 <<SF circe1: circe1: TBP>>=
   procedure :: init => circe1_init
 <<SF circe1: procedures>>=
   subroutine circe1_init (sf_int, data)
     class(circe1_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     logical, dimension(6) :: mask_h
     type(quantum_numbers_mask_t), dimension(6) :: mask
     integer, dimension(6) :: hel_lock
     type(polarization_t), target :: pol1, pol2
     type(quantum_numbers_t), dimension(1) :: qn_fc1, qn_fc2
     type(flavor_t) :: flv_photon
     type(color_t) :: col0
     real(default), dimension(2) :: mi2, mr2, mo2
     type(quantum_numbers_t) :: qn_hel1, qn_hel2, qn_photon, qn1, qn2
     type(quantum_numbers_t), dimension(6) :: qn
     type(polarization_iterator_t) :: it_hel1, it_hel2
     hel_lock = 0
     mask_h = .false.
     select type (data)
     type is (circe1_data_t)
        mi2 = data%m_in**2
        if (data%with_radiation) then
           if (data%photon(1)) then
              hel_lock(1) = 3;  hel_lock(3) = 1;  mask_h(5) = .true.
              mr2(1) = mi2(1)
              mo2(1) = 0._default
           else
              hel_lock(1) = 5;  hel_lock(5) = 1;  mask_h(3) = .true.
              mr2(1) = 0._default
              mo2(1) = mi2(1)
           end if
           if (data%photon(2)) then
              hel_lock(2) = 4;  hel_lock(4) = 2;  mask_h(6) = .true.
              mr2(2) = mi2(2)
              mo2(2) = 0._default
           else
              hel_lock(2) = 6;  hel_lock(6) = 2;  mask_h(4) = .true.
              mr2(2) = 0._default
              mo2(2) = mi2(2)
           end if
           mask = quantum_numbers_mask (.false., .false., mask_h)
           call sf_int%base_init (mask, mi2, mr2, mo2, &
                hel_lock = hel_lock)
           sf_int%data => data
           call flv_photon%init (PHOTON, data%model)
           call col0%init ()
           call qn_photon%init (flv_photon, col0)
           call pol1%init_generic (data%flv_in(1))
           call qn_fc1(1)%init (flv = data%flv_in(1), col = col0)
           call pol2%init_generic (data%flv_in(2))
           call qn_fc2(1)%init (flv = data%flv_in(2), col = col0)
           call it_hel1%init (pol1)
 
           do while (it_hel1%is_valid ())
              qn_hel1 = it_hel1%get_quantum_numbers ()
              qn1 = qn_hel1 .merge. qn_fc1(1)
              qn(1) = qn1
              if (data%photon(1)) then
                 qn(3) = qn1;  qn(5) = qn_photon
              else
                 qn(3) = qn_photon;  qn(5) = qn1
              end if
              call it_hel2%init (pol2)
              do while (it_hel2%is_valid ())
                 qn_hel2 = it_hel2%get_quantum_numbers ()
                 qn2 = qn_hel2 .merge. qn_fc2(1)
                 qn(2) = qn2
                 if (data%photon(2)) then
                    qn(4) = qn2;  qn(6) = qn_photon
                 else
                    qn(4) = qn_photon;  qn(6) = qn2
                 end if
                 call qn(3:4)%tag_radiated ()
                 call sf_int%add_state (qn)
                 call it_hel2%advance ()
              end do
              call it_hel1%advance ()
           end do
 !           call pol1%final ()
 !           call pol2%final ()
           call sf_int%freeze ()
           call sf_int%set_incoming ([1,2])
           call sf_int%set_radiated ([3,4])
           call sf_int%set_outgoing ([5,6])
        else
           if (data%photon(1)) then
              mask_h(3) = .true.
              mo2(1) = 0._default
           else
              hel_lock(1) = 3;  hel_lock(3) = 1
              mo2(1) = mi2(1)
           end if
           if (data%photon(2)) then
              mask_h(4) = .true.
              mo2(2) = 0._default
           else
              hel_lock(2) = 4;  hel_lock(4) = 2
              mo2(2) = mi2(2)
           end if
           mask = quantum_numbers_mask (.false., .false., mask_h)
           call sf_int%base_init (mask(1:4), mi2, [real(default) :: ], mo2, &
                hel_lock = hel_lock(1:4))
           sf_int%data => data
           call flv_photon%init (PHOTON, data%model)
           call col0%init ()
           call qn_photon%init (flv_photon, col0)
           call pol1%init_generic (data%flv_in(1))
           call qn_fc1(1)%init (flv = data%flv_in(1), col = col0)
           call pol2%init_generic (data%flv_in(2))
           call qn_fc2(1)%init (flv = data%flv_in(2), col = col0)
           call it_hel1%init (pol1)
 
           do while (it_hel1%is_valid ())
              qn_hel1 = it_hel1%get_quantum_numbers ()
              qn1 = qn_hel1 .merge. qn_fc1(1)
              qn(1) = qn1
              if (data%photon(1)) then
                 qn(3) = qn_photon
              else
                 qn(3) = qn1
              end if
              call it_hel2%init (pol2)
              do while (it_hel2%is_valid ())
                 qn_hel2 = it_hel2%get_quantum_numbers ()
                 qn2 = qn_hel2 .merge. qn_fc2(1)
                 qn(2) = qn2
                 if (data%photon(2)) then
                    qn(4) = qn_photon
                 else
                    qn(4) = qn2
                 end if
                 call sf_int%add_state (qn(1:4))
                 call it_hel2%advance ()
              end do
              call it_hel1%advance ()
           end do
 !           call pol1%final ()
 !           call pol2%final ()
           call sf_int%freeze ()
           call sf_int%set_incoming ([1,2])
           call sf_int%set_outgoing ([3,4])
        end if
        sf_int%status = SF_INITIAL
     end select
     if (sf_int%data%generate) then
        call sf_int%data%rng_factory%make (sf_int%rng_obj%rng)
     end if
   end subroutine circe1_init
 
 @ %def circe1_init
 @
 \subsection{Kinematics}
 Refer to the [[data]] component.
 <<SF circe1: circe1: TBP>>=
   procedure :: is_generator => circe1_is_generator
 <<SF circe1: procedures>>=
   function circe1_is_generator (sf_int) result (flag)
     class(circe1_t), intent(in) :: sf_int
     logical :: flag
     flag = sf_int%data%is_generator ()
   end function circe1_is_generator
 
 @ %def circe1_is_generator
 @ Generate free parameters, if generator mode is on.  Otherwise, the
 parameters will be discarded.
 <<SF circe1: circe1: TBP>>=
   procedure :: generate_free => circe1_generate_free
 <<SF circe1: procedures>>=
   subroutine circe1_generate_free (sf_int, r, rb,  x_free)
     class(circe1_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(inout) :: x_free
 
     if (sf_int%data%generate) then
        call circe_generate (r, sf_int%data%get_pdg_int (), sf_int%rng_obj)
        rb = 1 - r
        x_free = x_free * product (r)
     else
        r = 0
        rb= 1
     end if
   end subroutine circe1_generate_free
 
 @ %def circe1_generate_free
 @ Generator mode: depending on the particle codes, call one of the
 available [[girce]] generators.  Illegal particle code combinations
 should have been caught during data initialization.
 <<SF circe1: procedures>>=
   subroutine circe_generate (x, pdg, rng_obj)
     real(default), dimension(2), intent(out) :: x
     integer, dimension(2), intent(in) :: pdg
     class(rng_obj_t), intent(inout) :: rng_obj
     real(double) :: xc1, xc2
     select case (abs (pdg(1)))
     case (ELECTRON)
        select case (abs (pdg(2)))
        case (ELECTRON)
           call gircee (xc1, xc2, rng_obj = rng_obj)
        case (PHOTON)
           call girceg (xc1, xc2, rng_obj = rng_obj)
        end select
     case (PHOTON)
        select case (abs (pdg(2)))
        case (ELECTRON)
           call girceg (xc2, xc1, rng_obj = rng_obj)
        case (PHOTON)
           call gircgg (xc1, xc2, rng_obj = rng_obj)
        end select
     end select
     x = [xc1, xc2]
   end subroutine circe_generate
 
 @ %def circe_generate
 @ Set kinematics.  The $r$ values (either from integration or from the
 generator call above) are copied to $x$ unchanged, and $f$ is unity.
 We store the $x$ values, so we can use them for the evaluation later.
 <<SF circe1: circe1: TBP>>=
   procedure :: complete_kinematics => circe1_complete_kinematics
 <<SF circe1: procedures>>=
   subroutine circe1_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(circe1_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     x = r
     xb = rb
     sf_int%x = x
     sf_int%xb= xb
     f = 1
     if (sf_int%data%with_radiation) then
        call sf_int%split_momenta (x, xb)
     else
        call sf_int%reduce_momenta (x)
     end if
     select case (sf_int%status)
     case (SF_FAILED_KINEMATICS);  f = 0
     end select
   end subroutine circe1_complete_kinematics
 
 @ %def circe1_complete_kinematics
 @ Compute inverse kinematics.  In generator mode, the $r$ values are
 meaningless, but we copy them anyway.
 <<SF circe1: circe1: TBP>>=
   procedure :: inverse_kinematics => circe1_inverse_kinematics
 <<SF circe1: procedures>>=
   subroutine circe1_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(circe1_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     r = x
     rb = xb
     sf_int%x = x
     sf_int%xb= xb
     f = 1
     if (set_mom) then
        call sf_int%split_momenta (x, xb)
        select case (sf_int%status)
        case (SF_FAILED_KINEMATICS);  f = 0
        end select
     end if
   end subroutine circe1_inverse_kinematics
 
 @ %def circe1_inverse_kinematics
 @
 \subsection{CIRCE1 application}
 CIRCE is applied for the two beams at once.  We can safely assume that no
 structure functions are applied before this, so the incoming particles are
 on-shell electrons/positrons.
 
 The scale is ignored.
 <<SF circe1: circe1: TBP>>=
   procedure :: apply => circe1_apply
 <<SF circe1: procedures>>=
   subroutine circe1_apply (sf_int, scale, rescale, i_sub)
     class(circe1_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     real(default), dimension(2) :: xb
     real(double), dimension(2) :: xc
     real(double), parameter :: one = 1
     associate (data => sf_int%data)
       xc = sf_int%x
       xb = sf_int%xb
       if (data%generate) then
          sf_int%f = 1
       else
          sf_int%f = 0
          if (all (sf_int%continuum)) then
             sf_int%f = circe (xc(1), xc(2), data%pdg_in(1), data%pdg_in(2))
          end if
          if (sf_int%continuum(2) .and. sf_int%peak(1)) then
             sf_int%f = sf_int%f &
                  + circe (one, xc(2), data%pdg_in(1), data%pdg_in(2)) &
                  * peak (xb(1), data%eps)
          end if
          if (sf_int%continuum(1) .and. sf_int%peak(2)) then
             sf_int%f = sf_int%f &
                  + circe (xc(1), one, data%pdg_in(1), data%pdg_in(2)) &
                  * peak (xb(2), data%eps)
          end if
          if (all (sf_int%peak)) then
             sf_int%f = sf_int%f &
                  + circe (one, one, data%pdg_in(1), data%pdg_in(2)) &
                  * peak (xb(1), data%eps) * peak (xb(2), data%eps)
          end if
       end if
     end associate
     call sf_int%set_matrix_element (cmplx (sf_int%f, kind=default))
     sf_int%status = SF_EVALUATED
   end subroutine circe1_apply
 
 @ %def circe1_apply
 @ This is a smeared delta peak at zero, as an endpoint singularity.
 We choose an exponentially decreasing function, starting at zero, with
 integral (from $0$ to $1$) $1-e^{-1/\epsilon}$.  For small $\epsilon$,
 this reduces to one.
 <<SF circe1: procedures>>=
   function peak (x, eps) result (f)
     real(default), intent(in) :: x, eps
     real(default) :: f
     f = exp (-x / eps) / eps
   end function peak
 
 @ %def peak
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_circe1_ut.f90]]>>=
 <<File header>>
 
 module sf_circe1_ut
   use unit_tests
   use sf_circe1_uti
 
 <<Standard module head>>
 
 <<SF circe1: public test>>
 
 contains
 
 <<SF circe1: test driver>>
 
 end module sf_circe1_ut
 @ %def sf_circe1_ut
 @
 <<[[sf_circe1_uti.f90]]>>=
 <<File header>>
 
 module sf_circe1_uti
 
 <<Use kinds>>
   use physics_defs, only: ELECTRON
   use lorentz
   use pdg_arrays
   use flavors
   use interactions, only: reset_interaction_counter
   use model_data
   use rng_base
   use sf_aux
   use sf_base
 
   use sf_circe1
 
   use rng_base_ut, only: rng_test_factory_t
 
 <<Standard module head>>
 
 <<SF circe1: test declarations>>
 
 contains
 
 <<SF circe1: tests>>
 
 end module sf_circe1_uti
 @ %def sf_circe1_ut
 @ API: driver for the unit tests below.
 <<SF circe1: public test>>=
   public :: sf_circe1_test
 <<SF circe1: test driver>>=
   subroutine sf_circe1_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF circe1: execute tests>>
   end subroutine sf_circe1_test
 
 @ %def sf_circe1_test
 @
 \subsubsection{Test structure function data}
 Construct and display a test structure function data object.
 <<SF circe1: execute tests>>=
   call test (sf_circe1_1, "sf_circe1_1", &
        "structure function configuration", &
        u, results)
 <<SF circe1: test declarations>>=
   public :: sf_circe1_1
 <<SF circe1: tests>>=
   subroutine sf_circe1_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t), dimension(2) :: pdg_in
     type(pdg_array_t), dimension(2) :: pdg_out
     integer, dimension(:), allocatable :: pdg1, pdg2
     class(sf_data_t), allocatable :: data
 
     write (u, "(A)")  "* Test output: sf_circe1_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &CIRCE structure function data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Create empty data object"
     write (u, "(A)")
 
     call model%init_qed_test ()
     pdg_in(1) = ELECTRON
     pdg_in(2) = -ELECTRON
 
     allocate (circe1_data_t :: data)
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     select type (data)
     type is (circe1_data_t)
        call data%init (model, pdg_in, &
             sqrts = 500._default, &
             eps = 1e-6_default, &
             out_photon = [.false., .false.], &
             ver = 0, &
             rev = 0, &
             acc = "SBAND", &
             chat = 0, &
             with_radiation = .true.)
     end select
 
     call data%write (u)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     pdg2 = pdg_out(2)
     write (u, "(2x,99(1x,I0))")  pdg1, pdg2
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_circe1_1"
 
   end subroutine sf_circe1_1
 
 @ %def sf_circe1_1
 @
 \subsubsection{Test and probe structure function}
 Construct and display a structure function object based on the PDF builtin
 structure function.
 <<SF circe1: execute tests>>=
   call test (sf_circe1_2, "sf_circe1_2", &
        "structure function instance", &
        u, results)
 <<SF circe1: test declarations>>=
   public :: sf_circe1_2
 <<SF circe1: tests>>=
   subroutine sf_circe1_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t), dimension(2) :: flv
     type(pdg_array_t), dimension(2) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k1, k2
     type(vector4_t), dimension(4) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_circe1_2"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &circe1 structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     call flv(1)%init (ELECTRON, model)
     call flv(2)%init (-ELECTRON, model)
     pdg_in(1) = ELECTRON
     pdg_in(2) = -ELECTRON
 
     call reset_interaction_counter ()
 
     allocate (circe1_data_t :: data)
     select type (data)
     type is (circe1_data_t)
        call data%init (model, pdg_in, &
             sqrts = 500._default, &
             eps = 1e-6_default, &
             out_photon = [.false., .false.], &
             ver = 0, &
             rev = 0, &
             acc = "SBAND", &
             chat = 0, &
             with_radiation = .true.)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1,2])
 
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 250
     k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
     k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
     call vector4_write (k1, u)
     call vector4_write (k2, u)
     call sf_int%seed_kinematics ([k1, k2])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.95,0.85."
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = [0.9_default, 0.8_default]
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1, 2])
 
     call sf_int%seed_kinematics ([k1, k2])
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
 
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate"
     write (u, "(A)")
 
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%apply (scale = 0._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_circe1_2"
 
   end subroutine sf_circe1_2
 
 @ %def sf_circe1_2
 @
 \subsubsection{Generator mode}
 Construct and evaluate a structure function object in generator mode.
 <<SF circe1: execute tests>>=
   call test (sf_circe1_3, "sf_circe1_3", &
        "generator mode", &
        u, results)
 <<SF circe1: test declarations>>=
   public :: sf_circe1_3
 <<SF circe1: tests>>=
   subroutine sf_circe1_3 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t), dimension(2) :: flv
     type(pdg_array_t), dimension(2) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(rng_factory_t), allocatable :: rng_factory
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k1, k2
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f, x_free
 
     write (u, "(A)")  "* Test output: sf_circe1_3"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &circe1 structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_qed_test ()
     call flv(1)%init (ELECTRON, model)
     call flv(2)%init (-ELECTRON, model)
     pdg_in(1) = ELECTRON
     pdg_in(2) = -ELECTRON
 
     call reset_interaction_counter ()
 
     allocate (circe1_data_t :: data)
     allocate (rng_test_factory_t :: rng_factory)
     select type (data)
     type is (circe1_data_t)
        call data%init (model, pdg_in, &
             sqrts = 500._default, &
             eps = 1e-6_default, &
             out_photon = [.false., .false.], &
             ver = 0, &
             rev = 0, &
             acc = "SBAND", &
             chat = 0, &
             with_radiation = .true.)
        call data%set_generator_mode (rng_factory)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1,2])
     select type (sf_int)
     type is (circe1_t)
        call sf_int%rng_obj%rng%init (3)
     end select
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 250
     k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
     k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
     call vector4_write (k1, u)
     call vector4_write (k2, u)
     call sf_int%seed_kinematics ([k1, k2])
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate x"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r  = 0
     rb = 0
     x_free = 1
     call sf_int%generate_free (r, rb, x_free)
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
 
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
     write (u, "(A,9(1x,F10.7))")  "xf=", x_free
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate"
     write (u, "(A)")
 
     call sf_int%apply (scale = 0._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_circe1_3"
 
   end subroutine sf_circe1_3
 
 @ %def sf_circe1_3
 @
 \clearpage
 %------------------------------------------------------------------------
 \section{Lepton Collider Beamstrahlung and Photon collider: CIRCE2}
 
 <<[[sf_circe2.f90]]>>=
 <<File header>>
 
 module sf_circe2
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_defs, only: FMT_19
   use numeric_utils
   use diagnostics
   use os_interface
   use physics_defs, only: PHOTON, ELECTRON
   use lorentz
   use rng_base
   use selectors
   use pdg_arrays
   use model_data
   use flavors
   use colors
   use helicities
   use quantum_numbers
   use state_matrices
   use polarizations
   use sf_base
   use circe2, circe2_rng_t => rng_type !NODEP!
 
 <<Standard module head>>
 
 <<SF circe2: public>>
 
 <<SF circe2: types>>
 
 contains
 
 <<SF circe2: procedures>>
 
 end module sf_circe2
 @ %def sf_circe2
 @
 \subsection{Physics}
 [[CIRCE2]] describes photon spectra
 Beamstrahlung is applied before ISR.  The [[CIRCE2]] implementation has
 a single structure function for both beams (which makes sense since it
 has to be switched on or off for both beams simultaneously).
 
 
 \subsection{The CIRCE2 data block}
 The CIRCE2 parameters are: file and collider specification, incoming
 (= outgoing) particles.  The luminosity is returned by [[circe2_luminosity]].
 <<SF circe2: public>>=
   public :: circe2_data_t
 <<SF circe2: types>>=
   type, extends (sf_data_t) :: circe2_data_t
      private
      class(model_data_t), pointer :: model => null ()
      type(flavor_t), dimension(2) :: flv_in
      integer, dimension(2) :: pdg_in
      real(default) :: sqrts = 0
      logical :: polarized = .false.
      logical :: beams_polarized = .false.
      class(rng_factory_t), allocatable :: rng_factory
      type(string_t) :: filename
      type(string_t) :: file
      type(string_t) :: design
      real(default) :: lumi = 0
      real(default), dimension(4) :: lumi_hel_frac = 0
      integer, dimension(0:4) :: h1 = [0, -1, -1, 1, 1]
      integer, dimension(0:4) :: h2 = [0, -1,  1,-1, 1]
      integer :: error = 1
    contains
      <<SF circe2: circe2 data: TBP>>
   end type circe2_data_t
 
 @ %def circe2_data_t
 <<SF circe2: types>>=
   type(circe2_state) :: circe2_global_state
 
 @
 <<SF circe2: circe2 data: TBP>>=
   procedure :: init => circe2_data_init
 <<SF circe2: procedures>>=
   subroutine circe2_data_init (data, os_data, model, pdg_in, &
        sqrts, polarized, beam_pol, file, design)
     class(circe2_data_t), intent(out) :: data
     type(os_data_t), intent(in) :: os_data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), dimension(2), intent(in) :: pdg_in
     real(default), intent(in) :: sqrts
     logical, intent(in) :: polarized, beam_pol
     type(string_t), intent(in) :: file, design
     integer :: h
     data%model => model
     if (any (pdg_array_get_length (pdg_in) /= 1)) then
        call msg_fatal ("CIRCE2: incoming beam particles must be unique")
     end if
     call data%flv_in(1)%init (pdg_array_get (pdg_in(1), 1), model)
     call data%flv_in(2)%init (pdg_array_get (pdg_in(2), 1), model)
     data%pdg_in = data%flv_in%get_pdg ()
     data%sqrts = sqrts
     data%polarized = polarized
     data%beams_polarized = beam_pol
     data%filename = file
     data%design = design
     call data%check_file (os_data)
     call circe2_load (circe2_global_state, trim (char(data%file)), &
             trim (char(data%design)), data%sqrts, data%error)
     call data%check ()
     data%lumi = circe2_luminosity (circe2_global_state, data%pdg_in, [0, 0])
     if (vanishes (data%lumi)) then
        call msg_fatal ("CIRCE2: luminosity vanishes for specified beams.")
     end if
     if (data%polarized) then
        do h = 1, 4
           data%lumi_hel_frac(h) = &
                circe2_luminosity (circe2_global_state, data%pdg_in, &
                             [data%h1(h), data%h2(h)]) &
                / data%lumi
        end do
     end if
   end subroutine circe2_data_init
 
 @ %def circe2_data_init
 @ Activate the generator mode.  We import a RNG factory into the data
 type, which can then spawn RNG generator objects.
 <<SF circe2: circe2 data: TBP>>=
   procedure :: set_generator_mode => circe2_data_set_generator_mode
 <<SF circe2: procedures>>=
   subroutine circe2_data_set_generator_mode (data, rng_factory)
     class(circe2_data_t), intent(inout) :: data
     class(rng_factory_t), intent(inout), allocatable :: rng_factory
     call move_alloc (from = rng_factory, to = data%rng_factory)
   end subroutine circe2_data_set_generator_mode
 
 @ %def circe2_data_set_generator_mode
 @ Check whether the requested data file is in the system directory or
 in the current directory.
 <<SF circe2: circe2 data: TBP>>=
   procedure :: check_file => circe2_check_file
 <<SF circe2: procedures>>=
   subroutine circe2_check_file (data, os_data)
     class(circe2_data_t), intent(inout) :: data
     type(os_data_t), intent(in) :: os_data
     logical :: exist
     type(string_t) :: file
     file = data%filename
     if (file == "") &
          call msg_fatal ("CIRCE2: $circe2_file is not set")
     inquire (file = char (file), exist = exist)
     if (exist) then
        data%file = file
     else
        file = os_data%whizard_circe2path // "/" // data%filename
        inquire (file = char (file), exist = exist)
        if (exist) then
           data%file = file
        else
           call msg_fatal ("CIRCE2: data file '" // char (data%filename) &
                // "' not found")
        end if
     end if
   end subroutine circe2_check_file
 
 @ %def circe2_check_file
 @ Handle error conditions.
 <<SF circe2: circe2 data: TBP>>=
   procedure :: check => circe2_data_check
 <<SF circe2: procedures>>=
   subroutine circe2_data_check (data)
     class(circe2_data_t), intent(in) :: data
     type(flavor_t) :: flv_photon, flv_electron
     call flv_photon%init (PHOTON, data%model)
     if (.not. flv_photon%is_defined ()) then
        call msg_fatal ("CIRCE2: model must contain photon")
     end if
     call flv_electron%init (ELECTRON, data%model)
     if (.not. flv_electron%is_defined ()) then
        call msg_fatal ("CIRCE2: model must contain electron")
     end if
     if (any (abs (data%pdg_in) /= PHOTON .and. abs (data%pdg_in) /= ELECTRON)) &
          then
        call msg_fatal ("CIRCE2: applicable only for e+e- or photon collisions")
     end if
     select case (data%error)
     case (-1)
        call msg_fatal ("CIRCE2: data file not found.")
     case (-2)
        call msg_fatal ("CIRCE2: beam setup does not match data file.")
     case (-3)
        call msg_fatal ("CIRCE2: invalid format of data file.")
     case (-4)
        call msg_fatal ("CIRCE2: data file too large.")
     end select
   end subroutine circe2_data_check
 
 @ %def circe2_data_check
 @ Output
 <<SF circe2: circe2 data: TBP>>=
   procedure :: write => circe2_data_write
 <<SF circe2: procedures>>=
   subroutine circe2_data_write (data, unit, verbose)
     class(circe2_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u, h
     logical :: verb
     verb = .false.;  if (present (verbose))  verb = verbose
     u = given_output_unit (unit)
     write (u, "(1x,A)") "CIRCE2 data:"
     write (u, "(3x,A,A)")       "file   = ", char(data%filename)
     write (u, "(3x,A,A)")       "design = ", char(data%design)
     write (u, "(3x,A," // FMT_19 // ")") "sqrts  = ", data%sqrts
     write (u, "(3x,A,A,A,A)")   "prt_in = ", &
          char (data%flv_in(1)%get_name ()), &
          ", ", char (data%flv_in(2)%get_name ())
     write (u, "(3x,A,L1)")      "polarized  = ", data%polarized
     write (u, "(3x,A,L1)")      "beams pol. = ", data%beams_polarized
     write (u, "(3x,A," // FMT_19 // ")") "luminosity = ", data%lumi
     if (data%polarized) then
        do h = 1, 4
           write (u, "(6x,'(',I2,1x,I2,')',1x,'=',1x)", advance="no") &
                data%h1(h), data%h2(h)
           write (u, "(6x, " // FMT_19 // ")")  data%lumi_hel_frac(h)
        end do
     end if
     if (verb) then
        call data%rng_factory%write (u)
     end if
   end subroutine circe2_data_write
 
 @ %def circe2_data_write
 @ This is always in generator mode.
 <<SF circe2: circe2 data: TBP>>=
   procedure :: is_generator => circe2_data_is_generator
 <<SF circe2: procedures>>=
   function circe2_data_is_generator (data) result (flag)
     class(circe2_data_t), intent(in) :: data
     logical :: flag
     flag = .true.
   end function circe2_data_is_generator
 
 @ %def circe2_data_is_generator
 @ The number of parameters is two, collinear splitting for
 the two beams.
 <<SF circe2: circe2 data: TBP>>=
   procedure :: get_n_par => circe2_data_get_n_par
 <<SF circe2: procedures>>=
   function circe2_data_get_n_par (data) result (n)
     class(circe2_data_t), intent(in) :: data
     integer :: n
     n = 2
   end function circe2_data_get_n_par
 
 @ %def circe2_data_get_n_par
 @ Return the outgoing particles PDG codes.  They are equal to the
 incoming ones.
 <<SF circe2: circe2 data: TBP>>=
   procedure :: get_pdg_out => circe2_data_get_pdg_out
 <<SF circe2: procedures>>=
   subroutine circe2_data_get_pdg_out (data, pdg_out)
     class(circe2_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     integer :: i, n
     n = 2
     do i = 1, n
        pdg_out(i) = data%pdg_in(i)
     end do
   end subroutine circe2_data_get_pdg_out
 
 @ %def circe2_data_get_pdg_out
 @ Allocate the interaction record.
 <<SF circe2: circe2 data: TBP>>=
   procedure :: allocate_sf_int => circe2_data_allocate_sf_int
 <<SF circe2: procedures>>=
   subroutine circe2_data_allocate_sf_int (data, sf_int)
     class(circe2_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (circe2_t :: sf_int)
   end subroutine circe2_data_allocate_sf_int
 
 @ %def circe2_data_allocate_sf_int
 @ Return the beam file.
 <<SF circe2: circe2 data: TBP>>=
   procedure :: get_beam_file => circe2_data_get_beam_file
 <<SF circe2: procedures>>=
   function circe2_data_get_beam_file (data) result (file)
     class(circe2_data_t), intent(in) :: data
     type(string_t) :: file
     file = "CIRCE2: " // data%filename
   end function circe2_data_get_beam_file
 
 @ %def circe2_data_get_beam_file
 @
 \subsection{Random Number Generator for CIRCE}
 The CIRCE implementation now supports a generic random-number
 generator object that allows for a local state as a component.  To
 support this, we must extend the abstract type provided by CIRCE and
 delegate the generator call to the (also abstract) RNG used by WHIZARD.
 <<SF circe2: types>>=
   type, extends (circe2_rng_t) :: rng_obj_t
      class(rng_t), allocatable :: rng
    contains
      procedure :: generate => rng_obj_generate
   end type rng_obj_t
 
 @ %def rng_obj_t
 <<SF circe2: procedures>>=
   subroutine rng_obj_generate (rng_obj, u)
     class(rng_obj_t), intent(inout) :: rng_obj
     real(default), intent(out) :: u
     real(default) :: x
     call rng_obj%rng%generate (x)
     u = x
   end subroutine rng_obj_generate
 
 @ %def rng_obj_generate
 @
 \subsection{The CIRCE2 object}
 For CIRCE2 spectra it does not make sense to describe the state matrix
 as a radiation interaction, even if photons originate from laser
 backscattering.  Instead, it is a $2\to 2$ interaction where the
 incoming particles are identical to the outgoing ones.
 
 The current implementation of CIRCE2 does support polarization and
 classical correlations, but no entanglement, so the density matrix of
 the outgoing particles is diagonal.  The incoming particles are
 unpolarized (user-defined polarization for beams is meaningless, since
 polarization is described by the data file).  The outgoing particles
 are polarized or polarization-averaged, depending on user request.
 
 When assigning matrix elements, we scan the previously initialized
 state matrix.  For each entry, we extract helicity and call the
 structure function.  In the unpolarized case, the helicity is
 undefined and replaced by value zero.  In the polarized case, there
 are four entries.  If the generator is used, only one entry is nonzero
 in each call.  Which one, is determined by comparing with a previously
 (randomly, distributed by relative luminosity) selected pair of
 helicities.
 <<SF circe2: public>>=
   public :: circe2_t
 <<SF circe2: types>>=
   type, extends (sf_int_t) :: circe2_t
      type(circe2_data_t), pointer :: data => null ()
      type(rng_obj_t) :: rng_obj
      type(selector_t) :: selector
      integer :: h_sel = 0
    contains
    <<SF circe2: circe2: TBP>>
   end type circe2_t
 
 @ %def circe2_t
 @ Type string: show file and design of [[CIRCE2]] structure function.
 <<SF circe2: circe2: TBP>>=
   procedure :: type_string => circe2_type_string
 <<SF circe2: procedures>>=
   function circe2_type_string (object) result (string)
     class(circe2_t), intent(in) :: object
     type(string_t) :: string
     if (associated (object%data)) then
        string = "CIRCE2: " // object%data%design
     else
        string = "CIRCE2: [undefined]"
     end if
   end function circe2_type_string
 
 @ %def circe2_type_string
 @
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF circe2: circe2: TBP>>=
   procedure :: write => circe2_write
 <<SF circe2: procedures>>=
   subroutine circe2_write (object, unit, testflag)
     class(circe2_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "CIRCE2 data: [undefined]"
     end if
   end subroutine circe2_write
 
 @ %def circe2_write
 @
 <<SF circe2: circe2: TBP>>=
   procedure :: init => circe2_init
 <<SF circe2: procedures>>=
   subroutine circe2_init (sf_int, data)
     class(circe2_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     logical, dimension(4) :: mask_h
     real(default), dimension(0) :: null_array
     type(quantum_numbers_mask_t), dimension(4) :: mask
     type(quantum_numbers_t), dimension(4) :: qn
     type(helicity_t) :: hel
     type(color_t) :: col0
     integer :: h
     select type (data)
     type is (circe2_data_t)
        if (data%polarized .and. data%beams_polarized) then
           call msg_fatal ("CIRCE2: Beam polarization can't be set &
                &for polarized data file")
        else if (data%beams_polarized) then
           call msg_warning ("CIRCE2: User-defined beam polarization set &
                &for unpolarized CIRCE2 data file")
        end if
        mask_h(1:2) = .not. data%beams_polarized
        mask_h(3:4) = .not. (data%polarized .or. data%beams_polarized)
        mask = quantum_numbers_mask (.false., .false., mask_h)
        call sf_int%base_init (mask, [0._default, 0._default], &
             null_array, [0._default, 0._default])
        sf_int%data => data
        if (data%polarized) then
           if (vanishes (sum (data%lumi_hel_frac)) .or. &
                any (data%lumi_hel_frac < 0)) then
              call msg_fatal ("CIRCE2: Helicity-dependent lumi " &
                   // "fractions all vanish or",  &
                   [var_str ("are negative: Please inspect the " &
                   // "CIRCE2 file or "), &
                    var_str ("switch off the polarized" // &
                   " option for CIRCE2.")])
           else
              call sf_int%selector%init (data%lumi_hel_frac)
           end if
        end if
        call col0%init ()
        if (data%beams_polarized) then
           do h = 1, 4
              call hel%init (data%h1(h))
              call qn(1)%init &
                   (flv = data%flv_in(1), col = col0, hel = hel)
              call qn(3)%init &
                   (flv = data%flv_in(1), col = col0, hel = hel)
              call hel%init (data%h2(h))
              call qn(2)%init &
                   (flv = data%flv_in(2), col = col0, hel = hel)
              call qn(4)%init &
                   (flv = data%flv_in(2), col = col0, hel = hel)
              call sf_int%add_state (qn)
           end do
        else if (data%polarized) then
           call qn(1)%init (flv = data%flv_in(1), col = col0)
           call qn(2)%init (flv = data%flv_in(2), col = col0)
           do h = 1, 4
              call hel%init (data%h1(h))
              call qn(3)%init &
                   (flv = data%flv_in(1), col = col0, hel = hel)
              call hel%init (data%h2(h))
              call qn(4)%init &
                   (flv = data%flv_in(2), col = col0, hel = hel)
              call sf_int%add_state (qn)
           end do
        else
           call qn(1)%init (flv = data%flv_in(1), col = col0)
           call qn(2)%init (flv = data%flv_in(2), col = col0)
           call qn(3)%init (flv = data%flv_in(1), col = col0)
           call qn(4)%init (flv = data%flv_in(2), col = col0)
           call sf_int%add_state (qn)
        end if
        call sf_int%freeze ()
        call sf_int%set_incoming ([1,2])
        call sf_int%set_outgoing ([3,4])
        call sf_int%data%rng_factory%make (sf_int%rng_obj%rng)
        sf_int%status = SF_INITIAL
     end select
   end subroutine circe2_init
 
 @ %def circe2_init
 @
 \subsection{Kinematics}
 Refer to the [[data]] component.
 <<SF circe2: circe2: TBP>>=
   procedure :: is_generator => circe2_is_generator
 <<SF circe2: procedures>>=
   function circe2_is_generator (sf_int) result (flag)
     class(circe2_t), intent(in) :: sf_int
     logical :: flag
     flag = sf_int%data%is_generator ()
   end function circe2_is_generator
 
 @ %def circe2_is_generator
 @ Generate free parameters.  We first select a helicity, which we have
 to store, then generate $x$ values for that helicity.
 <<SF circe2: circe2: TBP>>=
   procedure :: generate_free => circe2_generate_whizard_free
 <<SF circe2: procedures>>=
   subroutine circe2_generate_whizard_free (sf_int, r, rb, x_free)
     class(circe2_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: r, rb
     real(default), intent(inout) :: x_free
     integer :: h_sel
     if (sf_int%data%polarized) then
        call sf_int%selector%generate (sf_int%rng_obj%rng, h_sel)
     else
        h_sel = 0
     end if
     sf_int%h_sel = h_sel
     call circe2_generate_whizard (r, sf_int%data%pdg_in, &
          [sf_int%data%h1(h_sel), sf_int%data%h2(h_sel)], &
          sf_int%rng_obj)
     rb = 1 - r
     x_free = x_free * product (r)
   end subroutine circe2_generate_whizard_free
 
 @ %def circe2_generate_whizard_free
 @ Generator mode: call the CIRCE2 generator for the given particles
 and helicities.  (For unpolarized generation, helicities are zero.)
 <<SF circe2: procedures>>=
   subroutine circe2_generate_whizard (x, pdg, hel, rng_obj)
     real(default), dimension(2), intent(out) :: x
     integer, dimension(2), intent(in) :: pdg
     integer, dimension(2), intent(in) :: hel
     class(rng_obj_t), intent(inout) :: rng_obj
     call circe2_generate (circe2_global_state, rng_obj, x, pdg, hel)
   end subroutine circe2_generate_whizard
 
 @ %def circe2_generate_whizard
 @ Set kinematics.  Trivial here.
 <<SF circe2: circe2: TBP>>=
   procedure :: complete_kinematics => circe2_complete_kinematics
 <<SF circe2: procedures>>=
   subroutine circe2_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(circe2_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     if (map) then
        call msg_fatal ("CIRCE2: map flag not supported")
     else
        x = r
        xb= rb
        f = 1
     end if
     call sf_int%reduce_momenta (x)
   end subroutine circe2_complete_kinematics
 
 @ %def circe2_complete_kinematics
 @ Compute inverse kinematics.
 <<SF circe2: circe2: TBP>>=
   procedure :: inverse_kinematics => circe2_inverse_kinematics
 <<SF circe2: procedures>>=
   subroutine circe2_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(circe2_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     if (map) then
        call msg_fatal ("CIRCE2: map flag not supported")
     else
        r = x
        rb= xb
        f = 1
     end if
     if (set_mom) then
        call sf_int%reduce_momenta (x)
     end if
   end subroutine circe2_inverse_kinematics
 
 @ %def circe2_inverse_kinematics
 @
 \subsection{CIRCE2 application}
 This function works on both beams.  In polarized mode, we set only the
 selected helicity.  In unpolarized mode,
 the interaction has only one entry, and the factor is unity.
 <<SF circe2: circe2: TBP>>=
   procedure :: apply => circe2_apply
 <<SF circe2: procedures>>=
   subroutine circe2_apply (sf_int, scale, rescale, i_sub)
     class(circe2_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     complex(default) :: f
     associate (data => sf_int%data)
       f = 1
       if (data%beams_polarized) then
          call sf_int%set_matrix_element (f)
       else if (data%polarized) then
          call sf_int%set_matrix_element (sf_int%h_sel, f)
       else
          call sf_int%set_matrix_element (1, f)
       end if
     end associate
     sf_int%status = SF_EVALUATED
   end subroutine circe2_apply
 
 @ %def circe2_apply
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_circe2_ut.f90]]>>=
 <<File header>>
 
 module sf_circe2_ut
   use unit_tests
   use sf_circe2_uti
 
 <<Standard module head>>
 
 <<SF circe2: public test>>
 
 contains
 
 <<SF circe2: test driver>>
 
 end module sf_circe2_ut
 @ %def sf_circe2_ut
 @
 <<[[sf_circe2_uti.f90]]>>=
 <<File header>>
 
 module sf_circe2_uti
 
 <<Use kinds>>
 <<Use strings>>
   use os_interface
   use physics_defs, only: PHOTON
   use lorentz
   use pdg_arrays
   use flavors
   use interactions, only: reset_interaction_counter
   use model_data
   use rng_base
   use sf_aux
   use sf_base
 
   use sf_circe2
 
   use rng_base_ut, only: rng_test_factory_t
 
 <<Standard module head>>
 
 <<SF circe2: test declarations>>
 
 contains
 
 <<SF circe2: tests>>
 
 end module sf_circe2_uti
 @ %def sf_circe2_ut
 @ API: driver for the unit tests below.
 <<SF circe2: public test>>=
   public :: sf_circe2_test
 <<SF circe2: test driver>>=
   subroutine sf_circe2_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF circe2: execute tests>>
   end subroutine sf_circe2_test
 
 @ %def sf_circe2_test
 @
 \subsubsection{Test structure function data}
 Construct and display a test structure function data object.
 <<SF circe2: execute tests>>=
   call test (sf_circe2_1, "sf_circe2_1", &
        "structure function configuration", &
        u, results)
 <<SF circe2: test declarations>>=
   public :: sf_circe2_1
 <<SF circe2: tests>>=
   subroutine sf_circe2_1 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(model_data_t), target :: model
     type(pdg_array_t), dimension(2) :: pdg_in
     type(pdg_array_t), dimension(2) :: pdg_out
     integer, dimension(:), allocatable :: pdg1, pdg2
     class(sf_data_t), allocatable :: data
     class(rng_factory_t), allocatable :: rng_factory
 
     write (u, "(A)")  "* Test output: sf_circe2_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &CIRCE structure function data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Create empty data object"
     write (u, "(A)")
 
     call os_data%init ()
     call model%init_qed_test ()
     pdg_in(1) = PHOTON
     pdg_in(2) = PHOTON
 
     allocate (circe2_data_t :: data)
     allocate (rng_test_factory_t :: rng_factory)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize (unpolarized)"
     write (u, "(A)")
 
     select type (data)
     type is (circe2_data_t)
        call data%init (os_data, model, pdg_in, &
             sqrts = 500._default, &
             polarized = .false., &
             beam_pol = .false., &
             file = var_str ("teslagg_500_polavg.circe"), &
             design = var_str ("TESLA/GG"))
        call data%set_generator_mode (rng_factory)
     end select
 
     call data%write (u, verbose = .true.)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     pdg2 = pdg_out(2)
     write (u, "(2x,99(1x,I0))")  pdg1, pdg2
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize (polarized)"
     write (u, "(A)")
 
     allocate (rng_test_factory_t :: rng_factory)
 
     select type (data)
     type is (circe2_data_t)
        call data%init (os_data, model, pdg_in, &
             sqrts = 500._default, &
             polarized = .true., &
             beam_pol = .false., &
             file = var_str ("teslagg_500.circe"), &
             design = var_str ("TESLA/GG"))
        call data%set_generator_mode (rng_factory)
     end select
 
     call data%write (u, verbose = .true.)
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_circe2_1"
 
   end subroutine sf_circe2_1
 
 @ %def sf_circe2_1
 @
 \subsubsection{Generator mode, unpolarized}
 Construct and evaluate a structure function object in generator mode.
 <<SF circe2: execute tests>>=
   call test (sf_circe2_2, "sf_circe2_2", &
        "generator, unpolarized", &
        u, results)
 <<SF circe2: test declarations>>=
   public :: sf_circe2_2
 <<SF circe2: tests>>=
   subroutine sf_circe2_2 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(model_data_t), target :: model
     type(flavor_t), dimension(2) :: flv
     type(pdg_array_t), dimension(2) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(rng_factory_t), allocatable :: rng_factory
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k1, k2
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f, x_free
 
     write (u, "(A)")  "* Test output: sf_circe2_2"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &circe2 structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call os_data%init ()
     call model%init_qed_test ()
     call flv(1)%init (PHOTON, model)
     call flv(2)%init (PHOTON, model)
     pdg_in(1) = PHOTON
     pdg_in(2) = PHOTON
 
     call reset_interaction_counter ()
 
     allocate (circe2_data_t :: data)
     allocate (rng_test_factory_t :: rng_factory)
     select type (data)
     type is (circe2_data_t)
        call data%init (os_data, model, pdg_in, &
             sqrts = 500._default, &
             polarized = .false., &
             beam_pol = .false., &
             file = var_str ("teslagg_500_polavg.circe"), &
             design = var_str ("TESLA/GG"))
        call data%set_generator_mode (rng_factory)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1,2])
     select type (sf_int)
     type is (circe2_t)
        call sf_int%rng_obj%rng%init (3)
     end select
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 250
     k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
     k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
     call vector4_write (k1, u)
     call vector4_write (k2, u)
     call sf_int%seed_kinematics ([k1, k2])
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate x"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r  = 0
     rb = 0
     x_free = 1
     call sf_int%generate_free (r, rb, x_free)
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
 
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
     write (u, "(A,9(1x,F10.7))")  "xf=", x_free
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate"
     write (u, "(A)")
 
     call sf_int%apply (scale = 0._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_circe2_2"
 
   end subroutine sf_circe2_2
 
 @ %def sf_circe2_2
 @
 \subsubsection{Generator mode, polarized}
 Construct and evaluate a structure function object in generator mode.
 <<SF circe2: execute tests>>=
   call test (sf_circe2_3, "sf_circe2_3", &
        "generator, polarized", &
        u, results)
 <<SF circe2: test declarations>>=
   public :: sf_circe2_3
 <<SF circe2: tests>>=
   subroutine sf_circe2_3 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(model_data_t), target :: model
     type(flavor_t), dimension(2) :: flv
     type(pdg_array_t), dimension(2) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(rng_factory_t), allocatable :: rng_factory
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k1, k2
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f, x_free
 
     write (u, "(A)")  "* Test output: sf_circe2_3"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &circe2 structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call os_data%init ()
     call model%init_qed_test ()
     call flv(1)%init (PHOTON, model)
     call flv(2)%init (PHOTON, model)
     pdg_in(1) = PHOTON
     pdg_in(2) = PHOTON
 
     call reset_interaction_counter ()
 
     allocate (circe2_data_t :: data)
     allocate (rng_test_factory_t :: rng_factory)
     select type (data)
     type is (circe2_data_t)
        call data%init (os_data, model, pdg_in, &
             sqrts = 500._default, &
             polarized = .true., &
             beam_pol = .false., &
             file = var_str ("teslagg_500.circe"), &
             design = var_str ("TESLA/GG"))
        call data%set_generator_mode (rng_factory)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1,2])
     select type (sf_int)
     type is (circe2_t)
        call sf_int%rng_obj%rng%init (3)
     end select
 
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 250
     k1 = vector4_moving (E, sqrt (E**2 - flv(1)%get_mass ()**2), 3)
     k2 = vector4_moving (E,-sqrt (E**2 - flv(2)%get_mass ()**2), 3)
     call vector4_write (k1, u)
     call vector4_write (k2, u)
     call sf_int%seed_kinematics ([k1, k2])
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate x"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r  = 0
     rb = 0
     x_free = 1
     call sf_int%generate_free (r, rb, x_free)
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
 
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
     write (u, "(A,9(1x,F10.7))")  "xf=", x_free
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate"
     write (u, "(A)")
 
     call sf_int%apply (scale = 0._default)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_circe2_3"
 
   end subroutine sf_circe2_3
 
 @ %def sf_circe2_3
 @
 \clearpage
 %------------------------------------------------------------------------
 \section{HOPPET interface}
 Interface to the HOPPET wrapper necessary to perform
 the LO vs. NLO matching of processes containing an initial
 b quark.
 <<[[hoppet_interface.f90]]>>=
 <<File header>>
 
 module hoppet_interface
   use lhapdf !NODEP!
 
 <<Standard module head>>
 
   public :: hoppet_init, hoppet_eval
 
 contains
 
   subroutine hoppet_init (pdf_builtin, pdf, pdf_id)
     logical, intent(in) :: pdf_builtin
     type(lhapdf_pdf_t), intent(inout), optional :: pdf
     integer, intent(in), optional :: pdf_id
     external InitForWhizard
     call InitForWhizard (pdf_builtin, pdf, pdf_id)
   end subroutine hoppet_init
 
   subroutine hoppet_eval (x, q, f)
     double precision, intent(in)  :: x, q
     double precision, intent(out) :: f(-6:6)
     external EvalForWhizard
     call EvalForWhizard (x, q, f)
   end subroutine hoppet_eval
 
 end module hoppet_interface
 @ %def hoppet_interface
 @
 \clearpage
 %------------------------------------------------------------------------
 \section{Builtin PDF sets}
 For convenience in order not to depend on the external package LHAPDF,
 we ship some PDFs with WHIZARD.
 @
 \subsection{The module}
 <<[[sf_pdf_builtin.f90]]>>=
 <<File header>>
 
 module sf_pdf_builtin
 
 <<Use kinds>>
   use kinds, only: double
 <<Use strings>>
   use io_units
   use format_defs, only: FMT_17
   use diagnostics
   use os_interface
   use physics_defs, only: PROTON, PHOTON, GLUON
   use physics_defs, only: HADRON_REMNANT_SINGLET
   use physics_defs, only: HADRON_REMNANT_TRIPLET
   use physics_defs, only: HADRON_REMNANT_OCTET
   use sm_qcd
   use lorentz
   use pdg_arrays
   use model_data
   use flavors
   use colors
   use quantum_numbers
   use state_matrices
   use polarizations
   use sf_base
   use pdf_builtin !NODEP!
   use hoppet_interface
 
 <<Standard module head>>
 
 <<SF pdf builtin: public>>
 
 <<SF pdf builtin: types>>
 
 <<SF pdf builtin: parameters>>
 
 contains
 
 <<SF pdf builtin: procedures>>
 
 end module sf_pdf_builtin
 @ %def sf_pdf_builtin
 @
 \subsection{Codes for default PDF sets}
 <<SF pdf builtin: parameters>>=
   character(*), parameter :: PDF_BUILTIN_DEFAULT_PROTON = "CTEQ6L"
   ! character(*), parameter :: PDF_BUILTIN_DEFAULT_PION   = "NONE"
   ! character(*), parameter :: PDF_BUILTIN_DEFAULT_PHOTON = "MRST2004QEDp"
 @ %def PDF_BUILTIN_DEFAULT_SET
 @
 \subsection{The PDF builtin data block}
 The data block holds the incoming flavor (which has to be proton,
 pion, or photon), the corresponding pointer to the global access data
 (1, 2, or 3), the flag [[invert]] which is set for an antiproton, the
 bounds as returned by LHAPDF for the specified set, and a mask that
 determines which partons will be actually in use.
 <<SF pdf builtin: public>>=
   public :: pdf_builtin_data_t
 <<SF pdf builtin: types>>=
   type, extends (sf_data_t) :: pdf_builtin_data_t
      private
      integer :: id = -1
      type (string_t) :: name
      class(model_data_t), pointer :: model => null ()
      type(flavor_t) :: flv_in
      logical :: invert
      logical :: has_photon
      logical :: photon
      logical, dimension(-6:6) :: mask
      logical :: mask_photon
      logical :: hoppet_b_matching = .false.
    contains
    <<SF pdf builtin: pdf builtin data: TBP>>
   end type pdf_builtin_data_t
 
 @ %def pdf_builtin_data_t
 @ Generate PDF data and initialize the requested set. Pion and photon PDFs
 are disabled at the moment until we ship appropiate structure functions.
 needed.
 <<SF pdf builtin: pdf builtin data: TBP>>=
   procedure :: init => pdf_builtin_data_init
 <<SF pdf builtin: procedures>>=
   subroutine pdf_builtin_data_init (data, &
        model, pdg_in, name, path, hoppet_b_matching)
     class(pdf_builtin_data_t), intent(out) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), intent(in) :: pdg_in
     type(string_t), intent(in) :: name
     type(string_t), intent(in) :: path
     logical, intent(in), optional :: hoppet_b_matching
     data%model => model
     if (pdg_array_get_length (pdg_in) /= 1) &
          call msg_fatal ("PDF: incoming particle must be unique")
     call data%flv_in%init (pdg_array_get (pdg_in, 1), model)
     data%mask = .true.
     data%mask_photon = .true.
     select case (pdg_array_get (pdg_in, 1))
     case (PROTON)
        data%name = var_str (PDF_BUILTIN_DEFAULT_PROTON)
        data%invert = .false.
        data%photon = .false.
     case (-PROTON)
        data%name = var_str (PDF_BUILTIN_DEFAULT_PROTON)
        data%invert = .true.
        data%photon = .false.
        ! case (PIPLUS)
        !    data%name = var_str (PDF_BUILTIN_DEFAULT_PION)
        !    data%invert = .false.
        !    data%photon = .false.
        ! case (-PIPLUS)
        !    data%name = var_str (PDF_BUILTIN_DEFAULT_PION)
        !    data%invert = .true.
        !    data%photon = .false.
        ! case (PHOTON)
        !    data%name = var_str (PDF_BUILTIN_DEFAULT_PHOTON)
        !    data%invert = .false.
        !    data%photon = .true.
     case default
        call msg_fatal ("PDF: " &
             // "incoming particle must either proton or antiproton.")
        return
     end select
     data%name = name
     data%id = pdf_get_id (data%name)
     if (data%id < 0) call msg_fatal ("unknown PDF set " // char (data%name))
     data%has_photon = pdf_provides_photon (data%id)
     if (present (hoppet_b_matching))  data%hoppet_b_matching = hoppet_b_matching
     call pdf_init (data%id, path)
     if (data%hoppet_b_matching)  call hoppet_init (.true., pdf_id = data%id)
   end subroutine pdf_builtin_data_init
 
 @ %def pdf_builtin_data_init
 @ Enable/disable partons explicitly.  If a mask entry is true,
 applying the PDF will generate the corresponding flavor on output.
 <<SF pdf builtin: pdf builtin data: TBP>>=
   procedure :: set_mask => pdf_builtin_data_set_mask
 <<SF pdf builtin: procedures>>=
   subroutine pdf_builtin_data_set_mask (data, mask)
     class(pdf_builtin_data_t), intent(inout) :: data
     logical, dimension(-6:6), intent(in) :: mask
     data%mask = mask
   end subroutine pdf_builtin_data_set_mask
 
 @ %def pdf_builtin_data_set_mask
 @ Output.
 <<SF pdf builtin: pdf builtin data: TBP>>=
   procedure :: write => pdf_builtin_data_write
 <<SF pdf builtin: procedures>>=
   subroutine pdf_builtin_data_write (data, unit, verbose)
     class(pdf_builtin_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)")  "PDF builtin data:"
     if (data%id < 0) then
        write (u, "(3x,A)") "[undefined]"
        return
     end if
     write (u, "(3x,A)", advance="no") "flavor       = "
     call data%flv_in%write (u);  write (u, *)
     write (u, "(3x,A,A)")   "name         = ", char (data%name)
     write (u, "(3x,A,L1)")  "invert       = ", data%invert
     write (u, "(3x,A,L1)")  "has photon   = ", data%has_photon
     write (u, "(3x,A,6(1x,L1),1x,A,1x,L1,1x,A,6(1x,L1))") &
          "mask         =", &
          data%mask(-6:-1), "*", data%mask(0), "*", data%mask(1:6)
     write (u, "(3x,A,L1)") "photon mask  = ", data%mask_photon
     write (u, "(3x,A,L1)") "hoppet_b     = ", data%hoppet_b_matching
   end subroutine pdf_builtin_data_write
 
 @ %def pdf_builtin_data_write
 @ The number of parameters is one.  We do not generate transverse momentum.
 <<SF pdf builtin: pdf builtin data: TBP>>=
   procedure :: get_n_par => pdf_builtin_data_get_n_par
 <<SF pdf builtin: procedures>>=
   function pdf_builtin_data_get_n_par (data) result (n)
     class(pdf_builtin_data_t), intent(in) :: data
     integer :: n
     n = 1
   end function pdf_builtin_data_get_n_par
 
 @ %def pdf_builtin_data_get_n_par
 @ Return the outgoing particle PDG codes.  This is based on the mask.
 <<SF pdf builtin: pdf builtin data: TBP>>=
   procedure :: get_pdg_out => pdf_builtin_data_get_pdg_out
 <<SF pdf builtin: procedures>>=
   subroutine pdf_builtin_data_get_pdg_out (data, pdg_out)
     class(pdf_builtin_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     integer, dimension(:), allocatable :: pdg1
     integer :: n, np, i
     n = count (data%mask)
     np = 0;  if (data%has_photon .and. data%mask_photon)  np = 1
     allocate (pdg1 (n + np))
     pdg1(1:n) = pack ([(i, i = -6, 6)], data%mask)
     if (np == 1)  pdg1(n+np) = PHOTON
     pdg_out(1) = pdg1
   end subroutine pdf_builtin_data_get_pdg_out
 
 @ %def pdf_builtin_data_get_pdg_out
 @ Allocate the interaction record.
 <<SF pdf builtin: pdf builtin data: TBP>>=
   procedure :: allocate_sf_int => pdf_builtin_data_allocate_sf_int
 <<SF pdf builtin: procedures>>=
   subroutine pdf_builtin_data_allocate_sf_int (data, sf_int)
     class(pdf_builtin_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (pdf_builtin_t :: sf_int)
   end subroutine pdf_builtin_data_allocate_sf_int
 
 @ %def pdf_builtin_data_allocate_sf_int
 @ Return the numerical PDF set index.
 <<SF pdf builtin: pdf builtin data: TBP>>=
   procedure :: get_pdf_set => pdf_builtin_data_get_pdf_set
 <<SF pdf builtin: procedures>>=
   elemental function pdf_builtin_data_get_pdf_set (data) result (pdf_set)
     class(pdf_builtin_data_t), intent(in) :: data
     integer :: pdf_set
     pdf_set = data%id
   end function pdf_builtin_data_get_pdf_set
 
 @ %def pdf_builtin_data_get_pdf_set
 @
 \subsection{The PDF object}
 The PDF $1\to 2$ interaction which describes
 the splitting of an (anti)proton into a parton and a beam remnant.  We
 stay in the strict forward-splitting limit, but allow some invariant
 mass for the beam remnant such that the outgoing parton is exactly
 massless.  For a real event, we would replace this by a parton
 cascade, where the outgoing partons have virtuality as dictated by
 parton-shower kinematics, and transverse momentum is generated.
 
 The PDF application is a $1\to 2$ splitting process, where the
 particles are ordered as (hadron, remnant, parton).
 
 Polarization is ignored completely.  The beam particle is colorless,
 while partons and beam remnant carry color.  The remnant gets a
 special flavor code.
 <<SF pdf builtin: public>>=
   public :: pdf_builtin_t
 <<SF pdf builtin: types>>=
   type, extends (sf_int_t) :: pdf_builtin_t
      type(pdf_builtin_data_t), pointer :: data => null ()
      real(default) :: x = 0
      real(default) :: q = 0
   contains
   <<SF pdf builtin: pdf builtin: TBP>>
   end type pdf_builtin_t
 
 @ %def pdf_builtin_t
 @ Type string: display the chosen PDF set.
 <<SF pdf builtin: pdf builtin: TBP>>=
   procedure :: type_string => pdf_builtin_type_string
 <<SF pdf builtin: procedures>>=
   function pdf_builtin_type_string (object) result (string)
     class(pdf_builtin_t), intent(in) :: object
     type(string_t) :: string
     if (associated (object%data)) then
        string = "PDF builtin: " // object%data%name
     else
        string = "PDF builtin: [undefined]"
     end if
   end function pdf_builtin_type_string
 
 @ %def pdf_builtin_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF pdf builtin: pdf builtin: TBP>>=
   procedure :: write => pdf_builtin_write
 <<SF pdf builtin: procedures>>=
   subroutine pdf_builtin_write (object, unit, testflag)
     class(pdf_builtin_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        if (object%status >= SF_DONE_KINEMATICS) then
           write (u, "(1x,A)")  "SF parameters:"
           write (u, "(3x,A," // FMT_17 // ")")  "x =", object%x
           if (object%status >= SF_FAILED_EVALUATION) then
              write (u, "(3x,A," // FMT_17 // ")")  "Q =", object%q
           end if
        end if
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "PDF builtin data: [undefined]"
     end if
   end subroutine pdf_builtin_write
 
 @ %def pdf_builtin_write
 @ Initialize.  We know that [[data]] will be of concrete type
 [[sf_test_data_t]], but we have to cast this explicitly.
 
 For this implementation, we set the incoming and outgoing masses equal
 to the physical particle mass, but keep the radiated mass zero.
 
 Optionally, we can provide minimum and maximum values for the momentum
 transfer.
 <<SF pdf builtin: pdf builtin: TBP>>=
   procedure :: init => pdf_builtin_init
 <<SF pdf builtin: procedures>>=
   subroutine pdf_builtin_init (sf_int, data)
     class(pdf_builtin_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     type(quantum_numbers_mask_t), dimension(3) :: mask
     type(flavor_t) :: flv, flv_remnant
     type(color_t) :: col0
     type(quantum_numbers_t), dimension(3) :: qn
     integer :: i
     select type (data)
     type is (pdf_builtin_data_t)
        mask = quantum_numbers_mask (.false., .false., .true.)
        call col0%init ()
        call sf_int%base_init (mask, [0._default], [0._default], [0._default])
        sf_int%data => data
        do i = -6, 6
           if (data%mask(i)) then
              call qn(1)%init (data%flv_in, col = col0)
              if (i == 0) then
                 call flv%init (GLUON, data%model)
                 call flv_remnant%init (HADRON_REMNANT_OCTET, data%model)
              else
                 call flv%init (i, data%model)
                 call flv_remnant%init &
                      (sign (HADRON_REMNANT_TRIPLET, -i), data%model)
              end if
              call qn(2)%init ( &
                   flv = flv_remnant, col = color_from_flavor (flv_remnant, 1))
              call qn(2)%tag_radiated ()
              call qn(3)%init ( &
                   flv = flv, col = color_from_flavor (flv, 1, reverse=.true.))
              call sf_int%add_state (qn)
           end if
        end do
        if (data%has_photon .and. data%mask_photon) then
           call flv%init (PHOTON, data%model)
           call flv_remnant%init (HADRON_REMNANT_SINGLET, data%model)
           call qn(2)%init (flv = flv_remnant, &
                col = color_from_flavor (flv_remnant, 1))
           call qn(2)%tag_radiated ()
           call qn(3)%init (flv = flv, &
                col = color_from_flavor (flv, 1, reverse = .true.))
           call sf_int%add_state (qn)
        end if
        call sf_int%freeze ()
        call sf_int%set_incoming ([1])
        call sf_int%set_radiated ([2])
        call sf_int%set_outgoing ([3])
        sf_int%status = SF_INITIAL
     end select
   end subroutine pdf_builtin_init
 
 @ %def pdf_builtin_init
 @
 \subsection{Kinematics}
 Set kinematics.  If [[map]] is unset, the $r$ and $x$ values
 coincide, and the Jacobian $f(r)$ is trivial.
 
 If [[map]] is set, we are asked to provide an efficient mapping.
 For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
 <<SF pdf builtin: pdf builtin: TBP>>=
   procedure :: complete_kinematics => pdf_builtin_complete_kinematics
 <<SF pdf builtin: procedures>>=
   subroutine pdf_builtin_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(pdf_builtin_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     if (map) then
        call msg_fatal ("PDF builtin: map flag not supported")
     else
        x(1) = r(1)
        xb(1)= rb(1)
        f = 1
     end if
     call sf_int%split_momentum (x, xb)
     select case (sf_int%status)
     case (SF_DONE_KINEMATICS)
        sf_int%x = x(1)
     case (SF_FAILED_KINEMATICS)
        sf_int%x = 0
        f = 0
     end select
   end subroutine pdf_builtin_complete_kinematics
 
 @ %def pdf_builtin_complete_kinematics
 @ Overriding the default method: we compute the [[x]] value from the
 momentum configuration.  In this specific case, we also set the
 internally stored $x$ value, so it can be used in the
 following routine.
 <<SF pdf builtin: pdf builtin: TBP>>=
   procedure :: recover_x => pdf_builtin_recover_x
 <<SF pdf builtin: procedures>>=
   subroutine pdf_builtin_recover_x (sf_int, x, xb, x_free)
     class(pdf_builtin_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(inout), optional :: x_free
     call sf_int%base_recover_x (x, xb, x_free)
     sf_int%x  = x(1)
   end subroutine pdf_builtin_recover_x
 
 @ %def sf_pdf_builtin_recover_x
 @ Compute inverse kinematics.  Here, we start with the $x$ array and
 compute the ``input'' $r$ values and the Jacobian $f$.  After this, we
 can set momenta by the same formula as for normal kinematics.
 <<SF pdf builtin: pdf builtin: TBP>>=
   procedure :: inverse_kinematics => pdf_builtin_inverse_kinematics
 <<SF pdf builtin: procedures>>=
   subroutine pdf_builtin_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(pdf_builtin_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     if (map) then
        call msg_fatal ("PDF builtin: map flag not supported")
     else
        r(1) = x(1)
        rb(1)= xb(1)
        f = 1
     end if
     if (set_mom) then
        call sf_int%split_momentum (x, xb)
        select case (sf_int%status)
        case (SF_FAILED_KINEMATICS);  f = 0
        end select
     end if
   end subroutine pdf_builtin_inverse_kinematics
 
 @ %def pdf_builtin_inverse_kinematics
 @
 \subsection{Structure function}
 Once the scale is also known, we can actually call the PDF and
 set the values.  Contrary to LHAPDF, the wrapper already takes care of
 adjusting to the $x$ and $Q$ bounds.  Account for the Jacobian.
 
 The class [[rescale]] gives rescaling prescription for NLO convolution of the
 structure function in combination with [[i_sub]].
 <<SF pdf builtin: pdf builtin: TBP>>=
   procedure :: apply => pdf_builtin_apply
 <<SF pdf builtin: procedures>>=
   subroutine pdf_builtin_apply (sf_int, scale, rescale, i_sub)
     class(pdf_builtin_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     real(default), dimension(-6:6) :: ff
     real(double), dimension(-6:6) :: ff_dbl
     real(default) :: x, fph
     real(double) :: xx, qq
     complex(default), dimension(:), allocatable :: fc
     integer :: i, j_sub, i_sub_opt
     i_sub_opt = 0; if (present (i_sub)) i_sub_opt = i_sub
     associate (data => sf_int%data)
       sf_int%q = scale
       x = sf_int%x
       if (present (rescale))  call rescale%apply (x)
       if (debug2_active (D_BEAMS)) then
          call msg_debug2 (D_BEAMS, "pdf_builtin_apply")
          call msg_debug2 (D_BEAMS, "rescale: ", present(rescale))
          call msg_debug2 (D_BEAMS, "i_sub: ", i_sub_opt)
          call msg_debug2 (D_BEAMS, "x: ", x)
       end if
       xx = x
       qq = scale
       if (data%invert) then
          if (data%has_photon) then
             call pdf_evolve (data%id, x, scale, ff(6:-6:-1), fph)
          else
             if (data%hoppet_b_matching) then
                call hoppet_eval (xx, qq, ff_dbl(6:-6:-1))
                ff = ff_dbl
             else
                call pdf_evolve (data%id, x, scale, ff(6:-6:-1))
             end if
          end if
       else
          if (data%has_photon) then
             call pdf_evolve (data%id, x, scale, ff, fph)
          else
             if (data%hoppet_b_matching) then
                call hoppet_eval (xx, qq, ff_dbl)
                ff = ff_dbl
             else
                call pdf_evolve (data%id, x, scale, ff)
             end if
          end if
       end if
       if (data%has_photon) then
          allocate (fc (count ([data%mask, data%mask_photon])))
          fc = max (pack ([ff, fph], &
               [data%mask, data%mask_photon]), 0._default)
       else
          allocate (fc (count (data%mask)))
          fc = max (pack (ff, data%mask), 0._default)
       end if
     end associate
     if (debug_active (D_BEAMS)) print *, 'Set pdfs: ', real (fc)
     call sf_int%set_matrix_element (fc, [(i_sub_opt * size(fc) + i, i = 1, size(fc))])
     sf_int%status = SF_EVALUATED
   end subroutine pdf_builtin_apply
 
 @ %def pdf_builtin_apply
 @
 \subsection{Strong Coupling}
 Since the PDF codes provide a function for computing the running
 $\alpha_s$ value, we make this available as an implementation of the
 abstract [[alpha_qcd_t]] type, which is used for matrix element evaluation.
 <<SF pdf builtin: public>>=
   public :: alpha_qcd_pdf_builtin_t
 <<SF pdf builtin: types>>=
   type, extends (alpha_qcd_t) :: alpha_qcd_pdf_builtin_t
      type(string_t) :: pdfset_name
      integer :: pdfset_id = -1
    contains
    <<SF pdf builtin: alpha qcd: TBP>>
   end type alpha_qcd_pdf_builtin_t
 
 @ %def alpha_qcd_pdf_builtin_t
 @ Output.
 <<SF pdf builtin: alpha qcd: TBP>>=
   procedure :: write => alpha_qcd_pdf_builtin_write
 <<SF pdf builtin: procedures>>=
   subroutine alpha_qcd_pdf_builtin_write (object, unit)
     class(alpha_qcd_pdf_builtin_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(3x,A)")  "QCD parameters (pdf_builtin):"
     write (u, "(5x,A,A)")  "PDF set = ", char (object%pdfset_name)
     write (u, "(5x,A,I0)") "PDF ID  = ", object%pdfset_id
   end subroutine alpha_qcd_pdf_builtin_write
 
 @ %def alpha_qcd_pdf_builtin_write
 @ Calculation: the numeric ID selects the correct PDF set, which must
 be properly initialized.
 <<SF pdf builtin: alpha qcd: TBP>>=
   procedure :: get => alpha_qcd_pdf_builtin_get
 <<SF pdf builtin: procedures>>=
   function alpha_qcd_pdf_builtin_get (alpha_qcd, scale) result (alpha)
     class(alpha_qcd_pdf_builtin_t), intent(in) :: alpha_qcd
     real(default), intent(in) :: scale
     real(default) :: alpha
     alpha = pdf_alphas (alpha_qcd%pdfset_id, scale)
   end function alpha_qcd_pdf_builtin_get
 
 @ %def alpha_qcd_pdf_builtin_get
 @
 Initialization.  We need to access the global initialization status.
 <<SF pdf builtin: alpha qcd: TBP>>=
   procedure :: init => alpha_qcd_pdf_builtin_init
 <<SF pdf builtin: procedures>>=
   subroutine alpha_qcd_pdf_builtin_init (alpha_qcd, name, path)
     class(alpha_qcd_pdf_builtin_t), intent(out) :: alpha_qcd
     type(string_t), intent(in) :: name
     type(string_t), intent(in) :: path
     alpha_qcd%pdfset_name = name
     alpha_qcd%pdfset_id = pdf_get_id (name)
     if (alpha_qcd%pdfset_id < 0) &
          call msg_fatal ("QCD parameter initialization: PDF set " &
          // char (name) // " is unknown")
     call pdf_init (alpha_qcd%pdfset_id, path)
   end subroutine alpha_qcd_pdf_builtin_init
 
 @ %def alpha_qcd_pdf_builtin_init
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_pdf_builtin_ut.f90]]>>=
 <<File header>>
 
 module sf_pdf_builtin_ut
   use unit_tests
   use sf_pdf_builtin_uti
 
 <<Standard module head>>
 
 <<SF pdf builtin: public test>>
 
 contains
 
 <<SF pdf builtin: test driver>>
 
 end module sf_pdf_builtin_ut
 @ %def sf_pdf_builtin_ut
 @
 <<[[sf_pdf_builtin_uti.f90]]>>=
 <<File header>>
 
 module sf_pdf_builtin_uti
 
 <<Use kinds>>
 <<Use strings>>
   use os_interface
   use physics_defs, only: PROTON
   use sm_qcd
   use lorentz
   use pdg_arrays
   use flavors
   use interactions, only: reset_interaction_counter
   use model_data
   use sf_base
 
   use sf_pdf_builtin
 
 <<Standard module head>>
 
 <<SF pdf builtin: test declarations>>
 
 contains
 
 <<SF pdf builtin: tests>>
 
 end module sf_pdf_builtin_uti
 @ %def sf_pdf_builtin_ut
 @ API: driver for the unit tests below.
 <<SF pdf builtin: public test>>=
   public :: sf_pdf_builtin_test
 <<SF pdf builtin: test driver>>=
   subroutine sf_pdf_builtin_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF pdf builtin: execute tests>>
   end subroutine sf_pdf_builtin_test
 
 @ %def sf_pdf_builtin_test
 @
 \subsubsection{Test structure function data}
 Construct and display a test structure function data object.
 <<SF pdf builtin: execute tests>>=
   call test (sf_pdf_builtin_1, "sf_pdf_builtin_1", &
        "structure function configuration", &
        u, results)
 <<SF pdf builtin: test declarations>>=
   public :: sf_pdf_builtin_1
 <<SF pdf builtin: tests>>=
   subroutine sf_pdf_builtin_1 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(pdg_array_t), dimension(1) :: pdg_out
     integer, dimension(:), allocatable :: pdg1
     class(sf_data_t), allocatable :: data
     type(string_t) :: name
 
     write (u, "(A)")  "* Test output: sf_pdf_builtin_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &test structure function data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Create empty data object"
     write (u, "(A)")
 
     call os_data%init ()
 
     call model%init_sm_test ()
     pdg_in = PROTON
 
     allocate (pdf_builtin_data_t :: data)
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     name = "CTEQ6L"
 
     select type (data)
     type is (pdf_builtin_data_t)
        call data%init (model, pdg_in, name, &
             os_data%pdf_builtin_datapath)
     end select
 
     call data%write (u)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     write (u, "(2x,99(1x,I0))")  pdg1
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_pdf_builtin_1"
 
   end subroutine sf_pdf_builtin_1
 
 @ %def sf_pdf_builtin_1
 @
 \subsubsection{Test and probe structure function}
 Construct and display a structure function object based on the PDF builtin
 structure function.
 <<SF pdf builtin: execute tests>>=
   call test (sf_pdf_builtin_2, "sf_pdf_builtin_2", &
        "structure function instance", &
        u, results)
 <<SF pdf builtin: test declarations>>=
   public :: sf_pdf_builtin_2
 <<SF pdf builtin: tests>>=
   subroutine sf_pdf_builtin_2 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(string_t) :: name
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_pdf_builtin_2"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call os_data%init ()
     call model%init_sm_test ()
     call flv%init (PROTON, model)
     pdg_in = PROTON
 
     call reset_interaction_counter ()
 
     name = "CTEQ6L"
 
     allocate (pdf_builtin_data_t :: data)
     select type (data)
     type is (pdf_builtin_data_t)
        call data%init (model, pdg_in, name, &
             os_data%pdf_builtin_datapath)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
 
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = 0.5_default
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
 
     call sf_int%seed_kinematics ([k])
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
 
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for Q = 100 GeV"
     write (u, "(A)")
 
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%apply (scale = 100._default)
     call sf_int%write (u)
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_pdf_builtin_2"
 
   end subroutine sf_pdf_builtin_2
 
 @ %def sf_pdf_builtin_2
 @
 \subsubsection{Strong Coupling}
 Test $\alpha_s$ as an implementation of the [[alpha_qcd_t]] abstract
 type.
 <<SF pdf builtin: execute tests>>=
   call test (sf_pdf_builtin_3, "sf_pdf_builtin_3", &
        "running alpha_s", &
        u, results)
 <<SF pdf builtin: test declarations>>=
   public :: sf_pdf_builtin_3
 <<SF pdf builtin: tests>>=
   subroutine sf_pdf_builtin_3 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(qcd_t) :: qcd
     type(string_t) :: name
 
     write (u, "(A)")  "* Test output: sf_pdf_builtin_3"
     write (u, "(A)")  "*   Purpose: initialize and evaluate alpha_s"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call os_data%init ()
 
     name = "CTEQ6L"
 
     write (u, "(A)")  "* Initialize qcd object"
     write (u, "(A)")
 
     allocate (alpha_qcd_pdf_builtin_t :: qcd%alpha)
     select type (alpha => qcd%alpha)
     type is (alpha_qcd_pdf_builtin_t)
        call alpha%init (name, os_data%pdf_builtin_datapath)
     end select
     call qcd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for Q = 100"
     write (u, "(A)")
 
     write (u, "(1x,A,F8.5)")  "alpha = ", qcd%alpha%get (100._default)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_pdf_builtin_3"
 
   end subroutine sf_pdf_builtin_3
 
 @ %def sf_pdf_builtin_3
 @
 \clearpage
 %------------------------------------------------------------------------
 \section{LHAPDF}
 Parton distribution functions (PDFs) are available via an interface to
 the LHAPDF standard library.
 @
 \subsection{The module}
 <<[[sf_lhapdf.f90]]>>=
 <<File header>>
 
 module sf_lhapdf
 
 <<Use kinds>>
 <<Use strings>>
   use format_defs, only: FMT_17, FMT_19
   use io_units
   use system_dependencies, only: LHAPDF_PDFSETS_PATH
   use system_dependencies, only: LHAPDF5_AVAILABLE
   use system_dependencies, only: LHAPDF6_AVAILABLE
   use diagnostics
   use physics_defs, only: PROTON, PHOTON, PIPLUS, GLUON
   use physics_defs, only: HADRON_REMNANT_SINGLET
   use physics_defs, only: HADRON_REMNANT_TRIPLET
   use physics_defs, only: HADRON_REMNANT_OCTET
   use lorentz
   use sm_qcd
   use pdg_arrays
   use model_data
   use flavors
   use colors
   use quantum_numbers
   use state_matrices
   use polarizations
   use sf_base
   use lhapdf !NODEP!
   use hoppet_interface
 
 <<Standard module head>>
 
 <<SF lhapdf: public>>
 
 <<SF lhapdf: types>>
 
 <<SF lhapdf: parameters>>
 
 <<SF lhapdf: variables>>
 
 <<SF lhapdf: interfaces>>
 
 contains
 
 <<SF lhapdf: procedures>>
 
 end module sf_lhapdf
 @ %def sf_lhapdf
 @
 \subsection{Codes for default PDF sets}
 The default PDF for protons set is chosen to be CTEQ6ll (LO fit with
 LO $\alpha_s$).
 <<SF lhapdf: parameters>>=
   character(*), parameter :: LHAPDF5_DEFAULT_PROTON = "cteq6ll.LHpdf"
   character(*), parameter :: LHAPDF5_DEFAULT_PION   = "ABFKWPI.LHgrid"
   character(*), parameter :: LHAPDF5_DEFAULT_PHOTON = "GSG960.LHgrid"
   character(*), parameter :: LHAPDF6_DEFAULT_PROTON = "CT10"
 @ %def LHAPDF5_DEFAULT_PROTON LHAPDF5_DEFAULT_PION
 @ %def LHAPDF5_DEFAULT_PHOTON LHAPDF6_DEFAULT_PROTON
 @
 \subsection{LHAPDF library interface}
 Here we specify explicit interfaces for all LHAPDF routines that we
 use below.
 <<SF lhapdf: interfaces>>=
   interface
      subroutine InitPDFsetM (set, file)
        integer, intent(in) :: set
        character(*), intent(in) :: file
      end subroutine InitPDFsetM
   end interface
 
 @ %def InitPDFsetM
 <<SF lhapdf: interfaces>>=
   interface
      subroutine InitPDFM (set, mem)
        integer, intent(in) :: set, mem
      end subroutine InitPDFM
   end interface
 
 @ %def InitPDFM
 <<SF lhapdf: interfaces>>=
   interface
      subroutine numberPDFM (set, n_members)
        integer, intent(in) :: set
        integer, intent(out) :: n_members
      end subroutine numberPDFM
   end interface
 
 @ %def numberPDFM
 <<SF lhapdf: interfaces>>=
   interface
      subroutine evolvePDFM (set, x, q, ff)
        integer, intent(in) :: set
        double precision, intent(in) :: x, q
        double precision, dimension(-6:6), intent(out) :: ff
      end subroutine evolvePDFM
   end interface
 
 @ %def evolvePDFM
 <<SF lhapdf: interfaces>>=
   interface
      subroutine evolvePDFphotonM (set, x, q, ff, fphot)
        integer, intent(in) :: set
        double precision, intent(in) :: x, q
        double precision, dimension(-6:6), intent(out) :: ff
        double precision, intent(out) :: fphot
      end subroutine evolvePDFphotonM
   end interface
 
 @ %def evolvePDFphotonM
 <<SF lhapdf: interfaces>>=
   interface
      subroutine evolvePDFpM (set, x, q, s, scheme, ff)
        integer, intent(in) :: set
        double precision, intent(in) :: x, q, s
        integer, intent(in) :: scheme
        double precision, dimension(-6:6), intent(out) :: ff
      end subroutine evolvePDFpM
   end interface
 
 @ %def evolvePDFpM
 <<SF lhapdf: interfaces>>=
   interface
      subroutine GetXminM (set, mem, xmin)
        integer, intent(in) :: set, mem
        double precision, intent(out) :: xmin
      end subroutine GetXminM
   end interface
 
 @ %def GetXminM
 <<SF lhapdf: interfaces>>=
   interface
      subroutine GetXmaxM (set, mem, xmax)
        integer, intent(in) :: set, mem
        double precision, intent(out) :: xmax
      end subroutine GetXmaxM
   end interface
 
 @ %def GetXmaxM
 <<SF lhapdf: interfaces>>=
   interface
      subroutine GetQ2minM (set, mem, q2min)
        integer, intent(in) :: set, mem
        double precision, intent(out) :: q2min
      end subroutine GetQ2minM
   end interface
 
 @ %def GetQ2minM
 <<SF lhapdf: interfaces>>=
   interface
      subroutine GetQ2maxM (set, mem, q2max)
        integer, intent(in) :: set, mem
        double precision, intent(out) :: q2max
      end subroutine GetQ2maxM
   end interface
 
 @ %def GetQ2maxM
 <<SF lhapdf: interfaces>>=
   interface
      function has_photon () result(flag)
         logical :: flag
      end function has_photon
   end interface
 
 @ %def has_photon
 @
 \subsection{The LHAPDF status}
 This type holds the initialization status of the LHAPDF system. Entry
 1 is for proton PDFs, entry 2 for pion PDFs, entry 3 for photon PDFs.
 
 Since it is connected to the external LHAPDF library, this is a truly
 global object.  We implement it as a a private module variable.  To
 access it from elsewhere, the caller has to create and initialize an
 object of type [[lhapdf_status_t]], which acts as a proxy.
 <<SF lhapdf: types>>=
   type :: lhapdf_global_status_t
      private
      logical, dimension(3) :: initialized = .false.
   end type lhapdf_global_status_t
 
 @ %def lhapdf_global_status_t
 <<SF lhapdf: variables>>=
   type(lhapdf_global_status_t), save :: lhapdf_global_status
 @ %def lhapdf_global_status
 <<SF lhapdf: procedures>>=
   function lhapdf_global_status_is_initialized (set) result (flag)
     logical :: flag
     integer, intent(in), optional :: set
     if (present (set)) then
        select case (set)
        case (1:3);    flag = lhapdf_global_status%initialized(set)
        case default;  flag = .false.
        end select
     else
        flag = any (lhapdf_global_status%initialized)
     end if
   end function lhapdf_global_status_is_initialized
 
 @ %def lhapdf_global_status_is_initialized
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_global_status_set_initialized (set)
     integer, intent(in) :: set
     lhapdf_global_status%initialized(set) = .true.
   end subroutine lhapdf_global_status_set_initialized
 
 @ %def lhapdf_global_status_set_initialized
 @ This is the only public procedure, it tells the system to forget
 about previous initialization, allowing for changing the chosen PDF
 set.  Note that such a feature works only if the global program flow
 is serial, so no two distinct sets are accessed simultaneously.  But
 this applies to LHAPDF anyway.
 <<SF lhapdf: public>>=
   public :: lhapdf_global_reset
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_global_reset ()
     lhapdf_global_status%initialized = .false.
   end subroutine lhapdf_global_reset
 
 @ %def lhapdf_global_status_reset
 @
 \subsection{LHAPDF initialization}
 Before using LHAPDF, we have to initialize it with a particular data
 set and member.  This applies not just if we use structure functions,
 but also if we just use an $\alpha_s$ formula.  The integer [[set]]
 should be $1$ for proton, $2$ for pion, and $3$ for photon, but this
 is just convention.
 
 It appears as if LHAPDF does not allow for multiple data sets being
 used concurrently (?), so multi-threaded usage with different sets
 (e.g., a scan) is excluded.  The current setup with a global flag that
 indicates initialization is fine as long as Whizard itself is run in
 serial mode at the Sindarin level.  If we introduce multithreading in
 any form from Sindarin, we have to rethink the implementation of the
 LHAPDF interface.  (The same considerations apply to builtin PDFs.)
 
 If the particular set has already been initialized, do nothing.  This
 implies that whenever we want to change the setup for a particular
 set, we have to reset the LHAPDF status.
 [[lhapdf_initialize]] has an obvious name clash with [[lhapdf_init]],
 the reason it works for [[pdf_builtin]] is that there things are
 outsourced to a separate module (inc. [[lhapdf_status]] etc.).
 <<SF lhapdf: public>>=
   public :: lhapdf_initialize
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_initialize (set, prefix, file, member, pdf, b_match)
     integer, intent(in) :: set
     type(string_t), intent(inout) :: prefix
     type(string_t), intent(inout) :: file
     type(lhapdf_pdf_t), intent(inout), optional :: pdf
     integer, intent(inout) :: member
     logical, intent(in), optional :: b_match
     if (prefix == "")  prefix = LHAPDF_PDFSETS_PATH
     if (LHAPDF5_AVAILABLE) then
        if (lhapdf_global_status_is_initialized (set))  return
        if (file == "") then
           select case (set)
           case (1);  file = LHAPDF5_DEFAULT_PROTON
           case (2);  file = LHAPDF5_DEFAULT_PION
           case (3);  file = LHAPDF5_DEFAULT_PHOTON
           end select
        end if
        if (data_file_exists (prefix // "/" // file)) then
           call InitPDFsetM (set, char (prefix // "/" // file))
        else
           call msg_fatal ("LHAPDF: Data file '" &
                // char (file) // "' not found in '" // char (prefix) // "'.")
           return
        end if
        if (.not. dataset_member_exists (set, member)) then
           call msg_error (" LHAPDF: Chosen member does not exist for set '" &
                // char (file) // "', using default.")
           member = 0
        end if
        call InitPDFM (set, member)
     else if (LHAPDF6_AVAILABLE) then
     ! TODO: (bcn 2015-07-07) we should have a closer look why this global
     !                        check must not be executed
     !   if (lhapdf_global_status_is_initialized (set) .and. &
     !        pdf%is_associated ()) return
        if (file == "") then
           select case (set)
           case (1);  file = LHAPDF6_DEFAULT_PROTON
           case (2);
              call msg_fatal ("LHAPDF6: no pion PDFs supported")
           case (3);
              call msg_fatal ("LHAPDF6: no photon PDFs supported")
           end select
        end if
        if (data_file_exists (prefix // "/" // file // "/" // file // ".info")) then
           call pdf%init (char (file), member)
        else
           call msg_fatal ("LHAPDF: Data file '" &
                // char (file) // "' not found in '" // char (prefix) // "'.")
           return
        end if
     end if
     if (present (b_match)) then
        if (b_match) then
           if (LHAPDF5_AVAILABLE) then
              call hoppet_init (.false.)
           else if (LHAPDF6_AVAILABLE) then
              call hoppet_init (.false., pdf)
           end if
        end if
     end if
     call lhapdf_global_status_set_initialized (set)
   contains
     function data_file_exists (fq_name) result (exist)
       type(string_t), intent(in) :: fq_name
       logical :: exist
       inquire (file = char(fq_name), exist = exist)
     end function data_file_exists
     function dataset_member_exists (set, member) result (exist)
       integer, intent(in) :: set, member
       logical :: exist
       integer :: n_members
       call numberPDFM (set, n_members)
       exist = member >= 0 .and. member <= n_members
     end function dataset_member_exists
   end subroutine lhapdf_initialize
 
 @ %def lhapdf_initialize
 @
 \subsection{Kinematics}
 Set kinematics.  If [[map]] is unset, the $r$ and $x$ values
 coincide, and the Jacobian $f(r)$ is trivial.
 
 If [[map]] is set, we are asked to provide an efficient mapping.
 For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
 <<SF lhapdf: lhapdf: TBP>>=
   procedure :: complete_kinematics => lhapdf_complete_kinematics
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_complete_kinematics (sf_int, x, xb, f, r, rb, map)
     class(lhapdf_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(in) :: r
     real(default), dimension(:), intent(in) :: rb
     logical, intent(in) :: map
     if (map) then
        call msg_fatal ("LHAPDF: map flag not supported")
     else
        x(1) = r(1)
        xb(1)= rb(1)
        f = 1
     end if
     call sf_int%split_momentum (x, xb)
     select case (sf_int%status)
     case (SF_DONE_KINEMATICS)
        sf_int%x = x(1)
     case (SF_FAILED_KINEMATICS)
        sf_int%x = 0
        f = 0
     end select
   end subroutine lhapdf_complete_kinematics
 
 @ %def lhapdf_complete_kinematics
 @ Overriding the default method: we compute the [[x]] value from the
 momentum configuration.  In this specific case, we also set the
 internally stored $x$ value, so it can be used in the
 following routine.
 <<SF lhapdf: lhapdf: TBP>>=
   procedure :: recover_x => lhapdf_recover_x
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_recover_x (sf_int, x, xb, x_free)
     class(lhapdf_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(out) :: x
     real(default), dimension(:), intent(out) :: xb
     real(default), intent(inout), optional :: x_free
     call sf_int%base_recover_x (x, xb, x_free)
     sf_int%x  = x(1)
   end subroutine lhapdf_recover_x
 
 @ %def lhapdf_recover_x
 @ Compute inverse kinematics.  Here, we start with the $x$ array and
 compute the ``input'' $r$ values and the Jacobian $f$.  After this, we
 can set momenta by the same formula as for normal kinematics.
 <<SF lhapdf: lhapdf: TBP>>=
   procedure :: inverse_kinematics => lhapdf_inverse_kinematics
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
     class(lhapdf_t), intent(inout) :: sf_int
     real(default), dimension(:), intent(in) :: x
     real(default), dimension(:), intent(in) :: xb
     real(default), intent(out) :: f
     real(default), dimension(:), intent(out) :: r
     real(default), dimension(:), intent(out) :: rb
     logical, intent(in) :: map
     logical, intent(in), optional :: set_momenta
     logical :: set_mom
     set_mom = .false.;  if (present (set_momenta))  set_mom = set_momenta
     if (map) then
        call msg_fatal ("LHAPDF: map flag not supported")
     else
        r(1) = x(1)
        rb(1)= xb(1)
        f = 1
     end if
     if (set_mom) then
        call sf_int%split_momentum (x, xb)
        select case (sf_int%status)
        case (SF_FAILED_KINEMATICS);  f = 0
        end select
     end if
   end subroutine lhapdf_inverse_kinematics
 
 @ %def lhapdf_inverse_kinematics
 @
 \subsection{The LHAPDF data block}
 The data block holds the incoming flavor (which has to be proton,
 pion, or photon), the corresponding pointer to the global access data
 (1, 2, or 3), the flag [[invert]] which is set for an antiproton, the
 bounds as returned by LHAPDF for the specified set, and a mask that
 determines which partons will be actually in use.
 <<SF lhapdf: public>>=
   public :: lhapdf_data_t
 <<SF lhapdf: types>>=
   type, extends (sf_data_t) :: lhapdf_data_t
      private
      type(string_t) :: prefix
      type(string_t) :: file
      type(lhapdf_pdf_t) :: pdf
      integer :: member = 0
      class(model_data_t), pointer :: model => null ()
      type(flavor_t) :: flv_in
      integer :: set = 0
      logical :: invert = .false.
      logical :: photon = .false.
      logical :: has_photon = .false.
      integer :: photon_scheme = 0
      real(default) :: xmin = 0, xmax = 0
      real(default) :: qmin = 0, qmax = 0
      logical, dimension(-6:6) :: mask = .true.
      logical :: mask_photon = .true.
      logical :: hoppet_b_matching = .false.
    contains
      <<SF lhapdf: lhapdf data: TBP>>
   end type lhapdf_data_t
 
 @ %def lhapdf_data_t
 @ Generate PDF data.  This is provided as a function, but it has the
 side-effect of initializing the requested PDF set.  A finalizer is not
 needed.
 
 The library uses double precision, so since the default precision may be
 extended or quadruple, we use auxiliary variables for type casting.
 <<SF lhapdf: lhapdf data: TBP>>=
   procedure :: init => lhapdf_data_init
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_data_init &
        (data, model, pdg_in, prefix, file, member, photon_scheme, &
             hoppet_b_matching)
     class(lhapdf_data_t), intent(out) :: data
     class(model_data_t), intent(in), target :: model
     type(pdg_array_t), intent(in) :: pdg_in
     type(string_t), intent(in), optional :: prefix, file
     integer, intent(in), optional :: member
     integer, intent(in), optional :: photon_scheme
     logical, intent(in), optional :: hoppet_b_matching
     double precision :: xmin, xmax, q2min, q2max
     external :: InitPDFsetM, InitPDFM, numberPDFM
     external :: GetXminM, GetXmaxM, GetQ2minM, GetQ2maxM
     if (.not. LHAPDF5_AVAILABLE .and. .not. LHAPDF6_AVAILABLE) then
        call msg_fatal ("LHAPDF requested but library is not linked")
        return
     end if
     data%model => model
     if (pdg_array_get_length (pdg_in) /= 1) &
          call msg_fatal ("PDF: incoming particle must be unique")
     call data%flv_in%init (pdg_array_get (pdg_in, 1), model)
     select case (pdg_array_get (pdg_in, 1))
     case (PROTON)
        data%set = 1
     case (-PROTON)
        data%set = 1
        data%invert = .true.
     case (PIPLUS)
        data%set = 2
     case (-PIPLUS)
        data%set = 2
        data%invert = .true.
     case (PHOTON)
        data%set = 3
        data%photon = .true.
        if (present (photon_scheme))  data%photon_scheme = photon_scheme
     case default
        call msg_fatal (" LHAPDF: " &
             // "incoming particle must be (anti)proton, pion, or photon.")
        return
     end select
     if (present (prefix)) then
        data%prefix = prefix
     else
        data%prefix = ""
     end if
     if (present (file)) then
        data%file = file
     else
        data%file = ""
     end if
     if (present (hoppet_b_matching))  data%hoppet_b_matching = hoppet_b_matching
     if (LHAPDF5_AVAILABLE) then
        call lhapdf_initialize (data%set, &
             data%prefix, data%file, data%member, &
             b_match = data%hoppet_b_matching)
        call GetXminM (data%set, data%member, xmin)
        call GetXmaxM (data%set, data%member, xmax)
        call GetQ2minM (data%set, data%member, q2min)
        call GetQ2maxM (data%set, data%member, q2max)
        data%xmin = xmin
        data%xmax = xmax
        data%qmin = sqrt (q2min)
        data%qmax = sqrt (q2max)
        data%has_photon = has_photon ()
     else if (LHAPDF6_AVAILABLE) then
        call lhapdf_initialize (data%set, &
             data%prefix, data%file, data%member, &
             data%pdf, data%hoppet_b_matching)
        data%xmin = data%pdf%getxmin ()
        data%xmax = data%pdf%getxmax ()
        data%qmin = sqrt(data%pdf%getq2min ())
        data%qmax = sqrt(data%pdf%getq2max ())
        data%has_photon = data%pdf%has_photon ()
     end if
   end subroutine lhapdf_data_init
 
 @ %def lhapdf_data_init
 @ Enable/disable partons explicitly.  If a mask entry is true,
 applying the PDF will generate the corresponding flavor on output.
 <<LHAPDF: lhapdf data: TBP>>=
   procedure :: set_mask => lhapdf_data_set_mask
 <<LHAPDF: procedures>>=
   subroutine lhapdf_data_set_mask (data, mask)
     class(lhapdf_data_t), intent(inout) :: data
     logical, dimension(-6:6), intent(in) :: mask
     data%mask = mask
   end subroutine lhapdf_data_set_mask
 
 @ %def lhapdf_data_set_mask
 @ Return the public part of the data set.
 <<LHAPDF: public>>=
   public :: lhapdf_data_get_public_info
 <<LHAPDF: procedures>>=
   subroutine lhapdf_data_get_public_info &
        (data, lhapdf_dir, lhapdf_file, lhapdf_member)
     type(lhapdf_data_t), intent(in) :: data
     type(string_t), intent(out) :: lhapdf_dir, lhapdf_file
     integer, intent(out) :: lhapdf_member
     lhapdf_dir = data%prefix
     lhapdf_file = data%file
     lhapdf_member = data%member
   end subroutine lhapdf_data_get_public_info
 
 @ %def lhapdf_data_get_public_info
 @ Return the number of the member of the data set.
 <<LHAPDF: public>>=
   public :: lhapdf_data_get_set
 <<LHAPDF: procedures>>=
   function lhapdf_data_get_set(data) result(set)
     type(lhapdf_data_t), intent(in) :: data
     integer :: set
     set = data%set
   end function lhapdf_data_get_set
 
 @ %def lhapdf_data_get_set
 @ Output
 <<SF lhapdf: lhapdf data: TBP>>=
   procedure :: write => lhapdf_data_write
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_data_write (data, unit, verbose)
     class(lhapdf_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     logical :: verb
     integer :: u
     if (present (verbose)) then
        verb = verbose
     else
        verb = .false.
     end if
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)") "LHAPDF data:"
     if (data%set /= 0) then
        write (u, "(3x,A)", advance="no") "flavor       =  "
        call data%flv_in%write (u);  write (u, *)
        if (verb) then
           write (u, "(3x,A,A)")       "  prefix       =  ", char (data%prefix)
        else
           write (u, "(3x,A,A)")       "  prefix       = ", &
                " <empty (non-verbose version)>"
        end if
        write (u, "(3x,A,A)")       "  file         =  ", char (data%file)
        write (u, "(3x,A,I3)")      "  member       = ", data%member
        write (u, "(3x,A," // FMT_19 // ")") "  x(min)       = ", data%xmin
        write (u, "(3x,A," // FMT_19 // ")") "  x(max)       = ", data%xmax
        write (u, "(3x,A," // FMT_19 // ")") "  Q(min)       = ", data%qmin
        write (u, "(3x,A," // FMT_19 // ")") "  Q(max)       = ", data%qmax
        write (u, "(3x,A,L1)")      "  invert       =  ", data%invert
        if (data%photon)  write (u, "(3x,A,I3)") &
             "  IP2 (scheme) = ", data%photon_scheme
           write (u, "(3x,A,6(1x,L1),1x,A,1x,L1,1x,A,6(1x,L1))") &
                "  mask         = ", &
                data%mask(-6:-1), "*", data%mask(0), "*", data%mask(1:6)
           write (u, "(3x,A,L1)")   "  photon mask  =  ", data%mask_photon
        if (data%set == 1)  write (u, "(3x,A,L1)") &
             "  hoppet_b     =  ", data%hoppet_b_matching
     else
        write (u, "(3x,A)") "[undefined]"
     end if
   end subroutine lhapdf_data_write
 @ %def lhapdf_data_write
 @ The number of parameters is one.  We do not generate transverse momentum.
 <<SF lhapdf: lhapdf data: TBP>>=
   procedure :: get_n_par => lhapdf_data_get_n_par
 <<SF lhapdf: procedures>>=
   function lhapdf_data_get_n_par (data) result (n)
     class(lhapdf_data_t), intent(in) :: data
     integer :: n
     n = 1
   end function lhapdf_data_get_n_par
 
 @ %def lhapdf_data_get_n_par
 @ Return the outgoing particle PDG codes.  This is based on the mask.
 <<SF lhapdf: lhapdf data: TBP>>=
   procedure :: get_pdg_out => lhapdf_data_get_pdg_out
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_data_get_pdg_out (data, pdg_out)
     class(lhapdf_data_t), intent(in) :: data
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
     integer, dimension(:), allocatable :: pdg1
     integer :: n, np, i
     n = count (data%mask)
     np = 0;  if (data%has_photon .and. data%mask_photon)  np = 1
     allocate (pdg1 (n + np))
     pdg1(1:n) = pack ([(i, i = -6, 6)], data%mask)
     if (np == 1)  pdg1(n+np) = PHOTON
     pdg_out(1) = pdg1
   end subroutine lhapdf_data_get_pdg_out
 
 @ %def lhapdf_data_get_pdg_out
 @ Allocate the interaction record.
 <<SF lhapdf: lhapdf data: TBP>>=
   procedure :: allocate_sf_int => lhapdf_data_allocate_sf_int
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_data_allocate_sf_int (data, sf_int)
     class(lhapdf_data_t), intent(in) :: data
     class(sf_int_t), intent(inout), allocatable :: sf_int
     allocate (lhapdf_t :: sf_int)
   end subroutine lhapdf_data_allocate_sf_int
 
 @ %def lhapdf_data_allocate_sf_int
 @ Return the numerical PDF set index.
 <<SF lhapdf: lhapdf data: TBP>>=
   procedure :: get_pdf_set => lhapdf_data_get_pdf_set
 <<SF lhapdf: procedures>>=
   elemental function lhapdf_data_get_pdf_set (data) result (pdf_set)
     class(lhapdf_data_t), intent(in) :: data
     integer :: pdf_set
     pdf_set = data%set
   end function lhapdf_data_get_pdf_set
 
 @ %def lhapdf_data_get_pdf_set
 @
 \subsection{The LHAPDF object}
 The [[lhapdf_t]] data type is a $1\to 2$ interaction which describes
 the splitting of an (anti)proton into a parton and a beam remnant.  We
 stay in the strict forward-splitting limit, but allow some invariant
 mass for the beam remnant such that the outgoing parton is exactly
 massless.  For a real event, we would replace this by a parton
 cascade, where the outgoing partons have virtuality as dictated by
 parton-shower kinematics, and transverse momentum is generated.
 
 This is the LHAPDF object which holds input data together with the
 interaction.  We also store the $x$ momentum fraction and the scale,
 since kinematics and function value are requested at different times.
 
 The PDF application is a $1\to 2$ splitting process, where the
 particles are ordered as (hadron, remnant, parton).
 
 Polarization is ignored completely.  The beam particle is colorless,
 while partons and beam remnant carry color.  The remnant gets a
 special flavor code.
 <<SF lhapdf: public>>=
   public :: lhapdf_t
 <<SF lhapdf: types>>=
   type, extends (sf_int_t) :: lhapdf_t
      type(lhapdf_data_t), pointer :: data => null ()
      real(default) :: x = 0
      real(default) :: q = 0
      real(default) :: s = 0
    contains
    <<SF lhapdf: lhapdf: TBP>>
   end type lhapdf_t
 
 @ %def lhapdf_t
 @ Type string: display the chosen PDF set.
 <<SF lhapdf: lhapdf: TBP>>=
   procedure :: type_string => lhapdf_type_string
 <<SF lhapdf: procedures>>=
   function lhapdf_type_string (object) result (string)
     class(lhapdf_t), intent(in) :: object
     type(string_t) :: string
     if (associated (object%data)) then
        string = "LHAPDF: " // object%data%file
     else
        string = "LHAPDF: [undefined]"
     end if
   end function lhapdf_type_string
 
 @ %def lhapdf_type_string
 @ Output.  Call the interaction routine after displaying the configuration.
 <<SF lhapdf: lhapdf: TBP>>=
   procedure :: write => lhapdf_write
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_write (object, unit, testflag)
     class(lhapdf_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%data)) then
        call object%data%write (u)
        if (object%status >= SF_DONE_KINEMATICS) then
           write (u, "(1x,A)")  "SF parameters:"
           write (u, "(3x,A," // FMT_17 // ")")  "x =", object%x
           if (object%status >= SF_FAILED_EVALUATION) then
              write (u, "(3x,A," // FMT_17 // ")")  "Q =", object%q
           end if
        end if
        call object%base_write (u, testflag)
     else
        write (u, "(1x,A)")  "LHAPDF data: [undefined]"
     end if
   end subroutine lhapdf_write
 
 @ %def lhapdf_write
 @ Initialize.  We know that [[data]] will be of concrete type
 [[sf_lhapdf_data_t]], but we have to cast this explicitly.
 
 For this implementation, we set the incoming and outgoing masses equal
 to the physical particle mass, but keep the radiated mass zero.
 <<SF lhapdf: lhapdf: TBP>>=
   procedure :: init => lhapdf_init
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_init (sf_int, data)
     class(lhapdf_t), intent(out) :: sf_int
     class(sf_data_t), intent(in), target :: data
     type(quantum_numbers_mask_t), dimension(3) :: mask
     type(flavor_t) :: flv, flv_remnant
     type(color_t) :: col0
     type(quantum_numbers_t), dimension(3) :: qn
     integer :: i
     select type (data)
     type is (lhapdf_data_t)
        mask = quantum_numbers_mask (.false., .false., .true.)
        call col0%init ()
        call sf_int%base_init (mask, [0._default], [0._default], [0._default])
        sf_int%data => data
        do i = -6, 6
           if (data%mask(i)) then
              call qn(1)%init (data%flv_in, col = col0)
              if (i == 0) then
                 call flv%init (GLUON, data%model)
                 call flv_remnant%init (HADRON_REMNANT_OCTET, data%model)
              else
                 call flv%init (i, data%model)
                 call flv_remnant%init &
                      (sign (HADRON_REMNANT_TRIPLET, -i), data%model)
              end if
              call qn(2)%init ( &
                   flv = flv_remnant, col = color_from_flavor (flv_remnant, 1))
              call qn(2)%tag_radiated ()
              call qn(3)%init ( &
                   flv = flv, col = color_from_flavor (flv, 1, reverse=.true.))
              call sf_int%add_state (qn)
           end if
        end do
        if (data%has_photon .and. data%mask_photon) then
           call flv%init (PHOTON, data%model)
           call flv_remnant%init (HADRON_REMNANT_SINGLET, data%model)
           call qn(2)%init (flv = flv_remnant, &
                col = color_from_flavor (flv_remnant, 1))
           call qn(2)%tag_radiated ()
           call qn(3)%init (flv = flv, &
                col = color_from_flavor (flv, 1, reverse=.true.))
           call sf_int%add_state (qn)
        end if
        call sf_int%freeze ()
        call sf_int%set_incoming ([1])
        call sf_int%set_radiated ([2])
        call sf_int%set_outgoing ([3])
        sf_int%status = SF_INITIAL
     end select
   end subroutine lhapdf_init
 
 @ %def lhapdf_init
 @
 \subsection{Structure function}
 We have to cast the LHAPDF arguments to/from double precision (possibly
 from/to extended/quadruple precision), if necessary.  Furthermore,
 some structure functions can yield negative results (sea quarks close
 to $x=1$).  We set these unphysical values to zero.
 <<SF lhapdf: lhapdf: TBP>>=
   procedure :: apply => lhapdf_apply
 <<SF lhapdf: procedures>>=
   subroutine lhapdf_apply (sf_int, scale, rescale, i_sub)
     class(lhapdf_t), intent(inout) :: sf_int
     real(default), intent(in) :: scale
     class(sf_rescale_t), intent(in), optional :: rescale
     integer, intent(in), optional :: i_sub
     real(default) :: x, s
     double precision :: xx, qq, ss
     double precision, dimension(-6:6) :: ff
     double precision :: fphot
     complex(default), dimension(:), allocatable :: fc
     integer :: i, i_sub_opt, j_sub
     external :: evolvePDFM, evolvePDFpM
     i_sub_opt = 0; if (present (i_sub)) i_sub_opt = i_sub
     associate (data => sf_int%data)
       sf_int%q = scale
       x = sf_int%x
       if (present (rescale))  call rescale%apply (x)
       s = sf_int%s
       xx = x
       if (debug2_active (D_BEAMS)) then
          call msg_debug2 (D_BEAMS, "lhapdf_apply")
          call msg_debug2 (D_BEAMS, "rescale: ", present(rescale))
          call msg_debug2 (D_BEAMS, "i_sub: ", i_sub_opt)
          call msg_debug2 (D_BEAMS, "x: ", x)
       end if
       qq = min (data%qmax, scale)
       qq = max (data%qmin, qq)
       if (.not. data%photon) then
          if (data%invert) then
             if (data%has_photon) then
                if (LHAPDF5_AVAILABLE) then
                   call evolvePDFphotonM &
                        (data%set, xx, qq, ff(6:-6:-1), fphot)
                else if (LHAPDF6_AVAILABLE) then
                   call data%pdf%evolve_pdfphotonm &
                        (xx, qq, ff(6:-6:-1), fphot)
                end if
             else
                if (data%hoppet_b_matching) then
                   call hoppet_eval (xx, qq, ff(6:-6:-1))
                else
                   if (LHAPDF5_AVAILABLE) then
                      call evolvePDFM (data%set, xx, qq, ff(6:-6:-1))
                   else if (LHAPDF6_AVAILABLE) then
                      call data%pdf%evolve_pdfm (xx, qq, ff(6:-6:-1))
                   end if
                end if
             end if
          else
             if (data%has_photon) then
                if (LHAPDF5_AVAILABLE) then
                   call evolvePDFphotonM (data%set, xx, qq, ff, fphot)
                else if (LHAPDF6_AVAILABLE) then
                   call data%pdf%evolve_pdfphotonm (xx, qq, ff, fphot)
                end if
             else
                if (data%hoppet_b_matching) then
                   call hoppet_eval (xx, qq, ff)
                else
                   if (LHAPDF5_AVAILABLE) then
                      call evolvePDFM (data%set, xx, qq, ff)
                   else if (LHAPDF6_AVAILABLE) then
                      call data%pdf%evolve_pdfm (xx, qq, ff)
                   end if
                end if
             end if
          end if
       else
          ss = s
          if (LHAPDF5_AVAILABLE) then
             call evolvePDFpM (data%set, xx, qq, &
                  ss, data%photon_scheme, ff)
          else if (LHAPDF6_AVAILABLE) then
             call data%pdf%evolve_pdfpm (xx, qq, ss, &
                  data%photon_scheme, ff)
          end if
       end if
       if (data%has_photon) then
          allocate (fc (count ([data%mask, data%mask_photon])))
          fc = max (pack ([ff, fphot] / x, &
               [data%mask, data%mask_photon]), 0._default)
       else
          allocate (fc (count (data%mask)))
          fc = max (pack (ff / x, data%mask), 0._default)
       end if
     end associate
     if (debug_active (D_BEAMS)) print *, 'Set pdfs: ', real (fc)
     call sf_int%set_matrix_element (fc, [(i_sub_opt * size(fc) + i, i = 1, size(fc))])
     sf_int%status = SF_EVALUATED
   end subroutine lhapdf_apply
 
 @ %def apply_lhapdf
 @
 \subsection{Strong Coupling}
 Since the PDF codes provide a function for computing the running
 $\alpha_s$ value, we make this available as an implementation of the
 abstract [[alpha_qcd_t]] type, which is used for matrix element evaluation.
 <<SF lhapdf: public>>=
   public :: alpha_qcd_lhapdf_t
 <<SF lhapdf: types>>=
   type, extends (alpha_qcd_t) :: alpha_qcd_lhapdf_t
      type(string_t) :: pdfset_dir
      type(string_t) :: pdfset_file
      integer :: pdfset_member = -1
      type(lhapdf_pdf_t) :: pdf
    contains
    <<SF lhapdf: alpha qcd: TBP>>
   end type alpha_qcd_lhapdf_t
 
 @ %def alpha_qcd_lhapdf_t
 @ Output. As in earlier versions we leave the LHAPDF path out.
 <<SF lhapdf: alpha qcd: TBP>>=
   procedure :: write => alpha_qcd_lhapdf_write
 <<SF lhapdf: procedures>>=
   subroutine alpha_qcd_lhapdf_write (object, unit)
     class(alpha_qcd_lhapdf_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(3x,A)")  "QCD parameters (lhapdf):"
     write (u, "(5x,A,A)")  "PDF set    = ", char (object%pdfset_file)
     write (u, "(5x,A,I0)") "PDF member = ", object%pdfset_member
   end subroutine alpha_qcd_lhapdf_write
 
 @ %def alpha_qcd_lhapdf_write
 @ Calculation: the numeric member ID selects the correct PDF set, which must
 be properly initialized.
 <<SF lhapdf: interfaces>>=
   interface
      double precision function alphasPDF (Q)
        double precision, intent(in) :: Q
      end function alphasPDF
   end interface
 
 @ %def alphasPDF
 @
 <<SF lhapdf: alpha qcd: TBP>>=
   procedure :: get => alpha_qcd_lhapdf_get
 <<SF lhapdf: procedures>>=
   function alpha_qcd_lhapdf_get (alpha_qcd, scale) result (alpha)
     class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
     real(default), intent(in) :: scale
     real(default) :: alpha
     if (LHAPDF5_AVAILABLE) then
        alpha = alphasPDF (dble (scale))
     else if (LHAPDF6_AVAILABLE) then
        alpha = alpha_qcd%pdf%alphas_pdf (dble (scale))
     end if
   end function alpha_qcd_lhapdf_get
 
 @ %def alpha_qcd_lhapdf_get
 @
 Initialization.  We need to access the (quasi-global) initialization status.
 <<SF lhapdf: alpha qcd: TBP>>=
   procedure :: init => alpha_qcd_lhapdf_init
 <<SF lhapdf: procedures>>=
   subroutine alpha_qcd_lhapdf_init (alpha_qcd, file, member, path)
     class(alpha_qcd_lhapdf_t), intent(out) :: alpha_qcd
     type(string_t), intent(inout) :: file
     integer, intent(inout) :: member
     type(string_t), intent(inout) :: path
     alpha_qcd%pdfset_file = file
     alpha_qcd%pdfset_member = member
     if (alpha_qcd%pdfset_member < 0) &
          call msg_fatal ("QCD parameter initialization: PDF set " &
          // char (file) // " is unknown")
     if (LHAPDF5_AVAILABLE) then
        call lhapdf_initialize (1, path, file, member)
     else if (LHAPDF6_AVAILABLE) then
        call lhapdf_initialize &
             (1, path, file, member, alpha_qcd%pdf)
     end if
   end subroutine alpha_qcd_lhapdf_init
 
 @ %def alpha_qcd_lhapdf_init
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[sf_lhapdf_ut.f90]]>>=
 <<File header>>
 
 module sf_lhapdf_ut
   use unit_tests
   use system_dependencies, only: LHAPDF5_AVAILABLE
   use system_dependencies, only: LHAPDF6_AVAILABLE
   use sf_lhapdf_uti
 
 <<Standard module head>>
 
 <<SF lhapdf: public test>>
 
 contains
 
 <<SF lhapdf: test driver>>
 
 end module sf_lhapdf_ut
 @ %def sf_lhapdf_ut
 @
 <<[[sf_lhapdf_uti.f90]]>>=
 <<File header>>
 
 module sf_lhapdf_uti
 
 <<Use kinds>>
 <<Use strings>>
   use system_dependencies, only: LHAPDF5_AVAILABLE
   use system_dependencies, only: LHAPDF6_AVAILABLE
   use os_interface
   use physics_defs, only: PROTON
   use sm_qcd
   use lorentz
   use pdg_arrays
   use flavors
   use interactions, only: reset_interaction_counter
   use model_data
   use sf_base
 
   use sf_lhapdf
 
 <<Standard module head>>
 
 <<SF lhapdf: test declarations>>
 
 contains
 
 <<SF lhapdf: tests>>
 
 end module sf_lhapdf_uti
 @ %def sf_lhapdf_ut
 @ API: driver for the unit tests below.
 <<SF lhapdf: public test>>=
   public :: sf_lhapdf_test
 <<SF lhapdf: test driver>>=
   subroutine sf_lhapdf_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<SF lhapdf: execute tests>>
   end subroutine sf_lhapdf_test
 
 @ %def sf_lhapdf_test
 @
 \subsubsection{Test structure function data}
 Construct and display a test structure function data object.
 <<SF lhapdf: execute tests>>=
   if (LHAPDF5_AVAILABLE) then
      call test (sf_lhapdf_1, "sf_lhapdf5_1", &
           "structure function configuration", &
           u, results)
   else if (LHAPDF6_AVAILABLE) then
      call test (sf_lhapdf_1, "sf_lhapdf6_1", &
           "structure function configuration", &
           u, results)
   end if
 <<SF lhapdf: test declarations>>=
   public :: sf_lhapdf_1
 <<SF lhapdf: tests>>=
   subroutine sf_lhapdf_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(pdg_array_t) :: pdg_in
     type(pdg_array_t), dimension(1) :: pdg_out
     integer, dimension(:), allocatable :: pdg1
     class(sf_data_t), allocatable :: data
 
     write (u, "(A)")  "* Test output: sf_lhapdf_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &test structure function data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Create empty data object"
     write (u, "(A)")
 
     call model%init_sm_test ()
     pdg_in = PROTON
 
     allocate (lhapdf_data_t :: data)
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     select type (data)
     type is (lhapdf_data_t)
        call data%init (model, pdg_in)
     end select
 
     call data%write (u)
 
     write (u, "(A)")
 
     write (u, "(1x,A)")  "Outgoing particle codes:"
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     write (u, "(2x,99(1x,I0))")  pdg1
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_lhapdf_1"
 
   end subroutine sf_lhapdf_1
 
 @ %def sf_lhapdf_1
 @
 \subsubsection{Test and probe structure function}
 Construct and display a structure function object based on the PDF builtin
 structure function.
 <<SF lhapdf: execute tests>>=
   if (LHAPDF5_AVAILABLE) then
      call test (sf_lhapdf_2, "sf_lhapdf5_2", &
           "structure function instance", &
           u, results)
   else if (LHAPDF6_AVAILABLE) then
      call test (sf_lhapdf_2, "sf_lhapdf6_2", &
           "structure function instance", &
           u, results)
   end if
 <<SF lhapdf: test declarations>>=
   public :: sf_lhapdf_2
 <<SF lhapdf: tests>>=
   subroutine sf_lhapdf_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(pdg_array_t) :: pdg_in
     class(sf_data_t), allocatable, target :: data
     class(sf_int_t), allocatable :: sf_int
     type(vector4_t) :: k
     type(vector4_t), dimension(2) :: q
     real(default) :: E
     real(default), dimension(:), allocatable :: r, rb, x, xb
     real(default) :: f
 
     write (u, "(A)")  "* Test output: sf_lhapdf_2"
     write (u, "(A)")  "*   Purpose: initialize and fill &
          &test structure function object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call model%init_sm_test ()
     call flv%init (PROTON, model)
     pdg_in = PROTON
     call lhapdf_global_reset ()
 
     call reset_interaction_counter ()
 
     allocate (lhapdf_data_t :: data)
     select type (data)
     type is (lhapdf_data_t)
        call data%init (model, pdg_in)
     end select
 
     write (u, "(A)")  "* Initialize structure-function object"
     write (u, "(A)")
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
 
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize incoming momentum with E=500"
     write (u, "(A)")
     E = 500
     k = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     call vector4_write (k, u)
     call sf_int%seed_kinematics ([k])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set kinematics for x=0.5"
     write (u, "(A)")
 
     allocate (r (data%get_n_par ()))
     allocate (rb(size (r)))
     allocate (x (size (r)))
     allocate (xb(size (r)))
 
     r = 0.5_default
     rb = 1 - r
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%write (u)
 
     write (u, "(A)")
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
     write (u, "(A,9(1x,F10.7))")  "f =", f
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover x from momenta"
     write (u, "(A)")
 
     q = sf_int%get_momenta (outgoing=.true.)
     call sf_int%final ()
     deallocate (sf_int)
 
     call data%allocate_sf_int (sf_int)
     call sf_int%init (data)
     call sf_int%set_beam_index ([1])
 
     call sf_int%seed_kinematics ([k])
     call sf_int%set_momenta (q, outgoing=.true.)
     call sf_int%recover_x (x, xb)
 
     write (u, "(A,9(1x,F10.7))")  "x =", x
     write (u, "(A,9(1x,F10.7))")  "xb=", xb
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for Q = 100 GeV"
     write (u, "(A)")
 
     call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
     call sf_int%apply (scale = 100._default)
     call sf_int%write (u, testflag = .true.)
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call sf_int%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_lhapdf_2"
 
   end subroutine sf_lhapdf_2
 
 @ %def sf_lhapdf_2
 @
 \subsubsection{Strong Coupling}
 Test $\alpha_s$ as an implementation of the [[alpha_qcd_t]] abstract
 type.
 <<SF lhapdf: execute tests>>=
   if (LHAPDF5_AVAILABLE) then
      call test (sf_lhapdf_3, "sf_lhapdf5_3", &
           "running alpha_s", &
           u, results)
   else if (LHAPDF6_AVAILABLE) then
      call test (sf_lhapdf_3, "sf_lhapdf6_3", &
           "running alpha_s", &
           u, results)
   end if
 <<SF lhapdf: test declarations>>=
   public :: sf_lhapdf_3
 <<SF lhapdf: tests>>=
   subroutine sf_lhapdf_3 (u)
     integer, intent(in) :: u
     type(qcd_t) :: qcd
     type(string_t) :: name, path
     integer :: member
 
     write (u, "(A)")  "* Test output: sf_lhapdf_3"
     write (u, "(A)")  "*   Purpose: initialize and evaluate alpha_s"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize configuration data"
     write (u, "(A)")
 
     call lhapdf_global_reset ()
 
     if (LHAPDF5_AVAILABLE) then
        name = "cteq6ll.LHpdf"
        member = 1
        path = ""
     else if (LHAPDF6_AVAILABLE) then
        name = "CT10"
        member = 1
        path = ""
     end if
 
     write (u, "(A)")  "* Initialize qcd object"
     write (u, "(A)")
 
     allocate (alpha_qcd_lhapdf_t :: qcd%alpha)
     select type (alpha => qcd%alpha)
     type is (alpha_qcd_lhapdf_t)
        call alpha%init (name, member, path)
     end select
     call qcd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for Q = 100"
     write (u, "(A)")
 
     write (u, "(1x,A,F8.5)")  "alpha = ", qcd%alpha%get (100._default)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: sf_lhapdf_3"
 
   end subroutine sf_lhapdf_3
 
 @ %def sf_lhapdf_3
 @
 \section{Easy PDF Access}
 For the shower, subtraction and matching, it is very useful to have
 direct access to $f(x,Q)$ independently of the used library.
 <<[[pdf.f90]]>>=
 <<File header>>
 
 module pdf
 
 <<Use kinds with double>>
   use io_units
   use system_dependencies, only: LHAPDF5_AVAILABLE, LHAPDF6_AVAILABLE
   use diagnostics
   use beam_structures
   use lhapdf !NODEP!
   use pdf_builtin !NODEP!
 
 <<Standard module head>>
 
 <<PDF: public>>
 
 <<PDF: parameters>>
 
 <<PDF: types>>
 
 contains
 
 <<PDF: procedures>>
 
 end module pdf
 @ %def pdf
 We support the following implementations:
 <<PDF: parameters>>=
   integer, parameter, public :: STRF_NONE = 0
   integer, parameter, public :: STRF_LHAPDF6 = 1
   integer, parameter, public :: STRF_LHAPDF5 = 2
   integer, parameter, public :: STRF_PDF_BUILTIN = 3
 
 @ %def STRF_NONE STRF_LHAPDF6 STRF_LHAPDF5 STRF_PDF_BUILTIN
 @ A container to bundle all necessary PDF data. Could be moved to a more
 central location.
 <<PDF: public>>=
   public :: pdf_data_t
 <<PDF: types>>=
   type :: pdf_data_t
     type(lhapdf_pdf_t) :: pdf
     real(default) :: xmin, xmax, qmin, qmax
     integer :: type = STRF_NONE
     integer :: set = 0
    contains
    <<PDF: pdf data: TBP>>
   end type pdf_data_t
 
 @ %def pdf_data
 @
 <<PDF: pdf data: TBP>>=
   procedure :: init => pdf_data_init
 <<PDF: procedures>>=
   subroutine pdf_data_init (pdf_data, pdf_data_in)
     class(pdf_data_t), intent(out) :: pdf_data
     type(pdf_data_t), target, intent(in) :: pdf_data_in
     pdf_data%xmin = pdf_data_in%xmin
     pdf_data%xmax = pdf_data_in%xmax
     pdf_data%qmin = pdf_data_in%qmin
     pdf_data%qmax = pdf_data_in%qmax
     pdf_data%set = pdf_data_in%set
     pdf_data%type = pdf_data_in%type
     if (pdf_data%type == STRF_LHAPDF6) then
        if (pdf_data_in%pdf%is_associated ()) then
           call lhapdf_copy_pointer (pdf_data_in%pdf, pdf_data%pdf)
        else
           call msg_bug ('pdf_data_init: pdf_data%pdf was not associated!')
        end if
     end if
   end subroutine pdf_data_init
 
 @ %def pdf_data_init
 @
 <<PDF: pdf data: TBP>>=
   procedure :: write => pdf_data_write
 <<PDF: procedures>>=
   subroutine pdf_data_write (pdf_data, unit)
     class(pdf_data_t), intent(in) :: pdf_data
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit); if (u < 0) return
     write (u, "(3x,A,I0)") "PDF set  = ", pdf_data%set
     write (u, "(3x,A,I0)") "PDF type = ", pdf_data%type
   end subroutine pdf_data_write
 
 @ %def pdf_data_write
 @
 <<PDF: pdf data: TBP>>=
   procedure :: setup => pdf_data_setup
 <<PDF: procedures>>=
   subroutine pdf_data_setup (pdf_data, caller, beam_structure, lhapdf_member, set)
     class(pdf_data_t), intent(inout) :: pdf_data
     character(len=*), intent(in) :: caller
     type(beam_structure_t), intent(in) :: beam_structure
     integer, intent(in) :: lhapdf_member, set
     real(default) :: xmin, xmax, q2min, q2max
     pdf_data%set = set
     if (beam_structure%contains ("lhapdf")) then
        if (LHAPDF6_AVAILABLE) then
           pdf_data%type = STRF_LHAPDF6
        else if (LHAPDF5_AVAILABLE) then
           pdf_data%type = STRF_LHAPDF5
        end if
        write (msg_buffer, "(A,I0)")  caller &
             // ": interfacing LHAPDF set #", pdf_data%set
        call msg_message ()
     else if (beam_structure%contains ("pdf_builtin")) then
        pdf_data%type = STRF_PDF_BUILTIN
        write (msg_buffer, "(A,I0)")  caller &
             // ": interfacing PDF builtin set #", pdf_data%set
        call msg_message ()
     end if
     select case (pdf_data%type)
     case (STRF_LHAPDF6)
        pdf_data%xmin = pdf_data%pdf%getxmin ()
        pdf_data%xmax = pdf_data%pdf%getxmax ()
        pdf_data%qmin = sqrt(pdf_data%pdf%getq2min ())
        pdf_data%qmax = sqrt(pdf_data%pdf%getq2max ())
     case (STRF_LHAPDF5)
        call GetXminM (1, lhapdf_member, xmin)
        call GetXmaxM (1, lhapdf_member, xmax)
        call GetQ2minM (1, lhapdf_member, q2min)
        call GetQ2maxM (1, lhapdf_member, q2max)
        pdf_data%xmin = xmin
        pdf_data%xmax = xmax
        pdf_data%qmin = sqrt(q2min)
        pdf_data%qmax = sqrt(q2max)
     end select
   end subroutine pdf_data_setup
 
 @ %def pdf_data_setup
 @ This could be overloaded with a version that only asks for a specific
 flavor as it is supported by LHAPDF6.
 <<PDF: pdf data: TBP>>=
   procedure :: evolve => pdf_data_evolve
 <<PDF: procedures>>=
   subroutine pdf_data_evolve (pdf_data, x, q_in, f)
     class(pdf_data_t), intent(inout) :: pdf_data
     real(double), intent(in) :: x, q_in
     real(double), dimension(-6:6), intent(out) :: f
     real(double) :: q
     select case (pdf_data%type)
     case (STRF_PDF_BUILTIN)
        call pdf_evolve_LHAPDF (pdf_data%set, x, q_in, f)
     case (STRF_LHAPDF6)
        q = min (pdf_data%qmax, q_in)
        q = max (pdf_data%qmin, q)
        call pdf_data%pdf%evolve_pdfm (x, q, f)
     case (STRF_LHAPDF5)
        q = min (pdf_data%qmax, q_in)
        q = max (pdf_data%qmin, q)
        call evolvePDFM (pdf_data%set, x, q, f)
     case default
        call msg_fatal ("PDF function: unknown PDF method.")
     end select
   end subroutine pdf_data_evolve
 @ %def pdf_data_evolve
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Dispatch}
 @
 <<[[dispatch_beams.f90]]>>=
 <<File header>>
 
 module dispatch_beams
 
 <<Use kinds>>
 <<Use strings>>
   use diagnostics
   use os_interface, only: os_data_t
   use variables, only: var_list_t
   use constants, only: PI
   use numeric_utils, only: vanishes
   use physics_defs, only: PHOTON
   use rng_base, only: rng_factory_t
   use pdg_arrays
   use model_data, only: model_data_t
   use dispatch_rng, only: dispatch_rng_factory
   use dispatch_rng, only: update_rng_seed_in_var_list
   use flavors, only: flavor_t
   use sm_qcd, only: qcd_t, alpha_qcd_fixed_t, alpha_qcd_from_scale_t
   use sm_qcd, only: alpha_qcd_from_lambda_t
   use physics_defs, only: MZ_REF, ALPHA_QCD_MZ_REF
 
   use beam_structures
   use sf_base
   use sf_mappings
   use sf_isr
   use sf_epa
   use sf_ewa
   use sf_escan
   use sf_gaussian
   use sf_beam_events
   use sf_circe1
   use sf_circe2
   use sf_pdf_builtin
   use sf_lhapdf
 
 <<Standard module head>>
 
 <<Dispatch beams: public>>
 
 <<Dispatch beams: types>>
 
 <<Dispatch beams: variables>>
 
 contains
 
 <<Dispatch beams: procedures>>
 
 end module dispatch_beams
 @ %def dispatch_beams
 @ This data type is a container for transferring structure-function
 specific data from the [[dispatch_sf_data]] to the
 [[dispatch_sf_channels]] subroutine.
 <<Dispatch beams: public>>=
   public :: sf_prop_t
 <<Dispatch beams: types>>=
   type :: sf_prop_t
      real(default), dimension(2) :: isr_eps = 1
   end type sf_prop_t
 
 @ %def sf_prop_t
 @
 Allocate a structure-function configuration object according to the
 [[sf_method]] string.
 
 The [[sf_prop]] object can be used to transfer structure-function
 specific data up and to the [[dispatch_sf_channels]] subroutine below,
 so they can be used for particular mappings.
 
 The [[var_list_global]] object is used for the RNG generator seed.
 It is intent(inout) because the RNG generator seed
 may change during initialization.
 
 The [[pdg_in]] array is the array of incoming flavors, corresponding
 to the upstream structure function or the beam array.  This will be
 checked for the structure function in question and replaced by the
 outgoing flavors.  The [[pdg_prc]] array is the array of incoming
 flavors (beam index, component index) for the hard process.
 <<Dispatch beams: public>>=
   public :: dispatch_sf_data
 <<Dispatch beams: procedures>>=
   subroutine dispatch_sf_data (data, sf_method, i_beam, sf_prop, &
          var_list, var_list_global, model, &
          os_data, sqrts, pdg_in, pdg_prc, polarized)
     class(sf_data_t), allocatable, intent(inout) :: data
     type(string_t), intent(in) :: sf_method
     integer, dimension(:), intent(in) :: i_beam
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_in
     type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
     type(sf_prop_t), intent(inout) :: sf_prop
     type(var_list_t), intent(in) :: var_list
     type(var_list_t), intent(inout) :: var_list_global
     integer :: next_rng_seed
     class(model_data_t), target, intent(in) :: model
     type(os_data_t), intent(in) :: os_data
     real(default), intent(in) :: sqrts
     logical, intent(in) :: polarized
     type(pdg_array_t), dimension(:), allocatable :: pdg_out
     real(default) :: isr_alpha, isr_q_max, isr_mass
     integer :: isr_order
     logical :: isr_recoil, isr_keep_energy
-    real(default) :: epa_alpha, epa_x_min, epa_q_min, epa_e_max, epa_mass
+    real(default) :: epa_alpha, epa_x_min, epa_q_min, epa_q_max, epa_mass
     logical :: epa_recoil, epa_keep_energy
     real(default) :: ewa_x_min, ewa_pt_max, ewa_mass
     logical :: ewa_recoil, ewa_keep_energy
     type(pdg_array_t), dimension(:), allocatable :: pdg_prc1
     integer :: ewa_id
     type(string_t) :: pdf_name
     type(string_t) :: lhapdf_dir, lhapdf_file
     type(string_t), dimension(13) :: lhapdf_photon_sets
     integer :: lhapdf_member, lhapdf_photon_scheme
     logical :: hoppet_b_matching
     class(rng_factory_t), allocatable :: rng_factory
     logical :: circe1_photon1, circe1_photon2, circe1_generate, &
          circe1_with_radiation
     real(default) :: circe1_sqrts, circe1_eps
     integer :: circe1_version, circe1_chattiness, &
          circe1_revision
     character(6) :: circe1_accelerator
     logical :: circe2_polarized
     type(string_t) :: circe2_design, circe2_file
     real(default), dimension(2) :: gaussian_spread
     logical :: beam_events_warn_eof
     type(string_t) :: beam_events_dir, beam_events_file
     logical :: escan_normalize
     integer :: i
     lhapdf_photon_sets = [var_str ("DOG0.LHgrid"), var_str ("DOG1.LHgrid"), &
          var_str ("DGG.LHgrid"), var_str ("LACG.LHgrid"), &
          var_str ("GSG0.LHgrid"), var_str ("GSG1.LHgrid"), &
          var_str ("GSG960.LHgrid"), var_str ("GSG961.LHgrid"), &
          var_str ("GRVG0.LHgrid"), var_str ("GRVG1.LHgrid"), &
          var_str ("ACFGPG.LHgrid"), var_str ("WHITG.LHgrid"), &
          var_str ("SASG.LHgrid")]
     select case (char (sf_method))
     case ("pdf_builtin")
        allocate (pdf_builtin_data_t :: data)
        select type (data)
        type is (pdf_builtin_data_t)
           pdf_name = &
                var_list%get_sval (var_str ("$pdf_builtin_set"))
           hoppet_b_matching = &
                var_list%get_lval (var_str ("?hoppet_b_matching"))
           call data%init ( &
                model, pdg_in(i_beam(1)), &
                name = pdf_name, &
                path = os_data%pdf_builtin_datapath, &
                hoppet_b_matching = hoppet_b_matching)
        end select
     case ("pdf_builtin_photon")
        call msg_fatal ("Currently, there are no photon PDFs built into WHIZARD,", &
             [var_str ("for the photon content inside a proton or neutron use"), &
              var_str ("the 'lhapdf_photon' structure function.")])
     case ("lhapdf")
        allocate (lhapdf_data_t :: data)
        if (pdg_array_get (pdg_in(i_beam(1)), 1) == PHOTON) then
           call msg_fatal ("The 'lhapdf' structure is intended only for protons and", &
                [var_str ("pions, please use 'lhapdf_photon' for photon beams.")])
        end if
        lhapdf_dir = &
             var_list%get_sval (var_str ("$lhapdf_dir"))
        lhapdf_file = &
             var_list%get_sval (var_str ("$lhapdf_file"))
        lhapdf_member = &
             var_list%get_ival (var_str ("lhapdf_member"))
        lhapdf_photon_scheme = &
             var_list%get_ival (var_str ("lhapdf_photon_scheme"))
        hoppet_b_matching = &
             var_list%get_lval (var_str ("?hoppet_b_matching"))
        select type (data)
        type is (lhapdf_data_t)
           call data%init &
                (model, pdg_in(i_beam(1)), &
                 lhapdf_dir, lhapdf_file, lhapdf_member, &
                 lhapdf_photon_scheme, hoppet_b_matching)
        end select
     case ("lhapdf_photon")
        allocate (lhapdf_data_t :: data)
        if (pdg_array_get_length (pdg_in(i_beam(1))) /= 1 .or. &
             pdg_array_get (pdg_in(i_beam(1)), 1) /= PHOTON) then
           call msg_fatal ("The 'lhapdf_photon' structure function is exclusively for", &
                [var_str ("photon PDFs, i.e. for photons as beam particles")])
        end if
        lhapdf_dir = &
             var_list%get_sval (var_str ("$lhapdf_dir"))
        lhapdf_file = &
             var_list%get_sval (var_str ("$lhapdf_photon_file"))
        lhapdf_member = &
             var_list%get_ival (var_str ("lhapdf_member"))
        lhapdf_photon_scheme = &
             var_list%get_ival (var_str ("lhapdf_photon_scheme"))
        if (.not. any (lhapdf_photon_sets == lhapdf_file)) then
           call msg_fatal ("This PDF set is not supported or not " // &
                "intended for photon beams.")
        end if
        select type (data)
        type is (lhapdf_data_t)
           call data%init &
                (model, pdg_in(i_beam(1)), &
                 lhapdf_dir, lhapdf_file, lhapdf_member, &
                 lhapdf_photon_scheme)
        end select
     case ("isr")
        allocate (isr_data_t :: data)
        isr_alpha = &
             var_list%get_rval (var_str ("isr_alpha"))
        if (vanishes (isr_alpha)) then
           isr_alpha = (var_list%get_rval (var_str ("ee"))) &
                ** 2 / (4 * PI)
        end if
        isr_q_max = &
             var_list%get_rval (var_str ("isr_q_max"))
        if (vanishes (isr_q_max)) then
           isr_q_max = sqrts
        end if
        isr_mass   = var_list%get_rval (var_str ("isr_mass"))
        isr_order  = var_list%get_ival (var_str ("isr_order"))
        isr_recoil = var_list%get_lval (var_str ("?isr_recoil"))
        isr_keep_energy = var_list%get_lval (var_str ("?isr_keep_energy"))
        select type (data)
        type is (isr_data_t)
           call data%init &
                (model, pdg_in (i_beam(1)), isr_alpha, isr_q_max, &
                isr_mass, isr_order, recoil = isr_recoil, keep_energy = &
                isr_keep_energy)
           call data%check ()
           sf_prop%isr_eps(i_beam(1)) = data%get_eps ()
        end select
     case ("epa")
        allocate (epa_data_t :: data)
        epa_alpha = var_list%get_rval (var_str ("epa_alpha"))
        if (vanishes (epa_alpha)) then
           epa_alpha = (var_list%get_rval (var_str ("ee"))) &
                ** 2 / (4 * PI)
        end if
        epa_x_min = var_list%get_rval (var_str ("epa_x_min"))
        epa_q_min = var_list%get_rval (var_str ("epa_q_min"))
-       epa_e_max = var_list%get_rval (var_str ("epa_e_max"))
-       if (vanishes (epa_e_max)) then
-          epa_e_max = sqrts
+       epa_q_max = var_list%get_rval (var_str ("epa_q_max"))
+       if (vanishes (epa_q_max)) then
+          epa_q_max = sqrts
        end if
        epa_mass   = var_list%get_rval (var_str ("epa_mass"))
        epa_recoil = var_list%get_lval (var_str ("?epa_recoil"))
        epa_keep_energy = var_list%get_lval (var_str ("?epa_keep_energy"))
        select type (data)
        type is (epa_data_t)
           call data%init &
                (model, pdg_in (i_beam(1)), epa_alpha, epa_x_min, &
-               epa_q_min, epa_e_max, epa_mass, recoil = epa_recoil, &
+               epa_q_min, epa_q_max, epa_mass, recoil = epa_recoil, &
                keep_energy = epa_keep_energy)
           call data%check ()
        end select
     case ("ewa")
        allocate (ewa_data_t :: data)
        allocate (pdg_prc1 (size (pdg_prc, 2)))
        pdg_prc1 = pdg_prc(i_beam(1),:)
        if (any (pdg_array_get_length (pdg_prc1) /= 1) &
             .or. any (pdg_prc1 /= pdg_prc1(1))) then
           call msg_fatal &
                ("EWA: process incoming particle (W/Z) must be unique")
        end if
        ewa_id = abs (pdg_array_get (pdg_prc1(1), 1))
        ewa_x_min = var_list%get_rval (var_str ("ewa_x_min"))
        ewa_pt_max = var_list%get_rval (var_str ("ewa_pt_max"))
        if (vanishes (ewa_pt_max)) then
           ewa_pt_max = sqrts
        end if
        ewa_mass = var_list%get_rval (var_str ("ewa_mass"))
        ewa_recoil = var_list%get_lval (&
             var_str ("?ewa_recoil"))
        ewa_keep_energy = var_list%get_lval (&
             var_str ("?ewa_keep_energy"))
        select type (data)
        type is (ewa_data_t)
           call data%init &
                (model, pdg_in (i_beam(1)), ewa_x_min, &
                ewa_pt_max, sqrts, ewa_recoil, &
                ewa_keep_energy, ewa_mass)
           call data%set_id (ewa_id)
           call data%check ()
        end select
     case ("circe1")
        allocate (circe1_data_t :: data)
        select type (data)
        type is (circe1_data_t)
           circe1_photon1 = &
                var_list%get_lval (var_str ("?circe1_photon1"))
           circe1_photon2 = &
                var_list%get_lval (var_str ("?circe1_photon2"))
           circe1_sqrts = &
                var_list%get_rval (var_str ("circe1_sqrts"))
           circe1_eps = &
                var_list%get_rval (var_str ("circe1_eps"))
           if (circe1_sqrts <= 0)  circe1_sqrts = sqrts
           circe1_generate = &
                var_list%get_lval (var_str ("?circe1_generate"))
           circe1_version = &
                var_list%get_ival (var_str ("circe1_ver"))
           circe1_revision = &
                var_list%get_ival (var_str ("circe1_rev"))
           circe1_accelerator = &
                char (var_list%get_sval (var_str ("$circe1_acc")))
           circe1_chattiness = &
                var_list%get_ival (var_str ("circe1_chat"))
           circe1_with_radiation = &
                var_list%get_lval (var_str ("?circe1_with_radiation"))
           call data%init (model, pdg_in, circe1_sqrts, circe1_eps, &
                [circe1_photon1, circe1_photon2], &
                circe1_version, circe1_revision, circe1_accelerator, &
                circe1_chattiness, circe1_with_radiation)
           if (circe1_generate) then
              call msg_message ("CIRCE1: activating generator mode")
              call dispatch_rng_factory &
                   (rng_factory, var_list_global, next_rng_seed)
              call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
              call data%set_generator_mode (rng_factory)
           end if
        end select
     case ("circe2")
        allocate (circe2_data_t :: data)
        select type (data)
        type is (circe2_data_t)
           circe2_polarized = &
                var_list%get_lval (var_str ("?circe2_polarized"))
           circe2_file = &
                var_list%get_sval (var_str ("$circe2_file"))
           circe2_design = &
                var_list%get_sval (var_str ("$circe2_design"))
           call data%init (os_data, model, pdg_in, sqrts, &
                circe2_polarized, polarized, circe2_file, circe2_design)
           call msg_message ("CIRCE2: activating generator mode")
           call dispatch_rng_factory &
                (rng_factory, var_list_global, next_rng_seed)
           call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
           call data%set_generator_mode (rng_factory)
        end select
     case ("gaussian")
        allocate (gaussian_data_t :: data)
        select type (data)
        type is (gaussian_data_t)
           gaussian_spread = &
                [var_list%get_rval (var_str ("gaussian_spread1")), &
                var_list%get_rval (var_str ("gaussian_spread2"))]
           call dispatch_rng_factory &
                (rng_factory, var_list_global, next_rng_seed)
           call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
           call data%init (model, pdg_in, gaussian_spread, rng_factory)
        end select
     case ("beam_events")
        allocate (beam_events_data_t :: data)
        select type (data)
        type is (beam_events_data_t)
           beam_events_dir = os_data%whizard_beamsimpath
           beam_events_file = var_list%get_sval (&
                var_str ("$beam_events_file"))
           beam_events_warn_eof = var_list%get_lval (&
                var_str ("?beam_events_warn_eof"))
           call data%init (model, pdg_in, &
                   beam_events_dir, beam_events_file, beam_events_warn_eof)
        end select
     case ("energy_scan")
        escan_normalize = &
             var_list%get_lval (var_str ("?energy_scan_normalize"))
        allocate (escan_data_t :: data)
        select type (data)
        type is (escan_data_t)
           if (escan_normalize) then
              call data%init (model, pdg_in)
           else
              call data%init (model, pdg_in, sqrts)
           end if
        end select
     case default
        if (associated (dispatch_sf_data_extra)) then
           call dispatch_sf_data_extra (data, sf_method, i_beam, &
                sf_prop, var_list, var_list_global, model, os_data, sqrts, pdg_in, &
                pdg_prc, polarized)
        end if
        if (.not. allocated (data)) then
           call msg_fatal ("Structure function '" &
                // char (sf_method) // "' not implemented")
        end if
     end select
     if (allocated (data)) then
        allocate (pdg_out (size (pdg_prc, 1)))
        call data%get_pdg_out (pdg_out)
        do i = 1, size (i_beam)
           pdg_in(i_beam(i)) = pdg_out(i)
        end do
     end if
   end subroutine dispatch_sf_data
 
 @ %def dispatch_sf_data
 @ This is a hook that allows us to inject further handlers for
 structure-function objects, in particular a test structure function.
 <<Dispatch beams: public>>=
   public :: dispatch_sf_data_extra
 <<Dispatch beams: variables>>=
   procedure (dispatch_sf_data), pointer :: &
        dispatch_sf_data_extra => null ()
 @ %def dispatch_sf_data_extra
 @ This is an auxiliary procedure, used by the beam-structure
 expansion: tell for a given structure function name, whether it
 corresponds to a pair spectrum ($n=2$), a single-particle structure
 function ($n=1$), or nothing ($n=0$). Though [[energy_scan]] can
 in principle also be a pair spectrum, it always has only one
 parameter.
 <<Dispatch beams: public>>=
   public :: strfun_mode
 <<Dispatch beams: procedures>>=
   function strfun_mode (name) result (n)
     type(string_t), intent(in) :: name
     integer :: n
     select case (char (name))
     case ("none")
        n = 0
     case ("sf_test_0", "sf_test_1")
        n = 1
     case ("pdf_builtin","pdf_builtin_photon", &
           "lhapdf","lhapdf_photon")
        n = 1
     case ("isr","epa","ewa")
        n = 1
     case ("circe1", "circe2")
        n = 2
     case ("gaussian")
        n = 2
     case ("beam_events")
        n = 2
     case ("energy_scan")
        n = 2
     case default
        n = -1
        call msg_bug ("Structure function '" // char (name) &
             // "' not supported yet")
     end select
   end function strfun_mode
 
 @ %def strfun_mode
 @ Dispatch a whole structure-function chain, given beam data and beam
 structure data.
 
 This could be done generically, but we should look at the specific
 combination of structure functions in order to select appropriate mappings.
 
 The [[beam_structure]] argument gets copied because
 we want to expand it to canonical form (one valid structure-function
 entry per record) before proceeding further.
 
 The [[pdg_prc]] argument is the array of incoming flavors.  The first
 index is the beam index, the second one the process component index.
 Each element is itself a PDG array, notrivial if there is a flavor sum
 for the incoming state of this component.
 
 The dispatcher is divided in two parts.  The first part configures the
 structure function data themselves.  After this, we can configure the
 phase space for the elementary process.
 <<Dispatch beams: public>>=
   public :: dispatch_sf_config
 <<Dispatch beams: procedures>>=
   subroutine dispatch_sf_config (sf_config, sf_prop, beam_structure, &
          var_list, var_list_global, model, os_data, sqrts, pdg_prc)
     type(sf_config_t), dimension(:), allocatable, intent(out) :: sf_config
     type(sf_prop_t), intent(out) :: sf_prop
     type(beam_structure_t), intent(inout) :: beam_structure
     type(var_list_t), intent(in) :: var_list
     type(var_list_t), intent(inout) :: var_list_global
     class(model_data_t), target, intent(in) :: model
     type(os_data_t), intent(in) :: os_data
     real(default), intent(in) :: sqrts
     class(sf_data_t), allocatable :: sf_data
     type(beam_structure_t) :: beam_structure_tmp
     type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
     type(string_t), dimension(:), allocatable :: prt_in
     type(pdg_array_t), dimension(:), allocatable :: pdg_in
     type(flavor_t) :: flv_in
     integer :: n_beam, n_record, i
     beam_structure_tmp = beam_structure
     call beam_structure_tmp%expand (strfun_mode)
     n_record = beam_structure_tmp%get_n_record ()
     allocate (sf_config (n_record))
     n_beam = beam_structure_tmp%get_n_beam ()
     if (n_beam > 0) then
        allocate (prt_in (n_beam), pdg_in (n_beam))
        prt_in = beam_structure_tmp%get_prt ()
        do i = 1, n_beam
           call flv_in%init (prt_in(i), model)
           pdg_in(i) = flv_in%get_pdg ()
        end do
     else
        n_beam = size (pdg_prc, 1)
        allocate (pdg_in (n_beam))
        pdg_in = pdg_prc(:,1)
     end if
     do i = 1, n_record
        call dispatch_sf_data (sf_data, &
             beam_structure_tmp%get_name (i), &
             beam_structure_tmp%get_i_entry (i), &
             sf_prop, var_list, var_list_global, model, os_data, sqrts, &
             pdg_in, pdg_prc, &
             beam_structure_tmp%polarized ())
        call sf_config(i)%init (beam_structure_tmp%get_i_entry (i), sf_data)
        deallocate (sf_data)
     end do
   end subroutine dispatch_sf_config
 
 @ %def dispatch_sf_config
 @
 \subsection{QCD coupling}
 Allocate the [[alpha]] (running coupling) component of the [[qcd]] block with
 a concrete implementation, depending on the variable settings in the
 [[global]] record.
 
 If a fixed $\alpha_s$ is requested, we do not allocate the
 [[qcd%alpha]] object.  In this case, the matrix element code will just take
 the model parameter as-is, which implies fixed $\alpha_s$.  If the
 object is allocated, the $\alpha_s$ value is computed and updated for
 each matrix-element call.
 
 Also fetch the [[alphas_nf]] variable from the list and store it in
 the QCD record.  This is not used in the $\alpha_s$ calculation, but
 the QCD record thus becomes a messenger for this user parameter.
 <<Dispatch beams: public>>=
   public :: dispatch_qcd
 <<Dispatch beams: procedures>>=
   subroutine dispatch_qcd (qcd, var_list, os_data)
     type(qcd_t), intent(inout) :: qcd
     type(var_list_t), intent(in) :: var_list
     type(os_data_t), intent(in) :: os_data
     logical :: fixed, from_mz, from_pdf_builtin, from_lhapdf, from_lambda_qcd
     real(default) :: mz, alpha_val, lambda
     integer :: nf, order, lhapdf_member
     type(string_t) :: pdfset, lhapdf_dir, lhapdf_file
     call unpack_variables ()
     if (allocated (qcd%alpha))  deallocate (qcd%alpha)
     if (from_lhapdf .and. from_pdf_builtin) then
         call msg_fatal (" Mixing alphas evolution",  &
              [var_str (" from LHAPDF and builtin PDF is not permitted")])
     end if
     select case (count ([from_mz, from_pdf_builtin, from_lhapdf, from_lambda_qcd]))
     case (0)
        if (fixed) then
           allocate (alpha_qcd_fixed_t :: qcd%alpha)
        else
           call msg_fatal ("QCD alpha: no calculation mode set")
        end if
     case (2:)
        call msg_fatal ("QCD alpha: calculation mode is ambiguous")
     case (1)
        if (fixed) then
           call msg_fatal ("QCD alpha: use '?alphas_is_fixed = false' for " // &
                "running alphas")
        else if (from_mz) then
           allocate (alpha_qcd_from_scale_t :: qcd%alpha)
        else if (from_pdf_builtin) then
           allocate (alpha_qcd_pdf_builtin_t :: qcd%alpha)
        else if (from_lhapdf) then
           allocate (alpha_qcd_lhapdf_t :: qcd%alpha)
        else if (from_lambda_qcd) then
           allocate (alpha_qcd_from_lambda_t :: qcd%alpha)
        end if
        call msg_message ("QCD alpha: using a running strong coupling")
     end select
     call init_alpha ()
     qcd%n_f = var_list%get_ival (var_str ("alphas_nf"))
   contains
   <<Dispatch qcd: dispatch qcd: procedures>>
   end subroutine dispatch_qcd
 
 @ %def dispatch_qcd
 @
 <<Dispatch qcd: dispatch qcd: procedures>>=
   subroutine unpack_variables ()
     fixed = var_list%get_lval (var_str ("?alphas_is_fixed"))
     from_mz = var_list%get_lval (var_str ("?alphas_from_mz"))
     from_pdf_builtin = &
          var_list%get_lval (var_str ("?alphas_from_pdf_builtin"))
     from_lhapdf = &
          var_list%get_lval (var_str ("?alphas_from_lhapdf"))
     from_lambda_qcd = &
          var_list%get_lval (var_str ("?alphas_from_lambda_qcd"))
     pdfset = var_list%get_sval (var_str ("$pdf_builtin_set"))
     lambda = var_list%get_rval (var_str ("lambda_qcd"))
     nf = var_list%get_ival (var_str ("alphas_nf"))
     order = var_list%get_ival (var_str ("alphas_order"))
     lhapdf_dir = var_list%get_sval (var_str ("$lhapdf_dir"))
     lhapdf_file = var_list%get_sval (var_str ("$lhapdf_file"))
     lhapdf_member = var_list%get_ival (var_str ("lhapdf_member"))
     if (var_list%contains (var_str ("mZ"))) then
        mz = var_list%get_rval (var_str ("mZ"))
     else
        mz = MZ_REF
     end if
     if (var_list%contains (var_str ("alphas"))) then
        alpha_val = var_list%get_rval (var_str ("alphas"))
     else
        alpha_val = ALPHA_QCD_MZ_REF
     end if
   end subroutine unpack_variables
 
 @
 <<Dispatch qcd: dispatch qcd: procedures>>=
   subroutine init_alpha ()
     select type (alpha => qcd%alpha)
     type is (alpha_qcd_fixed_t)
        alpha%val = alpha_val
     type is (alpha_qcd_from_scale_t)
        alpha%mu_ref = mz
        alpha%ref = alpha_val
        alpha%order = order
        alpha%nf = nf
     type is (alpha_qcd_from_lambda_t)
        alpha%lambda = lambda
        alpha%order = order
        alpha%nf = nf
     type is (alpha_qcd_pdf_builtin_t)
        call alpha%init (pdfset, &
             os_data%pdf_builtin_datapath)
     type is (alpha_qcd_lhapdf_t)
        call alpha%init (lhapdf_file, lhapdf_member, lhapdf_dir)
     end select
   end subroutine init_alpha
 
 @
Index: trunk/src/whizard-core/whizard.nw
===================================================================
--- trunk/src/whizard-core/whizard.nw	(revision 8370)
+++ trunk/src/whizard-core/whizard.nw	(revision 8371)
@@ -1,31458 +1,31458 @@
 % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
 % WHIZARD main code as NOWEB source
 \includemodulegraph{whizard-core}
 \chapter{Integration and Simulation}
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{User-controlled File I/O}
 
 The SINDARIN language includes commands that write output to file (input may
 be added later).  We identify files by their name, and manage the unit
 internally.  We need procedures for opening, closing, and printing files.
 
 <<[[user_files.f90]]>>=
 <<File header>>
 
 module user_files
 
 <<Use strings>>
   use io_units
   use diagnostics
   use ifiles
   use analysis
 
 <<Standard module head>>
 
 <<User files: public>>
 
 <<User files: types>>
 
 <<User files: interfaces>>
 
 contains
 
 <<User files: procedures>>
 
 end module user_files
 @ %def user_files
 @
 \subsection{The file type}
 This is a type that describes an open user file and its properties.  The entry
 is part of a doubly-linked list.
 <<User files: types>>=
   type :: file_t
      private
      type(string_t) :: name
      integer :: unit = -1
      logical :: reading = .false.
      logical :: writing = .false.
      type(file_t), pointer :: prev => null ()
      type(file_t), pointer :: next => null ()
   end type file_t
 
 @ %def file_t
 @ The initializer opens the file.
 <<User files: procedures>>=
   subroutine file_init (file, name, action, status, position)
     type(file_t), intent(out) :: file
     type(string_t), intent(in) :: name
     character(len=*), intent(in) :: action, status, position
     file%unit = free_unit ()
     file%name = name
     open (unit = file%unit, file = char (file%name), &
           action = action, status = status, position = position)
     select case (action)
     case ("read")
        file%reading = .true.
     case ("write")
        file%writing = .true.
     case ("readwrite")
        file%reading = .true.
        file%writing = .true.
     end select
   end subroutine file_init
 
 @ %def file_init
 @ The finalizer closes it.
 <<User files: procedures>>=
   subroutine file_final (file)
     type(file_t), intent(inout) :: file
     close (unit = file%unit)
     file%unit = -1
   end subroutine file_final
 
 @ %def file_final
 @ Check if a file is open with correct status.
 <<User files: procedures>>=
   function file_is_open (file, action) result (flag)
     logical :: flag
     type(file_t), intent(in) :: file
     character(*), intent(in) :: action
     select case (action)
     case ("read")
        flag = file%reading
     case ("write")
        flag = file%writing
     case ("readwrite")
        flag = file%reading .and. file%writing
     case default
        call msg_bug ("Checking file '" // char (file%name) &
             // "': illegal action specifier")
     end select
   end function file_is_open
 
 @ %def file_is_open
 @ Return the unit number of a file for direct access.  It should be checked
 first whether the file is open.
 <<User files: procedures>>=
   function file_get_unit (file) result (unit)
     integer :: unit
     type(file_t), intent(in) :: file
     unit = file%unit
   end function file_get_unit
 
 @ %def file_get_unit
 @ Write to the file.  Error if in wrong mode.  If there is no string, just
 write an empty record.  If there is a string, respect the [[advancing]]
 option.
 <<User files: procedures>>=
   subroutine file_write_string (file, string, advancing)
     type(file_t), intent(in) :: file
     type(string_t), intent(in), optional :: string
     logical, intent(in), optional :: advancing
     if (file%writing) then
        if (present (string)) then
           if (present (advancing)) then
              if (advancing) then
                 write (file%unit, "(A)")  char (string)
              else
                 write (file%unit, "(A)", advance="no")  char (string)
              end if
           else
              write (file%unit, "(A)")  char (string)
           end if
        else
           write (file%unit, *)
        end if
     else
        call msg_error ("Writing to file: File '" // char (file%name) &
             // "' is not open for writing.")
     end if
   end subroutine file_write_string
 
 @ %def file_write
 @ Write a whole ifile, line by line.
 <<User files: procedures>>=
   subroutine file_write_ifile (file, ifile)
     type(file_t), intent(in) :: file
     type(ifile_t), intent(in) :: ifile
     type(line_p) :: line
     call line_init (line, ifile)
     do while (line_is_associated (line))
        call file_write_string (file, line_get_string_advance (line))
     end do
   end subroutine file_write_ifile
 
 @ %def file_write_ifile
 @ Write an analysis object (or all objects) to an open file.
 <<User files: procedures>>=
   subroutine file_write_analysis (file, tag)
     type(file_t), intent(in) :: file
     type(string_t), intent(in), optional :: tag
     if (file%writing) then
        if (present (tag)) then
           call analysis_write (tag, unit = file%unit)
        else
           call analysis_write (unit = file%unit)
        end if
     else
        call msg_error ("Writing analysis to file: File '" // char (file%name) &
             // "' is not open for writing.")
     end if
   end subroutine file_write_analysis
 
 @ %def file_write_analysis
 @
 \subsection{The file list}
 We maintain a list of all open files and their attributes.  The list must be
 doubly-linked because we may delete entries.
 <<User files: public>>=
   public :: file_list_t
 <<User files: types>>=
   type :: file_list_t
      type(file_t), pointer :: first => null ()
      type(file_t), pointer :: last => null ()
   end type file_list_t
 
 @ %def file_list_t
 @ There is no initialization routine, but a finalizer which deletes all:
 <<User files: public>>=
   public :: file_list_final
 <<User files: procedures>>=
   subroutine file_list_final (file_list)
     type(file_list_t), intent(inout) :: file_list
     type(file_t), pointer :: current
     do while (associated (file_list%first))
        current => file_list%first
        file_list%first => current%next
        call file_final (current)
        deallocate (current)
     end do
     file_list%last => null ()
   end subroutine file_list_final
 
 @ %def file_list_final
 @ Find an entry in the list.  Return null pointer on failure.
 <<User files: procedures>>=
   function file_list_get_file_ptr (file_list, name) result (current)
     type(file_t), pointer :: current
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     current => file_list%first
     do while (associated (current))
        if (current%name == name)  return
        current => current%next
     end do
   end function file_list_get_file_ptr
 
 @ %def file_list_get_file_ptr
 @ Check if a file is open, public version:
 <<User files: public>>=
   public :: file_list_is_open
 <<User files: procedures>>=
   function file_list_is_open (file_list, name, action) result (flag)
     logical :: flag
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     character(len=*), intent(in) :: action
     type(file_t), pointer :: current
     current => file_list_get_file_ptr (file_list, name)
     if (associated (current)) then
        flag = file_is_open (current, action)
     else
        flag = .false.
     end if
   end function file_list_is_open
 
 @ %def file_list_is_open
 @ Return the unit number for a file.  It should be checked first whether the
 file is open.
 <<User files: public>>=
   public :: file_list_get_unit
 <<User files: procedures>>=
   function file_list_get_unit (file_list, name) result (unit)
     integer :: unit
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     type(file_t), pointer :: current
     current => file_list_get_file_ptr (file_list, name)
     if (associated (current)) then
        unit = file_get_unit (current)
     else
        unit = -1
     end if
   end function file_list_get_unit
 
 @ %def file_list_get_unit
 @ Append a new file entry, i.e., open this file.  Error if it is
 already open.
 <<User files: public>>=
   public :: file_list_open
 <<User files: procedures>>=
   subroutine file_list_open (file_list, name, action, status, position)
     type(file_list_t), intent(inout) :: file_list
     type(string_t), intent(in) :: name
     character(len=*), intent(in) :: action, status, position
     type(file_t), pointer :: current
     if (.not. associated (file_list_get_file_ptr (file_list, name))) then
        allocate (current)
        call msg_message ("Opening file '" // char (name) // "' for output")
        call file_init (current, name, action, status, position)
        if (associated (file_list%last)) then
           file_list%last%next => current
           current%prev => file_list%last
        else
           file_list%first => current
        end if
        file_list%last => current
     else
        call msg_error ("Opening file: File '" // char (name) &
             // "' is already open.")
     end if
   end subroutine file_list_open
 
 @ %def file_list_open
 @ Delete a file entry, i.e., close this file.  Error if it is not open.
 <<User files: public>>=
   public :: file_list_close
 <<User files: procedures>>=
   subroutine file_list_close (file_list, name)
     type(file_list_t), intent(inout) :: file_list
     type(string_t), intent(in) :: name
     type(file_t), pointer :: current
     current => file_list_get_file_ptr (file_list, name)
     if (associated (current)) then
        if (associated (current%prev)) then
           current%prev%next => current%next
        else
           file_list%first => current%next
        end if
        if (associated (current%next)) then
           current%next%prev => current%prev
        else
           file_list%last => current%prev
        end if
        call msg_message ("Closing file '" // char (name) // "' for output")
        call file_final (current)
        deallocate (current)
     else
        call msg_error ("Closing file: File '" // char (name) &
             // "' is not open.")
     end if
   end subroutine file_list_close
 
 @ %def file_list_close
 @ Write a string to file.  Error if it is not open.
 <<User files: public>>=
   public :: file_list_write
 <<User files: interfaces>>=
   interface file_list_write
      module procedure file_list_write_string
      module procedure file_list_write_ifile
   end interface
 <<User files: procedures>>=
   subroutine file_list_write_string (file_list, name, string, advancing)
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: string
     logical, intent(in), optional :: advancing
     type(file_t), pointer :: current
     current => file_list_get_file_ptr (file_list, name)
     if (associated (current)) then
        call file_write_string (current, string, advancing)
     else
        call msg_error ("Writing to file: File '" // char (name) &
             // "'is not open.")
     end if
   end subroutine file_list_write_string
 
   subroutine file_list_write_ifile (file_list, name, ifile)
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     type(ifile_t), intent(in) :: ifile
     type(file_t), pointer :: current
     current => file_list_get_file_ptr (file_list, name)
     if (associated (current)) then
        call file_write_ifile (current, ifile)
     else
        call msg_error ("Writing to file: File '" // char (name) &
             // "'is not open.")
     end if
   end subroutine file_list_write_ifile
 
 @ %def file_list_write
 @ Write an analysis object or all objects to data file.  Error if it is not
 open.  If the file name is empty, write to standard output.
 <<User files: public>>=
   public :: file_list_write_analysis
 <<User files: procedures>>=
   subroutine file_list_write_analysis (file_list, name, tag)
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: tag
     type(file_t), pointer :: current
     if (name == "") then
        if (present (tag)) then
           call analysis_write (tag)
        else
           call analysis_write
        end if
     else
        current => file_list_get_file_ptr (file_list, name)
        if (associated (current)) then
           call file_write_analysis (current, tag)
        else
           call msg_error ("Writing analysis to file: File '" // char (name) &
                // "' is not open.")
        end if
     end if
   end subroutine file_list_write_analysis
 
 @ %def file_list_write_analysis
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Runtime data}
 
 <<[[rt_data.f90]]>>=
 <<File header>>
 
 module rt_data
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_utils, only: write_separator
   use format_defs, only: FMT_19, FMT_12
   use system_dependencies
   use diagnostics
   use os_interface
   use lexers
   use parser
   use models
   use subevents
   use pdg_arrays
   use variables, only: var_list_t
   use process_libraries
   use prclib_stacks
   use prc_core, only: helicity_selection_t
   use beam_structures
   use event_base, only: event_callback_t
   use user_files
   use process_stacks
   use iterations
 
 <<Standard module head>>
 
 <<RT data: public>>
 
 <<RT data: types>>
 
 contains
 
 <<RT data: procedures>>
 
 end module rt_data
 @ %def rt_data
 @
 \subsection{Strategy for models and variables}
 The program manages its data via a main [[rt_data_t]] object.  During program
 flow, various commands create and use local [[rt_data_t]] objects.  Those
 transient blocks contain either pointers to global object or local copies
 which are deleted after use.
 
 Each [[rt_data_t]] object contains a variable list component.  This lists
 holds (local copies of) all kinds of intrinsic or user-defined variables.  The
 variable list is linked to the variable list contained in the local process
 library.  This, in turn, is linked to the variable list of the [[rt_data_t]]
 context, and so on.
 
 A variable lookup will thus be recursively delegated to the linked variable
 lists, until a match is found.  When modifying a variable which is not yet
 local, the program creates a local copy and uses this afterwards.  Thus, when
 the local [[rt_data_t]] object is deleted, the context value is recovered.
 
 Models are kept in a model list which is separate from the variable list.
 Otherwise, they are treated in a similar manner: the local list is linked to
 the context model list.  Model lookup is thus recursively delegated.  When a
 model or any part of it is modified, the model is copied to the local
 [[rt_data_t]] object, so the context model is not modified.  Commands such as
 [[integrate]] will create their own copy of the current model (and of the
 current variable list) at the point where they are executed.
 
 When a model is encountered for the first time, it is read from file.  The
 reading is automatically delegated to the global context.  Thus, this master
 copy survives until the main [[rt_data_t]] object is deleted, at program
 completion.
 
 If there is a currently active model, its variable list is linked to the main
 variable list.  Variable lookups will then start from the model variable
 list.  When the current model is switched, the new active model will get this
 link instead.  Consequently, a change to the current model is kept as long as
 this model has a local copy; it survives local model switches.  On the other
 hand, a parameter change in the current model doesn't affect any other model,
 even if the parameter name is identical.
 @
 \subsection{Container for parse nodes}
 The runtime data set contains a bunch of parse nodes (chunks of code
 that have not been compiled into evaluation trees but saved for later
 use).  We collect them here.
 
 This implementation has the useful effect that an assignment between two
 objects of this type will establish a pointer-target relationship for
 all components.
 <<RT data: types>>=
   type :: rt_parse_nodes_t
      type(parse_node_t), pointer :: cuts_lexpr => null ()
      type(parse_node_t), pointer :: scale_expr => null ()
      type(parse_node_t), pointer :: fac_scale_expr => null ()
      type(parse_node_t), pointer :: ren_scale_expr => null ()
      type(parse_node_t), pointer :: weight_expr => null ()
      type(parse_node_t), pointer :: selection_lexpr => null ()
      type(parse_node_t), pointer :: reweight_expr => null ()
      type(parse_node_t), pointer :: analysis_lexpr => null ()
      type(parse_node_p), dimension(:), allocatable :: alt_setup
    contains
    <<RT data: rt parse nodes: TBP>>
   end type rt_parse_nodes_t
 
 @ %def rt_parse_nodes_t
 @ Clear individual components.  The parse nodes are nullified.  No
 finalization needed since the pointer targets are part of the global
 parse tree.
 <<RT data: rt parse nodes: TBP>>=
   procedure :: clear => rt_parse_nodes_clear
 <<RT data: procedures>>=
   subroutine rt_parse_nodes_clear (rt_pn, name)
     class(rt_parse_nodes_t), intent(inout) :: rt_pn
     type(string_t), intent(in) :: name
     select case (char (name))
     case ("cuts")
        rt_pn%cuts_lexpr => null ()
     case ("scale")
        rt_pn%scale_expr => null ()
     case ("factorization_scale")
        rt_pn%fac_scale_expr => null ()
     case ("renormalization_scale")
        rt_pn%ren_scale_expr => null ()
     case ("weight")
        rt_pn%weight_expr => null ()
     case ("selection")
        rt_pn%selection_lexpr => null ()
     case ("reweight")
        rt_pn%reweight_expr => null ()
     case ("analysis")
        rt_pn%analysis_lexpr => null ()
     end select
   end subroutine rt_parse_nodes_clear
 
 @ %def rt_parse_nodes_clear
 @ Output for the parse nodes.
 <<RT data: rt parse nodes: TBP>>=
   procedure :: write => rt_parse_nodes_write
 <<RT data: procedures>>=
   subroutine rt_parse_nodes_write (object, unit)
     class(rt_parse_nodes_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     call wrt ("Cuts", object%cuts_lexpr)
     call write_separator (u)
     call wrt ("Scale", object%scale_expr)
     call write_separator (u)
     call wrt ("Factorization scale", object%fac_scale_expr)
     call write_separator (u)
     call wrt ("Renormalization scale", object%ren_scale_expr)
     call write_separator (u)
     call wrt ("Weight", object%weight_expr)
     call write_separator (u, 2)
     call wrt ("Event selection", object%selection_lexpr)
     call write_separator (u)
     call wrt ("Event reweighting factor", object%reweight_expr)
     call write_separator (u)
     call wrt ("Event analysis", object%analysis_lexpr)
     if (allocated (object%alt_setup)) then
        call write_separator (u, 2)
        write (u, "(1x,A,':')")  "Alternative setups"
        do i = 1, size (object%alt_setup)
           call write_separator (u)
           call wrt ("Commands", object%alt_setup(i)%ptr)
        end do
     end if
   contains
     subroutine wrt (title, pn)
       character(*), intent(in) :: title
       type(parse_node_t), intent(in), pointer :: pn
       if (associated (pn)) then
          write (u, "(1x,A,':')")  title
          call write_separator (u)
          call parse_node_write_rec (pn, u)
       else
          write (u, "(1x,A,':',1x,A)")  title, "[undefined]"
       end if
     end subroutine wrt
   end subroutine rt_parse_nodes_write
 
 @ %def rt_parse_nodes_write
 @ Screen output for individual components.  (This should eventually be more
 condensed, currently we print the internal representation tree.)
 <<RT data: rt parse nodes: TBP>>=
   procedure :: show => rt_parse_nodes_show
 <<RT data: procedures>>=
   subroutine rt_parse_nodes_show (rt_pn, name, unit)
     class(rt_parse_nodes_t), intent(in) :: rt_pn
     type(string_t), intent(in) :: name
     integer, intent(in), optional :: unit
     type(parse_node_t), pointer :: pn
     integer :: u
     u = given_output_unit (unit)
     select case (char (name))
     case ("cuts")
        pn => rt_pn%cuts_lexpr
     case ("scale")
        pn => rt_pn%scale_expr
     case ("factorization_scale")
        pn => rt_pn%fac_scale_expr
     case ("renormalization_scale")
        pn => rt_pn%ren_scale_expr
     case ("weight")
        pn => rt_pn%weight_expr
     case ("selection")
        pn => rt_pn%selection_lexpr
     case ("reweight")
        pn => rt_pn%reweight_expr
     case ("analysis")
        pn => rt_pn%analysis_lexpr
     end select
     if (associated (pn)) then
        write (u, "(A,1x,A,1x,A)")  "Expression:", char (name), "(parse tree):"
        call parse_node_write_rec (pn, u)
     else
        write (u, "(A,1x,A,A)")  "Expression:", char (name), ": [undefined]"
     end if
   end subroutine rt_parse_nodes_show
 
 @ %def rt_parse_nodes_show
 @
 \subsection{The data type}
 This is a big data container which contains everything that is used and
 modified during the command flow.  A local copy of this can be used to
 temporarily override defaults.  The data set is transparent.
 <<RT data: public>>=
   public :: rt_data_t
 <<RT data: types>>=
   type :: rt_data_t
      type(lexer_t), pointer :: lexer => null ()
      type(rt_data_t), pointer :: context => null ()
      type(string_t), dimension(:), allocatable :: export
      type(var_list_t) :: var_list
      type(iterations_list_t) :: it_list
      type(os_data_t) :: os_data
      type(model_list_t) :: model_list
      type(model_t), pointer :: model => null ()
      logical :: model_is_copy = .false.
      type(model_t), pointer :: preload_model => null ()
      type(model_t), pointer :: fallback_model => null ()
      type(prclib_stack_t) :: prclib_stack
      type(process_library_t), pointer :: prclib => null ()
      type(beam_structure_t) :: beam_structure
      type(rt_parse_nodes_t) :: pn
      type(process_stack_t) :: process_stack
      type(string_t), dimension(:), allocatable :: sample_fmt
      class(event_callback_t), allocatable :: event_callback
      type(file_list_t), pointer :: out_files => null ()
      logical :: quit = .false.
      integer :: quit_code = 0
      type(string_t) :: logfile
      logical :: nlo_fixed_order = .false.
      logical, dimension(0:5) :: selected_nlo_parts = .false.
      integer, dimension(:), allocatable :: nlo_component
    contains
    <<RT data: rt data: TBP>>
   end type rt_data_t
 
 @ %def rt_data_t
 @
 \subsection{Output}
 <<RT data: rt data: TBP>>=
   procedure :: write => rt_data_write
 <<RT data: procedures>>=
   subroutine rt_data_write (object, unit, vars, pacify)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     type(string_t), dimension(:), intent(in), optional :: vars
     logical, intent(in), optional :: pacify
     integer :: u, i
     u = given_output_unit (unit)
     call write_separator (u, 2)
     write (u, "(1x,A)")  "Runtime data:"
     if (object%get_n_export () > 0) then
        call write_separator (u, 2)
        write (u, "(1x,A)")  "Exported objects and variables:"
        call write_separator (u)
        call object%write_exports (u)
     end if
     if (present (vars)) then
        if (size (vars) /= 0) then
           call write_separator (u, 2)
           write (u, "(1x,A)")  "Selected variables:"
           call write_separator (u)
           call object%write_vars (u, vars)
        end if
     else
        call write_separator (u, 2)
        if (associated (object%model)) then
           call object%model%write_var_list (u, follow_link=.true.)
        else
           call object%var_list%write (u, follow_link=.true.)
        end if
     end if
     if (object%it_list%get_n_pass () > 0) then
        call write_separator (u, 2)
        write (u, "(1x)", advance="no")
        call object%it_list%write (u)
     end if
     if (associated (object%model)) then
        call write_separator (u, 2)
        call object%model%write (u)
     end if
     call object%prclib_stack%write (u)
     call object%beam_structure%write (u)
     call write_separator (u, 2)
     call object%pn%write (u)
     if (allocated (object%sample_fmt)) then
        call write_separator (u)
        write (u, "(1x,A)", advance="no")  "Event sample formats = "
        do i = 1, size (object%sample_fmt)
           if (i > 1)  write (u, "(A,1x)", advance="no")  ","
           write (u, "(A)", advance="no")  char (object%sample_fmt(i))
        end do
        write (u, "(A)")
     end if
     call write_separator (u)
     write (u, "(1x,A)", advance="no")  "Event callback:"
     if (allocated (object%event_callback)) then
        call object%event_callback%write (u)
     else
        write (u, "(1x,A)")  "[undefined]"
     end if
     call object%process_stack%write (u, pacify)
     write (u, "(1x,A,1x,L1)")  "quit     :", object%quit
     write (u, "(1x,A,1x,I0)")  "quit_code:", object%quit_code
     call write_separator (u, 2)
     write (u, "(1x,A,1x,A)")   "Logfile  :", "'" // trim (char (object%logfile)) // "'"
     call write_separator (u, 2)
   end subroutine rt_data_write
 
 @ %def rt_data_write
 @ Write only selected variables.
 <<RT data: rt data: TBP>>=
   procedure :: write_vars => rt_data_write_vars
 <<RT data: procedures>>=
   subroutine rt_data_write_vars (object, unit, vars)
     class(rt_data_t), intent(in), target :: object
     integer, intent(in), optional :: unit
     type(string_t), dimension(:), intent(in) :: vars
     type(var_list_t), pointer :: var_list
     integer :: u, i
     u = given_output_unit (unit)
     var_list => object%get_var_list_ptr ()
     do i = 1, size (vars)
        associate (var => vars(i))
          if (var_list%contains (var, follow_link=.true.)) then
             call var_list%write_var (var, unit = u, &
                  follow_link = .true., defined=.true.)
          end if
        end associate
     end do
   end subroutine rt_data_write_vars
 
 @ %def rt_data_write_vars
 @ Write only the model list.
 <<RT data: rt data: TBP>>=
   procedure :: write_model_list => rt_data_write_model_list
 <<RT data: procedures>>=
   subroutine rt_data_write_model_list (object, unit)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call object%model_list%write (u)
   end subroutine rt_data_write_model_list
 
 @ %def rt_data_write_model_list
 @ Write only the library stack.
 <<RT data: rt data: TBP>>=
   procedure :: write_libraries => rt_data_write_libraries
 <<RT data: procedures>>=
   subroutine rt_data_write_libraries (object, unit, libpath)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: libpath
     integer :: u
     u = given_output_unit (unit)
     call object%prclib_stack%write (u, libpath)
   end subroutine rt_data_write_libraries
 
 @ %def rt_data_write_libraries
 @ Write only the beam data.
 <<RT data: rt data: TBP>>=
   procedure :: write_beams => rt_data_write_beams
 <<RT data: procedures>>=
   subroutine rt_data_write_beams (object, unit)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call write_separator (u, 2)
     call object%beam_structure%write (u)
     call write_separator (u, 2)
   end subroutine rt_data_write_beams
 
 @ %def rt_data_write_beams
 @ Write only the process and event expressions.
 <<RT data: rt data: TBP>>=
   procedure :: write_expr => rt_data_write_expr
 <<RT data: procedures>>=
   subroutine rt_data_write_expr (object, unit)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call write_separator (u, 2)
     call object%pn%write (u)
     call write_separator (u, 2)
   end subroutine rt_data_write_expr
 
 @ %def rt_data_write_expr
 @ Write only the process stack.
 <<RT data: rt data: TBP>>=
   procedure :: write_process_stack => rt_data_write_process_stack
 <<RT data: procedures>>=
   subroutine rt_data_write_process_stack (object, unit)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     call object%process_stack%write (unit)
   end subroutine rt_data_write_process_stack
 
 @ %def rt_data_write_process_stack
 @
 <<RT data: rt data: TBP>>=
   procedure :: write_var_descriptions => rt_data_write_var_descriptions
 <<RT data: procedures>>=
   subroutine rt_data_write_var_descriptions (rt_data, unit, ascii_output)
     class(rt_data_t), intent(in) :: rt_data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: ascii_output
     integer :: u
     logical :: ao
     u = given_output_unit (unit)
     ao = .false.;  if (present (ascii_output))  ao = ascii_output
     call rt_data%var_list%write (u, follow_link=.true., &
          descriptions=.true., ascii_output=ao)
   end subroutine rt_data_write_var_descriptions
 
 @ %def rt_data_write_var_descriptions
 @
 <<RT data: rt data: TBP>>=
   procedure :: show_description_of_string => rt_data_show_description_of_string
 <<RT data: procedures>>=
   subroutine rt_data_show_description_of_string (rt_data, string, &
          unit, ascii_output)
     class(rt_data_t), intent(in) :: rt_data
     type(string_t), intent(in) :: string
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: ascii_output
     integer :: u
     logical :: ao
     u = given_output_unit (unit)
     ao = .false.;  if (present (ascii_output))  ao = ascii_output
     call rt_data%var_list%write_var (string, unit=u, follow_link=.true., &
          defined=.false., descriptions=.true., ascii_output=ao)
   end subroutine rt_data_show_description_of_string
 
 @ %def rt_data_show_description_of_string
 @
 \subsection{Clear}
 The [[clear]] command can remove the contents of various subobjects.
 The objects themselves should stay.
 <<RT data: rt data: TBP>>=
   procedure :: clear_beams => rt_data_clear_beams
 <<RT data: procedures>>=
   subroutine rt_data_clear_beams (global)
     class(rt_data_t), intent(inout) :: global
     call global%beam_structure%final_sf ()
     call global%beam_structure%final_pol ()
     call global%beam_structure%final_mom ()
   end subroutine rt_data_clear_beams
 
 @ %def rt_data_clear_beams
 @
 \subsection{Initialization}
 Initialize runtime data.  This defines special variables such as
 [[sqrts]], and should be done only for the instance that is actually
 global.   Local copies will inherit the special variables.
 
 We link the global variable list to the process stack variable list,
 so the latter is always available (and kept global).
 <<RT data: rt data: TBP>>=
   procedure :: global_init => rt_data_global_init
 <<RT data: procedures>>=
   subroutine rt_data_global_init (global, paths, logfile)
     class(rt_data_t), intent(out), target :: global
     type(paths_t), intent(in), optional :: paths
     type(string_t), intent(in), optional :: logfile
     integer :: seed
     call global%os_data%init (paths)
     if (present (logfile)) then
        global%logfile = logfile
     else
        global%logfile = ""
     end if
     allocate (global%out_files)
     call system_clock (seed)
     call global%var_list%init_defaults (seed, paths)
     call global%init_pointer_variables ()
     call global%process_stack%init_var_list (global%var_list)
   end subroutine rt_data_global_init
 
 @ %def rt_data_global_init
 @
 \subsection{Local copies}
 This is done at compile time when a local copy of runtime data is
 needed: Link the variable list and initialize all derived parameters.
 This allows for synchronizing them with local variable changes without
 affecting global data.
 
 Also re-initialize pointer variables, so they point to local copies of
 their targets.
 <<RT data: rt data: TBP>>=
   procedure :: local_init => rt_data_local_init
 <<RT data: procedures>>=
   subroutine rt_data_local_init (local, global, env)
     class(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(in), target :: global
     integer, intent(in), optional :: env
     local%context => global
     call local%process_stack%link (global%process_stack)
     call local%process_stack%init_var_list (local%var_list)
     call local%process_stack%link_var_list (global%var_list)
     call local%var_list%append_string (var_str ("$model_name"), &
          var_str (""), intrinsic=.true.)
     call local%init_pointer_variables ()
     local%fallback_model => global%fallback_model
     local%os_data = global%os_data
     local%logfile = global%logfile
     call local%model_list%link (global%model_list)
     local%model => global%model
     if (associated (local%model)) then
        call local%model%link_var_list (local%var_list)
     end if
     if (allocated (global%event_callback)) then
        allocate (local%event_callback, source = global%event_callback)
     end if
   end subroutine rt_data_local_init
 
 @ %def rt_data_local_init
 @ These variables point to objects which get local copies:
 <<RT data: rt data: TBP>>=
   procedure :: init_pointer_variables => rt_data_init_pointer_variables
 <<RT data: procedures>>=
   subroutine rt_data_init_pointer_variables (local)
     class(rt_data_t), intent(inout), target :: local
     logical, target, save :: known = .true.
     call local%var_list%append_string_ptr (var_str ("$fc"), &
          local%os_data%fc, known, intrinsic=.true., &
          description=var_str('This string variable gives the ' // &
          '\ttt{Fortran} compiler used within \whizard. It can ' // &
          'only be accessed, not set by the user. (cf. also ' // &
          '\ttt{\$fcflags})'))
     call local%var_list%append_string_ptr (var_str ("$fcflags"), &
          local%os_data%fcflags, known, intrinsic=.true., &
          description=var_str('This string variable gives the ' // &
          'compiler flags for the \ttt{Fortran} compiler used ' // &
          'within \whizard. It can only be accessed, not set by ' // &
          'the user. (cf. also \ttt{\$fc})'))
   end subroutine rt_data_init_pointer_variables
 
 @ %def rt_data_init_pointer_variables
 @ This is done at execution time: Copy data, transfer pointers.
 [[local]] has intent(inout) because its local variable list has
 already been prepared by the previous routine.
 
 To be pedantic, the local pointers to model and library should point
 to the entries in the local copies.  (However, as long as these are
 just shallow copies with identical content, this is actually
 irrelevant.)
 
 The process library and process stacks behave as global objects.  The
 copies of the process library and process stacks should be shallow
 copies, so the contents stay identical.  Since objects may be pushed
 on the stack in the local environment, upon restoring the global
 environment, we should reverse the assignment.  Then the added stack
 elements will end up on the global stack.  (This should be
 reconsidered in a parallel environment.)
 <<RT data: rt data: TBP>>=
   procedure :: activate => rt_data_activate
 <<RT data: procedures>>=
   subroutine rt_data_activate (local)
     class(rt_data_t), intent(inout), target :: local
     class(rt_data_t), pointer :: global
     global => local%context
     if (associated (global)) then
        local%lexer => global%lexer
        call global%copy_globals (local)
        local%os_data = global%os_data
        local%logfile = global%logfile
        if (associated (global%prclib)) then
           local%prclib => &
                local%prclib_stack%get_library_ptr (global%prclib%get_name ())
        end if
        call local%import_values ()
        call local%process_stack%link (global%process_stack)
        local%it_list = global%it_list
        local%beam_structure = global%beam_structure
        local%pn = global%pn
        if (allocated (local%sample_fmt))  deallocate (local%sample_fmt)
        if (allocated (global%sample_fmt)) then
           allocate (local%sample_fmt (size (global%sample_fmt)), &
                source = global%sample_fmt)
        end if
        local%out_files => global%out_files
        local%model => global%model
        local%model_is_copy = .false.
     else if (.not. associated (local%model)) then
        local%model => local%preload_model
        local%model_is_copy = .false.
     end if
     if (associated (local%model)) then
        call local%model%link_var_list (local%var_list)
        call local%var_list%set_string (var_str ("$model_name"), &
             local%model%get_name (), is_known = .true.)
     else
        call local%var_list%set_string (var_str ("$model_name"), &
             var_str (""), is_known = .false.)
     end if
   end subroutine rt_data_activate
 
 @ %def rt_data_activate
 @ Restore the previous state of data, without actually finalizing the local
 environment.  We also clear the local process stack.  Some local modifications
 (model list and process library stack) are communicated to the global context,
 if there is any.
 
 If the [[keep_local]] flag is set, we want to retain current settings in
 the local environment.  In particular, we create an instance of the currently
 selected model (which thus becomes separated from the model library!).
 The local variables are also kept.
 <<RT data: rt data: TBP>>=
   procedure :: deactivate => rt_data_deactivate
 <<RT data: procedures>>=
   subroutine rt_data_deactivate (local, global, keep_local)
     class(rt_data_t), intent(inout), target :: local
     class(rt_data_t), intent(inout), optional, target :: global
     logical, intent(in), optional :: keep_local
     type(string_t) :: local_model, local_scheme
     logical :: same_model, delete
     delete = .true.;  if (present (keep_local))  delete = .not. keep_local
     if (present (global)) then
        if (associated (global%model) .and. associated (local%model)) then
           local_model = local%model%get_name ()
           if (global%model%has_schemes ()) then
              local_scheme = local%model%get_scheme ()
              same_model = &
                   global%model%matches (local_model, local_scheme)
           else
              same_model = global%model%matches (local_model)
           end if
        else
           same_model = .false.
        end if
        if (delete) then
           call local%process_stack%clear ()
           call local%unselect_model ()
           call local%unset_values ()
        else if (associated (local%model)) then
           call local%ensure_model_copy ()
        end if
        if (.not. same_model .and. associated (global%model)) then
           if (global%model%has_schemes ()) then
              call msg_message ("Restoring model '" // &
                   char (global%model%get_name ()) // "', scheme '" // &
                   char (global%model%get_scheme ()) // "'")
           else
              call msg_message ("Restoring model '" // &
                   char (global%model%get_name ()) // "'")
           end if
        end if
        if (associated (global%model)) then
           call global%model%link_var_list (global%var_list)
        end if
        call global%restore_globals (local)
     else
        call local%unselect_model ()
     end if
   end subroutine rt_data_deactivate
 
 @ %def rt_data_deactivate
 @ This imports the global objects for which local modifications
 should be kept.  Currently, this is only the process library stack.
 <<RT data: rt data: TBP>>=
   procedure :: copy_globals => rt_data_copy_globals
 <<RT data: procedures>>=
   subroutine rt_data_copy_globals (global, local)
     class(rt_data_t), intent(in) :: global
     class(rt_data_t), intent(inout) :: local
     local%prclib_stack = global%prclib_stack
   end subroutine rt_data_copy_globals
 
 @ %def rt_data_copy_globals
 @ This restores global objects for which local modifications
 should be kept.  May also modify (remove) the local objects.
 <<RT data: rt data: TBP>>=
   procedure :: restore_globals => rt_data_restore_globals
 <<RT data: procedures>>=
   subroutine rt_data_restore_globals (global, local)
     class(rt_data_t), intent(inout) :: global
     class(rt_data_t), intent(inout) :: local
     global%prclib_stack = local%prclib_stack
     call local%handle_exports (global)
   end subroutine rt_data_restore_globals
 
 @ %def rt_data_restore_globals
 @
 \subsection{Exported objects}
 Exported objects are transferred to the global state when a local environment
 is closed.  (For the top-level global data set, there is no effect.)
 
 The current implementation handles only the [[results]] object, which resolves
 to the local process stack.  The stack elements are appended to the global
 stack without modification, the local stack becomes empty.
 
 Write names of objects to be exported:
 <<RT data: rt data: TBP>>=
   procedure :: write_exports => rt_data_write_exports
 <<RT data: procedures>>=
   subroutine rt_data_write_exports (rt_data, unit)
     class(rt_data_t), intent(in) :: rt_data
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     do i = 1, rt_data%get_n_export ()
        write (u, "(A)")  char (rt_data%export(i))
     end do
   end subroutine rt_data_write_exports
 
 @ %def rt_data_write_exports
 @ The number of entries in the export list.
 <<RT data: rt data: TBP>>=
   procedure :: get_n_export => rt_data_get_n_export
 <<RT data: procedures>>=
   function rt_data_get_n_export (rt_data) result (n)
     class(rt_data_t), intent(in) :: rt_data
     integer :: n
     if (allocated (rt_data%export)) then
        n = size (rt_data%export)
     else
        n = 0
     end if
   end function rt_data_get_n_export
 
 @ %def rt_data_get_n_export
 @ Return a specific export
 @ Append new names to the export list.  If a duplicate occurs, do not transfer
 it.
 <<RT data: rt data: TBP>>=
   procedure :: append_exports => rt_data_append_exports
 <<RT data: procedures>>=
   subroutine rt_data_append_exports (rt_data, export)
     class(rt_data_t), intent(inout) :: rt_data
     type(string_t), dimension(:), intent(in) :: export
     logical, dimension(:), allocatable :: mask
     type(string_t), dimension(:), allocatable :: tmp
     integer :: i, j, n
     if (.not. allocated (rt_data%export))  allocate (rt_data%export (0))
     n = size (rt_data%export)
     allocate (mask (size (export)), source=.false.)
     do i = 1, size (export)
        mask(i) = all (export(i) /= rt_data%export) &
             .and. all (export(i) /= export(:i-1))
     end do
     if (count (mask) > 0) then
        allocate (tmp (n + count (mask)))
        tmp(1:n) = rt_data%export(:)
        j = n
        do i = 1, size (export)
           if (mask(i)) then
              j = j + 1
              tmp(j) = export(i)
           end if
        end do
        call move_alloc (from=tmp, to=rt_data%export)
     end if
   end subroutine rt_data_append_exports
 
 @ %def rt_data_append_exports
 @ Transfer export-objects from the [[local]] rt data to the [[global]] rt
 data, as far as supported.
 <<RT data: rt data: TBP>>=
   procedure :: handle_exports => rt_data_handle_exports
 <<RT data: procedures>>=
   subroutine rt_data_handle_exports (local, global)
     class(rt_data_t), intent(inout), target :: local
     class(rt_data_t), intent(inout), target :: global
     type(string_t) :: export
     integer :: i
     if (local%get_n_export () > 0) then
        do i = 1, local%get_n_export ()
           export = local%export(i)
           select case (char (export))
           case ("results")
              call msg_message ("Exporting integration results &
                   &to outer environment")
              call local%transfer_process_stack (global)
           case default
              call msg_bug ("handle exports: '" &
                   // char (export) // "' unsupported")
           end select
        end do
     end if
   end subroutine rt_data_handle_exports
 
 @ %def rt_data_handle_exports
 @ Export the process stack.  One-by-one, take the last process from the local
 stack and push it on the global stack.  Also handle the corresponding result
 variables: append if the process did not exist yet in the global stack,
 otherwise update.
 
 TODO: result variables don't work that way yet, require initialization in the
 global variable list.
 <<RT data: rt data: TBP>>=
   procedure :: transfer_process_stack => rt_data_transfer_process_stack
 <<RT data: procedures>>=
   subroutine rt_data_transfer_process_stack (local, global)
     class(rt_data_t), intent(inout), target :: local
     class(rt_data_t), intent(inout), target :: global
     type(process_entry_t), pointer :: process
     type(string_t) :: process_id
     do
        call local%process_stack%pop_last (process)
        if (.not. associated (process))  exit
        process_id = process%get_id ()
        call global%process_stack%push (process)
        call global%process_stack%fill_result_vars (process_id)
        call global%process_stack%update_result_vars &
             (process_id, global%var_list)
     end do
   end subroutine rt_data_transfer_process_stack
 
 @ %def rt_data_transfer_process_stack
 @
 \subsection{Finalization}
 Finalizer for the variable list and the structure-function list.
 This is done only for the global RT dataset; local copies contain
 pointers to this and do not need a finalizer.
 <<RT data: rt data: TBP>>=
   procedure :: final => rt_data_global_final
 <<RT data: procedures>>=
   subroutine rt_data_global_final (global)
     class(rt_data_t), intent(inout) :: global
     call global%process_stack%final ()
     call global%prclib_stack%final ()
     call global%model_list%final ()
     call global%var_list%final (follow_link=.false.)
     if (associated (global%out_files)) then
        call file_list_final (global%out_files)
        deallocate (global%out_files)
     end if
   end subroutine rt_data_global_final
 
 @ %def rt_data_global_final
 @ The local copy needs a finalizer for the variable list, which consists
 of local copies.  This finalizer is called only when the local
 environment is finally discarded.  (Note that the process stack should
 already have been cleared after execution, which can occur many times
 for the same local environment.)
 <<RT data: rt data: TBP>>=
   procedure :: local_final => rt_data_local_final
 <<RT data: procedures>>=
   subroutine rt_data_local_final (local)
     class(rt_data_t), intent(inout) :: local
     call local%process_stack%clear ()
     call local%model_list%final ()
     call local%var_list%final (follow_link=.false.)
   end subroutine rt_data_local_final
 
 @ %def rt_data_local_final
 @
 \subsection{Model Management}
 Read a model, so it becomes available for activation.  No variables or model
 copies, this is just initialization.
 
 If this is a local environment, the model will be automatically read into the
 global context.
 <<RT data: rt data: TBP>>=
   procedure :: read_model => rt_data_read_model
 <<RT data: procedures>>=
   subroutine rt_data_read_model (global, name, model, scheme)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: scheme
     type(model_t), pointer, intent(out) :: model
     type(string_t) :: filename
     filename = name // ".mdl"
     call global%model_list%read_model &
          (name, filename, global%os_data, model, scheme)
   end subroutine rt_data_read_model
 
 @ %def rt_data_read_model
 @ Read a UFO model.  Create it on the fly if necessary.
 <<RT data: rt data: TBP>>=
   procedure :: read_ufo_model => rt_data_read_ufo_model
 <<RT data: procedures>>=
   subroutine rt_data_read_ufo_model (global, name, model, ufo_path)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     type(model_t), pointer, intent(out) :: model
     type(string_t), intent(in), optional :: ufo_path
     type(string_t) :: filename
     filename = name // ".ufo.mdl"
     call global%model_list%read_model &
          (name, filename, global%os_data, model, ufo=.true., ufo_path=ufo_path)
   end subroutine rt_data_read_ufo_model
 
 @ %def rt_data_read_ufo_model
 @ Initialize the fallback model.  This model is used
 whenever the current model does not describe all physical particles
 (hadrons, mainly).  It is not supposed to be modified, and the pointer
 should remain linked to this model.
 <<RT data: rt data: TBP>>=
   procedure :: init_fallback_model => rt_data_init_fallback_model
 <<RT data: procedures>>=
   subroutine rt_data_init_fallback_model (global, name, filename)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name, filename
     call global%model_list%read_model &
          (name, filename, global%os_data, global%fallback_model)
   end subroutine rt_data_init_fallback_model
 
 @ %def rt_data_init_fallback_model
 @
 Activate a model: assign the current-model pointer and set the model name in
 the variable list.  If necessary, read the model from file.  Link the global
 variable list to the model variable list.
 <<RT data: rt data: TBP>>=
   procedure :: select_model => rt_data_select_model
 <<RT data: procedures>>=
   subroutine rt_data_select_model (global, name, scheme, ufo, ufo_path)
     class(rt_data_t), intent(inout), target :: global
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: scheme
     logical, intent(in), optional :: ufo
     type(string_t), intent(in), optional :: ufo_path
     logical :: same_model, ufo_model
     ufo_model = .false.;  if (present (ufo))  ufo_model = ufo
     if (associated (global%model)) then
        same_model = global%model%matches (name, scheme, ufo)
     else
        same_model = .false.
     end if
     if (.not. same_model) then
        global%model => global%model_list%get_model_ptr (name, scheme, ufo)
        if (.not. associated (global%model)) then
           if (ufo_model) then
              call global%read_ufo_model (name, global%model, ufo_path)
           else
              call global%read_model (name, global%model)
           end if
           global%model_is_copy = .false.
        else if (associated (global%context)) then
           global%model_is_copy = &
                global%model_list%model_exists (name, scheme, ufo, &
                follow_link=.false.)
        else
           global%model_is_copy = .false.
        end if
     end if
     if (associated (global%model)) then
        call global%model%link_var_list (global%var_list)
        call global%var_list%set_string (var_str ("$model_name"), &
             name, is_known = .true.)
        if (global%model%is_ufo_model ()) then
           call msg_message ("Switching to model '" // char (name) // "' " &
                // "(generated from UFO source)")
        else if (global%model%has_schemes ()) then
           call msg_message ("Switching to model '" // char (name) // "', " &
                // "scheme '" // char (global%model%get_scheme ()) // "'")
        else
           call msg_message ("Switching to model '" // char (name) // "'")
        end if
     else
        call global%var_list%set_string (var_str ("$model_name"), &
             var_str (""), is_known = .false.)
     end if
   end subroutine rt_data_select_model
 
 @ %def rt_data_select_model
 @
 Remove the model link.  Do not unset the model name variable, because
 this may unset the variable in a parent [[rt_data]] object (via linked
 var lists).
 <<RT data: rt data: TBP>>=
   procedure :: unselect_model => rt_data_unselect_model
 <<RT data: procedures>>=
   subroutine rt_data_unselect_model (global)
     class(rt_data_t), intent(inout), target :: global
     if (associated (global%model)) then
        global%model => null ()
        global%model_is_copy = .false.
     end if
   end subroutine rt_data_unselect_model
 
 @ %def rt_data_unselect_model
 @
 Create a copy of the currently selected model and append it to the local model
 list.  The model pointer is redirected to the copy.
 (Not applicable for the global model list, those models will be
 modified in-place.)
 <<RT data: rt data: TBP>>=
   procedure :: ensure_model_copy => rt_data_ensure_model_copy
 <<RT data: procedures>>=
   subroutine rt_data_ensure_model_copy (global)
     class(rt_data_t), intent(inout), target :: global
     if (associated (global%context)) then
        if (.not. global%model_is_copy) then
           call global%model_list%append_copy (global%model, global%model)
           global%model_is_copy = .true.
           call global%model%link_var_list (global%var_list)
        end if
     end if
   end subroutine rt_data_ensure_model_copy
 
 @ %def rt_data_ensure_model_copy
 @
 Modify a model variable.  The update mechanism will ensure that the model
 parameter set remains consistent.  This has to take place in a local copy
 of the current model.  If there is none yet, create one.
 <<RT data: rt data: TBP>>=
   procedure :: model_set_real => rt_data_model_set_real
 <<RT data: procedures>>=
   subroutine rt_data_model_set_real (global, name, rval, verbose, pacified)
     class(rt_data_t), intent(inout), target :: global
     type(string_t), intent(in) :: name
     real(default), intent(in) :: rval
     logical, intent(in), optional :: verbose, pacified
     call global%ensure_model_copy ()
     call global%model%set_real (name, rval, verbose, pacified)
   end subroutine rt_data_model_set_real
 
 @ %def rt_data_model_set_real
 @
 Modify particle properties.  This has to take place in a local copy
 of the current model.  If there is none yet, create one.
 <<RT data: rt data: TBP>>=
   procedure :: modify_particle => rt_data_modify_particle
 <<RT data: procedures>>=
   subroutine rt_data_modify_particle &
        (global, pdg, polarized, stable, decay, &
        isotropic_decay, diagonal_decay, decay_helicity)
     class(rt_data_t), intent(inout), target :: global
     integer, intent(in) :: pdg
     logical, intent(in), optional :: polarized, stable
     logical, intent(in), optional :: isotropic_decay, diagonal_decay
     integer, intent(in), optional :: decay_helicity
     type(string_t), dimension(:), intent(in), optional :: decay
     call global%ensure_model_copy ()
     if (present (polarized)) then
        if (polarized) then
           call global%model%set_polarized (pdg)
        else
           call global%model%set_unpolarized (pdg)
        end if
     end if
     if (present (stable)) then
        if (stable) then
           call global%model%set_stable (pdg)
        else if (present (decay)) then
           call global%model%set_unstable &
                (pdg, decay, isotropic_decay, diagonal_decay, decay_helicity)
        else
           call msg_bug ("Setting particle unstable: missing decay processes")
        end if
     end if
   end subroutine rt_data_modify_particle
 
 @ %def rt_data_modify_particle
 @
 \subsection{Managing Variables}
 Return a pointer to the currently active variable list.  If there is no model,
 this is the global variable list.  If there is one, it is the model variable
 list, which should be linked to the former.
 <<RT data: rt data: TBP>>=
   procedure :: get_var_list_ptr => rt_data_get_var_list_ptr
 <<RT data: procedures>>=
   function rt_data_get_var_list_ptr (global) result (var_list)
     class(rt_data_t), intent(in), target :: global
     type(var_list_t), pointer :: var_list
     if (associated (global%model)) then
        var_list => global%model%get_var_list_ptr ()
     else
        var_list => global%var_list
     end if
   end function rt_data_get_var_list_ptr
 
 @ %def rt_data_get_var_list_ptr
 @ Initialize a local variable: append it to the current variable list.  No
 initial value, yet.
 <<RT data: rt data: TBP>>=
   procedure :: append_log => rt_data_append_log
   procedure :: append_int => rt_data_append_int
   procedure :: append_real => rt_data_append_real
   procedure :: append_cmplx => rt_data_append_cmplx
   procedure :: append_subevt => rt_data_append_subevt
   procedure :: append_pdg_array => rt_data_append_pdg_array
   procedure :: append_string => rt_data_append_string
 <<RT data: procedures>>=
   subroutine rt_data_append_log (local, name, lval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     logical, intent(in), optional :: lval
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_log (name, lval, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_log
 
   subroutine rt_data_append_int (local, name, ival, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     integer, intent(in), optional :: ival
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_int (name, ival, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_int
 
   subroutine rt_data_append_real (local, name, rval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     real(default), intent(in), optional :: rval
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_real (name, rval, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_real
 
   subroutine rt_data_append_cmplx (local, name, cval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     complex(default), intent(in), optional :: cval
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_cmplx (name, cval, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_cmplx
 
   subroutine rt_data_append_subevt (local, name, pval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     type(subevt_t), intent(in), optional :: pval
     logical, intent(in) :: intrinsic, user
     call local%var_list%append_subevt (name, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_subevt
 
   subroutine rt_data_append_pdg_array (local, name, aval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     type(pdg_array_t), intent(in), optional :: aval
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_pdg_array (name, aval, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_pdg_array
 
   subroutine rt_data_append_string (local, name, sval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: sval
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_string (name, sval, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_string
 
 @ %def rt_data_append_log
 @ %def rt_data_append_int
 @ %def rt_data_append_real
 @ %def rt_data_append_cmplx
 @ %def rt_data_append_subevt
 @ %def rt_data_append_pdg_array
 @ %def rt_data_append_string
 @ Import values for all local variables, given a global context environment
 where these variables are defined.
 <<RT data: rt data: TBP>>=
   procedure :: import_values => rt_data_import_values
 <<RT data: procedures>>=
   subroutine rt_data_import_values (local)
     class(rt_data_t), intent(inout) :: local
     type(rt_data_t), pointer :: global
     global => local%context
     if (associated (global)) then
        call local%var_list%import (global%var_list)
     end if
   end subroutine rt_data_import_values
 
 @ %def rt_data_import_values
 @ Unset all variable values.
 <<RT data: rt data: TBP>>=
   procedure :: unset_values => rt_data_unset_values
 <<RT data: procedures>>=
   subroutine rt_data_unset_values (global)
     class(rt_data_t), intent(inout) :: global
     call global%var_list%undefine (follow_link=.false.)
   end subroutine rt_data_unset_values
 
 @ %def rt_data_unset_values
 @ Set a variable.  (Not a model variable, these are handled separately.)  We
 can assume that the variable has been initialized.
 <<RT data: rt data: TBP>>=
   procedure :: set_log => rt_data_set_log
   procedure :: set_int => rt_data_set_int
   procedure :: set_real => rt_data_set_real
   procedure :: set_cmplx => rt_data_set_cmplx
   procedure :: set_subevt => rt_data_set_subevt
   procedure :: set_pdg_array => rt_data_set_pdg_array
   procedure :: set_string => rt_data_set_string
 <<RT data: procedures>>=
   subroutine rt_data_set_log &
        (global, name, lval, is_known, force, verbose)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     logical, intent(in) :: lval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose
     call global%var_list%set_log (name, lval, is_known, &
          force=force, verbose=verbose)
   end subroutine rt_data_set_log
 
   subroutine rt_data_set_int &
        (global, name, ival, is_known, force, verbose)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     integer, intent(in) :: ival
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose
     call global%var_list%set_int (name, ival, is_known, &
          force=force, verbose=verbose)
   end subroutine rt_data_set_int
 
   subroutine rt_data_set_real &
        (global, name, rval, is_known, force, verbose, pacified)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     real(default), intent(in) :: rval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose, pacified
     call global%var_list%set_real (name, rval, is_known, &
          force=force, verbose=verbose, pacified=pacified)
   end subroutine rt_data_set_real
 
   subroutine rt_data_set_cmplx &
        (global, name, cval, is_known, force, verbose, pacified)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     complex(default), intent(in) :: cval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose, pacified
     call global%var_list%set_cmplx (name, cval, is_known, &
          force=force, verbose=verbose, pacified=pacified)
   end subroutine rt_data_set_cmplx
 
   subroutine rt_data_set_subevt &
        (global, name, pval, is_known, force, verbose)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     type(subevt_t), intent(in) :: pval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose
     call global%var_list%set_subevt (name, pval, is_known, &
          force=force, verbose=verbose)
   end subroutine rt_data_set_subevt
 
   subroutine rt_data_set_pdg_array &
        (global, name, aval, is_known, force, verbose)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     type(pdg_array_t), intent(in) :: aval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose
     call global%var_list%set_pdg_array (name, aval, is_known, &
          force=force, verbose=verbose)
   end subroutine rt_data_set_pdg_array
 
   subroutine rt_data_set_string &
        (global, name, sval, is_known, force, verbose)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     type(string_t), intent(in) :: sval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose
     call global%var_list%set_string (name, sval, is_known, &
          force=force, verbose=verbose)
   end subroutine rt_data_set_string
 
 @ %def rt_data_set_log
 @ %def rt_data_set_int
 @ %def rt_data_set_real
 @ %def rt_data_set_cmplx
 @ %def rt_data_set_subevt
 @ %def rt_data_set_pdg_array
 @ %def rt_data_set_string
 @ Return the value of a variable, assuming that the type is correct.
 <<RT data: rt data: TBP>>=
   procedure :: get_lval => rt_data_get_lval
   procedure :: get_ival => rt_data_get_ival
   procedure :: get_rval => rt_data_get_rval
   procedure :: get_cval => rt_data_get_cval
   procedure :: get_pval => rt_data_get_pval
   procedure :: get_aval => rt_data_get_aval
   procedure :: get_sval => rt_data_get_sval
 <<RT data: procedures>>=
   function rt_data_get_lval (global, name) result (lval)
     logical :: lval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     lval = var_list%get_lval (name)
   end function rt_data_get_lval
 
   function rt_data_get_ival (global, name) result (ival)
     integer :: ival
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     ival = var_list%get_ival (name)
   end function rt_data_get_ival
 
   function rt_data_get_rval (global, name) result (rval)
     real(default) :: rval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     rval = var_list%get_rval (name)
   end function rt_data_get_rval
 
   function rt_data_get_cval (global, name) result (cval)
     complex(default) :: cval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     cval = var_list%get_cval (name)
   end function rt_data_get_cval
 
   function rt_data_get_aval (global, name) result (aval)
     type(pdg_array_t) :: aval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     aval = var_list%get_aval (name)
   end function rt_data_get_aval
 
   function rt_data_get_pval (global, name) result (pval)
     type(subevt_t) :: pval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     pval = var_list%get_pval (name)
   end function rt_data_get_pval
 
   function rt_data_get_sval (global, name) result (sval)
     type(string_t) :: sval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     sval = var_list%get_sval (name)
   end function rt_data_get_sval
 
 @ %def rt_data_get_lval
 @ %def rt_data_get_ival
 @ %def rt_data_get_rval
 @ %def rt_data_get_cval
 @ %def rt_data_get_pval
 @ %def rt_data_get_aval
 @ %def rt_data_get_sval
 @ Return true if the variable exists in the global list.
 <<RT data: rt data: TBP>>=
   procedure :: contains => rt_data_contains
 <<RT data: procedures>>=
   function rt_data_contains (global, name) result (lval)
     logical :: lval
     class(rt_data_t), intent(in) :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     lval = var_list%contains (name)
   end function rt_data_contains
 
 @ %def rt_data_contains
 @
 \subsection{Further Content}
 Add a library (available via a pointer of type [[prclib_entry_t]]) to
 the stack and update the pointer and variable list to the current
 library.  The pointer association of [[prclib_entry]] will be discarded.
 <<RT data: rt data: TBP>>=
   procedure :: add_prclib => rt_data_add_prclib
 <<RT data: procedures>>=
   subroutine rt_data_add_prclib (global, prclib_entry)
     class(rt_data_t), intent(inout) :: global
     type(prclib_entry_t), intent(inout), pointer :: prclib_entry
     call global%prclib_stack%push (prclib_entry)
     call global%update_prclib (global%prclib_stack%get_first_ptr ())
   end subroutine rt_data_add_prclib
 
 @ %def rt_data_add_prclib
 @ Given a pointer to a process library, make this the currently active
 library.
 <<RT data: rt data: TBP>>=
   procedure :: update_prclib => rt_data_update_prclib
 <<RT data: procedures>>=
   subroutine rt_data_update_prclib (global, lib)
     class(rt_data_t), intent(inout) :: global
     type(process_library_t), intent(in), target :: lib
     global%prclib => lib
     if (global%var_list%contains (&
          var_str ("$library_name"), follow_link = .false.)) then
        call global%var_list%set_string (var_str ("$library_name"), &
             global%prclib%get_name (), is_known=.true.)
     else
        call global%var_list%append_string ( &
             var_str ("$library_name"), global%prclib%get_name (), &
             intrinsic = .true.)
     end if
   end subroutine rt_data_update_prclib
 
 @ %def rt_data_update_prclib
 @
 \subsection{Miscellaneous}
 The helicity selection data are distributed among several parameters.  Here,
 we collect them in a single record.
 <<RT data: rt data: TBP>>=
   procedure :: get_helicity_selection => rt_data_get_helicity_selection
 <<RT data: procedures>>=
   function rt_data_get_helicity_selection (rt_data) result (helicity_selection)
     class(rt_data_t), intent(in) :: rt_data
     type(helicity_selection_t) :: helicity_selection
     associate (var_list => rt_data%var_list)
       helicity_selection%active = var_list%get_lval (&
            var_str ("?helicity_selection_active"))
       if (helicity_selection%active) then
          helicity_selection%threshold = var_list%get_rval (&
               var_str ("helicity_selection_threshold"))
          helicity_selection%cutoff = var_list%get_ival (&
               var_str ("helicity_selection_cutoff"))
       end if
     end associate
   end function rt_data_get_helicity_selection
 
 @ %def rt_data_get_helicity_selection
 @ Show the beam setup: beam structure and relevant global variables.
 <<RT data: rt data: TBP>>=
   procedure :: show_beams => rt_data_show_beams
 <<RT data: procedures>>=
   subroutine rt_data_show_beams (rt_data, unit)
     class(rt_data_t), intent(in) :: rt_data
     integer, intent(in), optional :: unit
     type(string_t) :: s
     integer :: u
     u = given_output_unit (unit)
     associate (beams => rt_data%beam_structure, var_list => rt_data%var_list)
       call beams%write (u)
       if (.not. beams%asymmetric () .and. beams%get_n_beam () == 2) then
          write (u, "(2x,A," // FMT_19 // ",1x,'GeV')") "sqrts =", &
               var_list%get_rval (var_str ("sqrts"))
       end if
       if (beams%contains ("pdf_builtin")) then
          s = var_list%get_sval (var_str ("$pdf_builtin_set"))
          if (s /= "") then
             write (u, "(2x,A,1x,3A)")  "PDF set =", '"', char (s), '"'
          else
             write (u, "(2x,A,1x,A)")  "PDF set =", "[undefined]"
          end if
       end if
       if (beams%contains ("lhapdf")) then
          s = var_list%get_sval (var_str ("$lhapdf_dir"))
          if (s /= "") then
             write (u, "(2x,A,1x,3A)")  "LHAPDF dir    =", '"', char (s), '"'
          end if
          s = var_list%get_sval (var_str ("$lhapdf_file"))
          if (s /= "") then
             write (u, "(2x,A,1x,3A)")  "LHAPDF file   =", '"', char (s), '"'
             write (u, "(2x,A,1x,I0)") "LHAPDF member =", &
                  var_list%get_ival (var_str ("lhapdf_member"))
          else
             write (u, "(2x,A,1x,A)")  "LHAPDF file   =", "[undefined]"
          end if
       end if
       if (beams%contains ("lhapdf_photon")) then
          s = var_list%get_sval (var_str ("$lhapdf_dir"))
          if (s /= "") then
             write (u, "(2x,A,1x,3A)")  "LHAPDF dir    =", '"', char (s), '"'
          end if
          s = var_list%get_sval (var_str ("$lhapdf_photon_file"))
          if (s /= "") then
             write (u, "(2x,A,1x,3A)")  "LHAPDF file   =", '"', char (s), '"'
             write (u, "(2x,A,1x,I0)") "LHAPDF member =", &
                  var_list%get_ival (var_str ("lhapdf_member"))
             write (u, "(2x,A,1x,I0)") "LHAPDF scheme =", &
                  var_list%get_ival (&
                  var_str ("lhapdf_photon_scheme"))
          else
             write (u, "(2x,A,1x,A)")  "LHAPDF file   =", "[undefined]"
          end if
       end if
       if (beams%contains ("isr")) then
          write (u, "(2x,A," // FMT_19 // ")") "ISR alpha        =", &
               var_list%get_rval (var_str ("isr_alpha"))
          write (u, "(2x,A," // FMT_19 // ")") "ISR Q max        =", &
               var_list%get_rval (var_str ("isr_q_max"))
          write (u, "(2x,A," // FMT_19 // ")") "ISR mass         =", &
               var_list%get_rval (var_str ("isr_mass"))
          write (u, "(2x,A,1x,I0)") "ISR order        =", &
               var_list%get_ival (var_str ("isr_order"))
          write (u, "(2x,A,1x,L1)") "ISR recoil       =", &
               var_list%get_lval (var_str ("?isr_recoil"))
          write (u, "(2x,A,1x,L1)") "ISR energy cons. =", &
               var_list%get_lval (var_str ("?isr_keep_energy"))
       end if
       if (beams%contains ("epa")) then
          write (u, "(2x,A," // FMT_19 // ")") "EPA alpha         =", &
               var_list%get_rval (var_str ("epa_alpha"))
          write (u, "(2x,A," // FMT_19 // ")") "EPA x min         =", &
               var_list%get_rval (var_str ("epa_x_min"))
          write (u, "(2x,A," // FMT_19 // ")") "EPA Q min         =", &
               var_list%get_rval (var_str ("epa_q_min"))
-         write (u, "(2x,A," // FMT_19 // ")") "EPA E max         =", &
-              var_list%get_rval (var_str ("epa_e_max"))
+         write (u, "(2x,A," // FMT_19 // ")") "EPA Q max         =", &
+              var_list%get_rval (var_str ("epa_q_max"))
          write (u, "(2x,A," // FMT_19 // ")") "EPA mass          =", &
               var_list%get_rval (var_str ("epa_mass"))
          write (u, "(2x,A,1x,L1)") "EPA recoil        =", &
               var_list%get_lval (var_str ("?epa_recoil"))
          write (u, "(2x,A,1x,L1)") "EPA  energy cons. =", &
               var_list%get_lval (var_str ("?epa_keep_energy"))
       end if
       if (beams%contains ("ewa")) then
          write (u, "(2x,A," // FMT_19 // ")") "EWA x min       =", &
               var_list%get_rval (var_str ("ewa_x_min"))
          write (u, "(2x,A," // FMT_19 // ")") "EWA Pt max      =", &
               var_list%get_rval (var_str ("ewa_pt_max"))
          write (u, "(2x,A," // FMT_19 // ")") "EWA mass        =", &
               var_list%get_rval (var_str ("ewa_mass"))
          write (u, "(2x,A,1x,L1)") "EWA recoil       =", &
               var_list%get_lval (var_str ("?ewa_recoil"))
          write (u, "(2x,A,1x,L1)") "EWA energy cons. =", &
               var_list%get_lval (var_str ("ewa_keep_energy"))
       end if
       if (beams%contains ("circe1")) then
          write (u, "(2x,A,1x,I0)") "CIRCE1 version    =", &
               var_list%get_ival (var_str ("circe1_ver"))
          write (u, "(2x,A,1x,I0)") "CIRCE1 revision   =", &
               var_list%get_ival (var_str ("circe1_rev"))
          s = var_list%get_sval (var_str ("$circe1_acc"))
          write (u, "(2x,A,1x,A)") "CIRCE1 acceler.   =", char (s)
          write (u, "(2x,A,1x,I0)") "CIRCE1 chattin.   =", &
               var_list%get_ival (var_str ("circe1_chat"))
          write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 sqrts      =", &
               var_list%get_rval (var_str ("circe1_sqrts"))
          write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 epsil.     =", &
               var_list%get_rval (var_str ("circe1_eps"))
          write (u, "(2x,A,1x,L1)") "CIRCE1 phot. 1  =", &
               var_list%get_lval (var_str ("?circe1_photon1"))
          write (u, "(2x,A,1x,L1)") "CIRCE1 phot. 2  =", &
               var_list%get_lval (var_str ("?circe1_photon2"))
          write (u, "(2x,A,1x,L1)") "CIRCE1 generat. =", &
               var_list%get_lval (var_str ("?circe1_generate"))
          write (u, "(2x,A,1x,L1)") "CIRCE1 mapping  =", &
               var_list%get_lval (var_str ("?circe1_map"))
          write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 map. slope =", &
               var_list%get_rval (var_str ("circe1_mapping_slope"))
          write (u, "(2x,A,1x,L1)") "CIRCE recoil photon =", &
               var_list%get_lval (var_str ("?circe1_with_radiation"))
       end if
       if (beams%contains ("circe2")) then
          s = var_list%get_sval (var_str ("$circe2_design"))
          write (u, "(2x,A,1x,A)") "CIRCE2 design   =", char (s)
          s = var_list%get_sval (var_str ("$circe2_file"))
          write (u, "(2x,A,1x,A)") "CIRCE2 file     =", char (s)
          write (u, "(2x,A,1x,L1)") "CIRCE2 polarized =", &
               var_list%get_lval (var_str ("?circe2_polarized"))
       end if
       if (beams%contains ("gaussian")) then
          write (u, "(2x,A,1x," // FMT_12 // ")") "Gaussian spread 1    =", &
               var_list%get_rval (var_str ("gaussian_spread1"))
          write (u, "(2x,A,1x," // FMT_12 // ")") "Gaussian spread 2    =", &
               var_list%get_rval (var_str ("gaussian_spread2"))
       end if
       if (beams%contains ("beam_events")) then
          s = var_list%get_sval (var_str ("$beam_events_file"))
          write (u, "(2x,A,1x,A)") "Beam events file     =", char (s)
          write (u, "(2x,A,1x,L1)") "Beam events EOF warn =", &
               var_list%get_lval (var_str ("?beam_events_warn_eof"))
       end if
     end associate
   end subroutine rt_data_show_beams
 
 @ %def rt_data_show_beams
 @ Return the collision energy as determined by the current beam
 settings.  Without beam setup, this is the [[sqrts]] variable.
 
 If the value is meaningless for a setup, the function returns zero.
 <<RT data: rt data: TBP>>=
   procedure :: get_sqrts => rt_data_get_sqrts
 <<RT data: procedures>>=
   function rt_data_get_sqrts (rt_data) result (sqrts)
     class(rt_data_t), intent(in) :: rt_data
     real(default) :: sqrts
     sqrts = rt_data%var_list%get_rval (var_str ("sqrts"))
   end function rt_data_get_sqrts
 
 @ %def rt_data_get_sqrts
 @ For testing purposes, the [[rt_data_t]] contents can be pacified to
 suppress numerical fluctuations in (constant) test matrix elements.
 <<RT data: rt data: TBP>>=
   procedure :: pacify => rt_data_pacify
 <<RT data: procedures>>=
   subroutine rt_data_pacify (rt_data, efficiency_reset, error_reset)
     class(rt_data_t), intent(inout) :: rt_data
     logical, intent(in), optional :: efficiency_reset, error_reset
     type(process_entry_t), pointer :: process
     process => rt_data%process_stack%first
     do while (associated (process))
        call process%pacify (efficiency_reset, error_reset)
        process => process%next
     end do
   end subroutine rt_data_pacify
 
 @ %def rt_data_pacify
 @
 <<RT data: rt data: TBP>>=
   procedure :: set_event_callback => rt_data_set_event_callback
 <<RT data: procedures>>=
   subroutine rt_data_set_event_callback (global, callback)
     class(rt_data_t), intent(inout) :: global
     class(event_callback_t), intent(in) :: callback
     if (allocated (global%event_callback))  deallocate (global%event_callback)
     allocate (global%event_callback, source = callback)
   end subroutine rt_data_set_event_callback
 
 @ %def rt_data_set_event_callback
 @
 <<RT data: rt data: TBP>>=
   procedure :: has_event_callback => rt_data_has_event_callback
   procedure :: get_event_callback => rt_data_get_event_callback
 <<RT data: procedures>>=
   function rt_data_has_event_callback (global) result (flag)
     class(rt_data_t), intent(in) :: global
     logical :: flag
     flag = allocated (global%event_callback)
   end function rt_data_has_event_callback
 
   function rt_data_get_event_callback (global) result (callback)
     class(rt_data_t), intent(in) :: global
     class(event_callback_t), allocatable :: callback
     if (allocated (global%event_callback)) then
        allocate (callback, source = global%event_callback)
     end if
   end function rt_data_get_event_callback
 
 @ %def rt_data_has_event_callback
 @ %def rt_data_get_event_callback
 @ Force system-dependent objects to well-defined values.  Some of the
 variables are locked and therefore must be addressed directly.
 
 This is, of course, only required for testing purposes. In principle,
 the [[real_specimen]] variables could be set to their values in
 [[rt_data_t]], but this depends on the precision again, so we set
 them to some dummy values.
 <<RT data: public>>=
   public :: fix_system_dependencies
 <<RT data: procedures>>=
   subroutine fix_system_dependencies (global)
     class(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
 
     var_list => global%get_var_list_ptr ()
     call var_list%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true., force=.true.)
     call var_list%set_log (var_str ("?openmp_is_active"), &
          .false., is_known = .true., force=.true.)
     call var_list%set_int (var_str ("openmp_num_threads_default"), &
          1, is_known = .true., force=.true.)
     call var_list%set_int (var_str ("openmp_num_threads"), &
          1, is_known = .true., force=.true.)
     call var_list%set_int (var_str ("real_range"), &
          307, is_known = .true., force=.true.)
     call var_list%set_int (var_str ("real_precision"), &
          15, is_known = .true., force=.true.)
     call var_list%set_real (var_str ("real_epsilon"), &
          1.e-16_default, is_known = .true., force=.true.)
     call var_list%set_real (var_str ("real_tiny"), &
          1.e-300_default, is_known = .true., force=.true.)
 
     global%os_data%fc = "Fortran-compiler"
     global%os_data%fcflags = "Fortran-flags"
 
   end subroutine fix_system_dependencies
 
 @ %def fix_system_dependencies
 @
 <<RT data: public>>=
   public :: show_description_of_string
 <<RT data: procedures>>=
   subroutine show_description_of_string (string)
     type(string_t), intent(in) :: string
     type(rt_data_t), target :: global
     call global%global_init ()
     call global%show_description_of_string (string, ascii_output=.true.)
   end subroutine show_description_of_string
 
 @ %def show_description_of_string
 @
 <<RT data: public>>=
   public :: show_tex_descriptions
 <<RT data: procedures>>=
   subroutine show_tex_descriptions ()
     type(rt_data_t), target :: global
     call global%global_init ()
     call fix_system_dependencies (global)
     call global%set_int (var_str ("seed"), 0, is_known=.true.)
     call global%var_list%sort ()
     call global%write_var_descriptions ()
   end subroutine show_tex_descriptions
 
 @ %def show_tex_descriptions
 @
 \subsection{Unit Tests}
 Test module, followed by the corresponding implementation module.
 <<[[rt_data_ut.f90]]>>=
 <<File header>>
 
 module rt_data_ut
   use unit_tests
   use rt_data_uti
 
 <<Standard module head>>
 
 <<RT data: public test>>
 
 contains
 
 <<RT data: test driver>>
 
 end module rt_data_ut
 @ %def rt_data_ut
 @
 <<[[rt_data_uti.f90]]>>=
 <<File header>>
 
 module rt_data_uti
 
 <<Use kinds>>
 <<Use strings>>
   use format_defs, only: FMT_19
   use ifiles
   use lexers
   use parser
   use flavors
   use variables, only: var_list_t, var_entry_t, var_entry_init_int
   use eval_trees
   use models
   use prclib_stacks
 
   use rt_data
 
 <<Standard module head>>
 
 <<RT data: test declarations>>
 
 contains
 
 <<RT data: test auxiliary>>
 
 <<RT data: tests>>
 
 end module rt_data_uti
 @ %def rt_data_ut
 @ API: driver for the unit tests below.
 <<RT data: public test>>=
   public :: rt_data_test
 <<RT data: test driver>>=
   subroutine rt_data_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<RT data: execute tests>>
   end subroutine rt_data_test
 
 @ %def rt_data_test
 @
 \subsubsection{Initial content}
 @
 Display the RT data in the state just after (global) initialization.
 <<RT data: execute tests>>=
   call test (rt_data_1, "rt_data_1", &
        "initialize", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_1
 <<RT data: tests>>=
   subroutine rt_data_1 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: rt_data_1"
     write (u, "(A)")  "*   Purpose: initialize global runtime data"
     write (u, "(A)")
 
     call global%global_init (logfile = var_str ("rt_data.log"))
     call fix_system_dependencies (global)
 
     call global%set_int (var_str ("seed"), 0, is_known=.true.)
 
     call global%it_list%init ([2, 3], [5000, 20000])
 
     call global%write (u)
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_1"
 
   end subroutine rt_data_1
 
 @ %def rt_data_1
 @
 \subsubsection{Fill values}
 Fill in empty slots in the runtime data block.
 <<RT data: execute tests>>=
   call test (rt_data_2, "rt_data_2", &
        "fill", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_2
 <<RT data: tests>>=
   subroutine rt_data_2 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(flavor_t), dimension(2) :: flv
     type(string_t) :: cut_expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: parse_tree
 
     write (u, "(A)")  "* Test output: rt_data_2"
     write (u, "(A)")  "*   Purpose: initialize global runtime data &
          &and fill contents"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call fix_system_dependencies (global)
 
     call global%select_model (var_str ("Test"))
 
     call global%set_real (var_str ("sqrts"), &
          1000._default, is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
     call flv%init ([25,25], global%model)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("run1"), is_known = .true.)
     call global%set_real (var_str ("luminosity"), &
          33._default, is_known = .true.)
 
     call syntax_pexpr_init ()
     cut_expr_text = "all Pt > 100 [s]"
     call ifile_append (ifile, cut_expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (parse_tree, stream, .true.)
     global%pn%cuts_lexpr => parse_tree%get_root_ptr ()
 
     allocate (global%sample_fmt (2))
     global%sample_fmt(1) = "foo_fmt"
     global%sample_fmt(2) = "bar_fmt"
 
     call global%write (u)
 
     call parse_tree_final (parse_tree)
     call stream_final (stream)
     call ifile_final (ifile)
     call syntax_pexpr_final ()
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_2"
 
   end subroutine rt_data_2
 
 @ %def rt_data_2
 @
 \subsubsection{Save and restore}
 Set up a local runtime data block, change some contents, restore the
 global block.
 <<RT data: execute tests>>=
   call test (rt_data_3, "rt_data_3", &
        "save/restore", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_3
 <<RT data: tests>>=
   subroutine rt_data_3 (u)
     use event_base, only: event_callback_nop_t
     integer, intent(in) :: u
     type(rt_data_t), target :: global, local
     type(flavor_t), dimension(2) :: flv
     type(string_t) :: cut_expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: parse_tree
     type(prclib_entry_t), pointer :: lib
     type(event_callback_nop_t) :: event_callback_nop
 
     write (u, "(A)")  "* Test output: rt_data_3"
     write (u, "(A)")  "*   Purpose: initialize global runtime data &
          &and fill contents;"
     write (u, "(A)")  "*            copy to local block and back"
     write (u, "(A)")
 
     write (u, "(A)")  "* Init global data"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call fix_system_dependencies (global)
 
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%select_model (var_str ("Test"))
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call flv%init ([25,25], global%model)
 
     call global%beam_structure%init_sf (flv%get_name (), [1])
     call global%beam_structure%set_sf (1, 1, var_str ("pdf_builtin"))
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("run1"), is_known = .true.)
     call global%set_real (var_str ("luminosity"), &
          33._default, is_known = .true.)
 
     call syntax_pexpr_init ()
     cut_expr_text = "all Pt > 100 [s]"
     call ifile_append (ifile, cut_expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (parse_tree, stream, .true.)
     global%pn%cuts_lexpr => parse_tree%get_root_ptr ()
 
     allocate (global%sample_fmt (2))
     global%sample_fmt(1) = "foo_fmt"
     global%sample_fmt(2) = "bar_fmt"
 
     allocate (lib)
     call lib%init (var_str ("library_1"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "* Init and modify local data"
     write (u, "(A)")
 
     call local%local_init (global)
     call local%append_string (var_str ("$integration_method"), intrinsic=.true.)
     call local%append_string (var_str ("$phs_method"), intrinsic=.true.)
 
     call local%activate ()
 
     write (u, "(1x,A,L1)")  "model associated   = ", associated (local%model)
     write (u, "(1x,A,L1)")  "library associated = ", associated (local%prclib)
     write (u, *)
 
     call local%model_set_real (var_str ("ms"), 150._default)
     call local%set_string (var_str ("$integration_method"), &
          var_str ("midpoint"), is_known = .true.)
     call local%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
 
     local%os_data%fc = "Local compiler"
 
     allocate (lib)
     call lib%init (var_str ("library_2"))
     call local%add_prclib (lib)
 
     call local%set_event_callback (event_callback_nop)
 
     call local%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Restore global data"
     write (u, "(A)")
 
     call local%deactivate (global)
 
     write (u, "(1x,A,L1)")  "model associated   = ", associated (global%model)
     write (u, "(1x,A,L1)")  "library associated = ", associated (global%prclib)
     write (u, *)
 
     call global%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call parse_tree_final (parse_tree)
     call stream_final (stream)
     call ifile_final (ifile)
     call syntax_pexpr_final ()
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_3"
 
   end subroutine rt_data_3
 
 @ %def rt_data_3
 @
 \subsubsection{Show variables}
 Display selected variables in the global record.
 <<RT data: execute tests>>=
   call test (rt_data_4, "rt_data_4", &
        "show variables", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_4
 <<RT data: tests>>=
   subroutine rt_data_4 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     type(string_t), dimension(0) :: empty_string_array
 
     write (u, "(A)")  "* Test output: rt_data_4"
     write (u, "(A)")  "*   Purpose: display selected variables"
     write (u, "(A)")
 
     call global%global_init ()
 
     write (u, "(A)")  "* No variables:"
     write (u, "(A)")
 
     call global%write_vars (u, empty_string_array)
 
     write (u, "(A)")  "* Two variables:"
     write (u, "(A)")
 
     call global%write_vars (u, &
          [var_str ("?unweighted"), var_str ("$phs_method")])
 
     write (u, "(A)")
     write (u, "(A)")  "* Display whole record with selected variables"
     write (u, "(A)")
 
     call global%write (u, &
          vars = [var_str ("?unweighted"), var_str ("$phs_method")])
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_4"
 
   end subroutine rt_data_4
 
 @ %def rt_data_4
 @
 \subsubsection{Show parts}
 Display only selected parts in the state just after (global) initialization.
 <<RT data: execute tests>>=
   call test (rt_data_5, "rt_data_5", &
        "show parts", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_5
 <<RT data: tests>>=
   subroutine rt_data_5 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: rt_data_5"
     write (u, "(A)")  "*   Purpose: display parts of rt data"
     write (u, "(A)")
 
     call global%global_init ()
     call global%write_libraries (u)
 
     write (u, "(A)")
 
     call global%write_beams (u)
 
     write (u, "(A)")
 
     call global%write_process_stack (u)
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_5"
 
   end subroutine rt_data_5
 
 @ %def rt_data_5
 @
 \subsubsection{Local Model}
 Locally modify a model and restore the global one.  We need an auxiliary
 function to determine the status of a model particle:
 <<RT data: test auxiliary>>=
   function is_stable (pdg, global) result (flag)
     integer, intent(in) :: pdg
     type(rt_data_t), intent(in) :: global
     logical :: flag
     type(flavor_t) :: flv
     call flv%init (pdg, global%model)
     flag = flv%is_stable ()
   end function is_stable
 
   function is_polarized (pdg, global) result (flag)
     integer, intent(in) :: pdg
     type(rt_data_t), intent(in) :: global
     logical :: flag
     type(flavor_t) :: flv
     call flv%init (pdg, global%model)
     flag = flv%is_polarized ()
   end function is_polarized
 
 @ %def is_stable is_polarized
 <<RT data: execute tests>>=
   call test (rt_data_6, "rt_data_6", &
        "local model", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_6
 <<RT data: tests>>=
   subroutine rt_data_6 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global, local
     type(var_list_t), pointer :: model_vars
     type(string_t) :: var_name
 
     write (u, "(A)")  "* Test output: rt_data_6"
     write (u, "(A)")  "*   Purpose: apply and keep local modifications to model"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%select_model (var_str ("Test"))
 
     write (u, "(A)")  "* Original model"
     write (u, "(A)")
 
     call global%write_model_list (u)
     write (u, *)
     write (u, "(A,L1)")  "s is stable    = ", is_stable (25, global)
     write (u, "(A,L1)")  "f is polarized = ", is_polarized (6, global)
 
     write (u, *)
 
     var_name = "ff"
 
     write (u, "(A)", advance="no")  "Global model variable: "
     model_vars => global%model%get_var_list_ptr ()
     call model_vars%write_var (var_name, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Apply local modifications: unstable"
     write (u, "(A)")
 
     call local%local_init (global)
     call local%activate ()
 
     call local%model_set_real (var_name, 0.4_default)
     call local%modify_particle (25, stable = .false., decay = [var_str ("d1")])
     call local%modify_particle (6, stable = .false., &
          decay = [var_str ("f1")], isotropic_decay = .true.)
     call local%modify_particle (-6, stable = .false., &
          decay = [var_str ("f2"), var_str ("f3")], diagonal_decay = .true.)
 
     call local%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Further modifications"
     write (u, "(A)")
 
     call local%modify_particle (6, stable = .false., &
          decay = [var_str ("f1")], &
          diagonal_decay = .true., isotropic_decay = .false.)
     call local%modify_particle (-6, stable = .false., &
          decay = [var_str ("f2"), var_str ("f3")], &
          diagonal_decay = .false., isotropic_decay = .true.)
     call local%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Further modifications: f stable but polarized"
     write (u, "(A)")
 
     call local%modify_particle (6, stable = .true., polarized = .true.)
     call local%modify_particle (-6, stable = .true.)
     call local%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Global model"
     write (u, "(A)")
 
     call global%model%write (u)
     write (u, *)
     write (u, "(A,L1)")  "s is stable    = ", is_stable (25, global)
     write (u, "(A,L1)")  "f is polarized = ", is_polarized (6, global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Local model"
     write (u, "(A)")
 
     call local%model%write (u)
     write (u, *)
     write (u, "(A,L1)")  "s is stable    = ", is_stable (25, local)
     write (u, "(A,L1)")  "f is polarized = ", is_polarized (6, local)
 
     write (u, *)
 
     write (u, "(A)", advance="no")  "Global model variable: "
     model_vars => global%model%get_var_list_ptr ()
     call model_vars%write_var (var_name, u)
 
     write (u, "(A)", advance="no")  "Local model variable: "
     associate (model_var_list_ptr => local%model%get_var_list_ptr())
        call model_var_list_ptr%write_var (var_name, u)
     end associate
 
     write (u, "(A)")
     write (u, "(A)")  "* Restore global"
 
     call local%deactivate (global, keep_local = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Global model"
     write (u, "(A)")
 
     call global%model%write (u)
     write (u, *)
     write (u, "(A,L1)")  "s is stable    = ", is_stable (25, global)
     write (u, "(A,L1)")  "f is polarized = ", is_polarized (6, global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Local model"
     write (u, "(A)")
 
     call local%model%write (u)
     write (u, *)
     write (u, "(A,L1)")  "s is stable    = ", is_stable (25, local)
     write (u, "(A,L1)")  "f is polarized = ", is_polarized (6, local)
 
     write (u, *)
 
     write (u, "(A)", advance="no")  "Global model variable: "
     model_vars => global%model%get_var_list_ptr ()
     call model_vars%write_var (var_name, u)
 
     write (u, "(A)", advance="no")  "Local model variable: "
     associate (model_var_list_ptr => local%model%get_var_list_ptr())
        call model_var_list_ptr%write_var (var_name, u)
     end associate
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call local%model%final ()
     deallocate (local%model)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_6"
 
   end subroutine rt_data_6
 
 @ %def rt_data_6
 @
 \subsubsection{Result variables}
 Initialize result variables and check that they are accessible via the
 global variable list.
 <<RT data: execute tests>>=
   call test (rt_data_7, "rt_data_7", &
        "result variables", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_7
 <<RT data: tests>>=
   subroutine rt_data_7 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: rt_data_7"
     write (u, "(A)")  "*   Purpose: set and access result variables"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process variables"
     write (u, "(A)")
 
     call global%global_init ()
     call global%process_stack%init_result_vars (var_str ("testproc"))
 
     call global%var_list%write_var (&
          var_str ("integral(testproc)"), u, defined=.true.)
     call global%var_list%write_var (&
          var_str ("error(testproc)"), u, defined=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_7"
 
   end subroutine rt_data_7
 
 @ %def rt_data_7
 @
 \subsubsection{Beam energy}
 If beam parameters are set, the variable [[sqrts]] is not necessarily
 the collision energy.  The method [[get_sqrts]] fetches the correct value.
 <<RT data: execute tests>>=
   call test (rt_data_8, "rt_data_8", &
        "beam energy", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_8
 <<RT data: tests>>=
   subroutine rt_data_8 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: rt_data_8"
     write (u, "(A)")  "*   Purpose: get correct collision energy"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     call global%global_init ()
 
     write (u, "(A)")  "* Set sqrts"
     write (u, "(A)")
 
     call global%set_real (var_str ("sqrts"), &
          1000._default, is_known = .true.)
     write (u, "(1x,A," // FMT_19 // ")")  "sqrts =", global%get_sqrts ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_8"
 
   end subroutine rt_data_8
 
 @ %def rt_data_8
 @
 \subsubsection{Local variable modifications}
 <<RT data: execute tests>>=
   call test (rt_data_9, "rt_data_9", &
        "local variables", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_9
 <<RT data: tests>>=
   subroutine rt_data_9 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global, local
     type(var_list_t), pointer :: var_list
 
     write (u, "(A)")  "* Test output: rt_data_9"
     write (u, "(A)")  "*   Purpose: handle local variables"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     write (u, "(A)")  "* Initialize global record and set some variables"
     write (u, "(A)")
 
     call global%global_init ()
     call global%select_model (var_str ("Test"))
 
     call global%set_real (var_str ("sqrts"), 17._default, is_known = .true.)
     call global%set_real (var_str ("luminosity"), 2._default, is_known = .true.)
     call global%model_set_real (var_str ("ff"), 0.5_default)
     call global%model_set_real (var_str ("gy"), 1.2_default)
 
     var_list => global%get_var_list_ptr ()
 
     call var_list%write_var (var_str ("sqrts"), u, defined=.true.)
     call var_list%write_var (var_str ("luminosity"), u, defined=.true.)
     call var_list%write_var (var_str ("ff"), u, defined=.true.)
     call var_list%write_var (var_str ("gy"), u, defined=.true.)
     call var_list%write_var (var_str ("mf"), u, defined=.true.)
     call var_list%write_var (var_str ("x"), u, defined=.true.)
 
     write (u, "(A)")
 
     write (u, "(1x,A,1x,F5.2)")  "sqrts      = ", &
          global%get_rval (var_str ("sqrts"))
     write (u, "(1x,A,1x,F5.2)")  "luminosity = ", &
          global%get_rval (var_str ("luminosity"))
     write (u, "(1x,A,1x,F5.2)")  "ff         = ", &
          global%get_rval (var_str ("ff"))
     write (u, "(1x,A,1x,F5.2)")  "gy         = ", &
          global%get_rval (var_str ("gy"))
     write (u, "(1x,A,1x,F5.2)")  "mf         = ", &
          global%get_rval (var_str ("mf"))
     write (u, "(1x,A,1x,F5.2)")  "x          = ", &
          global%get_rval (var_str ("x"))
 
     write (u, "(A)")
     write (u, "(A)")  "* Create local record with local variables"
     write (u, "(A)")
 
     call local%local_init (global)
 
     call local%append_real (var_str ("luminosity"), intrinsic = .true.)
     call local%append_real (var_str ("x"), user = .true.)
 
     call local%activate ()
 
     var_list => local%get_var_list_ptr ()
 
     call var_list%write_var (var_str ("sqrts"), u)
     call var_list%write_var (var_str ("luminosity"), u)
     call var_list%write_var (var_str ("ff"), u)
     call var_list%write_var (var_str ("gy"), u)
     call var_list%write_var (var_str ("mf"), u)
     call var_list%write_var (var_str ("x"), u, defined=.true.)
 
     write (u, "(A)")
 
     write (u, "(1x,A,1x,F5.2)")  "sqrts      = ", &
          local%get_rval (var_str ("sqrts"))
     write (u, "(1x,A,1x,F5.2)")  "luminosity = ", &
          local%get_rval (var_str ("luminosity"))
     write (u, "(1x,A,1x,F5.2)")  "ff         = ", &
          local%get_rval (var_str ("ff"))
     write (u, "(1x,A,1x,F5.2)")  "gy         = ", &
          local%get_rval (var_str ("gy"))
     write (u, "(1x,A,1x,F5.2)")  "mf         = ", &
          local%get_rval (var_str ("mf"))
     write (u, "(1x,A,1x,F5.2)")  "x          = ", &
          local%get_rval (var_str ("x"))
 
     write (u, "(A)")
     write (u, "(A)")  "* Modify some local variables"
     write (u, "(A)")
 
     call local%set_real (var_str ("luminosity"), 42._default, is_known=.true.)
     call local%set_real (var_str ("x"), 6.66_default, is_known=.true.)
     call local%model_set_real (var_str ("ff"), 0.7_default)
 
     var_list => local%get_var_list_ptr ()
 
     call var_list%write_var (var_str ("sqrts"), u)
     call var_list%write_var (var_str ("luminosity"), u)
     call var_list%write_var (var_str ("ff"), u)
     call var_list%write_var (var_str ("gy"), u)
     call var_list%write_var (var_str ("mf"), u)
     call var_list%write_var (var_str ("x"), u, defined=.true.)
 
     write (u, "(A)")
 
     write (u, "(1x,A,1x,F5.2)")  "sqrts      = ", &
          local%get_rval (var_str ("sqrts"))
     write (u, "(1x,A,1x,F5.2)")  "luminosity = ", &
          local%get_rval (var_str ("luminosity"))
     write (u, "(1x,A,1x,F5.2)")  "ff         = ", &
          local%get_rval (var_str ("ff"))
     write (u, "(1x,A,1x,F5.2)")  "gy         = ", &
          local%get_rval (var_str ("gy"))
     write (u, "(1x,A,1x,F5.2)")  "mf         = ", &
          local%get_rval (var_str ("mf"))
     write (u, "(1x,A,1x,F5.2)")  "x          = ", &
          local%get_rval (var_str ("x"))
 
     write (u, "(A)")
     write (u, "(A)")  "* Restore globals"
     write (u, "(A)")
 
     call local%deactivate (global)
 
     var_list => global%get_var_list_ptr ()
 
     call var_list%write_var (var_str ("sqrts"), u)
     call var_list%write_var (var_str ("luminosity"), u)
     call var_list%write_var (var_str ("ff"), u)
     call var_list%write_var (var_str ("gy"), u)
     call var_list%write_var (var_str ("mf"), u)
     call var_list%write_var (var_str ("x"), u, defined=.true.)
 
     write (u, "(A)")
 
     write (u, "(1x,A,1x,F5.2)")  "sqrts      = ", &
          global%get_rval (var_str ("sqrts"))
     write (u, "(1x,A,1x,F5.2)")  "luminosity = ", &
          global%get_rval (var_str ("luminosity"))
     write (u, "(1x,A,1x,F5.2)")  "ff         = ", &
          global%get_rval (var_str ("ff"))
     write (u, "(1x,A,1x,F5.2)")  "gy         = ", &
          global%get_rval (var_str ("gy"))
     write (u, "(1x,A,1x,F5.2)")  "mf         = ", &
          global%get_rval (var_str ("mf"))
     write (u, "(1x,A,1x,F5.2)")  "x          = ", &
          global%get_rval (var_str ("x"))
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call local%local_final ()
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_9"
 
   end subroutine rt_data_9
 
 @ %def rt_data_9
 @
 \subsubsection{Descriptions}
 <<RT data: execute tests>>=
   call test(rt_data_10, "rt_data_10", &
             "descriptions", u, results)
 <<RT data: test declarations>>=
   public :: rt_data_10
 <<RT data: tests>>=
   subroutine rt_data_10 (u)
     integer, intent(in) :: u
     type(rt_data_t) :: global
     ! type(var_list_t) :: var_list
     write (u, "(A)")  "* Test output: rt_data_10"
     write (u, "(A)")  "*   Purpose: display descriptions"
     write (u, "(A)")
 
     call global%var_list%append_real (var_str ("sqrts"), &
           intrinsic=.true., &
           description=var_str ('Real variable in order to set the center-of-mass ' // &
           'energy for the collisions.'))
     call global%var_list%append_real (var_str ("luminosity"), 0._default, &
           intrinsic=.true., &
           description=var_str ('This specifier \ttt{luminosity = {\em ' // &
           '<num>}} sets the integrated luminosity (in inverse femtobarns, ' // &
           'fb${}^{-1}$) for the event generation of the processes in the ' // &
           '\sindarin\ input files.'))
     call global%var_list%append_int (var_str ("seed"), 1234, &
           intrinsic=.true., &
           description=var_str ('Integer variable \ttt{seed = {\em <num>}} ' // &
           'that allows to set a specific random seed \ttt{num}.'))
     call global%var_list%append_string (var_str ("$method"), var_str ("omega"), &
          intrinsic=.true., &
          description=var_str ('This string variable specifies the method ' // &
          'for the matrix elements to be used in the evaluation.'))
     call global%var_list%append_log (var_str ("?read_color_factors"), .true., &
           intrinsic=.true., &
           description=var_str ('This flag decides whether to read QCD ' // &
           'color factors from the matrix element provided by each method, ' // &
           'or to try and calculate the color factors in \whizard\ internally.'))
 
     call global%var_list%sort ()
 
     call global%write_var_descriptions (u)
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_10"
   end subroutine rt_data_10
 
 @ %def rt_data_10
 @
 \subsubsection{Export objects}
 Export objects are variables or other data that should be copied or otherwise
 applied to corresponding objects in the outer scope.
 
 We test appending and retrieval for the export list.
 <<RT data: execute tests>>=
   call test(rt_data_11, "rt_data_11", &
             "export objects", u, results)
 <<RT data: test declarations>>=
   public :: rt_data_11
 <<RT data: tests>>=
   subroutine rt_data_11 (u)
     integer, intent(in) :: u
     type(rt_data_t) :: global
     type(string_t), dimension(:), allocatable :: exports
     integer :: i
 
     write (u, "(A)")  "* Test output: rt_data_11"
     write (u, "(A)")  "*   Purpose: handle export object list"
     write (u, "(A)")
 
     write (u, "(A)")  "* Empty export list"
     write (u, "(A)")
 
     call global%write_exports (u)
 
     write (u, "(A)")  "* Add an entry"
     write (u, "(A)")
 
     allocate (exports (1))
     exports(1) = var_str ("results")
     do i = 1, size (exports)
        write (u, "('+ ',A)")  char (exports(i))
     end do
     write (u, *)
 
     call global%append_exports (exports)
     call global%write_exports (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Add more entries, including doubler"
     write (u, "(A)")
 
     deallocate (exports)
     allocate (exports (3))
     exports(1) = var_str ("foo")
     exports(2) = var_str ("results")
     exports(3) = var_str ("bar")
     do i = 1, size (exports)
        write (u, "('+ ',A)")  char (exports(i))
     end do
     write (u, *)
 
     call global%append_exports (exports)
     call global%write_exports (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_11"
   end subroutine rt_data_11
 
 @ %def rt_data_11
 @
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Select implementations}
 For abstract types (process core, integrator, phase space, etc.), we need a
 way to dynamically select a concrete type, using either data given by the user
 or a previous selection of a concrete type.  This is done by subroutines in
 the current module.
 
 We would like to put this in the [[me_methods]] folder but it also
 depends on [[gosam]] and [[openloops]], so it is unclear where to put
 it.
 <<[[dispatch_me_methods.f90]]>>=
 <<File header>>
 
 module dispatch_me_methods
 
 <<Use strings>>
 <<Use debug>>
   use physics_defs, only: BORN
   use diagnostics
   use sm_qcd
   use variables, only: var_list_t
   use models
   use model_data
 
   use prc_core_def
   use prc_core
   use prc_test_core
   use prc_template_me
   use prc_test
   use prc_omega
   use prc_external
   use prc_gosam
   use prc_openloops
   use prc_recola
   use prc_threshold
 
 <<Standard module head>>
 
 <<Dispatch me methods: public>>
 
 contains
 
 <<Dispatch me methods: procedures>>
 
 end module dispatch_me_methods
 @ %def dispatch_me_methods
 @
 \subsection{Process Core Definition}
 The [[prc_core_def_t]] abstract type can be instantiated by providing a
 [[$method]] string variable.
 <<Dispatch me methods: public>>=
   public :: dispatch_core_def
 <<Dispatch me methods: procedures>>=
   subroutine dispatch_core_def (core_def, prt_in, prt_out, &
        model, var_list, id, nlo_type, method)
     class(prc_core_def_t), allocatable, intent(out) :: core_def
     type(string_t), dimension(:), intent(in) :: prt_in
     type(string_t), dimension(:), intent(in) :: prt_out
     type(model_t), pointer, intent(in) :: model
     type(var_list_t), intent(in) :: var_list
     type(string_t), intent(in), optional :: id
     integer, intent(in), optional :: nlo_type
     type(string_t), intent(in), optional :: method
     type(string_t) :: model_name, meth
     type(string_t) :: ufo_path
     type(string_t) :: restrictions
     logical :: ufo
     logical :: cms_scheme
     logical :: openmp_support
     logical :: report_progress
     logical :: diags, diags_color
     logical :: write_phs_output
     type(string_t) :: extra_options, correction_type
     integer :: nlo
     integer :: alpha_power
     integer :: alphas_power
     if (present (method)) then
        meth = method
     else
        meth = var_list%get_sval (var_str ("$method"))
     end if
     if (debug_on) call msg_debug2 (D_CORE, "dispatch_core_def")
     if (associated (model)) then
        model_name = model%get_name ()
        cms_scheme = model%get_scheme () == "Complex_Mass_Scheme"
        ufo = model%is_ufo_model ()
        ufo_path = model%get_ufo_path ()
     else
        model_name = ""
        cms_scheme = .false.
        ufo = .false.
     end if
     restrictions = var_list%get_sval (&
          var_str ("$restrictions"))
     diags = var_list%get_lval (&
          var_str ("?vis_diags"))
     diags_color = var_list%get_lval (&
          var_str ("?vis_diags_color"))
     openmp_support = var_list%get_lval (&
          var_str ("?omega_openmp"))
     report_progress = var_list%get_lval (&
          var_str ("?report_progress"))
     write_phs_output = var_list%get_lval (&
          var_str ("?omega_write_phs_output"))
     extra_options = var_list%get_sval (&
          var_str ("$omega_flags"))
     nlo = BORN;  if (present (nlo_type))  nlo = nlo_type
     alpha_power = var_list%get_ival (var_str ("alpha_power"))
     alphas_power = var_list%get_ival (var_str ("alphas_power"))
     correction_type = var_list%get_sval (var_str ("$nlo_correction_type"))
     if (debug_on) call msg_debug2 (D_CORE, "dispatching core method: ", meth)
     select case (char (meth))
     case ("unit_test")
        allocate (prc_test_def_t :: core_def)
        select type (core_def)
        type is (prc_test_def_t)
           call core_def%init (model_name, prt_in, prt_out)
        end select
     case ("template")
        allocate (template_me_def_t :: core_def)
        select type (core_def)
        type is (template_me_def_t)
           call core_def%init (model, prt_in, prt_out, unity = .false.)
        end select
     case ("template_unity")
        allocate (template_me_def_t :: core_def)
        select type (core_def)
        type is (template_me_def_t)
           call core_def%init (model, prt_in, prt_out, unity = .true.)
        end select
     case ("omega")
        allocate (omega_def_t :: core_def)
        select type (core_def)
        type is (omega_def_t)
           call core_def%init (model_name, prt_in, prt_out, &
                .false., ufo, ufo_path, &
                restrictions, cms_scheme, &
                openmp_support, report_progress, write_phs_output, &
                extra_options, diags, diags_color)
        end select
     case ("ovm")
        allocate (omega_def_t :: core_def)
        select type (core_def)
        type is (omega_def_t)
           call core_def%init (model_name, prt_in, prt_out, &
                .true., .false., var_str (""), &
                restrictions, cms_scheme, &
                openmp_support, report_progress, write_phs_output, &
                extra_options, diags, diags_color)
        end select
     case ("gosam")
       allocate (gosam_def_t :: core_def)
       select type (core_def)
       type is (gosam_def_t)
         if (present (id)) then
            call core_def%init (id, model_name, prt_in, &
                 prt_out, nlo, restrictions, var_list)
         else
            call msg_fatal ("Dispatch GoSam def: No id!")
         end if
       end select
     case ("openloops")
        allocate (openloops_def_t :: core_def)
        select type (core_def)
        type is (openloops_def_t)
           if (present (id)) then
              call core_def%init (id, model_name, prt_in, &
                   prt_out, nlo, restrictions, var_list)
           else
              call msg_fatal ("Dispatch OpenLoops def: No id!")
           end if
        end select
     case ("recola")
        call abort_if_recola_not_active ()
        allocate (recola_def_t :: core_def)
        select type (core_def)
        type is (recola_def_t)
           if (present (id)) then
              call core_def%init (id, model_name, prt_in, prt_out, &
                   nlo, alpha_power, alphas_power, correction_type, &
                   restrictions)
           else
              call msg_fatal ("Dispatch RECOLA def: No id!")
           end if
        end select
     case ("dummy")
        allocate (prc_external_test_def_t :: core_def)
        select type (core_def)
        type is (prc_external_test_def_t)
           if (present (id)) then
              call core_def%init (id, model_name, prt_in, prt_out)
           else
              call msg_fatal ("Dispatch User-Defined Test def: No id!")
           end if
        end select
     case ("threshold")
        allocate (threshold_def_t :: core_def)
        select type (core_def)
        type is (threshold_def_t)
           if (present (id)) then
              call core_def%init (id, model_name, prt_in, prt_out, &
                   nlo, restrictions)
           else
              call msg_fatal ("Dispatch Threshold def: No id!")
           end if
        end select
     case default
        call msg_fatal ("Process configuration: method '" &
             // char (meth) // "' not implemented")
     end select
   end subroutine dispatch_core_def
 
 @ %def dispatch_core_def
 @
 \subsection{Process core allocation}
 Here we allocate an object of abstract type [[prc_core_t]] with a concrete
 type that matches a process definition.  The [[prc_omega_t]] extension
 will require the current parameter set, so we take the opportunity to
 grab it from the model.
 <<Dispatch me methods: public>>=
   public :: dispatch_core
 <<Dispatch me methods: procedures>>=
   subroutine dispatch_core (core, core_def, model, &
        helicity_selection, qcd, use_color_factors, has_beam_pol)
     class(prc_core_t), allocatable, intent(inout) :: core
     class(prc_core_def_t), intent(in) :: core_def
     class(model_data_t), intent(in), target, optional :: model
     type(helicity_selection_t), intent(in), optional :: helicity_selection
     type(qcd_t), intent(in), optional :: qcd
     logical, intent(in), optional :: use_color_factors
     logical, intent(in), optional :: has_beam_pol
     select type (core_def)
     type is (prc_test_def_t)
        allocate (test_t :: core)
     type is (template_me_def_t)
        allocate (prc_template_me_t :: core)
        select type (core)
        type is (prc_template_me_t)
           call core%set_parameters (model)
        end select
     class is (omega_def_t)
        if (.not. allocated (core)) allocate (prc_omega_t :: core)
        select type (core)
        type is (prc_omega_t)
           call core%set_parameters (model, &
                helicity_selection, qcd, use_color_factors)
        end select
     type is (gosam_def_t)
       if (.not. allocated (core)) allocate (prc_gosam_t :: core)
       select type (core)
       type is (prc_gosam_t)
         call core%set_parameters (qcd)
       end select
     type is (openloops_def_t)
       if (.not. allocated (core)) allocate (prc_openloops_t :: core)
       select type (core)
       type is (prc_openloops_t)
          call core%set_parameters (qcd)
       end select
     type is (recola_def_t)
       if (.not. allocated (core)) allocate (prc_recola_t :: core)
       select type (core)
       type is (prc_recola_t)
          call core%set_parameters (qcd, model)
       end select
     type is (prc_external_test_def_t)
       if (.not. allocated (core)) allocate (prc_external_test_t :: core)
       select type (core)
       type is (prc_external_test_t)
          call core%set_parameters (qcd, model)
       end select
     type is (threshold_def_t)
       if (.not. allocated (core)) allocate (prc_threshold_t :: core)
       select type (core)
       type is (prc_threshold_t)
          call core%set_parameters (qcd, model)
          call core%set_beam_pol (has_beam_pol)
       end select
     class default
        call msg_bug ("Process core: unexpected process definition type")
     end select
   end subroutine dispatch_core
 
 @ %def dispatch_core
 @
 \subsection{Process core update and restoration}
 Here we take an existing object of abstract type [[prc_core_t]] and
 update the parameters as given by the current state of [[model]].
 Optionally, we can save the previous state as [[saved_core]].  The
 second routine restores the original from the save.
 
 (In the test case, there is no possible update.)
 <<Dispatch me methods: public>>=
   public :: dispatch_core_update
   public :: dispatch_core_restore
 <<Dispatch me methods: procedures>>=
   subroutine dispatch_core_update &
        (core, model, helicity_selection, qcd, saved_core)
 
     class(prc_core_t), allocatable, intent(inout) :: core
     class(model_data_t), intent(in), optional, target :: model
     type(helicity_selection_t), intent(in), optional :: helicity_selection
     type(qcd_t), intent(in), optional :: qcd
     class(prc_core_t), allocatable, intent(inout), optional :: saved_core
 
     if (present (saved_core)) then
        allocate (saved_core, source = core)
     end if
     select type (core)
     type is (test_t)
     type is (prc_omega_t)
        call core%set_parameters (model, helicity_selection, qcd)
        call core%activate_parameters ()
     class is (prc_external_t)
       call msg_message ("Updating user defined cores is not implemented yet.")
     class default
        call msg_bug ("Process core update: unexpected process definition type")
     end select
   end subroutine dispatch_core_update
 
   subroutine dispatch_core_restore (core, saved_core)
 
     class(prc_core_t), allocatable, intent(inout) :: core
     class(prc_core_t), allocatable, intent(inout) :: saved_core
 
     call move_alloc (from = saved_core, to = core)
     select type (core)
     type is (test_t)
     type is (prc_omega_t)
        call core%activate_parameters ()
     class default
        call msg_bug ("Process core restore: unexpected process definition type")
     end select
   end subroutine dispatch_core_restore
 
 @ %def dispatch_core_update dispatch_core_restore
 @
 \subsection{Unit Tests}
 Test module, followed by the corresponding implementation module.
 <<[[dispatch_ut.f90]]>>=
 <<File header>>
 
 module dispatch_ut
   use unit_tests
   use dispatch_uti
 
 <<Standard module head>>
 
 <<Dispatch: public test>>
 
 <<Dispatch: public test auxiliary>>
 
 contains
 
 <<Dispatch: test driver>>
 
 end module dispatch_ut
 @ %def dispatch_ut
 @
 <<[[dispatch_uti.f90]]>>=
 <<File header>>
 
 module dispatch_uti
 <<Use kinds>>
 <<Use strings>>
   use os_interface, only: os_data_t
   use physics_defs, only: ELECTRON, PROTON
   use sm_qcd, only: qcd_t
   use flavors, only: flavor_t
   use interactions, only: reset_interaction_counter
   use pdg_arrays, only: pdg_array_t, assignment(=)
   use prc_core_def, only: prc_core_def_t
   use prc_test_core, only: test_t
   use prc_core, only: prc_core_t
   use prc_test, only: prc_test_def_t
   use prc_omega, only: omega_def_t, prc_omega_t
   use sf_mappings, only: sf_channel_t
   use sf_base, only: sf_data_t, sf_config_t
   use phs_base, only: phs_channel_collection_t
   use variables, only: var_list_t
   use model_data, only: model_data_t
   use models, only: syntax_model_file_init, syntax_model_file_final
   use rt_data, only: rt_data_t
 
   use dispatch_phase_space, only: dispatch_sf_channels
   use dispatch_beams, only: sf_prop_t, dispatch_qcd
   use dispatch_beams, only: dispatch_sf_config, dispatch_sf_data
   use dispatch_me_methods, only: dispatch_core_def, dispatch_core
   use dispatch_me_methods, only: dispatch_core_update, dispatch_core_restore
 
   use sf_base_ut, only: sf_test_data_t
 
 <<Standard module head>>
 
 <<Dispatch: public test auxiliary>>
 
 <<Dispatch: test declarations>>
 
 contains
 
 <<Dispatch: tests>>
 
 <<Dispatch: test auxiliary>>
 
 end module dispatch_uti
 
 @ %def dispatch_uti
 @ API: driver for the unit tests below.
 <<Dispatch: public test>>=
   public :: dispatch_test
 <<Dispatch: test driver>>=
   subroutine dispatch_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Dispatch: execute tests>>
   end subroutine dispatch_test
 
 @ %def dispatch_test
 @
 \subsubsection{Select type: process definition}
 <<Dispatch: execute tests>>=
   call test (dispatch_1, "dispatch_1", &
        "process configuration method", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_1
 <<Dispatch: tests>>=
   subroutine dispatch_1 (u)
     integer, intent(in) :: u
     type(string_t), dimension(2) :: prt_in, prt_out
     type(rt_data_t), target :: global
     class(prc_core_def_t), allocatable :: core_def
 
     write (u, "(A)")  "* Test output: dispatch_1"
     write (u, "(A)")  "*   Purpose: select process configuration method"
     write (u, "(A)")
 
     call global%global_init ()
 
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     prt_in = [var_str ("a"), var_str ("b")]
     prt_out = [var_str ("c"), var_str ("d")]
 
     write (u, "(A)")  "* Allocate core_def as prc_test_def"
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
     select type (core_def)
     type is (prc_test_def_t)
        call core_def%write (u)
     end select
 
     deallocate (core_def)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate core_def as omega_def"
     write (u, "(A)")
 
     call global%set_string (var_str ("$method"), &
          var_str ("omega"), is_known = .true.)
     call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
     select type (core_def)
     type is (omega_def_t)
        call core_def%write (u)
     end select
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_1"
 
   end subroutine dispatch_1
 
 @ %def dispatch_1
 @
 \subsubsection{Select type: process core}
 <<Dispatch: execute tests>>=
   call test (dispatch_2, "dispatch_2", &
        "process core", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_2
 <<Dispatch: tests>>=
   subroutine dispatch_2 (u)
     integer, intent(in) :: u
     type(string_t), dimension(2) :: prt_in, prt_out
     type(rt_data_t), target :: global
     class(prc_core_def_t), allocatable :: core_def
     class(prc_core_t), allocatable :: core
 
     write (u, "(A)")  "* Test output: dispatch_2"
     write (u, "(A)")  "*   Purpose: select process configuration method"
     write (u, "(A)")  "             and allocate process core"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
 
     prt_in = [var_str ("a"), var_str ("b")]
     prt_out = [var_str ("c"), var_str ("d")]
 
     write (u, "(A)")  "* Allocate core as test_t"
     write (u, "(A)")
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
     call dispatch_core (core, core_def)
     select type (core)
     type is (test_t)
        call core%write (u)
     end select
 
     deallocate (core)
     deallocate (core_def)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate core as prc_omega_t"
     write (u, "(A)")
 
     call global%set_string (var_str ("$method"), &
          var_str ("omega"), is_known = .true.)
     call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
 
     call global%select_model (var_str ("Test"))
 
     call global%set_log (&
          var_str ("?helicity_selection_active"), &
          .true., is_known = .true.)
     call global%set_real (&
          var_str ("helicity_selection_threshold"), &
          1e9_default, is_known = .true.)
     call global%set_int (&
          var_str ("helicity_selection_cutoff"), &
          10, is_known = .true.)
 
     call dispatch_core (core, core_def, &
          global%model, &
          global%get_helicity_selection ())
     call core_def%allocate_driver (core%driver, var_str (""))
 
     select type (core)
     type is (prc_omega_t)
        call core%write (u)
     end select
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_2"
 
   end subroutine dispatch_2
 
 @ %def dispatch_2
 @
 \subsubsection{Select type: structure-function data}
 This is an extra dispatcher that enables the test structure
 functions.  This procedure should be assigned to the
 [[dispatch_sf_data_extra]] hook before any tests are executed.
 <<Dispatch: public test auxiliary>>=
   public :: dispatch_sf_data_test
 <<Dispatch: test auxiliary>>=
   subroutine dispatch_sf_data_test (data, sf_method, i_beam, sf_prop, &
        var_list, var_list_global, model, os_data, sqrts, pdg_in, pdg_prc, polarized)
     class(sf_data_t), allocatable, intent(inout) :: data
     type(string_t), intent(in) :: sf_method
     integer, dimension(:), intent(in) :: i_beam
     type(var_list_t), intent(in) :: var_list
     type(var_list_t), intent(inout) :: var_list_global
     class(model_data_t), target, intent(in) :: model
     type(os_data_t), intent(in) :: os_data
     real(default), intent(in) :: sqrts
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_in
     type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
     type(sf_prop_t), intent(inout) :: sf_prop
     logical, intent(in) :: polarized
     select case (char (sf_method))
     case ("sf_test_0", "sf_test_1")
        allocate (sf_test_data_t :: data)
        select type (data)
        type is (sf_test_data_t)
           select case (char (sf_method))
           case ("sf_test_0");  call data%init (model, pdg_in(i_beam(1)))
           case ("sf_test_1");  call data%init (model, pdg_in(i_beam(1)),&
                mode = 1)
           end select
        end select
     end select
   end subroutine dispatch_sf_data_test
 
 @ %def dispatch_sf_data_test
 @ The actual test. We can't move this to [[beams]] as it depends on
 [[model_features]] for the [[model_list_t]].
 <<Dispatch: execute tests>>=
   call test (dispatch_7, "dispatch_7", &
        "structure-function data", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_7
 <<Dispatch: tests>>=
   subroutine dispatch_7 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(os_data_t) :: os_data
     type(string_t) :: prt, sf_method
     type(sf_prop_t) :: sf_prop
     class(sf_data_t), allocatable :: data
     type(pdg_array_t), dimension(1) :: pdg_in
     type(pdg_array_t), dimension(1,1) :: pdg_prc
     type(pdg_array_t), dimension(1) :: pdg_out
     integer, dimension(:), allocatable :: pdg1
 
     write (u, "(A)")  "* Test output: dispatch_7"
     write (u, "(A)")  "*   Purpose: select and configure &
          &structure function data"
     write (u, "(A)")
 
     call global%global_init ()
 
     call os_data%init ()
     call syntax_model_file_init ()
     call global%select_model (var_str ("QCD"))
 
     call reset_interaction_counter ()
     call global%set_real (var_str ("sqrts"), &
          14000._default, is_known = .true.)
     prt = "p"
     call global%beam_structure%init_sf ([prt, prt], [1])
     pdg_in = 2212
 
     write (u, "(A)")  "* Allocate data as sf_pdf_builtin_t"
     write (u, "(A)")
 
     sf_method = "pdf_builtin"
     call dispatch_sf_data (data, sf_method, [1], sf_prop, &
          global%get_var_list_ptr (), global%var_list, &
          global%model, global%os_data, global%get_sqrts (), &
          pdg_in, pdg_prc, .false.)
     call data%write (u)
 
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     write (u, "(A)")
     write (u, "(1x,A,99(1x,I0))")  "PDG(out) = ", pdg1
 
     deallocate (data)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate data for different PDF set"
     write (u, "(A)")
 
     pdg_in = 2212
 
     call global%set_string (var_str ("$pdf_builtin_set"), &
          var_str ("CTEQ6M"), is_known = .true.)
     sf_method = "pdf_builtin"
     call dispatch_sf_data (data, sf_method, [1], sf_prop, &
          global%get_var_list_ptr (), global%var_list, &
          global%model, global%os_data, global%get_sqrts (), &
          pdg_in, pdg_prc, .false.)
     call data%write (u)
 
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     write (u, "(A)")
     write (u, "(1x,A,99(1x,I0))")  "PDG(out) = ", pdg1
 
     deallocate (data)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_7"
 
   end subroutine dispatch_7
 
 @ %def dispatch_7
 @
 \subsubsection{Beam structure}
 The actual test. We can't move this to [[beams]] as it depends on
 [[model_features]] for the [[model_list_t]].
 <<Dispatch: execute tests>>=
   call test (dispatch_8, "dispatch_8", &
        "beam structure", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_8
 <<Dispatch: tests>>=
   subroutine dispatch_8 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(os_data_t) :: os_data
     type(flavor_t), dimension(2) :: flv
     type(sf_config_t), dimension(:), allocatable :: sf_config
     type(sf_prop_t) :: sf_prop
     type(sf_channel_t), dimension(:), allocatable :: sf_channel
     type(phs_channel_collection_t) :: coll
     type(string_t) :: sf_string
     integer :: i
     type(pdg_array_t), dimension (2,1) :: pdg_prc
 
     write (u, "(A)")  "* Test output: dispatch_8"
     write (u, "(A)")  "*   Purpose: configure a structure-function chain"
     write (u, "(A)")
 
     call global%global_init ()
 
     call os_data%init ()
     call syntax_model_file_init ()
     call global%select_model (var_str ("QCD"))
 
     write (u, "(A)")  "* Allocate LHC beams with PDF builtin"
     write (u, "(A)")
 
     call flv(1)%init (PROTON, global%model)
     call flv(2)%init (PROTON, global%model)
 
     call reset_interaction_counter ()
     call global%set_real (var_str ("sqrts"), &
          14000._default, is_known = .true.)
 
     call global%beam_structure%init_sf (flv%get_name (), [1])
     call global%beam_structure%set_sf (1, 1, var_str ("pdf_builtin"))
 
     call dispatch_sf_config (sf_config, sf_prop, global%beam_structure, &
          global%get_var_list_ptr (), global%var_list, &
          global%model, global%os_data, global%get_sqrts (), pdg_prc)
     do i = 1, size (sf_config)
        call sf_config(i)%write (u)
     end do
 
     call dispatch_sf_channels (sf_channel, sf_string, sf_prop, coll, &
          global%var_list, global%get_sqrts(), global%beam_structure)
     write (u, "(1x,A)")  "Mapping configuration:"
     do i = 1, size (sf_channel)
        write (u, "(2x)", advance = "no")
        call sf_channel(i)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate ILC beams with CIRCE1"
     write (u, "(A)")
 
     call global%select_model (var_str ("QED"))
     call flv(1)%init ( ELECTRON, global%model)
     call flv(2)%init (-ELECTRON, global%model)
 
     call reset_interaction_counter ()
     call global%set_real (var_str ("sqrts"), &
          500._default, is_known = .true.)
     call global%set_log (var_str ("?circe1_generate"), &
          .false., is_known = .true.)
 
     call global%beam_structure%init_sf (flv%get_name (), [1])
     call global%beam_structure%set_sf (1, 1, var_str ("circe1"))
 
     call dispatch_sf_config (sf_config, sf_prop, global%beam_structure, &
          global%get_var_list_ptr (), global%var_list, &
          global%model, global%os_data, global%get_sqrts (), pdg_prc)
     do i = 1, size (sf_config)
        call sf_config(i)%write (u)
     end do
 
     call dispatch_sf_channels (sf_channel, sf_string, sf_prop, coll, &
          global%var_list, global%get_sqrts(), global%beam_structure)
     write (u, "(1x,A)")  "Mapping configuration:"
     do i = 1, size (sf_channel)
        write (u, "(2x)", advance = "no")
        call sf_channel(i)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_8"
 
   end subroutine dispatch_8
 
 @ %def dispatch_8
 @
 \subsubsection{Update process core parameters}
 This test dispatches a process core, temporarily modifies parameters,
 then restores the original.
 <<Dispatch: execute tests>>=
   call test (dispatch_10, "dispatch_10", &
        "process core update", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_10
 <<Dispatch: tests>>=
   subroutine dispatch_10 (u)
     integer, intent(in) :: u
     type(string_t), dimension(2) :: prt_in, prt_out
     type(rt_data_t), target :: global
     class(prc_core_def_t), allocatable :: core_def
     class(prc_core_t), allocatable :: core, saved_core
     type(var_list_t), pointer :: model_vars
 
     write (u, "(A)")  "* Test output: dispatch_10"
     write (u, "(A)")  "*   Purpose: select process configuration method,"
     write (u, "(A)")  "             allocate process core,"
     write (u, "(A)")  "             temporarily reset parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
 
     prt_in = [var_str ("a"), var_str ("b")]
     prt_out = [var_str ("c"), var_str ("d")]
 
     write (u, "(A)")  "* Allocate core as prc_omega_t"
     write (u, "(A)")
 
     call global%set_string (var_str ("$method"), &
          var_str ("omega"), is_known = .true.)
     call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
 
     call global%select_model (var_str ("Test"))
 
     call dispatch_core (core, core_def, global%model)
     call core_def%allocate_driver (core%driver, var_str (""))
 
     select type (core)
     type is (prc_omega_t)
        call core%write (u)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Update core with modified model and helicity selection"
     write (u, "(A)")
 
     model_vars => global%model%get_var_list_ptr ()
 
     call model_vars%set_real (var_str ("gy"), 2._default, &
          is_known = .true.)
     call global%model%update_parameters ()
 
     call global%set_log (&
          var_str ("?helicity_selection_active"), &
          .true., is_known = .true.)
     call global%set_real (&
          var_str ("helicity_selection_threshold"), &
          2e10_default, is_known = .true.)
     call global%set_int (&
          var_str ("helicity_selection_cutoff"), &
          5, is_known = .true.)
 
     call dispatch_core_update (core, &
          global%model, &
          global%get_helicity_selection (), &
          saved_core = saved_core)
     select type (core)
     type is (prc_omega_t)
        call core%write (u)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Restore core from save"
     write (u, "(A)")
 
     call dispatch_core_restore (core, saved_core)
     select type (core)
     type is (prc_omega_t)
        call core%write (u)
     end select
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_10"
 
   end subroutine dispatch_10
 
 @ %def dispatch_10
 @
 \subsubsection{QCD Coupling}
 This test dispatches an [[qcd]] object, which is used to compute the
 (running) coupling by one of several possible methods.
 
 We can't move this to [[beams]] as it depends on
 [[model_features]] for the [[model_list_t]].
 <<Dispatch: execute tests>>=
   call test (dispatch_11, "dispatch_11", &
        "QCD coupling", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_11
 <<Dispatch: tests>>=
   subroutine dispatch_11 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(var_list_t), pointer :: model_vars
     type(qcd_t) :: qcd
 
     write (u, "(A)")  "* Test output: dispatch_11"
     write (u, "(A)")  "*   Purpose: select QCD coupling formula"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
     call global%select_model (var_str ("SM"))
     model_vars => global%get_var_list_ptr ()
 
     write (u, "(A)")  "* Allocate alpha_s as fixed"
     write (u, "(A)")
 
     call global%set_log (var_str ("?alphas_is_fixed"), &
          .true., is_known = .true.)
     call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
     call qcd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate alpha_s as running (built-in)"
     write (u, "(A)")
 
     call global%set_log (var_str ("?alphas_is_fixed"), &
          .false., is_known = .true.)
     call global%set_log (var_str ("?alphas_from_mz"), &
          .true., is_known = .true.)
     call global%set_int &
          (var_str ("alphas_order"), 1, is_known = .true.)
     call model_vars%set_real (var_str ("alphas"), 0.1234_default, &
           is_known=.true.)
     call model_vars%set_real (var_str ("mZ"), 91.234_default, &
           is_known=.true.)
     call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
     call qcd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate alpha_s as running (built-in, Lambda defined)"
     write (u, "(A)")
 
     call global%set_log (var_str ("?alphas_from_mz"), &
          .false., is_known = .true.)
     call global%set_log (&
          var_str ("?alphas_from_lambda_qcd"), &
          .true., is_known = .true.)
     call global%set_real &
          (var_str ("lambda_qcd"), 250.e-3_default, &
           is_known=.true.)
     call global%set_int &
          (var_str ("alphas_order"), 2, is_known = .true.)
     call global%set_int &
          (var_str ("alphas_nf"), 4, is_known = .true.)
     call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
     call qcd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate alpha_s as running (using builtin PDF set)"
     write (u, "(A)")
 
     call global%set_log (&
          var_str ("?alphas_from_lambda_qcd"), &
          .false., is_known = .true.)
     call global%set_log &
          (var_str ("?alphas_from_pdf_builtin"), &
          .true., is_known = .true.)
     call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
     call qcd%write (u)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_11"
 
   end subroutine dispatch_11
 
 @ %def dispatch_11
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Process Configuration}
 This module communicates between the toplevel command structure with
 its runtime data set and the process-library handling modules which
 collect the definition of individual processes.  Its primary purpose
 is to select from the available matrix-element generating methods and
 configure the entry in the process library accordingly.
 <<[[process_configurations.f90]]>>=
 <<File header>>
 
 module process_configurations
 
 <<Use strings>>
 <<Use debug>>
   use diagnostics
   use io_units
   use physics_defs, only: BORN, NLO_VIRTUAL, NLO_REAL, NLO_DGLAP, &
        NLO_SUBTRACTION, NLO_MISMATCH
   use models
   use prc_core_def
   use particle_specifiers
   use process_libraries
   use rt_data
   use variables, only: var_list_t
 
   use dispatch_me_methods, only: dispatch_core_def
   use prc_external, only: prc_external_def_t
 
 <<Standard module head>>
 
 <<Process configurations: public>>
 
 <<Process configurations: types>>
 
 contains
 
 <<Process configurations: procedures>>
 
 end module process_configurations
 @ %def process_configurations
 @
 \subsection{Data Type}
 <<Process configurations: public>>=
   public :: process_configuration_t
 <<Process configurations: types>>=
   type :: process_configuration_t
      type(process_def_entry_t), pointer :: entry => null ()
      type(string_t) :: id
      integer :: num_id = 0
    contains
    <<Process configurations: process configuration: TBP>>
   end type process_configuration_t
 
 @ %def process_configuration_t
 @ Output (for unit tests).
 <<Process configurations: process configuration: TBP>>=
   procedure :: write => process_configuration_write
 <<Process configurations: procedures>>=
   subroutine process_configuration_write (config, unit)
     class(process_configuration_t), intent(in) :: config
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(A)")  "Process configuration:"
     if (associated (config%entry)) then
        call config%entry%write (u)
     else
        write (u, "(1x,3A)")  "ID    = '", char (config%id), "'"
        write (u, "(1x,A,1x,I0)")  "num ID =", config%num_id
        write (u, "(2x,A)")  "[no entry]"
     end if
   end subroutine process_configuration_write
 
 @ %def process_configuration_write
 @ Initialize a process.  We only need the name, the number of incoming
 particles, and the number of components.
 <<Process configurations: process configuration: TBP>>=
   procedure :: init => process_configuration_init
 <<Process configurations: procedures>>=
   subroutine process_configuration_init &
        (config, prc_name, n_in, n_components, model, var_list, nlo_process)
     class(process_configuration_t), intent(out) :: config
     type(string_t), intent(in) :: prc_name
     integer, intent(in) :: n_in
     integer, intent(in) :: n_components
     type(model_t), intent(in), pointer :: model
     type(var_list_t), intent(in) :: var_list
     logical, intent(in), optional :: nlo_process
     logical :: nlo_proc
     logical :: requires_resonances
     if (debug_on) call msg_debug (D_CORE, "process_configuration_init")
     config%id = prc_name
     if (present (nlo_process)) then
        nlo_proc = nlo_process
     else
        nlo_proc = .false.
     end if
     requires_resonances = var_list%get_lval (var_str ("?resonance_history"))
 
     if (debug_on) call msg_debug (D_CORE, "nlo_process", nlo_proc)
     allocate (config%entry)
     if (var_list%is_known (var_str ("process_num_id"))) then
        config%num_id = &
             var_list%get_ival (var_str ("process_num_id"))
        call config%entry%init (prc_name, &
             model = model, n_in = n_in, n_components = n_components, &
             num_id = config%num_id, &
             nlo_process = nlo_proc, &
             requires_resonances = requires_resonances)
     else
        call config%entry%init (prc_name, &
             model = model, n_in = n_in, n_components = n_components, &
             nlo_process = nlo_proc, &
             requires_resonances = requires_resonances)
     end if
   end subroutine process_configuration_init
 
 @ %def process_configuration_init
 @ Initialize a process component.  The details depend on the process method,
 which determines the type of the process component core.  We set the incoming
 and outgoing particles (as strings, to be interpreted by the process driver).
 All other information is taken from the variable list.
 
 The dispatcher gets only the names of the particles.  The process
 component definition gets the complete specifiers which contains a
 polarization flag and names of decay processes, where applicable.
 <<Process configurations: process configuration: TBP>>=
   procedure :: setup_component => process_configuration_setup_component
 <<Process configurations: procedures>>=
   subroutine process_configuration_setup_component &
        (config, i_component, prt_in, prt_out, model, var_list, &
         nlo_type, can_be_integrated)
     class(process_configuration_t), intent(inout) :: config
     integer, intent(in) :: i_component
     type(prt_spec_t), dimension(:), intent(in) :: prt_in
     type(prt_spec_t), dimension(:), intent(in) :: prt_out
     type(model_t), pointer, intent(in) :: model
     type(var_list_t), intent(in) :: var_list
     integer, intent(in), optional :: nlo_type
     logical, intent(in), optional :: can_be_integrated
     type(string_t), dimension(:), allocatable :: prt_str_in
     type(string_t), dimension(:), allocatable :: prt_str_out
     class(prc_core_def_t), allocatable :: core_def
     type(string_t) :: method
     type(string_t) :: born_me_method
     type(string_t) :: real_tree_me_method
     type(string_t) :: loop_me_method
     type(string_t) :: correlation_me_method
     type(string_t) :: dglap_me_method
     integer :: i
     if (debug_on) call msg_debug2 (D_CORE, "process_configuration_setup_component")
     allocate (prt_str_in  (size (prt_in)))
     allocate (prt_str_out (size (prt_out)))
     forall (i = 1:size (prt_in))  prt_str_in(i)  = prt_in(i)% get_name ()
     forall (i = 1:size (prt_out)) prt_str_out(i) = prt_out(i)%get_name ()
 
     method = var_list%get_sval (var_str ("$method"))
     if (present (nlo_type)) then
        select case (nlo_type)
        case (BORN)
           born_me_method = var_list%get_sval (var_str ("$born_me_method"))
           if (born_me_method /= var_str ("")) then
              method = born_me_method
           end if
        case (NLO_VIRTUAL)
           loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
           if (loop_me_method /= var_str ("")) then
              method = loop_me_method
           end if
        case (NLO_REAL)
           real_tree_me_method = &
                var_list%get_sval (var_str ("$real_tree_me_method"))
           if (real_tree_me_method /= var_str ("")) then
              method = real_tree_me_method
           end if
        case (NLO_DGLAP)
           dglap_me_method = &
                var_list%get_sval (var_str ("$dglap_me_method"))
           if (dglap_me_method /= var_str ("")) then
              method = dglap_me_method
           end if
        case (NLO_SUBTRACTION,NLO_MISMATCH)
           correlation_me_method = &
                var_list%get_sval (var_str ("$correlation_me_method"))
           if (correlation_me_method /= var_str ("")) then
              method = correlation_me_method
           end if
        case default
        end select
     end if
     call dispatch_core_def (core_def, prt_str_in, prt_str_out, &
          model, var_list, config%id, nlo_type, method)
     select type (core_def)
     class is (prc_external_def_t)
        if (present (can_be_integrated)) then
           call core_def%set_active_writer (can_be_integrated)
        else
           call msg_fatal ("Cannot decide if external core is integrated!")
        end if
     end select
 
     if (debug_on) call msg_debug2 (D_CORE, "import_component with method ", method)
     call config%entry%import_component (i_component, &
          n_out = size (prt_out), &
          prt_in = prt_in, &
          prt_out = prt_out, &
          method = method, &
          variant = core_def, &
          nlo_type = nlo_type, &
          can_be_integrated = can_be_integrated)
   end subroutine process_configuration_setup_component
 
 @ %def process_configuration_setup_component
 @
 <<Process configurations: process configuration: TBP>>=
   procedure :: set_fixed_emitter => process_configuration_set_fixed_emitter
 <<Process configurations: procedures>>=
   subroutine process_configuration_set_fixed_emitter (config, i, emitter)
      class(process_configuration_t), intent(inout) :: config
      integer, intent(in) :: i, emitter
      call config%entry%set_fixed_emitter (i, emitter)
   end subroutine process_configuration_set_fixed_emitter
 
 @ %def process_configuration_set_fixed_emitter
 @
 <<Process configurations: process configuration: TBP>>=
   procedure :: set_coupling_powers => process_configuration_set_coupling_powers
 <<Process configurations: procedures>>=
   subroutine process_configuration_set_coupling_powers &
        (config, alpha_power, alphas_power)
     class(process_configuration_t), intent(inout) :: config
     integer, intent(in) :: alpha_power, alphas_power
     call config%entry%set_coupling_powers (alpha_power, alphas_power)
   end subroutine process_configuration_set_coupling_powers
 
 @ %def process_configuration_set_coupling_powers
 @
 <<Process configurations: process configuration: TBP>>=
   procedure :: set_component_associations => &
        process_configuration_set_component_associations
 <<Process configurations: procedures>>=
   subroutine process_configuration_set_component_associations &
          (config, i_list, remnant, use_real_finite, mismatch)
     class(process_configuration_t), intent(inout) :: config
     integer, dimension(:), intent(in) :: i_list
     logical, intent(in) :: remnant, use_real_finite, mismatch
     integer :: i_component
     do i_component = 1, config%entry%get_n_components ()
        if (any (i_list == i_component)) then
           call config%entry%set_associated_components (i_component, &
                i_list, remnant, use_real_finite, mismatch)
        end if
     end do
   end subroutine process_configuration_set_component_associations
 
 @ %def process_configuration_set_component_associations
 @ Record a process configuration: append it to the currently selected process
 definition library.
 <<Process configurations: process configuration: TBP>>=
   procedure :: record => process_configuration_record
 <<Process configurations: procedures>>=
   subroutine process_configuration_record (config, global)
     class(process_configuration_t), intent(inout) :: config
     type(rt_data_t), intent(inout) :: global
     if (associated (global%prclib)) then
        call global%prclib%open ()
        call global%prclib%append (config%entry)
        if (config%num_id /= 0) then
           write (msg_buffer, "(5A,I0,A)") "Process library '", &
                char (global%prclib%get_name ()), &
                "': recorded process '", char (config%id), "' (", &
                config%num_id, ")"
        else
           write (msg_buffer, "(5A)") "Process library '", &
                char (global%prclib%get_name ()), &
                "': recorded process '", char (config%id), "'"
        end if
        call msg_message ()
     else
        call msg_fatal ("Recording process '" // char (config%id) &
             // "': active process library undefined")
     end if
   end subroutine process_configuration_record
 
 @ %def process_configuration_record
 @
 \subsection{Unit Tests}
 Test module, followed by the corresponding implementation module.
 <<[[process_configurations_ut.f90]]>>=
 <<File header>>
 
 module process_configurations_ut
   use unit_tests
   use process_configurations_uti
 
 <<Standard module head>>
 
 <<Process configurations: public test>>
 
 <<Process configurations: public test auxiliary>>
 
 contains
 
 <<Process configurations: test driver>>
 
 end module process_configurations_ut
 @ %def process_configurations_ut
 @
 <<[[process_configurations_uti.f90]]>>=
 <<File header>>
 
 module process_configurations_uti
 
 <<Use strings>>
   use particle_specifiers, only: new_prt_spec
   use prclib_stacks
   use models
   use rt_data
 
   use process_configurations
 
 <<Standard module head>>
 
 <<Process configurations: test declarations>>
 
 <<Process configurations: public test auxiliary>>
 
 contains
 
 <<Process configurations: test auxiliary>>
 
 <<Process configurations: tests>>
 
 end module process_configurations_uti
 
 @ %def process_configurations_uti
 @ API: driver for the unit tests below.
 <<Process configurations: public test>>=
   public :: process_configurations_test
 <<Process configurations: test driver>>=
   subroutine process_configurations_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Process configurations: execute tests>>
   end subroutine process_configurations_test
 
 @ %def process_configurations_test
 @
 \subsubsection{Minimal setup}
 The workflow for setting up a minimal process configuration with the
 test matrix element method.
 
 We wrap this in a public procedure, so we can reuse it in later modules.
 The procedure prepares a process definition list for two processes
 (one [[prc_test]] and one [[omega]] type) and appends this to the
 process library stack in the global data set.
 
 The [[mode]] argument determines which processes to build.
 
 The [[procname]] argument replaces the predefined procname(s).
 
 This is re-exported by the UT module.
 <<Process configurations: public test auxiliary>>=
   public :: prepare_test_library
 <<Process configurations: test auxiliary>>=
   subroutine prepare_test_library (global, libname, mode, procname)
     type(rt_data_t), intent(inout), target :: global
     type(string_t), intent(in) :: libname
     integer, intent(in) :: mode
     type(string_t), intent(in), dimension(:), optional :: procname
     type(prclib_entry_t), pointer :: lib
     type(string_t) :: prc_name
     type(string_t), dimension(:), allocatable :: prt_in, prt_out
     integer :: n_components
     type(process_configuration_t) :: prc_config
 
     if (.not. associated (global%prclib_stack%get_first_ptr ())) then
        allocate (lib)
        call lib%init (libname)
        call global%add_prclib (lib)
     end if
 
     if (btest (mode, 0)) then
 
        call global%select_model (var_str ("Test"))
 
        if (present (procname)) then
           prc_name = procname(1)
        else
           prc_name = "prc_config_a"
        end if
        n_components = 1
        allocate (prt_in (2), prt_out (2))
        prt_in = [var_str ("s"), var_str ("s")]
        prt_out = [var_str ("s"), var_str ("s")]
 
        call global%set_string (var_str ("$method"),&
             var_str ("unit_test"), is_known = .true.)
 
        call prc_config%init (prc_name, &
             size (prt_in), n_components, &
             global%model, global%var_list)
        call prc_config%setup_component (1, &
             new_prt_spec (prt_in), new_prt_spec (prt_out), &
             global%model, global%var_list)
        call prc_config%record (global)
 
        deallocate (prt_in, prt_out)
 
     end if
 
     if (btest (mode, 1)) then
 
        call global%select_model (var_str ("QED"))
 
        if (present (procname)) then
           prc_name = procname(2)
        else
           prc_name = "prc_config_b"
        end if
        n_components = 1
        allocate (prt_in (2), prt_out (2))
        prt_in = [var_str ("e+"), var_str ("e-")]
        prt_out = [var_str ("m+"), var_str ("m-")]
 
        call global%set_string (var_str ("$method"),&
             var_str ("omega"), is_known = .true.)
 
        call prc_config%init (prc_name, &
             size (prt_in), n_components, &
             global%model, global%var_list)
        call prc_config%setup_component (1, &
             new_prt_spec (prt_in), new_prt_spec (prt_out), &
             global%model, global%var_list)
        call prc_config%record (global)
 
        deallocate (prt_in, prt_out)
 
     end if
 
     if (btest (mode, 2)) then
 
        call global%select_model (var_str ("Test"))
 
        if (present (procname)) then
           prc_name = procname(1)
        else
           prc_name = "prc_config_a"
        end if
        n_components = 1
        allocate (prt_in (1), prt_out (2))
        prt_in = [var_str ("s")]
        prt_out = [var_str ("f"), var_str ("fbar")]
 
        call global%set_string (var_str ("$method"),&
             var_str ("unit_test"), is_known = .true.)
 
        call prc_config%init (prc_name, &
             size (prt_in), n_components, &
             global%model, global%var_list)
        call prc_config%setup_component (1, &
             new_prt_spec (prt_in), new_prt_spec (prt_out), &
             global%model, global%var_list)
        call prc_config%record (global)
 
        deallocate (prt_in, prt_out)
 
     end if
 
   end subroutine prepare_test_library
 
 @ %def prepare_test_library
 @ The actual test: the previous procedure with some prelude and postlude.
 In the global variable list, just before printing we reset the
 variables where the value may depend on the system and run environment.
 <<Process configurations: execute tests>>=
   call test (process_configurations_1, "process_configurations_1", &
        "test processes", &
        u, results)
 <<Process configurations: test declarations>>=
   public :: process_configurations_1
 <<Process configurations: tests>>=
   subroutine process_configurations_1 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: process_configurations_1"
     write (u, "(A)")  "*   Purpose: configure test processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     write (u, "(A)")  "* Configure processes as prc_test, model Test"
     write (u, "(A)")  "*                     and omega, model QED"
     write (u, *)
 
     call global%set_int (var_str ("process_num_id"), &
          42, is_known = .true.)
     call prepare_test_library (global, var_str ("prc_config_lib_1"), 3)
 
     global%os_data%fc = "Fortran-compiler"
     global%os_data%fcflags = "Fortran-flags"
 
     call global%write_libraries (u)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: process_configurations_1"
 
   end subroutine process_configurations_1
 
 @ %def process_configurations_1
 @
 \subsubsection{\oMega\ options}
 Slightly extended example where we pass \oMega\ options to the
 library.  The [[prepare_test_library]] contents are spelled out.
 <<Process configurations: execute tests>>=
   call test (process_configurations_2, "process_configurations_2", &
        "omega options", &
        u, results)
 <<Process configurations: test declarations>>=
   public :: process_configurations_2
 <<Process configurations: tests>>=
   subroutine process_configurations_2 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     type(string_t) :: libname
     type(prclib_entry_t), pointer :: lib
     type(string_t) :: prc_name
     type(string_t), dimension(:), allocatable :: prt_in, prt_out
     integer :: n_components
     type(process_configuration_t) :: prc_config
 
     write (u, "(A)")  "* Test output: process_configurations_2"
     write (u, "(A)")  "*   Purpose: configure test processes with options"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     write (u, "(A)")  "* Configure processes as omega, model QED"
     write (u, *)
 
     libname = "prc_config_lib_2"
 
     allocate (lib)
     call lib%init (libname)
     call global%add_prclib (lib)
 
     call global%select_model (var_str ("QED"))
 
     prc_name = "prc_config_c"
     n_components = 2
     allocate (prt_in (2), prt_out (2))
     prt_in = [var_str ("e+"), var_str ("e-")]
     prt_out = [var_str ("m+"), var_str ("m-")]
 
     call global%set_string (var_str ("$method"),&
          var_str ("omega"), is_known = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     call prc_config%init (prc_name, size (prt_in), n_components, &
          global%model, global%var_list)
 
     call global%set_log (var_str ("?report_progress"), &
          .true., is_known = .true.)
     call prc_config%setup_component (1, &
          new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)
 
     call global%set_log (var_str ("?report_progress"), &
          .false., is_known = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .true., is_known = .true.)
     call global%set_string (var_str ("$restrictions"),&
          var_str ("3+4~A"), is_known = .true.)
     call global%set_string (var_str ("$omega_flags"), &
          var_str ("-fusion:progress_file omega_prc_config.log"), &
          is_known = .true.)
     call prc_config%setup_component (2, &
          new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)
 
     call prc_config%record (global)
 
     deallocate (prt_in, prt_out)
 
     global%os_data%fc = "Fortran-compiler"
     global%os_data%fcflags = "Fortran-flags"
 
     call global%write_vars (u, [ &
          var_str ("$model_name"), &
          var_str ("$method"), &
          var_str ("?report_progress"), &
          var_str ("$restrictions"), &
          var_str ("$omega_flags")])
     write (u, "(A)")
     call global%write_libraries (u)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: process_configurations_2"
 
   end subroutine process_configurations_2
 
 @ %def process_configurations_2
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Compilation}
 This module manages compilation and loading of of process libraries.  It is
 needed as a separate module because integration depends on it.
 <<[[compilations.f90]]>>=
 <<File header>>
 
 module compilations
 
 <<Use strings>>
   use io_units
   use system_defs, only: TAB
   use diagnostics
   use os_interface
   use variables, only: var_list_t
   use model_data
   use process_libraries
   use prclib_stacks
   use rt_data
 
 <<Standard module head>>
 
 <<Compilations: public>>
 
 <<Compilations: types>>
 
 <<Compilations: parameters>>
 
 contains
 
 <<Compilations: procedures>>
 
 end module compilations
 @ %def compilations
 @
 \subsection{The data type}
 The compilation item handles the compilation and loading of a single
 process library.
 <<Compilations: public>>=
   public :: compilation_item_t
 <<Compilations: types>>=
   type :: compilation_item_t
      private
      type(string_t) :: libname
      type(string_t) :: static_external_tag
      type(process_library_t), pointer :: lib => null ()
      logical :: recompile_library = .false.
      logical :: verbose = .false.
      logical :: use_workspace = .false.
      type(string_t) :: workspace
    contains
    <<Compilations: compilation item: TBP>>
   end type compilation_item_t
 
 @ %def compilation_item_t
 @ Initialize.
 
 Set flags and global properties of the library.  Establish the workspace name,
 if defined.
 <<Compilations: compilation item: TBP>>=
   procedure :: init => compilation_item_init
 <<Compilations: procedures>>=
   subroutine compilation_item_init (comp, libname, stack, var_list)
     class(compilation_item_t), intent(out) :: comp
     type(string_t), intent(in) :: libname
     type(prclib_stack_t), intent(inout) :: stack
     type(var_list_t), intent(in) :: var_list
     comp%libname = libname
     comp%lib => stack%get_library_ptr (comp%libname)
     if (.not. associated (comp%lib)) then
        call msg_fatal ("Process library '" // char (comp%libname) &
             // "' has not been declared.")
     end if
     comp%recompile_library = &
          var_list%get_lval (var_str ("?recompile_library"))
     comp%verbose = &
          var_list%get_lval (var_str ("?me_verbose"))
     comp%use_workspace = &
          var_list%is_known (var_str ("$compile_workspace"))
     if (comp%use_workspace) then
        comp%workspace = &
             var_list%get_sval (var_str ("$compile_workspace"))
        if (comp%workspace == "")  comp%use_workspace = .false.
     else
        comp%workspace = ""
     end if
   end subroutine compilation_item_init
 
 @ %def compilation_item_init
 @ Compile the current library.  The [[force]] flag has the
 effect that we first delete any previous files, as far as accessible
 by the current makefile.  It also guarantees that previous files not
 accessible by a makefile will be overwritten.
 <<Compilations: compilation item: TBP>>=
   procedure :: compile => compilation_item_compile
 <<Compilations: procedures>>=
   subroutine compilation_item_compile (comp, model, os_data, force, recompile)
     class(compilation_item_t), intent(inout) :: comp
     class(model_data_t), intent(in), target :: model
     type(os_data_t), intent(in) :: os_data
     logical, intent(in) :: force, recompile
     if (associated (comp%lib)) then
        if (comp%use_workspace)  call setup_workspace (comp%workspace, os_data)
        call msg_message ("Process library '" &
             // char (comp%libname) // "': compiling ...")
        call comp%lib%configure (os_data)
        if (signal_is_pending ())  return
        call comp%lib%compute_md5sum (model)
        call comp%lib%write_makefile &
             (os_data, force, verbose=comp%verbose, workspace=comp%workspace)
        if (signal_is_pending ())  return
        if (force) then
           call comp%lib%clean &
                (os_data, distclean = .false., workspace=comp%workspace)
           if (signal_is_pending ())  return
        end if
        call comp%lib%write_driver (force, workspace=comp%workspace)
        if (signal_is_pending ())  return
        if (recompile) then
           call comp%lib%load &
                (os_data, keep_old_source = .true., workspace=comp%workspace)
           if (signal_is_pending ())  return
        end if
        call comp%lib%update_status (os_data, workspace=comp%workspace)
     end if
   end subroutine compilation_item_compile
 
 @ %def compilation_item_compile
 @ The workspace directory is created if it does not exist.  (Applies only if
 the use has set the workspace directory.)
 <<Compilations: parameters>>=
   character(*), parameter :: ALLOWED_IN_DIRNAME = &
        "abcdefghijklmnopqrstuvwxyz&
        &ABCDEFGHIJKLMNOPQRSTUVWXYZ&
        &1234567890&
        &.,_-+="
 @ %def ALLOWED_IN_DIRNAME
 <<Compilations: procedures>>=
   subroutine setup_workspace (workspace, os_data)
     type(string_t), intent(in) :: workspace
     type(os_data_t), intent(in) :: os_data
     if (verify (workspace, ALLOWED_IN_DIRNAME) == 0) then
        call msg_message ("Compile: preparing workspace directory '" &
             // char (workspace) // "'")
        call os_system_call ("mkdir -p '" // workspace // "'")
     else
        call msg_fatal ("compile: workspace name '" &
             // char (workspace) // "' contains illegal characters")
     end if
   end subroutine setup_workspace
 
 @ %def setup_workspace
 @ Load the current library, just after compiling it.
 <<Compilations: compilation item: TBP>>=
   procedure :: load => compilation_item_load
 <<Compilations: procedures>>=
   subroutine compilation_item_load (comp, os_data)
     class(compilation_item_t), intent(inout) :: comp
     type(os_data_t), intent(in) :: os_data
     if (associated (comp%lib)) then
        call comp%lib%load (os_data, workspace=comp%workspace)
     end if
   end subroutine compilation_item_load
 
 @ %def compilation_item_load
 @ Message as a separate call:
 <<Compilations: compilation item: TBP>>=
   procedure :: success => compilation_item_success
 <<Compilations: procedures>>=
   subroutine compilation_item_success (comp)
     class(compilation_item_t), intent(in) :: comp
     if (associated (comp%lib)) then
        call msg_message ("Process library '" // char (comp%libname) &
             // "': ... success.")
     else
        call msg_fatal ("Process library '" // char (comp%libname) &
             // "': ... failure.")
     end if
   end subroutine compilation_item_success
 
 @ %def compilation_item_success
 @ %def compilation_item_failure
 @
 \subsection{API for library compilation and loading}
 This is a shorthand for compiling and loading a single library.  The
 [[compilation_item]] object is used only internally.
 
 The [[global]] data set may actually be local to the caller.  The
 compilation affects the library specified by its name if it is on the
 stack, but it does not reset the currently selected library.
 <<Compilations: public>>=
   public :: compile_library
 <<Compilations: procedures>>=
   subroutine compile_library (libname, global)
     type(string_t), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: global
     type(compilation_item_t) :: comp
     logical :: force, recompile
     force = &
          global%var_list%get_lval (var_str ("?rebuild_library"))
     recompile = &
          global%var_list%get_lval (var_str ("?recompile_library"))
     if (associated (global%model)) then
        call comp%init (libname, global%prclib_stack, global%var_list)
        call comp%compile (global%model, global%os_data, force, recompile)
        if (signal_is_pending ())  return
        call comp%load (global%os_data)
        if (signal_is_pending ())  return
     else
        call msg_fatal ("Process library compilation: " &
             // " model is undefined.")
     end if
     call comp%success ()
   end subroutine compile_library
 
 @ %def compile_library
 @
 \subsection{Compiling static executable}
 This object handles the creation of a static executable which should
 contain a set of static process libraries.
 <<Compilations: public>>=
   public :: compilation_t
 <<Compilations: types>>=
   type :: compilation_t
      private
      type(string_t) :: exe_name
      type(string_t), dimension(:), allocatable :: lib_name
    contains
    <<Compilations: compilation: TBP>>
   end type compilation_t
 
 @ %def compilation_t
 @ Output.
 <<Compilations: compilation: TBP>>=
   procedure :: write => compilation_write
 <<Compilations: procedures>>=
   subroutine compilation_write (object, unit)
     class(compilation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Compilation object:"
     write (u, "(3x,3A)")  "executable        = '", &
          char (object%exe_name), "'"
     write (u, "(3x,A)", advance="no")  "process libraries ="
     do i = 1, size (object%lib_name)
        write (u, "(1x,3A)", advance="no")  "'", char (object%lib_name(i)), "'"
     end do
     write (u, *)
   end subroutine compilation_write
 
 @ %def compilation_write
 @ Initialize: we know the names of the executable and of the libraries.
 Optionally, we may provide a workspace directory.
 <<Compilations: compilation: TBP>>=
   procedure :: init => compilation_init
 <<Compilations: procedures>>=
   subroutine compilation_init (compilation, exe_name, lib_name)
     class(compilation_t), intent(out) :: compilation
     type(string_t), intent(in) :: exe_name
     type(string_t), dimension(:), intent(in) :: lib_name
     compilation%exe_name = exe_name
     allocate (compilation%lib_name (size (lib_name)))
     compilation%lib_name = lib_name
   end subroutine compilation_init
 
 @ %def compilation_init
 @ Write the dispatcher subroutine for the compiled libraries.  Also
 write a subroutine which returns the names of the compiled libraries.
 <<Compilations: compilation: TBP>>=
   procedure :: write_dispatcher => compilation_write_dispatcher
 <<Compilations: procedures>>=
   subroutine compilation_write_dispatcher (compilation)
     class(compilation_t), intent(in) :: compilation
     type(string_t) :: file
     integer :: u, i
     file = compilation%exe_name // "_prclib_dispatcher.f90"
     call msg_message ("Static executable '" // char (compilation%exe_name) &
          // "': writing library dispatcher")
     u = free_unit ()
     open (u, file = char (file), status="replace", action="write")
     write (u, "(3A)")  "! Whizard: process libraries for executable '", &
          char (compilation%exe_name), "'"
     write (u, "(A)")  "! Automatically generated file, do not edit"
     write (u, "(A)")  "subroutine dispatch_prclib_static " // &
          "(driver, basename, modellibs_ldflags)"
     write (u, "(A)")  "  use iso_varying_string, string_t => varying_string"
     write (u, "(A)")  "  use prclib_interfaces"
     do i = 1, size (compilation%lib_name)
        associate (lib_name => compilation%lib_name(i))
          write (u, "(A)")  "  use " // char (lib_name) // "_driver"
        end associate
     end do
     write (u, "(A)")  "  implicit none"
     write (u, "(A)")  "  class(prclib_driver_t), intent(inout), allocatable &
          &:: driver"
     write (u, "(A)")  "  type(string_t), intent(in) :: basename"
     write (u, "(A)")  "  logical, intent(in), optional :: " // &
          "modellibs_ldflags"
     write (u, "(A)")  "  select case (char (basename))"
     do i = 1, size (compilation%lib_name)
        associate (lib_name => compilation%lib_name(i))
          write (u, "(3A)")  "  case ('", char (lib_name), "')"
          write (u, "(3A)")  "     allocate (", char (lib_name), "_driver_t &
               &:: driver)"
        end associate
     end do
     write (u, "(A)")  "  end select"
     write (u, "(A)")  "end subroutine dispatch_prclib_static"
     write (u, *)
     write (u, "(A)")  "subroutine get_prclib_static (libname)"
     write (u, "(A)")  "  use iso_varying_string, string_t => varying_string"
     write (u, "(A)")  "  implicit none"
     write (u, "(A)")  "  type(string_t), dimension(:), intent(inout), &
          &allocatable :: libname"
     write (u, "(A,I0,A)")  "  allocate (libname (", &
          size (compilation%lib_name), "))"
     do i = 1, size (compilation%lib_name)
        associate (lib_name => compilation%lib_name(i))
          write (u, "(A,I0,A,A,A)")  "  libname(", i, ") = '", &
               char (lib_name), "'"
        end associate
     end do
     write (u, "(A)")  "end subroutine get_prclib_static"
     close (u)
   end subroutine compilation_write_dispatcher
 
 @ %def compilation_write_dispatcher
 @ Write the Makefile subroutine for the compiled libraries.
 <<Compilations: compilation: TBP>>=
   procedure :: write_makefile => compilation_write_makefile
 <<Compilations: procedures>>=
   subroutine compilation_write_makefile &
        (compilation, os_data, ext_libtag, verbose)
     class(compilation_t), intent(in) :: compilation
     type(os_data_t), intent(in) :: os_data
     logical, intent(in) :: verbose
     type(string_t), intent(in), optional :: ext_libtag
     type(string_t) :: file, ext_tag
     integer :: u, i
     if (present (ext_libtag)) then
        ext_tag = ext_libtag
     else
        ext_tag = ""
     end if
     file = compilation%exe_name // ".makefile"
     call msg_message ("Static executable '" // char (compilation%exe_name) &
          // "': writing makefile")
     u = free_unit ()
     open (u, file = char (file), status="replace", action="write")
     write (u, "(3A)")  "# WHIZARD: Makefile for executable '", &
          char (compilation%exe_name), "'"
     write (u, "(A)")  "# Automatically generated file, do not edit"
     write (u, "(A)") ""
     write (u, "(A)") "# Executable name"
     write (u, "(A)") "EXE = " // char (compilation%exe_name)
     write (u, "(A)") ""
     write (u, "(A)") "# Compiler"
     write (u, "(A)") "FC = " // char (os_data%fc)
     write (u, "(A)") ""
     write (u, "(A)") "# Included libraries"
     write (u, "(A)") "FCINCL = " // char (os_data%whizard_includes)
     write (u, "(A)") ""
     write (u, "(A)") "# Compiler flags"
     write (u, "(A)") "FCFLAGS = " // char (os_data%fcflags)
     write (u, "(A)") "LDFLAGS = " // char (os_data%ldflags)
     write (u, "(A)") "LDFLAGS_STATIC = " // char (os_data%ldflags_static)
     write (u, "(A)") "LDFLAGS_HEPMC = " // char (os_data%ldflags_hepmc)
     write (u, "(A)") "LDFLAGS_LCIO = " // char (os_data%ldflags_lcio)
     write (u, "(A)") "LDFLAGS_HOPPET = " // char (os_data%ldflags_hoppet)
     write (u, "(A)") "LDFLAGS_LOOPTOOLS = " // char (os_data%ldflags_looptools)
     write (u, "(A)") "LDWHIZARD = " // char (os_data%whizard_ldflags)
     write (u, "(A)") ""
     write (u, "(A)") "# Libtool"
     write (u, "(A)") "LIBTOOL = " // char (os_data%whizard_libtool)
     if (verbose) then
        write (u, "(A)") "FCOMPILE = $(LIBTOOL) --tag=FC --mode=compile"
        write (u, "(A)") "LINK = $(LIBTOOL) --tag=FC --mode=link"
     else
        write (u, "(A)") "FCOMPILE = @$(LIBTOOL) --silent --tag=FC --mode=compile"
        write (u, "(A)") "LINK = @$(LIBTOOL) --silent --tag=FC --mode=link"
     end if
     write (u, "(A)") ""
     write (u, "(A)") "# Compile commands (default)"
     write (u, "(A)") "LTFCOMPILE = $(FCOMPILE) $(FC) -c $(FCINCL) $(FCFLAGS)"
     write (u, "(A)") ""
     write (u, "(A)") "# Default target"
     write (u, "(A)") "all: link"
     write (u, "(A)") ""
     write (u, "(A)") "# Libraries"
     do i = 1, size (compilation%lib_name)
        associate (lib_name => compilation%lib_name(i))
          write (u, "(A)") "LIBRARIES += " // char (lib_name) // ".la"
          write (u, "(A)") char (lib_name) // ".la:"
          write (u, "(A)") TAB // "$(MAKE) -f " // char (lib_name) // ".makefile"
        end associate
     end do
     write (u, "(A)") ""
     write (u, "(A)") "# Library dispatcher"
     write (u, "(A)") "DISP = $(EXE)_prclib_dispatcher"
     write (u, "(A)") "$(DISP).lo: $(DISP).f90 $(LIBRARIES)"
     if (.not. verbose) then
        write (u, "(A)")  TAB // '@echo  "  FC       " $@'
     end if
     write (u, "(A)") TAB // "$(LTFCOMPILE) $<"
     write (u, "(A)") ""
     write (u, "(A)") "# Executable"
     write (u, "(A)") "$(EXE): $(DISP).lo $(LIBRARIES)"
     if (.not. verbose) then
        write (u, "(A)")  TAB // '@echo  "  FCLD     " $@'
     end if
     write (u, "(A)") TAB // "$(LINK) $(FC) -static $(FCFLAGS) \"
     write (u, "(A)") TAB // "   $(LDWHIZARD) $(LDFLAGS) \"
     write (u, "(A)") TAB // "   -o $(EXE) $^ \"
     write (u, "(A)") TAB // "   $(LDFLAGS_HEPMC) $(LDFLAGS_LCIO) $(LDFLAGS_HOPPET) \"
     write (u, "(A)") TAB // "   $(LDFLAGS_LOOPTOOLS) $(LDFLAGS_STATIC)" // char (ext_tag)
     write (u, "(A)") ""
     write (u, "(A)") "# Main targets"
     write (u, "(A)") "link: compile $(EXE)"
     write (u, "(A)") "compile: $(LIBRARIES) $(DISP).lo"
     write (u, "(A)") ".PHONY: link compile"
     write (u, "(A)") ""
     write (u, "(A)") "# Cleanup targets"
     write (u, "(A)") "clean-exe:"
     write (u, "(A)") TAB // "rm -f $(EXE)"
     write (u, "(A)") "clean-objects:"
     write (u, "(A)") TAB // "rm -f $(DISP).lo"
     write (u, "(A)") "clean-source:"
     write (u, "(A)") TAB // "rm -f $(DISP).f90"
     write (u, "(A)") "clean-makefile:"
     write (u, "(A)") TAB // "rm -f $(EXE).makefile"
     write (u, "(A)") ""
     write (u, "(A)") "clean: clean-exe clean-objects clean-source"
     write (u, "(A)") "distclean: clean clean-makefile"
     write (u, "(A)") ".PHONY: clean distclean"
     close (u)
   end subroutine compilation_write_makefile
 
 @ %def compilation_write_makefile
 @ Compile the dispatcher source code.
 <<Compilations: compilation: TBP>>=
   procedure :: make_compile => compilation_make_compile
 <<Compilations: procedures>>=
   subroutine compilation_make_compile (compilation, os_data)
     class(compilation_t), intent(in) :: compilation
     type(os_data_t), intent(in) :: os_data
     call os_system_call ("make compile " // os_data%makeflags &
          // " -f " // compilation%exe_name // ".makefile")
   end subroutine compilation_make_compile
 
 @ %def compilation_make_compile
 @ Link the dispatcher together with all matrix-element code and the
 \whizard\ and \oMega\ main libraries, to generate a static executable.
 <<Compilations: compilation: TBP>>=
   procedure :: make_link => compilation_make_link
 <<Compilations: procedures>>=
   subroutine compilation_make_link (compilation, os_data)
     class(compilation_t), intent(in) :: compilation
     type(os_data_t), intent(in) :: os_data
     call os_system_call ("make link " // os_data%makeflags &
          // " -f " // compilation%exe_name // ".makefile")
   end subroutine compilation_make_link
 
 @ %def compilation_make_link
 @ Cleanup.
 <<Compilations: compilation: TBP>>=
   procedure :: make_clean_exe => compilation_make_clean_exe
 <<Compilations: procedures>>=
   subroutine compilation_make_clean_exe (compilation, os_data)
     class(compilation_t), intent(in) :: compilation
     type(os_data_t), intent(in) :: os_data
     call os_system_call ("make clean-exe " // os_data%makeflags &
          // " -f " // compilation%exe_name // ".makefile")
   end subroutine compilation_make_clean_exe
 
 @ %def compilation_make_clean_exe
 @
 \subsection{API for executable compilation}
 This is a shorthand for compiling and loading an executable, including
 the enclosed libraries.  The [[compilation]] object is used only internally.
 
 The [[global]] data set may actually be local to the caller.  The
 compilation affects the library specified by its name if it is on the
 stack, but it does not reset the currently selected library.
 <<Compilations: public>>=
   public :: compile_executable
 <<Compilations: procedures>>=
   subroutine compile_executable (exename, libname, global)
     type(string_t), intent(in) :: exename
     type(string_t), dimension(:), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: global
     type(compilation_t) :: compilation
     type(compilation_item_t) :: item
     type(string_t) :: ext_libtag
     logical :: force, recompile, verbose
     integer :: i
     ext_libtag = ""
     force = &
          global%var_list%get_lval (var_str ("?rebuild_library"))
     recompile = &
          global%var_list%get_lval (var_str ("?recompile_library"))
     verbose = &
          global%var_list%get_lval (var_str ("?me_verbose"))
     call compilation%init (exename, [libname])
     if (signal_is_pending ())  return
     call compilation%write_dispatcher ()
     if (signal_is_pending ())  return
     do i = 1, size (libname)
        call item%init (libname(i), global%prclib_stack, global%var_list)
        call item%compile (global%model, global%os_data, &
             force=force, recompile=recompile)
        ext_libtag = "" // item%lib%get_static_modelname (global%os_data)
        if (signal_is_pending ())  return
        call item%success ()
     end do
     call compilation%write_makefile &
          (global%os_data, ext_libtag=ext_libtag, verbose=verbose)
     if (signal_is_pending ())  return
     call compilation%make_compile (global%os_data)
     if (signal_is_pending ())  return
     call compilation%make_link (global%os_data)
   end subroutine compile_executable
 
 @ %def compile_executable
 @
 \subsection{Unit Tests}
 Test module, followed by the stand-alone unit-test procedures.
 <<[[compilations_ut.f90]]>>=
 <<File header>>
 
 module compilations_ut
   use unit_tests
   use compilations_uti
 
 <<Standard module head>>
 
 <<Compilations: public test>>
 
 contains
 
 <<Compilations: test driver>>
 
 end module compilations_ut
 @ %def compilations_ut
 @
 <<[[compilations_uti.f90]]>>=
 <<File header>>
 
 module compilations_uti
 
 <<Use strings>>
   use io_units
   use models
   use rt_data
   use process_configurations_ut, only: prepare_test_library
 
   use compilations
 
 <<Standard module head>>
 
 <<Compilations: test declarations>>
 
 contains
 
 <<Compilations: tests>>
 
 end module compilations_uti
 
 @ %def compilations_uti
 @ API: driver for the unit tests below.
 <<Compilations: public test>>=
   public :: compilations_test
 <<Compilations: test driver>>=
   subroutine compilations_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Compilations: execute tests>>
 end subroutine compilations_test
 
 @ %def compilations_test
 @
 \subsubsection{Intrinsic Matrix Element}
 Compile an intrinsic test matrix element ([[prc_test]] type).
 
 Note: In this and the following test, we reset the Fortran compiler and flag
 variables immediately before they are printed, so the test is portable.
 <<Compilations: execute tests>>=
   call test (compilations_1, "compilations_1", &
        "intrinsic test processes", &
        u, results)
 <<Compilations: test declarations>>=
   public :: compilations_1
 <<Compilations: tests>>=
   subroutine compilations_1 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: compilations_1"
     write (u, "(A)")  "*   Purpose: configure and compile test process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     libname = "compilation_1"
     procname = "prc_comp_1"
     call prepare_test_library (global, libname, 1, [procname])
 
     call compile_library (libname, global)
 
     call global%write_libraries (u)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: compilations_1"
 
   end subroutine compilations_1
 
 @ %def compilations_1
 @
 \subsubsection{External Matrix Element}
 Compile an external test matrix element ([[omega]] type)
 <<Compilations: execute tests>>=
   call test (compilations_2, "compilations_2", &
        "external process (omega)", &
        u, results)
 <<Compilations: test declarations>>=
   public :: compilations_2
 <<Compilations: tests>>=
   subroutine compilations_2 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: compilations_2"
     write (u, "(A)")  "*   Purpose: configure and compile test process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     libname = "compilation_2"
     procname = "prc_comp_2"
     call prepare_test_library (global, libname, 2, [procname,procname])
 
     call compile_library (libname, global)
 
     call global%write_libraries (u, libpath = .false.)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: compilations_2"
 
   end subroutine compilations_2
 
 @ %def compilations_2
 @
 \subsubsection{External Matrix Element}
 Compile an external test matrix element ([[omega]] type) and
 create driver files for a static executable.
 <<Compilations: execute tests>>=
   call test (compilations_3, "compilations_3", &
        "static executable: driver", &
        u, results)
 <<Compilations: test declarations>>=
   public :: compilations_3
 <<Compilations: tests>>=
   subroutine compilations_3 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname, exename
     type(rt_data_t), target :: global
     type(compilation_t) :: compilation
     integer :: u_file
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: compilations_3"
     write (u, "(A)")  "*   Purpose: make static executable"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize library"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     libname = "compilations_3_lib"
     procname = "prc_comp_3"
     exename = "compilations_3"
 
     call prepare_test_library (global, libname, 2, [procname,procname])
 
     call compilation%init (exename, [libname])
     call compilation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write dispatcher"
     write (u, "(A)")
 
     call compilation%write_dispatcher ()
 
     u_file = free_unit ()
     open (u_file, file = char (exename) // "_prclib_dispatcher.f90", &
          status = "old", action = "read")
     do
        read (u_file, "(A)", end = 1)  buffer
        write (u, "(A)")  trim (buffer)
     end do
 1   close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write Makefile"
     write (u, "(A)")
 
     associate (os_data => global%os_data)
       os_data%fc = "fortran-compiler"
       os_data%whizard_includes = "my-includes"
       os_data%fcflags = "my-fcflags"
       os_data%ldflags = "my-ldflags"
       os_data%ldflags_static = "my-ldflags-static"
       os_data%ldflags_hepmc = "my-ldflags-hepmc"
       os_data%ldflags_lcio = "my-ldflags-lcio"
       os_data%ldflags_hoppet = "my-ldflags-hoppet"
       os_data%ldflags_looptools = "my-ldflags-looptools"
       os_data%whizard_ldflags = "my-ldwhizard"
       os_data%whizard_libtool = "my-libtool"
     end associate
 
     call compilation%write_makefile (global%os_data, verbose = .true.)
 
     open (u_file, file = char (exename) // ".makefile", &
          status = "old", action = "read")
     do
        read (u_file, "(A)", end = 2)  buffer
        write (u, "(A)")  trim (buffer)
     end do
 2   close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: compilations_3"
 
   end subroutine compilations_3
 
 @ %def compilations_3
 @
 \subsection{Test static build}
 The tests for building a static executable are separate, since they
 should be skipped if the \whizard\ build itself has static libraries
 disabled.
 <<Compilations: public test>>=
   public :: compilations_static_test
 <<Compilations: test driver>>=
   subroutine compilations_static_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Compilations: static tests>>
 end subroutine compilations_static_test
 
 @ %def compilations_static_test
 @
 \subsubsection{External Matrix Element}
 Compile an external test matrix element ([[omega]] type) and
 incorporate this in a new static WHIZARD executable.
 <<Compilations: static tests>>=
   call test (compilations_static_1, "compilations_static_1", &
        "static executable: compilation", &
        u, results)
 <<Compilations: test declarations>>=
   public :: compilations_static_1
 <<Compilations: tests>>=
   subroutine compilations_static_1 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname, exename
     type(rt_data_t), target :: global
     type(compilation_item_t) :: item
     type(compilation_t) :: compilation
     logical :: exist
 
     write (u, "(A)")  "* Test output: compilations_static_1"
     write (u, "(A)")  "*   Purpose: make static executable"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize library"
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     libname = "compilations_static_1_lib"
     procname = "prc_comp_stat_1"
     exename = "compilations_static_1"
 
     call prepare_test_library (global, libname, 2, [procname,procname])
 
     call compilation%init (exename, [libname])
 
     write (u, "(A)")
     write (u, "(A)")  "* Write dispatcher"
 
     call compilation%write_dispatcher ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Write Makefile"
 
     call compilation%write_makefile (global%os_data, verbose = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build libraries"
 
     call item%init (libname, global%prclib_stack, global%var_list)
     call item%compile &
          (global%model, global%os_data, force=.true., recompile=.false.)
     call item%success ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Check executable (should be absent)"
     write (u, "(A)")
 
     call compilation%make_clean_exe (global%os_data)
     inquire (file = char (exename), exist = exist)
     write (u, "(A,A,L1)")  char (exename), " exists = ", exist
 
     write (u, "(A)")
     write (u, "(A)")  "* Build executable"
     write (u, "(A)")
 
     call compilation%make_compile (global%os_data)
     call compilation%make_link (global%os_data)
 
     write (u, "(A)")  "* Check executable (should be present)"
     write (u, "(A)")
 
     inquire (file = char (exename), exist = exist)
     write (u, "(A,A,L1)")  char (exename), " exists = ", exist
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call compilation%make_clean_exe (global%os_data)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: compilations_static_1"
 
   end subroutine compilations_static_1
 
 @ %def compilations_static_1
 @
 \subsubsection{External Matrix Element}
 Compile an external test matrix element ([[omega]] type) and
 incorporate this in a new static WHIZARD executable.  In this version,
 we use the wrapper [[compile_executable]] procedure.
 <<Compilations: static tests>>=
   call test (compilations_static_2, "compilations_static_2", &
        "static executable: shortcut", &
        u, results)
 <<Compilations: test declarations>>=
   public :: compilations_static_2
 <<Compilations: tests>>=
   subroutine compilations_static_2 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname, exename
     type(rt_data_t), target :: global
     logical :: exist
     integer :: u_file
 
     write (u, "(A)")  "* Test output: compilations_static_2"
     write (u, "(A)")  "*   Purpose: make static executable"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize library and compile"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     libname = "compilations_static_2_lib"
     procname = "prc_comp_stat_2"
     exename = "compilations_static_2"
 
     call prepare_test_library (global, libname, 2, [procname,procname])
 
     call compile_executable (exename, [libname], global)
 
     write (u, "(A)")  "* Check executable (should be present)"
     write (u, "(A)")
 
     inquire (file = char (exename), exist = exist)
     write (u, "(A,A,L1)")  char (exename), " exists = ", exist
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     u_file = free_unit ()
     open (u_file, file = char (exename), status = "old", action = "write")
     close (u_file, status = "delete")
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: compilations_static_2"
 
   end subroutine compilations_static_2
 
 @ %def compilations_static_2
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Integration}
 This module manages phase space setup, matrix-element evaluation and
 integration, as far as it is not done by lower-level routines, in particular
 in the [[processes]] module.
 <<[[integrations.f90]]>>=
 <<File header>>
 
 module integrations
 
 <<Use kinds>>
 <<Use strings>>
 <<Use debug>>
   use io_units
   use diagnostics
   use os_interface
   use cputime
   use sm_qcd
   use physics_defs
   use model_data
   use pdg_arrays
   use variables, only: var_list_t
   use eval_trees
   use sf_mappings
   use sf_base
   use phs_base
   use rng_base
   use mci_base
   use process_libraries
   use prc_core
   use process_config, only: COMP_MASTER, COMP_REAL_FIN, &
        COMP_MISMATCH, COMP_PDF, COMP_REAL, COMP_SUB, COMP_VIRT, &
        COMP_REAL_SING
   use process
   use pcm_base, only: pcm_t
   use instances
   use process_stacks
   use models
   use iterations
   use rt_data
 
   use dispatch_me_methods, only: dispatch_core
   use dispatch_beams, only: dispatch_qcd, sf_prop_t, dispatch_sf_config
   use dispatch_phase_space, only: dispatch_sf_channels
   use dispatch_phase_space, only: dispatch_phs
   use dispatch_mci, only: dispatch_mci_s, setup_grid_path
   use dispatch_transforms, only: dispatch_evt_shower_hook
 
   use compilations, only: compile_library
 
   use dispatch_fks, only: dispatch_fks_s
   use nlo_data
 <<Use mpi f08>>
 
 <<Standard module head>>
 
 <<Integrations: public>>
 
 <<Integrations: types>>
 
 contains
 
 <<Integrations: procedures>>
 
 end module integrations
 @ %def integrations
 @
 \subsection{The integration type}
 This type holds all relevant data, the integration methods operates on this.
 In contrast to the [[simulation_t]] introduced later, the [[integration_t]]
 applies to a single process.
 <<Integrations: public>>=
   public :: integration_t
 <<Integrations: types>>=
   type :: integration_t
     private
     type(string_t) :: process_id
     type(string_t) :: run_id
     type(process_t), pointer :: process => null ()
     logical :: rebuild_phs = .false.
     logical :: ignore_phs_mismatch = .false.
     logical :: phs_only = .false.
     logical :: process_has_me = .true.
     integer :: n_calls_test = 0
     logical :: vis_history = .true.
     type(string_t) :: history_filename
     type(string_t) :: log_filename
     type(helicity_selection_t) :: helicity_selection
     logical :: use_color_factors = .false.
     logical :: has_beam_pol = .false.
     logical :: combined_integration = .false.
     type(iteration_multipliers_t) :: iteration_multipliers
     type(nlo_settings_t) :: nlo_settings
    contains
    <<Integrations: integration: TBP>>
   end type integration_t
 
 @ %def integration_t
 @
 @
 \subsection{Initialization}
 Initialization, first part: Create a process entry.
 Push it on the stack if the [[global]] environment is supplied.
 <<Integrations: integration: TBP>>=
   procedure :: create_process => integration_create_process
 <<Integrations: procedures>>=
   subroutine integration_create_process (intg, process_id, global)
     class(integration_t), intent(out) :: intg
     type(rt_data_t), intent(inout), optional, target :: global
     type(string_t), intent(in) :: process_id
     type(process_entry_t), pointer :: process_entry
     if (debug_on) call msg_debug (D_CORE, "integration_create_process")
     intg%process_id = process_id
     if (present (global)) then
        allocate (process_entry)
        intg%process => process_entry%process_t
        call global%process_stack%push (process_entry)
     else
        allocate (process_t :: intg%process)
     end if
   end subroutine integration_create_process
 
 @ %def integration_create_process
 @ Initialization, second part: Initialize the process object, using the local
 environment.  We allocate a RNG factory and a QCD object.
 We also fetch a pointer to the model that the process uses.  The
 process initializer will create a snapshot of that model.
 
 This procedure
 does not modify the [[local]] stack directly.  The intent(inout) attribute for
 the [[local]] data set is due to the random generator seed which may be
 incremented during initialization.
 
 NOTE: Changes to model parameters within the current context are respected
 only if the process model coincides with the current model.  This is the usual
 case.  If not, we read
 the model from the global model library, which has default parameters.  To
 become more flexible, we should implement a local model library which records
 local changes to currently inactive models.
 <<Integrations: integration: TBP>>=
   procedure :: init_process => integration_init_process
 <<Integrations: procedures>>=
   subroutine integration_init_process (intg, local)
     class(integration_t), intent(inout) :: intg
     type(rt_data_t), intent(inout), target :: local
     type(string_t) :: model_name
     type(model_t), pointer :: model
     class(model_data_t), pointer :: model_instance
     type(var_list_t), pointer :: var_list
     if (debug_on) call msg_debug (D_CORE, "integration_init_process")
     if (.not. local%prclib%contains (intg%process_id)) then
        call msg_fatal ("Process '" // char (intg%process_id) // "' not found" &
             // " in library '" // char (local%prclib%get_name ()) // "'")
        return
     end if
     model_name = local%prclib%get_model_name (intg%process_id)
     if (local%get_sval (var_str ("$model_name")) == model_name) then
        model => local%model
     else
        model => local%model_list%get_model_ptr (model_name)
     end if
     var_list => local%get_var_list_ptr ()
     call intg%process%init (intg%process_id, &
          local%prclib, &
          local%os_data, &
          model, &
          var_list, &
          local%beam_structure)
     intg%run_id = intg%process%get_run_id ()
   end subroutine integration_init_process
 
 @ %def integration_init_process
 @ Initialization, third part: complete process configuration.
 <<Integrations: integration: TBP>>=
   procedure :: setup_process => integration_setup_process
 <<Integrations: procedures>>=
   subroutine integration_setup_process (intg, local, verbose, init_only)
     class(integration_t), intent(inout) :: intg
     type(rt_data_t), intent(inout), target :: local
     logical, intent(in), optional :: verbose
     logical, intent(in), optional :: init_only
 
     type(var_list_t), pointer :: var_list
     class(mci_t), allocatable :: mci_template
     type(sf_config_t), dimension(:), allocatable :: sf_config
     type(sf_prop_t) :: sf_prop
     type(sf_channel_t), dimension(:), allocatable :: sf_channel
     type(phs_channel_collection_t) :: phs_channel_collection
     logical :: sf_trace
     logical :: verb, initialize_only
     type(string_t) :: sf_string
     type(string_t) :: workspace
 
     verb = .true.;  if (present (verbose))  verb = verbose
 
     initialize_only = .false.
     if (present (init_only))  initialize_only = init_only
 
     call display_init_message (verb)
 
     var_list => local%get_var_list_ptr ()
     call setup_log_and_history ()
 
     associate (process => intg%process)
       call set_intg_parameters (process)
 
       call process%setup_cores (dispatch_core, &
            intg%helicity_selection, intg%use_color_factors, intg%has_beam_pol)
 
       call process%init_phs_config ()
       call process%init_components ()
 
       call process%record_inactive_components ()
       intg%process_has_me = process%has_matrix_element ()
       if (.not. intg%process_has_me) then
          call msg_warning ("Process '" &
               // char (intg%process_id) // "': matrix element vanishes")
       end if
 
       call setup_beams ()
       call setup_structure_functions ()
 
       workspace = var_list%get_sval (var_str ("$integrate_workspace"))
       if (workspace == "") then
          call process%configure_phs &
               (intg%rebuild_phs, &
               intg%ignore_phs_mismatch, &
               intg%combined_integration)
       else
          call setup_grid_path (workspace)
          call process%configure_phs &
               (intg%rebuild_phs, &
               intg%ignore_phs_mismatch, &
               intg%combined_integration, &
               workspace)
       end if
 
       call process%complete_pcm_setup ()
 
       call process%prepare_blha_cores ()
       call process%create_blha_interface ()
       call process%prepare_any_external_code ()
 
       call process%setup_terms (with_beams = intg%has_beam_pol)
       call process%check_masses ()
 
       if (verb) then
          call process%write (screen = .true.)
          call process%print_phs_startup_message ()
       end if
 
       if (intg%process_has_me) then
          if (size (sf_config) > 0) then
             call process%collect_channels (phs_channel_collection)
          else if (.not. initialize_only &
               .and. process%contains_trivial_component ()) then
             call msg_fatal ("Integrate: 2 -> 1 process can't be handled &
                  &with fixed-energy beams")
          end if
          call dispatch_sf_channels &
               (sf_channel, sf_string, sf_prop, phs_channel_collection, &
               local%var_list, local%get_sqrts(), local%beam_structure)
          if (allocated (sf_channel)) then
             if (size (sf_channel) > 0) then
                call process%set_sf_channel (sf_channel)
             end if
          end if
          call phs_channel_collection%final ()
          if (verb)  call process%sf_startup_message (sf_string)
       end if
 
       call process%setup_mci (dispatch_mci_s)
 
       call setup_expressions ()
 
       call process%compute_md5sum ()
     end associate
 
   contains
 
     subroutine setup_log_and_history ()
        if (intg%run_id /= "") then
           intg%history_filename = intg%process_id // "." // intg%run_id &
                // ".history"
           intg%log_filename = intg%process_id // "." // intg%run_id // ".log"
        else
           intg%history_filename = intg%process_id // ".history"
           intg%log_filename = intg%process_id // ".log"
        end if
        intg%vis_history = &
           var_list%get_lval (var_str ("?vis_history"))
     end subroutine setup_log_and_history
 
     subroutine set_intg_parameters (process)
       type(process_t), intent(in) :: process
       intg%n_calls_test = &
            var_list%get_ival (var_str ("n_calls_test"))
       intg%combined_integration = &
            var_list%get_lval (var_str ('?combined_nlo_integration')) &
            .and. process%is_nlo_calculation ()
       intg%use_color_factors = &
            var_list%get_lval (var_str ("?read_color_factors"))
       intg%has_beam_pol = &
            local%beam_structure%has_polarized_beams ()
       intg%helicity_selection = &
            local%get_helicity_selection ()
       intg%rebuild_phs = &
            var_list%get_lval (var_str ("?rebuild_phase_space"))
       intg%ignore_phs_mismatch = &
          .not. var_list%get_lval (var_str ("?check_phs_file"))
       intg%phs_only = &
            var_list%get_lval (var_str ("?phs_only"))
     end subroutine set_intg_parameters
 
     subroutine display_init_message (verb)
       logical, intent(in) :: verb
       if (verb) then
          call msg_message ("Initializing integration for process " &
               // char (intg%process_id) // ":")
          if (intg%run_id /= "") &
               call msg_message ("Run ID = " // '"' // char (intg%run_id) // '"')
       end if
     end subroutine display_init_message
 
     subroutine setup_beams ()
       real(default) :: sqrts
       logical :: decay_rest_frame
       sqrts = local%get_sqrts ()
       decay_rest_frame = &
            var_list%get_lval (var_str ("?decay_rest_frame"))
       if (intg%process_has_me) then
          call intg%process%setup_beams_beam_structure &
               (local%beam_structure, sqrts, decay_rest_frame)
       end if
       if (verb .and. intg%process_has_me) then
          call intg%process%beams_startup_message &
               (beam_structure = local%beam_structure)
       end if
     end subroutine setup_beams
 
     subroutine setup_structure_functions ()
       integer :: n_in
       type(pdg_array_t), dimension(:,:), allocatable :: pdg_prc
       type(string_t) :: sf_trace_file
       if (intg%process_has_me) then
          call intg%process%get_pdg_in (pdg_prc)
       else
          n_in = intg%process%get_n_in ()
          allocate (pdg_prc (n_in, intg%process%get_n_components ()))
          pdg_prc = 0
       end if
       call dispatch_sf_config (sf_config, sf_prop, local%beam_structure, &
            local%get_var_list_ptr (), local%var_list, &
            local%model, local%os_data, local%get_sqrts (), pdg_prc)
 
       sf_trace = &
            var_list%get_lval (var_str ("?sf_trace"))
       sf_trace_file = &
            var_list%get_sval (var_str ("$sf_trace_file"))
       if (sf_trace) then
          call intg%process%init_sf_chain (sf_config, sf_trace_file)
       else
          call intg%process%init_sf_chain (sf_config)
       end if
     end subroutine setup_structure_functions
 
     subroutine setup_expressions ()
       type(eval_tree_factory_t) :: expr_factory
       if (associated (local%pn%cuts_lexpr)) then
          if (verb)  call msg_message ("Applying user-defined cuts.")
          call expr_factory%init (local%pn%cuts_lexpr)
          call intg%process%set_cuts (expr_factory)
       else
          if (verb)  call msg_warning ("No cuts have been defined.")
       end if
       if (associated (local%pn%scale_expr)) then
          if (verb) call msg_message ("Using user-defined general scale.")
          call expr_factory%init (local%pn%scale_expr)
          call intg%process%set_scale (expr_factory)
       end if
       if (associated (local%pn%fac_scale_expr)) then
          if (verb) call msg_message ("Using user-defined factorization scale.")
          call expr_factory%init (local%pn%fac_scale_expr)
          call intg%process%set_fac_scale (expr_factory)
       end if
       if (associated (local%pn%ren_scale_expr)) then
          if (verb) call msg_message ("Using user-defined renormalization scale.")
          call expr_factory%init (local%pn%ren_scale_expr)
          call intg%process%set_ren_scale (expr_factory)
       end if
       if (associated (local%pn%weight_expr)) then
          if (verb) call msg_message ("Using user-defined reweighting factor.")
          call expr_factory%init (local%pn%weight_expr)
          call intg%process%set_weight (expr_factory)
       end if
     end subroutine setup_expressions
   end subroutine integration_setup_process
 
 @ %def integration_setup_process
 @
 \subsection{Integration}
 Integrate: do the final integration.  Here, we do a multi-iteration
 integration.  Again, we skip iterations that are already on file.
 Record the results in the global variable list.
 <<Integrations: integration: TBP>>=
   procedure :: evaluate => integration_evaluate
 <<Integrations: procedures>>=
   subroutine integration_evaluate &
        (intg, process_instance, i_mci, pass, it_list, pacify)
     class(integration_t), intent(inout) :: intg
     type(process_instance_t), intent(inout), target :: process_instance
     integer, intent(in) :: i_mci
     integer, intent(in) :: pass
     type(iterations_list_t), intent(in) :: it_list
     logical, intent(in), optional :: pacify
     integer :: n_calls, n_it
     logical :: adapt_grids, adapt_weights, final
     n_it = it_list%get_n_it (pass)
     n_calls = it_list%get_n_calls (pass)
     adapt_grids = it_list%adapt_grids (pass)
     adapt_weights = it_list%adapt_weights (pass)
     final = pass == it_list%get_n_pass ()
     call process_instance%integrate ( &
          i_mci, n_it, n_calls, adapt_grids, adapt_weights, &
          final, pacify)
   end subroutine integration_evaluate
 
 @ %def integration_evaluate
 @ In case the user has not provided a list of iterations, make a
 reasonable default.  This can depend on the process.  The usual
 approach is to define two distinct passes, one for adaptation and one
 for integration.
 <<Integrations: integration: TBP>>=
   procedure :: make_iterations_list => integration_make_iterations_list
 <<Integrations: procedures>>=
   subroutine integration_make_iterations_list (intg, it_list)
     class(integration_t), intent(in) :: intg
     type(iterations_list_t), intent(out) :: it_list
     integer :: pass, n_pass
     integer, dimension(:), allocatable :: n_it, n_calls
     logical, dimension(:), allocatable :: adapt_grids, adapt_weights
     n_pass = intg%process%get_n_pass_default ()
     allocate (n_it (n_pass), n_calls (n_pass))
     allocate (adapt_grids (n_pass), adapt_weights (n_pass))
     do pass = 1, n_pass
        n_it(pass)          = intg%process%get_n_it_default (pass)
        n_calls(pass)       = intg%process%get_n_calls_default (pass)
        adapt_grids(pass)   = intg%process%adapt_grids_default (pass)
        adapt_weights(pass) = intg%process%adapt_weights_default (pass)
     end do
     call it_list%init (n_it, n_calls, &
          adapt_grids = adapt_grids, adapt_weights = adapt_weights)
   end subroutine integration_make_iterations_list
 
 @ %def integration_make_iterations_list
 @ In NLO calculations, the individual components might scale very differently
 with the number of calls. This especially applies to the real-subtracted
 component, which usually fluctuates more than the Born and virtual
 component, making it a bottleneck of the calculation. Thus, the calculation
 is throttled twice, first by the number of calls for the real component,
 second by the number of surplus calls of computation-intense virtual
 matrix elements. Therefore, we want to set a different number of calls
 for each component, which is done by the subroutine [[integration_apply_call_multipliers]].
 <<Integrations: integration: TBP>>=
   procedure :: init_iteration_multipliers => integration_init_iteration_multipliers
 <<Integrations: procedures>>=
   subroutine integration_init_iteration_multipliers (intg, local)
     class(integration_t), intent(inout) :: intg
     type(rt_data_t), intent(in) :: local
     integer :: n_pass, pass
     type(iterations_list_t) :: it_list
     n_pass = local%it_list%get_n_pass ()
     if (n_pass == 0) then
        call intg%make_iterations_list (it_list)
        n_pass = it_list%get_n_pass ()
     end if
     associate (it_multipliers => intg%iteration_multipliers)
        allocate (it_multipliers%n_calls0 (n_pass))
        do pass = 1, n_pass
           it_multipliers%n_calls0(pass) = local%it_list%get_n_calls (pass)
        end do
        it_multipliers%mult_real = local%var_list%get_rval &
            (var_str ("mult_call_real"))
        it_multipliers%mult_virt = local%var_list%get_rval &
            (var_str ("mult_call_virt"))
        it_multipliers%mult_dglap = local%var_list%get_rval &
            (var_str ("mult_call_dglap"))
     end associate
   end subroutine integration_init_iteration_multipliers
 
 @ %def integration_init_iteration_multipliers
 @
 <<Integrations: integration: TBP>>=
   procedure :: apply_call_multipliers => integration_apply_call_multipliers
 <<Integrations: procedures>>=
   subroutine integration_apply_call_multipliers (intg, n_pass, i_component, it_list)
     class(integration_t), intent(in) :: intg
     integer, intent(in) :: n_pass, i_component
     type(iterations_list_t), intent(inout) :: it_list
     integer :: nlo_type
     integer :: n_calls0, n_calls
     integer :: pass
     real(default) :: multiplier
     nlo_type = intg%process%get_component_nlo_type (i_component)
     do pass = 1, n_pass
        associate (multipliers => intg%iteration_multipliers)
          select case (nlo_type)
          case (NLO_REAL)
             multiplier = multipliers%mult_real
          case (NLO_VIRTUAL)
             multiplier = multipliers%mult_virt
          case (NLO_DGLAP)
             multiplier = multipliers%mult_dglap
          case default
             return
          end select
        end associate
        if (n_pass <= size (intg%iteration_multipliers%n_calls0)) then
           n_calls0 = intg%iteration_multipliers%n_calls0 (pass)
           n_calls = floor (multiplier * n_calls0)
           call it_list%set_n_calls (pass, n_calls)
        end if
     end do
   end subroutine integration_apply_call_multipliers
 
 @ %def integration_apply_call_multipliers
 @
 \subsection{API for integration objects}
 This initializer does everything except assigning cuts/scale/weight
 expressions.
 <<Integrations: integration: TBP>>=
   procedure :: init => integration_init
 <<Integrations: procedures>>=
   subroutine integration_init &
        (intg, process_id, local, global, local_stack, init_only)
     class(integration_t), intent(out) :: intg
     type(string_t), intent(in) :: process_id
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     logical, intent(in), optional :: init_only
     logical, intent(in), optional :: local_stack
     logical :: use_local
     use_local = .false.;  if (present (local_stack))  use_local = local_stack
     if (present (global)) then
        call intg%create_process (process_id, global)
     else if (use_local) then
        call intg%create_process (process_id, local)
     else
        call intg%create_process (process_id)
     end if
     call intg%init_process (local)
     call intg%setup_process (local, init_only = init_only)
     call intg%init_iteration_multipliers (local)
   end subroutine integration_init
 
 @ %def integration_init
 @ Do the integration for a single process, both warmup and final evaluation.
 The [[eff_reset]] flag is to suppress numerical noise in the graphical output
 of the integration history.
 <<Integrations: integration: TBP>>=
   procedure :: integrate => integration_integrate
 <<Integrations: procedures>>=
   subroutine integration_integrate (intg, local, eff_reset)
     class(integration_t), intent(inout) :: intg
     type(rt_data_t), intent(in), target :: local
     logical, intent(in), optional :: eff_reset
     type(string_t) :: log_filename
     type(var_list_t), pointer :: var_list
     type(process_instance_t), allocatable, target :: process_instance
     type(iterations_list_t) :: it_list
     logical :: pacify
     integer :: pass, i_mci, n_mci, n_pass
     integer :: i_component
     integer :: nlo_type
     logical :: display_summed
     logical :: nlo_active
     type(string_t) :: component_output
 
     allocate (process_instance)
     call process_instance%init (intg%process)
 
     var_list => intg%process%get_var_list_ptr ()
     call openmp_set_num_threads_verbose &
          (var_list%get_ival (var_str ("openmp_num_threads")), &
           var_list%get_lval (var_str ("?openmp_logging")))
     pacify = var_list%get_lval (var_str ("?pacify"))
 
     display_summed = .true.
     n_mci = intg%process%get_n_mci ()
     if (n_mci == 1) then
        write (msg_buffer, "(A,A,A)") &
             "Starting integration for process '", &
             char (intg%process%get_id ()), "'"
        call msg_message ()
     end if
 
     call setup_hooks ()
 
     nlo_active = any (intg%process%get_component_nlo_type &
          ([(i_mci, i_mci = 1, n_mci)]) /= BORN)
     do i_mci = 1, n_mci
        i_component = intg%process%get_master_component (i_mci)
        nlo_type = intg%process%get_component_nlo_type (i_component)
        if (intg%process%component_can_be_integrated (i_component)) then
           if (n_mci > 1) then
              if (nlo_active) then
                 if (intg%combined_integration .and. nlo_type == BORN) then
                    component_output = var_str ("Combined")
                 else
                    component_output = component_status (nlo_type)
                 end if
                 write (msg_buffer, "(A,A,A,A,A)") &
                      "Starting integration for process '", &
                      char (intg%process%get_id ()), "' part '", &
                      char (component_output), "'"
              else
                 write (msg_buffer, "(A,A,A,I0)") &
                      "Starting integration for process '", &
                      char (intg%process%get_id ()), "' part ", i_mci
              end if
              call msg_message ()
           end if
           n_pass = local%it_list%get_n_pass ()
           if (n_pass == 0) then
              call msg_message ("Integrate: iterations not specified, &
                   &using default")
              call intg%make_iterations_list (it_list)
              n_pass = it_list%get_n_pass ()
           else
              it_list = local%it_list
           end if
           call intg%apply_call_multipliers (n_pass, i_mci, it_list)
           call msg_message ("Integrate: " // char (it_list%to_string ()))
           do pass = 1, n_pass
              call intg%evaluate (process_instance, i_mci, pass, it_list, pacify)
              if (signal_is_pending ())  return
           end do
           call intg%process%final_integration (i_mci)
           if (intg%vis_history) then
              call intg%process%display_integration_history &
                   (i_mci, intg%history_filename, local%os_data, eff_reset)
           end if
           if (local%logfile == intg%log_filename) then
              if (intg%run_id /= "") then
                 log_filename = intg%process_id // "." // intg%run_id // &
                      ".var.log"
              else
                 log_filename = intg%process_id // ".var.log"
              end if
              call msg_message ("Name clash for global logfile and process log: ", &
                   arr =[var_str ("| Renaming log file from ") // local%logfile, &
                         var_str ("|   to ") // log_filename // var_str (" .")])
           else
              log_filename = intg%log_filename
           end if
           call intg%process%write_logfile (i_mci, log_filename)
        end if
     end do
 
     if (n_mci > 1 .and. display_summed) then
        call msg_message ("Integrate: sum of all components")
        call intg%process%display_summed_results (pacify)
     end if
 
     call process_instance%final ()
     deallocate (process_instance)
   contains
     subroutine setup_hooks ()
       class(process_instance_hook_t), pointer :: hook
       call dispatch_evt_shower_hook (hook, var_list, process_instance)
       if (associated (hook)) then
          call process_instance%append_after_hook (hook)
       end if
     end subroutine setup_hooks
   end subroutine integration_integrate
 
 @ %def integration_integrate
 @ Do a dummy integration for a process which could not be initialized (e.g.,
 has no matrix element).  The result is zero.
 <<Integrations: integration: TBP>>=
   procedure :: integrate_dummy => integration_integrate_dummy
 <<Integrations: procedures>>=
   subroutine integration_integrate_dummy (intg)
     class(integration_t), intent(inout) :: intg
     call intg%process%integrate_dummy ()
   end subroutine integration_integrate_dummy
 
 @ %def integration_integrate_dummy
 @ Just sample the matrix element under realistic conditions (but no
 cuts); throw away the results.
 <<Integrations: integration: TBP>>=
   procedure :: sampler_test => integration_sampler_test
 <<Integrations: procedures>>=
   subroutine integration_sampler_test (intg)
     class(integration_t), intent(inout) :: intg
     type(process_instance_t), allocatable, target :: process_instance
     integer :: n_mci, i_mci
     type(timer_t) :: timer_mci, timer_tot
     real(default) :: t_mci, t_tot
     allocate (process_instance)
     call process_instance%init (intg%process)
     n_mci = intg%process%get_n_mci ()
     if (n_mci == 1) then
        write (msg_buffer, "(A,A,A)") &
             "Test: probing process '", &
             char (intg%process%get_id ()), "'"
        call msg_message ()
     end if
     call timer_tot%start ()
     do i_mci = 1, n_mci
        if (n_mci > 1) then
           write (msg_buffer, "(A,A,A,I0)") &
                "Test: probing process '", &
                char (intg%process%get_id ()), "' part ", i_mci
           call msg_message ()
        end if
        call timer_mci%start ()
        call process_instance%sampler_test (i_mci, intg%n_calls_test)
        call timer_mci%stop ()
        t_mci = timer_mci
        write (msg_buffer, "(A,ES12.5)")  "Test: " &
             // "time in seconds (wallclock): ", t_mci
        call msg_message ()
     end do
     call timer_tot%stop ()
     t_tot = timer_tot
     if (n_mci > 1) then
        write (msg_buffer, "(A,ES12.5)")  "Test: " &
             // "total time      (wallclock): ", t_tot
        call msg_message ()
     end if
     call process_instance%final ()
   end subroutine integration_sampler_test
 
 @ %def integration_sampler_test
 @ Return the process pointer (needed by simulate):
 <<Integrations: integration: TBP>>=
   procedure :: get_process_ptr => integration_get_process_ptr
 <<Integrations: procedures>>=
   function integration_get_process_ptr (intg) result (ptr)
     class(integration_t), intent(in) :: intg
     type(process_t), pointer :: ptr
     ptr => intg%process
   end function integration_get_process_ptr
 
 @ %def integration_get_process_ptr
 @ Simply integrate, do a dummy integration if necessary.  The [[integration]]
 object exists only internally.
 
 If the [[global]] environment is provided, the process object is appended to
 the global stack.  Otherwise, if [[local_stack]] is set, we append to the
 local process stack.  If this is unset, the [[process]] object is not recorded
 permanently.
 
 The [[init_only]] flag can be used to skip the actual integration part.  We
 will end up with a process object that is completely initialized, including
 phase space configuration.
 
 The [[eff_reset]] flag is to suppress numerical noise in the visualization
 of the integration history.
 <<Integrations: public>>=
   public :: integrate_process
 <<Integrations: procedures>>=
   subroutine integrate_process (process_id, local, global, local_stack, init_only, eff_reset)
     type(string_t), intent(in) :: process_id
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     logical, intent(in), optional :: local_stack, init_only, eff_reset
     type(string_t) :: prclib_name
     type(integration_t) :: intg
     character(32) :: buffer
   <<Integrations: integrate process: variables>>
   <<Integrations: integrate process: init>>
     if (.not. associated (local%prclib)) then
        call msg_fatal ("Integrate: current process library is undefined")
        return
     end if
 
     if (.not. local%prclib%is_active ()) then
        call msg_message ("Integrate: current process library needs compilation")
        prclib_name = local%prclib%get_name ()
        call compile_library (prclib_name, local)
        if (signal_is_pending ())  return
        call msg_message ("Integrate: compilation done")
     end if
 
     call intg%init (process_id, local, global, local_stack, init_only)
     if (signal_is_pending ())  return
 
     if (present (init_only)) then
        if (init_only) return
     end if
 
     if (intg%n_calls_test > 0) then
        write (buffer, "(I0)")  intg%n_calls_test
        call msg_message ("Integrate: test (" // trim (buffer) // " calls) ...")
        call intg%sampler_test ()
        call msg_message ("Integrate: ... test complete.")
        if (signal_is_pending ())  return
     end if
   <<Integrations: integrate process: end init>>
 
     if (intg%phs_only) then
        call msg_message ("Integrate: phase space only, skipping integration")
     else
        if (intg%process_has_me) then
           call intg%integrate (local, eff_reset)
        else
           call intg%integrate_dummy ()
        end if
     end if
   end subroutine integrate_process
 
 @ %def integrate_process
 <<Integrations: integrate process: variables>>=
 @
 <<Integrations: integrate process: init>>=
 @
 <<Integrations: integrate process: end init>>=
 @
 @ The parallelization leads to undefined behavior while writing simultaneously to one file.
 The master worker has to initialize single-handed the corresponding library files and the phase space file.
 The slave worker will wait with a blocking [[MPI_BCAST]] until they receive a logical flag.
 <<MPI: Integrations: integrate process: variables>>=
   type(var_list_t), pointer :: var_list
   logical :: mpi_logging, process_init
   integer :: rank, n_size
 <<MPI: Integrations: integrate process: init>>=
   if (debug_on) call msg_debug (D_MPI, "integrate_process")
   var_list => local%get_var_list_ptr ()
   process_init = .false.
   call mpi_get_comm_id (n_size, rank)
   mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) .and. &
        & (n_size > 1)) .or. var_list%get_lval (var_str ("?mpi_logging")))
   if (debug_on) call msg_debug (D_MPI, "n_size", rank)
   if (debug_on) call msg_debug (D_MPI, "rank", rank)
   if (debug_on) call msg_debug (D_MPI, "mpi_logging", mpi_logging)
   if (rank /= 0) then
      if (mpi_logging) then
         call msg_message ("MPI: wait for master to finish process initialization ...")
      end if
      call MPI_bcast (process_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
   else
      process_init = .true.
   end if
 
   if (process_init) then
 <<MPI: Integrations: integrate process: end init>>=
   if (rank == 0) then
      if (mpi_logging) then
         call msg_message ("MPI: finish process initialization, load slaves ...")
      end if
      call MPI_bcast (process_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
   end if
 end if
 call MPI_barrier (MPI_COMM_WORLD)
 call mpi_set_logging (mpi_logging)
 @ %def integrate_process_mpi
 @
 \subsection{Unit Tests}
 Test module, followed by the stand-alone unit-test procedures.
 <<[[integrations_ut.f90]]>>=
 <<File header>>
 
 module integrations_ut
   use unit_tests
   use integrations_uti
 
 <<Standard module head>>
 
 <<Integrations: public test>>
 
 contains
 
 <<Integrations: test driver>>
 
 end module integrations_ut
 @ %def integrations_ut
 @
 <<[[integrations_uti.f90]]>>=
 <<File header>>
 
 module integrations_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use ifiles
   use lexers
   use parser
   use io_units
   use flavors
   use interactions, only: reset_interaction_counter
   use phs_forests
   use eval_trees
   use models
   use rt_data
   use process_configurations_ut, only: prepare_test_library
   use compilations, only: compile_library
 
   use integrations
 
   use phs_wood_ut, only: write_test_phs_file
 
 <<Standard module head>>
 
 <<Integrations: test declarations>>
 
 contains
 
 <<Integrations: tests>>
 
 end module integrations_uti
 
 @ %def integrations_uti
 @ API: driver for the unit tests below.
 <<Integrations: public test>>=
   public :: integrations_test
 <<Integrations: test driver>>=
   subroutine integrations_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Integrations: execute tests>>
   end subroutine integrations_test
 
 @ %def integrations_test
 @
 <<Integrations: public test>>=
   public :: integrations_history_test
 <<Integrations: test driver>>=
   subroutine integrations_history_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Integrations: execute history tests>>
   end subroutine integrations_history_test
 
 @ %def integrations_history_test
 @
 \subsubsection{Integration of test process}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type).  The phase-space implementation is [[phs_single]]
 (single-particle phase space), the integrator is [[mci_midpoint]].
 
 The cross section for the $2\to 2$ process $ss\to ss$ with its
 constant matrix element is given by
 \begin{equation}
   \sigma = c\times f\times \Phi_2 \times |M|^2.
 \end{equation}
 $c$ is the conversion constant
 \begin{equation}
   c = 0.3894\times 10^{12}\;\mathrm{fb}\,\mathrm{GeV}^2.
 \end{equation}
 $f$ is the flux of the incoming particles with mass
 $m=125\,\mathrm{GeV}$ and energy $\sqrt{s}=1000\,\mathrm{GeV}$
 \begin{equation}
   f = \frac{(2\pi)^4}{2\lambda^{1/2}(s,m^2,m^2)}
     = \frac{(2\pi)^4}{2\sqrt{s}\,\sqrt{s - 4m^2}}
     = 8.048\times 10^{-4}\;\mathrm{GeV}^{-2}
 \end{equation}
 $\Phi_2$ is the volume of the two-particle phase space
 \begin{equation}
   \Phi_2 = \frac{1}{4(2\pi)^5} = 2.5529\times 10^{-5}.
 \end{equation}
 The squared matrix element $|M|^2$ is unity.
 Combining everything, we obtain
 \begin{equation}
   \sigma = 8000\;\mathrm{fb}
 \end{equation}
 This number should appear as the final result.
 
 Note: In this and the following test, we reset the Fortran compiler and flag
 variables immediately before they are printed, so the test is portable.
 <<Integrations: execute tests>>=
   call test (integrations_1, "integrations_1", &
        "intrinsic test process", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_1
 <<Integrations: tests>>=
   subroutine integrations_1 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: integrations_1"
     write (u, "(A)")  "*   Purpose: integrate test process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     libname = "integration_1"
     procname = "prc_config_a"
 
     call prepare_test_library (global, libname, 1)
     call compile_library (libname, global)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("integrations1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%write (u, vars = [ &
          var_str ("$method"), &
          var_str ("sqrts"), &
          var_str ("$integration_method"), &
          var_str ("$phs_method"), &
          var_str ("$run_id")])
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_1"
 
   end subroutine integrations_1
 
 @ %def integrations_1
 @
 \subsubsection{Integration with cuts}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) with cuts set.
 <<Integrations: execute tests>>=
   call test (integrations_2, "integrations_2", &
        "intrinsic test process with cut", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_2
 <<Integrations: tests>>=
   subroutine integrations_2 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     type(string_t) :: cut_expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: parse_tree
 
     type(string_t), dimension(0) :: empty_string_array
 
     write (u, "(A)")  "* Test output: integrations_2"
     write (u, "(A)")  "*   Purpose: integrate test process with cut"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     write (u, "(A)")  "* Prepare a cut expression"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
     cut_expr_text = "all Pt > 100 [s]"
     call ifile_append (ifile, cut_expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (parse_tree, stream, .true.)
     global%pn%cuts_lexpr => parse_tree%get_root_ptr ()
 
     write (u, "(A)")  "* Build and initialize a test process"
     write (u, "(A)")
 
     libname = "integration_3"
     procname = "prc_config_a"
 
     call prepare_test_library (global, libname, 1)
     call compile_library (libname, global)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("integrations1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%write (u, vars = empty_string_array)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_2"
 
   end subroutine integrations_2
 
 @ %def integrations_2
 @
 \subsubsection{Standard phase space}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the default ([[phs_wood]]) phase-space implementation.  We
 use an explicit phase-space configuration file with a single channel
 and integrate by [[mci_midpoint]].
 <<Integrations: execute tests>>=
   call test (integrations_3, "integrations_3", &
        "standard phase space", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_3
 <<Integrations: tests>>=
   subroutine integrations_3 (u)
   <<Use kinds>>
   <<Use strings>>
     use interactions, only: reset_interaction_counter
     use models
     use rt_data
     use process_configurations_ut, only: prepare_test_library
     use compilations, only: compile_library
     use integrations
 
     implicit none
 
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
     integer :: u_phs
 
     write (u, "(A)")  "* Test output: integrations_3"
     write (u, "(A)")  "*   Purpose: integrate test process"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
 
     libname = "integration_3"
     procname = "prc_config_a"
 
     call prepare_test_library (global, libname, 1)
     call compile_library (libname, global)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("integrations1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("default"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?phs_s_mapping"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     write (u, "(A)")  "* Create a scratch phase-space file"
     write (u, "(A)")
 
     u_phs = free_unit ()
     open (u_phs, file = "integrations_3.phs", &
          status = "replace", action = "write")
     call write_test_phs_file (u_phs, var_str ("prc_config_a_i1"))
     close (u_phs)
 
     call global%set_string (var_str ("$phs_file"),&
          var_str ("integrations_3.phs"), is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%write (u, vars = [ &
          var_str ("$phs_method"), &
          var_str ("$phs_file")])
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_3"
 
   end subroutine integrations_3
 
 @ %def integrations_3
 @
 \subsubsection{VAMP integration}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the single-channel ([[phs_single]]) phase-space
 implementation.  The integration method is [[vamp]].
 <<Integrations: execute tests>>=
   call test (integrations_4, "integrations_4", &
        "VAMP integration (one iteration)", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_4
 <<Integrations: tests>>=
   subroutine integrations_4 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: integrations_4"
     write (u, "(A)")  "*   Purpose: integrate test process using VAMP"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     libname = "integrations_4_lib"
     procname = "integrations_4"
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%pacify (efficiency_reset = .true., error_reset = .true.)
     call global%write (u, vars = [var_str ("$integration_method")], &
             pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_4"
 
   end subroutine integrations_4
 
 @ %def integrations_4
 @
 \subsubsection{Multiple iterations integration}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the single-channel ([[phs_single]]) phase-space
 implementation.  The integration method is [[vamp]].  We launch three
 iterations.
 <<Integrations: execute tests>>=
   call test (integrations_5, "integrations_5", &
        "VAMP integration (three iterations)", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_5
 <<Integrations: tests>>=
   subroutine integrations_5 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: integrations_5"
     write (u, "(A)")  "*   Purpose: integrate test process using VAMP"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     libname = "integrations_5_lib"
     procname = "integrations_5"
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([3], [1000])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%pacify (efficiency_reset = .true., error_reset = .true.)
     call global%write (u, vars = [var_str ("$integration_method")], &
             pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_5"
 
   end subroutine integrations_5
 
 @ %def integrations_5
 @
 \subsubsection{Multiple passes integration}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the single-channel ([[phs_single]]) phase-space
 implementation.  The integration method is [[vamp]].  We launch three
 passes with three iterations each.
 <<Integrations: execute tests>>=
   call test (integrations_6, "integrations_6", &
        "VAMP integration (three passes)", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_6
 <<Integrations: tests>>=
   subroutine integrations_6 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: no_vars
 
     write (u, "(A)")  "* Test output: integrations_6"
     write (u, "(A)")  "*   Purpose: integrate test process using VAMP"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     libname = "integrations_6_lib"
     procname = "integrations_6"
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([3, 3, 3], [1000, 1000, 1000], &
          adapt = [.true., .true., .false.], &
          adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%pacify (efficiency_reset = .true., error_reset = .true.)
     call global%write (u, vars = no_vars, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_6"
 
   end subroutine integrations_6
 
 @ %def integrations_6
 @
 \subsubsection{VAMP and default phase space}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the default ([[phs_wood]]) phase-space
 implementation.  The integration method is [[vamp]].  We launch three
 passes with three iterations each.  We enable channel equivalences and
 groves.
 <<Integrations: execute tests>>=
   call test (integrations_7, "integrations_7", &
        "VAMP integration with wood phase space", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_7
 <<Integrations: tests>>=
   subroutine integrations_7 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: no_vars
     integer :: iostat, u_phs
     character(95) :: buffer
     type(string_t) :: phs_file
     logical :: exist
 
     write (u, "(A)")  "* Test output: integrations_7"
     write (u, "(A)")  "*   Purpose: integrate test process using VAMP"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
 
     libname = "integrations_7_lib"
     procname = "integrations_7"
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?phs_s_mapping"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([3, 3, 3], [1000, 1000, 1000], &
          adapt = [.true., .true., .false.], &
          adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%pacify (efficiency_reset = .true., error_reset = .true.)
     call global%write (u, vars = no_vars, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Generated phase-space file"
     write (u, "(A)")
 
     phs_file = procname // ".r1.i1.phs"
     inquire (file = char (phs_file), exist = exist)
     if (exist) then
        u_phs = free_unit ()
        open (u_phs, file = char (phs_file), action = "read", status = "old")
        iostat = 0
        do while (iostat == 0)
           read (u_phs, "(A)", iostat = iostat)  buffer
           if (iostat == 0)  write (u, "(A)")  trim (buffer)
        end do
        close (u_phs)
     else
        write (u, "(A)")  "[file is missing]"
     end if
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_7"
 
   end subroutine integrations_7
 
 @ %def integrations_7
 @
 \subsubsection{Structure functions}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the default ([[phs_wood]]) phase-space
 implementation.  The integration method is [[vamp]].  There is a structure
 function of type [[unit_test]].
 
 We use a test structure function $f(x)=x$ for both beams.  Together with the
 $1/x_1x_2$ factor from the phase-space flux and a unit matrix element, we
 should get the same result as previously for the process without structure
 functions.  There is a slight correction due to the $m_s$ mass which we set to
 zero here.
 <<Integrations: execute tests>>=
   call test (integrations_8, "integrations_8", &
        "integration with structure function", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_8
 <<Integrations: tests>>=
   subroutine integrations_8 (u)
   <<Use kinds>>
   <<Use strings>>
     use interactions, only: reset_interaction_counter
     use phs_forests
     use models
     use rt_data
     use process_configurations_ut, only: prepare_test_library
     use compilations, only: compile_library
     use integrations
 
     implicit none
 
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
     type(flavor_t) :: flv
     type(string_t) :: name
 
     write (u, "(A)")  "* Test output: integrations_8"
     write (u, "(A)")  "*   Purpose: integrate test process using VAMP &
          &with structure function"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
 
     libname = "integrations_8_lib"
     procname = "integrations_8"
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?phs_s_mapping"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), 0._default)
 
     call reset_interaction_counter ()
 
     call flv%init (25, global%model)
 
     name = flv%get_name ()
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call global%it_list%init ([1], [1000])
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%write (u, vars = [var_str ("ms")])
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_8"
 
   end subroutine integrations_8
 
 @ %def integrations_8
 @
 \subsubsection{Integration with sign change}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type).  The phase-space implementation is [[phs_single]]
 (single-particle phase space), the integrator is [[mci_midpoint]].
 The weight that is applied changes the sign in half of phase space.
 The weight is $-3$ and $1$, respectively, so the total result is equal
 to the original, but negative sign.
 
 The efficiency should (approximately) become the average of $1$ and
 $1/3$, that is $2/3$.
 <<Integrations: execute tests>>=
   call test (integrations_9, "integrations_9", &
        "handle sign change", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_9
 <<Integrations: tests>>=
   subroutine integrations_9 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     type(string_t) :: wgt_expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: parse_tree
 
     write (u, "(A)")  "* Test output: integrations_9"
     write (u, "(A)")  "*   Purpose: integrate test process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     write (u, "(A)")  "* Prepare a weight expression"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
     wgt_expr_text = "eval 2 * sgn (Pz) - 1 [s]"
     call ifile_append (ifile, wgt_expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (parse_tree, stream, .true.)
     global%pn%weight_expr => parse_tree%get_root_ptr ()
 
     write (u, "(A)")  "* Build and evaluate a test process"
     write (u, "(A)")
 
     libname = "integration_9"
     procname = "prc_config_a"
 
     call prepare_test_library (global, libname, 1)
     call compile_library (libname, global)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("integrations1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%write (u, vars = [ &
          var_str ("$method"), &
          var_str ("sqrts"), &
          var_str ("$integration_method"), &
          var_str ("$phs_method"), &
          var_str ("$run_id")])
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_9"
 
   end subroutine integrations_9
 
 @ %def integrations_9
 @
 \subsubsection{Integration history for VAMP integration with default
   phase space}
 This test is only run when event analysis can be done.
 <<Integrations: execute history tests>>=
   call test (integrations_history_1, "integrations_history_1", &
        "Test integration history files", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_history_1
 <<Integrations: tests>>=
   subroutine integrations_history_1 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: no_vars
     integer :: iostat, u_his
     character(91) :: buffer
     type(string_t) :: his_file, ps_file, pdf_file
     logical :: exist, exist_ps, exist_pdf
 
     write (u, "(A)")  "* Test output: integrations_history_1"
     write (u, "(A)")  "*   Purpose: test integration history files"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
 
     libname = "integrations_history_1_lib"
     procname = "integrations_history_1"
 
     call global%set_log (var_str ("?vis_history"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?phs_s_mapping"),&
          .false., is_known = .true.)
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_real (var_str ("error_threshold"),&
          5E-6_default, is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([2, 2, 2], [1000, 1000, 1000], &
          adapt = [.true., .true., .false.], &
          adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true., &
          eff_reset = .true.)
 
     call global%pacify (efficiency_reset = .true., error_reset = .true.)
     call global%write (u, vars = no_vars, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generated history files"
     write (u, "(A)")
 
     his_file = procname // ".r1.history.tex"
     ps_file  = procname // ".r1.history.ps"
     pdf_file = procname // ".r1.history.pdf"
     inquire (file = char (his_file), exist = exist)
     if (exist) then
        u_his = free_unit ()
        open (u_his, file = char (his_file), action = "read", status = "old")
        iostat = 0
        do while (iostat == 0)
           read (u_his, "(A)", iostat = iostat)  buffer
           if (iostat == 0)  write (u, "(A)")  trim (buffer)
        end do
        close (u_his)
     else
        write (u, "(A)")  "[History LaTeX file is missing]"
     end if
     inquire (file = char (ps_file), exist = exist_ps)
     if (exist_ps) then
        write (u, "(A)")  "[History Postscript file exists and is nonempty]"
     else
        write (u, "(A)")  "[History Postscript file is missing/non-regular]"
     end if
     inquire (file = char (pdf_file), exist = exist_pdf)
     if (exist_pdf) then
        write (u, "(A)")  "[History PDF file exists and is nonempty]"
     else
        write (u, "(A)")  "[History PDF file is missing/non-regular]"
     end if
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_history_1"
 
   end subroutine integrations_history_1
 
 @ %def integrations_history_1
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Event Streams}
 This module manages I/O from/to multiple concurrent event streams.
 Usually, there is at most one input stream, but several output
 streams.  For the latter, we set up an array which can hold [[eio_t]]
 (event I/O) objects of different dynamic types simultaneously.  One of
 them may be marked as an input channel.
 <<[[event_streams.f90]]>>=
 <<File header>>
 
 module event_streams
 
 <<Use strings>>
   use io_units
   use diagnostics
   use events
   use eio_data
   use eio_base
   use rt_data
 
   use dispatch_transforms, only: dispatch_eio
 
 <<Standard module head>>
 
 <<Event streams: public>>
 
 <<Event streams: types>>
 
 contains
 
 <<Event streams: procedures>>
 
 end module event_streams
 @ %def event_streams
 @
 \subsection{Event Stream Array}
 Each entry is an [[eio_t]] object.  Since the type is dynamic, we need
 a wrapper:
 <<Event streams: types>>=
   type :: event_stream_entry_t
      class(eio_t), allocatable :: eio
   end type event_stream_entry_t
 
 @ %def event_stream_entry_t
 @ An array of event-stream entry objects.  If one of the entries is an
 input channel, [[i_in]] is the corresponding index.
 <<Event streams: public>>=
   public :: event_stream_array_t
 <<Event streams: types>>=
   type :: event_stream_array_t
      type(event_stream_entry_t), dimension(:), allocatable :: entry
      integer :: i_in = 0
    contains
    <<Event streams: event stream array: TBP>>
   end type event_stream_array_t
 
 @ %def event_stream_array_t
 @ Output.
 <<Event streams: event stream array: TBP>>=
   procedure :: write => event_stream_array_write
 <<Event streams: procedures>>=
   subroutine event_stream_array_write (object, unit)
     class(event_stream_array_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event stream array:"
     if (allocated (object%entry)) then
        select case (size (object%entry))
        case (0)
           write (u, "(3x,A)")  "[empty]"
        case default
           do i = 1, size (object%entry)
              if (i == object%i_in)  write (u, "(1x,A)")  "Input stream:"
              call object%entry(i)%eio%write (u)
           end do
        end select
     else
        write (u, "(3x,A)")  "[undefined]"
     end if
   end subroutine event_stream_array_write
 
 @ %def event_stream_array_write
 @ Finalize all streams.
 <<Event streams: event stream array: TBP>>=
   procedure :: final => event_stream_array_final
 <<Event streams: procedures>>=
   subroutine event_stream_array_final (es_array)
     class(event_stream_array_t), intent(inout) :: es_array
     integer :: i
     do i = 1, size (es_array%entry)
        call es_array%entry(i)%eio%final ()
     end do
   end subroutine event_stream_array_final
 
 @ %def event_stream_array_final
 @ Initialization.  We use a generic [[sample]] name, open event I/O
 objects for all provided stream types (using the [[dispatch_eio]]
 routine), and initialize for the given list of process pointers.  If
 there is an [[input]] argument, this channel is initialized as an input
 channel and appended to the array.
 
 The [[input_data]] or, if not present, [[data]] may be modified.  This
 happens if we open a stream for reading and get new information there.
 <<Event streams: event stream array: TBP>>=
   procedure :: init => event_stream_array_init
 <<Event streams: procedures>>=
   subroutine event_stream_array_init &
        (es_array, sample, stream_fmt, global, &
        data, input, input_sample, input_data, allow_switch, &
        checkpoint, callback, &
        error)
     class(event_stream_array_t), intent(out) :: es_array
     type(string_t), intent(in) :: sample
     type(string_t), dimension(:), intent(in) :: stream_fmt
     type(rt_data_t), intent(in) :: global
     type(event_sample_data_t), intent(inout), optional :: data
     type(string_t), intent(in), optional :: input
     type(string_t), intent(in), optional :: input_sample
     type(event_sample_data_t), intent(inout), optional :: input_data
     logical, intent(in), optional :: allow_switch
     integer, intent(in), optional :: checkpoint
     integer, intent(in), optional :: callback
     logical, intent(out), optional :: error
     type(string_t) :: sample_in
     integer :: n, i, n_output, i_input, i_checkpoint, i_callback
     logical :: success, switch
     if (present (input_sample)) then
        sample_in = input_sample
     else
        sample_in = sample
     end if
     if (present (allow_switch)) then
        switch = allow_switch
     else
        switch = .true.
     end if
     if (present (error)) then
        error = .false.
     end if
     n = size (stream_fmt)
     n_output = n
     if (present (input)) then
        n = n + 1
        i_input = n
     else
        i_input = 0
     end if
     if (present (checkpoint)) then
        n = n + 1
        i_checkpoint = n
     else
        i_checkpoint = 0
     end if
     if (present (callback)) then
        n = n + 1
        i_callback = n
     else
        i_callback = 0
     end if
     allocate (es_array%entry (n))
     if (i_checkpoint > 0) then
        call dispatch_eio &
             (es_array%entry(i_checkpoint)%eio, var_str ("checkpoint"), &
             global%var_list, global%fallback_model, &
             global%event_callback)
        call es_array%entry(i_checkpoint)%eio%init_out (sample, data)
     end if
     if (i_callback > 0) then
        call dispatch_eio &
             (es_array%entry(i_callback)%eio, var_str ("callback"), &
             global%var_list, global%fallback_model, &
             global%event_callback)
        call es_array%entry(i_callback)%eio%init_out (sample, data)
     end if
     if (i_input > 0) then
        call dispatch_eio (es_array%entry(i_input)%eio, input, &
             global%var_list, global%fallback_model, &
             global%event_callback)
        if (present (input_data)) then
           call es_array%entry(i_input)%eio%init_in &
                (sample_in, input_data, success)
        else
           call es_array%entry(i_input)%eio%init_in &
                (sample_in, data, success)
        end if
        if (success) then
           es_array%i_in = i_input
        else if (present (input_sample)) then
           if (present (error)) then
              error = .true.
           else
              call msg_fatal ("Events: &
                   &parameter mismatch in input, aborting")
           end if
        else
           call msg_message ("Events: &
                &parameter mismatch, discarding old event set")
           call es_array%entry(i_input)%eio%final ()
           if (switch) then
              call msg_message ("Events: generating new events")
              call es_array%entry(i_input)%eio%init_out (sample, data)
           end if
        end if
     end if
     do i = 1, n_output
        call dispatch_eio (es_array%entry(i)%eio, stream_fmt(i), &
             global%var_list, global%fallback_model, &
             global%event_callback)
        call es_array%entry(i)%eio%init_out (sample, data)
     end do
   end subroutine event_stream_array_init
 
 @ %def event_stream_array_init
 @ Switch the (only) input channel to an output channel, so further
 events are appended to the respective stream.
 <<Event streams: event stream array: TBP>>=
   procedure :: switch_inout => event_stream_array_switch_inout
 <<Event streams: procedures>>=
   subroutine event_stream_array_switch_inout (es_array)
     class(event_stream_array_t), intent(inout) :: es_array
     integer :: n
     if (es_array%has_input ()) then
        n = es_array%i_in
        call es_array%entry(n)%eio%switch_inout ()
        es_array%i_in = 0
     else
        call msg_bug ("Reading events: switch_inout: no input stream selected")
     end if
   end subroutine event_stream_array_switch_inout
 
 @ %def event_stream_array_switch_inout
 @ Output an event (with given process number) to all output streams.
 If there is no output stream, do nothing.
 <<Event streams: event stream array: TBP>>=
   procedure :: output => event_stream_array_output
 <<Event streams: procedures>>=
   subroutine event_stream_array_output (es_array, event, i_prc, &
                                         event_index, passed, pacify)
     class(event_stream_array_t), intent(inout) :: es_array
     type(event_t), intent(in), target :: event
     integer, intent(in) :: i_prc, event_index
     logical, intent(in), optional :: passed, pacify
     logical :: increased
     integer :: i
     do i = 1, size (es_array%entry)
        if (i /= es_array%i_in) then
           associate (eio => es_array%entry(i)%eio)
             if (eio%split) then
                if (eio%split_n_evt > 0 .and. event_index > 1) then
                   if (mod (event_index, eio%split_n_evt) == 1) then
                      call eio%split_out ()
                   end if
                else if (eio%split_n_kbytes > 0) then
                   call eio%update_split_count (increased)
                   if (increased)  call eio%split_out ()
                end if
             end if
             call eio%output (event, i_prc, reading = es_array%i_in /= 0, &
                  passed = passed, &
                  pacify = pacify)
           end associate
        end if
     end do
   end subroutine event_stream_array_output
 
 @ %def event_stream_array_output
 @ Input the [[i_prc]] index which selects the process for the current
 event.  This is separated from reading the event, because it
 determines which event record to read.  [[iostat]] may indicate an
 error or an EOF condition, as usual.
 <<Event streams: event stream array: TBP>>=
   procedure :: input_i_prc => event_stream_array_input_i_prc
 <<Event streams: procedures>>=
   subroutine event_stream_array_input_i_prc (es_array, i_prc, iostat)
     class(event_stream_array_t), intent(inout) :: es_array
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     integer :: n
     if (es_array%has_input ()) then
        n = es_array%i_in
        call es_array%entry(n)%eio%input_i_prc (i_prc, iostat)
     else
        call msg_fatal ("Reading events: no input stream selected")
     end if
   end subroutine event_stream_array_input_i_prc
 
 @ %def event_stream_array_input_i_prc
 @ Input an event from the selected input stream.  [[iostat]] may indicate an
 error or an EOF condition, as usual.
 <<Event streams: event stream array: TBP>>=
   procedure :: input_event => event_stream_array_input_event
 <<Event streams: procedures>>=
   subroutine event_stream_array_input_event (es_array, event, iostat)
     class(event_stream_array_t), intent(inout) :: es_array
     type(event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     integer :: n
     if (es_array%has_input ()) then
        n = es_array%i_in
        call es_array%entry(n)%eio%input_event (event, iostat)
     else
        call msg_fatal ("Reading events: no input stream selected")
     end if
   end subroutine event_stream_array_input_event
 
 @ %def event_stream_array_input_event
 @ Skip an entry of eio\_t. Used to synchronize the event read-in for
 NLO events.
 <<Event streams: event stream array: TBP>>=
   procedure :: skip_eio_entry => event_stream_array_skip_eio_entry
 <<Event streams: procedures>>=
   subroutine event_stream_array_skip_eio_entry (es_array, iostat)
     class(event_stream_array_t), intent(inout) :: es_array
     integer, intent(out) :: iostat
     integer :: n
     if (es_array%has_input ()) then
        n = es_array%i_in
        call es_array%entry(n)%eio%skip (iostat)
     else
        call msg_fatal ("Reading events: no input stream selected")
     end if
   end subroutine event_stream_array_skip_eio_entry
 
 @ %def event_stream_array_skip_eio_entry
 @ Return true if there is an input channel among the event streams.
 <<Event streams: event stream array: TBP>>=
   procedure :: has_input => event_stream_array_has_input
 <<Event streams: procedures>>=
   function event_stream_array_has_input (es_array) result (flag)
     class(event_stream_array_t), intent(in) :: es_array
     logical :: flag
     flag = es_array%i_in /= 0
   end function event_stream_array_has_input
 
 @ %def event_stream_array_has_input
 @
 \subsection{Unit Tests}
 Test module, followed by the stand-alone unit-test procedures.
 <<[[event_streams_ut.f90]]>>=
 <<File header>>
 
 module event_streams_ut
   use unit_tests
   use event_streams_uti
 
 <<Standard module head>>
 
 <<Event streams: public test>>
 
 contains
 
 <<Event streams: test driver>>
 
 end module event_streams_ut
 @
 <<[[event_streams_uti.f90]]>>=
 <<File header>>
 
 module event_streams_uti
 
 <<Use kinds>>
 <<Use strings>>
   use model_data
   use eio_data
   use process, only: process_t
   use instances, only: process_instance_t
   use models
   use rt_data
   use events
 
   use event_streams
 
 <<Standard module head>>
 
 <<Event streams: test declarations>>
 
 contains
 
 <<Event streams: tests>>
 
 end module event_streams_uti
 
 @ %def event_streams_uti
 @ API: driver for the unit tests below.
 <<Event streams: public test>>=
   public :: event_streams_test
 <<Event streams: test driver>>=
   subroutine event_streams_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Event streams: execute tests>>
   end subroutine event_streams_test
 
 @ %def event_streams_test
 @
 \subsubsection{Empty event stream}
 This should set up an empty event output stream array, including
 initialization, output, and finalization (which are all no-ops).
 <<Event streams: execute tests>>=
   call test (event_streams_1, "event_streams_1", &
        "empty event stream array", &
        u, results)
 <<Event streams: test declarations>>=
   public :: event_streams_1
 <<Event streams: tests>>=
   subroutine event_streams_1 (u)
     integer, intent(in) :: u
     type(event_stream_array_t) :: es_array
     type(rt_data_t) :: global
     type(event_t) :: event
     type(string_t) :: sample
     type(string_t), dimension(0) :: empty_string_array
 
     write (u, "(A)")  "* Test output: event_streams_1"
     write (u, "(A)")  "*   Purpose: handle empty event stream array"
     write (u, "(A)")
 
     sample = "event_streams_1"
 
     call es_array%init (sample, empty_string_array, global)
     call es_array%output (event, 42, 1)
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: event_streams_1"
 
   end subroutine event_streams_1
 
 @ %def event_streams_1
 @
 \subsubsection{Nontrivial event stream}
 Here we generate a trivial event and choose [[raw]] output as an entry in
 the stream array.
 <<Event streams: execute tests>>=
   call test (event_streams_2, "event_streams_2", &
        "nontrivial event stream array", &
        u, results)
 <<Event streams: test declarations>>=
   public :: event_streams_2
 <<Event streams: tests>>=
   subroutine event_streams_2 (u)
     use processes_ut, only: prepare_test_process
     integer, intent(in) :: u
     type(event_stream_array_t) :: es_array
     type(rt_data_t) :: global
     type(model_data_t), target :: model
     type(event_t), allocatable, target :: event
     type(process_t), allocatable, target :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(string_t) :: sample
     type(string_t), dimension(0) :: empty_string_array
     integer :: i_prc, iostat
 
     write (u, "(A)")  "* Test output: event_streams_2"
     write (u, "(A)")  "*   Purpose: handle empty event stream array"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call model%init_test ()
 
     write (u, "(A)")  "* Generate test process event"
     write (u, "(A)")
 
     allocate (process)
     allocate (process_instance)
     call prepare_test_process (process, process_instance, model, &
          run_id = var_str ("run_test"))
     call process_instance%setup_event_data ()
 
     allocate (event)
     call event%basic_init ()
     call event%connect (process_instance, process%get_model_ptr ())
     call event%generate (1, [0.4_default, 0.4_default])
     call event%set_index (42)
     call event%evaluate_expressions ()
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Allocate raw eio stream and write event to file"
     write (u, "(A)")
 
     sample = "event_streams_2"
 
     call es_array%init (sample, [var_str ("raw")], global)
     call es_array%output (event, 1, 1)
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)") "* Reallocate raw eio stream for reading"
     write (u, "(A)")
 
     sample = "foo"
     call es_array%init (sample, empty_string_array, global, &
          input = var_str ("raw"), input_sample = var_str ("event_streams_2"))
     call es_array%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Reread event"
     write (u, "(A)")
 
     call es_array%input_i_prc (i_prc, iostat)
 
     write (u, "(1x,A,I0)")  "i_prc = ", i_prc
     write (u, "(A)")
     call es_array%input_event (event, iostat)
     call es_array%final ()
 
     call event%write (u)
 
     call global%final ()
 
     call model%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: event_streams_2"
 
   end subroutine event_streams_2
 
 @ %def event_streams_2
 @
 \subsubsection{Switch in/out}
 Here we generate an event file and test switching from writing to
 reading when the file is exhausted.
 <<Event streams: execute tests>>=
   call test (event_streams_3, "event_streams_3", &
        "switch input/output", &
        u, results)
 <<Event streams: test declarations>>=
   public :: event_streams_3
 <<Event streams: tests>>=
   subroutine event_streams_3 (u)
     use processes_ut, only: prepare_test_process
     integer, intent(in) :: u
     type(event_stream_array_t) :: es_array
     type(rt_data_t) :: global
     type(model_data_t), target :: model
     type(event_t), allocatable, target :: event
     type(process_t), allocatable, target :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(string_t) :: sample
     type(string_t), dimension(0) :: empty_string_array
     integer :: i_prc, iostat
 
     write (u, "(A)")  "* Test output: event_streams_3"
     write (u, "(A)")  "*   Purpose: handle in/out switching"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call model%init_test ()
 
     write (u, "(A)")  "* Generate test process event"
     write (u, "(A)")
 
     allocate (process)
     allocate (process_instance)
     call prepare_test_process (process, process_instance, model, &
          run_id = var_str ("run_test"))
     call process_instance%setup_event_data ()
 
     allocate (event)
     call event%basic_init ()
     call event%connect (process_instance, process%get_model_ptr ())
     call event%generate (1, [0.4_default, 0.4_default])
     call event%increment_index ()
     call event%evaluate_expressions ()
 
     write (u, "(A)") "* Allocate raw eio stream and write event to file"
     write (u, "(A)")
 
     sample = "event_streams_3"
 
     call es_array%init (sample, [var_str ("raw")], global)
     call es_array%output (event, 1, 1)
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)") "* Reallocate raw eio stream for reading"
     write (u, "(A)")
 
     call es_array%init (sample, empty_string_array, global, &
          input = var_str ("raw"))
     call es_array%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Reread event"
     write (u, "(A)")
 
     call es_array%input_i_prc (i_prc, iostat)
     call es_array%input_event (event, iostat)
 
     write (u, "(A)") "* Attempt to read another event (fail), then generate"
     write (u, "(A)")
 
     call es_array%input_i_prc (i_prc, iostat)
     if (iostat < 0) then
        call es_array%switch_inout ()
        call event%generate (1, [0.3_default, 0.3_default])
        call event%increment_index ()
        call event%evaluate_expressions ()
        call es_array%output (event, 1, 2)
     end if
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Reallocate raw eio stream for reading"
     write (u, "(A)")
 
     call es_array%init (sample, empty_string_array, global, &
          input = var_str ("raw"))
     call es_array%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Reread two events and display 2nd event"
     write (u, "(A)")
 
     call es_array%input_i_prc (i_prc, iostat)
     call es_array%input_event (event, iostat)
     call es_array%input_i_prc (i_prc, iostat)
 
     call es_array%input_event (event, iostat)
     call es_array%final ()
 
     call event%write (u)
 
     call global%final ()
 
     call model%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: event_streams_3"
 
   end subroutine event_streams_3
 
 @ %def event_streams_3
 @
 \subsubsection{Checksum}
 Here we generate an event file and repeat twice, once with identical
 parameters and once with modified parameters.
 <<Event streams: execute tests>>=
   call test (event_streams_4, "event_streams_4", &
        "check MD5 sum", &
        u, results)
 <<Event streams: test declarations>>=
   public :: event_streams_4
 <<Event streams: tests>>=
   subroutine event_streams_4 (u)
     integer, intent(in) :: u
     type(event_stream_array_t) :: es_array
     type(rt_data_t) :: global
     type(process_t), allocatable, target :: process
     type(string_t) :: sample
     type(string_t), dimension(0) :: empty_string_array
     type(event_sample_data_t) :: data
 
     write (u, "(A)")  "* Test output: event_streams_4"
     write (u, "(A)")  "*   Purpose: handle in/out switching"
     write (u, "(A)")
 
     write (u, "(A)")  "* Generate test process event"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%set_log (var_str ("?check_event_file"), &
          .true., is_known = .true.)
 
     allocate (process)
 
     write (u, "(A)") "* Allocate raw eio stream for writing"
     write (u, "(A)")
 
     sample = "event_streams_4"
     data%md5sum_cfg = "1234567890abcdef1234567890abcdef"
 
     call es_array%init (sample, [var_str ("raw")], global, data)
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)") "* Reallocate raw eio stream for reading"
     write (u, "(A)")
 
     call es_array%init (sample, empty_string_array, global, &
          data, input = var_str ("raw"))
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)") "* Reallocate modified raw eio stream for reading (fail)"
     write (u, "(A)")
 
     data%md5sum_cfg = "1234567890______1234567890______"
     call es_array%init (sample, empty_string_array, global, &
          data, input = var_str ("raw"))
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)") "* Repeat ignoring checksum"
     write (u, "(A)")
 
     call global%set_log (var_str ("?check_event_file"), &
          .false., is_known = .true.)
     call es_array%init (sample, empty_string_array, global, &
          data, input = var_str ("raw"))
     call es_array%write (u)
     call es_array%final ()
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: event_streams_4"
 
   end subroutine event_streams_4
 
 @ %def event_streams_4
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Restricted Subprocesses}
 This module provides an automatic means to construct restricted subprocesses
 of a current process object.  A restricted subprocess has the same initial and
 final state as the current process, but a restricted set of Feynman graphs.
 
 The actual application extracts the set of resonance histories that apply to
 the process and uses this to construct subprocesses that are restricted to one
 of those histories, respectively.  The resonance histories are derived from
 the phase-space setup.  This implies that the method is tied to the OMega
 matrix element generator and to the wood phase space method.
 
 The processes are collected in a new process library that is generated
 on-the-fly.
 
 The [[resonant_subprocess_t]] object is intended as a component of the event
 record, which manages all operations regarding resonance handling.
 
 The run-time calculations are delegated to an event transform
 ([[evt_resonance_t]]), as a part of the event transform chain.  The transform
 selects one (or none) of the resonance histories, given the momentum
 configuration, computes matrix elements and inserts resonances into the
 particle set.
 <<[[restricted_subprocesses.f90]]>>=
 <<File header>>
 
 module restricted_subprocesses
 
 <<Use kinds>>
 <<Use strings>>
   use diagnostics, only: msg_message, msg_fatal, msg_bug
   use diagnostics, only: signal_is_pending
   use io_units, only: given_output_unit
   use format_defs, only: FMT_14, FMT_19
   use string_utils, only: str
   use lorentz, only: vector4_t
   use particle_specifiers, only: prt_spec_t
   use particles, only: particle_set_t
   use resonances, only: resonance_history_t, resonance_history_set_t
   use variables, only: var_list_t
   use models, only: model_t
   use process_libraries, only: process_component_def_t
   use process_libraries, only: process_library_t
   use process_libraries, only: STAT_ACTIVE
   use prclib_stacks, only: prclib_entry_t
   use event_transforms, only: evt_t
   use resonance_insertion, only: evt_resonance_t
   use rt_data, only: rt_data_t
   use compilations, only: compile_library
   use process_configurations, only: process_configuration_t
   use process, only: process_t, process_ptr_t
   use instances, only: process_instance_t, process_instance_ptr_t
   use integrations, only: integrate_process
 
 <<Use mpi f08>>
 
 <<Standard module head>>
 
 <<Restricted subprocesses: public>>
 
 <<Restricted subprocesses: types>>
 
 <<Restricted subprocesses: interfaces>>
 
 contains
 
 <<Restricted subprocesses: procedures>>
 
 end module restricted_subprocesses
 @ %def restricted_subprocesses
 @
 \subsection{Process configuration}
 We extend the [[process_configuration_t]] by another method for initialization
 that takes into account a resonance history.
 <<Restricted subprocesses: public>>=
   public :: restricted_process_configuration_t
 <<Restricted subprocesses: types>>=
   type, extends (process_configuration_t) :: restricted_process_configuration_t
      private
    contains
    <<Restricted subprocesses: restricted process configuration: TBP>>
   end type restricted_process_configuration_t
 
 @ %def restricted_process_configuration_t
 @
 Resonance history as an argument.  We use it to override the [[restrictions]]
 setting in a local variable list.  Since we can construct the restricted
 process only by using OMega, we enforce it as the ME method.  Other settings
 are taken from the variable list.  The model will most likely be set, but we
 insert a safeguard just in case.
 
 Also, the resonant subprocess should not itself spawn resonant
 subprocesses, so we unset [[?resonance_history]].
 
 We have to create a local copy of the model here, via pointer
 allocation.  The reason is that the model as stored (via pointer) in
 the base type will be finalized and deallocated.
 
 The current implementation will generate a LO process, the optional
 [[nlo_process]] is unset.  (It is not obvious
 whether the construction makes sense beyond LO.)
 <<Restricted subprocesses: restricted process configuration: TBP>>=
   procedure :: init_resonant_process
 <<Restricted subprocesses: procedures>>=
   subroutine init_resonant_process &
        (prc_config, prc_name, prt_in, prt_out, res_history, model, var_list)
     class(restricted_process_configuration_t), intent(out) :: prc_config
     type(string_t), intent(in) :: prc_name
     type(prt_spec_t), dimension(:), intent(in) :: prt_in
     type(prt_spec_t), dimension(:), intent(in) :: prt_out
     type(resonance_history_t), intent(in) :: res_history
     type(model_t), intent(in), target :: model
     type(var_list_t), intent(in), target :: var_list
     type(model_t), pointer :: local_model
     type(var_list_t) :: local_var_list
     allocate (local_model)
     call local_model%init_instance (model)
     call local_var_list%link (var_list)
     call local_var_list%append_string (var_str ("$model_name"), &
          sval = local_model%get_name (), &
          intrinsic=.true.)
     call local_var_list%append_string (var_str ("$method"), &
          sval = var_str ("omega"), &
          intrinsic=.true.)
     call local_var_list%append_string (var_str ("$restrictions"), &
          sval = res_history%as_omega_string (size (prt_in)), &
          intrinsic = .true.)
     call local_var_list%append_log (var_str ("?resonance_history"), &
          lval = .false., &
          intrinsic = .true.)
     call prc_config%init (prc_name, size (prt_in), 1, &
          local_model, local_var_list)
     call prc_config%setup_component (1, &
          prt_in, prt_out, &
          local_model, local_var_list)
   end subroutine init_resonant_process
 
 @ %def init_resonant_process
 @
 \subsection{Resonant-subprocess set manager}
 This data type enables generation of a library of resonant subprocesses for a
 given master process, and it allows for convenient access.  The matrix
 elements from the subprocesses can be used as channel weights to activate a
 selector, which then returns a preferred channel via some random number
 generator.
 <<Restricted subprocesses: public>>=
   public :: resonant_subprocess_set_t
 <<Restricted subprocesses: types>>=
   type :: resonant_subprocess_set_t
      private
      integer, dimension(:), allocatable :: n_history
      type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
      logical :: lib_active = .false.
      type(string_t) :: libname
      type(string_t), dimension(:), allocatable :: proc_id
      type(process_ptr_t), dimension(:), allocatable :: subprocess
      type(process_instance_ptr_t), dimension(:), allocatable :: instance
      logical :: filled = .false.
      type(evt_resonance_t), pointer :: evt => null ()
    contains
    <<Restricted subprocesses: resonant subprocess set: TBP>>
   end type resonant_subprocess_set_t
 
 @ %def resonant_subprocess_set_t
 @ Output
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: write => resonant_subprocess_set_write
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_write (prc_set, unit, testflag)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     logical :: truncate
     integer :: u, i
     u = given_output_unit (unit)
     truncate = .false.;  if (present (testflag))  truncate = testflag
     write (u, "(1x,A)")  "Resonant subprocess set:"
     if (allocated (prc_set%n_history)) then
        if (any (prc_set%n_history > 0)) then
           do i = 1, size (prc_set%n_history)
              if (prc_set%n_history(i) > 0) then
                 write (u, "(1x,A,I0)")  "Component #", i
                 call prc_set%res_history_set(i)%write (u, indent=1)
              end if
           end do
           if (prc_set%lib_active) then
              write (u, "(3x,A,A,A)")  "Process library = '", &
                   char (prc_set%libname), "'"
           else
              write (u, "(3x,A)")  "Process library: [inactive]"
           end if
           if (associated (prc_set%evt)) then
              if (truncate) then
                 write (u, "(3x,A,1x," // FMT_14 // ")") &
                      "Process sqme =", prc_set%get_master_sqme ()
              else
                 write (u, "(3x,A,1x," // FMT_19 // ")") &
                      "Process sqme =", prc_set%get_master_sqme ()
              end if
           end if
           if (associated (prc_set%evt)) then
              write (u, "(3x,A)")  "Event transform: associated"
              write (u, "(2x)", advance="no")
              call prc_set%evt%write_selector (u, testflag)
           else
              write (u, "(3x,A)")  "Event transform: not associated"
           end if
        else
           write (u, "(2x,A)")  "[empty]"
        end if
     else
        write (u, "(3x,A)")  "[not allocated]"
     end if
   end subroutine resonant_subprocess_set_write
 
 @ %def resonant_subprocess_set_write
 @
 \subsection{Resonance history set}
 Initialize subprocess set with an array of pre-created resonance
 history sets.
 
 Safeguard: if there are no resonances in the input, initialize the local set
 as empty, but complete.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: init => resonant_subprocess_set_init
   procedure :: fill_resonances => resonant_subprocess_set_fill_resonances
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_init (prc_set, n_component)
     class(resonant_subprocess_set_t), intent(out) :: prc_set
     integer, intent(in) :: n_component
     allocate (prc_set%res_history_set (n_component))
     allocate (prc_set%n_history (n_component), source = 0)
   end subroutine resonant_subprocess_set_init
 
   subroutine resonant_subprocess_set_fill_resonances (prc_set, &
        res_history_set, i_component)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     type(resonance_history_set_t), intent(in) :: res_history_set
     integer, intent(in) :: i_component
     prc_set%n_history(i_component) = res_history_set%get_n_history ()
     if (prc_set%n_history(i_component) > 0) then
        prc_set%res_history_set(i_component) = res_history_set
     else
        call prc_set%res_history_set(i_component)%init (initial_size = 0)
        call prc_set%res_history_set(i_component)%freeze ()
     end if
   end subroutine resonant_subprocess_set_fill_resonances
 
 @ %def resonant_subprocess_set_init
 @ %def resonant_subprocess_set_fill_resonances
 @ Return the resonance history set.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: get_resonance_history_set &
        => resonant_subprocess_set_get_resonance_history_set
 <<Restricted subprocesses: procedures>>=
   function resonant_subprocess_set_get_resonance_history_set (prc_set) &
        result (res_history_set)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
     res_history_set = prc_set%res_history_set
   end function resonant_subprocess_set_get_resonance_history_set
 
 @ %def resonant_subprocess_set_get_resonance_history_set
 @
 \subsection{Library for the resonance history set}
 The recommended library name: append [[_R]] to the process name.
 <<Restricted subprocesses: public>>=
   public :: get_libname_res
 <<Restricted subprocesses: procedures>>=
   elemental function get_libname_res (proc_id) result (libname)
     type(string_t), intent(in) :: proc_id
     type(string_t) :: libname
     libname = proc_id // "_R"
   end function get_libname_res
 
 @ %def get_libname_res
 @ Here we scan the global process library whether any
 processes require resonant subprocesses to be constructed.  If yes,
 create process objects with phase space and construct the process
 libraries as usual.  Then append the library names to the array.
 
 The temporary integration objects should carry the [[phs_only]]
 flag.  We set this in the local environment.
 
 Once a process object with resonance histories (derived from phase
 space) has been created, we extract the resonance histories and use
 them, together with the process definition, to create the new library.
 
 Finally, compile the library.
 <<Restricted subprocesses: public>>=
   public :: spawn_resonant_subprocess_libraries
 <<Restricted subprocesses: procedures>>=
   subroutine spawn_resonant_subprocess_libraries &
        (libname, local, global, libname_res)
     type(string_t), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), target :: global
     type(string_t), dimension(:), allocatable, intent(inout) :: libname_res
     type(process_library_t), pointer :: lib
     type(string_t), dimension(:), allocatable :: process_id_res
     type(process_t), pointer :: process
     type(resonance_history_set_t) :: res_history_set
     type(process_component_def_t), pointer :: process_component_def
     logical :: phs_only_saved, exist
     integer :: i_proc, i_component
     lib => global%prclib_stack%get_library_ptr (libname)
     call lib%get_process_id_req_resonant (process_id_res)
     if (size (process_id_res) > 0) then
        call msg_message ("Creating resonant-subprocess libraries &
             &for library '" // char (libname) // "'")
        libname_res = get_libname_res (process_id_res)
        phs_only_saved = local%var_list%get_lval (var_str ("?phs_only"))
        call local%var_list%set_log &
             (var_str ("?phs_only"), .true., is_known=.true.)
        do i_proc = 1, size (process_id_res)
           associate (proc_id => process_id_res (i_proc))
             call msg_message ("Process '" // char (proc_id) // "': &
                  &constructing phase space for resonance structure")
             call integrate_process (proc_id, local, global)
             process => global%process_stack%get_process_ptr (proc_id)
             call create_library (libname_res(i_proc), global, exist)
             if (.not. exist) then
                do i_component = 1, process%get_n_components ()
                   call process%extract_resonance_history_set &
                        (res_history_set, i_component = i_component)
                   process_component_def &
                        => process%get_component_def_ptr (i_component)
                   call add_to_library (libname_res(i_proc), &
                        res_history_set, &
                        process_component_def%get_prt_spec_in (), &
                        process_component_def%get_prt_spec_out (), &
                        global)
                end do
                call msg_message ("Process library '" &
                     // char (libname_res(i_proc)) &
                     // "': created")
             end if
             call global%update_prclib (lib)
           end associate
        end do
        call local%var_list%set_log &
             (var_str ("?phs_only"), phs_only_saved, is_known=.true.)
     end if
   end subroutine spawn_resonant_subprocess_libraries
 
 @ %def spawn_resonant_subprocess_libraries
 @ This is another version of the library constructor, bound to a
 restricted-subprocess set object.  Create the appropriate
 process library, add processes, and close the library.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: create_library => resonant_subprocess_set_create_library
   procedure :: add_to_library => resonant_subprocess_set_add_to_library
   procedure :: freeze_library => resonant_subprocess_set_freeze_library
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_create_library (prc_set, &
        libname, global, exist)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     type(string_t), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: global
     logical, intent(out) :: exist
     prc_set%libname = libname
     call create_library (prc_set%libname, global, exist)
   end subroutine resonant_subprocess_set_create_library
 
   subroutine resonant_subprocess_set_add_to_library (prc_set, &
        i_component, prt_in, prt_out, global)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     integer, intent(in) :: i_component
     type(prt_spec_t), dimension(:), intent(in) :: prt_in
     type(prt_spec_t), dimension(:), intent(in) :: prt_out
     type(rt_data_t), intent(inout), target :: global
     call add_to_library (prc_set%libname, &
          prc_set%res_history_set(i_component), &
          prt_in, prt_out, global)
   end subroutine resonant_subprocess_set_add_to_library
 
   subroutine resonant_subprocess_set_freeze_library (prc_set, global)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     type(rt_data_t), intent(inout), target :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     lib => global%prclib_stack%get_library_ptr (prc_set%libname)
     call lib%get_process_id_list (prc_set%proc_id)
     prc_set%lib_active = .true.
   end subroutine resonant_subprocess_set_freeze_library
 
 @ %def resonant_subprocess_set_create_library
 @ %def resonant_subprocess_set_add_to_library
 @ %def resonant_subprocess_set_freeze_library
 @ The common parts of the procedures above: (i) create a new process
 library or recover it, (ii) for each history, create a
 process configuration and record it.
 <<Restricted subprocesses: procedures>>=
   subroutine create_library (libname, global, exist)
     type(string_t), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: global
     logical, intent(out) :: exist
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     type(resonance_history_t) :: res_history
     type(string_t), dimension(:), allocatable :: proc_id
     type(restricted_process_configuration_t) :: prc_config
     integer :: i
     lib => global%prclib_stack%get_library_ptr (libname)
     exist = associated (lib)
     if (.not. exist) then
        call msg_message ("Creating library for resonant subprocesses '" &
             // char (libname) // "'")
        allocate (lib_entry)
        call lib_entry%init (libname)
        lib => lib_entry%process_library_t
        call global%add_prclib (lib_entry)
     else
        call msg_message ("Using library for resonant subprocesses '" &
             // char (libname) // "'")
        call global%update_prclib (lib)
     end if
   end subroutine create_library
 
   subroutine add_to_library (libname, res_history_set, prt_in, prt_out, global)
     type(string_t), intent(in) :: libname
     type(resonance_history_set_t), intent(in) :: res_history_set
     type(prt_spec_t), dimension(:), intent(in) :: prt_in
     type(prt_spec_t), dimension(:), intent(in) :: prt_out
     type(rt_data_t), intent(inout), target :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     type(resonance_history_t) :: res_history
     type(string_t), dimension(:), allocatable :: proc_id
     type(restricted_process_configuration_t) :: prc_config
     integer :: n0, i
     lib => global%prclib_stack%get_library_ptr (libname)
     if (associated (lib)) then
        n0 = lib%get_n_processes ()
        allocate (proc_id (res_history_set%get_n_history ()))
        do i = 1, size (proc_id)
           proc_id(i) = libname // str (n0 + i)
           res_history = res_history_set%get_history(i)
           call prc_config%init_resonant_process (proc_id(i), &
                prt_in, prt_out, &
                res_history, &
                global%model, global%var_list)
           call msg_message ("Resonant subprocess #" &
                // char (str(n0+i)) // ": " &
                // char (res_history%as_omega_string (size (prt_in))))
           call prc_config%record (global)
           if (signal_is_pending ())  return
        end do
     else
        call msg_bug ("Adding subprocesses: library '" &
             // char (libname) // "' not found")
     end if
   end subroutine add_to_library
 
 @ %def create_library
 @ %def add_to_library
 @ Compile the generated library, required settings taken from the
 [[global]] data set.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: compile_library => resonant_subprocess_set_compile_library
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_compile_library (prc_set, global)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     type(rt_data_t), intent(inout), target :: global
     type(process_library_t), pointer :: lib
     lib => global%prclib_stack%get_library_ptr (prc_set%libname)
     if (lib%get_status () < STAT_ACTIVE) then
        call compile_library (prc_set%libname, global)
     end if
   end subroutine resonant_subprocess_set_compile_library
 
 @ %def resonant_subprocess_set_compile_library
 @ Check if the library has been created / the process has been evaluated.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: is_active => resonant_subprocess_set_is_active
 <<Restricted subprocesses: procedures>>=
   function resonant_subprocess_set_is_active (prc_set) result (flag)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     logical :: flag
     flag = prc_set%lib_active
   end function resonant_subprocess_set_is_active
 
 @ %def resonant_subprocess_set_is_active
 @ Return number of generated process objects, library, and process IDs.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: get_n_process => resonant_subprocess_set_get_n_process
   procedure :: get_libname => resonant_subprocess_set_get_libname
   procedure :: get_proc_id => resonant_subprocess_set_get_proc_id
 <<Restricted subprocesses: procedures>>=
   function resonant_subprocess_set_get_n_process (prc_set) result (n)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     integer :: n
     if (prc_set%lib_active) then
        n = size (prc_set%proc_id)
     else
        n = 0
     end if
   end function resonant_subprocess_set_get_n_process
 
   function resonant_subprocess_set_get_libname (prc_set) result (libname)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     type(string_t) :: libname
     if (prc_set%lib_active) then
        libname = prc_set%libname
     else
        libname = ""
     end if
   end function resonant_subprocess_set_get_libname
 
   function resonant_subprocess_set_get_proc_id (prc_set, i) result (proc_id)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     integer, intent(in) :: i
     type(string_t) :: proc_id
     if (allocated (prc_set%proc_id)) then
        proc_id = prc_set%proc_id(i)
     else
        proc_id = ""
     end if
   end function resonant_subprocess_set_get_proc_id
 
 @ %def resonant_subprocess_set_get_n_process
 @ %def resonant_subprocess_set_get_libname
 @ %def resonant_subprocess_set_get_proc_id
 @
 \subsection{Process objects and instances}
 Prepare process objects for all entries in the resonant-subprocesses
 library.  The process objects are appended to the global process
 stack.  A local environment can be used where we place temporary
 variable settings that affect process-object generation.  We
 initialize the processes, such that we can evaluate matrix elements,
 but we do not need to integrate them.
 
 The internal procedure [[prepare_process]] is an abridged version of
 the procedure with this name in the [[simulations]] module.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: prepare_process_objects &
        => resonant_subprocess_set_prepare_process_objects
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_prepare_process_objects &
        (prc_set, local, global)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     type(rt_data_t), pointer :: current
     type(process_library_t), pointer :: lib
     type(string_t) :: proc_id, libname_cur, libname_res
     integer :: i, n
     if (.not. prc_set%is_active ())  return
     if (present (global)) then
        current => global
     else
        current => local
     end if
     libname_cur = current%prclib%get_name ()
     libname_res = prc_set%get_libname ()
     lib => current%prclib_stack%get_library_ptr (libname_res)
     if (associated (lib))  call current%update_prclib (lib)
     call local%set_string (var_str ("$phs_method"), &
             var_str ("none"), is_known = .true.)
     call local%set_string (var_str ("$integration_method"), &
             var_str ("none"), is_known = .true.)
     n = prc_set%get_n_process ()
     allocate (prc_set%subprocess (n))
     do i = 1, n
        proc_id = prc_set%get_proc_id (i)
        call prepare_process (prc_set%subprocess(i)%p, proc_id)
        if (signal_is_pending ())  return
     end do
     lib => current%prclib_stack%get_library_ptr (libname_cur)
     if (associated (lib))  call current%update_prclib (lib)
   contains
     subroutine prepare_process (process, process_id)
       type(process_t), pointer, intent(out) :: process
       type(string_t), intent(in) :: process_id
       call msg_message ("Simulate: initializing resonant subprocess '" &
                // char (process_id) // "'")
       if (present (global)) then
          call integrate_process (process_id, local, global, &
               init_only = .true.)
       else
          call integrate_process (process_id, local, local_stack = .true., &
               init_only = .true.)
       end if
       process => current%process_stack%get_process_ptr (process_id)
       if (.not. associated (process)) then
          call msg_fatal ("Simulate: resonant subprocess '" &
                // char (process_id) // "' could not be initialized: aborting")
       end if
     end subroutine prepare_process
   end subroutine resonant_subprocess_set_prepare_process_objects
 
 @ %def resonant_subprocess_set_prepare_process_objects
 @ Workspace for the resonant subprocesses.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: prepare_process_instances &
        => resonant_subprocess_set_prepare_process_instances
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_prepare_process_instances (prc_set, global)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     type(rt_data_t), intent(in), target :: global
     integer :: i, n
     if (.not. prc_set%is_active ())  return
     n = size (prc_set%subprocess)
     allocate (prc_set%instance (n))
     do i = 1, n
        allocate (prc_set%instance(i)%p)
        call prc_set%instance(i)%p%init (prc_set%subprocess(i)%p)
        call prc_set%instance(i)%p%setup_event_data (global%model)
     end do
   end subroutine resonant_subprocess_set_prepare_process_instances
 
 @ %def resonant_subprocess_set_prepare_process_instances
 @
 \subsection{Event transform connection}
 The idea is that the resonance-insertion event transform has been
 allocated somewhere (namely, in the standard event-transform chain),
 but we maintain a link such that we can inject matrix-element results
 event by event.  The event transform holds a selector, to choose one
 of the resonance histories (or none), and it manages resonance
 insertion for the particle set.
 
 The data that the event transform requires can be provided here.  The
 resonance history set has already been assigned with the [[dispatch]]
 initializer.  Here, we supply the set of subprocess instances that we
 have generated (see above).  The master-process instance is set
 when we [[connect]] the transform by the standard method.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: connect_transform => &
        resonant_subprocess_set_connect_transform
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_connect_transform (prc_set, evt)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     class(evt_t), intent(in), target :: evt
     select type (evt)
     type is (evt_resonance_t)
        prc_set%evt => evt
        call prc_set%evt%set_subprocess_instances (prc_set%instance)
     class default
        call msg_bug ("Resonant subprocess set: event transform has wrong type")
     end select
   end subroutine resonant_subprocess_set_connect_transform
 
 @ %def resonant_subprocess_set_connect_transform
 @ Set the on-shell limit value in the connected transform.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: set_on_shell_limit => resonant_subprocess_set_on_shell_limit
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_on_shell_limit (prc_set, on_shell_limit)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     real(default), intent(in) :: on_shell_limit
     call prc_set%evt%set_on_shell_limit (on_shell_limit)
   end subroutine resonant_subprocess_set_on_shell_limit
 
 @ %def resonant_subprocess_set_on_shell_limit
 @ Set the Gaussian turnoff parameter in the connected transform.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: set_on_shell_turnoff => resonant_subprocess_set_on_shell_turnoff
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_on_shell_turnoff &
        (prc_set, on_shell_turnoff)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     real(default), intent(in) :: on_shell_turnoff
     call prc_set%evt%set_on_shell_turnoff (on_shell_turnoff)
   end subroutine resonant_subprocess_set_on_shell_turnoff
 
 @ %def resonant_subprocess_set_on_shell_turnoff
 @ Reweight (suppress) the background contribution probability, for the
 kinematics where a resonance history is active.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: set_background_factor &
        => resonant_subprocess_set_background_factor
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_background_factor &
        (prc_set, background_factor)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     real(default), intent(in) :: background_factor
     call prc_set%evt%set_background_factor (background_factor)
   end subroutine resonant_subprocess_set_background_factor
 
 @ %def resonant_subprocess_set_background_factor
 @
 \subsection{Wrappers for runtime calculations}
 All runtime calculations are delegated to the event transform.  The
 following procedures are essentially redundant wrappers.  We retain
 them for a unit test below.
 
 Debugging aid:
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: dump_instances => resonant_subprocess_set_dump_instances
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_dump_instances (prc_set, unit, testflag)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: i, n, u
     u = given_output_unit (unit)
     write (u, "(A)")  "*** Process instances of resonant subprocesses"
     write (u, *)
     n = size (prc_set%subprocess)
     do i = 1, n
        associate (instance => prc_set%instance(i)%p)
          call instance%write (u, testflag)
          write (u, *)
          write (u, *)
        end associate
     end do
   end subroutine resonant_subprocess_set_dump_instances
 
 @ %def resonant_subprocess_set_dump_instances
 @ Inject the current kinematics configuration, reading from the
 previous event transform or from the process instance.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: fill_momenta => resonant_subprocess_set_fill_momenta
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_fill_momenta (prc_set)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     integer :: i, n
     call prc_set%evt%fill_momenta ()
   end subroutine resonant_subprocess_set_fill_momenta
 
 @ %def resonant_subprocess_set_fill_momenta
 @ Determine the indices of the resonance histories that can be
 considered on-shell for the current kinematics.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: determine_on_shell_histories &
        => resonant_subprocess_set_determine_on_shell_histories
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_determine_on_shell_histories &
        (prc_set, i_component, index_array)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     integer, intent(in) :: i_component
     integer, dimension(:), allocatable, intent(out) :: index_array
     call prc_set%evt%determine_on_shell_histories (index_array)
   end subroutine resonant_subprocess_set_determine_on_shell_histories
 
 @ %def resonant_subprocess_set_determine_on_shell_histories
 @ Evaluate selected subprocesses.  (In actual operation, the ones that
 have been tagged as on-shell.)
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: evaluate_subprocess &
        => resonant_subprocess_set_evaluate_subprocess
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_evaluate_subprocess (prc_set, index_array)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     integer, dimension(:), intent(in) :: index_array
     call prc_set%evt%evaluate_subprocess (index_array)
   end subroutine resonant_subprocess_set_evaluate_subprocess
 
 @ %def resonant_subprocess_set_evaluate_subprocess
 @ Extract the matrix elements of the master process / the resonant
 subprocesses.  After the previous routine has been executed, they
 should be available and stored in the corresponding process instances.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: get_master_sqme &
        => resonant_subprocess_set_get_master_sqme
   procedure :: get_subprocess_sqme &
        => resonant_subprocess_set_get_subprocess_sqme
 <<Restricted subprocesses: procedures>>=
   function resonant_subprocess_set_get_master_sqme (prc_set) result (sqme)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     real(default) :: sqme
     sqme = prc_set%evt%get_master_sqme ()
   end function resonant_subprocess_set_get_master_sqme
 
   subroutine resonant_subprocess_set_get_subprocess_sqme (prc_set, sqme)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     real(default), dimension(:), intent(inout) :: sqme
     integer :: i
     call prc_set%evt%get_subprocess_sqme (sqme)
   end subroutine resonant_subprocess_set_get_subprocess_sqme
 
 @ %def resonant_subprocess_set_get_master_sqme
 @ %def resonant_subprocess_set_get_subprocess_sqme
 @ We use the calculations of resonant matrix elements to determine
 probabilities for all resonance configurations.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: compute_probabilities &
        => resonant_subprocess_set_compute_probabilities
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_compute_probabilities (prc_set, prob_array)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     real(default), dimension(:), allocatable, intent(out) :: prob_array
     integer, dimension(:), allocatable :: index_array
     real(default) :: sqme, sqme_sum, sqme_bg
     real(default), dimension(:), allocatable :: sqme_res
     integer :: n
     n = size (prc_set%subprocess)
     allocate (prob_array (0:n), source = 0._default)
     call prc_set%evt%compute_probabilities ()
     call prc_set%evt%get_selector_weights (prob_array)
   end subroutine resonant_subprocess_set_compute_probabilities
 
 @ %def resonant_subprocess_set_compute_probabilities
 @
 \subsection{Unit tests}
 Test module, followed by the stand-alone unit-test procedures.
 <<[[restricted_subprocesses_ut.f90]]>>=
 <<File header>>
 
 module restricted_subprocesses_ut
   use unit_tests
   use restricted_subprocesses_uti
 
 <<Standard module head>>
 
 <<Restricted subprocesses: public test>>
 
 contains
 
 <<Restricted subprocesses: test driver>>
 
 end module restricted_subprocesses_ut
 @ %def restricted_subprocesses_ut
 @
 <<[[restricted_subprocesses_uti.f90]]>>=
 <<File header>>
 
 module restricted_subprocesses_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units, only: free_unit
   use format_defs, only: FMT_10, FMT_12
   use lorentz, only: vector4_t, vector3_moving, vector4_moving
   use particle_specifiers, only: new_prt_spec
   use process_libraries, only: process_library_t
   use resonances, only: resonance_info_t
   use resonances, only: resonance_history_t
   use resonances, only: resonance_history_set_t
   use state_matrices, only: FM_IGNORE_HELICITY
   use particles, only: particle_set_t
   use model_data, only: model_data_t
   use models, only: syntax_model_file_init, syntax_model_file_final
   use models, only: model_t
   use rng_base_ut, only: rng_test_factory_t
   use mci_base, only: mci_t
   use mci_none, only: mci_none_t
   use phs_base, only: phs_config_t
   use phs_forests, only: syntax_phs_forest_init, syntax_phs_forest_final
   use phs_wood, only: phs_wood_config_t
   use process_libraries, only: process_def_entry_t
   use process_libraries, only: process_component_def_t
   use prclib_stacks, only: prclib_entry_t
   use prc_core_def, only: prc_core_def_t
   use prc_omega, only: omega_def_t
   use process, only: process_t
   use instances, only: process_instance_t
   use process_stacks, only: process_entry_t
   use event_transforms, only: evt_trivial_t
   use resonance_insertion, only: evt_resonance_t
   use integrations, only: integrate_process
   use rt_data, only: rt_data_t
 
   use restricted_subprocesses
 
 <<Standard module head>>
 
 <<Restricted subprocesses: test declarations>>
 
 <<Restricted subprocesses: test auxiliary types>>
 
 <<Restricted subprocesses: public test auxiliary>>
 
 contains
 
 <<Restricted subprocesses: tests>>
 
 <<Restricted subprocesses: test auxiliary>>
 
 end module restricted_subprocesses_uti
 
 @ %def restricted_subprocesses_uti
 @ API: driver for the unit tests below.
 <<Restricted subprocesses: public test>>=
   public :: restricted_subprocesses_test
 <<Restricted subprocesses: test driver>>=
   subroutine restricted_subprocesses_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Restricted subprocesses: execute tests>>
   end subroutine restricted_subprocesses_test
 
 @ %def restricted_subprocesses_test
 @
 \subsubsection{subprocess configuration}
 Initialize a [[restricted_subprocess_configuration_t]] object which represents
 a given process with a defined resonance history.
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_1, "restricted_subprocesses_1", &
        "single subprocess", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_1
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_1 (u)
     integer, intent(in) :: u
     type(rt_data_t) :: global
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(string_t) :: prc_name
     type(string_t), dimension(2) :: prt_in
     type(string_t), dimension(3) :: prt_out
     type(restricted_process_configuration_t) :: prc_config
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_1"
     write (u, "(A)")  "*   Purpose: create subprocess list from resonances"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%select_model (var_str ("SM"))
 
     write (u, "(A)")  "* Create resonance history"
     write (u, "(A)")
 
     call res_info%init (3, -24, global%model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Create process configuration"
     write (u, "(A)")
 
     prc_name = "restricted_subprocesses_1_p"
     prt_in(1) = "e-"
     prt_in(2) = "e+"
     prt_out(1) = "d"
     prt_out(2) = "u"
     prt_out(3) = "W+"
 
     call prc_config%init_resonant_process (prc_name, &
          new_prt_spec (prt_in), new_prt_spec (prt_out), &
          res_history, global%model, global%var_list)
 
     call prc_config%write (u)
 
     write (u, *)
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_1"
 
   end subroutine restricted_subprocesses_1
 
 @ %def restricted_subprocesses_1
 @
 \subsubsection{Subprocess library configuration}
 Create a process library that represents restricted subprocesses for a given
 set of resonance histories
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_2, "restricted_subprocesses_2", &
        "subprocess library", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_2
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_2 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(resonance_info_t) :: res_info
     type(resonance_history_t), dimension(2) :: res_history
     type(resonance_history_set_t) :: res_history_set
     type(string_t) :: libname
     type(string_t), dimension(2) :: prt_in
     type(string_t), dimension(3) :: prt_out
     type(resonant_subprocess_set_t) :: prc_set
     type(process_library_t), pointer :: lib
     logical :: exist
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_2"
     write (u, "(A)")  "*   Purpose: create subprocess library from resonances"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%select_model (var_str ("SM"))
 
     write (u, "(A)")  "* Create resonance histories"
     write (u, "(A)")
 
     call res_info%init (3, -24, global%model, 5)
     call res_history(1)%add_resonance (res_info)
     call res_history(1)%write (u)
 
     call res_info%init (7, 23, global%model, 5)
     call res_history(2)%add_resonance (res_info)
     call res_history(2)%write (u)
 
     call res_history_set%init ()
     call res_history_set%enter (res_history(1))
     call res_history_set%enter (res_history(2))
     call res_history_set%freeze ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Empty restricted subprocess set"
     write (u, "(A)")
 
     write (u, "(A,1x,L1)")  "active =", prc_set%is_active ()
     write (u, "(A)")
 
     call prc_set%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Fill restricted subprocess set"
     write (u, "(A)")
 
     libname = "restricted_subprocesses_2_p_R"
     prt_in(1) = "e-"
     prt_in(2) = "e+"
     prt_out(1) = "d"
     prt_out(2) = "u"
     prt_out(3) = "W+"
 
     call prc_set%init (1)
     call prc_set%fill_resonances (res_history_set, 1)
     call prc_set%create_library (libname, global, exist)
     if (.not. exist) then
        call prc_set%add_to_library (1, &
             new_prt_spec (prt_in), new_prt_spec (prt_out), &
             global)
     end if
     call prc_set%freeze_library (global)
 
     write (u, "(A,1x,L1)")  "active =", prc_set%is_active ()
     write (u, "(A)")
 
     call prc_set%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Queries"
     write (u, "(A)")
 
     write (u, "(A,1x,I0)")  "n_process =", prc_set%get_n_process ()
     write (u, "(A)")
     write (u, "(A,A,A)")  "libname = '", char (prc_set%get_libname ()), "'"
     write (u, "(A)")
     write (u, "(A,A,A)")  "proc_id(1) = '", char (prc_set%get_proc_id (1)), "'"
     write (u, "(A,A,A)")  "proc_id(2) = '", char (prc_set%get_proc_id (2)), "'"
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Process library"
     write (u, "(A)")
 
     call prc_set%compile_library (global)
 
     lib => global%prclib_stack%get_library_ptr (libname)
     if (associated (lib))  call lib%write (u, libpath=.false.)
 
     write (u, *)
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_2"
 
   end subroutine restricted_subprocesses_2
 
 @ %def restricted_subprocesses_2
 @
 \subsubsection{Auxiliary: Test processes}
 Auxiliary subroutine that constructs the process library for the above test.
 This parallels a similar subroutine in [[processes_uti]], but this time we
 want an \oMega\ process.
 <<Restricted subprocesses: public test auxiliary>>=
   public :: prepare_resonance_test_library
 <<Restricted subprocesses: test auxiliary>>=
   subroutine prepare_resonance_test_library &
        (lib, libname, procname, model, global, u)
     type(process_library_t), target, intent(out) :: lib
     type(string_t), intent(in) :: libname
     type(string_t), intent(in) :: procname
     class(model_data_t), intent(in), pointer :: model
     type(rt_data_t), intent(in), target :: global
     integer, intent(in) :: u
     type(string_t), dimension(:), allocatable :: prt_in, prt_out
     class(prc_core_def_t), allocatable :: def
     type(process_def_entry_t), pointer :: entry
 
     call lib%init (libname)
 
     allocate (prt_in (2), prt_out (3))
     prt_in = [var_str ("e+"), var_str ("e-")]
     prt_out = [var_str ("d"), var_str ("ubar"), var_str ("W+")]
 
     allocate (omega_def_t :: def)
     select type (def)
     type is (omega_def_t)
        call def%init (model%get_name (), prt_in, prt_out, &
             ovm=.false., ufo=.false.)
     end select
     allocate (entry)
     call entry%init (procname, &
          model_name = model%get_name (), &
          n_in = 2, n_components = 1, &
          requires_resonances = .true.)
     call entry%import_component (1, n_out = size (prt_out), &
          prt_in  = new_prt_spec (prt_in), &
          prt_out = new_prt_spec (prt_out), &
          method  = var_str ("omega"), &
          variant = def)
     call entry%write (u)
 
     call lib%append (entry)
 
     call lib%configure (global%os_data)
     call lib%write_makefile (global%os_data, force = .true., verbose = .false.)
     call lib%clean (global%os_data, distclean = .false.)
     call lib%write_driver (force = .true.)
     call lib%load (global%os_data)
 
   end subroutine prepare_resonance_test_library
 
 @ %def prepare_resonance_test_library
 @
 \subsubsection{Kinematics and resonance selection}
 Prepare an actual process with resonant subprocesses.  Insert
 kinematics and apply the resonance selector in an associated event
 transform.
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_3, "restricted_subprocesses_3", &
        "resonance kinematics and probability", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_3
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_3 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(string_t) :: libname, libname_res
     type(string_t) :: procname
     type(process_component_def_t), pointer :: process_component_def
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     logical :: exist
     type(process_t), pointer :: process
     type(process_instance_t), target :: process_instance
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(resonant_subprocess_set_t) :: prc_set
     type(particle_set_t) :: pset
     real(default) :: sqrts, mw, pp
     real(default), dimension(3) :: p3
     type(vector4_t), dimension(:), allocatable :: p
     real(default), dimension(:), allocatable :: m
     integer, dimension(:), allocatable :: pdg
     real(default), dimension(:), allocatable :: sqme
     logical, dimension(:), allocatable :: mask
     real(default) :: on_shell_limit
     integer, dimension(:), allocatable :: i_array
     real(default), dimension(:), allocatable :: prob_array
     type(evt_resonance_t), target :: evt_resonance
     integer :: i, u_dump
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_3"
     write (u, "(A)")  "*   Purpose: handle process and resonance kinematics"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
 
     call global%select_model (var_str ("SM"))
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     libname = "restricted_subprocesses_3_lib"
     libname_res = "restricted_subprocesses_3_lib_res"
     procname = "restricted_subprocesses_3_p"
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     call integrate_process (procname, global, &
          local_stack = .true., init_only = .true.)
 
     process => global%process_stack%get_process_ptr (procname)
 
     call process_instance%init (process)
     call process_instance%setup_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract resonance history set"
     write (u, "(A)")
 
     call process%extract_resonance_history_set &
          (res_history_set(1), include_trivial=.true., i_component=1)
     call res_history_set(1)%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build resonant-subprocess library"
     write (u, "(A)")
 
     call prc_set%init (1)
     call prc_set%fill_resonances (res_history_set(1), 1)
 
     process_component_def => process%get_component_def_ptr (1)
     call prc_set%create_library (libname_res, global, exist)
     if (.not. exist) then
        call prc_set%add_to_library (1, &
             process_component_def%get_prt_spec_in (), &
             process_component_def%get_prt_spec_out (), &
             global)
     end if
     call prc_set%freeze_library (global)
     call prc_set%compile_library (global)
     call prc_set%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build particle set"
     write (u, "(A)")
 
     sqrts = global%get_rval (var_str ("sqrts"))
     mw = 80._default   ! deliberately slightly different from true mw
     pp = sqrt (sqrts**2 - 4 * mw**2) / 2
 
     allocate (pdg (5), p (5), m (5))
     pdg(1) = -11
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     m(1) = 0
     pdg(2) = 11
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     m(2) = 0
     pdg(3) = 1
     p3(1) = pp/2
     p3(2) = mw/2
     p3(3) = 0
     p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(3) = 0
     p3(2) = -mw/2
     pdg(4) = -2
     p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(4) = 0
     pdg(5) = 24
     p(5) = vector4_moving (sqrts/2,-pp, 1)
     m(5) = mw
 
     call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
     call pset%set_momentum (p, m**2)
     call pset%write (u, testflag=.true.)
 
      write (u, "(A)")
      write (u, "(A)")  "* Fill process instance"
 
     ! workflow from event_recalculate
     call process_instance%choose_mci (1)
     call process_instance%set_trace (pset, 1)
     call process_instance%recover &
          (1, 1, update_sqme=.true., recover_phs=.false.)
     call process_instance%evaluate_event_data (weight = 1._default)
 
     write (u, "(A)")
     write (u, "(A)")  "* Prepare resonant subprocesses"
 
     call prc_set%prepare_process_objects (global)
     call prc_set%prepare_process_instances (global)
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call prc_set%connect_transform (evt_resonance)
     call evt_resonance%connect (process_instance, model)
 
     call prc_set%fill_momenta ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Show squared matrix element of master process,"
     write (u, "(A)")  "  should coincide with 2nd subprocess sqme"
     write (u, "(A)")
 
     write (u, "(1x,I0,1x," // FMT_12 // ")")  0, prc_set%get_master_sqme ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute squared matrix elements &
          &of selected resonant subprocesses [1,2]"
     write (u, "(A)")
 
     call prc_set%evaluate_subprocess ([1,2])
 
     allocate (sqme (3), source = 0._default)
     call prc_set%get_subprocess_sqme (sqme)
     do i = 1, size (sqme)
        write (u, "(1x,I0,1x," // FMT_12 // ")")  i, sqme(i)
     end do
     deallocate (sqme)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute squared matrix elements &
          &of all resonant subprocesses"
     write (u, "(A)")
 
     call prc_set%evaluate_subprocess ([1,2,3])
 
     allocate (sqme (3), source = 0._default)
     call prc_set%get_subprocess_sqme (sqme)
     do i = 1, size (sqme)
        write (u, "(1x,I0,1x," // FMT_12 // ")")  i, sqme(i)
     end do
     deallocate (sqme)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write process instances to file &
          &restricted_subprocesses_3_lib_res.dat"
 
     u_dump = free_unit ()
     open (unit = u_dump, file = "restricted_subprocesses_3_lib_res.dat", &
          action = "write", status = "replace")
     call prc_set%dump_instances (u_dump)
     close (u_dump)
 
     write (u, "(A)")
     write (u, "(A)")  "* Determine on-shell resonant subprocesses"
     write (u, "(A)")
 
     on_shell_limit = 0
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     write (u, "(1x,A,9(1x,I0))")  "resonant =", i_array
 
     on_shell_limit = 0.1_default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     write (u, "(1x,A,9(1x,I0))")  "resonant =", i_array
 
     on_shell_limit = 10._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     write (u, "(1x,A,9(1x,I0))")  "resonant =", i_array
 
     on_shell_limit = 10000._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     write (u, "(1x,A,9(1x,I0))")  "resonant =", i_array
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute probabilities for applicable resonances"
     write (u, "(A)")  "  and initialize the process selector"
     write (u, "(A)")  "  (The first number is the probability for background)"
     write (u, "(A)")
 
     on_shell_limit = 0
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     call prc_set%compute_probabilities (prob_array)
     write (u, "(1x,A,9(1x,"// FMT_12 // "))")  "resonant =", prob_array
     call prc_set%write (u, testflag=.true.)
     write (u, *)
 
     on_shell_limit = 10._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     call prc_set%compute_probabilities (prob_array)
     write (u, "(1x,A,9(1x,"// FMT_12 // "))")  "resonant =", prob_array
     call prc_set%write (u, testflag=.true.)
     write (u, *)
 
     on_shell_limit = 10000._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     call prc_set%compute_probabilities (prob_array)
     write (u, "(1x,A,9(1x,"// FMT_12 // "))")  "resonant =", prob_array
     write (u, *)
     call prc_set%write (u, testflag=.true.)
     write (u, *)
 
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_3"
 
   end subroutine restricted_subprocesses_3
 
 @ %def restricted_subprocesses_3
 @
 \subsubsection{Event transform}
 Prepare an actual process with resonant subprocesses.  Prepare the
 resonance selector for a fixed event and apply the resonance-insertion
 event transform.
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_4, "restricted_subprocesses_4", &
        "event transform", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_4
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_4 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(string_t) :: libname, libname_res
     type(string_t) :: procname
     type(process_component_def_t), pointer :: process_component_def
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     logical :: exist
     type(process_t), pointer :: process
     type(process_instance_t), target :: process_instance
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(resonant_subprocess_set_t) :: prc_set
     type(particle_set_t) :: pset
     real(default) :: sqrts, mw, pp
     real(default), dimension(3) :: p3
     type(vector4_t), dimension(:), allocatable :: p
     real(default), dimension(:), allocatable :: m
     integer, dimension(:), allocatable :: pdg
     real(default) :: on_shell_limit
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     real(default) :: probability
     integer :: i
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_4"
     write (u, "(A)")  "*   Purpose: employ event transform"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
 
     call global%select_model (var_str ("SM"))
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     libname = "restricted_subprocesses_4_lib"
     libname_res = "restricted_subprocesses_4_lib_res"
     procname = "restricted_subprocesses_4_p"
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     call integrate_process (procname, global, &
          local_stack = .true., init_only = .true.)
 
     process => global%process_stack%get_process_ptr (procname)
 
     call process_instance%init (process)
     call process_instance%setup_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract resonance history set"
 
     call process%extract_resonance_history_set &
          (res_history_set(1), include_trivial=.false., i_component=1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build resonant-subprocess library"
 
     call prc_set%init (1)
     call prc_set%fill_resonances (res_history_set(1), 1)
 
     process_component_def => process%get_component_def_ptr (1)
     call prc_set%create_library (libname_res, global, exist)
     if (.not. exist) then
        call prc_set%add_to_library (1, &
             process_component_def%get_prt_spec_in (), &
             process_component_def%get_prt_spec_out (), &
             global)
     end if
     call prc_set%freeze_library (global)
     call prc_set%compile_library (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build particle set"
     write (u, "(A)")
 
     sqrts = global%get_rval (var_str ("sqrts"))
     mw = 80._default   ! deliberately slightly different from true mw
     pp = sqrt (sqrts**2 - 4 * mw**2) / 2
 
     allocate (pdg (5), p (5), m (5))
     pdg(1) = -11
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     m(1) = 0
     pdg(2) = 11
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     m(2) = 0
     pdg(3) = 1
     p3(1) = pp/2
     p3(2) = mw/2
     p3(3) = 0
     p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(3) = 0
     p3(2) = -mw/2
     pdg(4) = -2
     p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(4) = 0
     pdg(5) = 24
     p(5) = vector4_moving (sqrts/2,-pp, 1)
     m(5) = mw
 
     call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
     call pset%set_momentum (p, m**2)
 
     write (u, "(A)")  "* Fill process instance"
     write (u, "(A)")
 
     ! workflow from event_recalculate
     call process_instance%choose_mci (1)
     call process_instance%set_trace (pset, 1)
     call process_instance%recover &
          (1, 1, update_sqme=.true., recover_phs=.false.)
     call process_instance%evaluate_event_data (weight = 1._default)
 
     write (u, "(A)")  "* Prepare resonant subprocesses"
     write (u, "(A)")
 
     call prc_set%prepare_process_objects (global)
     call prc_set%prepare_process_instances (global)
 
     write (u, "(A)")  "* Fill trivial event transform (deliberately w/o color)"
     write (u, "(A)")
 
     call evt_trivial%connect (process_instance, model)
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize resonance-insertion event transform"
     write (u, "(A)")
 
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call evt_resonance%connect (process_instance, model)
     call prc_set%connect_transform (evt_resonance)
     call evt_resonance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute probabilities for applicable resonances"
     write (u, "(A)")  "  and initialize the process selector"
     write (u, "(A)")
 
     on_shell_limit = 10._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call evt_resonance%set_on_shell_limit (on_shell_limit)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate resonance-insertion event transform"
     write (u, "(A)")
 
     call evt_resonance%prepare_new_event (1, 1)
     call evt_resonance%generate_weighted (probability)
     call evt_resonance%make_particle_set (1, .false.)
 
     call evt_resonance%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_4"
 
   end subroutine restricted_subprocesses_4
 
 @ %def restricted_subprocesses_4
 @
 \subsubsection{Gaussian turnoff}
 Identical to the previous process, except that we apply a Gaussian
 turnoff to the resonance kinematics, which affects the subprocess selector.
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_5, "restricted_subprocesses_5", &
        "event transform with gaussian turnoff", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_5
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_5 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(string_t) :: libname, libname_res
     type(string_t) :: procname
     type(process_component_def_t), pointer :: process_component_def
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     logical :: exist
     type(process_t), pointer :: process
     type(process_instance_t), target :: process_instance
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(resonant_subprocess_set_t) :: prc_set
     type(particle_set_t) :: pset
     real(default) :: sqrts, mw, pp
     real(default), dimension(3) :: p3
     type(vector4_t), dimension(:), allocatable :: p
     real(default), dimension(:), allocatable :: m
     integer, dimension(:), allocatable :: pdg
     real(default) :: on_shell_limit
     real(default) :: on_shell_turnoff
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     real(default) :: probability
     integer :: i
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_5"
     write (u, "(A)")  "*   Purpose: employ event transform &
          &with gaussian turnoff"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
 
     call global%select_model (var_str ("SM"))
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     libname = "restricted_subprocesses_5_lib"
     libname_res = "restricted_subprocesses_5_lib_res"
     procname = "restricted_subprocesses_5_p"
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     call integrate_process (procname, global, &
          local_stack = .true., init_only = .true.)
 
     process => global%process_stack%get_process_ptr (procname)
 
     call process_instance%init (process)
     call process_instance%setup_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract resonance history set"
 
     call process%extract_resonance_history_set &
          (res_history_set(1), include_trivial=.false., i_component=1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build resonant-subprocess library"
 
     call prc_set%init (1)
     call prc_set%fill_resonances (res_history_set(1), 1)
 
     process_component_def => process%get_component_def_ptr (1)
     call prc_set%create_library (libname_res, global, exist)
     if (.not. exist) then
        call prc_set%add_to_library (1, &
             process_component_def%get_prt_spec_in (), &
             process_component_def%get_prt_spec_out (), &
             global)
     end if
     call prc_set%freeze_library (global)
     call prc_set%compile_library (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build particle set"
     write (u, "(A)")
 
     sqrts = global%get_rval (var_str ("sqrts"))
     mw = 80._default   ! deliberately slightly different from true mw
     pp = sqrt (sqrts**2 - 4 * mw**2) / 2
 
     allocate (pdg (5), p (5), m (5))
     pdg(1) = -11
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     m(1) = 0
     pdg(2) = 11
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     m(2) = 0
     pdg(3) = 1
     p3(1) = pp/2
     p3(2) = mw/2
     p3(3) = 0
     p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(3) = 0
     p3(2) = -mw/2
     pdg(4) = -2
     p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(4) = 0
     pdg(5) = 24
     p(5) = vector4_moving (sqrts/2,-pp, 1)
     m(5) = mw
 
     call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
     call pset%set_momentum (p, m**2)
 
     write (u, "(A)")  "* Fill process instance"
     write (u, "(A)")
 
     ! workflow from event_recalculate
     call process_instance%choose_mci (1)
     call process_instance%set_trace (pset, 1)
     call process_instance%recover &
          (1, 1, update_sqme=.true., recover_phs=.false.)
     call process_instance%evaluate_event_data (weight = 1._default)
 
     write (u, "(A)")  "* Prepare resonant subprocesses"
     write (u, "(A)")
 
     call prc_set%prepare_process_objects (global)
     call prc_set%prepare_process_instances (global)
 
     write (u, "(A)")  "* Fill trivial event transform (deliberately w/o color)"
     write (u, "(A)")
 
     call evt_trivial%connect (process_instance, model)
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize resonance-insertion event transform"
     write (u, "(A)")
 
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call evt_resonance%connect (process_instance, model)
     call prc_set%connect_transform (evt_resonance)
     call evt_resonance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute probabilities for applicable resonances"
     write (u, "(A)")  "  and initialize the process selector"
     write (u, "(A)")
 
     on_shell_limit = 10._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit   =", &
          on_shell_limit
     call evt_resonance%set_on_shell_limit (on_shell_limit)
 
     on_shell_turnoff = 1._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_turnoff =", &
          on_shell_turnoff
     call evt_resonance%set_on_shell_turnoff (on_shell_turnoff)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate resonance-insertion event transform"
     write (u, "(A)")
 
     call evt_resonance%prepare_new_event (1, 1)
     call evt_resonance%generate_weighted (probability)
     call evt_resonance%make_particle_set (1, .false.)
 
     call evt_resonance%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_5"
 
   end subroutine restricted_subprocesses_5
 
 @ %def restricted_subprocesses_5
 @
 \subsubsection{Event transform}
 The same process and event again.  This time, switch off the background
 contribution, so the selector becomes trivial.
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_6, "restricted_subprocesses_6", &
        "event transform with background switched off", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_6
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_6 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(string_t) :: libname, libname_res
     type(string_t) :: procname
     type(process_component_def_t), pointer :: process_component_def
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     logical :: exist
     type(process_t), pointer :: process
     type(process_instance_t), target :: process_instance
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(resonant_subprocess_set_t) :: prc_set
     type(particle_set_t) :: pset
     real(default) :: sqrts, mw, pp
     real(default), dimension(3) :: p3
     type(vector4_t), dimension(:), allocatable :: p
     real(default), dimension(:), allocatable :: m
     integer, dimension(:), allocatable :: pdg
     real(default) :: on_shell_limit
     real(default) :: background_factor
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     real(default) :: probability
     integer :: i
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_6"
     write (u, "(A)")  "*   Purpose: employ event transform &
          &with background switched off"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
 
     call global%select_model (var_str ("SM"))
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     libname = "restricted_subprocesses_6_lib"
     libname_res = "restricted_subprocesses_6_lib_res"
     procname = "restricted_subprocesses_6_p"
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     call integrate_process (procname, global, &
          local_stack = .true., init_only = .true.)
 
     process => global%process_stack%get_process_ptr (procname)
 
     call process_instance%init (process)
     call process_instance%setup_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract resonance history set"
 
     call process%extract_resonance_history_set &
          (res_history_set(1), include_trivial=.false., i_component=1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build resonant-subprocess library"
 
     call prc_set%init (1)
     call prc_set%fill_resonances (res_history_set(1), 1)
 
     process_component_def => process%get_component_def_ptr (1)
     call prc_set%create_library (libname_res, global, exist)
     if (.not. exist) then
        call prc_set%add_to_library (1, &
             process_component_def%get_prt_spec_in (), &
             process_component_def%get_prt_spec_out (), &
             global)
     end if
     call prc_set%freeze_library (global)
     call prc_set%compile_library (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build particle set"
     write (u, "(A)")
 
     sqrts = global%get_rval (var_str ("sqrts"))
     mw = 80._default   ! deliberately slightly different from true mw
     pp = sqrt (sqrts**2 - 4 * mw**2) / 2
 
     allocate (pdg (5), p (5), m (5))
     pdg(1) = -11
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     m(1) = 0
     pdg(2) = 11
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     m(2) = 0
     pdg(3) = 1
     p3(1) = pp/2
     p3(2) = mw/2
     p3(3) = 0
     p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(3) = 0
     p3(2) = -mw/2
     pdg(4) = -2
     p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(4) = 0
     pdg(5) = 24
     p(5) = vector4_moving (sqrts/2,-pp, 1)
     m(5) = mw
 
     call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
     call pset%set_momentum (p, m**2)
 
     write (u, "(A)")  "* Fill process instance"
     write (u, "(A)")
 
     ! workflow from event_recalculate
     call process_instance%choose_mci (1)
     call process_instance%set_trace (pset, 1)
     call process_instance%recover &
          (1, 1, update_sqme=.true., recover_phs=.false.)
     call process_instance%evaluate_event_data (weight = 1._default)
 
     write (u, "(A)")  "* Prepare resonant subprocesses"
     write (u, "(A)")
 
     call prc_set%prepare_process_objects (global)
     call prc_set%prepare_process_instances (global)
 
     write (u, "(A)")  "* Fill trivial event transform (deliberately w/o color)"
     write (u, "(A)")
 
     call evt_trivial%connect (process_instance, model)
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize resonance-insertion event transform"
     write (u, "(A)")
 
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call evt_resonance%connect (process_instance, model)
     call prc_set%connect_transform (evt_resonance)
     call evt_resonance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute probabilities for applicable resonances"
     write (u, "(A)")  "  and initialize the process selector"
     write (u, "(A)")
 
     on_shell_limit = 10._default
     write (u, "(1x,A,1x," // FMT_10 // ")") &
          "on_shell_limit    =", on_shell_limit
     call evt_resonance%set_on_shell_limit (on_shell_limit)
 
     background_factor = 0
     write (u, "(1x,A,1x," // FMT_10 // ")") &
          "background_factor =", background_factor
     call evt_resonance%set_background_factor (background_factor)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate resonance-insertion event transform"
     write (u, "(A)")
 
     call evt_resonance%prepare_new_event (1, 1)
     call evt_resonance%generate_weighted (probability)
     call evt_resonance%make_particle_set (1, .false.)
 
     call evt_resonance%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_6"
 
   end subroutine restricted_subprocesses_6
 
 @ %def restricted_subprocesses_6
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Simulation}
 This module manages simulation: event generation and reading/writing of event
 files.  The [[simulation]] object is intended to be used (via a pointer)
 outside of \whizard, if events are generated individually by an external
 driver.
 <<[[simulations.f90]]>>=
 <<File header>>
 
 module simulations
 
 <<Use kinds>>
 <<Use strings>>
 <<Use debug>>
   use io_units
   use format_utils, only: write_separator
   use format_defs, only: FMT_15, FMT_19
   use os_interface
   use numeric_utils
   use string_utils, only: str
   use diagnostics
   use lorentz, only: vector4_t
   use sm_qcd
   use md5
   use variables, only: var_list_t
   use eval_trees
   use model_data
   use flavors
   use particles
   use state_matrices, only: FM_IGNORE_HELICITY
   use beam_structures, only: beam_structure_t
   use beams
   use rng_base
   use rng_stream, only: rng_stream_t
   use selectors
   use resonances, only: resonance_history_set_t
   use process_libraries, only: process_library_t
   use process_libraries, only: process_component_def_t
   use prc_core
   !  TODO: (bcn 2016-09-13) should be ideally only pcm_base
   use pcm, only: pcm_nlo_t, pcm_instance_nlo_t
   !  TODO: (bcn 2016-09-13) details of process config should not be necessary here
   use process_config, only: COMP_REAL_FIN
   use process
   use instances
   use event_base
   use events
   use event_transforms
   use shower
   use eio_data
   use eio_base
   use rt_data
 
   use dispatch_beams, only: dispatch_qcd
   use dispatch_rng, only: dispatch_rng_factory
   use dispatch_rng, only: update_rng_seed_in_var_list
   use dispatch_me_methods, only: dispatch_core_update, dispatch_core_restore
   use dispatch_transforms, only: dispatch_evt_isr_epa_handler
   use dispatch_transforms, only: dispatch_evt_resonance
   use dispatch_transforms, only: dispatch_evt_decay
   use dispatch_transforms, only: dispatch_evt_shower
   use dispatch_transforms, only: dispatch_evt_hadrons
   use dispatch_transforms, only: dispatch_evt_nlo
 
   use integrations
   use event_streams
   use restricted_subprocesses, only: resonant_subprocess_set_t
   use restricted_subprocesses, only: get_libname_res
 
   use evt_nlo
 
 <<Use mpi f08>>
 
 <<Standard module head>>
 
 <<Simulations: public>>
 
 <<Simulations: types>>
 
 <<Simulations: interfaces>>
 
 contains
 
 <<Simulations: procedures>>
 
 end module simulations
 @ %def simulations
 @
 \subsection{Event counting}
 In this object we collect statistical information about an event
 sample or sub-sample.
 <<Simulations: types>>=
   type :: counter_t
      integer :: total = 0
      integer :: generated = 0
      integer :: read = 0
      integer :: positive = 0
      integer :: negative = 0
      integer :: zero = 0
      integer :: excess = 0
      integer :: dropped = 0
      real(default) :: max_excess = 0
      real(default) :: sum_excess = 0
      logical :: reproduce_xsection = .false.
      real(default) :: mean = 0
      real(default) :: varsq = 0
      integer :: nlo_weight_counter = 0
    contains
    <<Simulations: counter: TBP>>
   end type counter_t
 
 @ %def simulation_counter_t
 @ Output.
 <<Simulations: counter: TBP>>=
   procedure :: write => counter_write
 <<Simulations: procedures>>=
   subroutine counter_write (counter, unit)
     class(counter_t), intent(in) :: counter
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
 1   format (3x,A,I0)
 2   format (5x,A,I0)
 3   format (5x,A,ES19.12)
     write (u, 1)  "Events total      = ", counter%total
     write (u, 2)  "generated       = ", counter%generated
     write (u, 2)  "read            = ", counter%read
     write (u, 2)  "positive weight = ", counter%positive
     write (u, 2)  "negative weight = ", counter%negative
     write (u, 2)  "zero weight     = ", counter%zero
     write (u, 2)  "excess weight   = ", counter%excess
     if (counter%excess /= 0) then
        write (u, 3)  "max excess      = ", counter%max_excess
        write (u, 3)  "avg excess      = ", counter%sum_excess / counter%total
     end if
     write (u, 1)  "Events dropped    = ", counter%dropped
   end subroutine counter_write
 
 @ %def counter_write
 @ This is a screen message: if there was an excess, display statistics.
 <<Simulations: counter: TBP>>=
   procedure :: show_excess => counter_show_excess
 <<Simulations: procedures>>=
   subroutine counter_show_excess (counter)
     class(counter_t), intent(in) :: counter
     if (counter%excess > 0) then
        write (msg_buffer, "(A,1x,I0,1x,A,1x,'(',F7.3,' %)')") &
             "Encountered events with excess weight:", counter%excess, &
             "events", 100 * counter%excess / real (counter%total)
        call msg_warning ()
        write (msg_buffer, "(A,ES10.3)") &
             "Maximum excess weight =", counter%max_excess
        call msg_message ()
        write (msg_buffer, "(A,ES10.3)") &
             "Average excess weight =", counter%sum_excess / counter%total
        call msg_message ()
     end if
   end subroutine counter_show_excess
 
 @ %def counter_show_excess
 @ If events have been dropped during simulation of weighted events,
 issue a message here.
 <<Simulations: counter: TBP>>=
   procedure :: show_dropped => counter_show_dropped
 <<Simulations: procedures>>=
   subroutine counter_show_dropped (counter)
     class(counter_t), intent(in) :: counter
     if (counter%dropped > 0) then
        write (msg_buffer, "(A,1x,I0,1x,'(',A,1x,I0,')')") &
             "Dropped events (weight zero) =", &
             counter%dropped, "total", counter%dropped + counter%total
        call msg_message ()
        write (msg_buffer, "(A,ES15.8)") &
             "All event weights must be rescaled by f =", &
             real (counter%total, default) &
             / real (counter%dropped + counter%total, default)
        call msg_warning ()
     end if
   end subroutine counter_show_dropped
 
 @ %def counter_show_dropped
 @
 <<Simulations: counter: TBP>>=
   procedure :: show_mean_and_variance => counter_show_mean_and_variance
 <<Simulations: procedures>>=
   subroutine counter_show_mean_and_variance (counter)
     class(counter_t), intent(in) :: counter
     if (counter%reproduce_xsection .and. counter%nlo_weight_counter > 1) then
        print *,  "Reconstructed cross-section from event weights: "
        print *,  counter%mean, '+-', sqrt (counter%varsq / (counter%nlo_weight_counter - 1))
     end if
   end subroutine counter_show_mean_and_variance
 
 @ %def counter_show_mean_and_variance
 @ Count an event.  The weight and event source are optional; by
 default we assume that the event has been generated and has positive
 weight.
 
 The optional integer [[n_dropped]] counts weighted events with weight
 zero that were encountered while generating the current event, but
 dropped (because of their zero weight).  Accumulating this number
 allows for renormalizing event weight sums in histograms, after the
 generation step has been completed.
 <<Simulations: counter: TBP>>=
   procedure :: record => counter_record
 <<Simulations: procedures>>=
   subroutine counter_record (counter, weight, excess, n_dropped, from_file)
     class(counter_t), intent(inout) :: counter
     real(default), intent(in), optional :: weight, excess
     integer, intent(in), optional :: n_dropped
     logical, intent(in), optional :: from_file
     counter%total = counter%total + 1
     if (present (from_file)) then
        if (from_file) then
           counter%read = counter%read + 1
        else
           counter%generated = counter%generated + 1
        end if
     else
        counter%generated = counter%generated + 1
     end if
     if (present (weight)) then
        if (weight > 0) then
           counter%positive = counter%positive + 1
        else if (weight < 0) then
           counter%negative = counter%negative + 1
        else
           counter%zero = counter%zero + 1
        end if
     else
        counter%positive = counter%positive + 1
     end if
     if (present (excess)) then
        if (excess > 0) then
           counter%excess = counter%excess + 1
           counter%max_excess = max (counter%max_excess, excess)
           counter%sum_excess = counter%sum_excess + excess
        end if
     end if
     if (present (n_dropped)) then
        counter%dropped = counter%dropped + n_dropped
     end if
   end subroutine counter_record
 
 @ %def counter_record
 <<MPI: Simulations: counter: TBP>>=
   procedure :: allreduce_record => counter_allreduce_record
 <<MPI: Simulations: procedures>>=
   subroutine counter_allreduce_record (counter)
     class(counter_t), intent(inout) :: counter
     integer :: read, generated
     integer :: positive, negative, zero, excess, dropped
     real(default) :: max_excess, sum_excess
     read = counter%read
     generated = counter%generated
     positive = counter%positive
     negative = counter%negative
     zero = counter%zero
     excess = counter%excess
     max_excess = counter%max_excess
     sum_excess = counter%sum_excess
     dropped = counter%dropped
     call MPI_ALLREDUCE (read, counter%read, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
     call MPI_ALLREDUCE (generated, counter%generated, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
     call MPI_ALLREDUCE (positive, counter%positive, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
     call MPI_ALLREDUCE (negative, counter%negative, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
     call MPI_ALLREDUCE (zero, counter%zero, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
     call MPI_ALLREDUCE (excess, counter%excess, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
     call MPI_ALLREDUCE (max_excess, counter%max_excess, 1, MPI_DOUBLE_PRECISION, MPI_MAX, MPI_COMM_WORLD)
     call MPI_ALLREDUCE (sum_excess, counter%sum_excess, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD)
     call MPI_ALLREDUCE (dropped, counter%dropped, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
     !! \todo{sbrass - Implement allreduce of mean and variance, relevant for weighted events.}
   end subroutine counter_allreduce_record
 
 @
 <<Simulations: counter: TBP>>=
   procedure :: record_mean_and_variance => &
      counter_record_mean_and_variance
 <<Simulations: procedures>>=
   subroutine counter_record_mean_and_variance (counter, weight, i_nlo)
     class(counter_t), intent(inout) :: counter
     real(default), intent(in) :: weight
     integer, intent(in) :: i_nlo
     real(default), save :: weight_buffer = 0._default
     integer, save :: nlo_count = 1
     if (.not. counter%reproduce_xsection) return
     if (i_nlo == 1) then
        call flush_weight_buffer (weight_buffer, nlo_count)
        weight_buffer = weight
        nlo_count = 1
     else
        weight_buffer = weight_buffer + weight
        nlo_count = nlo_count + 1
     end if
   contains
     subroutine flush_weight_buffer (w, n_nlo)
       real(default), intent(in) :: w
       integer, intent(in) :: n_nlo
       integer :: n
       real(default) :: mean_new
       counter%nlo_weight_counter = counter%nlo_weight_counter + 1
       !!! Minus 1 to take into account offset from initialization
       n = counter%nlo_weight_counter - 1
       if (n > 0) then
          mean_new = counter%mean + (w / n_nlo - counter%mean) / n
          if (n > 1) &
             counter%varsq = counter%varsq - counter%varsq / (n - 1) + &
                n * (mean_new - counter%mean)**2
          counter%mean = mean_new
       end if
     end subroutine flush_weight_buffer
   end subroutine counter_record_mean_and_variance
 
 @ %def counter_record_mean_and_variance
 @
 \subsection{Simulation: component sets}
 For each set of process components that share a MCI entry in the
 process configuration, we keep a separate event record.
 <<Simulations: types>>=
   type :: mci_set_t
      private
      integer :: n_components = 0
      integer, dimension(:), allocatable :: i_component
      type(string_t), dimension(:), allocatable :: component_id
      logical :: has_integral = .false.
      real(default) :: integral = 0
      real(default) :: error = 0
      real(default) :: weight_mci = 0
      type(counter_t) :: counter
    contains
    <<Simulations: mci set: TBP>>
   end type mci_set_t
 
 @ %def mci_set_t
 @ Output.
 <<Simulations: mci set: TBP>>=
   procedure :: write => mci_set_write
 <<Simulations: procedures>>=
   subroutine mci_set_write (object, unit, pacified)
     class(mci_set_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacified
     logical :: pacify
     integer :: u, i
     u = given_output_unit (unit)
     pacify = .false.;  if (present (pacified))  pacify = pacified
     write (u, "(3x,A)")  "Components:"
     do i = 1, object%n_components
        write (u, "(5x,I0,A,A,A)")  object%i_component(i), &
             ": '", char (object%component_id(i)), "'"
     end do
     if (object%has_integral) then
        if (pacify) then
           write (u, "(3x,A," // FMT_15 // ")")  "Integral  = ", object%integral
           write (u, "(3x,A," // FMT_15 // ")")  "Error     = ", object%error
           write (u, "(3x,A,F9.6)")  "Weight    =", object%weight_mci
        else
           write (u, "(3x,A," // FMT_19 // ")")  "Integral  = ", object%integral
           write (u, "(3x,A," // FMT_19 // ")")  "Error     = ", object%error
           write (u, "(3x,A,F13.10)")  "Weight    =", object%weight_mci
        end if
     else
        write (u, "(3x,A)")  "Integral  = [undefined]"
     end if
     call object%counter%write (u)
   end subroutine mci_set_write
 
 @ %def mci_set_write
 @ Initialize: Get the indices and names for the process components
 that will contribute to this set.
 <<Simulations: mci set: TBP>>=
   procedure :: init => mci_set_init
 <<Simulations: procedures>>=
   subroutine mci_set_init (object, i_mci, process)
     class(mci_set_t), intent(out) :: object
     integer, intent(in) :: i_mci
     type(process_t), intent(in), target :: process
     integer :: i
     call process%get_i_component (i_mci, object%i_component)
     object%n_components = size (object%i_component)
     allocate (object%component_id (object%n_components))
     do i = 1, size (object%component_id)
        object%component_id(i) = &
             process%get_component_id (object%i_component(i))
     end do
     if (process%has_integral (i_mci)) then
        object%integral = process%get_integral (i_mci)
        object%error = process%get_error (i_mci)
        object%has_integral = .true.
     end if
   end subroutine mci_set_init
 
 @ %def mci_set_init
 @
 \subsection{Process-core Safe}
 This is an object that temporarily holds a process core object.  We
 need this while rescanning a process with modified parameters.  After
 the rescan, we want to restore the original state.
 <<Simulations: types>>=
   type :: core_safe_t
      class(prc_core_t), allocatable :: core
   end type core_safe_t
 
 @ %def core_safe_t
 @
 \subsection{Process Object}
 The simulation works on process objects.  This subroutine makes a
 process object available for simulation.  The process is in the
 process stack.  [[use_process]] implies that the process should
 already exist as an object in the process stack.  If integration is
 not yet done, do it.  Any generated process object should be put on
 the global stack, if it is separate from the local one.
 <<Simulations: procedures>>=
   subroutine prepare_process &
        (process, process_id, use_process, integrate, local, global)
     type(process_t), pointer, intent(out) :: process
     type(string_t), intent(in) :: process_id
     logical, intent(in) :: use_process, integrate
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     type(rt_data_t), pointer :: current
     if (debug_on) call msg_debug (D_CORE, "prepare_process")
     if (debug_on) call msg_debug (D_CORE, "global present", present (global))
     if (present (global)) then
        current => global
     else
        current => local
     end if
     process => current%process_stack%get_process_ptr (process_id)
     if (debug_on) call msg_debug (D_CORE, "use_process", use_process)
     if (debug_on) call msg_debug (D_CORE, "associated process", associated (process))
     if (use_process .and. .not. associated (process)) then
        if (integrate) then
           call msg_message ("Simulate: process '" &
                // char (process_id) // "' needs integration")
        else
           call msg_message ("Simulate: process '" &
                // char (process_id) // "' needs initialization")
        end if
        if (present (global)) then
           call integrate_process (process_id, local, global, &
             init_only = .not. integrate)
        else
           call integrate_process (process_id, local, &
                local_stack = .true., init_only = .not. integrate)
        end if
        if (signal_is_pending ())  return
        process => current%process_stack%get_process_ptr (process_id)
        if (associated (process)) then
           if (integrate) then
              call msg_message ("Simulate: integration done")
              call current%process_stack%fill_result_vars (process_id)
           else
              call msg_message ("Simulate: process initialization done")
           end if
        else
           call msg_fatal ("Simulate: process '" &
                // char (process_id) // "' could not be initialized: aborting")
        end if
     else if (.not. associated (process)) then
        if (present (global)) then
           call integrate_process (process_id, local, global, &
                init_only = .true.)
        else
           call integrate_process (process_id, local, &
                local_stack = .true., init_only = .true.)
        end if
        process => current%process_stack%get_process_ptr (process_id)
        call msg_message &
             ("Simulate: process '" &
                // char (process_id) // "': enabled for rescan only")
     end if
   end subroutine prepare_process
 
 @ %def prepare_process
 @
 \subsection{Simulation entry}
 For each process that we consider for event generation, we need a
 separate entry.  The entry separately records the process ID and run ID.  The
 [[weight_mci]] array is used for selecting a component set (which
 shares a MCI record inside the process container) when generating an
 event for the current process.
 
 The simulation entry is an extension of the [[event_t]] event record.
 This core object contains configuration data, pointers to the process
 and process instance, the expressions, flags and values that are
 evaluated at runtime, and the resulting particle set.
 
 The entry explicitly allocate the [[process_instance]], which becomes
 the process-specific workspace for the event record.
 
 If entries with differing environments are present simultaneously, we
 may need to switch QCD parameters and/or the model event by event.  In
 this case, the [[qcd]] and/or [[model]] components are present.\\
 For the puropose of NLO events, [[entry_t]] contains a pointer list
 to other simulation-entries. This is due to the fact that we have to
 associate an event for each component of the fixed order simulation,
 i.e. one $N$-particle event and $N_\alpha$ $N+1$-particle events.
 However, all entries share the same event transforms.
 <<Simulations: types>>=
   type, extends (event_t) :: entry_t
      private
      type(string_t) :: process_id
      type(string_t) :: library
      type(string_t) :: run_id
      logical :: has_integral = .false.
      real(default) :: integral = 0
      real(default) :: error = 0
      real(default) :: process_weight = 0
      logical :: valid = .false.
      type(counter_t) :: counter
      integer :: n_in = 0
      integer :: n_mci = 0
      type(mci_set_t), dimension(:), allocatable :: mci_sets
      type(selector_t) :: mci_selector
      logical :: has_resonant_subprocess_set = .false.
      type(resonant_subprocess_set_t) :: resonant_subprocess_set
      type(core_safe_t), dimension(:), allocatable :: core_safe
      class(model_data_t), pointer :: model => null ()
      type(qcd_t) :: qcd
      type(entry_t), pointer :: first => null ()
      type(entry_t), pointer :: next => null ()
      class(evt_t), pointer :: evt_powheg => null ()
    contains
    <<Simulations: entry: TBP>>
   end type entry_t
 
 @ %def entry_t
 @ Output.  Write just the configuration, the event is written by a
 separate routine.
 
 The [[verbose]] option is unused, it is required by the interface of
 the base-object method.
 <<Simulations: entry: TBP>>=
   procedure :: write_config => entry_write_config
 <<Simulations: procedures>>=
   subroutine entry_write_config (object, unit, pacified)
     class(entry_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacified
     logical :: pacify
     integer :: u, i
     u = given_output_unit (unit)
     pacify = .false.;  if (present (pacified))  pacify = pacified
     write (u, "(3x,A,A,A)")  "Process   = '", char (object%process_id), "'"
     write (u, "(3x,A,A,A)")  "Library   = '", char (object%library), "'"
     write (u, "(3x,A,A,A)")  "Run       = '", char (object%run_id), "'"
     write (u, "(3x,A,L1)")   "is valid  = ", object%valid
     if (object%has_integral) then
        if (pacify) then
           write (u, "(3x,A," // FMT_15 // ")")  "Integral  = ", object%integral
           write (u, "(3x,A," // FMT_15 // ")")  "Error     = ", object%error
           write (u, "(3x,A,F9.6)")  "Weight    =", object%process_weight
        else
           write (u, "(3x,A," // FMT_19 // ")")  "Integral  = ", object%integral
           write (u, "(3x,A," // FMT_19 // ")")  "Error     = ", object%error
           write (u, "(3x,A,F13.10)")  "Weight    =", object%process_weight
        end if
     else
        write (u, "(3x,A)")  "Integral  = [undefined]"
     end if
     write (u, "(3x,A,I0)")   "MCI sets  = ", object%n_mci
     call object%counter%write (u)
     do i = 1, size (object%mci_sets)
        write (u, "(A)")
        write (u, "(1x,A,I0,A)")  "MCI set #", i, ":"
        call object%mci_sets(i)%write (u, pacified)
     end do
     if (object%resonant_subprocess_set%is_active ()) then
        write (u, "(A)")
        call object%write_resonant_subprocess_data (u)
     end if
     if (allocated (object%core_safe)) then
        do i = 1, size (object%core_safe)
           write (u, "(1x,A,I0,A)")  "Saved process-component core #", i, ":"
           call object%core_safe(i)%core%write (u)
        end do
     end if
   end subroutine entry_write_config
 
 @ %def entry_write_config
 @ Finalizer.  The [[instance]] pointer component of the [[event_t]]
 base type points to a target which we did explicitly allocate in the
 [[entry_init]] procedure.  Therefore, we finalize and explicitly
 deallocate it here.  Then we call the finalizer of the base type.
 <<Simulations: entry: TBP>>=
   procedure :: final => entry_final
 <<Simulations: procedures>>=
   subroutine entry_final (object)
     class(entry_t), intent(inout) :: object
     integer :: i
     if (associated (object%instance)) then
        do i = 1, object%n_mci
           call object%instance%final_simulation (i)
        end do
        call object%instance%final ()
        deallocate (object%instance)
     end if
     call object%event_t%final ()
   end subroutine entry_final
 
 @ %def entry_final
 @ Copy the content of an entry into another one, except for the next-pointer
 <<Simulations: entry: TBP>>=
   procedure :: copy_entry => entry_copy_entry
 <<Simulations: procedures>>=
   subroutine entry_copy_entry (entry1, entry2)
     class(entry_t), intent(in), target :: entry1
     type(entry_t), intent(inout), target :: entry2
     call entry1%event_t%clone (entry2%event_t)
     entry2%process_id = entry1%process_id
     entry2%library = entry1%library
     entry2%run_id = entry1%run_id
     entry2%has_integral = entry1%has_integral
     entry2%integral = entry1%integral
     entry2%error = entry1%error
     entry2%process_weight = entry1%process_weight
     entry2%valid = entry1%valid
     entry2%counter = entry1%counter
     entry2%n_in = entry1%n_in
     entry2%n_mci = entry1%n_mci
     if (allocated (entry1%mci_sets)) then
        allocate (entry2%mci_sets (size (entry1%mci_sets)))
        entry2%mci_sets = entry1%mci_sets
     end if
     entry2%mci_selector = entry1%mci_selector
     if (allocated (entry1%core_safe)) then
        allocate (entry2%core_safe (size (entry1%core_safe)))
        entry2%core_safe = entry1%core_safe
     end if
     entry2%model => entry1%model
     entry2%qcd = entry1%qcd
   end subroutine entry_copy_entry
 
 @ %def entry_copy_entry
 @ Initialization.  Search for a process entry and allocate a process
 instance as an anonymous object, temporarily accessible via the
 [[process_instance]] pointer.  Assign data by looking at the process
 object and at the environment.
 
 If [[n_alt]] is set, we prepare for additional alternate sqme and weight
 entries.
 
 The [[compile]] flag is only false if we don't need the Whizard
 process at all, just its definition.  In that case, we skip process
 initialization.
 
 Otherwise, and if the process object is not found initially: if
 [[integrate]] is set, attempt an integration pass and try again.
 Otherwise, just initialize the object.
 
 If [[generate]] is set, prepare the MCI objects for generating new events.
 For pure rescanning, this is not necessary.
 
 If [[resonance_history]] is set, we create a separate process library
 which contains all possible restricted subprocesses with distinct
 resonance histories.  These processes will not be integrated, but
 their matrix element codes are used for determining probabilities of
 resonance histories.  Note that this can work only if the process
 method is OMega, and the phase-space method is 'wood'.
 
 When done, we assign the [[instance]] and [[process]] pointers of the
 base type by the [[connect]] method, so we can reference them later.
 
 TODO: In case of NLO event generation, copying the configuration from the
 master process is rather intransparent.  For instance, we override the process
 var list by the global var list.
 <<Simulations: entry: TBP>>=
   procedure :: init => entry_init
 <<Simulations: procedures>>=
   subroutine entry_init &
        (entry, process_id, &
        use_process, integrate, generate, update_sqme, &
        support_resonance_history, &
        local, global, n_alt)
     class(entry_t), intent(inout), target :: entry
     type(string_t), intent(in) :: process_id
     logical, intent(in) :: use_process, integrate, generate, update_sqme
     logical, intent(in) :: support_resonance_history
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     integer, intent(in), optional :: n_alt
     type(process_t), pointer :: process, master_process
     type(process_instance_t), pointer :: process_instance
     type(process_library_t), pointer :: prclib_saved
     integer :: i
     logical :: res_include_trivial
     logical :: combined_integration
     integer :: selected_mci
     selected_mci = 0
     if (debug_on) call msg_debug (D_CORE, "entry_init")
     if (debug_on) call msg_debug (D_CORE, "process_id", process_id)
     call prepare_process &
          (master_process, process_id, use_process, integrate, local, global)
     if (signal_is_pending ())  return
 
     if (associated (master_process)) then
        if (.not. master_process%has_matrix_element ()) then
           entry%has_integral = .true.
           entry%process_id = process_id
           entry%valid = .false.
           return
        end if
     else
        call entry%basic_init (local%var_list)
        entry%has_integral = .false.
        entry%process_id = process_id
        call entry%import_process_def_characteristics (local%prclib, process_id)
        entry%valid = .true.
        return
     end if
 
     call entry%basic_init (local%var_list, n_alt)
 
     entry%process_id = process_id
     if (generate .or. integrate) then
        entry%run_id = master_process%get_run_id ()
        process => master_process
     else
        call local%set_log (var_str ("?rebuild_phase_space"), &
             .false., is_known = .true.)
        call local%set_log (var_str ("?check_phs_file"), &
             .false., is_known = .true.)
        call local%set_log (var_str ("?rebuild_grids"), &
             .false., is_known = .true.)
        entry%run_id = &
             local%var_list%get_sval (var_str ("$run_id"))
        if (update_sqme) then
           call prepare_local_process (process, process_id, local)
        else
           process => master_process
        end if
     end if
 
     call entry%import_process_characteristics (process)
 
     allocate (entry%mci_sets (entry%n_mci))
     do i = 1, size (entry%mci_sets)
        call entry%mci_sets(i)%init (i, master_process)
     end do
 
     call entry%import_process_results (master_process)
     call entry%prepare_expressions (local)
 
     if (process%is_nlo_calculation ()) then
        call process%init_nlo_settings (global%var_list)
     end if
     combined_integration = local%get_lval (var_str ("?combined_nlo_integration"))
     if (.not. combined_integration &
          .and. local%get_lval (var_str ("?fixed_order_nlo_events"))) &
               selected_mci = process%extract_active_component_mci ()
     call prepare_process_instance (process_instance, process, local%model, &
          local = local)
 
     if (generate) then
        if (selected_mci > 0) then
           call process%prepare_simulation (selected_mci)
           call process_instance%init_simulation (selected_mci, entry%config%safety_factor, &
                local%get_lval (var_str ("?keep_failed_events")))
        else
           do i = 1, entry%n_mci
              call process%prepare_simulation (i)
              call process_instance%init_simulation (i, entry%config%safety_factor, &
                   local%get_lval (var_str ("?keep_failed_events")))
           end do
       end if
     end if
 
     if (support_resonance_history) then
        prclib_saved => local%prclib
        call entry%setup_resonant_subprocesses (local, process)
        if (entry%has_resonant_subprocess_set) then
           if (signal_is_pending ())  return
           call entry%compile_resonant_subprocesses (local)
           if (signal_is_pending ())  return
           call entry%prepare_resonant_subprocesses (local, global)
           if (signal_is_pending ())  return
           call entry%prepare_resonant_subprocess_instances (local)
        end if
        if (signal_is_pending ())  return
        if (associated (prclib_saved))  call local%update_prclib (prclib_saved)
     end if
 
     call entry%setup_event_transforms (process, local)
 
     call dispatch_qcd (entry%qcd, local%get_var_list_ptr (), local%os_data)
 
     call entry%connect_qcd ()
 
     select type (pcm => process_instance%pcm)
     class is (pcm_instance_nlo_t)
         select type (config => pcm%config)
         type is (pcm_nlo_t)
            if (config%settings%fixed_order_nlo) &
                 call pcm%set_fixed_order_event_mode ()
        end select
     end select
 
     if (present (global)) then
        call entry%connect (process_instance, local%model, global%process_stack)
     else
        call entry%connect (process_instance, local%model, local%process_stack)
     end if
     call entry%setup_expressions ()
 
     entry%model => process%get_model_ptr ()
 
     entry%valid = .true.
 
   end subroutine entry_init
 
 @ %def entry_init
 @
 <<Simulations: entry: TBP>>=
   procedure :: set_active_real_components => entry_set_active_real_components
 <<Simulations: procedures>>=
   subroutine entry_set_active_real_components (entry)
     class(entry_t), intent(inout) :: entry
     integer :: i_active_real
     select type (pcm => entry%instance%pcm)
     class is (pcm_instance_nlo_t)
        i_active_real = entry%instance%get_real_of_mci ()
        if (debug_on) call msg_debug2 (D_CORE, "i_active_real", i_active_real)
        if (associated (entry%evt_powheg)) then
           select type (evt => entry%evt_powheg)
           type is (evt_shower_t)
              if (entry%process%get_component_type(i_active_real) == COMP_REAL_FIN) then
                 if (debug_on) call msg_debug (D_CORE, "Disabling Powheg matching for ", i_active_real)
                 call evt%disable_powheg_matching ()
              else
                 if (debug_on) call msg_debug (D_CORE, "Enabling Powheg matching for ", i_active_real)
                 call evt%enable_powheg_matching ()
              end if
           class default
              call msg_fatal ("powheg-evt should be evt_shower_t!")
           end select
        end if
     end select
   end subroutine entry_set_active_real_components
 
 @ %def entry_set_active_real_components
 @ Part of simulation-entry initialization: set up a process object for
 local use.
 <<Simulations: procedures>>=
   subroutine prepare_local_process (process, process_id, local)
     type(process_t), pointer, intent(inout) :: process
     type(string_t), intent(in) :: process_id
     type(rt_data_t), intent(inout), target :: local
     type(integration_t) :: intg
     call intg%create_process (process_id)
     call intg%init_process (local)
     call intg%setup_process (local, verbose=.false.)
     process => intg%get_process_ptr ()
   end subroutine prepare_local_process
 
 @ %def prepare_local_process
 @ Part of simulation-entry initialization: set up a process instance
 matching the selected process object.
 
 The model that we can provide as an extra argument can modify particle
 settings (polarization) in the density matrices that will be constructed.  It
 does not affect parameters.
 <<Simulations: procedures>>=
   subroutine prepare_process_instance &
     (process_instance, process, model, local)
     type(process_instance_t), pointer, intent(inout) :: process_instance
     type(process_t), intent(inout), target :: process
     class(model_data_t), intent(in), optional :: model
     type(rt_data_t), intent(in), optional, target :: local
     allocate (process_instance)
     call process_instance%init (process)
     if (process%is_nlo_calculation ()) then
        select type (pcm => process_instance%pcm)
        type is (pcm_instance_nlo_t)
           select type (config => pcm%config)
           type is (pcm_nlo_t)
              if (.not. config%settings%combined_integration) &
                   call pcm%set_radiation_event ()
           end select
        end select
        call process%prepare_any_external_code ()
     end if
     call process_instance%setup_event_data (model)
   end subroutine prepare_process_instance
 
 @ %def prepare_process_instance
 @ Part of simulation-entry initialization: query the
 process for basic information.
 <<Simulations: entry: TBP>>=
   procedure, private :: import_process_characteristics &
        => entry_import_process_characteristics
 <<Simulations: procedures>>=
   subroutine entry_import_process_characteristics (entry, process)
     class(entry_t), intent(inout) :: entry
     type(process_t), intent(in), target :: process
     entry%library = process%get_library_name ()
     entry%n_in = process%get_n_in ()
     entry%n_mci = process%get_n_mci ()
   end subroutine entry_import_process_characteristics
 
 @ %def entry_import_process_characteristics
 @ This is the alternative form which applies if there is no process
 entry, but just a process definition which we take from the provided
 [[prclib]] definition library.
 <<Simulations: entry: TBP>>=
   procedure, private :: import_process_def_characteristics &
        => entry_import_process_def_characteristics
 <<Simulations: procedures>>=
   subroutine entry_import_process_def_characteristics (entry, prclib, id)
     class(entry_t), intent(inout) :: entry
     type(process_library_t), intent(in), target :: prclib
     type(string_t), intent(in) :: id
     entry%library = prclib%get_name ()
     entry%n_in = prclib%get_n_in (id)
   end subroutine entry_import_process_def_characteristics
 
 @ %def entry_import_process_def_characteristics
 @ Part of simulation-entry initialization: query the
 process for integration results.
 <<Simulations: entry: TBP>>=
   procedure, private :: import_process_results &
        => entry_import_process_results
 <<Simulations: procedures>>=
   subroutine entry_import_process_results (entry, process)
     class(entry_t), intent(inout) :: entry
     type(process_t), intent(in), target :: process
     if (process%has_integral ()) then
        entry%integral = process%get_integral ()
        entry%error = process%get_error ()
        call entry%set_sigma (entry%integral)
        entry%has_integral = .true.
     end if
   end subroutine entry_import_process_results
 
 @ %def entry_import_process_characteristics
 @ Part of simulation-entry initialization: create expression factory
 objects and store them.
 <<Simulations: entry: TBP>>=
   procedure, private :: prepare_expressions &
        => entry_prepare_expressions
 <<Simulations: procedures>>=
   subroutine entry_prepare_expressions (entry, local)
     class(entry_t), intent(inout) :: entry
     type(rt_data_t), intent(in), target :: local
     type(eval_tree_factory_t) :: expr_factory
     call expr_factory%init (local%pn%selection_lexpr)
     call entry%set_selection (expr_factory)
     call expr_factory%init (local%pn%reweight_expr)
     call entry%set_reweight (expr_factory)
     call expr_factory%init (local%pn%analysis_lexpr)
     call entry%set_analysis (expr_factory)
   end subroutine entry_prepare_expressions
 
 @ %def entry_prepare_expressions
 @ Initializes the list of additional NLO entries.  The routine gets the
 information about how many entries to associate from [[region_data]].
 <<Simulations: entry: TBP>>=
   procedure :: setup_additional_entries => entry_setup_additional_entries
 <<Simulations: procedures>>=
   subroutine entry_setup_additional_entries (entry)
     class(entry_t), intent(inout), target :: entry
     type(entry_t), pointer :: current_entry
     integer :: i, n_phs
     type(evt_nlo_t), pointer :: evt
     integer :: mode
     evt => null ()
     select type (pcm => entry%instance%pcm)
     class is (pcm_instance_nlo_t)
        select type (config => pcm%config)
        type is (pcm_nlo_t)
           n_phs = config%region_data%n_phs
        end select
     end select
     select type (entry)
     type is (entry_t)
        current_entry => entry
        current_entry%first => entry
        call get_nlo_evt_ptr (current_entry, evt, mode)
        if (mode > EVT_NLO_SEPARATE_BORNLIKE) then
           allocate (evt%particle_set_radiated (n_phs + 1))
           evt%event_deps%n_phs = n_phs
           evt%qcd = entry%qcd
           do i = 1, n_phs
              allocate (current_entry%next)
              current_entry%next%first => current_entry%first
              current_entry => current_entry%next
              call entry%copy_entry (current_entry)
              current_entry%i_event = i
           end do
        else
           allocate (evt%particle_set_radiated (1))
        end if
     end select
   contains
     subroutine get_nlo_evt_ptr (entry, evt, mode)
       type(entry_t), intent(in), target :: entry
       type(evt_nlo_t), intent(out), pointer :: evt
       integer, intent(out) :: mode
       class(evt_t), pointer :: current_evt
       evt => null ()
       current_evt => entry%transform_first
       do
          select type (current_evt)
          type is (evt_nlo_t)
             evt => current_evt
             mode = evt%mode
             exit
          end select
          if (associated (current_evt%next)) then
             current_evt => current_evt%next
          else
             call msg_fatal ("evt_nlo not in list of event transforms")
          end if
       end do
     end subroutine get_nlo_evt_ptr
   end subroutine entry_setup_additional_entries
 
 @ %def entry_setup_additional_entries
 @
 <<Simulations: entry: TBP>>=
   procedure :: get_first => entry_get_first
 <<Simulations: procedures>>=
   function entry_get_first (entry) result (entry_out)
     class(entry_t), intent(in), target :: entry
     type(entry_t), pointer :: entry_out
     entry_out => null ()
     select type (entry)
     type is (entry_t)
        if (entry%is_nlo ()) then
           entry_out => entry%first
        else
           entry_out => entry
        end if
     end select
   end function entry_get_first
 
 @ %def entry_get_first
 @
 <<Simulations: entry: TBP>>=
   procedure :: get_next => entry_get_next
 <<Simulations: procedures>>=
   function entry_get_next (entry) result (next_entry)
      class(entry_t), intent(in) :: entry
      type(entry_t), pointer :: next_entry
      next_entry => null ()
      if (associated (entry%next)) then
         next_entry => entry%next
      else
         call msg_fatal ("Get next entry: No next entry")
      end if
   end function entry_get_next
 
 @ %def entry_get_next
 @
 <<Simulations: entry: TBP>>=
   procedure :: count_nlo_entries => entry_count_nlo_entries
 <<Simulations: procedures>>=
   function entry_count_nlo_entries (entry) result (n)
     class(entry_t), intent(in), target :: entry
     integer :: n
     type(entry_t), pointer :: current_entry
     n = 1
     if (.not. associated (entry%next)) then
        return
     else
        current_entry => entry%next
        do
           n = n + 1
           if (.not. associated (current_entry%next)) exit
           current_entry => current_entry%next
        end do
     end if
   end function entry_count_nlo_entries
 
 @ %def entry_count_nlo_entries
 @
 <<Simulations: entry: TBP>>=
   procedure :: reset_nlo_counter => entry_reset_nlo_counter
 <<Simulations: procedures>>=
   subroutine entry_reset_nlo_counter (entry)
     class(entry_t), intent(inout) :: entry
     class(evt_t), pointer :: evt
     evt => entry%transform_first
     do
        select type (evt)
        type is (evt_nlo_t)
           evt%i_evaluation = 0
           exit
        end select
        if (associated (evt%next)) evt => evt%next
    end do
   end subroutine entry_reset_nlo_counter
 
 @ %def entry_reset_nlo_counter
 @
 <<Simulations: entry: TBP>>=
   procedure :: determine_if_powheg_matching => entry_determine_if_powheg_matching
 <<Simulations: procedures>>=
   subroutine entry_determine_if_powheg_matching (entry)
      class(entry_t), intent(inout) :: entry
      class(evt_t), pointer :: current_transform
      if (associated (entry%transform_first)) then
         current_transform => entry%transform_first
         do
            select type (current_transform)
            type is (evt_shower_t)
               if (current_transform%contains_powheg_matching ()) &
                   entry%evt_powheg => current_transform
               exit
            end select
            if (associated (current_transform%next)) then
               current_transform => current_transform%next
            else
               exit
            end if
         end do
      end if
   end subroutine entry_determine_if_powheg_matching
 
 @ %def entry_determine_if_powheg_matching
 @ Part of simulation-entry initialization: dispatch event transforms
 (decay, shower) as requested.  If a transform is not applicable or
 switched off via some variable, it will be skipped.
 
 Regarding resonances/decays: these two transforms are currently mutually
 exclusive.  Resonance insertion will not be applied if there is an
 unstable particle in the game.
 <<Simulations: entry: TBP>>=
   procedure, private :: setup_event_transforms &
        => entry_setup_event_transforms
 <<Simulations: procedures>>=
   subroutine entry_setup_event_transforms (entry, process, local)
     class(entry_t), intent(inout) :: entry
     type(process_t), intent(inout), target :: process
     type(rt_data_t), intent(in), target :: local
     class(evt_t), pointer :: evt
     type(var_list_t), pointer :: var_list
     logical :: enable_isr_handler
     logical :: enable_epa_handler
     logical :: enable_fixed_order
     logical :: enable_shower
     var_list => local%get_var_list_ptr ()
     enable_isr_handler = local%get_lval (var_str ("?isr_handler"))
     enable_epa_handler = local%get_lval (var_str ("?epa_handler"))
     if (enable_isr_handler .or. enable_epa_handler) then
        call dispatch_evt_isr_epa_handler (evt, local%var_list)
        if (associated (evt))  call entry%import_transform (evt)
     end if
     if (process%contains_unstable (local%model)) then
        call dispatch_evt_decay (evt, local%var_list)
        if (associated (evt))  call entry%import_transform (evt)
     else if (entry%resonant_subprocess_set%is_active ()) then
        call dispatch_evt_resonance (evt, local%var_list, &
             entry%resonant_subprocess_set%get_resonance_history_set (), &
             entry%resonant_subprocess_set%get_libname ())
        if (associated (evt)) then
           call entry%resonant_subprocess_set%connect_transform (evt)
           call entry%resonant_subprocess_set%set_on_shell_limit &
                (local%get_rval (var_str ("resonance_on_shell_limit")))
           call entry%resonant_subprocess_set%set_on_shell_turnoff &
                (local%get_rval (var_str ("resonance_on_shell_turnoff")))
           call entry%resonant_subprocess_set%set_background_factor &
                (local%get_rval (var_str ("resonance_background_factor")))
           call entry%import_transform (evt)
        end if
     end if
     enable_fixed_order = local%get_lval (var_str ("?fixed_order_nlo_events"))
     if (enable_fixed_order) then
        if (local%get_lval (var_str ("?unweighted"))) &
           call msg_fatal ("NLO Fixed Order events have to be generated with &
                           &?unweighted = false")
        call dispatch_evt_nlo (evt, local%get_lval (var_str ("?keep_failed_events")))
        call entry%import_transform (evt)
     end if
     enable_shower = local%get_lval (var_str ("?allow_shower")) .and. &
             (local%get_lval (var_str ("?ps_isr_active")) &
             .or. local%get_lval (var_str ("?ps_fsr_active")) &
             .or. local%get_lval (var_str ("?muli_active")) &
             .or. local%get_lval (var_str ("?mlm_matching")) &
             .or. local%get_lval (var_str ("?ckkw_matching")) &
             .or. local%get_lval (var_str ("?powheg_matching")))
     if (enable_shower) then
        call dispatch_evt_shower (evt, var_list, local%model, &
             local%fallback_model, local%os_data, local%beam_structure, &
             process)
        call entry%import_transform (evt)
     end if
     if (local%get_lval (var_str ("?hadronization_active"))) then
        call dispatch_evt_hadrons (evt, var_list, local%fallback_model)
        call entry%import_transform (evt)
     end if
   end subroutine entry_setup_event_transforms
 
 @ %def entry_setup_event_transforms
 @ Compute weights.  The integral in the argument is the sum of integrals for
 all processes in the sample.  After computing the process weights, we repeat
 the normalization procedure for the process components.
 <<Simulations: entry: TBP>>=
   procedure :: init_mci_selector => entry_init_mci_selector
 <<Simulations: procedures>>=
   subroutine entry_init_mci_selector (entry, negative_weights)
     class(entry_t), intent(inout), target :: entry
     logical, intent(in), optional :: negative_weights
     type(entry_t), pointer :: current_entry
     integer :: i, j, k
     if (debug_on) call msg_debug (D_CORE, "entry_init_mci_selector")
     if (entry%has_integral) then
        select type (entry)
        type is (entry_t)
           current_entry => entry
           do j = 1, current_entry%count_nlo_entries ()
              if (j > 1) current_entry => current_entry%get_next ()
              do k = 1, size(current_entry%mci_sets%integral)
                 if (debug_on) call msg_debug (D_CORE, "current_entry%mci_sets(k)%integral", &
                      current_entry%mci_sets(k)%integral)
              end do
              call current_entry%mci_selector%init &
                   (current_entry%mci_sets%integral, negative_weights)
              do i = 1, current_entry%n_mci
                 current_entry%mci_sets(i)%weight_mci = &
                    current_entry%mci_selector%get_weight (i)
              end do
           end do
        end select
     end if
   end subroutine entry_init_mci_selector
 
 @ %def entry_init_mci_selector
 @ Select a MCI entry, using the embedded random-number generator.
 <<Simulations: entry: TBP>>=
   procedure :: select_mci => entry_select_mci
 <<Simulations: procedures>>=
   function entry_select_mci (entry) result (i_mci)
     class(entry_t), intent(inout) :: entry
     integer :: i_mci
     if (debug_on) call msg_debug2 (D_CORE, "entry_select_mci")
     i_mci = entry%process%extract_active_component_mci ()
     if (i_mci == 0) call entry%mci_selector%generate (entry%rng, i_mci)
     if (debug_on) call msg_debug2 (D_CORE, "i_mci", i_mci)
   end function entry_select_mci
 
 @ %def entry_select_mci
 @ Record an event for this entry, i.e., increment the appropriate counters.
 <<Simulations: entry: TBP>>=
   procedure :: record => entry_record
 <<Simulations: procedures>>=
   subroutine entry_record (entry, i_mci, from_file)
     class(entry_t), intent(inout) :: entry
     integer, intent(in) :: i_mci
     logical, intent(in), optional :: from_file
     real(default) :: weight, excess
     integer :: n_dropped
     weight = entry%get_weight_prc ()
     excess = entry%get_excess_prc ()
     n_dropped = entry%get_n_dropped ()
     call entry%counter%record (weight, excess, n_dropped, from_file)
     if (i_mci > 0) then
        call entry%mci_sets(i_mci)%counter%record (weight, excess)
     end if
   end subroutine entry_record
 
 @ %def entry_record
 @ Update and restore the process core that this entry accesses, when
 parameters change.  If explicit arguments [[model]], [[qcd]], or
 [[helicity_selection]] are provided, use those.  Otherwise use the
 parameters stored in the process object.
 
 These two procedures come with a caching mechanism which guarantees
 that the current core object is saved when calling [[update_process]],
 and restored by calling [[restore_process]].  If the flag [[saved]] is
 unset, saving is skipped, and the [[restore]] procedure should not be
 called.
 <<Simulations: entry: TBP>>=
   procedure :: update_process => entry_update_process
   procedure :: restore_process => entry_restore_process
 <<Simulations: procedures>>=
   subroutine entry_update_process &
        (entry, model, qcd, helicity_selection, saved)
     class(entry_t), intent(inout) :: entry
     class(model_data_t), intent(in), optional, target :: model
     type(qcd_t), intent(in), optional :: qcd
     type(helicity_selection_t), intent(in), optional :: helicity_selection
     logical, intent(in), optional :: saved
     type(process_t), pointer :: process
     class(prc_core_t), allocatable :: core
     integer :: i, n_terms
     class(model_data_t), pointer :: model_local
     type(qcd_t) :: qcd_local
     logical :: use_saved
     if (present (model)) then
        model_local => model
     else
        model_local => entry%model
     end if
     if (present (qcd)) then
        qcd_local = qcd
     else
        qcd_local = entry%qcd
     end if
     use_saved = .true.;  if (present (saved))  use_saved = saved
     process => entry%get_process_ptr ()
     n_terms = process%get_n_terms ()
     if (use_saved)  allocate (entry%core_safe (n_terms))
     do i = 1, n_terms
        if (process%has_matrix_element (i, is_term_index = .true.)) then
           call process%extract_core (i, core)
           if (use_saved) then
              call dispatch_core_update (core, &
                   model_local, helicity_selection, qcd_local, &
                   entry%core_safe(i)%core)
           else
              call dispatch_core_update (core, &
                   model_local, helicity_selection, qcd_local)
           end if
           call process%restore_core (i, core)
        end if
     end do
   end subroutine entry_update_process
 
   subroutine entry_restore_process (entry)
     class(entry_t), intent(inout) :: entry
     type(process_t), pointer :: process
     class(prc_core_t), allocatable :: core
     integer :: i, n_terms
     process => entry%get_process_ptr ()
     n_terms = process%get_n_terms ()
     do i = 1, n_terms
        if (process%has_matrix_element (i, is_term_index = .true.)) then
           call process%extract_core (i, core)
           call dispatch_core_restore (core, entry%core_safe(i)%core)
           call process%restore_core (i, core)
        end if
     end do
     deallocate (entry%core_safe)
   end subroutine entry_restore_process
 
 @ %def entry_update_process
 @ %def entry_restore_process
 <<Simulations: entry: TBP>>=
   procedure :: connect_qcd => entry_connect_qcd
 <<Simulations: procedures>>=
   subroutine entry_connect_qcd (entry)
     class(entry_t), intent(inout), target :: entry
     class(evt_t), pointer :: evt
     evt => entry%transform_first
     do while (associated (evt))
        select type (evt)
        type is (evt_shower_t)
           evt%qcd = entry%qcd
           if (allocated (evt%matching)) then
              evt%matching%qcd = entry%qcd
           end if
        end select
        evt => evt%next
     end do
   end subroutine entry_connect_qcd
 
 @ %def entry_connect_qcd
 @
 \subsection{Handling resonant subprocesses}
 Resonant subprocesses are required if we want to determine resonance histories
 when generating events.  The feature is optional, to be switched on by
 the user.
 
 This procedure initializes a new, separate process library that
 contains copies of the current process, restricted to the relevant
 resonance histories.  (If this library exists already, it is just
 kept.)  The histories can be extracted from the process object.
 
 The code has to match the assignments in
 [[create_resonant_subprocess_library]].  The library may already
 exist -- in that case, here it will be recovered without recompilation.
 <<Simulations: entry: TBP>>=
   procedure :: setup_resonant_subprocesses &
        => entry_setup_resonant_subprocesses
 <<Simulations: procedures>>=
   subroutine entry_setup_resonant_subprocesses (entry, global, process)
     class(entry_t), intent(inout) :: entry
     type(rt_data_t), intent(inout), target :: global
     type(process_t), intent(in), target :: process
     type(string_t) :: libname
     type(resonance_history_set_t) :: res_history_set
     type(process_library_t), pointer :: lib
     type(process_component_def_t), pointer :: process_component_def
     logical :: req_resonant, library_exist
     integer :: i_component
     libname = process%get_library_name ()
     lib => global%prclib_stack%get_library_ptr (libname)
     entry%has_resonant_subprocess_set = lib%req_resonant (process%get_id ())
     if (entry%has_resonant_subprocess_set) then
        libname = get_libname_res (process%get_id ())
        call entry%resonant_subprocess_set%init (process%get_n_components ())
        call entry%resonant_subprocess_set%create_library &
             (libname, global, library_exist)
        do i_component = 1, process%get_n_components ()
           call process%extract_resonance_history_set &
                (res_history_set, i_component = i_component)
           call entry%resonant_subprocess_set%fill_resonances &
                (res_history_set, i_component)
           if (.not. library_exist) then
              process_component_def &
                   => process%get_component_def_ptr (i_component)
              call entry%resonant_subprocess_set%add_to_library &
                   (i_component, &
                   process_component_def%get_prt_spec_in (), &
                   process_component_def%get_prt_spec_out (), &
                   global)
           end if
        end do
        call entry%resonant_subprocess_set%freeze_library (global)
     end if
   end subroutine entry_setup_resonant_subprocesses
 
 @ %def entry_setup_resonant_subprocesses
 @ Compile the resonant-subprocesses library.  The library is assumed
 to be the current library in the [[global]] object.  This is a simple wrapper.
 <<Simulations: entry: TBP>>=
   procedure :: compile_resonant_subprocesses &
        => entry_compile_resonant_subprocesses
 <<Simulations: procedures>>=
   subroutine entry_compile_resonant_subprocesses (entry, global)
     class(entry_t), intent(inout) :: entry
     type(rt_data_t), intent(inout), target :: global
     call entry%resonant_subprocess_set%compile_library (global)
   end subroutine entry_compile_resonant_subprocesses
 
 @ %def entry_compile_resonant_subprocesses
 @ Prepare process objects for the resonant-subprocesses library.  The
 process objects are appended to the global process stack.  We
 initialize the processes, such that we can evaluate matrix elements,
 but we do not need to integrate them.
 <<Simulations: entry: TBP>>=
   procedure :: prepare_resonant_subprocesses &
        => entry_prepare_resonant_subprocesses
 <<Simulations: procedures>>=
   subroutine entry_prepare_resonant_subprocesses (entry, local, global)
     class(entry_t), intent(inout) :: entry
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     call entry%resonant_subprocess_set%prepare_process_objects (local, global)
   end subroutine entry_prepare_resonant_subprocesses
 
 @ %def entry_prepare_resonant_subprocesses
 @ Prepare process instances.  They are linked to their corresponding process
 objects.  Both, process and instance objects, are allocated as anonymous
 targets inside the [[resonant_subprocess_set]] component.
 
 NOTE: those anonymous object are likely forgotten during finalization of the
 parent [[event_t]] (extended as [[entry_t]]) object.  This should be checked!
 The memory leak is probably harmless as long as the event object is created
 once per run, not once per event.
 <<Simulations: entry: TBP>>=
   procedure :: prepare_resonant_subprocess_instances &
        => entry_prepare_resonant_subprocess_instances
 <<Simulations: procedures>>=
   subroutine entry_prepare_resonant_subprocess_instances (entry, global)
     class(entry_t), intent(inout) :: entry
     type(rt_data_t), intent(in), target :: global
     call entry%resonant_subprocess_set%prepare_process_instances (global)
   end subroutine entry_prepare_resonant_subprocess_instances
 
 @ %def entry_prepare_resonant_subprocess_instances
 @ Display the resonant subprocesses.  This includes, upon request, the
 resonance set that defines those subprocess, and a short or long account of the
 process objects themselves.
 <<Simulations: entry: TBP>>=
   procedure :: write_resonant_subprocess_data &
        => entry_write_resonant_subprocess_data
 <<Simulations: procedures>>=
   subroutine entry_write_resonant_subprocess_data (entry, unit)
     class(entry_t), intent(in) :: entry
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     call entry%resonant_subprocess_set%write (unit)
     write (u, "(1x,A,I0)")  "Resonant subprocesses refer to &
             &process component #", 1
   end subroutine entry_write_resonant_subprocess_data
 
 @ %def entry_write_resonant_subprocess_data
 @ Display of the master process for the current event, for diagnostics.
 <<Simulations: entry: TBP>>=
   procedure :: write_process_data => entry_write_process_data
 <<Simulations: procedures>>=
   subroutine entry_write_process_data &
        (entry, unit, show_process, show_instance, verbose)
     class(entry_t), intent(in) :: entry
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: show_process
     logical, intent(in), optional :: show_instance
     logical, intent(in), optional :: verbose
     integer :: u, i
     logical :: s_proc, s_inst, verb
     type(process_t), pointer :: process
     type(process_instance_t), pointer :: instance
     u = given_output_unit (unit)
     s_proc = .false.;  if (present (show_process))  s_proc = show_process
     s_inst = .false.;  if (present (show_instance))  s_inst = show_instance
     verb = .false.;  if (present (verbose))  verb = verbose
     if (s_proc .or. s_inst) then
        write (u, "(1x,A,':')")  "Process data"
        if (s_proc) then
           process => entry%process
           if (associated (process)) then
              if (verb) then
                 call write_separator (u, 2)
                 call process%write (.false., u)
              else
                 call process%show (u, verbose=.false.)
              end if
           else
              write (u, "(3x,A)")  "[not associated]"
           end if
        end if
        if (s_inst) then
           instance => entry%instance
           if (associated (instance)) then
              if (verb) then
                 call instance%write (u)
              else
                 call instance%write_header (u)
              end if
           else
              write (u, "(3x,A)")  "Process instance: [not associated]"
           end if
        end if
     end if
   end subroutine entry_write_process_data
 
 @ %def entry_write_process_data
 @
 \subsection{Entries for alternative environment}
 Entries for alternate environments.  [No additional components
 anymore, so somewhat redundant.]
 <<Simulations: types>>=
   type, extends (entry_t) :: alt_entry_t
    contains
    <<Simulations: alt entry: TBP>>
   end type alt_entry_t
 
 @ %def alt_entry_t
  The alternative entries are there to re-evaluate the event, given
 momenta, in a different context.
 
 Therefore, we allocate a local process object and use this as the
 reference for the local process instance, when initializing the entry.
 We temporarily import the [[process]] object into an [[integration_t]]
 wrapper, to take advantage of the associated methods.  The local
 process object is built in the context of the current environment,
 here called [[global]].  Then, we initialize the process instance.
 
 The [[master_process]] object contains the integration results to which we
 refer when recalculating an event.  Therefore, we use this object instead of
 the locally built [[process]] when we extract the integration results.
 
 The locally built [[process]] object should be finalized when done.  It
 remains accessible via the [[event_t]] base object of [[entry]], which
 contains pointers to the process and instance.
 <<Simulations: alt entry: TBP>>=
   procedure :: init_alt => alt_entry_init
 <<Simulations: procedures>>=
   subroutine alt_entry_init (entry, process_id, master_process, local)
     class(alt_entry_t), intent(inout), target :: entry
     type(string_t), intent(in) :: process_id
     type(process_t), intent(in), target :: master_process
     type(rt_data_t), intent(inout), target :: local
     type(process_t), pointer :: process
     type(process_instance_t), pointer :: process_instance
     type(string_t) :: run_id
     integer :: i
 
     call msg_message ("Simulate: initializing alternate process setup ...")
 
     run_id = &
          local%var_list%get_sval (var_str ("$run_id"))
     call local%set_log (var_str ("?rebuild_phase_space"), &
          .false., is_known = .true.)
     call local%set_log (var_str ("?check_phs_file"), &
          .false., is_known = .true.)
     call local%set_log (var_str ("?rebuild_grids"), &
          .false., is_known = .true.)
 
     call entry%basic_init (local%var_list)
 
     call prepare_local_process (process, process_id, local)
     entry%process_id = process_id
     entry%run_id = run_id
 
     call entry%import_process_characteristics (process)
 
     allocate (entry%mci_sets (entry%n_mci))
     do i = 1, size (entry%mci_sets)
        call entry%mci_sets(i)%init (i, master_process)
     end do
 
     call entry%import_process_results (master_process)
     call entry%prepare_expressions (local)
 
     call prepare_process_instance (process_instance, process, local%model)
     call entry%setup_event_transforms (process, local)
 
     call entry%connect (process_instance, local%model, local%process_stack)
     call entry%setup_expressions ()
 
     entry%model => process%get_model_ptr ()
 
     call msg_message ("...  alternate process setup complete.")
 
   end subroutine alt_entry_init
 
 @ %def alt_entry_init
 @ Copy the particle set from the master entry to the alternate entry.
 This is the particle set of the hard process.
 <<Simulations: alt entry: TBP>>=
   procedure :: fill_particle_set => entry_fill_particle_set
 <<Simulations: procedures>>=
   subroutine entry_fill_particle_set (alt_entry, entry)
     class(alt_entry_t), intent(inout) :: alt_entry
     class(entry_t), intent(in), target :: entry
     type(particle_set_t) :: pset
     call entry%get_hard_particle_set (pset)
     call alt_entry%set_hard_particle_set (pset)
     call pset%final ()
   end subroutine entry_fill_particle_set
 
 @ %def particle_set_copy_prt
 @
 \subsection{The simulation type}
 Each simulation object corresponds to an event sample, identified by
 the [[sample_id]].
 
 The simulation may cover several processes simultaneously.  All
 process-specific data, including the event records, are stored in the
 [[entry]] subobjects.  The [[current]] index indicates which record
 was selected last. [[version]] is foreseen to contain a tag on the \whizard\
 event file version. It can be
 <<Simulations: public>>=
   public :: simulation_t
 <<Simulations: types>>=
   type :: simulation_t
      private
      type(rt_data_t), pointer :: local => null ()
      type(string_t) :: sample_id
      logical :: unweighted = .true.
      logical :: negative_weights = .false.
      logical :: support_resonance_history = .false.
      logical :: respect_selection = .true.
      integer :: norm_mode = NORM_UNDEFINED
      logical :: update_sqme = .false.
      logical :: update_weight = .false.
      logical :: update_event = .false.
      logical :: recover_beams = .false.
      logical :: pacify = .false.
      integer :: n_max_tries = 10000
      integer :: n_prc = 0
      integer :: n_alt = 0
      logical :: has_integral = .false.
      logical :: valid = .false.
      real(default) :: integral = 0
      real(default) :: error = 0
      integer :: version = 1
      character(32) :: md5sum_prc = ""
      character(32) :: md5sum_cfg = ""
      character(32), dimension(:), allocatable :: md5sum_alt
      type(entry_t), dimension(:), allocatable :: entry
      type(alt_entry_t), dimension(:,:), allocatable :: alt_entry
      type(selector_t) :: process_selector
      integer :: n_evt_requested = 0
      integer :: event_index_offset = 0
      logical :: event_index_set = .false.
      integer :: event_index = 0
      integer :: split_n_evt = 0
      integer :: split_n_kbytes = 0
      integer :: split_index = 0
      type(counter_t) :: counter
      class(rng_t), allocatable :: rng
      integer :: i_prc = 0
      integer :: i_mci = 0
      real(default) :: weight = 0
      real(default) :: excess = 0
      integer :: n_dropped = 0
    contains
    <<Simulations: simulation: TBP>>
   end type simulation_t
 
 @ %def simulation_t
 @ Output.  [[write_config]] writes just the configuration.  [[write]]
 as a method of the base type [[event_t]]
 writes the current event and process instance, depending on options.
 <<Simulations: simulation: TBP>>=
   procedure :: write => simulation_write
 <<Simulations: procedures>>=
   subroutine simulation_write (object, unit, testflag)
     class(simulation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     logical :: pacified
     integer :: u, i
     u = given_output_unit (unit)
     pacified = object%pacify;  if (present (testflag))  pacified = testflag
     call write_separator (u, 2)
     write (u, "(1x,A,A,A)")  "Event sample: '", char (object%sample_id), "'"
     write (u, "(3x,A,I0)")  "Processes    = ", object%n_prc
     if (object%n_alt > 0) then
        write (u, "(3x,A,I0)")  "Alt.wgts     = ", object%n_alt
     end if
     write (u, "(3x,A,L1)")  "Unweighted   = ", object%unweighted
     write (u, "(3x,A,A)")   "Event norm   = ", &
          char (event_normalization_string (object%norm_mode))
     write (u, "(3x,A,L1)")  "Neg. weights = ", object%negative_weights
     write (u, "(3x,A,L1)")  "Res. history = ", object%support_resonance_history
     write (u, "(3x,A,L1)")  "Respect sel. = ", object%respect_selection
     write (u, "(3x,A,L1)")  "Update sqme  = ", object%update_sqme
     write (u, "(3x,A,L1)")  "Update wgt   = ", object%update_weight
     write (u, "(3x,A,L1)")  "Update event = ", object%update_event
     write (u, "(3x,A,L1)")  "Recov. beams = ", object%recover_beams
     write (u, "(3x,A,L1)")  "Pacify       = ", object%pacify
     write (u, "(3x,A,I0)")  "Max. tries   = ", object%n_max_tries
     if (object%has_integral) then
        if (pacified) then
           write (u, "(3x,A," // FMT_15 // ")")  &
                "Integral     = ", object%integral
           write (u, "(3x,A," // FMT_15 // ")")  &
                "Error        = ", object%error
        else
           write (u, "(3x,A," // FMT_19 // ")")  &
                "Integral     = ", object%integral
           write (u, "(3x,A," // FMT_19 // ")")  &
                "Error        = ", object%error
        end if
     else
        write (u, "(3x,A)")  "Integral     = [undefined]"
     end if
     write (u, "(3x,A,L1)")  "Sim. valid   = ", object%valid
     write (u, "(3x,A,I0)")  "Ev.file ver. = ", object%version
     if (object%md5sum_prc /= "") then
        write (u, "(3x,A,A,A)")  "MD5 sum (proc)   = '", object%md5sum_prc, "'"
     end if
     if (object%md5sum_cfg /= "") then
        write (u, "(3x,A,A,A)")  "MD5 sum (config) = '", object%md5sum_cfg, "'"
     end if
     write (u, "(3x,A,I0)")  "Events requested  = ", object%n_evt_requested
     if (object%event_index_offset /= 0) then
        write (u, "(3x,A,I0)")  "Event index offset= ", object%event_index_offset
     end if
     if (object%event_index_set) then
        write (u, "(3x,A,I0)")  "Event index       = ", object%event_index
     end if
     if (object%split_n_evt > 0 .or. object%split_n_kbytes > 0) then
        write (u, "(3x,A,I0)")  "Events per file   = ", object%split_n_evt
        write (u, "(3x,A,I0)")  "KBytes per file   = ", object%split_n_kbytes
        write (u, "(3x,A,I0)")  "First file index  = ", object%split_index
     end if
     call object%counter%write (u)
     call write_separator (u)
     if (object%i_prc /= 0) then
        write (u, "(1x,A)")  "Current event:"
        write (u, "(3x,A,I0,A,A)")  "Process #", &
             object%i_prc, ": ", &
             char (object%entry(object%i_prc)%process_id)
        write (u, "(3x,A,I0)")  "MCI set #", object%i_mci
        write (u, "(3x,A," // FMT_19 // ")")  "Weight    = ", object%weight
        if (.not. vanishes (object%excess)) &
             write (u, "(3x,A," // FMT_19 // ")")  "Excess    = ", object%excess
        write (u, "(3x,A,I0)")  "Zero-weight events dropped = ", object%n_dropped
     else
        write (u, "(1x,A,I0,A,A)")  "Current event: [undefined]"
     end if
     call write_separator (u)
     if (allocated (object%rng)) then
        call object%rng%write (u)
     else
        write (u, "(3x,A)")  "Random-number generator: [undefined]"
     end if
     if (allocated (object%entry)) then
        do i = 1, size (object%entry)
           if (i == 1) then
              call write_separator (u, 2)
           else
              call write_separator (u)
           end if
           write (u, "(1x,A,I0,A)") "Process #", i, ":"
           call object%entry(i)%write_config (u, pacified)
        end do
     end if
     call write_separator (u, 2)
   end subroutine simulation_write
 
 @ %def simulation_write
 @ Write the current event record.  If an explicit index is given,
 write that event record.
 
 We implement writing to [[unit]] (event contents / debugging format)
 and writing to an [[eio]] event stream (storage). We include a [[testflag]]
 in order to suppress numerical noise in the testsuite.
 <<Simulations: simulation: TBP>>=
   generic :: write_event => write_event_unit
   procedure :: write_event_unit => simulation_write_event_unit
 <<Simulations: procedures>>=
   subroutine simulation_write_event_unit &
        (object, unit, i_prc, verbose, testflag)
     class(simulation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer, intent(in), optional :: i_prc
     logical, intent(in), optional :: testflag
     logical :: pacified
     integer :: current
     pacified = .false.;  if (present(testflag)) pacified = testflag
     pacified = pacified .or. object%pacify
     if (present (i_prc)) then
        current = i_prc
     else
        current = object%i_prc
     end if
     if (current > 0) then
        call object%entry(current)%write (unit, verbose = verbose, &
             testflag = pacified)
     else
        call msg_fatal ("Simulation: write event: no process selected")
     end if
   end subroutine simulation_write_event_unit
 
 @ %def simulation_write_event
 @ This writes one of the alternate events, if allocated.
 <<Simulations: simulation: TBP>>=
   procedure :: write_alt_event => simulation_write_alt_event
 <<Simulations: procedures>>=
   subroutine simulation_write_alt_event (object, unit, j_alt, i_prc, &
        verbose, testflag)
     class(simulation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: j_alt
     integer, intent(in), optional :: i_prc
     logical, intent(in), optional :: verbose
     logical, intent(in), optional :: testflag
     integer :: i, j
     if (present (j_alt)) then
        j = j_alt
     else
        j = 1
     end if
     if (present (i_prc)) then
        i = i_prc
     else
        i = object%i_prc
     end if
     if (i > 0) then
        if (j> 0 .and. j <= object%n_alt) then
           call object%alt_entry(i,j)%write (unit, verbose = verbose, &
                testflag = testflag)
        else
           call msg_fatal ("Simulation: write alternate event: out of range")
        end if
     else
        call msg_fatal ("Simulation: write alternate event: no process selected")
     end if
   end subroutine simulation_write_alt_event
 
 @ %def simulation_write_alt_event
 @ This writes the contents of the resonant subprocess set in the current event
 record.
 <<Simulations: simulation: TBP>>=
   procedure :: write_resonant_subprocess_data &
        => simulation_write_resonant_subprocess_data
 <<Simulations: procedures>>=
   subroutine simulation_write_resonant_subprocess_data (object, unit, i_prc)
     class(simulation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: i_prc
     integer :: i
     if (present (i_prc)) then
        i = i_prc
     else
        i = object%i_prc
     end if
     call object%entry(i)%write_resonant_subprocess_data (unit)
   end subroutine simulation_write_resonant_subprocess_data
 
 @ %def simulation_write_resonant_subprocess_data
 @ The same for the master process, as an additional debugging aid.
 <<Simulations: simulation: TBP>>=
   procedure :: write_process_data &
        => simulation_write_process_data
 <<Simulations: procedures>>=
   subroutine simulation_write_process_data &
        (object, unit, i_prc, &
        show_process, show_instance, verbose)
     class(simulation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: i_prc
     logical, intent(in), optional :: show_process
     logical, intent(in), optional :: show_instance
     logical, intent(in), optional :: verbose
     integer :: i
     if (present (i_prc)) then
        i = i_prc
     else
        i = object%i_prc
     end if
     call object%entry(i)%write_process_data &
          (unit, show_process, show_instance, verbose)
   end subroutine simulation_write_process_data
 
 @ %def simulation_write_process_data
 @ Finalizer.
 <<Simulations: simulation: TBP>>=
   procedure :: final => simulation_final
 <<Simulations: procedures>>=
   subroutine simulation_final (object)
     class(simulation_t), intent(inout) :: object
     integer :: i, j
     if (allocated (object%entry)) then
        do i = 1, size (object%entry)
           call object%entry(i)%final ()
        end do
     end if
     if (allocated (object%alt_entry)) then
        do j = 1, size (object%alt_entry, 2)
           do i = 1, size (object%alt_entry, 1)
              call object%alt_entry(i,j)%final ()
           end do
        end do
     end if
     if (allocated (object%rng))  call object%rng%final ()
   end subroutine simulation_final
 
 @ %def simulation_final
 @ Initialization.  We can deduce all data from the given list of
 process IDs and the global data set.  The process objects are taken
 from the stack.  Once the individual integrals are known, we add them (and the
 errors), to get the sample integral.
 
 If there are alternative environments, we suspend initialization for
 setting up alternative process objects, then restore the master
 process and its parameters.  The generator or rescanner can then
 switch rapidly between processes.
 
 If [[integrate]] is set, we make sure that all affected processes are
 integrated before simulation.  This is necessary if we want to actually
 generate events.  If [[integrate]] is unset, we don't need the integral
 because we just rescan existing events.  In that case, we just need compiled
 matrix elements.
 
 If [[generate]] is set, we prepare for actually generating events.  Otherwise,
 we may only read and rescan events.
 <<Simulations: simulation: TBP>>=
   procedure :: init => simulation_init
 <<Simulations: procedures>>=
   subroutine simulation_init (simulation, &
        process_id, integrate, generate, local, global, alt_env)
     class(simulation_t), intent(out), target :: simulation
     type(string_t), dimension(:), intent(in) :: process_id
     logical, intent(in) :: integrate, generate
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     type(rt_data_t), dimension(:), intent(inout), optional, target :: alt_env
     class(rng_factory_t), allocatable :: rng_factory
     integer :: next_rng_seed
     type(string_t) :: norm_string, version_string
     logical :: use_process
     integer :: i, j
     type(string_t) :: sample_suffix
   <<Simulations: simulation init: variables>>
     sample_suffix = ""
   <<Simulations: simulation init: init>>
     simulation%local => local
     simulation%sample_id = &
          local%get_sval (var_str ("$sample")) // sample_suffix
     simulation%unweighted = &
          local%get_lval (var_str ("?unweighted"))
     simulation%negative_weights = &
          local%get_lval (var_str ("?negative_weights"))
     simulation%support_resonance_history = &
          local%get_lval (var_str ("?resonance_history"))
     simulation%respect_selection = &
          local%get_lval (var_str ("?sample_select"))
     version_string = &
          local%get_sval (var_str ("$event_file_version"))
     norm_string = &
          local%get_sval (var_str ("$sample_normalization"))
     simulation%norm_mode = &
          event_normalization_mode (norm_string, simulation%unweighted)
     simulation%pacify = &
          local%get_lval (var_str ("?sample_pacify"))
     simulation%event_index_offset = &
          local%get_ival (var_str ("event_index_offset"))
     simulation%n_max_tries = &
          local%get_ival (var_str ("sample_max_tries"))
     simulation%split_n_evt = &
          local%get_ival (var_str ("sample_split_n_evt"))
     simulation%split_n_kbytes = &
          local%get_ival (var_str ("sample_split_n_kbytes"))
     simulation%split_index = &
          local%get_ival (var_str ("sample_split_index"))
     simulation%update_sqme = &
          local%get_lval (var_str ("?update_sqme"))
     simulation%update_weight = &
          local%get_lval (var_str ("?update_weight"))
     simulation%update_event = &
          local%get_lval (var_str ("?update_event"))
     simulation%recover_beams = &
          local%get_lval (var_str ("?recover_beams"))
     simulation%counter%reproduce_xsection = &
          local%get_lval (var_str ("?check_event_weights_against_xsection"))
     use_process = &
          integrate .or. generate &
          .or. simulation%update_sqme &
          .or. simulation%update_weight &
          .or. simulation%update_event &
          .or. present (alt_env)
     select case (size (process_id))
     case (0)
        call msg_error ("Simulation: no process selected")
     case (1)
        write (msg_buffer, "(A,A,A)") &
             "Starting simulation for process '", &
             char (process_id(1)), "'"
        call msg_message ()
     case default
        write (msg_buffer, "(A,A,A)") &
             "Starting simulation for processes '", &
             char (process_id(1)), "' etc."
        call msg_message ()
     end select
     select case (char (version_string))
     case ("", "2.2.4")
        simulation%version = 2
     case ("2.2")
        simulation%version = 1
     case default
        simulation%version = 0
     end select
     if (simulation%version == 0) then
        call msg_fatal ("Event file format '" &
             // char (version_string) &
             // "' is not compatible with this version.")
     end if
     simulation%n_prc = size (process_id)
     allocate (simulation%entry (simulation%n_prc))
     if (present (alt_env)) then
        simulation%n_alt = size (alt_env)
        do i = 1, simulation%n_prc
           call simulation%entry(i)%init (process_id(i), &
                use_process, integrate, generate, &
                simulation%update_sqme, &
                simulation%support_resonance_history, &
                local, global, simulation%n_alt)
           if (signal_is_pending ())  return
        end do
        simulation%valid = any (simulation%entry%valid)
        if (.not. simulation%valid) then
           call msg_error ("Simulate: no process has a valid matrix element.")
           return
        end if
        call simulation%update_processes ()
        allocate (simulation%alt_entry (simulation%n_prc, simulation%n_alt))
        allocate (simulation%md5sum_alt (simulation%n_alt))
        simulation%md5sum_alt = ""
        do j = 1, simulation%n_alt
           do i = 1, simulation%n_prc
              call simulation%alt_entry(i,j)%init_alt (process_id(i), &
                   simulation%entry(i)%get_process_ptr (), alt_env(j))
              if (signal_is_pending ())  return
           end do
        end do
        call simulation%restore_processes ()
     else
        do i = 1, simulation%n_prc
           call simulation%entry(i)%init &
                (process_id(i), &
                use_process, integrate, generate, &
                simulation%update_sqme, &
                simulation%support_resonance_history, &
                local, global)
           call simulation%entry(i)%determine_if_powheg_matching ()
           if (signal_is_pending ())  return
           if (simulation%entry(i)%is_nlo ()) &
                call simulation%entry(i)%setup_additional_entries ()
        end do
        simulation%valid = any (simulation%entry%valid)
        if (.not. simulation%valid) then
           call msg_error ("Simulate: " &
                // "no process has a valid matrix element.")
           return
        end if
     end if
 !!! if this becomes conditional, some ref files will need update (seed change)
 !    if (generate) then
        call dispatch_rng_factory (rng_factory, local%var_list, next_rng_seed)
        call update_rng_seed_in_var_list (local%var_list, next_rng_seed)
        call rng_factory%make (simulation%rng)
      <<Simulations: simulation init: rng>>
 !    end if
     if (all (simulation%entry%has_integral)) then
        simulation%integral = sum (simulation%entry%integral)
        simulation%error = sqrt (sum (simulation%entry%error ** 2))
        simulation%has_integral = .true.
        if (integrate .and. generate) then
           do i = 1, simulation%n_prc
              if (simulation%entry(i)%integral < 0 .and. .not. &
                   simulation%negative_weights) then
                 call msg_fatal ("Integral of process '" // &
                      char (process_id (i)) // "'is negative.")
              end if
           end do
        end if
     else
        if (integrate .and. generate) &
             call msg_error ("Simulation contains undefined integrals.")
     end if
     if (simulation%integral > 0 .or. &
          (simulation%integral < 0 .and. simulation%negative_weights)) then
        simulation%valid = .true.
     else if (generate) then
        call msg_error ("Simulate: " &
             // "sum of process integrals must be positive; skipping.")
        simulation%valid = .false.
     else
        simulation%valid = .true.
     end if
     if (simulation%valid)  call simulation%compute_md5sum ()
   end subroutine simulation_init
 
 @ %def simulation_init
 @
 <<MPI: Simulations: simulation init: variables>>=
   integer :: rank, n_size
 @
 <<MPI: Simulations: simulation init: init>>=
   call mpi_get_comm_id (n_size, rank)
   if (n_size > 1) then
      sample_suffix = var_str ("_") // str (rank)
   end if
 @
 <<MPI: Simulations: simulation init: rng>>=
   do i = 2, rank + 1
      select type (rng => simulation%rng)
      type is (rng_stream_t)
         call rng%next_substream ()
         if (i == rank) &
            call msg_message ("Simulate: Advance RNG for parallel event generation")
      class default
         call msg_bug ("Use of any random number generator &
                &beside rng_stream for parallel event generation not supported.")
      end select
   end do
 @
 @ The number of events that we want to simulate is determined by the
 settings of [[n_events]], [[luminosity]], and [[?unweighted]].  For
 weighted events, we take [[n_events]] at face value as the number of
 matrix element calls.  For unweighted events, if the process is a
 decay, [[n_events]] is the number of unweighted events.  In these
 cases, the luminosity setting is ignored.
 
 For unweighted events with a scattering process, we calculate the
 event number that corresponds to the luminosity, given the current
 value of the integral.  We then compare this with [[n_events]] and
 choose the larger number.
 <<Simulations: simulation: TBP>>=
   procedure :: compute_n_events => simulation_compute_n_events
 <<Simulations: procedures>>=
   subroutine simulation_compute_n_events (simulation, n_events, var_list)
     class(simulation_t), intent(in) :: simulation
     integer, intent(out) :: n_events
     type(var_list_t) :: var_list
     real(default) :: lumi, x_events_lumi
     integer :: n_events_lumi
     logical :: is_scattering
     n_events = &
          var_list%get_ival (var_str ("n_events"))
     lumi = &
          var_list%get_rval (var_str ("luminosity"))
     if (simulation%unweighted) then
        is_scattering = simulation%entry(1)%n_in == 2
        if (is_scattering) then
           x_events_lumi = abs (simulation%integral * lumi)
           if (x_events_lumi < huge (n_events)) then
              n_events_lumi = nint (x_events_lumi)
           else
              call msg_message ("Simulation: luminosity too large, &
                   &limiting number of events")
              n_events_lumi = huge (n_events)
           end if
           if (n_events_lumi > n_events) then
              call msg_message ("Simulation: using n_events as computed from &
                   &luminosity value")
              n_events = n_events_lumi
           else
              write (msg_buffer, "(A,1x,I0)") &
                   "Simulation: requested number of events =", n_events
              call msg_message ()
              if (.not. vanishes (simulation%integral)) then
                 write (msg_buffer, "(A,1x,ES11.4)") &
                      "            corr. to luminosity [fb-1] = ", &
                      n_events / simulation%integral
                 call msg_message ()
              end if
           end if
        end if
     end if
   end subroutine simulation_compute_n_events
 
 @ %def simulation_compute_n_events
 @ Write the actual efficiency of the simulation run.  We get the total
 number of events stored in the simulation counter and compare this
 with the total number of calls stored in the event entries.
 
 In order not to miscount samples that are partly read from file, use
 the [[generated]] counter, not the [[total]] counter.
 <<Simulations: simulation: TBP>>=
   procedure :: show_efficiency => simulation_show_efficiency
 <<Simulations: procedures>>=
   subroutine simulation_show_efficiency (simulation)
     class(simulation_t), intent(inout) :: simulation
     integer :: n_events, n_calls
     real(default) :: eff
     n_events = simulation%counter%generated
     n_calls = sum (simulation%entry%get_actual_calls_total ())
     if (n_calls > 0) then
        eff = real (n_events, kind=default) / n_calls
        write (msg_buffer, "(A,1x,F6.2,1x,A)") &
             "Events: actual unweighting efficiency =", 100 * eff, "%"
        call msg_message ()
     end if
   end subroutine simulation_show_efficiency
 
 @ %def simulation_show_efficiency
 @
 <<Simulations: simulation: TBP>>=
   procedure :: get_n_nlo_entries => simulation_get_n_nlo_entries
 <<Simulations: procedures>>=
   function simulation_get_n_nlo_entries (simulation, i_prc) result (n_extra)
     class(simulation_t), intent(in) :: simulation
     integer, intent(in) :: i_prc
     integer :: n_extra
     n_extra = simulation%entry(i_prc)%count_nlo_entries ()
   end function simulation_get_n_nlo_entries
 
 @ %def simulation_get_n_nlo_entries
 @ Compute the checksum of the process set.  We retrieve the MD5 sums
 of all processes.  This depends only on the process definitions, while
 parameters are not considered.  The configuration checksum is
 retrieved from the MCI records in the process objects and furthermore
 includes beams, parameters, integration results, etc., so matching the
 latter should guarantee identical physics.
 <<Simulations: simulation: TBP>>=
   procedure :: compute_md5sum => simulation_compute_md5sum
 <<Simulations: procedures>>=
   subroutine simulation_compute_md5sum (simulation)
     class(simulation_t), intent(inout) :: simulation
     type(process_t), pointer :: process
     type(string_t) :: buffer
     integer :: j, i, n_mci, i_mci, n_component, i_component
     if (simulation%md5sum_prc == "") then
        buffer = ""
        do i = 1, simulation%n_prc
           if (.not. simulation%entry(i)%valid) cycle
           process => simulation%entry(i)%get_process_ptr ()
           if (associated (process)) then
              n_component = process%get_n_components ()
              do i_component = 1, n_component
                 if (process%has_matrix_element (i_component)) then
                    buffer = buffer // process%get_md5sum_prc (i_component)
                 end if
              end do
           end if
        end do
        simulation%md5sum_prc = md5sum (char (buffer))
     end if
     if (simulation%md5sum_cfg == "") then
        buffer = ""
        do i = 1, simulation%n_prc
           if (.not. simulation%entry(i)%valid) cycle
           process => simulation%entry(i)%get_process_ptr ()
           if (associated (process)) then
              n_mci = process%get_n_mci ()
              do i_mci = 1, n_mci
                 buffer = buffer // process%get_md5sum_mci (i_mci)
              end do
           end if
        end do
        simulation%md5sum_cfg = md5sum (char (buffer))
     end if
     do j = 1, simulation%n_alt
        if (simulation%md5sum_alt(j) == "") then
           buffer = ""
           do i = 1, simulation%n_prc
              process => simulation%alt_entry(i,j)%get_process_ptr ()
              if (associated (process)) then
                 buffer = buffer // process%get_md5sum_cfg ()
              end if
           end do
           simulation%md5sum_alt(j) = md5sum (char (buffer))
        end if
     end do
   end subroutine simulation_compute_md5sum
 
 @ %def simulation_compute_md5sum
 @ Initialize the process selector, using the entry integrals as process
 weights.
 <<Simulations: simulation: TBP>>=
   procedure :: init_process_selector => simulation_init_process_selector
 <<Simulations: procedures>>=
   subroutine simulation_init_process_selector (simulation)
     class(simulation_t), intent(inout) :: simulation
     integer :: i
     if (simulation%has_integral) then
        call simulation%process_selector%init (simulation%entry%integral, &
             negative_weights = simulation%negative_weights)
        do i = 1, simulation%n_prc
           associate (entry => simulation%entry(i))
             if (.not. entry%valid) then
                call msg_warning ("Process '" // char (entry%process_id) // &
                     "': matrix element vanishes, no events can be generated.")
                cycle
             end if
             call entry%init_mci_selector (simulation%negative_weights)
             entry%process_weight = simulation%process_selector%get_weight (i)
           end associate
        end do
     end if
   end subroutine simulation_init_process_selector
 
 @ %def simulation_init_process_selector
 @ Select a process, using the random-number generator.
 <<Simulations: simulation: TBP>>=
   procedure :: select_prc => simulation_select_prc
 <<Simulations: procedures>>=
   function simulation_select_prc (simulation) result (i_prc)
     class(simulation_t), intent(inout) :: simulation
     integer :: i_prc
     call simulation%process_selector%generate (simulation%rng, i_prc)
   end function simulation_select_prc
 
 @ %def simulation_select_prc
 @ Select a MCI set for the selected process.
 <<Simulations: simulation: TBP>>=
   procedure :: select_mci => simulation_select_mci
 <<Simulations: procedures>>=
   function simulation_select_mci (simulation) result (i_mci)
     class(simulation_t), intent(inout) :: simulation
     integer :: i_mci
     i_mci = 0
     if (simulation%i_prc /= 0) then
        i_mci = simulation%entry(simulation%i_prc)%select_mci ()
     end if
   end function simulation_select_mci
 
 @ %def simulation_select_mci
 <<Simulations: simulation: TBP>>=
   procedure, private :: startup_message_generate => simulation_startup_message_generate
 <<Simulations: procedures>>=
   subroutine simulation_startup_message_generate (simulation, &
      has_input, is_weighted, is_polarized, is_leading_order, n_events)
     class(simulation_t), intent(in) :: simulation
     logical, intent(in) :: has_input
     logical, intent(in) :: is_weighted
     logical, intent(in) :: is_polarized
     logical, intent(in) :: is_leading_order
     integer, intent(in) :: n_events
     type(string_t) :: str1, str2, str3, str4
     if (has_input) then
        str1 = "Events: reading"
     else
        str1 = "Events: generating"
     end if
     if (is_weighted) then
        str2 = "weighted"
     else
        str2 = "unweighted"
     end if
     if (is_polarized) then
        str3 = ", polarized"
     else
        str3 = ", unpolarized"
     end if
     str4 = ""
     if (.not. is_leading_order) str4 = " NLO"
     write (msg_buffer, "(A,1X,I0,1X,A,1X,A)")  char (str1), n_events, &
             char (str2) // char(str3) // char(str4), "events ..."
     call msg_message ()
     write (msg_buffer, "(A,1x,A)") "Events: event normalization mode", &
          char (event_normalization_string (simulation%norm_mode))
     call msg_message ()
   end subroutine simulation_startup_message_generate
 
 @ Generate a predefined number of events.  First select a process and
 a component set, then generate an event for that process and factorize
 the quantum state.  The pair of random numbers can be used for
 factorization.
 
 When generating events, we drop all configurations where the event is
 marked as incomplete.  This happens if the event fails cuts.  In fact,
 such events are dropped already by the sampler if unweighting is in
 effect, so this can happen only for weighted events.  By setting a
 limit given by [[sample_max_tries]] (user parameter), we can avoid an
 endless loop.
 
 NB: When reading from file, event transforms can't be applied because the
 process instance will not be complete.  This should be fixed.
 <<Simulations: simulation: TBP>>=
   procedure :: generate => simulation_generate
 <<Simulations: procedures>>=
   subroutine simulation_generate (simulation, n, es_array)
     class(simulation_t), intent(inout), target :: simulation
     integer, intent(in) :: n
     type(event_stream_array_t), intent(inout), optional :: es_array
     logical :: generate_new, passed
     integer :: i, j, k, begin_it, end_it
     type(entry_t), pointer :: current_entry
     integer :: n_events_print
     logical :: has_input, is_leading_order
     has_input = .false.; if (present (es_array)) has_input = es_array%has_input ()
     n_events_print = n * simulation%get_n_nlo_entries (1)
     is_leading_order = (n_events_print == n)
     call simulation%startup_message_generate ( &
          has_input = has_input, &
          is_weighted = .not. simulation%entry(1)%config%unweighted, &
          is_polarized = .not. (simulation%entry(1)%config%factorization_mode &
             == FM_IGNORE_HELICITY), &
          is_leading_order = is_leading_order, &
          n_events = n_events_print)
     simulation%n_evt_requested = n
     call simulation%entry%set_n (n)
     if (simulation%n_alt > 0)  call simulation%alt_entry%set_n (n)
     call simulation%init_event_index ()
     begin_it = 1; end_it = n
   <<Simulations: simulation generate: init>>
     do i = begin_it, end_it
        call simulation%increment_event_index ()
        if (present (es_array)) then
           call simulation%read_event (es_array, .true., generate_new)
        else
           generate_new = .true.
        end if
        if (generate_new) then
           simulation%i_prc = simulation%select_prc ()
           simulation%i_mci = simulation%select_mci ()
           associate (entry => simulation%entry(simulation%i_prc))
             entry%instance%i_mci = simulation%i_mci
             call entry%set_active_real_components ()
             current_entry => entry%get_first ()
             do k = 1, current_entry%count_nlo_entries ()
                if (k > 1) then
                   current_entry => current_entry%get_next ()
                   current_entry%particle_set => current_entry%first%particle_set
                   current_entry%particle_set_is_valid &
                      = current_entry%first%particle_set_is_valid
                end if
                do j = 1, simulation%n_max_tries
                   if (.not. current_entry%valid)  call msg_warning &
                           ("Process '" // char (current_entry%process_id) // "': " // &
                           "matrix element vanishes, no events can be generated.")
                   call current_entry%generate (simulation%i_mci, i_nlo = k)
                   if (signal_is_pending ()) return
                   call simulation%counter%record_mean_and_variance &
                        (current_entry%weight_prc, k)
                   if (current_entry%has_valid_particle_set ()) exit
                end do
             end do
             if (entry%is_nlo ()) call entry%reset_nlo_counter ()
             if (.not. entry%has_valid_particle_set ()) then
                write (msg_buffer, "(A,I0,A)")  "Simulation: failed to &
                     &generate valid event after ", &
                     simulation%n_max_tries, " tries (sample_max_tries)"
                call msg_fatal ()
             end if
             current_entry => entry%get_first ()
             do k = 1, current_entry%count_nlo_entries ()
                if (k > 1) current_entry => current_entry%get_next ()
                call current_entry%set_index (simulation%get_event_index ())
                call current_entry%evaluate_expressions ()
             end do
             if (signal_is_pending ()) return
             simulation%n_dropped = entry%get_n_dropped ()
             if (entry%passed_selection ()) then
                simulation%weight = entry%get_weight_ref ()
                simulation%excess = entry%get_excess_prc ()
             end if
             call simulation%counter%record &
                  (simulation%weight, simulation%excess, simulation%n_dropped)
             call entry%record (simulation%i_mci)
           end associate
        else
           associate (entry => simulation%entry(simulation%i_prc))
             call simulation%set_event_index (entry%get_index ())
             call entry%accept_sqme_ref ()
             call entry%accept_weight_ref ()
             call entry%check ()
             call entry%evaluate_expressions ()
             if (signal_is_pending ()) return
             simulation%n_dropped = entry%get_n_dropped ()
             if (entry%passed_selection ()) then
                simulation%weight = entry%get_weight_ref ()
                simulation%excess = entry%get_excess_prc ()
             end if
             call simulation%counter%record &
                  (simulation%weight, simulation%excess, simulation%n_dropped, from_file=.true.)
             call entry%record (simulation%i_mci, from_file=.true.)
           end associate
        end if
        call simulation%calculate_alt_entries ()
        if (signal_is_pending ()) return
        if (simulation%pacify)  call pacify (simulation)
        if (simulation%respect_selection) then
           passed = simulation%entry(simulation%i_prc)%passed_selection ()
        else
           passed = .true.
        end if
        if (present (es_array)) then
           call simulation%write_event (es_array, passed)
        end if
     end do
     call msg_message ("        ... event sample complete.")
   <<Simulations: simulation generate: finalize>>
     if (simulation%unweighted)  call simulation%show_efficiency ()
     call simulation%counter%show_excess ()
     call simulation%counter%show_dropped ()
     call simulation%counter%show_mean_and_variance ()
   end subroutine simulation_generate
 
 @ %def simulation_generate
 @
 <<Simulations: simulation generate: init>>=
 @
 <<MPI: Simulations: simulation generate: init>>=
   call simulation%init_event_loop (n, begin_it, end_it)
 @
 <<Simulations: simulation generate: finalize>>=
 @
 <<MPI: Simulations: simulation generate: finalize>>=
   call simulation%finalize_event_loop (n, begin_it, end_it)
 @ We iterate over [[1:n]].
 However, for the MPI event generation this interval is split up into intervals of [[n_workers]].
 <<MPI: Simulations: simulation: TBP>>=
   procedure, private :: init_event_loop => simulation_init_event_loop
 <<MPI: Simulations: procedures>>=
   subroutine simulation_init_event_loop (simulation, n_events, begin_it, end_it)
     class(simulation_t), intent(inout) :: simulation
     integer, intent(in) :: n_events
     integer, intent(out) :: begin_it, end_it
     integer :: rank, n_workers
     call MPI_COMM_SIZE (MPI_COMM_WORLD, n_workers)
     if (n_workers < 2) then
        begin_it = 1; end_it = n_events
        return
     end if
     call MPI_COMM_RANK (MPI_COMM_WORLD, rank)
     if (rank == 0) then
        call compute_and_scatter_intervals (n_events, begin_it, end_it)
     else
        call retrieve_intervals (begin_it, end_it)
     end if
     !! Event index starts by 0 (before incrementing when the first event gets generated/read in).
     !! Proof: event_index_offset in [0, N], start_it in [1, N].
     simulation%event_index_offset = simulation%event_index_offset + (begin_it - 1)
     call simulation%init_event_index ()
     write (msg_buffer, "(A,I0,A,I0,A)") &
           & "MPI: generate events [", begin_it, ":", end_it, "]"
     call msg_message ()
    contains
     subroutine compute_and_scatter_intervals (n_events, begin_it, end_it)
       integer, intent(in) :: n_events
       integer, intent(out) :: begin_it, end_it
       integer, dimension(:), allocatable :: all_begin_it, all_end_it
       integer :: rank, n_workers, n_events_per_worker
       call MPI_COMM_RANK (MPI_COMM_WORLD, rank)
       call MPI_COMM_SIZE (MPI_COMM_WORLD, n_workers)
       allocate (all_begin_it (n_workers), source = 1)
       allocate (all_end_it (n_workers), source = n_events)
       n_events_per_worker = floor (real (n_events, default) / n_workers)
       all_begin_it = [(1 + rank * n_events_per_worker, rank = 0, n_workers - 1)]
       all_end_it = [(rank * n_events_per_worker, rank = 1, n_workers)]
       all_end_it(n_workers) = n_events
       call MPI_SCATTER (all_begin_it, 1, MPI_INTEGER, begin_it, 1, MPI_INTEGER, 0, MPI_COMM_WORLD)
       call MPI_SCATTER (all_end_it, 1, MPI_INTEGER, end_it, 1, MPI_INTEGER, 0, MPI_COMM_WORLD)
     end subroutine compute_and_scatter_intervals
 
     subroutine retrieve_intervals (begin_it, end_it)
       integer, intent(out) :: begin_it, end_it
       integer :: local_begin_it, local_end_it
       call MPI_SCATTER (local_begin_it, 1, MPI_INTEGER, begin_it, 1, MPI_INTEGER, 0, MPI_COMM_WORLD)
       call MPI_SCATTER (local_end_it, 1, MPI_INTEGER, end_it, 1, MPI_INTEGER, 0, MPI_COMM_WORLD)
     end subroutine retrieve_intervals
   end subroutine simulation_init_event_loop
 
 @
 <<MPI: Simulations: simulation: TBP>>=
   procedure, private :: finalize_event_loop => simulation_finalize_event_loop
 <<MPI: Simulations: procedures>>=
   subroutine simulation_finalize_event_loop (simulation, n_events, begin_it, end_it)
      class(simulation_t), intent(inout) :: simulation
      integer, intent(in) :: n_events
      integer, intent(in) :: begin_it, end_it
      integer :: n_workers, n_events_local, n_events_global
      call MPI_Barrier (MPI_COMM_WORLD)
      call MPI_COMM_SIZE (MPI_COMM_WORLD, n_workers)
      if (n_workers < 2) return
      n_events_local = end_it - begin_it + 1
      call MPI_ALLREDUCE (n_events_local, n_events_global, 1, MPI_INTEGER, MPI_SUM,&
           & MPI_COMM_WORLD)
      write (msg_buffer, "(2(A,1X,I0))") &
           "MPI: Number of generated events locally", n_events_local, " and in world", n_events_global
      call msg_message ()
      call simulation%counter%allreduce_record ()
   end subroutine simulation_finalize_event_loop
 
 @
 @ Compute the event matrix element and weight for all alternative
 environments, given the current event and selected process.  We first
 copy the particle set, then temporarily update the process core with
 local parameters, recalculate everything, and restore the process
 core.
 
 The event weight is obtained by rescaling the original event weight with the
 ratio of the new and old [[sqme]] values.  (In particular, if the old
 value was zero, the weight will stay zero.)
 
 Note: this may turn out to be inefficient because we always replace
 all parameters and recalculate everything, once for each event and
 environment.  However, a more fine-grained control requires more
 code.  In any case, while we may keep multiple process cores (which
 stay constant for a simulation run), we still have to update the
 external matrix element parameters event by event.  The matrix element
 ``object'' is present only once.
 <<Simulations: simulation: TBP>>=
   procedure :: calculate_alt_entries => simulation_calculate_alt_entries
 <<Simulations: procedures>>=
   subroutine simulation_calculate_alt_entries (simulation)
     class(simulation_t), intent(inout) :: simulation
     real(default) :: factor
     real(default), dimension(:), allocatable :: sqme_alt, weight_alt
     integer :: n_alt, i, j
     i = simulation%i_prc
     n_alt = simulation%n_alt
     if (n_alt == 0)  return
     allocate (sqme_alt (n_alt), weight_alt (n_alt))
     associate (entry => simulation%entry(i))
       do j = 1, n_alt
          if (signal_is_pending ())  return
          factor = entry%get_kinematical_weight ()
          associate (alt_entry => simulation%alt_entry(i,j))
            call alt_entry%update_process (saved=.false.)
            call alt_entry%select &
                 (entry%get_i_mci (), entry%get_i_term (), entry%get_channel ())
            call alt_entry%fill_particle_set (entry)
            call alt_entry%recalculate &
                 (update_sqme = .true., weight_factor = factor)
            if (signal_is_pending ())  return
            call alt_entry%accept_sqme_prc ()
            call alt_entry%update_normalization ()
            call alt_entry%accept_weight_prc ()
            call alt_entry%check ()
            call alt_entry%set_index (simulation%get_event_index ())
            call alt_entry%evaluate_expressions ()
            if (signal_is_pending ())  return
            sqme_alt(j) = alt_entry%get_sqme_ref ()
            if (alt_entry%passed_selection ()) then
               weight_alt(j) = alt_entry%get_weight_ref ()
            end if
          end associate
       end do
       call entry%update_process (saved=.false.)
       call entry%set (sqme_alt = sqme_alt, weight_alt = weight_alt)
       call entry%check ()
       call entry%store_alt_values ()
     end associate
   end subroutine simulation_calculate_alt_entries
 
 @ %def simulation_calculate_alt_entries
 @ Rescan an undefined number of events.
 
 If [[update_event]] or [[update_sqme]] is set, we have to recalculate the
 event, starting from the particle set.  If the latter is set, this includes
 the squared matrix element (i.e., the amplitude is evaluated).  Otherwise,
 only kinematics and observables derived from it are recovered.
 
 If any of the update flags is set, we will come up with separate
 [[sqme_prc]] and [[weight_prc]] values.  (The latter is only distinct
 if [[update_weight]] is set.)  Otherwise, we accept the reference values.
 <<Simulations: simulation: TBP>>=
   procedure :: rescan => simulation_rescan
 <<Simulations: procedures>>=
   subroutine simulation_rescan (simulation, n, es_array, global)
     class(simulation_t), intent(inout) :: simulation
     integer, intent(in) :: n
     type(event_stream_array_t), intent(inout) :: es_array
     type(rt_data_t), intent(inout) :: global
     type(qcd_t) :: qcd
     type(string_t) :: str1, str2, str3
     logical :: complete
     str1 = "Rescanning"
     if (simulation%entry(1)%config%unweighted) then
        str2 = "unweighted"
     else
        str2 = "weighted"
     end if
     simulation%n_evt_requested = n
     call simulation%entry%set_n (n)
     if (simulation%update_sqme .or. simulation%update_weight) then
        call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
        call simulation%update_processes &
             (global%model, qcd, global%get_helicity_selection ())
        str3 = "(process parameters updated) "
     else
        str3 = ""
     end if
     write (msg_buffer, "(A,1x,A,1x,A,A,A)")  char (str1), char (str2), &
          "events ", char (str3), "..."
     call msg_message ()
     call simulation%init_event_index ()
     do
        call simulation%increment_event_index ()
        call simulation%read_event (es_array, .false., complete)
        if (complete)  exit
        if (simulation%update_event &
             .or. simulation%update_sqme &
             .or. simulation%update_weight) then
           call simulation%recalculate ()
           if (signal_is_pending ())  return
           associate (entry => simulation%entry(simulation%i_prc))
             call entry%update_normalization ()
             if (simulation%update_event) then
                call entry%evaluate_transforms ()
             end if
             call entry%check ()
             call entry%evaluate_expressions ()
             if (signal_is_pending ())  return
             simulation%n_dropped = entry%get_n_dropped ()
             simulation%weight = entry%get_weight_prc ()
             call simulation%counter%record &
                  (simulation%weight, n_dropped=simulation%n_dropped, from_file=.true.)
             call entry%record (simulation%i_mci, from_file=.true.)
           end associate
        else
           associate (entry => simulation%entry(simulation%i_prc))
             call entry%accept_sqme_ref ()
             call entry%accept_weight_ref ()
             call entry%check ()
             call entry%evaluate_expressions ()
             if (signal_is_pending ())  return
             simulation%n_dropped = entry%get_n_dropped ()
             simulation%weight = entry%get_weight_ref ()
             call simulation%counter%record &
                  (simulation%weight, n_dropped=simulation%n_dropped, from_file=.true.)
             call entry%record (simulation%i_mci, from_file=.true.)
           end associate
        end if
        call simulation%calculate_alt_entries ()
        if (signal_is_pending ())  return
        call simulation%write_event (es_array)
     end do
     call simulation%counter%show_dropped ()
     if (simulation%update_sqme .or. simulation%update_weight) then
        call simulation%restore_processes ()
     end if
   end subroutine simulation_rescan
 
 @ %def simulation_rescan
 @ Here we handle the event index that is kept in the simulation record.  The
 event index is valid for the current sample.  When generating or reading
 events, we initialize the index with the offset that the user provides (if any)
 and increment it for each event that is generated or read from file.  The event
 index is stored in the event-entry that is current for the event.  If an
 event on file comes with its own index, that index overwrites the predefined
 one and also resets the index within the simulation record.
 
 The event index is not connected to the [[counter]] object.  The counter is
 supposed to collect statistical information.  The event index is a user-level
 object that is visible in event records and analysis expressions.
 <<Simulations: simulation: TBP>>=
   procedure :: init_event_index => simulation_init_event_index
   procedure :: increment_event_index => simulation_increment_event_index
   procedure :: set_event_index => simulation_set_event_index
   procedure :: get_event_index => simulation_get_event_index
 <<Simulations: procedures>>=
   subroutine simulation_init_event_index (simulation)
     class(simulation_t), intent(inout) :: simulation
     call simulation%set_event_index (simulation%event_index_offset)
   end subroutine simulation_init_event_index
 
   subroutine simulation_increment_event_index (simulation)
     class(simulation_t), intent(inout) :: simulation
     if (simulation%event_index_set) then
        simulation%event_index = simulation%event_index + 1
     end if
   end subroutine simulation_increment_event_index
 
   subroutine simulation_set_event_index (simulation, i)
     class(simulation_t), intent(inout) :: simulation
     integer, intent(in) :: i
     simulation%event_index = i
     simulation%event_index_set = .true.
   end subroutine simulation_set_event_index
 
   function simulation_get_event_index (simulation) result (i)
     class(simulation_t), intent(in) :: simulation
     integer :: i
     if (simulation%event_index_set) then
        i = simulation%event_index
     else
        i = 0
     end if
   end function simulation_get_event_index
 
 @ %def simulation_init_event_index
 @ %def simulation_increment_event_index
 @ %def simulation_set_event_index
 @ %def simulation_get_event_index
 @
 @ These routines take care of temporary parameter redefinitions that
 we want to take effect while recalculating the matrix elements.  We
 extract the core(s) of the processes that we are simulating, apply the
 changes, and make sure that the changes are actually used.  This is
 the duty of [[dispatch_core_update]].  When done, we restore the
 original versions using [[dispatch_core_restore]].
 <<Simulations: simulation: TBP>>=
   procedure :: update_processes => simulation_update_processes
   procedure :: restore_processes => simulation_restore_processes
 <<Simulations: procedures>>=
   subroutine simulation_update_processes (simulation, &
        model, qcd, helicity_selection)
     class(simulation_t), intent(inout) :: simulation
     class(model_data_t), intent(in), optional, target :: model
     type(qcd_t), intent(in), optional :: qcd
     type(helicity_selection_t), intent(in), optional :: helicity_selection
     integer :: i
     do i = 1, simulation%n_prc
        call simulation%entry(i)%update_process &
             (model, qcd, helicity_selection)
     end do
   end subroutine simulation_update_processes
 
   subroutine simulation_restore_processes (simulation)
     class(simulation_t), intent(inout) :: simulation
     integer :: i
     do i = 1, simulation%n_prc
        call simulation%entry(i)%restore_process ()
     end do
   end subroutine simulation_restore_processes
 
 @ %def simulation_update_processes
 @ %def simulation_restore_processes
 @
 \subsection{Event Stream I/O}
 Write an event to a generic [[eio]] event stream.  The process index
 must be selected, or the current index must be available.
 <<Simulations: simulation: TBP>>=
   generic :: write_event => write_event_eio
   procedure :: write_event_eio => simulation_write_event_eio
 <<Simulations: procedures>>=
   subroutine simulation_write_event_eio (object, eio, i_prc)
     class(simulation_t), intent(in) :: object
     class(eio_t), intent(inout) :: eio
     integer, intent(in), optional :: i_prc
     logical :: increased
     integer :: current
     if (present (i_prc)) then
        current = i_prc
     else
        current = object%i_prc
     end if
     if (current > 0) then
        if (object%split_n_evt > 0 .and. object%counter%total > 1) then
           if (mod (object%counter%total, object%split_n_evt) == 1) then
              call eio%split_out ()
           end if
        else if (object%split_n_kbytes > 0) then
           call eio%update_split_count (increased)
           if (increased)  call eio%split_out ()
        end if
        call eio%output (object%entry(current)%event_t, current, pacify = object%pacify)
     else
        call msg_fatal ("Simulation: write event: no process selected")
     end if
   end subroutine simulation_write_event_eio
 
 @ %def simulation_write_event
 @
 Read an event from a generic [[eio]] event stream.  The event stream element
 must specify the process within the sample ([[i_prc]]), the MC group for this
 process ([[i_mci]]), the selected term ([[i_term]]), the selected MC
 integration [[channel]], and the particle set of the event.
 
 We may encounter EOF, which we indicate by storing 0 for the process index
 [[i_prc]].  An I/O error will be reported, and we also abort reading.
 <<Simulations: simulation: TBP>>=
   generic :: read_event => read_event_eio
   procedure :: read_event_eio => simulation_read_event_eio
 <<Simulations: procedures>>=
   subroutine simulation_read_event_eio (object, eio)
     class(simulation_t), intent(inout) :: object
     class(eio_t), intent(inout) :: eio
     integer :: iostat, current
     call eio%input_i_prc (current, iostat)
     select case (iostat)
     case (0)
        object%i_prc = current
        call eio%input_event (object%entry(current)%event_t, iostat)
     end select
     select case (iostat)
     case (:-1)
        object%i_prc = 0
        object%i_mci = 0
     case (1:)
        call msg_error ("Reading events: I/O error, aborting read")
        object%i_prc = 0
        object%i_mci = 0
     case default
        object%i_mci = object%entry(current)%get_i_mci ()
     end select
   end subroutine simulation_read_event_eio
 
 @ %def simulation_read_event
 @
 \subsection{Event Stream Array}
 Write an event using an array of event I/O streams.
 The process index must be selected, or the current index must be
 available.
 <<Simulations: simulation: TBP>>=
   generic :: write_event => write_event_es_array
   procedure :: write_event_es_array => simulation_write_event_es_array
 <<Simulations: procedures>>=
   subroutine simulation_write_event_es_array (object, es_array, passed)
     class(simulation_t), intent(in), target :: object
     class(event_stream_array_t), intent(inout) :: es_array
     logical, intent(in), optional :: passed
     integer :: i_prc, event_index
     integer :: i
     type(entry_t), pointer :: current_entry
     i_prc = object%i_prc
     if (i_prc > 0) then
        event_index = object%counter%total
        current_entry => object%entry(i_prc)%get_first ()
        do i = 1, current_entry%count_nlo_entries ()
           if (i > 1) current_entry => current_entry%get_next ()
           call es_array%output (current_entry%event_t, i_prc, &
              event_index, passed = passed, pacify = object%pacify)
        end do
     else
        call msg_fatal ("Simulation: write event: no process selected")
     end if
   end subroutine simulation_write_event_es_array
 
 @ %def simulation_write_event
 @ Read an event using an array of event I/O streams.  Reading is
 successful if there is an input stream within the array, and if a
 valid event can be read from that stream.  If there is a stream, but
 EOF is passed when reading the first item, we switch the channel to
 output and return failure but no error message, such that new events
 can be appended to that stream.
 <<Simulations: simulation: TBP>>=
   generic :: read_event => read_event_es_array
   procedure :: read_event_es_array => simulation_read_event_es_array
 <<Simulations: procedures>>=
   subroutine simulation_read_event_es_array (object, es_array, enable_switch, &
        fail)
     class(simulation_t), intent(inout), target :: object
     class(event_stream_array_t), intent(inout), target :: es_array
     logical, intent(in) :: enable_switch
     logical, intent(out) :: fail
     integer :: iostat, i_prc
     type(entry_t), pointer :: current_entry => null ()
     integer :: i
     if (es_array%has_input ()) then
        fail = .false.
        call es_array%input_i_prc (i_prc, iostat)
        select case (iostat)
        case (0)
           object%i_prc = i_prc
           current_entry => object%entry(i_prc)
           do i = 1, current_entry%count_nlo_entries ()
              if (i > 1) then
                 call es_array%skip_eio_entry (iostat)
                 current_entry => current_entry%get_next ()
              end if
              call current_entry%set_index (object%get_event_index ())
              call es_array%input_event (current_entry%event_t, iostat)
           end do
        case (:-1)
           write (msg_buffer, "(A,1x,I0,1x,A)")  &
                "... event file terminates after", &
                object%counter%read, "events."
           call msg_message ()
           if (enable_switch) then
              call es_array%switch_inout ()
              write (msg_buffer, "(A,1x,I0,1x,A)")  &
                   "Generating remaining ", &
                   object%n_evt_requested - object%counter%read, "events ..."
              call msg_message ()
           end if
           fail = .true.
           return
        end select
        select case (iostat)
        case (0)
           object%i_mci = object%entry(i_prc)%get_i_mci ()
        case default
           write (msg_buffer, "(A,1x,I0,1x,A)")  &
                "Reading events: I/O error, aborting read after", &
                object%counter%read, "events."
           call msg_error ()
           object%i_prc = 0
           object%i_mci = 0
           fail = .true.
        end select
     else
        fail = .true.
     end if
   end subroutine simulation_read_event_es_array
 
 @ %def simulation_read_event
 @
 \subsection{Recover event}
 Recalculate the process instance contents, given an event with known particle
 set.  The indices for MC, term, and channel must be already set.  The
 [[recalculate]] method of the selected entry will import the result
 into [[sqme_prc]] and [[weight_prc]].
 
 If [[recover_phs]] is set (and false), do not attempt any phase-space
 calculation.  Useful if we need only matrix elements (esp. testing); this flag
 is not stored in the simulation record.
 <<Simulations: simulation: TBP>>=
   procedure :: recalculate => simulation_recalculate
 <<Simulations: procedures>>=
   subroutine simulation_recalculate (simulation, recover_phs)
     class(simulation_t), intent(inout) :: simulation
     logical, intent(in), optional :: recover_phs
     integer :: i_prc
     i_prc = simulation%i_prc
     associate (entry => simulation%entry(i_prc))
       if (simulation%update_weight) then
          call entry%recalculate &
               (update_sqme = simulation%update_sqme, &
               recover_beams = simulation%recover_beams, &
               recover_phs = recover_phs, &
               weight_factor = entry%get_kinematical_weight ())
       else
          call entry%recalculate &
               (update_sqme = simulation%update_sqme, &
               recover_beams = simulation%recover_beams, &
               recover_phs = recover_phs)
       end if
     end associate
   end subroutine simulation_recalculate
 
 @ %def simulation_recalculate
 @
 \subsection{Extract contents}
 Return the MD5 sum that summarizes configuration and integration
 (but not the event file).  Used for initializing the event streams.
 <<Simulations: simulation: TBP>>=
   procedure :: get_md5sum_prc => simulation_get_md5sum_prc
   procedure :: get_md5sum_cfg => simulation_get_md5sum_cfg
   procedure :: get_md5sum_alt => simulation_get_md5sum_alt
 <<Simulations: procedures>>=
   function simulation_get_md5sum_prc (simulation) result (md5sum)
     class(simulation_t), intent(in) :: simulation
     character(32) :: md5sum
     md5sum = simulation%md5sum_prc
   end function simulation_get_md5sum_prc
 
   function simulation_get_md5sum_cfg (simulation) result (md5sum)
     class(simulation_t), intent(in) :: simulation
     character(32) :: md5sum
     md5sum = simulation%md5sum_cfg
   end function simulation_get_md5sum_cfg
 
   function simulation_get_md5sum_alt (simulation, i) result (md5sum)
     class(simulation_t), intent(in) :: simulation
     integer, intent(in) :: i
     character(32) :: md5sum
     md5sum = simulation%md5sum_alt(i)
   end function simulation_get_md5sum_alt
 
 @ %def simulation_get_md5sum_prc
 @ %def simulation_get_md5sum_cfg
 @ Return data that may be useful for writing event files.
 
 Usually we can refer to a previously integrated process, for which we
 can fetch a process pointer.  Occasionally, we don't have this because
 we're just rescanning an externally generated file without
 calculation.  For that situation, we generate our local beam data object
 using the current enviroment, or, in simple cases, just fetch the
 necessary data from the process definition and environment.
 <<Simulations: simulation: TBP>>=
   procedure :: get_data => simulation_get_data
 <<Simulations: procedures>>=
   function simulation_get_data (simulation, alt) result (sdata)
     class(simulation_t), intent(in) :: simulation
     logical, intent(in), optional :: alt
     type(event_sample_data_t) :: sdata
     type(process_t), pointer :: process
     type(beam_data_t), pointer :: beam_data
     type(beam_structure_t), pointer :: beam_structure
     type(flavor_t), dimension(:), allocatable :: flv
     integer :: n, i
     logical :: enable_alt, construct_beam_data
     real(default) :: sqrts
     class(model_data_t), pointer :: model
     logical :: decay_rest_frame
     type(string_t) :: process_id
     enable_alt = .true.;  if (present (alt))  enable_alt = alt
     if (debug_on) call msg_debug (D_CORE, "simulation_get_data")
     if (debug_on) call msg_debug (D_CORE, "alternative setup", enable_alt)
     if (enable_alt) then
        call sdata%init (simulation%n_prc, simulation%n_alt)
        do i = 1, simulation%n_alt
           sdata%md5sum_alt(i) = simulation%get_md5sum_alt (i)
        end do
     else
        call sdata%init (simulation%n_prc)
     end if
     sdata%unweighted = simulation%unweighted
     sdata%negative_weights = simulation%negative_weights
     sdata%norm_mode = simulation%norm_mode
     process => simulation%entry(1)%get_process_ptr ()
     if (associated (process)) then
        beam_data => process%get_beam_data_ptr ()
        construct_beam_data = .false.
     else
        n = simulation%entry(1)%n_in
        sqrts = simulation%local%get_sqrts ()
        beam_structure => simulation%local%beam_structure
        call beam_structure%check_against_n_in (n, construct_beam_data)
        if (construct_beam_data) then
           allocate (beam_data)
           model => simulation%local%model
           decay_rest_frame = &
                simulation%local%get_lval (var_str ("?decay_rest_frame"))
           call beam_data%init_structure (beam_structure, &
                sqrts, model, decay_rest_frame)
        else
           beam_data => null ()
        end if
     end if
     if (associated (beam_data)) then
        n = beam_data%get_n_in ()
        sdata%n_beam = n
        allocate (flv (n))
        flv = beam_data%get_flavor ()
        sdata%pdg_beam(:n) = flv%get_pdg ()
        sdata%energy_beam(:n) = beam_data%get_energy ()
        if (construct_beam_data)  deallocate (beam_data)
     else
        n = simulation%entry(1)%n_in
        sdata%n_beam = n
        process_id = simulation%entry(1)%process_id
        call simulation%local%prclib%get_pdg_in_1 &
             (process_id, sdata%pdg_beam(:n))
        sdata%energy_beam(:n) = sqrts / n
     end if
     do i = 1, simulation%n_prc
        if (.not. simulation%entry(i)%valid) cycle
        process => simulation%entry(i)%get_process_ptr ()
        if (associated (process)) then
           sdata%proc_num_id(i) = process%get_num_id ()
        else
           process_id = simulation%entry(i)%process_id
           sdata%proc_num_id(i) = simulation%local%prclib%get_num_id (process_id)
        end if
        if (sdata%proc_num_id(i) == 0)  sdata%proc_num_id(i) = i
        if (simulation%entry(i)%has_integral) then
           sdata%cross_section(i) = simulation%entry(i)%integral
           sdata%error(i) = simulation%entry(i)%error
        end if
     end do
     sdata%total_cross_section = sum (sdata%cross_section)
     sdata%md5sum_prc = simulation%get_md5sum_prc ()
     sdata%md5sum_cfg = simulation%get_md5sum_cfg ()
     if (simulation%split_n_evt > 0 .or. simulation%split_n_kbytes > 0) then
        sdata%split_n_evt = simulation%split_n_evt
        sdata%split_n_kbytes = simulation%split_n_kbytes
        sdata%split_index = simulation%split_index
     end if
   end function simulation_get_data
 
 @ %def simulation_get_data
 @ Return a default name for the current event sample.  This is the
 process ID of the first process.
 <<Simulations: simulation: TBP>>=
   procedure :: get_default_sample_name => simulation_get_default_sample_name
 <<Simulations: procedures>>=
   function simulation_get_default_sample_name (simulation) result (sample)
     class(simulation_t), intent(in) :: simulation
     type(string_t) :: sample
     type(process_t), pointer :: process
     sample = "whizard"
     if (simulation%n_prc > 0) then
        process => simulation%entry(1)%get_process_ptr ()
        if (associated (process)) then
           sample = process%get_id ()
        end if
     end if
   end function simulation_get_default_sample_name
 
 @ %def simulation_get_default_sample_name
 @
 <<Simulations: simulation: TBP>>=
   procedure :: is_valid => simulation_is_valid
 <<Simulations: procedures>>=
   function simulation_is_valid (simulation) result (valid)
     class(simulation_t), intent(inout) :: simulation
     logical :: valid
     valid = simulation%valid
   end function simulation_is_valid
 
 @ %def simulation_is_valid
 @
 Return the hard-interaction particle set for event entry [[i_prc]].
 <<Simulations: simulation: TBP>>=
   procedure :: get_hard_particle_set => simulation_get_hard_particle_set
 <<Simulations: procedures>>=
   function simulation_get_hard_particle_set (simulation, i_prc) result (pset)
     class(simulation_t), intent(in) :: simulation
     integer, intent(in) :: i_prc
     type(particle_set_t) :: pset
     call simulation%entry(i_prc)%get_hard_particle_set (pset)
   end function simulation_get_hard_particle_set
 
 @ %def simulation_get_hard_particle_set
 @
 \subsection{Auxiliary}
 Call pacify: eliminate numerical noise.
 <<Simulations: public>>=
   public :: pacify
 <<Simulations: interfaces>>=
   interface pacify
      module procedure pacify_simulation
   end interface
 <<Simulations: procedures>>=
   subroutine pacify_simulation (simulation)
     class(simulation_t), intent(inout) :: simulation
     integer :: i, j
     i = simulation%i_prc
     if (i > 0) then
        call pacify (simulation%entry(i))
        do j = 1, simulation%n_alt
           call pacify (simulation%alt_entry(i,j))
        end do
     end if
   end subroutine pacify_simulation
 
 @ %def pacify_simulation
 @ Manually evaluate expressions for the currently selected process.
 This is used only in the unit tests.
 <<Simulations: simulation: TBP>>=
   procedure :: evaluate_expressions => simulation_evaluate_expressions
 <<Simulations: procedures>>=
   subroutine simulation_evaluate_expressions (simulation)
     class(simulation_t), intent(inout) :: simulation
     call simulation%entry(simulation%i_prc)%evaluate_expressions ()
   end subroutine simulation_evaluate_expressions
 
 @ %def simulation_evaluate_expressions
 @ Manually evaluate event transforms for the currently selected
 process.  This is used only in the unit tests.
 <<Simulations: simulation: TBP>>=
   procedure :: evaluate_transforms => simulation_evaluate_transforms
 <<Simulations: procedures>>=
   subroutine simulation_evaluate_transforms (simulation)
     class(simulation_t), intent(inout) :: simulation
     associate (entry => simulation%entry(simulation%i_prc))
       call entry%evaluate_transforms ()
     end associate
   end subroutine simulation_evaluate_transforms
 
 @ %def simulation_evaluate_transforms
 @
 \subsection{Unit tests}
 Test module, followed by the stand-alone unit-test procedures.
 <<[[simulations_ut.f90]]>>=
 <<File header>>
 
 module simulations_ut
   use unit_tests
   use simulations_uti
 
 <<Standard module head>>
 
 <<Simulations: public test>>
 
 contains
 
 <<Simulations: test driver>>
 
 end module simulations_ut
 @ %def simulations_ut
 @
 <<[[simulations_uti.f90]]>>=
 <<File header>>
 
 module simulations_uti
 
   <<Use kinds>>
     use kinds, only: i64
   <<Use strings>>
     use io_units
     use format_defs, only: FMT_10, FMT_12
     use ifiles
     use lexers
     use parser
     use lorentz
     use flavors
     use interactions, only: reset_interaction_counter
     use process_libraries, only: process_library_t
     use prclib_stacks
     use phs_forests
     use event_base, only: generic_event_t
     use event_base, only: event_callback_t
     use particles, only: particle_set_t
     use eio_data
     use eio_base
     use eio_direct, only: eio_direct_t
     use eio_raw
     use eio_ascii
     use eio_dump
     use eio_callback
     use eval_trees
     use model_data, only: model_data_t
     use models
     use rt_data
     use event_streams
     use decays_ut, only: prepare_testbed
     use process, only: process_t
     use process_stacks, only: process_entry_t
     use process_configurations_ut, only: prepare_test_library
     use compilations, only: compile_library
     use integrations, only: integrate_process
 
     use simulations
 
     use restricted_subprocesses_uti, only: prepare_resonance_test_library
 
 <<Standard module head>>
 
 <<Simulations: test declarations>>
 
 <<Simulations: test auxiliary types>>
 
 contains
 
 <<Simulations: tests>>
 
 <<Simulations: test auxiliary>>
 
 end module simulations_uti
 
 @ %def simulations_uti
 @ API: driver for the unit tests below.
 <<Simulations: public test>>=
   public :: simulations_test
 <<Simulations: test driver>>=
   subroutine simulations_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Simulations: execute tests>>
   end subroutine simulations_test
 
 @ %def simulations_test
 @
 \subsubsection{Initialization}
 Initialize a [[simulation_t]] object, including the embedded event records.
 <<Simulations: execute tests>>=
   call test (simulations_1, "simulations_1", &
        "initialization", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_1
 <<Simulations: tests>>=
   subroutine simulations_1 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, procname2
     type(rt_data_t), target :: global
     type(simulation_t), target :: simulation
 
     write (u, "(A)")  "* Test output: simulations_1"
     write (u, "(A)")  "*   Purpose: initialize simulation"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_1a"
     procname1 = "simulation_1p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     procname2 = "sim_extra"
 
     call prepare_test_library (global, libname, 1, [procname2])
     call compile_library (libname, global)
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations2"), is_known = .true.)
 
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_string (var_str ("$sample"), &
          var_str ("sim1"), is_known = .true.)
     call integrate_process (procname2, global, local_stack=.true.)
 
     call simulation%init ([procname1, procname2], .false., .true., global)
     call simulation%init_process_selector ()
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the first process"
     write (u, "(A)")
 
     call simulation%write_event (u, i_prc = 1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_1"
 
   end subroutine simulations_1
 
 @ %def simulations_1
 @
 \subsubsection{Weighted events}
 Generate events for a single process.
 <<Simulations: execute tests>>=
   call test (simulations_2, "simulations_2", &
        "weighted events", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_2
 <<Simulations: tests>>=
   subroutine simulations_2 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1
     type(rt_data_t), target :: global
     type(simulation_t), target :: simulation
     type(event_sample_data_t) :: data
 
     write (u, "(A)")  "* Test output: simulations_2"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_2a"
     procname1 = "simulation_2p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     data = simulation%get_data ()
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate three events"
     write (u, "(A)")
 
     call simulation%generate (3)
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the last event"
     write (u, "(A)")
 
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_2"
 
   end subroutine simulations_2
 
 @ %def simulations_2
 @
 \subsubsection{Unweighted events}
 Generate events for a single process.
 <<Simulations: execute tests>>=
   call test (simulations_3, "simulations_3", &
        "unweighted events", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_3
 <<Simulations: tests>>=
   subroutine simulations_3 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1
     type(rt_data_t), target :: global
     type(simulation_t), target :: simulation
     type(event_sample_data_t) :: data
 
     write (u, "(A)")  "* Test output: simulations_3"
     write (u, "(A)")  "*   Purpose: generate unweighted events &
          &for a single process"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_3a"
     procname1 = "simulation_3p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     data = simulation%get_data ()
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate three events"
     write (u, "(A)")
 
     call simulation%generate (3)
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the last event"
     write (u, "(A)")
 
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_3"
 
   end subroutine simulations_3
 
 @ %def simulations_3
 @
 \subsubsection{Simulating process with structure functions}
 Generate events for a single process.
 <<Simulations: execute tests>>=
   call test (simulations_4, "simulations_4", &
        "process with structure functions", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_4
 <<Simulations: tests>>=
   subroutine simulations_4 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1
     type(rt_data_t), target :: global
     type(flavor_t) :: flv
     type(string_t) :: name
     type(simulation_t), target :: simulation
     type(event_sample_data_t) :: data
 
     write (u, "(A)")  "* Test output: simulations_4"
     write (u, "(A)")  "*   Purpose: generate events for a single process &
          &with structure functions"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_4a"
     procname1 = "simulation_4p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call reset_interaction_counter ()
 
     call flv%init (25, global%model)
     name = flv%get_name ()
 
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     call global%set_string (var_str ("$sample"), &
          var_str ("simulations4"), is_known = .true.)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     data = simulation%get_data ()
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate three events"
     write (u, "(A)")
 
     call simulation%generate (3)
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the last event"
     write (u, "(A)")
 
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_4"
 
   end subroutine simulations_4
 
 @ %def simulations_4
 @
 \subsubsection{Event I/O}
 Generate event for a test process, write to file and reread.
 <<Simulations: execute tests>>=
   call test (simulations_5, "simulations_5", &
        "raw event I/O", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_5
 <<Simulations: tests>>=
   subroutine simulations_5 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     class(eio_t), allocatable :: eio
     type(simulation_t), allocatable, target :: simulation
 
     write (u, "(A)")  "* Test output: simulations_5"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            write to file and reread"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_5a"
     procname1 = "simulation_5p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations5"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations5"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Initialize raw event file"
     write (u, "(A)")
 
     allocate (eio_raw_t :: eio)
     call eio%init_out (sample)
 
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1)
     call simulation%write_event (u)
     call simulation%write_event (eio)
 
     call eio%final ()
     deallocate (eio)
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read the event from file"
     write (u, "(A)")
 
     call global%set_log (var_str ("?update_sqme"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_weight"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
     allocate (eio_raw_t :: eio)
     call eio%init_in (sample)
 
     call simulation%read_event (eio)
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recalculate process instance"
     write (u, "(A)")
 
     call simulation%recalculate ()
     call simulation%evaluate_expressions ()
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_5"
 
   end subroutine simulations_5
 
 @ %def simulations_5
 @
 \subsubsection{Event I/O}
 Generate event for a real process with structure functions, write to file and
 reread.
 <<Simulations: execute tests>>=
   call test (simulations_6, "simulations_6", &
        "raw event I/O with structure functions", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_6
 <<Simulations: tests>>=
   subroutine simulations_6 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     class(eio_t), allocatable :: eio
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     type(string_t) :: name
 
     write (u, "(A)")  "* Test output: simulations_6"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            write to file and reread"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_6"
     procname1 = "simulation_6p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
 
     call flv%init (25, global%model)
     name = flv%get_name ()
 
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations6"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Initialize raw event file"
     write (u, "(A)")
 
     allocate (eio_raw_t :: eio)
     call eio%init_out (sample)
 
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1)
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true., testflag = .true.)
     call simulation%write_event (eio)
 
     call eio%final ()
     deallocate (eio)
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read the event from file"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?update_sqme"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_weight"), &
          .true., is_known = .true.)
 
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
     allocate (eio_raw_t :: eio)
     call eio%init_in (sample)
 
     call simulation%read_event (eio)
     call simulation%write_event (u, verbose = .true., testflag = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recalculate process instance"
     write (u, "(A)")
 
     call simulation%recalculate ()
     call simulation%evaluate_expressions ()
     call simulation%write_event (u, verbose = .true., testflag = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_6"
 
   end subroutine simulations_6
 
 @ %def simulations_6
 @
 \subsubsection{Automatic Event I/O}
 Generate events with raw-format event file as cache: generate, reread,
 append.
 <<Simulations: execute tests>>=
   call test (simulations_7, "simulations_7", &
        "automatic raw event I/O", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_7
 <<Simulations: tests>>=
   subroutine simulations_7 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: empty_string_array
     type(event_sample_data_t) :: data
     type(event_stream_array_t) :: es_array
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     type(string_t) :: name
 
     write (u, "(A)")  "* Test output: simulations_7"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            write to file and reread"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_7"
     procname1 = "simulation_7p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
 
     call flv%init (25, global%model)
     name = flv%get_name ()
 
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations7"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Initialize raw event file"
     write (u, "(A)")
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = simulation%get_md5sum_cfg ()
     call es_array%init (sample, [var_str ("raw")], global, data)
 
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1, es_array)
 
     call es_array%final ()
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")  "* Re-read the event from file and generate another one"
     write (u, "(A)")
 
     call global%set_log (&
          var_str ("?rebuild_events"), .false., is_known = .true.)
 
     call reset_interaction_counter ()
 
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = simulation%get_md5sum_cfg ()
     call es_array%init (sample, empty_string_array, global, data, &
          input = var_str ("raw"))
 
     call simulation%generate (2, es_array)
 
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true.)
 
     call es_array%final ()
     call simulation%final ()
     deallocate (simulation)
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read both events from file"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = simulation%get_md5sum_cfg ()
     call es_array%init (sample, empty_string_array, global, data, &
          input = var_str ("raw"))
 
     call simulation%generate (2, es_array)
 
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call es_array%final ()
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_7"
 
   end subroutine simulations_7
 
 @ %def simulations_7
 @
 \subsubsection{Rescanning Events}
 Generate events and rescan the resulting raw event file.
 <<Simulations: execute tests>>=
   call test (simulations_8, "simulations_8", &
        "rescan raw event file", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_8
 <<Simulations: tests>>=
   subroutine simulations_8 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: empty_string_array
     type(event_sample_data_t) :: data
     type(event_stream_array_t) :: es_array
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     type(string_t) :: name
 
     write (u, "(A)")  "* Test output: simulations_8"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            write to file and rescan"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_8"
     procname1 = "simulation_8p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
 
     call flv%init (25, global%model)
     name = flv%get_name ()
 
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations8"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Initialize raw event file"
     write (u, "(A)")
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = simulation%get_md5sum_cfg ()
     write (u, "(1x,A,A,A)")  "MD5 sum (proc)   = '", data%md5sum_prc, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (config) = '", data%md5sum_cfg, "'"
     call es_array%init (sample, [var_str ("raw")], global, &
          data)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1, es_array)
 
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true., testflag = .true.)
 
     call es_array%final ()
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read the event from file"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     allocate (simulation)
     call simulation%init ([procname1], .false., .false., global)
     call simulation%init_process_selector ()
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = ""
     write (u, "(1x,A,A,A)")  "MD5 sum (proc)   = '", data%md5sum_prc, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (config) = '", data%md5sum_cfg, "'"
     call es_array%init (sample, empty_string_array, global, data, &
          input = var_str ("raw"), input_sample = sample, allow_switch = .false.)
 
     call simulation%rescan (1, es_array, global = global)
 
     write (u, "(A)")
 
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true., testflag = .true.)
 
     call es_array%final ()
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read again and recalculate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?update_sqme"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_event"), &
          .true., is_known = .true.)
 
     allocate (simulation)
     call simulation%init ([procname1], .false., .false., global)
     call simulation%init_process_selector ()
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = ""
     write (u, "(1x,A,A,A)")  "MD5 sum (proc)   = '", data%md5sum_prc, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (config) = '", data%md5sum_cfg, "'"
     call es_array%init (sample, empty_string_array, global, data, &
          input = var_str ("raw"), input_sample = sample, allow_switch = .false.)
 
     call simulation%rescan (1, es_array, global = global)
 
     write (u, "(A)")
 
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true., testflag = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call es_array%final ()
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_8"
 
   end subroutine simulations_8
 
 @ %def simulations_8
 @
 \subsubsection{Rescanning Check}
 Generate events and rescan with process mismatch.
 <<Simulations: execute tests>>=
   call test (simulations_9, "simulations_9", &
        "rescan mismatch", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_9
 <<Simulations: tests>>=
   subroutine simulations_9 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: empty_string_array
     type(event_sample_data_t) :: data
     type(event_stream_array_t) :: es_array
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     type(string_t) :: name
     logical :: error
 
     write (u, "(A)")  "* Test output: simulations_9"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            write to file and rescan"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_9"
     procname1 = "simulation_9p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
 
     call flv%init (25, global%model)
     name = flv%get_name ()
 
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations9"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize raw event file"
     write (u, "(A)")
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = simulation%get_md5sum_cfg ()
     write (u, "(1x,A,A,A)")  "MD5 sum (proc)   = '", data%md5sum_prc, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (config) = '", data%md5sum_cfg, "'"
     call es_array%init (sample, [var_str ("raw")], global, &
          data)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1, es_array)
 
     call es_array%final ()
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")  "* Initialize event generation for different parameters"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     allocate (simulation)
     call simulation%init ([procname1, procname1], .false., .false., global)
     call simulation%init_process_selector ()
 
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Attempt to re-read the events (should fail)"
     write (u, "(A)")
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = ""
     write (u, "(1x,A,A,A)")  "MD5 sum (proc)   = '", data%md5sum_prc, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (config) = '", data%md5sum_cfg, "'"
     call es_array%init (sample, empty_string_array, global, data, &
          input = var_str ("raw"), input_sample = sample, &
          allow_switch = .false., error = error)
 
     write (u, "(1x,A,L1)")  "error = ", error
 
     call simulation%rescan (1, es_array, global = global)
 
     call es_array%final ()
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_9"
 
   end subroutine simulations_9
 
 @ %def simulations_9
 @
 \subsubsection{Alternative weights}
 Generate an event for a single process and reweight it in a
 simultaneous calculation.
 <<Simulations: execute tests>>=
   call test (simulations_10, "simulations_10", &
        "alternative weight", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_10
 <<Simulations: tests>>=
   subroutine simulations_10 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, expr_text
     type(rt_data_t), target :: global
     type(rt_data_t), dimension(1), target :: alt_env
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: pt_weight
     type(simulation_t), target :: simulation
     type(event_sample_data_t) :: data
 
     write (u, "(A)")  "* Test output: simulations_10"
     write (u, "(A)")  "*   Purpose: reweight event"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_pexpr_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_10a"
     procname1 = "simulation_10p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize alternative environment with custom weight"
     write (u, "(A)")
 
     call alt_env(1)%local_init (global)
     call alt_env(1)%activate ()
 
     expr_text = "2"
     write (u, "(A,A)")  "weight = ", char (expr_text)
     write (u, *)
 
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_weight, stream, .true.)
     call stream_final (stream)
     alt_env(1)%pn%weight_expr => pt_weight%get_root_ptr ()
     call alt_env(1)%write_expr (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     call simulation%init ([procname1], .true., .true., global, alt_env=alt_env)
     call simulation%init_process_selector ()
 
     data = simulation%get_data ()
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1)
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the last event"
     write (u, "(A)")
 
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the alternative setup"
     write (u, "(A)")
 
     call simulation%write_alt_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     call syntax_model_file_final ()
     call syntax_pexpr_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_10"
 
   end subroutine simulations_10
 
 @ %def simulations_10
 @
 \subsubsection{Decays}
 Generate an event with subsequent partonic decays.
 <<Simulations: execute tests>>=
   call test (simulations_11, "simulations_11", &
        "decay", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_11
 <<Simulations: tests>>=
   subroutine simulations_11 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(prclib_entry_t), pointer :: lib
     type(string_t) :: prefix, procname1, procname2
     type(simulation_t), target :: simulation
 
     write (u, "(A)")  "* Test output: simulations_11"
     write (u, "(A)")  "*   Purpose: apply decay"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     allocate (lib)
     call global%add_prclib (lib)
 
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     prefix = "simulation_11"
     procname1 = prefix // "_p"
     procname2 = prefix // "_d"
     call prepare_testbed &
          (global%prclib, global%process_stack, &
          prefix, global%os_data, &
          scattering=.true., decay=.true.)
 
     call global%select_model (var_str ("Test"))
     call global%model%set_par (var_str ("ff"), 0.4_default)
     call global%model%set_par (var_str ("mf"), &
          global%model%get_real (var_str ("ff")) &
          * global%model%get_real (var_str ("ms")))
     call global%model%set_unstable (25, [procname2])
 
     write (u, "(A)")  "* Initialize simulation object"
     write (u, "(A)")
 
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Generate event"
     write (u, "(A)")
 
     call simulation%generate (1)
     call simulation%write (u)
 
     write (u, *)
 
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
     write (u, "(A)")
 
     call simulation%final ()
     call global%final ()
 
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_11"
 
   end subroutine simulations_11
 
 @ %def simulations_11
 @
 \subsubsection{Split Event Files}
 Generate event for a real process with structure functions and write to file,
 accepting a limit for the number of events per file.
 <<Simulations: execute tests>>=
   call test (simulations_12, "simulations_12", &
        "split event files", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_12
 <<Simulations: tests>>=
   subroutine simulations_12 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     class(eio_t), allocatable :: eio
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     integer :: i_evt
 
     write (u, "(A)")  "* Test output: simulations_12"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            and write to split event files"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_12"
     procname1 = "simulation_12p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
 
     call flv%init (25, global%model)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations_12"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     call global%set_int (var_str ("sample_split_n_evt"), &
          2, is_known = .true.)
     call global%set_int (var_str ("sample_split_index"), &
          42, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize ASCII event file"
     write (u, "(A)")
 
     allocate (eio_ascii_short_t :: eio)
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data = simulation%get_data ())
 
     write (u, "(A)")  "* Generate 5 events, distributed among three files"
 
     do i_evt = 1, 5
        call simulation%generate (1)
        call simulation%write_event (eio)
     end do
 
     call eio%final ()
     deallocate (eio)
     call simulation%final ()
     deallocate (simulation)
 
     write (u, *)
     call display_file ("simulations_12.42.short.evt", u)
     write (u, *)
     call display_file ("simulations_12.43.short.evt", u)
     write (u, *)
     call display_file ("simulations_12.44.short.evt", u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_12"
 
   end subroutine simulations_12
 
 @ %def simulations_12
 @ Auxiliary: display file contents.
 <<Simulations: public test auxiliary>>=
   public :: display_file
 <<Simulations: test auxiliary>>=
   subroutine display_file (file, u)
     use io_units, only: free_unit
     character(*), intent(in) :: file
     integer, intent(in) :: u
     character(256) :: buffer
     integer :: u_file
     write (u, "(3A)")  "* Contents of file '", file, "':"
     write (u, *)
     u_file = free_unit ()
     open (u_file, file = file, action = "read", status = "old")
     do
        read (u_file, "(A)", end = 1)  buffer
        write (u, "(A)")  trim (buffer)
     end do
 1   continue
   end subroutine display_file
 
 @ %def display_file
 @
 \subsubsection{Callback}
 Generate events and execute a callback in place of event I/O.
 <<Simulations: execute tests>>=
   call test (simulations_13, "simulations_13", &
        "callback", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_13
 <<Simulations: tests>>=
   subroutine simulations_13 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     class(eio_t), allocatable :: eio
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     integer :: i_evt
     type(simulations_13_callback_t) :: event_callback
 
     write (u, "(A)")  "* Test output: simulations_13"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            and execute callback"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_13"
     procname1 = "simulation_13p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call flv%init (25, global%model)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations_13"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
 
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Prepare callback object"
     write (u, "(A)")
 
     event_callback%u = u
     call global%set_event_callback (event_callback)
 
     write (u, "(A)")  "* Initialize callback I/O object"
     write (u, "(A)")
 
     allocate (eio_callback_t :: eio)
     select type (eio)
     class is (eio_callback_t)
        call eio%set_parameters (callback = event_callback, &
             count_interval = 3)
     end select
     call eio%init_out (sample, data = simulation%get_data ())
 
     write (u, "(A)")  "* Generate 7 events, with callback every 3 events"
     write (u, "(A)")
 
     do i_evt = 1, 7
        call simulation%generate (1)
        call simulation%write_event (eio)
     end do
 
     call eio%final ()
     deallocate (eio)
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_13"
 
   end subroutine simulations_13
 
 @ %def simulations_13
 @ The callback object and procedure.  In the type extension, we can
 store the output channel [[u]] so we know where to write into.
 <<Simulations: test auxiliary types>>=
   type, extends (event_callback_t) :: simulations_13_callback_t
      integer :: u
    contains
      procedure :: write => simulations_13_callback_write
      procedure :: proc => simulations_13_callback
   end type simulations_13_callback_t
 
 @ %def simulations_13_callback_t
 <<Simulations: test auxiliary>>=
   subroutine simulations_13_callback_write (event_callback, unit)
     class(simulations_13_callback_t), intent(in) :: event_callback
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Hello"
   end subroutine simulations_13_callback_write
 
   subroutine simulations_13_callback (event_callback, i, event)
     class(simulations_13_callback_t), intent(in) :: event_callback
     integer(i64), intent(in) :: i
     class(generic_event_t), intent(in) :: event
     write (event_callback%u, "(A,I0)")  "hello event #", i
   end subroutine simulations_13_callback
 
 @ %def simulations_13_callback_write
 @ %def simulations_13_callback
 @
 \subsubsection{Resonant subprocess setup}
 Prepare a process with resonances and enter resonant subprocesses in
 the simulation object.  Select a kinematics configuration and compute
 probabilities for resonant subprocesses.
 
 The process and its initialization is taken from [[processes_18]], but
 we need a complete \oMega\ matrix element here.
 <<Simulations: execute tests>>=
   call test (simulations_14, "simulations_14", &
        "resonant subprocesses evaluation", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_14
 <<Simulations: tests>>=
   subroutine simulations_14 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, libname_generated
     type(string_t) :: procname
     type(string_t) :: model_name
     type(rt_data_t), target :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(simulation_t), target :: simulation
     type(particle_set_t) :: pset
     type(eio_direct_t) :: eio_in
     type(eio_dump_t) :: eio_out
     real(default) :: sqrts, mw, pp
     real(default), dimension(3) :: p3
     type(vector4_t), dimension(:), allocatable :: p
     real(default), dimension(:), allocatable :: m
     integer :: u_verbose, i
     real(default) :: sqme_proc
     real(default), dimension(:), allocatable :: sqme
     real(default) :: on_shell_limit
     integer, dimension(:), allocatable :: i_array
     real(default), dimension(:), allocatable :: prob_array
 
     write (u, "(A)")  "* Test output: simulations_14"
     write (u, "(A)")  "*   Purpose: construct resonant subprocesses &
          &in the simulation object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Build and load a test library with one process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     libname = "simulations_14_lib"
     procname = "simulations_14_p"
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
     call global%set_log (var_str ("?update_sqme"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_weight"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_event"), &
          .true., is_known = .true.)
 
     model_name = "SM"
     call global%select_model (model_name)
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize simulation object &
          &with resonant subprocesses"
     write (u, "(A)")
 
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
     call global%set_real (var_str ("resonance_on_shell_limit"), &
          10._default, is_known = .true.)
 
     call simulation%init ([procname], &
          integrate=.false., generate=.false., local=global)
 
     call simulation%write_resonant_subprocess_data (u, 1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Resonant subprocesses: generated library"
     write (u, "(A)")
 
     libname_generated = procname // "_R"
     lib => global%prclib_stack%get_library_ptr (libname_generated)
     if (associated (lib))  call lib%write (u, libpath=.false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generated process stack"
     write (u, "(A)")
 
     call global%process_stack%show (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Particle set"
     write (u, "(A)")
 
     pset = simulation%get_hard_particle_set (1)
     call pset%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize object for direct access"
     write (u, "(A)")
 
     call eio_in%init_direct &
          (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 3, &
          pdg = [-11, 11, 1, -2, 24], model=global%model)
     call eio_in%set_selection_indices (1, 1, 1, 1)
 
     sqrts = global%get_rval (var_str ("sqrts"))
     mw = 80._default   ! deliberately slightly different from true mw
     pp = sqrt (sqrts**2 - 4 * mw**2) / 2
 
     allocate (p (5), m (5))
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     m(1) = 0
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     m(2) = 0
     p3(1) = pp/2
     p3(2) = mw/2
     p3(3) = 0
     p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(3) = 0
     p3(2) = -mw/2
     p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(4) = 0
     p(5) = vector4_moving (sqrts/2,-pp, 1)
     m(5) = mw
     call eio_in%set_momentum (p, m**2)
 
     call eio_in%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Transfer and show particle set"
     write (u, "(A)")
 
     call simulation%read_event (eio_in)
     pset = simulation%get_hard_particle_set (1)
     call pset%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* (Re)calculate matrix element"
     write (u, "(A)")
 
     call simulation%recalculate (recover_phs = .false.)
     call simulation%evaluate_transforms ()
 
     write (u, "(A)")  "* Show event with sqme"
     write (u, "(A)")
 
     call eio_out%set_parameters (unit = u, &
          weights = .true., pacify = .true., compressed = .true.)
     call eio_out%init_out (var_str (""))
     call simulation%write_event (eio_out)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write event to separate file &
          &'simulations_14_event_verbose.log'"
 
     u_verbose = free_unit ()
     open (unit = u_verbose, file = "simulations_14_event_verbose.log", &
          status = "replace", action = "write")
     call simulation%write (u_verbose)
     write (u_verbose, *)
     call simulation%write_event (u_verbose, verbose =.true., testflag = .true.)
     close (u_verbose)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_14"
 
   end subroutine simulations_14
 
 @ %def simulations_14
 @
 \subsubsection{Resonant subprocess simulation}
 Prepare a process with resonances and enter resonant subprocesses in
 the simulation object.  Simulate events with selection of resonance
 histories.
 
 The process and its initialization is taken from [[processes_18]], but
 we need a complete \oMega\ matrix element here.
 <<Simulations: execute tests>>=
   call test (simulations_15, "simulations_15", &
        "resonant subprocesses in simulation", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_15
 <<Simulations: tests>>=
   subroutine simulations_15 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, libname_generated
     type(string_t) :: procname
     type(string_t) :: model_name
     type(rt_data_t), target :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(simulation_t), target :: simulation
     real(default) :: sqrts
     type(eio_dump_t) :: eio_out
     integer :: u_verbose
 
     write (u, "(A)")  "* Test output: simulations_15"
     write (u, "(A)")  "*   Purpose: generate event with resonant subprocess"
     write (u, "(A)")
 
     write (u, "(A)")  "* Build and load a test library with one process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     libname = "simulations_15_lib"
     procname = "simulations_15_p"
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
     call global%set_log (var_str ("?update_sqme"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_weight"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_event"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
     call global%set_real (var_str ("resonance_on_shell_limit"), &
          10._default, is_known = .true.)
 
     model_name = "SM"
     call global%select_model (model_name)
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize simulation object &
          &with resonant subprocesses"
     write (u, "(A)")
 
     call global%it_list%init ([1], [1000])
     call simulation%init ([procname], &
          integrate=.true., generate=.true., local=global)
 
     call simulation%write_resonant_subprocess_data (u, 1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate event"
     write (u, "(A)")
 
     call simulation%init_process_selector ()
     call simulation%generate (1)
 
     call eio_out%set_parameters (unit = u, &
          weights = .true., pacify = .true., compressed = .true.)
     call eio_out%init_out (var_str (""))
     call simulation%write_event (eio_out)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write event to separate file &
          &'simulations_15_event_verbose.log'"
 
     u_verbose = free_unit ()
     open (unit = u_verbose, file = "simulations_15_event_verbose.log", &
          status = "replace", action = "write")
     call simulation%write (u_verbose)
     write (u_verbose, *)
     call simulation%write_event (u_verbose, verbose =.true., testflag = .true.)
     close (u_verbose)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_15"
 
   end subroutine simulations_15
 
 @ %def simulations_15
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{More Unit Tests}
 
 This chapter collects some procedures for testing that can't be
 provided at the point where the corresponding modules are defined,
 because they use other modules of a different level.
 
 (We should move them back, collecting the high-level functionality in
 init/final hooks that we can set at runtime.)
 
 
 \section{Expression Testing}
 
 Expression objects are part of process and event objects, but the
 process and event object modules should not depend on the
 implementation of expressions.  Here, we collect unit tests that
 depend on expression implementation.
 <<[[expr_tests_ut.f90]]>>=
 <<File header>>
 module expr_tests_ut
 
   use unit_tests
   use expr_tests_uti
 
 <<Standard module head>>
 
 <<Expr tests: public test>>
 
 contains
 
 <<Expr tests: test driver>>
 
 end module expr_tests_ut
 @ %def expr_tests_ut
 @
 <<[[expr_tests_uti.f90]]>>=
 <<File header>>
 
 module expr_tests_uti
 
   <<Use kinds>>
   <<Use strings>>
     use format_defs, only: FMT_12
     use format_utils, only: write_separator
     use os_interface
     use sm_qcd
     use lorentz
     use ifiles
     use lexers
     use parser
     use model_data
     use interactions, only: reset_interaction_counter
     use process_libraries
     use subevents
     use subevt_expr
     use rng_base
     use mci_base
     use phs_base
     use variables, only: var_list_t
     use eval_trees
     use models
     use prc_core
     use prc_test
     use process, only: process_t
     use instances, only: process_instance_t
     use events
 
     use rng_base_ut, only: rng_test_factory_t
     use phs_base_ut, only: phs_test_config_t
 
 <<Standard module head>>
 
 <<Expr tests: test declarations>>
 
 contains
 
 <<Expr tests: tests>>
 
 <<Expr tests: test auxiliary>>
 
 end module expr_tests_uti
 
 @ %def expr_tests_uti
 @
 \subsection{Test}
 This is the master for calling self-test procedures.
 <<Expr tests: public test>>=
   public :: subevt_expr_test
 <<Expr tests: test driver>>=
   subroutine subevt_expr_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Expr tests: execute tests>>
 end subroutine subevt_expr_test
 
 @ %def subevt_expr_test
 @
 \subsubsection{Parton-event expressions}
 <<Expr tests: execute tests>>=
   call test (subevt_expr_1, "subevt_expr_1", &
        "parton-event expressions", &
        u, results)
 <<Expr tests: test declarations>>=
   public :: subevt_expr_1
 <<Expr tests: tests>>=
   subroutine subevt_expr_1 (u)
     integer, intent(in) :: u
     type(string_t) :: expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: pt_cuts, pt_scale, pt_fac_scale, pt_ren_scale
     type(parse_tree_t) :: pt_weight
     type(parse_node_t), pointer :: pn_cuts, pn_scale, pn_fac_scale, pn_ren_scale
     type(parse_node_t), pointer :: pn_weight
     type(eval_tree_factory_t) :: expr_factory
     type(os_data_t) :: os_data
     type(model_t), target :: model
     type(parton_expr_t), target :: expr
     real(default) :: E, Ex, m
     type(vector4_t), dimension(6) :: p
     integer :: i, pdg
     logical :: passed
     real(default) :: scale, fac_scale, ren_scale, weight
 
     write (u, "(A)")  "* Test output: subevt_expr_1"
     write (u, "(A)")  "*   Purpose: Set up a subevt and associated &
          &process-specific expressions"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model%read (var_str ("Test.mdl"), os_data)
 
     write (u, "(A)")  "* Expression texts"
     write (u, "(A)")
 
 
     expr_text = "all Pt > 100 [s]"
     write (u, "(A,A)")  "cuts = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (pt_cuts, stream, .true.)
     call stream_final (stream)
     pn_cuts => pt_cuts%get_root_ptr ()
 
     expr_text = "sqrts"
     write (u, "(A,A)")  "scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_scale, stream, .true.)
     call stream_final (stream)
     pn_scale => pt_scale%get_root_ptr ()
 
     expr_text = "sqrts_hat"
     write (u, "(A,A)")  "fac_scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_fac_scale, stream, .true.)
     call stream_final (stream)
     pn_fac_scale => pt_fac_scale%get_root_ptr ()
 
     expr_text = "100"
     write (u, "(A,A)")  "ren_scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_ren_scale, stream, .true.)
     call stream_final (stream)
     pn_ren_scale => pt_ren_scale%get_root_ptr ()
 
     expr_text = "n_tot - n_in - n_out"
     write (u, "(A,A)")  "weight = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_weight, stream, .true.)
     call stream_final (stream)
     pn_weight => pt_weight%get_root_ptr ()
 
     call ifile_final (ifile)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize process expr"
     write (u, "(A)")
 
     call expr%setup_vars (1000._default)
     call expr%var_list%append_real (var_str ("tolerance"), 0._default)
     call expr%link_var_list (model%get_var_list_ptr ())
 
     call expr_factory%init (pn_cuts)
     call expr%setup_selection (expr_factory)
     call expr_factory%init (pn_scale)
     call expr%setup_scale (expr_factory)
     call expr_factory%init (pn_fac_scale)
     call expr%setup_fac_scale (expr_factory)
     call expr_factory%init (pn_ren_scale)
     call expr%setup_ren_scale (expr_factory)
     call expr_factory%init (pn_weight)
     call expr%setup_weight (expr_factory)
 
     call write_separator (u)
     call expr%write (u)
     call write_separator (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Fill subevt and evaluate expressions"
     write (u, "(A)")
 
     call subevt_init (expr%subevt_t, 6)
     E = 500._default
     Ex = 400._default
     m = 125._default
     pdg = 25
     p(1) = vector4_moving (E, sqrt (E**2 - m**2), 3)
     p(2) = vector4_moving (E, -sqrt (E**2 - m**2), 3)
     p(3) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 3)
     p(4) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 3)
     p(5) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 1)
     p(6) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 1)
 
     call expr%reset_contents ()
     do i = 1, 2
        call subevt_set_beam (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     do i = 3, 4
        call subevt_set_incoming (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     do i = 5, 6
        call subevt_set_outgoing (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
     expr%n_in = 2
     expr%n_out = 2
     expr%n_tot = 4
     expr%subevt_filled = .true.
 
     call expr%evaluate (passed, scale, fac_scale, ren_scale, weight)
 
     write (u, "(A,L1)")      "Event has passed      = ", passed
     write (u, "(A," // FMT_12 // ")")  "Scale                 = ", scale
     write (u, "(A," // FMT_12 // ")")  "Factorization scale   = ", fac_scale
     write (u, "(A," // FMT_12 // ")")  "Renormalization scale = ", ren_scale
     write (u, "(A," // FMT_12 // ")")  "Weight                = ", weight
     write (u, "(A)")
 
     call write_separator (u)
     call expr%write (u)
     call write_separator (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call expr%final ()
 
     call model%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: subevt_expr_1"
 
   end subroutine subevt_expr_1
 
 @ %def subevt_expr_1
 @
 \subsubsection{Parton-event expressions}
 <<Expr tests: execute tests>>=
   call test (subevt_expr_2, "subevt_expr_2", &
        "parton-event expressions", &
        u, results)
 <<Expr tests: test declarations>>=
   public :: subevt_expr_2
 <<Expr tests: tests>>=
   subroutine subevt_expr_2 (u)
     integer, intent(in) :: u
     type(string_t) :: expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: pt_selection
     type(parse_tree_t) :: pt_reweight, pt_analysis
     type(parse_node_t), pointer :: pn_selection
     type(parse_node_t), pointer :: pn_reweight, pn_analysis
     type(os_data_t) :: os_data
     type(model_t), target :: model
     type(eval_tree_factory_t) :: expr_factory
     type(event_expr_t), target :: expr
     real(default) :: E, Ex, m
     type(vector4_t), dimension(6) :: p
     integer :: i, pdg
     logical :: passed
     real(default) :: reweight
     logical :: analysis_flag
 
     write (u, "(A)")  "* Test output: subevt_expr_2"
     write (u, "(A)")  "*   Purpose: Set up a subevt and associated &
          &process-specific expressions"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model%read (var_str ("Test.mdl"), os_data)
 
     write (u, "(A)")  "* Expression texts"
     write (u, "(A)")
 
 
     expr_text = "all Pt > 100 [s]"
     write (u, "(A,A)")  "selection = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (pt_selection, stream, .true.)
     call stream_final (stream)
     pn_selection => pt_selection%get_root_ptr ()
 
     expr_text = "n_tot - n_in - n_out"
     write (u, "(A,A)")  "reweight = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_reweight, stream, .true.)
     call stream_final (stream)
     pn_reweight => pt_reweight%get_root_ptr ()
 
     expr_text = "true"
     write (u, "(A,A)")  "analysis = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (pt_analysis, stream, .true.)
     call stream_final (stream)
     pn_analysis => pt_analysis%get_root_ptr ()
 
     call ifile_final (ifile)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize process expr"
     write (u, "(A)")
 
     call expr%setup_vars (1000._default)
     call expr%link_var_list (model%get_var_list_ptr ())
     call expr%var_list%append_real (var_str ("tolerance"), 0._default)
 
     call expr_factory%init (pn_selection)
     call expr%setup_selection (expr_factory)
     call expr_factory%init (pn_analysis)
     call expr%setup_analysis (expr_factory)
     call expr_factory%init (pn_reweight)
     call expr%setup_reweight (expr_factory)
 
     call write_separator (u)
     call expr%write (u)
     call write_separator (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Fill subevt and evaluate expressions"
     write (u, "(A)")
 
     call subevt_init (expr%subevt_t, 6)
     E = 500._default
     Ex = 400._default
     m = 125._default
     pdg = 25
     p(1) = vector4_moving (E, sqrt (E**2 - m**2), 3)
     p(2) = vector4_moving (E, -sqrt (E**2 - m**2), 3)
     p(3) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 3)
     p(4) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 3)
     p(5) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 1)
     p(6) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 1)
 
     call expr%reset_contents ()
     do i = 1, 2
        call subevt_set_beam (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     do i = 3, 4
        call subevt_set_incoming (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     do i = 5, 6
        call subevt_set_outgoing (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
     expr%n_in = 2
     expr%n_out = 2
     expr%n_tot = 4
     expr%subevt_filled = .true.
 
     call expr%evaluate (passed, reweight, analysis_flag)
 
     write (u, "(A,L1)")      "Event has passed      = ", passed
     write (u, "(A," // FMT_12 // ")")  "Reweighting factor    = ", reweight
     write (u, "(A,L1)")      "Analysis flag         = ", analysis_flag
     write (u, "(A)")
 
     call write_separator (u)
     call expr%write (u)
     call write_separator (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call expr%final ()
 
     call model%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: subevt_expr_2"
 
   end subroutine subevt_expr_2
 
 @ %def subevt_expr_2
 @
 \subsubsection{Processes: handle partonic cuts}
 Initialize a process and process instance, choose a sampling point and
 fill the process instance, evaluating a given cut configuration.
 
 We use the same trivial process as for the previous test.  All
 momentum and state dependence is trivial, so we just test basic
 functionality.
 <<Expr tests: execute tests>>=
   call test (processes_5, "processes_5", &
        "handle cuts (partonic event)", &
        u, results)
 <<Expr tests: test declarations>>=
   public :: processes_5
 <<Expr tests: tests>>=
   subroutine processes_5 (u)
     integer, intent(in) :: u
     type(string_t) :: cut_expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: parse_tree
     type(eval_tree_factory_t) :: expr_factory
     type(process_library_t), target :: lib
     type(string_t) :: libname
     type(string_t) :: procname
     type(os_data_t) :: os_data
     type(model_t), pointer :: model_tmp
     type(model_t), pointer :: model
     type(var_list_t), target :: var_list
     type(process_t), allocatable, target :: process
     class(phs_config_t), allocatable :: phs_config_template
     real(default) :: sqrts
     type(process_instance_t), allocatable, target :: process_instance
 
     write (u, "(A)")  "* Test output: processes_5"
     write (u, "(A)")  "*   Purpose: create a process &
          &and fill a process instance"
     write (u, "(A)")
 
     write (u, "(A)")  "* Prepare a cut expression"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
     cut_expr_text = "all Pt > 100 [s]"
     call ifile_append (ifile, cut_expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (parse_tree, stream, .true.)
 
     write (u, "(A)")  "* Build and initialize a test process"
     write (u, "(A)")
 
     libname = "processes5"
     procname = libname
 
     call os_data%init ()
     call prc_test_create_library (libname, lib)
 
     call syntax_model_file_init ()
     allocate (model_tmp)
     call model_tmp%read (var_str ("Test.mdl"), os_data)
     call var_list%init_snapshot (model_tmp%get_var_list_ptr ())
     model => model_tmp
 
     call reset_interaction_counter ()
 
     call var_list%append_real (var_str ("tolerance"), 0._default)
     call var_list%append_log (var_str ("?alphas_is_fixed"), .true.)
     call var_list%append_int (var_str ("seed"), 0)
 
     allocate (process)
     call process%init (procname, lib, os_data, model, var_list)
 
     call var_list%final ()
 
     allocate (phs_test_config_t :: phs_config_template)
     call process%setup_test_cores ()
     call process%init_components (phs_config_template)
 
     write (u, "(A)")  "* Prepare a trivial beam setup"
     write (u, "(A)")
 
     sqrts = 1000
     call process%setup_beams_sqrts (sqrts, i_core = 1)
     call process%configure_phs ()
     call process%setup_mci (dispatch_mci_empty)
 
     write (u, "(A)")  "* Complete process initialization and set cuts"
     write (u, "(A)")
 
     call process%setup_terms ()
     call expr_factory%init (parse_tree%get_root_ptr ())
     call process%set_cuts (expr_factory)
     call process%write (.false., u, &
          show_var_list=.true., show_expressions=.true., show_os_data=.false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Create a process instance"
     write (u, "(A)")
 
     allocate (process_instance)
     call process_instance%init (process)
 
     write (u, "(A)")
     write (u, "(A)")  "* Inject a set of random numbers"
     write (u, "(A)")
 
     call process_instance%choose_mci (1)
     call process_instance%set_mcpar ([0._default, 0._default])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set up kinematics and subevt, check cuts (should fail)"
     write (u, "(A)")
 
     call process_instance%select_channel (1)
     call process_instance%compute_seed_kinematics ()
     call process_instance%compute_hard_kinematics ()
     call process_instance%compute_eff_kinematics ()
     call process_instance%evaluate_expressions ()
     call process_instance%compute_other_channels ()
 
     call process_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for another set (should succeed)"
     write (u, "(A)")
 
     call process_instance%reset ()
     call process_instance%set_mcpar ([0.5_default, 0.125_default])
     call process_instance%select_channel (1)
     call process_instance%compute_seed_kinematics ()
     call process_instance%compute_hard_kinematics ()
     call process_instance%compute_eff_kinematics ()
     call process_instance%evaluate_expressions ()
     call process_instance%compute_other_channels ()
     call process_instance%evaluate_trace ()
 
     call process_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for another set using convenience procedure &
          &(failure)"
     write (u, "(A)")
 
     call process_instance%evaluate_sqme (1, [0.0_default, 0.2_default])
 
     call process_instance%write_header (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for another set using convenience procedure &
          &(success)"
     write (u, "(A)")
 
     call process_instance%evaluate_sqme (1, [0.1_default, 0.2_default])
 
     call process_instance%write_header (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call process_instance%final ()
     deallocate (process_instance)
 
     call process%final ()
     deallocate (process)
 
     call parse_tree_final (parse_tree)
     call stream_final (stream)
     call ifile_final (ifile)
     call syntax_pexpr_final ()
 
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: processes_5"
 
   end subroutine processes_5
 
 @ %def processes_5
 @ Trivial for testing: do not allocate the MCI record.
 <<Expr tests: test auxiliary>>=
   subroutine dispatch_mci_empty (mci, var_list, process_id, is_nlo)
     class(mci_t), allocatable, intent(out) :: mci
     type(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: process_id
     logical, intent(in), optional :: is_nlo
   end subroutine dispatch_mci_empty
 
 @ %def dispatch_mci_empty
 @
 \subsubsection{Processes: scales and such}
 Initialize a process and process instance, choose a sampling point and
 fill the process instance, evaluating a given cut configuration.
 
 We use the same trivial process as for the previous test.  All
 momentum and state dependence is trivial, so we just test basic
 functionality.
 <<Expr tests: execute tests>>=
   call test (processes_6, "processes_6", &
        "handle scales and weight (partonic event)", &
        u, results)
 <<Expr tests: test declarations>>=
   public :: processes_6
 <<Expr tests: tests>>=
   subroutine processes_6 (u)
     integer, intent(in) :: u
     type(string_t) :: expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: pt_scale, pt_fac_scale, pt_ren_scale, pt_weight
     type(process_library_t), target :: lib
     type(string_t) :: libname
     type(string_t) :: procname
     type(os_data_t) :: os_data
     type(model_t), pointer :: model_tmp
     type(model_t), pointer :: model
     type(var_list_t), target :: var_list
     type(process_t), allocatable, target :: process
     class(phs_config_t), allocatable :: phs_config_template
     real(default) :: sqrts
     type(process_instance_t), allocatable, target :: process_instance
     type(eval_tree_factory_t) :: expr_factory
 
     write (u, "(A)")  "* Test output: processes_6"
     write (u, "(A)")  "*   Purpose: create a process &
          &and fill a process instance"
     write (u, "(A)")
 
     write (u, "(A)")  "* Prepare expressions"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
 
     expr_text = "sqrts - 100 GeV"
     write (u, "(A,A)")  "scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_scale, stream, .true.)
     call stream_final (stream)
 
     expr_text = "sqrts_hat"
     write (u, "(A,A)")  "fac_scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_fac_scale, stream, .true.)
     call stream_final (stream)
 
     expr_text = "eval sqrt (M2) [collect [s]]"
     write (u, "(A,A)")  "ren_scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_ren_scale, stream, .true.)
     call stream_final (stream)
 
     expr_text = "n_tot * n_in * n_out * (eval Phi / pi [s])"
     write (u, "(A,A)")  "weight = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_weight, stream, .true.)
     call stream_final (stream)
 
     call ifile_final (ifile)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build and initialize a test process"
     write (u, "(A)")
 
     libname = "processes4"
     procname = libname
 
     call os_data%init ()
     call prc_test_create_library (libname, lib)
 
     call syntax_model_file_init ()
     allocate (model_tmp)
     call model_tmp%read (var_str ("Test.mdl"), os_data)
     call var_list%init_snapshot (model_tmp%get_var_list_ptr ())
     model => model_tmp
 
     call var_list%append_log (var_str ("?alphas_is_fixed"), .true.)
     call var_list%append_int (var_str ("seed"), 0)
 
     call reset_interaction_counter ()
 
     allocate (process)
     call process%init (procname, lib, os_data, model, var_list)
 
     call var_list%final ()
 
     call process%setup_test_cores ()
     allocate (phs_test_config_t :: phs_config_template)
     call process%init_components (phs_config_template)
 
     write (u, "(A)")  "* Prepare a trivial beam setup"
     write (u, "(A)")
 
     sqrts = 1000
     call process%setup_beams_sqrts (sqrts, i_core = 1)
     call process%configure_phs ()
     call process%setup_mci (dispatch_mci_empty)
 
     write (u, "(A)")  "* Complete process initialization and set cuts"
     write (u, "(A)")
 
     call process%setup_terms ()
     call expr_factory%init (pt_scale%get_root_ptr ())
     call process%set_scale (expr_factory)
     call expr_factory%init (pt_fac_scale%get_root_ptr ())
     call process%set_fac_scale (expr_factory)
     call expr_factory%init (pt_ren_scale%get_root_ptr ())
     call process%set_ren_scale (expr_factory)
     call expr_factory%init (pt_weight%get_root_ptr ())
     call process%set_weight (expr_factory)
     call process%write (.false., u, show_expressions=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Create a process instance and evaluate"
     write (u, "(A)")
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%choose_mci (1)
     call process_instance%evaluate_sqme (1, [0.5_default, 0.125_default])
 
     call process_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call process_instance%final ()
     deallocate (process_instance)
 
     call process%final ()
     deallocate (process)
 
     call parse_tree_final (pt_scale)
     call parse_tree_final (pt_fac_scale)
     call parse_tree_final (pt_ren_scale)
     call parse_tree_final (pt_weight)
     call syntax_pexpr_final ()
 
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: processes_6"
 
   end subroutine processes_6
 
 @ %def processes_6
 @
 \subsubsection{Event expressions}
 After generating an event, fill the [[subevt]] and evaluate expressions for
 selection, reweighting, and analysis.
 <<Expr tests: execute tests>>=
   call test (events_3, "events_3", &
        "expression evaluation", &
        u, results)
 <<Expr tests: test declarations>>=
   public :: events_3
 <<Expr tests: tests>>=
   subroutine events_3 (u)
     use processes_ut, only: prepare_test_process, cleanup_test_process
     integer, intent(in) :: u
     type(string_t) :: expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: pt_selection, pt_reweight, pt_analysis
     type(eval_tree_factory_t) :: expr_factory
     type(event_t), allocatable, target :: event
     type(process_t), allocatable, target :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(os_data_t) :: os_data
     type(model_t), pointer :: model
     type(var_list_t), target :: var_list
 
     write (u, "(A)")  "* Test output: events_3"
     write (u, "(A)")  "*   Purpose: generate an event and evaluate expressions"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
 
     write (u, "(A)")  "* Expression texts"
     write (u, "(A)")
 
     expr_text = "all Pt > 100 [s]"
     write (u, "(A,A)")  "selection = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (pt_selection, stream, .true.)
     call stream_final (stream)
 
     expr_text = "1 + sqrts_hat / sqrts"
     write (u, "(A,A)")  "reweight = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_reweight, stream, .true.)
     call stream_final (stream)
 
     expr_text = "true"
     write (u, "(A,A)")  "analysis = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (pt_analysis, stream, .true.)
     call stream_final (stream)
 
     call ifile_final (ifile)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize test process event"
 
     call os_data%init ()
 
     call syntax_model_file_init ()
     allocate (model)
     call model%read (var_str ("Test.mdl"), os_data)
     call var_list%init_snapshot (model%get_var_list_ptr ())
 
     call var_list%append_log (var_str ("?alphas_is_fixed"), .true.)
     call var_list%append_int (var_str ("seed"), 0)
 
     allocate (process)
     allocate (process_instance)
     call prepare_test_process (process, process_instance, model, var_list)
 
     call var_list%final ()
 
     call process_instance%setup_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize event object and set expressions"
 
     allocate (event)
     call event%basic_init ()
 
     call expr_factory%init (pt_selection%get_root_ptr ())
     call event%set_selection (expr_factory)
     call expr_factory%init (pt_reweight%get_root_ptr ())
     call event%set_reweight (expr_factory)
     call expr_factory%init (pt_analysis%get_root_ptr ())
     call event%set_analysis (expr_factory)
 
     call event%connect (process_instance, process%get_model_ptr ())
     call event%expr%var_list%append_real (var_str ("tolerance"), 0._default)
     call event%setup_expressions ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate test process event"
 
     call process_instance%generate_weighted_event (1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Fill event object and evaluate expressions"
     write (u, "(A)")
 
     call event%generate (1, [0.4_default, 0.4_default])
     call event%set_index (42)
     call event%evaluate_expressions ()
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call event%final ()
     deallocate (event)
 
     call cleanup_test_process (process, process_instance)
     deallocate (process_instance)
     deallocate (process)
 
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: events_3"
 
   end subroutine events_3
 
 @ %def events_3
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Top Level}
 
 The top level consists of
 \begin{description}
 \item[commands]
   Defines generic command-list and command objects, and all specific
   implementations.  Each command type provides a specific
   functionality.  Together with the modules that provide expressions
   and variables, this module defines the Sindarin language.
 \item[whizard]
   This module interprets streams of various kind in terms of the
   command language.  It also contains the unit-test feature.  We also
   define the externally visible procedures here, for the \whizard\ as
   a library.
 \item[main]
   The driver for \whizard\ as a stand-alone program.  Contains the
   command-line interpreter.
 \item[whizard\_c\_interface]
   Alternative top-level procedures, for use in the context of a
   C-compatible caller program.
 \end{description}
 
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Commands}
 This module defines the command language of the main input file.
 <<[[commands.f90]]>>=
 <<File header>>
 
 module commands
 
 <<Use kinds>>
 <<Use strings>>
 <<Use debug>>
   use io_units
   use string_utils, only: lower_case, split_string, str
   use format_utils, only: write_indent
   use format_defs, only: FMT_14, FMT_19
   use diagnostics
 
   use physics_defs
   use sorting
   use sf_lhapdf, only: lhapdf_global_reset
   use os_interface
   use ifiles
   use lexers
   use syntax_rules
   use parser
   use analysis
   use pdg_arrays
   use variables, only: var_list_t, V_NONE, V_LOG, V_INT, V_REAL, V_CMPLX, V_STR, V_PDG
   use observables, only: var_list_check_observable
   use observables, only: var_list_check_result_var
   use eval_trees
   use models
   use auto_components
   use flavors
   use polarizations
   use particle_specifiers
   use process_libraries
   use process
   use instances
   use prclib_stacks
   use slha_interface
   use user_files
   use eio_data
   use rt_data
 
   use process_configurations
   use compilations, only: compile_library, compile_executable
   use integrations, only: integrate_process
   use restricted_subprocesses, only: get_libname_res
   use restricted_subprocesses, only: spawn_resonant_subprocess_libraries
   use event_streams
   use simulations
 
   use radiation_generator
 
 <<Use mpi f08>>
 
 <<Standard module head>>
 
 <<Commands: public>>
 
 <<Commands: types>>
 
 <<Commands: variables>>
 
 <<Commands: parameters>>
 
 <<Commands: interfaces>>
 
 contains
 
 <<Commands: procedures>>
 
 end module commands
 @ %def commands
 @
 \subsection{The command type}
 The command type is a generic type that holds any command, compiled
 for execution.
 
 Each command may come with its own local environment.  The command list that
 determines this environment is allocated as [[options]], if necessary.  (It
 has to be allocated as a pointer because the type definition is recursive.) The
 local environment is available as a pointer which either points to the global
 environment, or is explicitly allocated and initialized.
 <<Commands: types>>=
   type, abstract :: command_t
      type(parse_node_t), pointer :: pn => null ()
      class(command_t), pointer :: next => null ()
      type(parse_node_t), pointer :: pn_opt => null ()
      type(command_list_t), pointer :: options => null ()
      type(rt_data_t), pointer :: local => null ()
    contains
    <<Commands: command: TBP>>
   end type command_t
 
 @ %def command_t
 @ Finalizer: If there is an option list, finalize the option list and
 deallocate.  If not, the local environment is just a pointer.
 <<Commands: command: TBP>>=
   procedure :: final => command_final
 <<Commands: procedures>>=
   recursive subroutine command_final (cmd)
     class(command_t), intent(inout) :: cmd
     if (associated (cmd%options)) then
        call cmd%options%final ()
        deallocate (cmd%options)
        call cmd%local%local_final ()
        deallocate (cmd%local)
     else
        cmd%local => null ()
     end if
   end subroutine command_final
 
 @ %def command_final
 @ Allocate a command with the appropriate concrete type.  Store the
 parse node pointer in the command object, so we can reference to it
 when compiling.
 <<Commands: procedures>>=
   subroutine dispatch_command (command, pn)
     class(command_t), intent(inout), pointer :: command
     type(parse_node_t), intent(in), target :: pn
     select case (char (parse_node_get_rule_key (pn)))
     case ("cmd_model")
        allocate (cmd_model_t :: command)
     case ("cmd_library")
        allocate (cmd_library_t :: command)
     case ("cmd_process")
        allocate (cmd_process_t :: command)
     case ("cmd_nlo")
        allocate (cmd_nlo_t :: command)
     case ("cmd_compile")
        allocate (cmd_compile_t :: command)
     case ("cmd_exec")
        allocate (cmd_exec_t :: command)
      case ("cmd_num", "cmd_complex", "cmd_real", "cmd_int", &
            "cmd_log_decl", "cmd_log", "cmd_string", "cmd_string_decl", &
            "cmd_alias", "cmd_result")
        allocate (cmd_var_t :: command)
     case ("cmd_slha")
        allocate (cmd_slha_t :: command)
     case ("cmd_show")
        allocate (cmd_show_t :: command)
     case ("cmd_clear")
        allocate (cmd_clear_t :: command)
     case ("cmd_expect")
        allocate (cmd_expect_t :: command)
     case ("cmd_beams")
        allocate (cmd_beams_t :: command)
     case ("cmd_beams_pol_density")
        allocate (cmd_beams_pol_density_t :: command)
     case ("cmd_beams_pol_fraction")
        allocate (cmd_beams_pol_fraction_t :: command)
     case ("cmd_beams_momentum")
        allocate (cmd_beams_momentum_t :: command)
     case ("cmd_beams_theta")
        allocate (cmd_beams_theta_t :: command)
     case ("cmd_beams_phi")
        allocate (cmd_beams_phi_t :: command)
     case ("cmd_cuts")
        allocate (cmd_cuts_t :: command)
     case ("cmd_scale")
        allocate (cmd_scale_t :: command)
     case ("cmd_fac_scale")
        allocate (cmd_fac_scale_t :: command)
     case ("cmd_ren_scale")
        allocate (cmd_ren_scale_t :: command)
     case ("cmd_weight")
        allocate (cmd_weight_t :: command)
     case ("cmd_selection")
        allocate (cmd_selection_t :: command)
     case ("cmd_reweight")
        allocate (cmd_reweight_t :: command)
     case ("cmd_iterations")
        allocate (cmd_iterations_t :: command)
     case ("cmd_integrate")
        allocate (cmd_integrate_t :: command)
     case ("cmd_observable")
        allocate (cmd_observable_t :: command)
     case ("cmd_histogram")
        allocate (cmd_histogram_t :: command)
     case ("cmd_plot")
        allocate (cmd_plot_t :: command)
     case ("cmd_graph")
        allocate (cmd_graph_t :: command)
     case ("cmd_record")
        allocate (cmd_record_t :: command)
     case ("cmd_analysis")
        allocate (cmd_analysis_t :: command)
     case ("cmd_alt_setup")
        allocate (cmd_alt_setup_t :: command)
     case ("cmd_unstable")
        allocate (cmd_unstable_t :: command)
     case ("cmd_stable")
        allocate (cmd_stable_t :: command)
     case ("cmd_polarized")
        allocate (cmd_polarized_t :: command)
     case ("cmd_unpolarized")
        allocate (cmd_unpolarized_t :: command)
     case ("cmd_sample_format")
        allocate (cmd_sample_format_t :: command)
     case ("cmd_simulate")
        allocate (cmd_simulate_t :: command)
     case ("cmd_rescan")
        allocate (cmd_rescan_t :: command)
     case ("cmd_write_analysis")
        allocate (cmd_write_analysis_t :: command)
     case ("cmd_compile_analysis")
        allocate (cmd_compile_analysis_t :: command)
     case ("cmd_open_out")
        allocate (cmd_open_out_t :: command)
     case ("cmd_close_out")
        allocate (cmd_close_out_t :: command)
     case ("cmd_printf")
        allocate (cmd_printf_t :: command)
     case ("cmd_scan")
        allocate (cmd_scan_t :: command)
     case ("cmd_if")
        allocate (cmd_if_t :: command)
     case ("cmd_include")
        allocate (cmd_include_t :: command)
     case ("cmd_export")
        allocate (cmd_export_t :: command)
     case ("cmd_quit")
        allocate (cmd_quit_t :: command)
     case default
        print *, char (parse_node_get_rule_key (pn))
        call msg_bug ("Command not implemented")
     end select
     command%pn => pn
   end subroutine dispatch_command
 
 @ %def dispatch_command
 @ Output.  We allow for indentation so we can display a command tree.
 <<Commands: command: TBP>>=
   procedure (command_write), deferred :: write
 <<Commands: interfaces>>=
   abstract interface
      subroutine command_write (cmd, unit, indent)
        import
        class(command_t), intent(in) :: cmd
        integer, intent(in), optional :: unit, indent
      end subroutine command_write
   end interface
 
 @ %def command_write
 @ Compile a command.  The command type is already fixed, so this is a
 deferred type-bound procedure.
 <<Commands: command: TBP>>=
   procedure (command_compile), deferred :: compile
 <<Commands: interfaces>>=
   abstract interface
      subroutine command_compile (cmd, global)
        import
        class(command_t), intent(inout) :: cmd
        type(rt_data_t), intent(inout), target :: global
      end subroutine command_compile
   end interface
 
 @ %def command_compile
 @ Execute a command.  This will use and/or modify the runtime data
 set.  If the [[quit]] flag is set, the caller should terminate command
 execution.
 <<Commands: command: TBP>>=
   procedure (command_execute), deferred :: execute
 <<Commands: interfaces>>=
   abstract interface
      subroutine command_execute (cmd, global)
        import
        class(command_t), intent(inout) :: cmd
        type(rt_data_t), intent(inout), target :: global
      end subroutine command_execute
   end interface
 
 @ %def command_execute
 @
 \subsection{Options}
 The [[options]] command list is allocated, initialized, and executed, if the
 command is associated with an option text in curly braces.  If present, a
 separate local runtime data set [[local]] will be allocated and initialized;
 otherwise, [[local]] becomes a pointer to the global dataset.
 
 For output, we indent the options list.
 <<Commands: command: TBP>>=
   procedure :: write_options => command_write_options
 <<Commands: procedures>>=
   recursive subroutine command_write_options (cmd, unit, indent)
     class(command_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: ind
     ind = 1;  if (present (indent))  ind = indent + 1
     if (associated (cmd%options))  call cmd%options%write (unit, ind)
   end subroutine command_write_options
 
 @ %def command_write_options
 @ Compile the options list, if any.  This implies initialization of the local
 environment.  Should be done once the [[pn_opt]] node has been assigned (if
 applicable), but before the actual command compilation.
 <<Commands: command: TBP>>=
   procedure :: compile_options => command_compile_options
 <<Commands: procedures>>=
   recursive subroutine command_compile_options (cmd, global)
     class(command_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (associated (cmd%pn_opt)) then
        allocate (cmd%local)
        call cmd%local%local_init (global)
        call global%copy_globals (cmd%local)
        allocate (cmd%options)
        call cmd%options%compile (cmd%pn_opt, cmd%local)
        call global%restore_globals (cmd%local)
        call cmd%local%deactivate ()
     else
        cmd%local => global
     end if
   end subroutine command_compile_options
 
 @ %def command_compile_options
 @ Execute options.  First prepare the local environment, then execute the
 command list.
 <<Commands: command: TBP>>=
   procedure :: execute_options => cmd_execute_options
 <<Commands: procedures>>=
   recursive subroutine cmd_execute_options (cmd, global)
     class(command_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (associated (cmd%options)) then
        call cmd%local%activate ()
        call cmd%options%execute (cmd%local)
     end if
   end subroutine cmd_execute_options
 
 @ %def cmd_execute_options
 @ This must be called after the parent command has been executed, to undo
 temporary modifications to the environment.  Note that some modifications to
 [[global]] can become permanent.
 <<Commands: command: TBP>>=
   procedure :: reset_options => cmd_reset_options
 <<Commands: procedures>>=
   subroutine cmd_reset_options (cmd, global)
     class(command_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (associated (cmd%options)) then
        call cmd%local%deactivate (global)
     end if
   end subroutine cmd_reset_options
 
 @ %def cmd_reset_options
 @
 \subsection{Specific command types}
 \subsubsection{Model configuration}
 The command declares a model, looks for the specified file and loads
 it.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_model_t
      private
      type(string_t) :: name
      type(string_t) :: scheme
      logical :: ufo_model = .false.
      logical :: ufo_path_set = .false.
      type(string_t) :: ufo_path
    contains
    <<Commands: cmd model: TBP>>
   end type cmd_model_t
 
 @ %def cmd_model_t
 @ Output
 <<Commands: cmd model: TBP>>=
   procedure :: write => cmd_model_write
 <<Commands: procedures>>=
   subroutine cmd_model_write (cmd, unit, indent)
     class(cmd_model_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,'""',A,'""')", advance="no")  "model =", char (cmd%name)
     if (cmd%ufo_model) then
        if (cmd%ufo_path_set) then
           write (u, "(1x,A,A,A)")  "(ufo (", char (cmd%ufo_path), "))"
        else
           write (u, "(1x,A)")  "(ufo)"
        end if
     else if (cmd%scheme /= "") then
        write (u, "(1x,'(',A,')')")  char (cmd%scheme)
     else
        write (u, *)
     end if
   end subroutine cmd_model_write
 
 @ %def cmd_model_write
 @ Compile.  Get the model name and read the model from file, so it is
 readily available when the command list is executed.  If the model has a
 scheme argument, take this into account.
 
 Assign the model pointer in the [[global]] record, so it can be used for
 (read-only) variable lookup while compiling further commands.
 <<Commands: cmd model: TBP>>=
   procedure :: compile => cmd_model_compile
 <<Commands: procedures>>=
   subroutine cmd_model_compile (cmd, global)
     class(cmd_model_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_name, pn_arg, pn_scheme
     type(parse_node_t), pointer :: pn_ufo_arg, pn_path
     type(model_t), pointer :: model
     type(string_t) :: scheme
     pn_name => cmd%pn%get_sub_ptr (3)
     pn_arg => pn_name%get_next_ptr ()
     if (associated (pn_arg)) then
        pn_scheme => pn_arg%get_sub_ptr ()
     else
        pn_scheme => null ()
     end if
     cmd%name = pn_name%get_string ()
     if (associated (pn_scheme)) then
        select case (char (pn_scheme%get_rule_key ()))
        case ("ufo_spec")
           cmd%ufo_model = .true.
           pn_ufo_arg => pn_scheme%get_sub_ptr (2)
           if (associated (pn_ufo_arg)) then
              pn_path => pn_ufo_arg%get_sub_ptr ()
              cmd%ufo_path_set = .true.
              cmd%ufo_path = pn_path%get_string ()
           end if
        case default
           scheme = pn_scheme%get_string ()
     select case (char (lower_case (scheme)))
     case ("ufo");  cmd%ufo_model = .true.
           case default;  cmd%scheme = scheme
           end select
        end select
        if (cmd%ufo_model) then
           if (cmd%ufo_path_set) then
              call preload_ufo_model (model, cmd%name, cmd%ufo_path)
           else
              call preload_ufo_model (model, cmd%name)
           end if
        else
           call preload_model (model, cmd%name, cmd%scheme)
        end if
     else
        cmd%scheme = ""
        call preload_model (model, cmd%name)
     end if
     global%model => model
     if (associated (global%model)) then
        call global%model%link_var_list (global%var_list)
     end if
   contains
     subroutine preload_model (model, name, scheme)
       type(model_t), pointer, intent(out) :: model
       type(string_t), intent(in) :: name
       type(string_t), intent(in), optional :: scheme
       model => null ()
       if (associated (global%model)) then
          if (global%model%matches (name, scheme)) then
             model => global%model
          end if
       end if
       if (.not. associated (model)) then
          if (global%model_list%model_exists (name, scheme)) then
             model => global%model_list%get_model_ptr (name, scheme)
          else
             call global%read_model (name, model, scheme)
          end if
       end if
     end subroutine preload_model
     subroutine preload_ufo_model (model, name, ufo_path)
       type(model_t), pointer, intent(out) :: model
       type(string_t), intent(in) :: name
       type(string_t), intent(in), optional :: ufo_path
       model => null ()
       if (associated (global%model)) then
          if (global%model%matches (name, ufo=.true., ufo_path=ufo_path)) then
             model => global%model
          end if
       end if
       if (.not. associated (model)) then
          if (global%model_list%model_exists (name, &
               ufo=.true., ufo_path=ufo_path)) then
             model => global%model_list%get_model_ptr (name, &
                  ufo=.true., ufo_path=ufo_path)
          else
             call global%read_ufo_model (name, model, ufo_path=ufo_path)
          end if
       end if
     end subroutine preload_ufo_model
   end subroutine cmd_model_compile
 
 @ %def cmd_model_compile
 @ Execute: Insert a pointer into the global data record and reassign
 the variable list.
 <<Commands: cmd model: TBP>>=
   procedure :: execute => cmd_model_execute
 <<Commands: procedures>>=
   subroutine cmd_model_execute (cmd, global)
     class(cmd_model_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (cmd%ufo_model) then
        if (cmd%ufo_path_set) then
           call global%select_model (cmd%name, ufo=.true., ufo_path=cmd%ufo_path)
        else
           call global%select_model (cmd%name, ufo=.true.)
        end if
     else if (cmd%scheme /= "") then
        call global%select_model (cmd%name, cmd%scheme)
     else
        call global%select_model (cmd%name)
     end if
     if (.not. associated (global%model)) &
          call msg_fatal ("Switching to model '" &
          // char (cmd%name) // "': model not found")
   end subroutine cmd_model_execute
 
 @ %def cmd_model_execute
 @
 \subsubsection{Library configuration}
 We configure a process library that should hold the subsequently
 defined processes.  If the referenced library exists already, just
 make it the currently active one.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_library_t
      private
      type(string_t) :: name
    contains
    <<Commands: cmd library: TBP>>
   end type cmd_library_t
 
 @ %def cmd_library_t
 @ Output.
 <<Commands: cmd library: TBP>>=
   procedure :: write => cmd_library_write
 <<Commands: procedures>>=
   subroutine cmd_library_write (cmd, unit, indent)
     class(cmd_library_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit)
     call write_indent (u, indent)
     write (u, "(1x,A,1x,'""',A,'""')")  "library =", char (cmd%name)
   end subroutine cmd_library_write
 
 @ %def cmd_library_write
 @ Compile.  Get the library name.
 <<Commands: cmd library: TBP>>=
   procedure :: compile => cmd_library_compile
 <<Commands: procedures>>=
   subroutine cmd_library_compile (cmd, global)
     class(cmd_library_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_name
     pn_name => parse_node_get_sub_ptr (cmd%pn, 3)
     cmd%name = parse_node_get_string (pn_name)
   end subroutine cmd_library_compile
 
 @ %def cmd_library_compile
 @ Execute: Initialize a new library and push it on the library stack
 (if it does not yet exist).   Insert a pointer to the library into the
 global data record.  Then, try to load the library unless the
 [[rebuild]] flag is set.
 <<Commands: cmd library: TBP>>=
   procedure :: execute => cmd_library_execute
 <<Commands: procedures>>=
   subroutine cmd_library_execute (cmd, global)
     class(cmd_library_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     logical :: rebuild_library
     lib => global%prclib_stack%get_library_ptr (cmd%name)
     rebuild_library = &
          global%var_list%get_lval (var_str ("?rebuild_library"))
     if (.not. (associated (lib))) then
        allocate (lib_entry)
        call lib_entry%init (cmd%name)
        lib => lib_entry%process_library_t
        call global%add_prclib (lib_entry)
     else
        call global%update_prclib (lib)
     end if
     if (associated (lib) .and. .not. rebuild_library) then
        call lib%update_status (global%os_data)
     end if
   end subroutine cmd_library_execute
 
 @ %def cmd_library_execute
 @
 \subsubsection{Process configuration}
 We define a process-configuration command as a specific type.  The
 incoming and outgoing particles are given evaluation-trees which we
 transform to PDG-code arrays.  For transferring to \oMega, they are
 reconverted to strings.
 
 For the incoming particles, we store parse nodes individually.  We do
 not yet resolve the outgoing state, so we store just a single parse
 node.
 
 This also includes the choice of method for the corresponding process:
 [[omega]] for \oMega\ matrix elements as Fortran code, [[ovm]] for
 \oMega\ matrix elements as a bytecode virtual machine, [[test]] for
 special processes, [[unit_test]] for internal test matrix elements
 generated by \whizard, [[template]] and [[template_unity]] for test
 matrix elements generated by \whizard\ as Fortran code similar to the
 \oMega\ code. If the one-loop program (OLP) \gosam\ is linked, also
 matrix elements from there (at leading and next-to-leading order) can
 be generated via [[gosam]].
 <<Commands: types>>=
   type, extends (command_t) :: cmd_process_t
      private
      type(string_t) :: id
      integer :: n_in  = 0
      type(parse_node_p), dimension(:), allocatable :: pn_pdg_in
      type(parse_node_t), pointer :: pn_out => null ()
    contains
    <<Commands: cmd process: TBP>>
   end type cmd_process_t
 
 @ %def cmd_process_t
 @ Output.  The particle expressions are not resolved, so we just list the
 number of incoming particles.
 <<Commands: cmd process: TBP>>=
   procedure :: write => cmd_process_write
 <<Commands: procedures>>=
   subroutine cmd_process_write (cmd, unit, indent)
     class(cmd_process_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A,A,I0,A)")  "process: ", char (cmd%id), " (", &
          size (cmd%pn_pdg_in), " -> X)"
     call cmd%write_options (u, indent)
   end subroutine cmd_process_write
 
 @ %def cmd_process_write
 @ Compile.  Find and assign the parse nodes.
 <<Commands: cmd process: TBP>>=
   procedure :: compile => cmd_process_compile
 <<Commands: procedures>>=
   subroutine cmd_process_compile (cmd, global)
     class(cmd_process_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_id, pn_in, pn_codes
     integer :: i
     pn_id => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_in  => parse_node_get_next_ptr (pn_id, 2)
     cmd%pn_out => parse_node_get_next_ptr (pn_in, 2)
     cmd%pn_opt => parse_node_get_next_ptr (cmd%pn_out)
     call cmd%compile_options (global)
     cmd%id = parse_node_get_string (pn_id)
     cmd%n_in  = parse_node_get_n_sub (pn_in)
     pn_codes => parse_node_get_sub_ptr (pn_in)
     allocate (cmd%pn_pdg_in (cmd%n_in))
     do i = 1, cmd%n_in
        cmd%pn_pdg_in(i)%ptr => pn_codes
        pn_codes => parse_node_get_next_ptr (pn_codes)
     end do
   end subroutine cmd_process_compile
 
 @ %def cmd_process_compile
 @ Command execution.  Evaluate the subevents, transform PDG codes
 into strings, and add the current process configuration to the
 process library.
 
 The initial state will be unique (one or two particles).  For the final state,
 we allow for expressions.  The expressions will be expanded until we have a
 sum of final states.  Each distinct final state will get its own process
 component.
 
 To identify equivalent final states, we transform the final state into
 an array of PDG codes, which we sort and compare.  If a particle entry
 is actually a PDG array, only the first entry in the array is used for
 the comparison. The user should make sure that there is no overlap
 between different particles or arrays which would make the expansion
 ambiguous.
 
 There are two possibilities that a process contains more than
 component: by an explicit component statement by the user for
 inclusive processes, or by having one process at NLO level. The first
 option is determined in the routine [[scan_components]], and
 determines [[n_components]].
 <<Commands: cmd process: TBP>>=
   procedure :: execute => cmd_process_execute
 <<Commands: procedures>>=
   subroutine cmd_process_execute (cmd, global)
     class(cmd_process_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(pdg_array_t) :: pdg_in, pdg_out
     type(pdg_array_t), dimension(:), allocatable :: pdg_out_tab
     type(string_t), dimension(:), allocatable :: prt_in
     type(string_t) :: prt_out, prt_out1
     type(process_configuration_t) :: prc_config
     type(prt_expr_t) :: prt_expr_out
     type(prt_spec_t), dimension(:), allocatable :: prt_spec_in
     type(prt_spec_t), dimension(:), allocatable :: prt_spec_out
     type(var_list_t), pointer :: var_list
     integer, dimension(:), allocatable :: pdg
     integer, dimension(:), allocatable :: i_term
     integer, dimension(:), allocatable :: nlo_comp
     integer :: i, j, n_in, n_out, n_terms, n_components
     logical :: nlo_fixed_order
     logical :: qcd_corr, qed_corr
     type(string_t), dimension(:), allocatable :: prt_in_nlo, prt_out_nlo
     type(radiation_generator_t) :: radiation_generator
     type(pdg_list_t) :: pl_in, pl_out, pl_excluded_gauge_splittings
     type(string_t) :: method, born_me_method, loop_me_method, &
          correlation_me_method, real_tree_me_method, dglap_me_method
     integer, dimension(:), allocatable :: i_list
     logical :: use_real_finite
     logical :: gks_active
     logical :: initial_state_colored
     integer :: comp_mult
     integer :: gks_multiplicity
     integer :: n_components_init
     integer :: alpha_power, alphas_power
     logical :: requires_soft_mismatch, requires_dglap_remnants
     if (debug_on) call msg_debug (D_CORE, "cmd_process_execute")
     var_list => cmd%local%get_var_list_ptr ()
 
     n_in = size (cmd%pn_pdg_in)
     allocate (prt_in (n_in), prt_spec_in (n_in))
     do i = 1, n_in
        pdg_in = &
             eval_pdg_array (cmd%pn_pdg_in(i)%ptr, var_list)
        prt_in(i) = make_flavor_string (pdg_in, cmd%local%model)
        prt_spec_in(i) = new_prt_spec (prt_in(i))
     end do
     call compile_prt_expr &
          (prt_expr_out, cmd%pn_out, var_list, cmd%local%model)
     call prt_expr_out%expand ()
     call scan_components ()
     allocate (nlo_comp (n_components))
 
     nlo_fixed_order = cmd%local%nlo_fixed_order
     gks_multiplicity = var_list%get_ival (var_str ('gks_multiplicity'))
     gks_active = gks_multiplicity > 2
     call check_for_nlo_corrections ()
 
     method = var_list%get_sval (var_str ("$method"))
     born_me_method = var_list%get_sval (var_str ("$born_me_method"))
     if (born_me_method == var_str (""))  born_me_method = method
     use_real_finite = var_list%get_lval (var_str ('?nlo_use_real_partition'))
     if (nlo_fixed_order) then
        real_tree_me_method = &
             var_list%get_sval (var_str ("$real_tree_me_method"))
        if (real_tree_me_method == var_str ("")) &
             real_tree_me_method = method
        loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
        if (loop_me_method == var_str ("")) &
             loop_me_method = method
        correlation_me_method = &
             var_list%get_sval (var_str ("$correlation_me_method"))
        if (correlation_me_method == var_str ("")) &
             correlation_me_method = method
        dglap_me_method = var_list%get_sval (var_str ("$dglap_me_method"))
        if (dglap_me_method == var_str ("")) &
             dglap_me_method = method
        call check_nlo_options (cmd%local)
     end if
 
     call determine_needed_components ()
     call prc_config%init (cmd%id, n_in, n_components_init, &
          cmd%local%model, cmd%local%var_list, &
          nlo_process = nlo_fixed_order)
 
     alpha_power = var_list%get_ival (var_str ("alpha_power"))
     alphas_power = var_list%get_ival (var_str ("alphas_power"))
     call prc_config%set_coupling_powers (alpha_power, alphas_power)
 
     call setup_components ()
     call prc_config%record (cmd%local)
 
   contains
 
   <<Commands: cmd process execute procedures>>
 
   end subroutine cmd_process_execute
 
 @ %def cmd_process_execute
 @
 <<Commands: cmd process execute procedures>>=
   elemental function is_threshold (method)
     logical :: is_threshold
     type(string_t), intent(in) :: method
     is_threshold = method == var_str ("threshold")
   end function is_threshold
 
   subroutine check_threshold_consistency ()
     if (nlo_fixed_order .and. is_threshold (born_me_method)) then
        if (.not. (is_threshold (real_tree_me_method) .and. is_threshold (loop_me_method) &
             .and. is_threshold (correlation_me_method))) then
             print *, 'born: ', char (born_me_method)
             print *, 'real: ', char (real_tree_me_method)
             print *, 'loop: ', char (loop_me_method)
             print *, 'correlation: ', char (correlation_me_method)
             call msg_fatal ("Inconsistent methods: All components need to be threshold")
        end if
     end if
   end subroutine check_threshold_consistency
 
 @ %def check_threshold_consistency
 <<Commands: cmd process execute procedures>>=
   subroutine check_for_nlo_corrections ()
     type(string_t) :: nlo_correction_type
     type(pdg_array_t), dimension(:), allocatable :: pdg
     if (nlo_fixed_order .or. gks_active) then
        nlo_correction_type = &
             var_list%get_sval (var_str ('$nlo_correction_type'))
        select case (char(nlo_correction_type))
        case ("QCD")
           qcd_corr = .true.; qed_corr = .false.
        case ("EW")
           qcd_corr = .false.; qed_corr = .true.
        case ("Full")
           qcd_corr =.true.; qed_corr = .true.
        case default
           call msg_fatal ("Invalid NLO correction type! " // &
                "Valid inputs are: QCD, EW, Full (default: QCD)")
        end select
        call check_for_excluded_gauge_boson_splitting_partners ()
        call setup_radiation_generator ()
     end if
     if (nlo_fixed_order) then
        call radiation_generator%find_splittings ()
        if (debug2_active (D_CORE)) then
           print *, ''
           print *, 'Found (pdg) splittings: '
           do i = 1, radiation_generator%if_table%get_length ()
              call radiation_generator%if_table%get_pdg_out (i, pdg)
              call pdg_array_write_set (pdg)
              print *, '----------------'
           end do
        end if
 
        nlo_fixed_order = radiation_generator%contains_emissions ()
        if (.not. nlo_fixed_order) call msg_warning &
             (arr = [var_str ("No NLO corrections found for process ") // &
             cmd%id // var_str("."), var_str ("Proceed with usual " // &
             "leading-order integration and simulation")])
     end if
   end subroutine check_for_nlo_corrections
 
 @ %def check_for_nlo_corrections
 @
 <<Commands: cmd process execute procedures>>=
   subroutine check_for_excluded_gauge_boson_splitting_partners ()
     type(string_t) :: str_excluded_partners
     type(string_t), dimension(:), allocatable :: excluded_partners
     type(pdg_list_t) :: pl_tmp, pl_anti
     integer :: i, n_anti
     str_excluded_partners = var_list%get_sval &
          (var_str ("$exclude_gauge_splittings"))
     if (str_excluded_partners == "") then
        return
     else
        call split_string (str_excluded_partners, &
             var_str (":"), excluded_partners)
        call pl_tmp%init (size (excluded_partners))
        do i = 1, size (excluded_partners)
           call pl_tmp%set (i, &
                cmd%local%model%get_pdg (excluded_partners(i), .true.))
        end do
        call pl_tmp%create_antiparticles (pl_anti, n_anti)
        call pl_excluded_gauge_splittings%init (pl_tmp%get_size () + n_anti)
        do i = 1, pl_tmp%get_size ()
           call pl_excluded_gauge_splittings%set (i, pl_tmp%get(i))
        end do
        do i = 1, n_anti
           j = i + pl_tmp%get_size ()
           call pl_excluded_gauge_splittings%set (j, pl_anti%get(i))
        end do
     end if
   end subroutine check_for_excluded_gauge_boson_splitting_partners
 
 @ %def check_for_excluded_gauge_boson_splitting_partners
 @
 <<Commands: cmd process execute procedures>>=
   subroutine determine_needed_components ()
     type(string_t) :: fks_method
     comp_mult = 1
     if (nlo_fixed_order) then
        fks_method = var_list%get_sval (var_str ('$fks_mapping_type'))
        call check_threshold_consistency ()
        requires_soft_mismatch = fks_method == var_str ('resonances')
        comp_mult = needed_extra_components (requires_dglap_remnants, &
             use_real_finite, requires_soft_mismatch)
        allocate (i_list (comp_mult))
     else if (gks_active) then
        call radiation_generator%generate_multiple &
             (gks_multiplicity, cmd%local%model)
        comp_mult = radiation_generator%get_n_gks_states () + 1
     end if
     n_components_init = n_components * comp_mult
   end subroutine determine_needed_components
 
 @ %def determine_needed_components
 @
 <<Commands: cmd process execute procedures>>=
   subroutine setup_radiation_generator ()
     call split_prt (prt_spec_in, n_in, pl_in)
     call split_prt (prt_spec_out, n_out, pl_out)
     call radiation_generator%init (pl_in, pl_out, &
          pl_excluded_gauge_splittings, qcd = qcd_corr, qed = qed_corr)
     call radiation_generator%set_n (n_in, n_out, 0)
     initial_state_colored = pdg_in%has_colored_particles ()
     if ((n_in == 2 .and. initial_state_colored) .or. qed_corr) then
         requires_dglap_remnants = n_in == 2 .and. initial_state_colored
         call radiation_generator%set_initial_state_emissions ()
     else
        requires_dglap_remnants = .false.
     end if
     call radiation_generator%set_constraints (.false., .false., .true., .true.)
     call radiation_generator%setup_if_table (cmd%local%model)
   end subroutine setup_radiation_generator
 
 @ %def setup_radiation_generator
 @
 <<Commands: cmd process execute procedures>>=
   subroutine scan_components ()
     n_terms = prt_expr_out%get_n_terms ()
     allocate (pdg_out_tab (n_terms))
     allocate (i_term (n_terms), source = 0)
     n_components = 0
     SCAN: do i = 1, n_terms
        if (allocated (pdg))  deallocate (pdg)
        call prt_expr_out%term_to_array (prt_spec_out, i)
        n_out = size (prt_spec_out)
        allocate (pdg (n_out))
        do j = 1, n_out
           prt_out = prt_spec_out(j)%to_string ()
           call split (prt_out, prt_out1, ":")
           pdg(j) = cmd%local%model%get_pdg (prt_out1)
        end do
        pdg_out = sort (pdg)
        do j = 1, n_components
           if (pdg_out == pdg_out_tab(j))  cycle SCAN
        end do
        n_components = n_components + 1
        i_term(n_components) = i
        pdg_out_tab(n_components) = pdg_out
     end do SCAN
   end subroutine scan_components
 
 @
 <<Commands: cmd process execute procedures>>=
   subroutine split_prt (prt, n_out, pl)
     type(prt_spec_t), intent(in), dimension(:), allocatable :: prt
     integer, intent(in) :: n_out
     type(pdg_list_t), intent(out) :: pl
     type(pdg_array_t) :: pdg
     type(string_t) :: prt_string, prt_tmp
     integer, parameter :: max_particle_number = 25
     integer, dimension(max_particle_number) :: i_particle
     integer :: i, j, n
     i_particle = 0
     call pl%init (n_out)
     do i = 1, n_out
        n = 1
        prt_string = prt(i)%to_string ()
        do
          call split (prt_string, prt_tmp, ":")
          if (prt_tmp /= "") then
            i_particle(n) = cmd%local%model%get_pdg (prt_tmp)
            n = n + 1
          else
            exit
          end if
        end do
        call pdg_array_init (pdg, n - 1)
        do j = 1, n - 1
          call pdg%set (j, i_particle(j))
        end do
        call pl%set (i, pdg)
        call pdg_array_delete (pdg)
     end do
   end subroutine split_prt
 
 @ %def split_prt
 @
 <<Commands: cmd process execute procedures>>=
   subroutine setup_components()
     integer :: k, i_comp, add_index
     i_comp = 0
     add_index = 0
     if (debug_on) call msg_debug (D_CORE, "setup_components")
     do i = 1, n_components
        call prt_expr_out%term_to_array (prt_spec_out, i_term(i))
        if (nlo_fixed_order) then
           associate (selected_nlo_parts => cmd%local%selected_nlo_parts)
              if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
                   i_comp + 1)
              call prc_config%setup_component (i_comp + 1, &
                   prt_spec_in, prt_spec_out, &
                   cmd%local%model, var_list, BORN, &
                   can_be_integrated = selected_nlo_parts (BORN))
              call radiation_generator%generate_real_particle_strings &
                   (prt_in_nlo, prt_out_nlo)
              if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
                   i_comp + 2)
              call prc_config%setup_component (i_comp + 2, &
                   new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
                   cmd%local%model, var_list, NLO_REAL, &
                   can_be_integrated = selected_nlo_parts (NLO_REAL))
              if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
                   i_comp + 3)
              call prc_config%setup_component (i_comp + 3, &
                   prt_spec_in, prt_spec_out, &
                   cmd%local%model, var_list, NLO_VIRTUAL, &
                   can_be_integrated = selected_nlo_parts (NLO_VIRTUAL))
              if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
                   i_comp + 4)
              call prc_config%setup_component (i_comp + 4, &
                   prt_spec_in, prt_spec_out, &
                   cmd%local%model, var_list, NLO_SUBTRACTION, &
                   can_be_integrated = selected_nlo_parts (NLO_SUBTRACTION))
              do k = 1, 4
                 i_list(k) = i_comp + k
              end do
              if (requires_dglap_remnants) then
                 if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
                      i_comp + 5)
                 call prc_config%setup_component (i_comp + 5, &
                      prt_spec_in, prt_spec_out, &
                      cmd%local%model, var_list, NLO_DGLAP, &
                      can_be_integrated = selected_nlo_parts (NLO_DGLAP))
                 i_list(5) = i_comp + 5
                 add_index = add_index + 1
              end if
              if (use_real_finite) then
                 if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
                      i_comp + 5 + add_index)
                 call prc_config%setup_component (i_comp + 5 + add_index, &
                      new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
                      cmd%local%model, var_list, NLO_REAL, &
                      can_be_integrated = selected_nlo_parts (NLO_REAL))
                 i_list(5 + add_index) = i_comp + 5 + add_index
                 add_index = add_index + 1
              end if
              if (requires_soft_mismatch) then
                 if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
                      i_comp + 5 + add_index)
                 call prc_config%setup_component (i_comp + 5 + add_index, &
                    prt_spec_in, prt_spec_out, &
                    cmd%local%model, var_list, NLO_MISMATCH, &
                    can_be_integrated = selected_nlo_parts (NLO_MISMATCH))
                 i_list(5 + add_index) = i_comp + 5 + add_index
              end if
              call prc_config%set_component_associations (i_list, &
                   requires_dglap_remnants, use_real_finite, &
                   requires_soft_mismatch)
           end associate
        else if (gks_active) then
           call prc_config%setup_component (i_comp + 1, prt_spec_in, &
                prt_spec_out, cmd%local%model, var_list, BORN, &
                can_be_integrated = .true.)
           call radiation_generator%reset_queue ()
           do j = 1, comp_mult
              prt_out_nlo =  radiation_generator%get_next_state ()
              call prc_config%setup_component (i_comp + 1 + j, &
                 new_prt_spec (prt_in), new_prt_spec (prt_out_nlo), &
                 cmd%local%model, var_list, GKS, can_be_integrated = .false.)
           end do
        else
           call prc_config%setup_component (i, &
                prt_spec_in, prt_spec_out, &
                cmd%local%model, var_list, can_be_integrated = .true.)
        end if
        i_comp = i_comp + comp_mult
     end do
   end subroutine setup_components
 
 @
 @ These three functions should be bundled with the logicals they depend
 on into an object (the pcm?).
 <<Commands: procedures>>=
   subroutine check_nlo_options (local)
     type(rt_data_t), intent(in) :: local
     type(var_list_t), pointer :: var_list => null ()
     logical :: nlo, combined, powheg
     logical :: case_lo_but_any_other
     logical :: case_nlo_powheg_but_not_combined
     logical :: vamp_equivalences_enabled
     logical :: fixed_order_nlo_events
     var_list => local%get_var_list_ptr ()
     nlo = local%nlo_fixed_order
     combined = var_list%get_lval (var_str ('?combined_nlo_integration'))
     powheg = var_list%get_lval (var_str ('?powheg_matching'))
     case_lo_but_any_other = .not. nlo .and. any ([combined, powheg])
     case_nlo_powheg_but_not_combined = &
          nlo .and. powheg .and. .not. combined
     if (case_lo_but_any_other) then
        call msg_fatal ("Option mismatch: Leading order process is selected &
             &but either powheg_matching or combined_nlo_integration &
             &is set to true.")
     else if (case_nlo_powheg_but_not_combined) then
        call msg_fatal ("POWHEG requires the 'combined_nlo_integration'-option &
             &to be set to true.")
     end if
     fixed_order_nlo_events = &
          var_list%get_lval (var_str ('?fixed_order_nlo_events'))
     if (fixed_order_nlo_events .and. .not. combined .and. &
          all (local%selected_nlo_parts)) &
        call msg_fatal ("Option mismatch: Fixed order NLO events of the full ", &
             [var_str ("process are requested, but ?combined_nlo_integration"), &
             var_str ("is false. You can either switch to the combined NLO"), &
             var_str ("integration mode or choose one individual NLO component"), &
             var_str ("to generate events with.")])
     vamp_equivalences_enabled = var_list%get_lval &
          (var_str ('?use_vamp_equivalences'))
     if (nlo .and. vamp_equivalences_enabled) &
          call msg_warning ("You have not disabled VAMP equivalences. ", &
               [var_str ("   Note that they are automatically switched off "), &
                var_str ("   for NLO calculations.")])
   end subroutine check_nlo_options
 
 @ %def check_nlo_options
 @ There are four components for a general NLO process, namely Born,
 real, virtual and subtraction. There will be additional components for
 DGLAP remnant, in case real contributions are split into singular and
 finite pieces, and for resonance-aware FKS subtraction for the needed
 soft mismatch component.
 <<Commands: procedures>>=
   pure function needed_extra_components (requires_dglap_remnant, &
          use_real_finite, requires_soft_mismatch) result (n)
     integer :: n
     logical, intent(in) :: requires_dglap_remnant, &
          use_real_finite, requires_soft_mismatch
     n = 4
     if (requires_dglap_remnant)  n = n + 1
     if (use_real_finite)  n = n + 1
     if (requires_soft_mismatch)  n = n + 1
   end function needed_extra_components
 
 @ %def needed_extra_components
 @ This is a method of the eval tree, but cannot be coded inside the
 [[expressions]] module since it uses the [[model]] and [[flv]] types
 which are not available there.
 <<Commands: procedures>>=
   function make_flavor_string (aval, model) result (prt)
     type(string_t) :: prt
     type(pdg_array_t), intent(in) :: aval
     type(model_t), intent(in), target :: model
     integer, dimension(:), allocatable :: pdg
     type(flavor_t), dimension(:), allocatable :: flv
     integer :: i
     pdg = aval
     allocate (flv (size (pdg)))
     call flv%init (pdg, model)
     if (size (pdg) /= 0) then
        prt = flv(1)%get_name ()
        do i = 2, size (flv)
           prt = prt // ":" // flv(i)%get_name ()
        end do
     else
        prt = "?"
     end if
   end function make_flavor_string
 
 @ %def make_flavor_string
 @ Create a pdg array from a particle-specification array
 <<Commands: procedures>>=
   function make_pdg_array (prt, model) result (pdg_array)
     type(prt_spec_t), intent(in), dimension(:) :: prt
     type(model_t), intent(in) :: model
     integer, dimension(:), allocatable :: aval
     type(pdg_array_t) :: pdg_array
     type(flavor_t) :: flv
     integer :: k
     allocate (aval (size (prt)))
     do k = 1, size (prt)
       call flv%init (prt(k)%to_string (), model)
       aval (k) = flv%get_pdg ()
     end do
     pdg_array = aval
   end function make_pdg_array
 
 @ %def make_pdg_array
 @ Compile a (possible nested) expression, to obtain a
 particle-specifier expression which we can process further.
 <<Commands: procedures>>=
   recursive subroutine compile_prt_expr (prt_expr, pn, var_list, model)
     type(prt_expr_t), intent(out) :: prt_expr
     type(parse_node_t), intent(in), target :: pn
     type(var_list_t), intent(in), target :: var_list
     type(model_t), intent(in), target :: model
     type(parse_node_t), pointer :: pn_entry, pn_term, pn_addition
     type(pdg_array_t) :: pdg
     type(string_t) :: prt_string
     integer :: n_entry, n_term, i
     select case (char (parse_node_get_rule_key (pn)))
     case ("prt_state_list")
        n_entry = parse_node_get_n_sub (pn)
        pn_entry => parse_node_get_sub_ptr (pn)
        if (n_entry == 1) then
           call compile_prt_expr (prt_expr, pn_entry, var_list, model)
        else
           call prt_expr%init_list (n_entry)
           select type (x => prt_expr%x)
           type is (prt_spec_list_t)
              do i = 1, n_entry
                 call compile_prt_expr (x%expr(i), pn_entry, var_list, model)
                 pn_entry => parse_node_get_next_ptr (pn_entry)
              end do
           end select
        end if
     case ("prt_state_sum")
        n_term = parse_node_get_n_sub (pn)
        pn_term => parse_node_get_sub_ptr (pn)
        pn_addition => pn_term
        if (n_term == 1) then
           call compile_prt_expr (prt_expr, pn_term, var_list, model)
        else
           call prt_expr%init_sum (n_term)
           select type (x => prt_expr%x)
           type is (prt_spec_sum_t)
              do i = 1, n_term
                 call compile_prt_expr (x%expr(i), pn_term, var_list, model)
                 pn_addition => parse_node_get_next_ptr (pn_addition)
                 if (associated (pn_addition)) &
                      pn_term => parse_node_get_sub_ptr (pn_addition, 2)
              end do
           end select
        end if
     case ("cexpr")
        pdg = eval_pdg_array (pn, var_list)
        prt_string = make_flavor_string (pdg, model)
        call prt_expr%init_spec (new_prt_spec (prt_string))
     case default
        call parse_node_write_rec (pn)
        call msg_bug ("compile prt expr: impossible syntax rule")
     end select
   end subroutine compile_prt_expr
 
 @ %def compile_prt_expr
 @
 \subsubsection{Initiating a NLO calculation}
 <<Commands: types>>=
   type, extends (command_t) :: cmd_nlo_t
     private
     integer, dimension(:), allocatable :: nlo_component
   contains
     <<Commands: cmd nlo: TBP>>
   end type cmd_nlo_t
 
 @ %def cmd_nlo_t
 @
 <<Commands: cmd nlo: TBP>>=
   procedure :: write => cmd_nlo_write
 <<Commands: procedures>>=
   subroutine cmd_nlo_write (cmd, unit, indent)
     class(cmd_nlo_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
   end subroutine cmd_nlo_write
 
 @ %def cmd_nlo_write
 @ As it is, the NLO calculation is switched on by putting {nlo} behind the process definition. This should be made nicer in the future.
 <<Commands: cmd nlo: TBP>>=
   procedure :: compile => cmd_nlo_compile
 <<Commands: procedures>>=
   subroutine cmd_nlo_compile (cmd, global)
     class(cmd_nlo_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_comp
     integer :: i, n_comp
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
     if (associated (pn_arg)) then
        n_comp = parse_node_get_n_sub (pn_arg)
        allocate (cmd%nlo_component (n_comp))
        pn_comp => parse_node_get_sub_ptr (pn_arg)
        i = 0
        do while (associated (pn_comp))
           i = i + 1
           cmd%nlo_component(i) = component_status &
                (parse_node_get_rule_key (pn_comp))
           pn_comp => parse_node_get_next_ptr (pn_comp)
        end do
     else
        allocate (cmd%nlo_component (0))
     end if
   end subroutine cmd_nlo_compile
 
 @ %def cmd_nlo_compile
 @
 <<Commands: cmd nlo: TBP>>=
   procedure :: execute => cmd_nlo_execute
 <<Commands: procedures>>=
   subroutine cmd_nlo_execute (cmd, global)
     class(cmd_nlo_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(string_t) :: string
     integer :: n, i, j
     logical, dimension(0:5) :: selected_nlo_parts
     if (debug_on) call msg_debug (D_CORE, "cmd_nlo_execute")
     selected_nlo_parts = .false.
     if (allocated (cmd%nlo_component)) then
        n = size (cmd%nlo_component)
     else
        n = 0
     end if
     do i = 1, n
        select case (cmd%nlo_component (i))
        case (BORN, NLO_VIRTUAL, NLO_MISMATCH, NLO_DGLAP, NLO_REAL)
           selected_nlo_parts(cmd%nlo_component (i)) = .true.
        case (NLO_FULL)
           selected_nlo_parts = .true.
           selected_nlo_parts (NLO_SUBTRACTION) = .false.
        case default
           string = var_str ("")
           do j = BORN, NLO_DGLAP
              string = string // component_status (j) // ", "
           end do
           string = string // component_status (NLO_FULL)
           call msg_fatal ("Invalid NLO mode. Valid modes are: " // &
                char (string))
        end select
     end do
     global%nlo_fixed_order = any (selected_nlo_parts)
     global%selected_nlo_parts = selected_nlo_parts
     allocate (global%nlo_component (size (cmd%nlo_component)))
     global%nlo_component = cmd%nlo_component
   end subroutine cmd_nlo_execute
 
 @ %def cmd_nlo_execute
 @
 \subsubsection{Process compilation}
 <<Commands: types>>=
   type, extends (command_t) :: cmd_compile_t
      private
      type(string_t), dimension(:), allocatable :: libname
      logical :: make_executable = .false.
      type(string_t) :: exec_name
    contains
    <<Commands: cmd compile: TBP>>
   end type cmd_compile_t
 
 @ %def cmd_compile_t
 @ Output: list all libraries to be compiled.
 <<Commands: cmd compile: TBP>>=
   procedure :: write => cmd_compile_write
 <<Commands: procedures>>=
   subroutine cmd_compile_write (cmd, unit, indent)
     class(cmd_compile_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "compile ("
     if (allocated (cmd%libname)) then
        do i = 1, size (cmd%libname)
           if (i > 1)  write (u, "(A,1x)", advance="no")  ","
           write (u, "('""',A,'""')", advance="no")  char (cmd%libname(i))
        end do
     end if
     write (u, "(A)")  ")"
   end subroutine cmd_compile_write
 
 @ %def cmd_compile_write
 @ Compile the libraries specified in the argument.  If the argument is
 empty, compile all libraries which can be found in the process library stack.
 <<Commands: cmd compile: TBP>>=
   procedure :: compile => cmd_compile_compile
 <<Commands: procedures>>=
   subroutine cmd_compile_compile (cmd, global)
     class(cmd_compile_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_cmd, pn_clause, pn_arg, pn_lib
     type(parse_node_t), pointer :: pn_exec_name_spec, pn_exec_name
     integer :: n_lib, i
     pn_cmd => parse_node_get_sub_ptr (cmd%pn)
     pn_clause => parse_node_get_sub_ptr (pn_cmd)
     pn_exec_name_spec => parse_node_get_sub_ptr (pn_clause, 2)
     if (associated (pn_exec_name_spec)) then
        pn_exec_name => parse_node_get_sub_ptr (pn_exec_name_spec, 2)
     else
        pn_exec_name => null ()
     end if
     pn_arg => parse_node_get_next_ptr (pn_clause)
     cmd%pn_opt => parse_node_get_next_ptr (pn_cmd)
     call cmd%compile_options (global)
     if (associated (pn_arg)) then
        n_lib = parse_node_get_n_sub (pn_arg)
     else
        n_lib = 0
     end if
     if (n_lib > 0) then
        allocate (cmd%libname (n_lib))
        pn_lib => parse_node_get_sub_ptr (pn_arg)
        do i = 1, n_lib
           cmd%libname(i) = parse_node_get_string (pn_lib)
           pn_lib => parse_node_get_next_ptr (pn_lib)
        end do
     end if
     if (associated (pn_exec_name)) then
        cmd%make_executable = .true.
        cmd%exec_name = parse_node_get_string (pn_exec_name)
     end if
   end subroutine cmd_compile_compile
 
 @ %def cmd_compile_compile
 @ Command execution.  Generate code, write driver, compile and link.
 Do this for all libraries in the list.
 
 If no library names have been given and stored while compiling this
 command, we collect all libraries from the current stack and compile
 those.
 
 As a bonus, a compiled library may be able to spawn new process
 libraries.  For instance, a processes may ask for a set of resonant
 subprocesses which go into their own library, but this can be
 determined only after the process is available as a compiled object.
 Therefore, the compilation loop is implemented as a recursive internal
 subroutine.
 
 We can compile static libraries (which actually just loads them).  However, we
 can't incorporate in a generated executable.
 <<Commands: cmd compile: TBP>>=
   procedure :: execute => cmd_compile_execute
 <<Commands: procedures>>=
   subroutine cmd_compile_execute (cmd, global)
     class(cmd_compile_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(string_t), dimension(:), allocatable :: libname, libname_static
     integer :: i, n_lib
     <<Commands: cmd compile execute: variables>>
     <<Commands: cmd compile execute: init>>
     if (allocated (cmd%libname)) then
        allocate (libname (size (cmd%libname)))
        libname = cmd%libname
     else
        call cmd%local%prclib_stack%get_names (libname)
     end if
     n_lib = size (libname)
     if (cmd%make_executable) then
        call get_prclib_static (libname_static)
        do i = 1, n_lib
           if (any (libname_static == libname(i))) then
              call msg_fatal ("Compile: can't include static library '" &
                   // char (libname(i)) // "'")
           end if
        end do
        call compile_executable (cmd%exec_name, libname, cmd%local)
     else
        call compile_libraries (libname)
        call global%update_prclib &
             (global%prclib_stack%get_library_ptr (libname(n_lib)))
     end if
     <<Commands: cmd compile execute: end init>>
   contains
     recursive subroutine compile_libraries (libname)
       type(string_t), dimension(:), intent(in) :: libname
       integer :: i
       type(string_t), dimension(:), allocatable :: libname_extra
       type(process_library_t), pointer :: lib_saved
       do i = 1, size (libname)
          call compile_library (libname(i), cmd%local)
          lib_saved => global%prclib
          call spawn_extra_libraries &
               (libname(i), cmd%local, global, libname_extra)
          call compile_libraries (libname_extra)
          call global%update_prclib (lib_saved)
       end do
     end subroutine compile_libraries
   end subroutine cmd_compile_execute
 
 @ %def cmd_compile_execute
 <<Commands: cmd compile execute: variables>>=
 @
 <<Commands: cmd compile execute: init>>=
 @
 <<Commands: cmd compile execute: end init>>=
 @
 @ The parallelization leads to undefined behavior while writing simultaneously to one file.
 The master worker has to initialize single-handed the corresponding library files.
 The slave worker will wait with a blocking [[MPI_BCAST]] until they receive a logical flag.
 <<MPI: Commands: cmd compile execute: variables>>=
   logical :: compile_init
   integer :: rank, n_size
 <<MPI: Commands: cmd compile execute: init>>=
   if (debug_on) call msg_debug (D_MPI, "cmd_compile_execute")
   compile_init = .false.
   call mpi_get_comm_id (n_size, rank)
   if (debug_on) call msg_debug (D_MPI, "n_size", rank)
   if (debug_on) call msg_debug (D_MPI, "rank", rank)
   if (rank /= 0) then
      if (debug_on) call msg_debug (D_MPI, "wait for master")
      call MPI_bcast (compile_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
   else
      compile_init = .true.
   end if
 
   if (compile_init) then
 <<MPI: Commands: cmd compile execute: end init>>=
   if (rank == 0) then
      if (debug_on) call msg_debug (D_MPI, "load slaves")
      call MPI_bcast (compile_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
   end if
 end if
 call MPI_barrier (MPI_COMM_WORLD)
 @ %def cmd_compile_execute_mpi
 @
 This is the interface to the external procedure which returns the
 names of all static libraries which are part of the executable.  (The
 default is none.)  The routine must allocate the array.
 <<Commands: public>>=
   public :: get_prclib_static
 <<Commands: interfaces>>=
   interface
      subroutine get_prclib_static (libname)
        import
        type(string_t), dimension(:), intent(inout), allocatable :: libname
      end subroutine get_prclib_static
   end interface
 
 @ %def get_prclib_static
 @
 Spawn extra libraries.  We can ask the processes within a compiled
 library, which we have available at this point, whether they need additional
 processes which should go into their own libraries.
 
 The current implementation only concerns resonant subprocesses.
 
 Note that the libraries should be created (source code), but not be
 compiled here.  This is done afterwards.
 <<Commands: procedures>>=
   subroutine spawn_extra_libraries (libname, local, global, libname_extra)
     type(string_t), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), target :: global
     type(string_t), dimension(:), allocatable, intent(out) :: libname_extra
     type(string_t), dimension(:), allocatable :: libname_res
     allocate (libname_extra (0))
     call spawn_resonant_subprocess_libraries &
          (libname, local, global, libname_res)
     if (allocated (libname_res))  libname_extra = [libname_extra, libname_res]
   end subroutine spawn_extra_libraries
 
 @ %def spawn_extra_libraries
 @
 \subsubsection{Execute a shell command}
 The argument is a string expression.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_exec_t
      private
      type(parse_node_t), pointer :: pn_command => null ()
    contains
    <<Commands: cmd exec: TBP>>
   end type cmd_exec_t
 
 @ %def cmd_exec_t
 @ Simply tell the status.
 <<Commands: cmd exec: TBP>>=
   procedure :: write => cmd_exec_write
 <<Commands: procedures>>=
   subroutine cmd_exec_write (cmd, unit, indent)
     class(cmd_exec_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     if (associated (cmd%pn_command)) then
        write (u, "(1x,A)")  "exec: [command associated]"
     else
        write (u, "(1x,A)")  "exec: [undefined]"
     end if
   end subroutine cmd_exec_write
 
 @ %def cmd_exec_write
 @ Compile the exec command.
 <<Commands: cmd exec: TBP>>=
   procedure :: compile => cmd_exec_compile
 <<Commands: procedures>>=
   subroutine cmd_exec_compile (cmd, global)
     class(cmd_exec_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_command
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_command => parse_node_get_sub_ptr (pn_arg)
     cmd%pn_command => pn_command
   end subroutine cmd_exec_compile
 
 @ %def cmd_exec_compile
 @ Execute the specified shell command.
 <<Commands: cmd exec: TBP>>=
   procedure :: execute => cmd_exec_execute
 <<Commands: procedures>>=
   subroutine cmd_exec_execute (cmd, global)
     class(cmd_exec_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(string_t) :: command
     logical :: is_known
     integer :: status
     command = eval_string (cmd%pn_command, global%var_list, is_known=is_known)
     if (is_known) then
        if (command /= "") then
           call os_system_call (command, status, verbose=.true.)
           if (status /= 0) then
              write (msg_buffer, "(A,I0)")  "Return code = ", status
              call msg_message ()
              call msg_error ("System command returned with nonzero status code")
           end if
        end if
     end if
   end subroutine cmd_exec_execute
 
 @ %def cmd_exec_execute
 @
 \subsubsection{Variable declaration}
 A variable can have various types.  Hold the definition as an eval
 tree.
 
 There are intrinsic variables, user variables, and model variables.
 The latter are further divided in independent variables and dependent
 variables.
 
 Regarding model variables: When dealing with them, we always look at
 two variable lists in parallel.  The global (or local) variable list
 contains the user-visible values.  It includes variables that
 correspond to variables in the current model's list.  These, in turn,
 are pointers to the model's parameter list, so the model is always in
 sync, internally.  To keep the global variable list in sync with the
 model, the global variables carry the [[is_copy]] property and contain
 a separate pointer to the model variable.  (The pointer is reassigned
 whenever the model changes.)  Modifying the global variable changes
 two values simultaneously: the visible value and the model variable,
 via this extra pointer.  After each modification, we update dependent
 parameters in the model variable list and re-synchronize the global
 variable list (again, using these pointers) with the model variable
 this.  In the last step, modifications in the derived parameters
 become visible.
 
 When we integrate a process, we capture the current variable list of
 the current model in a separate model instance, which is stored in the
 process object.  Thus, the model parameters associated to this process
 at this time are preserved for the lifetime of the process object.
 
 When we generate or rescan events, we can again capture a local model
 variable list in a model instance.  This allows us to reweight event
 by event with different parameter sets simultaneously.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_var_t
      private
      type(string_t) :: name
      integer :: type = V_NONE
      type(parse_node_t), pointer :: pn_value => null ()
      logical :: is_intrinsic = .false.
      logical :: is_model_var = .false.
    contains
    <<Commands: cmd var: TBP>>
   end type cmd_var_t
 
 @ %def cmd_var_t
 @ Output.  We know name, type, and properties, but not the value.
 <<Commands: cmd var: TBP>>=
   procedure :: write => cmd_var_write
 <<Commands: procedures>>=
   subroutine cmd_var_write (cmd, unit, indent)
     class(cmd_var_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A,A)", advance="no")  "var: ", char (cmd%name), " ("
     select case (cmd%type)
     case (V_NONE)
        write (u, "(A)", advance="no")  "[unknown]"
     case (V_LOG)
        write (u, "(A)", advance="no")  "logical"
     case (V_INT)
        write (u, "(A)", advance="no")  "int"
     case (V_REAL)
        write (u, "(A)", advance="no")  "real"
     case (V_CMPLX)
        write (u, "(A)", advance="no")  "complex"
     case (V_STR)
        write (u, "(A)", advance="no")  "string"
     case (V_PDG)
        write (u, "(A)", advance="no")  "alias"
     end select
     if (cmd%is_intrinsic) then
        write (u, "(A)", advance="no")  ", intrinsic"
     end if
     if (cmd%is_model_var) then
        write (u, "(A)", advance="no")  ", model"
     end if
     write (u, "(A)")  ")"
   end subroutine cmd_var_write
 
 @ %def cmd_var_write
 @ Compile the lhs and determine the variable name and type.  Check whether
 this variable can be created or modified as requested, and append the value to
 the variable list, if appropriate.  The value is initially undefined.
 The rhs is assigned to a pointer, to be compiled and evaluated when the
 command is executed.
 <<Commands: cmd var: TBP>>=
   procedure :: compile => cmd_var_compile
 <<Commands: procedures>>=
   subroutine cmd_var_compile (cmd, global)
     class(cmd_var_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_var, pn_name
     type(parse_node_t), pointer :: pn_result, pn_proc
     type(string_t) :: var_name
     type(var_list_t), pointer :: model_vars
     integer :: type
     logical :: new
     pn_result => null ()
     new = .false.
     select case (char (parse_node_get_rule_key (cmd%pn)))
     case ("cmd_log_decl");    type = V_LOG
        pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
        if (.not. associated (pn_var)) then   ! handle masked syntax error
           cmd%type = V_NONE; return
        end if
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        new = .true.
     case ("cmd_log");         type = V_LOG
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
     case ("cmd_int");         type = V_INT
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
        new = .true.
     case ("cmd_real");        type = V_REAL
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
        new = .true.
     case ("cmd_complex");       type = V_CMPLX
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
        new = .true.
     case ("cmd_num");         type = V_NONE
        pn_name => parse_node_get_sub_ptr (cmd%pn)
     case ("cmd_string_decl"); type = V_STR
        pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
        if (.not. associated (pn_var)) then   ! handle masked syntax error
           cmd%type = V_NONE; return
        end if
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        new = .true.
     case ("cmd_string");      type = V_STR
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
     case ("cmd_alias");       type = V_PDG
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
        new = .true.
     case ("cmd_result");      type = V_REAL
        pn_name => parse_node_get_sub_ptr (cmd%pn)
        pn_result => parse_node_get_sub_ptr (pn_name)
        pn_proc => parse_node_get_next_ptr (pn_result)
     case default
        call parse_node_mismatch &
             ("logical|int|real|complex|?|$|alias|var_name", cmd%pn)  ! $
     end select
     if (.not. associated (pn_name)) then   ! handle masked syntax error
        cmd%type = V_NONE; return
     end if
     if (.not. associated (pn_result)) then
        var_name = parse_node_get_string (pn_name)
     else
        var_name = parse_node_get_key (pn_result) &
             // "(" // parse_node_get_string (pn_proc) // ")"
     end if
     select case (type)
     case (V_LOG);  var_name = "?" // var_name
     case (V_STR);  var_name = "$" // var_name    ! $
     end select
     if (associated (global%model)) then
        model_vars => global%model%get_var_list_ptr ()
     else
        model_vars => null ()
     end if
     call var_list_check_observable (global%var_list, var_name, type)
     call var_list_check_result_var (global%var_list, var_name, type)
     call global%var_list%check_user_var (var_name, type, new)
     cmd%name = var_name
     cmd%pn_value => parse_node_get_next_ptr (pn_name, 2)
     if (global%var_list%contains (cmd%name, follow_link = .false.)) then
        ! local variable
        cmd%is_intrinsic = &
             global%var_list%is_intrinsic (cmd%name, follow_link = .false.)
        cmd%type = &
             global%var_list%get_type (cmd%name, follow_link = .false.)
     else
        if (new)  cmd%type = type
        if (global%var_list%contains (cmd%name, follow_link = .true.)) then
           ! global variable
           cmd%is_intrinsic = &
                global%var_list%is_intrinsic (cmd%name, follow_link = .true.)
           if (cmd%type == V_NONE) then
              cmd%type = &
                   global%var_list%get_type (cmd%name, follow_link = .true.)
           end if
        else if (associated (model_vars)) then  ! check model variable
           cmd%is_model_var = &
                model_vars%contains (cmd%name)
           if (cmd%type == V_NONE) then
              cmd%type = &
                   model_vars%get_type (cmd%name)
           end if
        end if
        if (cmd%type == V_NONE) then
           call msg_fatal ("Variable '" // char (cmd%name) // "' " &
                // "set without declaration")
           cmd%type = V_NONE;  return
        end if
        if (cmd%is_model_var) then
           if (new) then
              call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
                   // "redeclared")
           else if (model_vars%is_locked (cmd%name)) then
              call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
                   // "is locked")
           end if
        else
           select case (cmd%type)
           case (V_LOG)
              call global%var_list%append_log (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           case (V_INT)
              call global%var_list%append_int (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           case (V_REAL)
              call global%var_list%append_real (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           case (V_CMPLX)
              call global%var_list%append_cmplx (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           case (V_PDG)
              call global%var_list%append_pdg_array (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           case (V_STR)
              call global%var_list%append_string (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           end select
        end if
     end if
   end subroutine cmd_var_compile
 
 @ %def cmd_var_compile
 @ Execute.  Evaluate the definition and assign the variable value.
 If the variable is a model variable, take a snapshot of the model if necessary
 and set the variable in the local model.
 <<Commands: cmd var: TBP>>=
   procedure :: execute => cmd_var_execute
 <<Commands: procedures>>=
   subroutine cmd_var_execute (cmd, global)
     class(cmd_var_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default) :: rval
     logical :: is_known, pacified
     var_list => global%get_var_list_ptr ()
     if (cmd%is_model_var) then
        pacified = var_list%get_lval (var_str ("?pacify"))
        rval = eval_real (cmd%pn_value, var_list, is_known=is_known)
        call global%model_set_real &
             (cmd%name, rval, verbose=.true., pacified=pacified)
     else if (cmd%type /= V_NONE) then
        call cmd%set_value (var_list, verbose=.true.)
     end if
   end subroutine cmd_var_execute
 
 @ %def cmd_var_execute
 @ Copy the value to the variable list, where the variable should already exist.
 <<Commands: cmd var: TBP>>=
   procedure :: set_value => cmd_var_set_value
 <<Commands: procedures>>=
   subroutine cmd_var_set_value (var, var_list, verbose, model_name)
     class(cmd_var_t), intent(inout) :: var
     type(var_list_t), intent(inout), target :: var_list
     logical, intent(in), optional :: verbose
     type(string_t), intent(in), optional :: model_name
     logical :: lval, pacified
     integer :: ival
     real(default) :: rval
     complex(default) :: cval
     type(pdg_array_t) :: aval
     type(string_t) :: sval
     logical :: is_known
     pacified = var_list%get_lval (var_str ("?pacify"))
     select case (var%type)
     case (V_LOG)
        lval = eval_log (var%pn_value, var_list, is_known=is_known)
        call var_list%set_log (var%name, &
             lval, is_known, verbose=verbose, model_name=model_name)
     case (V_INT)
        ival = eval_int (var%pn_value, var_list, is_known=is_known)
        call var_list%set_int (var%name, &
             ival, is_known, verbose=verbose, model_name=model_name)
     case (V_REAL)
        rval = eval_real (var%pn_value, var_list, is_known=is_known)
        call var_list%set_real (var%name, &
             rval, is_known, verbose=verbose, &
             model_name=model_name, pacified = pacified)
     case (V_CMPLX)
        cval = eval_cmplx (var%pn_value, var_list, is_known=is_known)
        call var_list%set_cmplx (var%name, &
             cval, is_known, verbose=verbose, &
             model_name=model_name, pacified = pacified)
     case (V_PDG)
        aval = eval_pdg_array (var%pn_value, var_list, is_known=is_known)
        call var_list%set_pdg_array (var%name, &
             aval, is_known, verbose=verbose, model_name=model_name)
     case (V_STR)
        sval = eval_string (var%pn_value, var_list, is_known=is_known)
        call var_list%set_string (var%name, &
             sval, is_known, verbose=verbose, model_name=model_name)
     end select
   end subroutine cmd_var_set_value
 
 @ %def cmd_var_set_value
 @
 \subsubsection{SLHA}
 Read a SLHA (SUSY Les Houches Accord) file to fill the appropriate
 model parameters.  We do not access the current variable record, but
 directly work on the appropriate SUSY model, which is loaded if
 necessary.
 
 We may be in read or write mode.  In the latter case, we may write
 just input parameters, or the complete spectrum, or the spectrum with
 all decays.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_slha_t
      private
      type(string_t) :: file
      logical :: write_mode = .false.
    contains
    <<Commands: cmd slha: TBP>>
   end type cmd_slha_t
 
 @ %def cmd_slha_t
 @ Output.
 <<Commands: cmd slha: TBP>>=
   procedure :: write => cmd_slha_write
 <<Commands: procedures>>=
   subroutine cmd_slha_write (cmd, unit, indent)
     class(cmd_slha_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A)")  "slha: file name  = ", char (cmd%file)
     write (u, "(1x,A,L1)") "slha: write mode = ", cmd%write_mode
   end subroutine cmd_slha_write
 
 @ %def cmd_slha_write
 @ Compile.  Read the filename and store it.
 <<Commands: cmd slha: TBP>>=
   procedure :: compile => cmd_slha_compile
 <<Commands: procedures>>=
   subroutine cmd_slha_compile (cmd, global)
     class(cmd_slha_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_key, pn_arg, pn_file
     pn_key => parse_node_get_sub_ptr (cmd%pn)
     pn_arg => parse_node_get_next_ptr (pn_key)
     pn_file => parse_node_get_sub_ptr (pn_arg)
     call cmd%compile_options (global)
     cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
     select case (char (parse_node_get_key (pn_key)))
     case ("read_slha")
        cmd%write_mode = .false.
     case ("write_slha")
        cmd%write_mode = .true.
     case default
        call parse_node_mismatch ("read_slha|write_slha",  cmd%pn)
     end select
     cmd%file = parse_node_get_string (pn_file)
   end subroutine cmd_slha_compile
 
 @ %def cmd_slha_compile
 @ Execute.  Read or write the specified SLHA file.  Behind the scenes,
 this will first read the WHIZARD model file, then read the SLHA file
 and assign the SLHA parameters as far as determined by
 [[dispatch_slha]].  Finally, the global variables are synchronized
 with the model.  This is similar to executing [[cmd_model]].
 <<Commands: cmd slha: TBP>>=
   procedure :: execute => cmd_slha_execute
 <<Commands: procedures>>=
   subroutine cmd_slha_execute (cmd, global)
     class(cmd_slha_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     logical :: input, spectrum, decays
     if (cmd%write_mode) then
        input = .true.
        spectrum = .false.
        decays = .false.
        if (.not. associated (cmd%local%model)) then
           call msg_fatal ("SLHA: local model not associated")
           return
        end if
        call slha_write_file &
             (cmd%file, cmd%local%model, &
              input = input, spectrum = spectrum, decays = decays)
     else
        if (.not. associated (global%model)) then
           call msg_fatal ("SLHA: global model not associated")
           return
        end if
        call dispatch_slha (cmd%local%var_list, &
             input = input, spectrum = spectrum, decays = decays)
        call global%ensure_model_copy ()
        call slha_read_file &
             (cmd%file, cmd%local%os_data, global%model, &
              input = input, spectrum = spectrum, decays = decays)
     end if
   end subroutine cmd_slha_execute
 
 @ %def cmd_slha_execute
 @
 \subsubsection{Show values}
 This command shows the current values of variables or other objects,
 in a suitably condensed form.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_show_t
      private
      type(string_t), dimension(:), allocatable :: name
    contains
    <<Commands: cmd show: TBP>>
   end type cmd_show_t
 
 @ %def cmd_show_t
 @ Output: list the object names, not values.
 <<Commands: cmd show: TBP>>=
   procedure :: write => cmd_show_write
 <<Commands: procedures>>=
   subroutine cmd_show_write (cmd, unit, indent)
     class(cmd_show_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "show: "
     if (allocated (cmd%name)) then
        do i = 1, size (cmd%name)
           write (u, "(1x,A)", advance="no")  char (cmd%name(i))
        end do
        write (u, *)
     else
        write (u, "(5x,A)")  "[undefined]"
     end if
   end subroutine cmd_show_write
 
 @ %def cmd_show_write
 @ Compile.  Allocate an array which is filled with the names of the
 variables to show.
 <<Commands: cmd show: TBP>>=
   procedure :: compile => cmd_show_compile
 <<Commands: procedures>>=
   subroutine cmd_show_compile (cmd, global)
     class(cmd_show_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
     type(string_t) :: key
     integer :: i, n_args
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (pn_arg)) then
        select case (char (parse_node_get_rule_key (pn_arg)))
        case ("show_arg")
           cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
        case default
           cmd%pn_opt => pn_arg
           pn_arg => null ()
        end select
     end if
     call cmd%compile_options (global)
     if (associated (pn_arg)) then
        n_args = parse_node_get_n_sub (pn_arg)
        allocate (cmd%name (n_args))
        pn_var => parse_node_get_sub_ptr (pn_arg)
        i = 0
        do while (associated (pn_var))
           i = i + 1
           select case (char (parse_node_get_rule_key (pn_var)))
           case ("model", "library", "beams", "iterations", &
                 "cuts", "weight", "int", "real", "complex", &
                 "scale", "factorization_scale", "renormalization_scale", &
                 "selection", "reweight", "analysis", "pdg", &
                 "stable", "unstable", "polarized", "unpolarized", &
                 "results", "expect", "intrinsic", "string", "logical")
              cmd%name(i) = parse_node_get_key (pn_var)
           case ("result_var")
              pn_prefix => parse_node_get_sub_ptr (pn_var)
              pn_name => parse_node_get_next_ptr (pn_prefix)
              if (associated (pn_name)) then
                 cmd%name(i) = parse_node_get_key (pn_prefix) &
                      // "(" // parse_node_get_string (pn_name) // ")"
              else
                 cmd%name(i) = parse_node_get_key (pn_prefix)
              end if
           case ("log_var", "string_var", "alias_var")
              pn_prefix => parse_node_get_sub_ptr (pn_var)
              pn_name => parse_node_get_next_ptr (pn_prefix)
              key = parse_node_get_key (pn_prefix)
              if (associated (pn_name)) then
                 select case (char (parse_node_get_rule_key (pn_name)))
                 case ("var_name")
                    select case (char (key))
                    case ("?", "$")  ! $ sign
                       cmd%name(i) = key // parse_node_get_string (pn_name)
                    case ("alias")
                       cmd%name(i) = parse_node_get_string (pn_name)
                    end select
                 case default
                    call parse_node_mismatch &
                         ("var_name",  pn_name)
                 end select
              else
                 cmd%name(i) = key
              end if
           case default
              cmd%name(i) = parse_node_get_string (pn_var)
           end select
           pn_var => parse_node_get_next_ptr (pn_var)
        end do
     else
        allocate (cmd%name (0))
     end if
   end subroutine cmd_show_compile
 
 @ %def cmd_show_compile
 @ Execute.  Scan the list of objects to show.
 <<Commands: parameters>>=
   integer, parameter, public :: SHOW_BUFFER_SIZE = 4096
 <<Commands: cmd show: TBP>>=
   procedure :: execute => cmd_show_execute
 <<Commands: procedures>>=
   subroutine cmd_show_execute (cmd, global)
     class(cmd_show_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list, model_vars
     type(model_t), pointer :: model
     type(string_t) :: name
     integer :: n, pdg
     type(flavor_t) :: flv
     type(process_library_t), pointer :: prc_lib
     type(process_t), pointer :: process
     logical :: pacified
     character(SHOW_BUFFER_SIZE) :: buffer
     type(string_t) :: out_file
     integer :: i, j, u, u_log, u_out, u_ext
     u = free_unit ()
     var_list => cmd%local%var_list
     if (associated (cmd%local%model)) then
        model_vars => cmd%local%model%get_var_list_ptr ()
     else
        model_vars => null ()
     end if
     pacified = var_list%get_lval (var_str ("?pacify"))
     out_file = var_list%get_sval (var_str ("$out_file"))
     if (file_list_is_open (global%out_files, out_file, action="write")) then
        call msg_message ("show: copying output to file '" &
             // char (out_file) // "'")
        u_ext = file_list_get_unit (global%out_files, out_file)
     else
        u_ext = -1
     end if
     open (u, status = "scratch", action = "readwrite")
     if (associated (cmd%local%model)) then
        name = cmd%local%model%get_name ()
     end if
     if (size (cmd%name) == 0) then
        if (associated (model_vars)) then
           call model_vars%write (model_name = name, &
                unit = u, pacified = pacified, follow_link = .false.)
        end if
        call var_list%write (unit = u, pacified = pacified)
     else
        do i = 1, size (cmd%name)
           select case (char (cmd%name(i)))
           case ("model")
              if (associated (cmd%local%model)) then
                 call cmd%local%model%show (u)
              else
                 write (u, "(A)")  "Model: [undefined]"
              end if
           case ("library")
              if (associated (cmd%local%prclib)) then
                 call cmd%local%prclib%show (u)
              else
                 write (u, "(A)")  "Process library: [undefined]"
              end if
           case ("beams")
              call cmd%local%show_beams (u)
           case ("iterations")
              call cmd%local%it_list%write (u)
           case ("results")
              call cmd%local%process_stack%show (u, fifo=.true.)
           case ("stable")
              call cmd%local%model%show_stable (u)
           case ("polarized")
              call cmd%local%model%show_polarized (u)
           case ("unpolarized")
              call cmd%local%model%show_unpolarized (u)
           case ("unstable")
              model => cmd%local%model
              call model%show_unstable (u)
              n = model%get_n_field ()
              do j = 1, n
                 pdg = model%get_pdg (j)
                 call flv%init (pdg, model)
                 if (.not. flv%is_stable ()) &
                      call show_unstable (cmd%local, pdg, u)
                 if (flv%has_antiparticle ()) then
                    associate (anti => flv%anti ())
                      if (.not. anti%is_stable ()) &
                           call show_unstable (cmd%local, -pdg, u)
                    end associate
                 end if
              end do
           case ("cuts", "weight", "scale", &
                "factorization_scale", "renormalization_scale", &
                "selection", "reweight", "analysis")
              call cmd%local%pn%show (cmd%name(i), u)
           case ("expect")
              call expect_summary (force = .true.)
           case ("intrinsic")
              call var_list%write (intrinsic=.true., unit=u, &
                   pacified = pacified)
           case ("logical")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_LOG, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (&
                   only_type=V_LOG, unit=u, pacified = pacified)
           case ("int")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_INT, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (only_type=V_INT, &
                   unit=u, pacified = pacified)
           case ("real")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_REAL, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (only_type=V_REAL, &
                   unit=u, pacified = pacified)
           case ("complex")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_CMPLX, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (only_type=V_CMPLX, &
                   unit=u, pacified = pacified)
           case ("pdg")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_PDG, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (only_type=V_PDG, &
                   unit=u, pacified = pacified)
           case ("string")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_STR, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (only_type=V_STR, &
                   unit=u, pacified = pacified)
           case default
              if (analysis_exists (cmd%name(i))) then
                 call analysis_write (cmd%name(i), u)
              else if (cmd%local%process_stack%exists (cmd%name(i))) then
                 process => cmd%local%process_stack%get_process_ptr (cmd%name(i))
                 call process%show (u)
              else if (associated (cmd%local%prclib_stack%get_library_ptr &
                   (cmd%name(i)))) then
                 prc_lib => cmd%local%prclib_stack%get_library_ptr (cmd%name(i))
                 call prc_lib%show (u)
              else if (associated (model_vars)) then
                 if (model_vars%contains (cmd%name(i), follow_link=.false.)) then
                    call model_vars%write_var (cmd%name(i), &
                         unit = u, model_name = name, pacified = pacified)
                 else if (var_list%contains (cmd%name(i))) then
                    call var_list%write_var (cmd%name(i), &
                         unit = u, pacified = pacified)
                 else
                    call msg_error ("show: object '" // char (cmd%name(i)) &
                         // "' not found")
                 end if
              else if (var_list%contains (cmd%name(i))) then
                 call var_list%write_var (cmd%name(i), &
                      unit = u, pacified = pacified)
              else
                 call msg_error ("show: object '" // char (cmd%name(i)) &
                      // "' not found")
              end if
           end select
        end do
     end if
     rewind (u)
     u_log = logfile_unit ()
     u_out = given_output_unit ()
     do
        read (u, "(A)", end = 1)  buffer
        if (u_log > 0)  write (u_log, "(A)")  trim (buffer)
        if (u_out > 0)  write (u_out, "(A)")  trim (buffer)
        if (u_ext > 0)  write (u_ext, "(A)")  trim (buffer)
     end do
 1   close (u)
     if (u_log > 0)  flush (u_log)
     if (u_out > 0)  flush (u_out)
     if (u_ext > 0)  flush (u_ext)
   end subroutine cmd_show_execute
 
 @ %def cmd_show_execute
 @
 \subsubsection{Clear values}
 This command clears the current values of variables or other objects,
 where this makes sense.  It parallels the [[show]] command.  The
 objects are cleared, but not deleted.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_clear_t
      private
      type(string_t), dimension(:), allocatable :: name
    contains
    <<Commands: cmd clear: TBP>>
   end type cmd_clear_t
 
 @ %def cmd_clear_t
 @ Output: list the names of the objects to be cleared.
 <<Commands: cmd clear: TBP>>=
   procedure :: write => cmd_clear_write
 <<Commands: procedures>>=
   subroutine cmd_clear_write (cmd, unit, indent)
     class(cmd_clear_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "clear: "
     if (allocated (cmd%name)) then
        do i = 1, size (cmd%name)
           write (u, "(1x,A)", advance="no")  char (cmd%name(i))
        end do
        write (u, *)
     else
        write (u, "(5x,A)")  "[undefined]"
     end if
   end subroutine cmd_clear_write
 
 @ %def cmd_clear_write
 @ Compile.  Allocate an array which is filled with the names of the
 objects to be cleared.
 
 Note: there is currently no need to account for options, but we
 prepare for that possibility.
 <<Commands: cmd clear: TBP>>=
   procedure :: compile => cmd_clear_compile
 <<Commands: procedures>>=
   subroutine cmd_clear_compile (cmd, global)
     class(cmd_clear_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
     type(string_t) :: key
     integer :: i, n_args
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (pn_arg)) then
        select case (char (parse_node_get_rule_key (pn_arg)))
        case ("clear_arg")
           cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
        case default
           cmd%pn_opt => pn_arg
           pn_arg => null ()
        end select
     end if
     call cmd%compile_options (global)
     if (associated (pn_arg)) then
        n_args = parse_node_get_n_sub (pn_arg)
        allocate (cmd%name (n_args))
        pn_var => parse_node_get_sub_ptr (pn_arg)
        i = 0
        do while (associated (pn_var))
           i = i + 1
           select case (char (parse_node_get_rule_key (pn_var)))
           case ("beams", "iterations", &
                 "cuts", "weight", &
                 "scale", "factorization_scale", "renormalization_scale", &
                 "selection", "reweight", "analysis", &
                 "unstable", "polarized", &
                 "expect")
              cmd%name(i) = parse_node_get_key (pn_var)
           case ("log_var", "string_var")
              pn_prefix => parse_node_get_sub_ptr (pn_var)
              pn_name => parse_node_get_next_ptr (pn_prefix)
              key = parse_node_get_key (pn_prefix)
              if (associated (pn_name)) then
                 select case (char (parse_node_get_rule_key (pn_name)))
                 case ("var_name")
                    select case (char (key))
                    case ("?", "$")  ! $ sign
                       cmd%name(i) = key // parse_node_get_string (pn_name)
                    end select
                 case default
                    call parse_node_mismatch &
                         ("var_name",  pn_name)
                 end select
              else
                 cmd%name(i) = key
              end if
           case default
              cmd%name(i) = parse_node_get_string (pn_var)
           end select
           pn_var => parse_node_get_next_ptr (pn_var)
        end do
     else
        allocate (cmd%name (0))
     end if
   end subroutine cmd_clear_compile
 
 @ %def cmd_clear_compile
 @ Execute.  Scan the list of objects to clear.
 
 Objects that can be shown but not cleared: model, library, results
 <<Commands: cmd clear: TBP>>=
   procedure :: execute => cmd_clear_execute
 <<Commands: procedures>>=
   subroutine cmd_clear_execute (cmd, global)
     class(cmd_clear_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     integer :: i
     logical :: success
     type(var_list_t), pointer :: model_vars
     if (size (cmd%name) == 0) then
        call msg_warning ("clear: no object specified")
     else
        do i = 1, size (cmd%name)
           success = .true.
           select case (char (cmd%name(i)))
           case ("beams")
              call cmd%local%clear_beams ()
           case ("iterations")
              call cmd%local%it_list%clear ()
           case ("polarized")
              call cmd%local%model%clear_polarized ()
           case ("unstable")
              call cmd%local%model%clear_unstable ()
           case ("cuts", "weight", "scale", &
                "factorization_scale", "renormalization_scale", &
                "selection", "reweight", "analysis")
              call cmd%local%pn%clear (cmd%name(i))
           case ("expect")
              call expect_clear ()
           case default
              if (analysis_exists (cmd%name(i))) then
                 call analysis_clear (cmd%name(i))
              else if (cmd%local%var_list%contains (cmd%name(i))) then
                 if (.not. cmd%local%var_list%is_locked (cmd%name(i))) then
                    call cmd%local%var_list%unset (cmd%name(i))
                 else
                    call msg_error ("clear: variable '" // char (cmd%name(i)) &
                         // "' is locked and can't be cleared")
                    success = .false.
                 end if
              else if (associated (cmd%local%model)) then
                 model_vars => cmd%local%model%get_var_list_ptr ()
                 if (model_vars%contains (cmd%name(i), follow_link=.false.)) then
                    call msg_error ("clear: variable '" // char (cmd%name(i)) &
                         // "' is a model variable and can't be cleared")
                 else
                    call msg_error ("clear: object '" // char (cmd%name(i)) &
                         // "' not found")
                 end if
                 success = .false.
              else
                 call msg_error ("clear: object '" // char (cmd%name(i)) &
                      // "' not found")
                 success = .false.
              end if
           end select
           if (success)  call msg_message ("cleared: " // char (cmd%name(i)))
        end do
     end if
   end subroutine cmd_clear_execute
 
 @ %def cmd_clear_execute
 @
 \subsubsection{Compare values of variables to expectation}
 The implementation is similar to the [[show]] command.  There are just
 two arguments: two values that should be compared.  For providing
 local values for the numerical tolerance, the command has a local
 argument list.
 
 If the expectation fails, an error condition is recorded.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_expect_t
      private
      type(parse_node_t), pointer :: pn_lexpr => null ()
    contains
    <<Commands: cmd expect: TBP>>
   end type cmd_expect_t
 
 @ %def cmd_expect_t
 @ Simply tell the status.
 <<Commands: cmd expect: TBP>>=
   procedure :: write => cmd_expect_write
 <<Commands: procedures>>=
   subroutine cmd_expect_write (cmd, unit, indent)
     class(cmd_expect_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     if (associated (cmd%pn_lexpr)) then
        write (u, "(1x,A)")  "expect: [expression associated]"
     else
        write (u, "(1x,A)")  "expect: [undefined]"
     end if
   end subroutine cmd_expect_write
 
 @ %def cmd_expect_write
 @ Compile.  This merely assigns the parse node, the actual compilation is done
 at execution.  This is necessary because the origin of variables
 (local/global) may change during execution.
 <<Commands: cmd expect: TBP>>=
   procedure :: compile => cmd_expect_compile
 <<Commands: procedures>>=
   subroutine cmd_expect_compile (cmd, global)
     class(cmd_expect_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
     cmd%pn_lexpr => parse_node_get_sub_ptr (pn_arg)
     call cmd%compile_options (global)
   end subroutine cmd_expect_compile
 
 @ %def cmd_expect_compile
 @ Execute.  Evaluate both arguments, print them and their difference
 (if numerical), and whether they agree.  Record the result.
 <<Commands: cmd expect: TBP>>=
   procedure :: execute => cmd_expect_execute
 <<Commands: procedures>>=
   subroutine cmd_expect_execute (cmd, global)
     class(cmd_expect_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     logical :: success, is_known
     var_list => cmd%local%get_var_list_ptr ()
     success = eval_log (cmd%pn_lexpr, var_list, is_known=is_known)
     if (is_known) then
        if (success) then
           call msg_message ("expect: success")
        else
           call msg_error ("expect: failure")
        end if
     else
        call msg_error ("expect: undefined result")
        success = .false.
     end if
     call expect_record (success)
   end subroutine cmd_expect_execute
 
 @ %def cmd_expect_execute
 @
 \subsubsection{Beams}
 The beam command includes both beam and structure-function
 definition.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_beams_t
      private
      integer :: n_in = 0
      type(parse_node_p), dimension(:), allocatable :: pn_pdg
      integer :: n_sf_record = 0
      integer, dimension(:), allocatable :: n_entry
      type(parse_node_p), dimension(:,:), allocatable :: pn_sf_entry
    contains
    <<Commands: cmd beams: TBP>>
   end type cmd_beams_t
 
 @ %def cmd_beams_t
 @ Output.  The particle expressions are not resolved.
 <<Commands: cmd beams: TBP>>=
   procedure :: write => cmd_beams_write
 <<Commands: procedures>>=
   subroutine cmd_beams_write (cmd, unit, indent)
     class(cmd_beams_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams: [undefined]"
     end select
     if (allocated (cmd%n_entry)) then
        if (cmd%n_sf_record > 0) then
           write (u, "(1x,A,99(1x,I0))")  "structure function entries:", &
                cmd%n_entry
        end if
     end if
   end subroutine cmd_beams_write
 
 @ %def cmd_beams_write
 @ Compile.  Find and assign the parse nodes.
 
 Note: local environments are not yet supported.
 <<Commands: cmd beams: TBP>>=
   procedure :: compile => cmd_beams_compile
 <<Commands: procedures>>=
   subroutine cmd_beams_compile (cmd, global)
     class(cmd_beams_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_beam_def, pn_beam_spec
     type(parse_node_t), pointer :: pn_beam_list
     type(parse_node_t), pointer :: pn_codes
     type(parse_node_t), pointer :: pn_strfun_seq, pn_strfun_pair
     type(parse_node_t), pointer :: pn_strfun_def
     integer :: i
     pn_beam_def => parse_node_get_sub_ptr (cmd%pn, 3)
     pn_beam_spec => parse_node_get_sub_ptr (pn_beam_def)
     pn_strfun_seq => parse_node_get_next_ptr (pn_beam_spec)
     pn_beam_list => parse_node_get_sub_ptr (pn_beam_spec)
     call cmd%compile_options (global)
     cmd%n_in = parse_node_get_n_sub (pn_beam_list)
     allocate (cmd%pn_pdg (cmd%n_in))
     pn_codes => parse_node_get_sub_ptr (pn_beam_list)
     do i = 1, cmd%n_in
        cmd%pn_pdg(i)%ptr => pn_codes
        pn_codes => parse_node_get_next_ptr (pn_codes)
     end do
     if (associated (pn_strfun_seq)) then
        cmd%n_sf_record = parse_node_get_n_sub (pn_beam_def) - 1
        allocate (cmd%n_entry (cmd%n_sf_record), source = 1)
        allocate (cmd%pn_sf_entry (2, cmd%n_sf_record))
        do i = 1, cmd%n_sf_record
           pn_strfun_pair => parse_node_get_sub_ptr (pn_strfun_seq, 2)
           pn_strfun_def => parse_node_get_sub_ptr (pn_strfun_pair)
           cmd%pn_sf_entry(1,i)%ptr => pn_strfun_def
           pn_strfun_def => parse_node_get_next_ptr (pn_strfun_def)
           cmd%pn_sf_entry(2,i)%ptr => pn_strfun_def
           if (associated (pn_strfun_def))  cmd%n_entry(i) = 2
           pn_strfun_seq => parse_node_get_next_ptr (pn_strfun_seq)
        end do
     else
        allocate (cmd%n_entry (0))
        allocate (cmd%pn_sf_entry (0, 0))
     end if
   end subroutine cmd_beams_compile
 
 @ %def cmd_beams_compile
 @ Command execution: Determine beam particles and structure-function
 names, if any.  The results are stored in the [[beam_structure]]
 component of the [[global]] data block.
 <<Commands: cmd beams: TBP>>=
   procedure :: execute => cmd_beams_execute
 <<Commands: procedures>>=
   subroutine cmd_beams_execute (cmd, global)
     class(cmd_beams_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(pdg_array_t) :: pdg_array
     integer, dimension(:), allocatable :: pdg
     type(flavor_t), dimension(:), allocatable :: flv
     type(parse_node_t), pointer :: pn_key
     type(string_t) :: sf_name
     integer :: i, j
     call lhapdf_global_reset ()
     var_list => cmd%local%get_var_list_ptr ()
     allocate (flv (cmd%n_in))
     do i = 1, cmd%n_in
        pdg_array = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
        pdg = pdg_array
        select case (size (pdg))
        case (1)
           call flv(i)%init ( pdg(1), cmd%local%model)
        case default
           call msg_fatal ("Beams: beam particles must be unique")
        end select
     end do
     select case (cmd%n_in)
     case (1)
        if (cmd%n_sf_record > 0) then
           call msg_fatal ("Beam setup: no structure functions allowed &
                &for decay")
        end if
        call global%beam_structure%init_sf (flv%get_name ())
     case (2)
        call global%beam_structure%init_sf (flv%get_name (), cmd%n_entry)
        do i = 1, cmd%n_sf_record
           do j = 1, cmd%n_entry(i)
              pn_key => parse_node_get_sub_ptr (cmd%pn_sf_entry(j,i)%ptr)
              sf_name = parse_node_get_key (pn_key)
              call global%beam_structure%set_sf (i, j, sf_name)
           end do
        end do
     end select
   end subroutine cmd_beams_execute
 
 @ %def cmd_beams_execute
 @
 \subsubsection{Density matrices for beam polarization}
 For holding beam polarization, we define a notation and a data
 structure for sparse matrices.  The entries (and the index
 expressions) are numerical expressions, so we use evaluation trees.
 
 Each entry in the sparse matrix is an n-tuple of expressions.  The first
 tuple elements represent index values, the last one is an arbitrary
 (complex) number.  Absent expressions are replaced by default-value rules.
 
 Note: Here, and in some other commands, we would like to store an evaluation
 tree, not just a parse node pointer.  However, the current expression handler
 wants all variables defined, so the evaluation tree can only be built by
 [[evaluate]], i.e., compiled just-in-time and evaluated immediately.
 <<Commands: types>>=
   type :: sentry_expr_t
      type(parse_node_p), dimension(:), allocatable :: expr
    contains
    <<Commands: sentry expr: TBP>>
   end type sentry_expr_t
 
 @ %def sentry_expr_t
 @ Compile parse nodes into evaluation trees.
 <<Commands: sentry expr: TBP>>=
   procedure :: compile => sentry_expr_compile
 <<Commands: procedures>>=
   subroutine sentry_expr_compile (sentry, pn)
     class(sentry_expr_t), intent(out) :: sentry
     type(parse_node_t), intent(in), target :: pn
     type(parse_node_t), pointer :: pn_expr, pn_extra
     integer :: n_expr, i
     n_expr = parse_node_get_n_sub (pn)
     allocate (sentry%expr (n_expr))
     if (n_expr > 0) then
        i = 0
        pn_expr => parse_node_get_sub_ptr (pn)
        pn_extra => parse_node_get_next_ptr (pn_expr)
        do i = 1, n_expr
           sentry%expr(i)%ptr => pn_expr
           if (associated (pn_extra)) then
              pn_expr => parse_node_get_sub_ptr (pn_extra, 2)
              pn_extra => parse_node_get_next_ptr (pn_extra)
           end if
        end do
     end if
   end subroutine sentry_expr_compile
 
 @ %def sentry_expr_compile
 @ Evaluate the expressions and return an index array of predefined
 length together with a complex value.  If the value (as the last expression)
 is undefined, set it to unity.  If index values are undefined, repeat
 the previous index value.
 <<Commands: sentry expr: TBP>>=
   procedure :: evaluate => sentry_expr_evaluate
 <<Commands: procedures>>=
   subroutine sentry_expr_evaluate (sentry, index, value, global)
     class(sentry_expr_t), intent(inout) :: sentry
     integer, dimension(:), intent(out) :: index
     complex(default), intent(out) :: value
     type(rt_data_t), intent(in), target :: global
     type(var_list_t), pointer :: var_list
     integer :: i, n_expr, n_index
     type(eval_tree_t) :: eval_tree
     var_list => global%get_var_list_ptr ()
     n_expr = size (sentry%expr)
     n_index = size (index)
     if (n_expr <= n_index + 1) then
        do i = 1, min (n_expr, n_index)
           associate (expr => sentry%expr(i))
             call eval_tree%init_expr (expr%ptr, var_list)
             call eval_tree%evaluate ()
             if (eval_tree%is_known ()) then
                index(i) = eval_tree%get_int ()
             else
                call msg_fatal ("Evaluating density matrix: undefined index")
             end if
           end associate
        end do
        do i = n_expr + 1, n_index
           index(i) = index(n_expr)
        end do
        if (n_expr == n_index + 1) then
           associate (expr => sentry%expr(n_expr))
             call eval_tree%init_expr (expr%ptr, var_list)
             call eval_tree%evaluate ()
             if (eval_tree%is_known ()) then
                value = eval_tree%get_cmplx ()
             else
                call msg_fatal ("Evaluating density matrix: undefined index")
             end if
             call eval_tree%final ()
           end associate
        else
           value = 1
        end if
     else
        call msg_fatal ("Evaluating density matrix: index expression too long")
     end if
   end subroutine sentry_expr_evaluate
 
 @ %def sentry_expr_evaluate
 @ The sparse matrix itself consists of an arbitrary number of entries.
 <<Commands: types>>=
   type :: smatrix_expr_t
      type(sentry_expr_t), dimension(:), allocatable :: entry
    contains
    <<Commands: smatrix expr: TBP>>
   end type smatrix_expr_t
 
 @ %def smatrix_expr_t
 @ Compile: assign sub-nodes to sentry-expressions and compile those.
 <<Commands: smatrix expr: TBP>>=
   procedure :: compile => smatrix_expr_compile
 <<Commands: procedures>>=
   subroutine smatrix_expr_compile (smatrix_expr, pn)
     class(smatrix_expr_t), intent(out) :: smatrix_expr
     type(parse_node_t), intent(in), target :: pn
     type(parse_node_t), pointer :: pn_arg, pn_entry
     integer :: n_entry, i
     pn_arg => parse_node_get_sub_ptr (pn, 2)
     if (associated (pn_arg)) then
        n_entry = parse_node_get_n_sub (pn_arg)
        allocate (smatrix_expr%entry (n_entry))
        pn_entry => parse_node_get_sub_ptr (pn_arg)
        do i = 1, n_entry
           call smatrix_expr%entry(i)%compile (pn_entry)
           pn_entry => parse_node_get_next_ptr (pn_entry)
        end do
     else
        allocate (smatrix_expr%entry (0))
     end if
   end subroutine smatrix_expr_compile
 
 @ %def smatrix_expr_compile
 @ Evaluate the entries and build a new [[smatrix]] object, which
 contains just the numerical results.
 <<Commands: smatrix expr: TBP>>=
   procedure :: evaluate => smatrix_expr_evaluate
 <<Commands: procedures>>=
   subroutine smatrix_expr_evaluate (smatrix_expr, smatrix, global)
     class(smatrix_expr_t), intent(inout) :: smatrix_expr
     type(smatrix_t), intent(out) :: smatrix
     type(rt_data_t), intent(in), target :: global
     integer, dimension(2) :: idx
     complex(default) :: value
     integer :: i, n_entry
     n_entry = size (smatrix_expr%entry)
     call smatrix%init (2, n_entry)
     do i = 1, n_entry
        call smatrix_expr%entry(i)%evaluate (idx, value, global)
        call smatrix%set_entry (i, idx, value)
     end do
   end subroutine smatrix_expr_evaluate
 
 @ %def smatrix_expr_evaluate
 @
 \subsubsection{Beam polarization density}
 
 The beam polarization command defines spin density matrix for one or
 two beams (scattering or decay).
 <<Commands: types>>=
   type, extends (command_t) :: cmd_beams_pol_density_t
      private
      integer :: n_in = 0
      type(smatrix_expr_t), dimension(:), allocatable :: smatrix
    contains
    <<Commands: cmd beams pol density: TBP>>
   end type cmd_beams_pol_density_t
 
 @ %def cmd_beams_pol_density_t
 @ Output.
 <<Commands: cmd beams pol density: TBP>>=
   procedure :: write => cmd_beams_pol_density_write
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_density_write (cmd, unit, indent)
     class(cmd_beams_pol_density_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams polarization setup: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams polarization setup: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams polarization setup: [undefined]"
     end select
   end subroutine cmd_beams_pol_density_write
 
 @ %def cmd_beams_pol_density_write
 @ Compile.  Find and assign the parse nodes.
 
 Note: local environments are not yet supported.
 <<Commands: cmd beams pol density: TBP>>=
   procedure :: compile => cmd_beams_pol_density_compile
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_density_compile (cmd, global)
     class(cmd_beams_pol_density_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_pol_spec, pn_smatrix
     integer :: i
     pn_pol_spec => parse_node_get_sub_ptr (cmd%pn, 3)
     call cmd%compile_options (global)
     cmd%n_in = parse_node_get_n_sub (pn_pol_spec)
     allocate (cmd%smatrix (cmd%n_in))
     pn_smatrix => parse_node_get_sub_ptr (pn_pol_spec)
     do i = 1, cmd%n_in
        call cmd%smatrix(i)%compile (pn_smatrix)
        pn_smatrix => parse_node_get_next_ptr (pn_smatrix)
     end do
   end subroutine cmd_beams_pol_density_compile
 
 @ %def cmd_beams_pol_density_compile
 @ Command execution: Fill polarization density matrices.  No check
 yet, the matrices are checked and normalized when the actual beam
 object is created, just before integration.  For intermediate storage,
 we use the [[beam_structure]] object in the [[global]] data set.
 <<Commands: cmd beams pol density: TBP>>=
   procedure :: execute => cmd_beams_pol_density_execute
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_density_execute (cmd, global)
     class(cmd_beams_pol_density_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(smatrix_t) :: smatrix
     integer :: i
     call global%beam_structure%init_pol (cmd%n_in)
     do i = 1, cmd%n_in
        call cmd%smatrix(i)%evaluate (smatrix, global)
        call global%beam_structure%set_smatrix (i, smatrix)
     end do
   end subroutine cmd_beams_pol_density_execute
 
 @ %def cmd_beams_pol_density_execute
 @
 \subsubsection{Beam polarization fraction}
 In addition to the polarization density matrix, we can independently
 specify the polarization fraction for one or both beams.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_beams_pol_fraction_t
      private
      integer :: n_in = 0
      type(parse_node_p), dimension(:), allocatable :: expr
    contains
    <<Commands: cmd beams pol fraction: TBP>>
   end type cmd_beams_pol_fraction_t
 
 @ %def cmd_beams_pol_fraction_t
 @ Output.
 <<Commands: cmd beams pol fraction: TBP>>=
   procedure :: write => cmd_beams_pol_fraction_write
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_fraction_write (cmd, unit, indent)
     class(cmd_beams_pol_fraction_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams polarization fraction: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams polarization fraction: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams polarization fraction: [undefined]"
     end select
   end subroutine cmd_beams_pol_fraction_write
 
 @ %def cmd_beams_pol_fraction_write
 @ Compile.  Find and assign the parse nodes.
 
 Note: local environments are not yet supported.
 <<Commands: cmd beams pol fraction: TBP>>=
   procedure :: compile => cmd_beams_pol_fraction_compile
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_fraction_compile (cmd, global)
     class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_frac_spec, pn_expr
     integer :: i
     pn_frac_spec => parse_node_get_sub_ptr (cmd%pn, 3)
     call cmd%compile_options (global)
     cmd%n_in = parse_node_get_n_sub (pn_frac_spec)
     allocate (cmd%expr (cmd%n_in))
     pn_expr => parse_node_get_sub_ptr (pn_frac_spec)
     do i = 1, cmd%n_in
        cmd%expr(i)%ptr => pn_expr
        pn_expr => parse_node_get_next_ptr (pn_expr)
     end do
   end subroutine cmd_beams_pol_fraction_compile
 
 @ %def cmd_beams_pol_fraction_compile
 @ Command execution: Retrieve the numerical values of the beam
 polarization fractions.  The results are stored in the
 [[beam_structure]] component of the [[global]] data block.
 <<Commands: cmd beams pol fraction: TBP>>=
   procedure :: execute => cmd_beams_pol_fraction_execute
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_fraction_execute (cmd, global)
     class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default), dimension(:), allocatable :: pol_f
     type(eval_tree_t) :: expr
     integer :: i
     var_list => global%get_var_list_ptr ()
     allocate (pol_f (cmd%n_in))
     do i = 1, cmd%n_in
        call expr%init_expr (cmd%expr(i)%ptr, var_list)
        call expr%evaluate ()
        if (expr%is_known ()) then
           pol_f(i) = expr%get_real ()
        else
           call msg_fatal ("beams polarization fraction: undefined value")
        end if
        call expr%final ()
     end do
     call global%beam_structure%set_pol_f (pol_f)
   end subroutine cmd_beams_pol_fraction_execute
 
 @ %def cmd_beams_pol_fraction_execute
 @
 \subsubsection{Beam momentum}
 This is completely analogous to the previous command, hence we can use
 inheritance.
 <<Commands: types>>=
   type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_momentum_t
    contains
    <<Commands: cmd beams momentum: TBP>>
   end type cmd_beams_momentum_t
 
 @ %def cmd_beams_momentum_t
 @ Output.
 <<Commands: cmd beams momentum: TBP>>=
   procedure :: write => cmd_beams_momentum_write
 <<Commands: procedures>>=
   subroutine cmd_beams_momentum_write (cmd, unit, indent)
     class(cmd_beams_momentum_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams momentum: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams momentum: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams momentum: [undefined]"
     end select
   end subroutine cmd_beams_momentum_write
 
 @ %def cmd_beams_momentum_write
 @ Compile: inherited.
 
 Command execution: Not inherited, but just the error string and the final
 command are changed.
 <<Commands: cmd beams momentum: TBP>>=
   procedure :: execute => cmd_beams_momentum_execute
 <<Commands: procedures>>=
   subroutine cmd_beams_momentum_execute (cmd, global)
     class(cmd_beams_momentum_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default), dimension(:), allocatable :: p
     type(eval_tree_t) :: expr
     integer :: i
     var_list => global%get_var_list_ptr ()
     allocate (p (cmd%n_in))
     do i = 1, cmd%n_in
        call expr%init_expr (cmd%expr(i)%ptr, var_list)
        call expr%evaluate ()
        if (expr%is_known ()) then
           p(i) = expr%get_real ()
        else
           call msg_fatal ("beams momentum: undefined value")
        end if
        call expr%final ()
     end do
     call global%beam_structure%set_momentum (p)
   end subroutine cmd_beams_momentum_execute
 
 @ %def cmd_beams_momentum_execute
 @
 \subsubsection{Beam angles}
 Again, this is analogous.  There are two angles, polar angle $\theta$
 and azimuthal angle $\phi$, which can be set independently for both beams.
 <<Commands: types>>=
   type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_theta_t
    contains
    <<Commands: cmd beams theta: TBP>>
   end type cmd_beams_theta_t
 
   type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_phi_t
    contains
    <<Commands: cmd beams phi: TBP>>
   end type cmd_beams_phi_t
 
 @ %def cmd_beams_theta_t
 @ %def cmd_beams_phi_t
 @ Output.
 <<Commands: cmd beams theta: TBP>>=
   procedure :: write => cmd_beams_theta_write
 <<Commands: cmd beams phi: TBP>>=
   procedure :: write => cmd_beams_phi_write
 <<Commands: procedures>>=
   subroutine cmd_beams_theta_write (cmd, unit, indent)
     class(cmd_beams_theta_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams theta: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams theta: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams theta: [undefined]"
     end select
   end subroutine cmd_beams_theta_write
 
   subroutine cmd_beams_phi_write (cmd, unit, indent)
     class(cmd_beams_phi_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams phi: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams phi: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams phi: [undefined]"
     end select
   end subroutine cmd_beams_phi_write
 
 @ %def cmd_beams_theta_write
 @ %def cmd_beams_phi_write
 @ Compile: inherited.
 
 Command execution: Not inherited, but just the error string and the final
 command are changed.
 <<Commands: cmd beams theta: TBP>>=
   procedure :: execute => cmd_beams_theta_execute
 <<Commands: cmd beams phi: TBP>>=
   procedure :: execute => cmd_beams_phi_execute
 <<Commands: procedures>>=
   subroutine cmd_beams_theta_execute (cmd, global)
     class(cmd_beams_theta_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default), dimension(:), allocatable :: theta
     type(eval_tree_t) :: expr
     integer :: i
     var_list => global%get_var_list_ptr ()
     allocate (theta (cmd%n_in))
     do i = 1, cmd%n_in
        call expr%init_expr (cmd%expr(i)%ptr, var_list)
        call expr%evaluate ()
        if (expr%is_known ()) then
           theta(i) = expr%get_real ()
        else
           call msg_fatal ("beams theta: undefined value")
        end if
        call expr%final ()
     end do
     call global%beam_structure%set_theta (theta)
   end subroutine cmd_beams_theta_execute
 
   subroutine cmd_beams_phi_execute (cmd, global)
     class(cmd_beams_phi_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default), dimension(:), allocatable :: phi
     type(eval_tree_t) :: expr
     integer :: i
     var_list => global%get_var_list_ptr ()
     allocate (phi (cmd%n_in))
     do i = 1, cmd%n_in
        call expr%init_expr (cmd%expr(i)%ptr, var_list)
        call expr%evaluate ()
        if (expr%is_known ()) then
           phi(i) = expr%get_real ()
        else
           call msg_fatal ("beams phi: undefined value")
        end if
        call expr%final ()
     end do
     call global%beam_structure%set_phi (phi)
   end subroutine cmd_beams_phi_execute
 
 @ %def cmd_beams_theta_execute
 @ %def cmd_beams_phi_execute
 @
 \subsubsection{Cuts}
 Define a cut expression.  We store the parse tree for the right-hand
 side instead of compiling it.  Compilation is deferred to the process
 environment where the cut expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_cuts_t
      private
      type(parse_node_t), pointer :: pn_lexpr => null ()
    contains
    <<Commands: cmd cuts: TBP>>
   end type cmd_cuts_t
 
 @ %def cmd_cuts_t
 @ Output.  Do not print the parse tree, since this may get cluttered.
 Just a message that cuts have been defined.
 <<Commands: cmd cuts: TBP>>=
   procedure :: write => cmd_cuts_write
 <<Commands: procedures>>=
   subroutine cmd_cuts_write (cmd, unit, indent)
     class(cmd_cuts_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "cuts: [defined]"
   end subroutine cmd_cuts_write
 
 @ %def cmd_cuts_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd cuts: TBP>>=
   procedure :: compile => cmd_cuts_compile
 <<Commands: procedures>>=
   subroutine cmd_cuts_compile (cmd, global)
     class(cmd_cuts_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_cuts_compile
 
 @ %def cmd_cuts_compile
 @ Instead of evaluating the cut expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd cuts: TBP>>=
   procedure :: execute => cmd_cuts_execute
 <<Commands: procedures>>=
   subroutine cmd_cuts_execute (cmd, global)
     class(cmd_cuts_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%cuts_lexpr => cmd%pn_lexpr
   end subroutine cmd_cuts_execute
 
 @ %def cmd_cuts_execute
 @
 \subsubsection{General, Factorization and Renormalization Scales}
 Define a scale expression for either the renormalization or the
 factorization scale.  We store the parse tree for the right-hand
 side instead of compiling it.  Compilation is deferred to the process
 environment where the expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_scale_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd scale: TBP>>
   end type cmd_scale_t
 
 @ %def cmd_scale_t
 <<Commands: types>>=
   type, extends (command_t) :: cmd_fac_scale_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd fac scale: TBP>>
   end type cmd_fac_scale_t
 
 @ %def cmd_fac_scale_t
 <<Commands: types>>=
   type, extends (command_t) :: cmd_ren_scale_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd ren scale: TBP>>
   end type cmd_ren_scale_t
 
 @ %def cmd_ren_scale_t
 @ Output. Do not print the parse tree, since this may get cluttered.
 Just a message that scale, renormalization and factorization have been
 defined, respectively.
 <<Commands: cmd scale: TBP>>=
   procedure :: write => cmd_scale_write
 <<Commands: procedures>>=
   subroutine cmd_scale_write (cmd, unit, indent)
     class(cmd_scale_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "scale: [defined]"
   end subroutine cmd_scale_write
 
 @ %def cmd_scale_write
 @
 <<Commands: cmd fac scale: TBP>>=
   procedure :: write => cmd_fac_scale_write
 <<Commands: procedures>>=
   subroutine cmd_fac_scale_write (cmd, unit, indent)
     class(cmd_fac_scale_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "factorization scale: [defined]"
   end subroutine cmd_fac_scale_write
 
 @ %def cmd_fac_scale_write
 @
 <<Commands: cmd ren scale: TBP>>=
   procedure :: write => cmd_ren_scale_write
 <<Commands: procedures>>=
   subroutine cmd_ren_scale_write (cmd, unit, indent)
     class(cmd_ren_scale_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "renormalization scale: [defined]"
   end subroutine cmd_ren_scale_write
 
 @ %def cmd_ren_scale_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd scale: TBP>>=
   procedure :: compile => cmd_scale_compile
 <<Commands: procedures>>=
   subroutine cmd_scale_compile (cmd, global)
     class(cmd_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_scale_compile
 
 @ %def cmd_scale_compile
 @
 <<Commands: cmd fac scale: TBP>>=
   procedure :: compile => cmd_fac_scale_compile
 <<Commands: procedures>>=
   subroutine cmd_fac_scale_compile (cmd, global)
     class(cmd_fac_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_fac_scale_compile
 
 @ %def cmd_fac_scale_compile
 @
 <<Commands: cmd ren scale: TBP>>=
   procedure :: compile => cmd_ren_scale_compile
 <<Commands: procedures>>=
   subroutine cmd_ren_scale_compile (cmd, global)
     class(cmd_ren_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_ren_scale_compile
 
 @ %def cmd_ren_scale_compile
 @ Instead of evaluating the scale expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd scale: TBP>>=
   procedure :: execute => cmd_scale_execute
 <<Commands: procedures>>=
   subroutine cmd_scale_execute (cmd, global)
     class(cmd_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%scale_expr => cmd%pn_expr
   end subroutine cmd_scale_execute
 
 @ %def cmd_scale_execute
 @
 <<Commands: cmd fac scale: TBP>>=
   procedure :: execute => cmd_fac_scale_execute
 <<Commands: procedures>>=
   subroutine cmd_fac_scale_execute (cmd, global)
     class(cmd_fac_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%fac_scale_expr => cmd%pn_expr
   end subroutine cmd_fac_scale_execute
 
 @ %def cmd_fac_scale_execute
 @
 <<Commands: cmd ren scale: TBP>>=
   procedure :: execute => cmd_ren_scale_execute
 <<Commands: procedures>>=
   subroutine cmd_ren_scale_execute (cmd, global)
     class(cmd_ren_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%ren_scale_expr => cmd%pn_expr
   end subroutine cmd_ren_scale_execute
 
 @ %def cmd_ren_scale_execute
 @
 \subsubsection{Weight}
 Define a weight expression. The weight is applied to a process to be
 integrated, event by event. We store the parse tree for the right-hand
 side instead of compiling it. Compilation is deferred to the process
 environment where the expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_weight_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd weight: TBP>>
   end type cmd_weight_t
 
 @ %def cmd_weight_t
 @ Output. Do not print the parse tree, since this may get cluttered.
 Just a message that scale, renormalization and factorization have been
 defined, respectively.
 <<Commands: cmd weight: TBP>>=
   procedure :: write => cmd_weight_write
 <<Commands: procedures>>=
   subroutine cmd_weight_write (cmd, unit, indent)
     class(cmd_weight_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "weight expression: [defined]"
   end subroutine cmd_weight_write
 
 @ %def cmd_weight_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd weight: TBP>>=
   procedure :: compile => cmd_weight_compile
 <<Commands: procedures>>=
   subroutine cmd_weight_compile (cmd, global)
     class(cmd_weight_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_weight_compile
 
 @ %def cmd_weight_compile
 @ Instead of evaluating the expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd weight: TBP>>=
   procedure :: execute => cmd_weight_execute
 <<Commands: procedures>>=
   subroutine cmd_weight_execute (cmd, global)
     class(cmd_weight_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%weight_expr => cmd%pn_expr
   end subroutine cmd_weight_execute
 
 @ %def cmd_weight_execute
 @
 \subsubsection{Selection}
 Define a selection expression.  This is to be applied upon simulation or
 event-file rescanning, event by event.  We store the parse tree for the
 right-hand side instead of compiling it.  Compilation is deferred to the
 environment where the expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_selection_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd selection: TBP>>
   end type cmd_selection_t
 
 @ %def cmd_selection_t
 @ Output. Do not print the parse tree, since this may get cluttered.
 Just a message that scale, renormalization and factorization have been
 defined, respectively.
 <<Commands: cmd selection: TBP>>=
   procedure :: write => cmd_selection_write
 <<Commands: procedures>>=
   subroutine cmd_selection_write (cmd, unit, indent)
     class(cmd_selection_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "selection expression: [defined]"
   end subroutine cmd_selection_write
 
 @ %def cmd_selection_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd selection: TBP>>=
   procedure :: compile => cmd_selection_compile
 <<Commands: procedures>>=
   subroutine cmd_selection_compile (cmd, global)
     class(cmd_selection_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_selection_compile
 
 @ %def cmd_selection_compile
 @ Instead of evaluating the expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd selection: TBP>>=
   procedure :: execute => cmd_selection_execute
 <<Commands: procedures>>=
   subroutine cmd_selection_execute (cmd, global)
     class(cmd_selection_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%selection_lexpr => cmd%pn_expr
   end subroutine cmd_selection_execute
 
 @ %def cmd_selection_execute
 @
 \subsubsection{Reweight}
 Define a reweight expression.  This is to be applied upon simulation or
 event-file rescanning, event by event.  We store the parse tree for the
 right-hand side instead of compiling it.  Compilation is deferred to the
 environment where the expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_reweight_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd reweight: TBP>>
   end type cmd_reweight_t
 
 @ %def cmd_reweight_t
 @ Output. Do not print the parse tree, since this may get cluttered.
 Just a message that scale, renormalization and factorization have been
 defined, respectively.
 <<Commands: cmd reweight: TBP>>=
   procedure :: write => cmd_reweight_write
 <<Commands: procedures>>=
   subroutine cmd_reweight_write (cmd, unit, indent)
     class(cmd_reweight_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "reweight expression: [defined]"
   end subroutine cmd_reweight_write
 
 @ %def cmd_reweight_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd reweight: TBP>>=
   procedure :: compile => cmd_reweight_compile
 <<Commands: procedures>>=
   subroutine cmd_reweight_compile (cmd, global)
     class(cmd_reweight_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_reweight_compile
 
 @ %def cmd_reweight_compile
 @ Instead of evaluating the expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd reweight: TBP>>=
   procedure :: execute => cmd_reweight_execute
 <<Commands: procedures>>=
   subroutine cmd_reweight_execute (cmd, global)
     class(cmd_reweight_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%reweight_expr => cmd%pn_expr
   end subroutine cmd_reweight_execute
 
 @ %def cmd_reweight_execute
 @
 \subsubsection{Alternative Simulation Setups}
 Together with simulation, we can re-evaluate event weights in the context of
 alternative setups.  The [[cmd_alt_setup_t]] object is designed to hold these
 setups, which are brace-enclosed command lists.  Compilation is deferred to
 the simulation environment where the setup expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_alt_setup_t
      private
      type(parse_node_p), dimension(:), allocatable :: setup
    contains
    <<Commands: cmd alt setup: TBP>>
   end type cmd_alt_setup_t
 
 @ %def cmd_alt_setup_t
 @ Output.  Print just a message that the alternative setup list has been
 defined.
 <<Commands: cmd alt setup: TBP>>=
   procedure :: write => cmd_alt_setup_write
 <<Commands: procedures>>=
   subroutine cmd_alt_setup_write (cmd, unit, indent)
     class(cmd_alt_setup_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,I0,A)")  "alt_setup: ", size (cmd%setup), " entries"
   end subroutine cmd_alt_setup_write
 
 @ %def cmd_alt_setup_write
 @ Compile.  Store the parse sub-trees in an array.
 <<Commands: cmd alt setup: TBP>>=
   procedure :: compile => cmd_alt_setup_compile
 <<Commands: procedures>>=
   subroutine cmd_alt_setup_compile (cmd, global)
     class(cmd_alt_setup_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_list, pn_setup
     integer :: i
     pn_list => parse_node_get_sub_ptr (cmd%pn, 3)
     if (associated (pn_list)) then
        allocate (cmd%setup (parse_node_get_n_sub (pn_list)))
        i = 1
        pn_setup => parse_node_get_sub_ptr (pn_list)
        do while (associated (pn_setup))
           cmd%setup(i)%ptr => pn_setup
           i = i + 1
           pn_setup => parse_node_get_next_ptr (pn_setup)
        end do
     else
        allocate (cmd%setup (0))
     end if
   end subroutine cmd_alt_setup_compile
 
 @ %def cmd_alt_setup_compile
 @ Execute.  Transfer the array of command lists to the global environment.
 <<Commands: cmd alt setup: TBP>>=
   procedure :: execute => cmd_alt_setup_execute
 <<Commands: procedures>>=
   subroutine cmd_alt_setup_execute (cmd, global)
     class(cmd_alt_setup_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (allocated (global%pn%alt_setup))  deallocate (global%pn%alt_setup)
     allocate (global%pn%alt_setup (size (cmd%setup)))
     global%pn%alt_setup = cmd%setup
   end subroutine cmd_alt_setup_execute
 
 @ %def cmd_alt_setup_execute
 @
 \subsubsection{Integration}
 Integrate several processes, consecutively with identical parameters.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_integrate_t
      private
      integer :: n_proc = 0
      type(string_t), dimension(:), allocatable :: process_id
    contains
    <<Commands: cmd integrate: TBP>>
   end type cmd_integrate_t
 
 @ %def cmd_integrate_t
 @ Output: we know the process IDs.
 <<Commands: cmd integrate: TBP>>=
   procedure :: write => cmd_integrate_write
 <<Commands: procedures>>=
   subroutine cmd_integrate_write (cmd, unit, indent)
     class(cmd_integrate_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "integrate ("
     do i = 1, cmd%n_proc
        if (i > 1)  write (u, "(A,1x)", advance="no")  ","
        write (u, "(A)", advance="no")  char (cmd%process_id(i))
     end do
     write (u, "(A)")  ")"
   end subroutine cmd_integrate_write
 
 @ %def cmd_integrate_write
 @ Compile.
 <<Commands: cmd integrate: TBP>>=
   procedure :: compile => cmd_integrate_compile
 <<Commands: procedures>>=
   subroutine cmd_integrate_compile (cmd, global)
     class(cmd_integrate_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_proclist, pn_proc
     integer :: i
     pn_proclist => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
     call cmd%compile_options (global)
     cmd%n_proc = parse_node_get_n_sub (pn_proclist)
     allocate (cmd%process_id (cmd%n_proc))
     pn_proc => parse_node_get_sub_ptr (pn_proclist)
     do i = 1, cmd%n_proc
        cmd%process_id(i) = parse_node_get_string (pn_proc)
        call global%process_stack%init_result_vars (cmd%process_id(i))
        pn_proc => parse_node_get_next_ptr (pn_proc)
     end do
   end subroutine cmd_integrate_compile
 
 @ %def cmd_integrate_compile
 @ Command execution.  Integrate the process(es) with the predefined number
 of passes, iterations and calls.  For structure functions, cuts,
 weight and scale, use local definitions if present; by default, the local
 definitions are initialized with the global ones.
 
 The [[integrate]] procedure should take its input from the currently
 active local environment, but produce a process record in the stack of
 the global environment.
 
 Since the process acquires a snapshot of the variable list, so if the global
 list (or the local one) is deleted, this does no harm.  This implies that
 later changes of the variable list do not affect the stored process.
 <<Commands: cmd integrate: TBP>>=
   procedure :: execute => cmd_integrate_execute
 <<Commands: procedures>>=
   subroutine cmd_integrate_execute (cmd, global)
     class(cmd_integrate_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     integer :: i
     if (debug_on) call msg_debug (D_CORE, "cmd_integrate_execute")
     do i = 1, cmd%n_proc
        if (debug_on) call msg_debug (D_CORE, "cmd%process_id(i) ", cmd%process_id(i))
        call integrate_process (cmd%process_id(i), cmd%local, global)
        call global%process_stack%fill_result_vars (cmd%process_id(i))
        call global%process_stack%update_result_vars &
             (cmd%process_id(i), global%var_list)
        if (signal_is_pending ())  return
     end do
   end subroutine cmd_integrate_execute
 
 @ %def cmd_integrate_execute
 @
 \subsubsection{Observables}
 Declare an observable.  After the declaration, it can be used to
 record data, and at the end one can retrieve average and error.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_observable_t
      private
      type(string_t) :: id
    contains
    <<Commands: cmd observable: TBP>>
   end type cmd_observable_t
 
 @ %def cmd_observable_t
 @ Output.  We know the ID.
 <<Commands: cmd observable: TBP>>=
   procedure :: write => cmd_observable_write
 <<Commands: procedures>>=
   subroutine cmd_observable_write (cmd, unit, indent)
     class(cmd_observable_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A)")  "observable: ", char (cmd%id)
   end subroutine cmd_observable_write
 
 @ %def cmd_observable_write
 @ Compile.  Just record the observable ID.
 <<Commands: cmd observable: TBP>>=
   procedure :: compile => cmd_observable_compile
 <<Commands: procedures>>=
   subroutine cmd_observable_compile (cmd, global)
     class(cmd_observable_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_tag
     pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (pn_tag)) then
        cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
     end if
     call cmd%compile_options (global)
     select case (char (parse_node_get_rule_key (pn_tag)))
     case ("analysis_id")
        cmd%id = parse_node_get_string (pn_tag)
     case default
        call msg_bug ("observable: name expression not implemented (yet)")
     end select
   end subroutine cmd_observable_compile
 
 @ %def cmd_observable_compile
 @ Command execution.  This declares the observable and allocates it in
 the analysis store.
 <<Commands: cmd observable: TBP>>=
   procedure :: execute => cmd_observable_execute
 <<Commands: procedures>>=
   subroutine cmd_observable_execute (cmd, global)
     class(cmd_observable_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(graph_options_t) :: graph_options
     type(string_t) :: label, unit
     var_list => cmd%local%get_var_list_ptr ()
     label = var_list%get_sval (var_str ("$obs_label"))
     unit = var_list%get_sval (var_str ("$obs_unit"))
     call graph_options_init (graph_options)
     call set_graph_options (graph_options, var_list)
     call analysis_init_observable (cmd%id, label, unit, graph_options)
   end subroutine cmd_observable_execute
 
 @ %def cmd_observable_execute
 @
 \subsubsection{Histograms}
 Declare a histogram.  At minimum, we have to set lower and upper bound
 and bin width.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_histogram_t
      private
      type(string_t) :: id
      type(parse_node_t), pointer :: pn_lower_bound => null ()
      type(parse_node_t), pointer :: pn_upper_bound => null ()
      type(parse_node_t), pointer :: pn_bin_width => null ()
    contains
    <<Commands: cmd histogram: TBP>>
   end type cmd_histogram_t
 
 @ %def cmd_histogram_t
 @ Output.  Just print the ID.
 <<Commands: cmd histogram: TBP>>=
   procedure :: write => cmd_histogram_write
 <<Commands: procedures>>=
   subroutine cmd_histogram_write (cmd, unit, indent)
     class(cmd_histogram_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A)")  "histogram: ", char (cmd%id)
   end subroutine cmd_histogram_write
 
 @ %def cmd_histogram_write
 @ Compile.  Record the histogram ID and initialize lower, upper bound
 and bin width.
 <<Commands: cmd histogram: TBP>>=
   procedure :: compile => cmd_histogram_compile
 <<Commands: procedures>>=
   subroutine cmd_histogram_compile (cmd, global)
     class(cmd_histogram_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_tag, pn_args, pn_arg1, pn_arg2, pn_arg3
     character(*), parameter :: e_illegal_use = &
        "illegal usage of 'histogram': insufficient number of arguments"
     pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_args => parse_node_get_next_ptr (pn_tag)
     if (associated (pn_args)) then
        pn_arg1 => parse_node_get_sub_ptr (pn_args)
        if (.not. associated (pn_arg1)) call msg_fatal (e_illegal_use)
        pn_arg2 => parse_node_get_next_ptr (pn_arg1)
        if (.not. associated (pn_arg2)) call msg_fatal (e_illegal_use)
        pn_arg3 => parse_node_get_next_ptr (pn_arg2)
        cmd%pn_opt => parse_node_get_next_ptr (pn_args)
     end if
     call cmd%compile_options (global)
     select case (char (parse_node_get_rule_key (pn_tag)))
     case ("analysis_id")
        cmd%id = parse_node_get_string (pn_tag)
     case default
        call msg_bug ("histogram: name expression not implemented (yet)")
     end select
     cmd%pn_lower_bound => pn_arg1
     cmd%pn_upper_bound => pn_arg2
     cmd%pn_bin_width => pn_arg3
   end subroutine cmd_histogram_compile
 
 @ %def cmd_histogram_compile
 @ Command execution.  This declares the histogram and allocates it in
 the analysis store.
 <<Commands: cmd histogram: TBP>>=
   procedure :: execute => cmd_histogram_execute
 <<Commands: procedures>>=
   subroutine cmd_histogram_execute (cmd, global)
     class(cmd_histogram_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default) :: lower_bound, upper_bound, bin_width
     integer :: bin_number
     logical :: bin_width_is_used, normalize_bins
     type(string_t) :: obs_label, obs_unit
     type(graph_options_t) :: graph_options
     type(drawing_options_t) :: drawing_options
 
     var_list => cmd%local%get_var_list_ptr ()
     lower_bound = eval_real (cmd%pn_lower_bound, var_list)
     upper_bound = eval_real (cmd%pn_upper_bound, var_list)
     if (associated (cmd%pn_bin_width)) then
        bin_width = eval_real (cmd%pn_bin_width, var_list)
        bin_width_is_used = .true.
     else if (var_list%is_known (var_str ("n_bins"))) then
        bin_number = &
             var_list%get_ival (var_str ("n_bins"))
        bin_width_is_used = .false.
     else
        call msg_error ("Cmd '" // char (cmd%id) // &
             "': neither bin width nor number is defined")
     end if
     normalize_bins = &
          var_list%get_lval (var_str ("?normalize_bins"))
     obs_label = &
          var_list%get_sval (var_str ("$obs_label"))
     obs_unit = &
          var_list%get_sval (var_str ("$obs_unit"))
 
     call graph_options_init (graph_options)
     call set_graph_options (graph_options, var_list)
     call drawing_options_init_histogram (drawing_options)
     call set_drawing_options (drawing_options, var_list)
 
     if (bin_width_is_used) then
        call analysis_init_histogram &
             (cmd%id, lower_bound, upper_bound, bin_width, &
              normalize_bins, &
              obs_label, obs_unit, &
              graph_options, drawing_options)
     else
        call analysis_init_histogram &
             (cmd%id, lower_bound, upper_bound, bin_number, &
              normalize_bins, &
              obs_label, obs_unit, &
              graph_options, drawing_options)
     end if
   end subroutine cmd_histogram_execute
 
 @ %def cmd_histogram_execute
 @ Set the graph options from a variable list.
 <<Commands: procedures>>=
   subroutine set_graph_options (gro, var_list)
     type(graph_options_t), intent(inout) :: gro
     type(var_list_t), intent(in) :: var_list
     call graph_options_set (gro, title = &
          var_list%get_sval (var_str ("$title")))
     call graph_options_set (gro, description = &
          var_list%get_sval (var_str ("$description")))
     call graph_options_set (gro, x_label = &
          var_list%get_sval (var_str ("$x_label")))
     call graph_options_set (gro, y_label = &
          var_list%get_sval (var_str ("$y_label")))
     call graph_options_set (gro, width_mm = &
          var_list%get_ival (var_str ("graph_width_mm")))
     call graph_options_set (gro, height_mm = &
          var_list%get_ival (var_str ("graph_height_mm")))
     call graph_options_set (gro, x_log = &
          var_list%get_lval (var_str ("?x_log")))
     call graph_options_set (gro, y_log = &
          var_list%get_lval (var_str ("?y_log")))
     if (var_list%is_known (var_str ("x_min"))) &
          call graph_options_set (gro, x_min = &
          var_list%get_rval (var_str ("x_min")))
     if (var_list%is_known (var_str ("x_max"))) &
          call graph_options_set (gro, x_max = &
          var_list%get_rval (var_str ("x_max")))
     if (var_list%is_known (var_str ("y_min"))) &
          call graph_options_set (gro, y_min = &
          var_list%get_rval (var_str ("y_min")))
     if (var_list%is_known (var_str ("y_max"))) &
          call graph_options_set (gro, y_max = &
          var_list%get_rval (var_str ("y_max")))
     call graph_options_set (gro, gmlcode_bg = &
          var_list%get_sval (var_str ("$gmlcode_bg")))
     call graph_options_set (gro, gmlcode_fg = &
          var_list%get_sval (var_str ("$gmlcode_fg")))
   end subroutine set_graph_options
 
 @ %def set_graph_options
 @ Set the drawing options from a variable list.
 <<Commands: procedures>>=
   subroutine set_drawing_options (dro, var_list)
     type(drawing_options_t), intent(inout) :: dro
     type(var_list_t), intent(in) :: var_list
     if (var_list%is_known (var_str ("?draw_histogram"))) then
        if (var_list%get_lval (var_str ("?draw_histogram"))) then
           call drawing_options_set (dro, with_hbars = .true.)
        else
           call drawing_options_set (dro, with_hbars = .false., &
                with_base = .false., fill = .false., piecewise = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?draw_base"))) then
        if (var_list%get_lval (var_str ("?draw_base"))) then
           call drawing_options_set (dro, with_base = .true.)
        else
           call drawing_options_set (dro, with_base = .false., fill = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?draw_piecewise"))) then
        if (var_list%get_lval (var_str ("?draw_piecewise"))) then
           call drawing_options_set (dro, piecewise = .true.)
        else
           call drawing_options_set (dro, piecewise = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?fill_curve"))) then
        if (var_list%get_lval (var_str ("?fill_curve"))) then
           call drawing_options_set (dro, fill = .true., with_base = .true.)
        else
           call drawing_options_set (dro, fill = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?draw_curve"))) then
        if (var_list%get_lval (var_str ("?draw_curve"))) then
           call drawing_options_set (dro, draw = .true.)
        else
           call drawing_options_set (dro, draw = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?draw_errors"))) then
        if (var_list%get_lval (var_str ("?draw_errors"))) then
           call drawing_options_set (dro, err = .true.)
        else
           call drawing_options_set (dro, err = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?draw_symbols"))) then
        if (var_list%get_lval (var_str ("?draw_symbols"))) then
           call drawing_options_set (dro, symbols = .true.)
        else
           call drawing_options_set (dro, symbols = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("$fill_options"))) then
        call drawing_options_set (dro, fill_options = &
             var_list%get_sval (var_str ("$fill_options")))
     end if
     if (var_list%is_known (var_str ("$draw_options"))) then
        call drawing_options_set (dro, draw_options = &
             var_list%get_sval (var_str ("$draw_options")))
     end if
     if (var_list%is_known (var_str ("$err_options"))) then
        call drawing_options_set (dro, err_options = &
             var_list%get_sval (var_str ("$err_options")))
     end if
     if (var_list%is_known (var_str ("$symbol"))) then
        call drawing_options_set (dro, symbol = &
             var_list%get_sval (var_str ("$symbol")))
     end if
     if (var_list%is_known (var_str ("$gmlcode_bg"))) then
        call drawing_options_set (dro, gmlcode_bg = &
             var_list%get_sval (var_str ("$gmlcode_bg")))
     end if
     if (var_list%is_known (var_str ("$gmlcode_fg"))) then
        call drawing_options_set (dro, gmlcode_fg = &
             var_list%get_sval (var_str ("$gmlcode_fg")))
     end if
   end subroutine set_drawing_options
 
 @ %def set_drawing_options
 @
 \subsubsection{Plots}
 Declare a plot.  No mandatory arguments, just options.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_plot_t
      private
      type(string_t) :: id
    contains
    <<Commands: cmd plot: TBP>>
   end type cmd_plot_t
 
 @ %def cmd_plot_t
 @ Output.  Just print the ID.
 <<Commands: cmd plot: TBP>>=
   procedure :: write => cmd_plot_write
 <<Commands: procedures>>=
   subroutine cmd_plot_write (cmd, unit, indent)
     class(cmd_plot_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A)")  "plot: ", char (cmd%id)
   end subroutine cmd_plot_write
 
 @ %def cmd_plot_write
 @ Compile.  Record the plot ID and initialize lower, upper bound
 and bin width.
 <<Commands: cmd plot: TBP>>=
   procedure :: compile => cmd_plot_compile
 <<Commands: procedures>>=
   subroutine cmd_plot_compile (cmd, global)
     class(cmd_plot_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_tag
     pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
     call cmd%init (pn_tag, global)
   end subroutine cmd_plot_compile
 
 @ %def cmd_plot_compile
 @ This init routine is separated because it is reused below for graph
 initialization.
 <<Commands: cmd plot: TBP>>=
   procedure :: init => cmd_plot_init
 <<Commands: procedures>>=
   subroutine cmd_plot_init (plot, pn_tag, global)
     class(cmd_plot_t), intent(inout) :: plot
     type(parse_node_t), intent(in), pointer :: pn_tag
     type(rt_data_t), intent(inout), target :: global
     call plot%compile_options (global)
     select case (char (parse_node_get_rule_key (pn_tag)))
     case ("analysis_id")
        plot%id = parse_node_get_string (pn_tag)
     case default
        call msg_bug ("plot: name expression not implemented (yet)")
     end select
   end subroutine cmd_plot_init
 
 @ %def cmd_plot_init
 @ Command execution.  This declares the plot and allocates it in
 the analysis store.
 <<Commands: cmd plot: TBP>>=
   procedure :: execute => cmd_plot_execute
 <<Commands: procedures>>=
   subroutine cmd_plot_execute (cmd, global)
     class(cmd_plot_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(graph_options_t) :: graph_options
     type(drawing_options_t) :: drawing_options
 
     var_list => cmd%local%get_var_list_ptr ()
     call graph_options_init (graph_options)
     call set_graph_options (graph_options, var_list)
     call drawing_options_init_plot (drawing_options)
     call set_drawing_options (drawing_options, var_list)
 
     call analysis_init_plot (cmd%id, graph_options, drawing_options)
   end subroutine cmd_plot_execute
 
 @ %def cmd_plot_execute
 @
 \subsubsection{Graphs}
 Declare a graph.  The graph is defined in terms of its contents.  Both the
 graph and its contents may carry options.
 
 The graph object contains its own ID as well as the IDs of its elements.  For
 the elements, we reuse the [[cmd_plot_t]] defined above.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_graph_t
      private
      type(string_t) :: id
      integer :: n_elements = 0
      type(cmd_plot_t), dimension(:), allocatable :: el
      type(string_t), dimension(:), allocatable :: element_id
    contains
    <<Commands: cmd graph: TBP>>
   end type cmd_graph_t
 
 @ %def cmd_graph_t
 @ Output.  Just print the ID.
 <<Commands: cmd graph: TBP>>=
   procedure :: write => cmd_graph_write
 <<Commands: procedures>>=
   subroutine cmd_graph_write (cmd, unit, indent)
     class(cmd_graph_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A,A,I0,A)")  "graph: ", char (cmd%id), &
          " (", cmd%n_elements, " entries)"
   end subroutine cmd_graph_write
 
 @ %def cmd_graph_write
 @ Compile.  Record the graph ID and initialize lower, upper bound
 and bin width.  For compiling the graph element syntax, we use part of the
 [[cmd_plot_t]] compiler.
 
 Note: currently, we do not respect options, therefore just IDs on the RHS.
 <<Commands: cmd graph: TBP>>=
   procedure :: compile => cmd_graph_compile
 <<Commands: procedures>>=
   subroutine cmd_graph_compile (cmd, global)
     class(cmd_graph_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_term, pn_tag, pn_def, pn_app
     integer :: i
 
     pn_term => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_tag => parse_node_get_sub_ptr (pn_term)
     cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
     call cmd%compile_options (global)
     select case (char (parse_node_get_rule_key (pn_tag)))
     case ("analysis_id")
        cmd%id = parse_node_get_string (pn_tag)
     case default
        call msg_bug ("graph: name expression not implemented (yet)")
     end select
     pn_def => parse_node_get_next_ptr (pn_term, 2)
     cmd%n_elements = parse_node_get_n_sub (pn_def)
     allocate (cmd%element_id (cmd%n_elements))
     allocate (cmd%el (cmd%n_elements))
     pn_term => parse_node_get_sub_ptr (pn_def)
     pn_tag => parse_node_get_sub_ptr (pn_term)
     cmd%el(1)%pn_opt => parse_node_get_next_ptr (pn_tag)
     call cmd%el(1)%init (pn_tag, global)
     cmd%element_id(1) = parse_node_get_string (pn_tag)
     pn_app => parse_node_get_next_ptr (pn_term)
     do i = 2, cmd%n_elements
        pn_term => parse_node_get_sub_ptr (pn_app, 2)
        pn_tag => parse_node_get_sub_ptr (pn_term)
        cmd%el(i)%pn_opt => parse_node_get_next_ptr (pn_tag)
        call cmd%el(i)%init (pn_tag, global)
        cmd%element_id(i) = parse_node_get_string (pn_tag)
        pn_app => parse_node_get_next_ptr (pn_app)
     end do
 
   end subroutine cmd_graph_compile
 
 @ %def cmd_graph_compile
 @ Command execution.  This declares the graph, allocates it in
 the analysis store, and copies the graph elements.
 
 For the graph, we set graph and default drawing options.  For the elements, we
 reset individual drawing options.
 
 This accesses internals of the contained elements of type [[cmd_plot_t]], see
 above.  We might disentangle such an interdependency when this code is
 rewritten using proper type extension.
 <<Commands: cmd graph: TBP>>=
   procedure :: execute => cmd_graph_execute
 <<Commands: procedures>>=
   subroutine cmd_graph_execute (cmd, global)
     class(cmd_graph_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(graph_options_t) :: graph_options
     type(drawing_options_t) :: drawing_options
     integer :: i, type
 
     var_list => cmd%local%get_var_list_ptr ()
     call graph_options_init (graph_options)
     call set_graph_options (graph_options, var_list)
     call analysis_init_graph (cmd%id, cmd%n_elements, graph_options)
 
     do i = 1, cmd%n_elements
        if (associated (cmd%el(i)%options)) then
           call cmd%el(i)%options%execute (cmd%el(i)%local)
        end if
        type = analysis_store_get_object_type (cmd%element_id(i))
        select case (type)
        case (AN_HISTOGRAM)
           call drawing_options_init_histogram (drawing_options)
        case (AN_PLOT)
           call drawing_options_init_plot (drawing_options)
        end select
        call set_drawing_options (drawing_options, var_list)
        if (associated (cmd%el(i)%options)) then
           call set_drawing_options (drawing_options, cmd%el(i)%local%var_list)
        end if
        call analysis_fill_graph (cmd%id, i, cmd%element_id(i), drawing_options)
     end do
   end subroutine cmd_graph_execute
 
 @ %def cmd_graph_execute
 @
 \subsubsection{Analysis}
 Hold the analysis ID either as a string or as an expression:
 <<Commands: types>>=
   type :: analysis_id_t
     type(string_t) :: tag
     type(parse_node_t), pointer :: pn_sexpr => null ()
   end type analysis_id_t
 
 @ %def analysis_id_t
 @ Define the analysis expression.  We store the parse tree for the
 right-hand side instead of compiling it.  Compilation is deferred to
 the process environment where the analysis expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_analysis_t
      private
      type(parse_node_t), pointer :: pn_lexpr => null ()
    contains
    <<Commands: cmd analysis: TBP>>
   end type cmd_analysis_t
 
 @ %def cmd_analysis_t
 @ Output.  Print just a message that analysis has been defined.
 <<Commands: cmd analysis: TBP>>=
   procedure :: write => cmd_analysis_write
 <<Commands: procedures>>=
   subroutine cmd_analysis_write (cmd, unit, indent)
     class(cmd_analysis_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "analysis: [defined]"
   end subroutine cmd_analysis_write
 
 @ %def cmd_analysis_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd analysis: TBP>>=
   procedure :: compile => cmd_analysis_compile
 <<Commands: procedures>>=
   subroutine cmd_analysis_compile (cmd, global)
     class(cmd_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_analysis_compile
 
 @ %def cmd_analysis_compile
 @ Instead of evaluating the cut expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd analysis: TBP>>=
   procedure :: execute => cmd_analysis_execute
 <<Commands: procedures>>=
   subroutine cmd_analysis_execute (cmd, global)
     class(cmd_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%analysis_lexpr => cmd%pn_lexpr
   end subroutine cmd_analysis_execute
 
 @ %def cmd_analysis_execute
 @
 \subsubsection{Write histograms and plots}
 The data type encapsulating the command:
 <<Commands: types>>=
   type, extends (command_t) :: cmd_write_analysis_t
      private
      type(analysis_id_t), dimension(:), allocatable :: id
      type(string_t), dimension(:), allocatable :: tag
    contains
    <<Commands: cmd write analysis: TBP>>
   end type cmd_write_analysis_t
 
 @ %def analysis_id_t
 @ %def cmd_write_analysis_t
 @ Output.  Just the keyword.
 <<Commands: cmd write analysis: TBP>>=
   procedure :: write => cmd_write_analysis_write
 <<Commands: procedures>>=
   subroutine cmd_write_analysis_write (cmd, unit, indent)
     class(cmd_write_analysis_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "write_analysis"
   end subroutine cmd_write_analysis_write
 
 @ %def cmd_write_analysis_write
 @ Compile.
 <<Commands: cmd write analysis: TBP>>=
   procedure :: compile => cmd_write_analysis_compile
 <<Commands: procedures>>=
   subroutine cmd_write_analysis_compile (cmd, global)
     class(cmd_write_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_clause, pn_args, pn_id
     integer :: n, i
     pn_clause => parse_node_get_sub_ptr (cmd%pn)
     pn_args => parse_node_get_sub_ptr (pn_clause, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_clause)
     call cmd%compile_options (global)
     if (associated (pn_args)) then
        n = parse_node_get_n_sub (pn_args)
        allocate (cmd%id (n))
        do i = 1, n
            pn_id => parse_node_get_sub_ptr (pn_args, i)
            if (char (parse_node_get_rule_key (pn_id)) == "analysis_id") then
               cmd%id(i)%tag = parse_node_get_string (pn_id)
            else
               cmd%id(i)%pn_sexpr => pn_id
            end if
        end do
     else
        allocate (cmd%id (0))
     end if
   end subroutine cmd_write_analysis_compile
 
 @ %def cmd_write_analysis_compile
 @ The output format for real data values:
 <<Commands: parameters>>=
   character(*), parameter, public :: &
        DEFAULT_ANALYSIS_FILENAME = "whizard_analysis.dat"
   character(len=1), dimension(2), parameter, public :: &
        FORBIDDEN_ENDINGS1 = [ "o", "a" ]
   character(len=2), dimension(6), parameter, public :: &
        FORBIDDEN_ENDINGS2 = [ "mp", "ps", "vg", "pg", "lo", "la" ]
   character(len=3), dimension(18), parameter, public :: &
        FORBIDDEN_ENDINGS3 = [ "aux", "dvi", "evt", "evx", "f03", "f90", &
           "f95", "log", "ltp", "mpx", "olc", "olp", "pdf", "phs", "sin", &
           "tex", "vg2", "vgx" ]
 
 @ %def DEFAULT_ANALYSIS_FILENAME
 @ %def FORBIDDEN_ENDINGS1
 @ %def FORBIDDEN_ENDINGS2
 @ %def FORBIDDEN_ENDINGS3
 @ As this contains a lot of similar code to [[cmd_compile_analysis_execute]]
 we outsource the main code to a subroutine.
 <<Commands: cmd write analysis: TBP>>=
   procedure :: execute => cmd_write_analysis_execute
 <<Commands: procedures>>=
   subroutine cmd_write_analysis_execute (cmd, global)
     class(cmd_write_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     var_list => cmd%local%get_var_list_ptr ()
     call write_analysis_wrap (var_list, global%out_files, &
          cmd%id, tag = cmd%tag)
   end subroutine cmd_write_analysis_execute
 
 @ %def cmd_write_analysis_execute
 @ If the [[data_file]] optional argument is present, this is
 called from [[cmd_compile_analysis_execute]], which needs the file name for
 further processing, and requires the default format.  For the moment,
 parameters and macros for custom data processing are disabled.
 <<Commands: procedures>>=
   subroutine write_analysis_wrap (var_list, out_files, id, tag, data_file)
     type(var_list_t), intent(inout), target :: var_list
     type(file_list_t), intent(inout), target :: out_files
     type(analysis_id_t), dimension(:), intent(in), target :: id
     type(string_t), dimension(:), allocatable, intent(out) :: tag
     type(string_t), intent(out), optional :: data_file
     type(string_t) :: defaultfile, file
     integer :: i
     logical :: keep_open !, custom, header, columns
     type(string_t) :: extension !, comment_prefix, separator
 !!! JRR: WK please check (#542)
 !     integer :: type
 !     type(ifile_t) :: ifile
     logical :: one_file !, has_writer
 !     type(analysis_iterator_t) :: iterator
 !     type(rt_data_t), target :: sandbox
 !     type(command_list_t) :: writer
     defaultfile = var_list%get_sval (var_str ("$out_file"))
     if (present (data_file)) then
        if (defaultfile == "" .or. defaultfile == ".") then
           defaultfile = DEFAULT_ANALYSIS_FILENAME
        else
           if (scan (".", defaultfile) > 0) then
              call split (defaultfile, extension, ".", back=.true.)
              if (any (lower_case (char(extension)) == FORBIDDEN_ENDINGS1) .or. &
                  any (lower_case (char(extension)) == FORBIDDEN_ENDINGS2) .or. &
                  any (lower_case (char(extension)) == FORBIDDEN_ENDINGS3)) &
                  call msg_fatal ("The ending " // char(extension) // &
                  " is internal and not allowed as data file.")
              if (extension /= "") then
                 if (defaultfile /= "") then
                    defaultfile = defaultfile // "." // extension
                 else
                    defaultfile = "whizard_analysis." // extension
                 end if
              else
                 defaultfile = defaultfile // ".dat"
              endif
           else
              defaultfile = defaultfile // ".dat"
           end if
        end if
        data_file = defaultfile
     end if
     one_file = defaultfile /= ""
     if (one_file) then
        file = defaultfile
        keep_open = file_list_is_open (out_files, file, &
             action = "write")
        if (keep_open) then
           if (present (data_file)) then
              call msg_fatal ("Compiling analysis: File '" &
                   // char (data_file) &
                    // "' can't be used, it is already open.")
           else
              call msg_message ("Appending analysis data to file '" &
                   // char (file) // "'")
           end if
        else
           call file_list_open (out_files, file, &
                action = "write", status = "replace", position = "asis")
           call msg_message ("Writing analysis data to file '" &
                // char (file) // "'")
        end if
     end if
 
 !!! JRR: WK please check. Custom data output. Ticket #542
 !     if (present (data_file)) then
 !        custom = .false.
 !     else
 !        custom = var_list%get_lval (&
 !            var_str ("?out_custom"))
 !     end if
 !     comment_prefix = var_list%get_sval (&
 !          var_str ("$out_comment"))
 !     header = var_list%get_lval (&
 !          var_str ("?out_header"))
 !     write_yerr = var_list%get_lval (&
 !          var_str ("?out_yerr"))
 !     write_xerr = var_list%get_lval (&
 !          var_str ("?out_xerr"))
 
     call get_analysis_tags (tag, id, var_list)
     do i = 1, size (tag)
        call file_list_write_analysis &
             (out_files, file, tag(i))
     end do
     if (one_file .and. .not. keep_open) then
        call file_list_close (out_files, file)
     end if
 
   contains
 
     subroutine get_analysis_tags (analysis_tag, id, var_list)
       type(string_t), dimension(:), intent(out), allocatable :: analysis_tag
       type(analysis_id_t), dimension(:), intent(in) :: id
       type(var_list_t), intent(in), target :: var_list
       if (size (id) /= 0) then
          allocate (analysis_tag (size (id)))
          do i = 1, size (id)
             if (associated (id(i)%pn_sexpr)) then
                analysis_tag(i) = eval_string (id(i)%pn_sexpr, var_list)
             else
                analysis_tag(i) = id(i)%tag
             end if
          end do
       else
          call analysis_store_get_ids (tag)
       end if
     end subroutine get_analysis_tags
 
   end subroutine write_analysis_wrap
 
 @ %def write_analysis_wrap
 \subsubsection{Compile analysis results}
 This command writes files in a form suitable for GAMELAN and executes the
 appropriate commands to compile them.  The first part is identical to
 [[cmd_write_analysis]].
 <<Commands: types>>=
   type, extends (command_t) :: cmd_compile_analysis_t
      private
      type(analysis_id_t), dimension(:), allocatable :: id
      type(string_t), dimension(:), allocatable :: tag
    contains
    <<Commands: cmd compile analysis: TBP>>
   end type cmd_compile_analysis_t
 
 @ %def cmd_compile_analysis_t
 @ Output.  Just the keyword.
 <<Commands: cmd compile analysis: TBP>>=
   procedure :: write => cmd_compile_analysis_write
 <<Commands: procedures>>=
   subroutine cmd_compile_analysis_write (cmd, unit, indent)
     class(cmd_compile_analysis_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "compile_analysis"
   end subroutine cmd_compile_analysis_write
 
 @ %def cmd_compile_analysis_write
 @ Compile.
 <<Commands: cmd compile analysis: TBP>>=
   procedure :: compile => cmd_compile_analysis_compile
 <<Commands: procedures>>=
   subroutine cmd_compile_analysis_compile (cmd, global)
     class(cmd_compile_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_clause, pn_args, pn_id
     integer :: n, i
     pn_clause => parse_node_get_sub_ptr (cmd%pn)
     pn_args => parse_node_get_sub_ptr (pn_clause, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_clause)
     call cmd%compile_options (global)
     if (associated (pn_args)) then
        n = parse_node_get_n_sub (pn_args)
        allocate (cmd%id (n))
        do i = 1, n
            pn_id => parse_node_get_sub_ptr (pn_args, i)
            if (char (parse_node_get_rule_key (pn_id)) == "analysis_id") then
               cmd%id(i)%tag = parse_node_get_string (pn_id)
            else
               cmd%id(i)%pn_sexpr => pn_id
            end if
        end do
     else
        allocate (cmd%id (0))
     end if
   end subroutine cmd_compile_analysis_compile
 
 @ %def cmd_compile_analysis_compile
 @ First write the analysis data to file, then write a GAMELAN driver and
 produce MetaPost and \TeX\ output.
 <<Commands: cmd compile analysis: TBP>>=
   procedure :: execute => cmd_compile_analysis_execute
 <<Commands: procedures>>=
   subroutine cmd_compile_analysis_execute (cmd, global)
     class(cmd_compile_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(string_t) :: file, basename, extension, driver_file, &
          makefile
     integer :: u_driver, u_makefile
     logical :: has_gmlcode, only_file
     var_list => cmd%local%get_var_list_ptr ()
     call write_analysis_wrap (var_list, &
          global%out_files, cmd%id, tag = cmd%tag, &
             data_file = file)
     basename = file
     if (scan (".", basename) > 0) then
       call split (basename, extension, ".", back=.true.)
     else
       extension = ""
     end if
     driver_file = basename // ".tex"
     makefile = basename // "_ana.makefile"
     u_driver = free_unit ()
     open (unit=u_driver, file=char(driver_file), &
           action="write", status="replace")
     if (allocated (cmd%tag)) then
        call analysis_write_driver (file, cmd%tag, unit=u_driver)
        has_gmlcode = analysis_has_plots (cmd%tag)
     else
        call analysis_write_driver (file, unit=u_driver)
        has_gmlcode = analysis_has_plots ()
     end if
     close (u_driver)
     u_makefile = free_unit ()
     open (unit=u_makefile, file=char(makefile), &
          action="write", status="replace")
     call analysis_write_makefile (basename, u_makefile, &
          has_gmlcode, global%os_data)
     close (u_makefile)
     call msg_message ("Compiling analysis results display in '" &
          // char (driver_file) // "'")
     call msg_message ("Providing analysis steering makefile '" &
          // char (makefile) // "'")
     only_file = global%var_list%get_lval &
          (var_str ("?analysis_file_only"))
     if (.not. only_file)  call analysis_compile_tex &
          (basename, has_gmlcode, global%os_data)
   end subroutine cmd_compile_analysis_execute
 
 @ %def cmd_compile_analysis_execute
 @
 \subsection{User-controlled output to data files}
 
 \subsubsection{Open file (output)}
 Open a file for output.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_open_out_t
      private
      type(parse_node_t), pointer :: file_expr => null ()
    contains
    <<Commands: cmd open out: TBP>>
   end type cmd_open_out_t
 
 @ %def cmd_open_out
 @ Finalizer for the embedded eval tree.
 <<Commands: procedures>>=
   subroutine cmd_open_out_final (object)
     class(cmd_open_out_t), intent(inout) :: object
   end subroutine cmd_open_out_final
 
 @ %def cmd_open_out_final
 @ Output (trivial here).
 <<Commands: cmd open out: TBP>>=
   procedure :: write => cmd_open_out_write
 <<Commands: procedures>>=
   subroutine cmd_open_out_write (cmd, unit, indent)
     class(cmd_open_out_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "open_out: <filename>"
   end subroutine cmd_open_out_write
 
 @ %def cmd_open_out_write
 @ Compile: create an eval tree for the filename expression.
 <<Commands: cmd open out: TBP>>=
   procedure :: compile => cmd_open_out_compile
 <<Commands: procedures>>=
   subroutine cmd_open_out_compile (cmd, global)
     class(cmd_open_out_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%file_expr => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (cmd%file_expr)) then
        cmd%pn_opt => parse_node_get_next_ptr (cmd%file_expr)
     end if
     call cmd%compile_options (global)
   end subroutine cmd_open_out_compile
 
 @ %def cmd_open_out_compile
 @ Execute: append the file to the global list of open files.
 <<Commands: cmd open out: TBP>>=
   procedure :: execute => cmd_open_out_execute
 <<Commands: procedures>>=
   subroutine cmd_open_out_execute (cmd, global)
     class(cmd_open_out_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(eval_tree_t) :: file_expr
     type(string_t) :: file
     var_list => cmd%local%get_var_list_ptr ()
     call file_expr%init_sexpr (cmd%file_expr, var_list)
     call file_expr%evaluate ()
     if (file_expr%is_known ()) then
        file = file_expr%get_string ()
        call file_list_open (global%out_files, file, &
             action = "write", status = "replace", position = "asis")
     else
        call msg_fatal ("open_out: file name argument evaluates to unknown")
     end if
     call file_expr%final ()
   end subroutine cmd_open_out_execute
 
 @ %def cmd_open_out_execute
 
 \subsubsection{Open file (output)}
 Close an output file.  Except for the [[execute]] method, everything is
 analogous to the open command, so we can just inherit.
 <<Commands: types>>=
   type, extends (cmd_open_out_t) :: cmd_close_out_t
      private
    contains
    <<Commands: cmd close out: TBP>>
   end type cmd_close_out_t
 
 @ %def cmd_close_out
 @ Execute: remove the file from the global list of output files.
 <<Commands: cmd close out: TBP>>=
   procedure :: execute => cmd_close_out_execute
 <<Commands: procedures>>=
   subroutine cmd_close_out_execute (cmd, global)
     class(cmd_close_out_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(eval_tree_t) :: file_expr
     type(string_t) :: file
     var_list => cmd%local%var_list
     call file_expr%init_sexpr (cmd%file_expr, var_list)
     call file_expr%evaluate ()
     if (file_expr%is_known ()) then
        file = file_expr%get_string ()
        call file_list_close (global%out_files, file)
     else
        call msg_fatal ("close_out: file name argument evaluates to unknown")
     end if
     call file_expr%final ()
   end subroutine cmd_close_out_execute
 
 @ %def cmd_close_out_execute
 @
 \subsection{Print custom-formatted values}
 <<Commands: types>>=
   type, extends (command_t) :: cmd_printf_t
      private
      type(parse_node_t), pointer :: sexpr => null ()
      type(parse_node_t), pointer :: sprintf_fun => null ()
      type(parse_node_t), pointer :: sprintf_clause => null ()
      type(parse_node_t), pointer :: sprintf => null ()
    contains
    <<Commands: cmd printf: TBP>>
   end type cmd_printf_t
 
 @ %def cmd_printf_t
 @ Finalize.
 <<Commands: cmd printf: TBP>>=
   procedure :: final => cmd_printf_final
 <<Commands: procedures>>=
   subroutine cmd_printf_final (cmd)
     class(cmd_printf_t), intent(inout) :: cmd
     call parse_node_final (cmd%sexpr, recursive = .false.)
     deallocate (cmd%sexpr)
     call parse_node_final (cmd%sprintf_fun, recursive = .false.)
     deallocate (cmd%sprintf_fun)
     call parse_node_final (cmd%sprintf_clause, recursive = .false.)
     deallocate (cmd%sprintf_clause)
     call parse_node_final (cmd%sprintf, recursive = .false.)
     deallocate (cmd%sprintf)
   end subroutine cmd_printf_final
 
 @ %def cmd_printf_final
 @ Output.  Do not print the parse tree, since this may get cluttered.
 Just a message that cuts have been defined.
 <<Commands: cmd printf: TBP>>=
   procedure :: write => cmd_printf_write
 <<Commands: procedures>>=
   subroutine cmd_printf_write (cmd, unit, indent)
     class(cmd_printf_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "printf:"
   end subroutine cmd_printf_write
 
 @ %def cmd_printf_write
 @ Compile.  We create a fake parse node (subtree) with a [[sprintf]] command
 with identical arguments which can then be handled by the corresponding
 evaluation procedure.
 <<Commands: cmd printf: TBP>>=
   procedure :: compile => cmd_printf_compile
 <<Commands: procedures>>=
   subroutine cmd_printf_compile (cmd, global)
     class(cmd_printf_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_cmd, pn_clause, pn_args, pn_format
     pn_cmd => parse_node_get_sub_ptr (cmd%pn)
     pn_clause => parse_node_get_sub_ptr (pn_cmd)
     pn_format => parse_node_get_sub_ptr (pn_clause, 2)
     pn_args => parse_node_get_next_ptr (pn_clause)
     cmd%pn_opt => parse_node_get_next_ptr (pn_cmd)
     call cmd%compile_options (global)
     allocate (cmd%sexpr)
     call parse_node_create_branch (cmd%sexpr, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("sexpr")))
     allocate (cmd%sprintf_fun)
     call parse_node_create_branch (cmd%sprintf_fun, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf_fun")))
     allocate (cmd%sprintf_clause)
     call parse_node_create_branch (cmd%sprintf_clause, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf_clause")))
     allocate (cmd%sprintf)
     call parse_node_create_key (cmd%sprintf, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf")))
     call parse_node_append_sub (cmd%sprintf_clause, cmd%sprintf)
     call parse_node_append_sub (cmd%sprintf_clause, pn_format)
     call parse_node_freeze_branch (cmd%sprintf_clause)
     call parse_node_append_sub (cmd%sprintf_fun, cmd%sprintf_clause)
     if (associated (pn_args)) then
        call parse_node_append_sub (cmd%sprintf_fun, pn_args)
     end if
     call parse_node_freeze_branch (cmd%sprintf_fun)
     call parse_node_append_sub (cmd%sexpr, cmd%sprintf_fun)
     call parse_node_freeze_branch (cmd%sexpr)
   end subroutine cmd_printf_compile
 
 @ %def cmd_printf_compile
 @ Execute.  Evaluate the string (pretending this is a [[sprintf]] expression)
 and print it.
 <<Commands: cmd printf: TBP>>=
   procedure :: execute => cmd_printf_execute
 <<Commands: procedures>>=
   subroutine cmd_printf_execute (cmd, global)
     class(cmd_printf_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(string_t) :: string, file
     type(eval_tree_t) :: sprintf_expr
     logical :: advance
     var_list => cmd%local%get_var_list_ptr ()
     advance = var_list%get_lval (&
          var_str ("?out_advance"))
     file = var_list%get_sval (&
          var_str ("$out_file"))
     call sprintf_expr%init_sexpr (cmd%sexpr, var_list)
     call sprintf_expr%evaluate ()
     if (sprintf_expr%is_known ()) then
        string = sprintf_expr%get_string ()
        if (len (file) == 0) then
           call msg_result (char (string))
        else
           call file_list_write (global%out_files, file, string, advance)
        end if
     end if
   end subroutine cmd_printf_execute
 
 @ %def cmd_printf_execute
 @
 \subsubsection{Record data}
 The expression syntax already contains a [[record]] keyword; this evaluates to
 a logical which is always true, but it has the side-effect of recording data
 into analysis objects.  Here we define a command as an interface to this
 construct.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_record_t
      private
      type(parse_node_t), pointer :: pn_lexpr => null ()
    contains
    <<Commands: cmd record: TBP>>
   end type cmd_record_t
 
 @ %def cmd_record_t
 @ Output.  With the compile hack below, there is nothing of interest
 to print here.
 <<Commands: cmd record: TBP>>=
   procedure :: write => cmd_record_write
 <<Commands: procedures>>=
   subroutine cmd_record_write (cmd, unit, indent)
     class(cmd_record_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "record"
   end subroutine cmd_record_write
 
 @ %def cmd_record_write
 @ Compile.  This is a hack which transforms the [[record]] command
 into a [[record]] expression, which we handle in the [[expressions]]
 module.
 <<Commands: cmd record: TBP>>=
   procedure :: compile => cmd_record_compile
 <<Commands: procedures>>=
   subroutine cmd_record_compile (cmd, global)
     class(cmd_record_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_lexpr, pn_lsinglet, pn_lterm, pn_record
     call parse_node_create_branch (pn_lexpr, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("lexpr")))
     call parse_node_create_branch (pn_lsinglet, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("lsinglet")))
     call parse_node_append_sub (pn_lexpr, pn_lsinglet)
     call parse_node_create_branch (pn_lterm, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("lterm")))
     call parse_node_append_sub (pn_lsinglet, pn_lterm)
     pn_record => parse_node_get_sub_ptr (cmd%pn)
     call parse_node_append_sub (pn_lterm, pn_record)
     cmd%pn_lexpr => pn_lexpr
   end subroutine cmd_record_compile
 
 @ %def cmd_record_compile
 @ Command execution.  Again, transfer this to the embedded expression
 and just forget the logical result.
 <<Commands: cmd record: TBP>>=
   procedure :: execute => cmd_record_execute
 <<Commands: procedures>>=
   subroutine cmd_record_execute (cmd, global)
     class(cmd_record_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     logical :: lval
     var_list => global%get_var_list_ptr ()
     lval = eval_log (cmd%pn_lexpr, var_list)
   end subroutine cmd_record_execute
 
 @ %def cmd_record_execute
 @
 \subsubsection{Unstable particles}
 Mark a particle as unstable.  For each unstable particle, we store a
 number of decay channels and compute their respective BRs.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_unstable_t
      private
      integer :: n_proc = 0
      type(string_t), dimension(:), allocatable :: process_id
      type(parse_node_t), pointer :: pn_prt_in => null ()
    contains
    <<Commands: cmd unstable: TBP>>
   end type cmd_unstable_t
 
 @ %def cmd_unstable_t
 @ Output: we know the process IDs.
 <<Commands: cmd unstable: TBP>>=
   procedure :: write => cmd_unstable_write
 <<Commands: procedures>>=
   subroutine cmd_unstable_write (cmd, unit, indent)
     class(cmd_unstable_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,I0,1x,A)", advance="no")  &
          "unstable:", 1, "("
     do i = 1, cmd%n_proc
        if (i > 1)  write (u, "(A,1x)", advance="no")  ","
        write (u, "(A)", advance="no")  char (cmd%process_id(i))
     end do
     write (u, "(A)")  ")"
   end subroutine cmd_unstable_write
 
 @ %def cmd_unstable_write
 @ Compile.  Initiate an eval tree for the decaying particle and
 determine the decay channel process IDs.
 <<Commands: cmd unstable: TBP>>=
   procedure :: compile => cmd_unstable_compile
 <<Commands: procedures>>=
   subroutine cmd_unstable_compile (cmd, global)
     class(cmd_unstable_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_list, pn_proc
     integer :: i
     cmd%pn_prt_in => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_list => parse_node_get_next_ptr (cmd%pn_prt_in)
     if (associated (pn_list)) then
        select case (char (parse_node_get_rule_key (pn_list)))
        case ("unstable_arg")
           cmd%n_proc = parse_node_get_n_sub (pn_list)
           cmd%pn_opt => parse_node_get_next_ptr (pn_list)
        case default
           cmd%n_proc = 0
           cmd%pn_opt => pn_list
           pn_list => null ()
        end select
     end if
     call cmd%compile_options (global)
     if (associated (pn_list)) then
        allocate (cmd%process_id (cmd%n_proc))
        pn_proc => parse_node_get_sub_ptr (pn_list)
        do i = 1, cmd%n_proc
           cmd%process_id(i) = parse_node_get_string (pn_proc)
           call cmd%local%process_stack%init_result_vars (cmd%process_id(i))
           pn_proc => parse_node_get_next_ptr (pn_proc)
        end do
     else
        allocate (cmd%process_id (0))
     end if
   end subroutine cmd_unstable_compile
 
 @ %def cmd_unstable_compile
 @ Command execution.  Evaluate the decaying particle and mark the decays in
 the current model object.
 <<Commands: cmd unstable: TBP>>=
   procedure :: execute => cmd_unstable_execute
 <<Commands: procedures>>=
   subroutine cmd_unstable_execute (cmd, global)
     class(cmd_unstable_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     logical :: auto_decays, auto_decays_radiative
     integer :: auto_decays_multiplicity
     logical :: isotropic_decay, diagonal_decay, polarized_decay
     integer :: decay_helicity
     type(pdg_array_t) :: pa_in
     integer :: pdg_in
     type(string_t) :: libname_cur, libname_dec
     type(string_t), dimension(:), allocatable :: auto_id, tmp_id
     integer :: n_proc_user
     integer :: i, u_tmp
     character(80) :: buffer
     var_list => cmd%local%get_var_list_ptr ()
     auto_decays = &
          var_list%get_lval (var_str ("?auto_decays"))
     if (auto_decays) then
        auto_decays_multiplicity = &
             var_list%get_ival (var_str ("auto_decays_multiplicity"))
        auto_decays_radiative = &
             var_list%get_lval (var_str ("?auto_decays_radiative"))
     end if
     isotropic_decay = &
          var_list%get_lval (var_str ("?isotropic_decay"))
     if (isotropic_decay) then
        diagonal_decay = .false.
        polarized_decay = .false.
     else
        diagonal_decay = &
             var_list%get_lval (var_str ("?diagonal_decay"))
        if (diagonal_decay) then
           polarized_decay = .false.
        else
           polarized_decay = &
                var_list%is_known (var_str ("decay_helicity"))
           if (polarized_decay) then
              decay_helicity = var_list%get_ival (var_str ("decay_helicity"))
           end if
        end if
     end if
     pa_in = eval_pdg_array (cmd%pn_prt_in, var_list)
     if (pdg_array_get_length (pa_in) /= 1) &
          call msg_fatal ("Unstable: decaying particle must be unique")
     pdg_in = pdg_array_get (pa_in, 1)
     n_proc_user = cmd%n_proc
     if (auto_decays) then
        call create_auto_decays (pdg_in, &
             auto_decays_multiplicity, auto_decays_radiative, &
             libname_dec, auto_id, cmd%local)
        allocate (tmp_id (cmd%n_proc + size (auto_id)))
        tmp_id(:cmd%n_proc) = cmd%process_id
        tmp_id(cmd%n_proc+1:) = auto_id
        call move_alloc (from = tmp_id, to = cmd%process_id)
        cmd%n_proc = size (cmd%process_id)
     end if
     libname_cur = cmd%local%prclib%get_name ()
     do i = 1, cmd%n_proc
        if (i == n_proc_user + 1) then
           call cmd%local%update_prclib &
                (cmd%local%prclib_stack%get_library_ptr (libname_dec))
        end if
        if (.not. global%process_stack%exists (cmd%process_id(i))) then
           call var_list%set_log &
                (var_str ("?decay_rest_frame"), .false., is_known = .true.)
           call integrate_process (cmd%process_id(i), cmd%local, global)
           call global%process_stack%fill_result_vars (cmd%process_id(i))
        end if
     end do
     call cmd%local%update_prclib &
          (cmd%local%prclib_stack%get_library_ptr (libname_cur))
     if (cmd%n_proc > 0) then
        if (polarized_decay) then
           call global%modify_particle (pdg_in, stable = .false., &
                decay = cmd%process_id, &
                isotropic_decay = .false., &
                diagonal_decay = .false., &
                decay_helicity = decay_helicity, &
                polarized = .false.)
        else
           call global%modify_particle (pdg_in, stable = .false., &
                decay = cmd%process_id, &
                isotropic_decay = isotropic_decay, &
                diagonal_decay = diagonal_decay, &
                polarized = .false.)
        end if
        u_tmp = free_unit ()
        open (u_tmp, status = "scratch", action = "readwrite")
        call show_unstable (global, pdg_in, u_tmp)
        rewind (u_tmp)
        do
           read (u_tmp, "(A)", end = 1)  buffer
           write (msg_buffer, "(A)")  trim (buffer)
           call msg_message ()
        end do
 1      continue
        close (u_tmp)
     else
        call err_unstable (global, pdg_in)
     end if
   end subroutine cmd_unstable_execute
 
 @ %def cmd_unstable_execute
 @ Show data for the current unstable particle.  This is called both by
 the [[unstable]] and by the [[show]] command.
 
 To determine decay branching rations, we look at the decay process IDs
 and inspect the corresponding [[integral()]] result variables.
 <<Commands: procedures>>=
   subroutine show_unstable (global, pdg, u)
     type(rt_data_t), intent(in), target :: global
     integer, intent(in) :: pdg, u
     type(flavor_t) :: flv
     type(string_t), dimension(:), allocatable :: decay
     real(default), dimension(:), allocatable :: br
     real(default) :: width
     type(process_t), pointer :: process
     type(process_component_def_t), pointer :: prc_def
     type(string_t), dimension(:), allocatable :: prt_out, prt_out_str
     integer :: i, j
     logical :: opened
     call flv%init (pdg, global%model)
     call flv%get_decays (decay)
     if (.not. allocated (decay))  return
     allocate (prt_out_str (size (decay)))
     allocate (br (size (decay)))
     do i = 1, size (br)
        process => global%process_stack%get_process_ptr (decay(i))
        prc_def => process%get_component_def_ptr (1)
        call prc_def%get_prt_out (prt_out)
        prt_out_str(i) = prt_out(1)
        do j = 2, size (prt_out)
           prt_out_str(i) = prt_out_str(i) // ", " // prt_out(j)
        end do
        br(i) = global%get_rval ("integral(" // decay(i) // ")")
     end do
     if (all (br >= 0)) then
        if (any (br > 0)) then
           width = sum (br)
           br = br / sum (br)
           write (u, "(A)") "Unstable particle " &
                // char (flv%get_name ()) &
                // ": computed branching ratios:"
           do i = 1, size (br)
              write (u, "(2x,A,':'," // FMT_14 // ",3x,A)") &
                   char (decay(i)), br(i), char (prt_out_str(i))
           end do
           write (u, "(2x,'Total width ='," // FMT_14 // ",' GeV (computed)')")  width
           write (u, "(2x,'            ='," // FMT_14 // ",' GeV (preset)')") &
                flv%get_width ()
           if (flv%decays_isotropically ()) then
              write (u, "(2x,A)")  "Decay options: isotropic"
           else if (flv%decays_diagonal ()) then
              write (u, "(2x,A)")  "Decay options: &
                   &projection on diagonal helicity states"
           else if (flv%has_decay_helicity ()) then
              write (u, "(2x,A,1x,I0)")  "Decay options: projection onto helicity =", &
                   flv%get_decay_helicity ()
           else
              write (u, "(2x,A)")  "Decay options: helicity treated exactly"
           end if
        else
           inquire (unit = u, opened = opened)
           if (opened .and. .not. mask_fatal_errors)  close (u)
           call msg_fatal ("Unstable particle " &
                // char (flv%get_name ()) &
                // ": partial width vanishes for all decay channels")
        end if
     else
        inquire (unit = u, opened = opened)
        if (opened .and. .not. mask_fatal_errors)  close (u)
        call msg_fatal ("Unstable particle " &
                // char (flv%get_name ()) &
                // ": partial width is negative")
     end if
   end subroutine show_unstable
 
 @ %def show_unstable
 @ If no decays have been found, issue a non-fatal error.
 <<Commands: procedures>>=
   subroutine err_unstable (global, pdg)
     type(rt_data_t), intent(in), target :: global
     integer, intent(in) :: pdg
     type(flavor_t) :: flv
     call flv%init (pdg, global%model)
     call msg_error ("Unstable: no allowed decays found for particle " &
          // char (flv%get_name ()) // ", keeping as stable")
   end subroutine err_unstable
 
 @ %def err_unstable
 @ Auto decays: create process IDs and make up process
 configurations, using the PDG codes generated by the [[ds_table]] make
 method.
 
 We allocate and use a self-contained process library that contains only the
 decay processes of the current particle.  When done, we revert the global
 library pointer to the original library but return the name of the new one.
 The new library becomes part of the global library stack and can thus be
 referred to at any time.
 <<Commands: procedures>>=
   subroutine create_auto_decays &
        (pdg_in, mult, rad, libname_dec, process_id, global)
     integer, intent(in) :: pdg_in
     integer, intent(in) :: mult
     logical, intent(in) :: rad
     type(string_t), intent(out) :: libname_dec
     type(string_t), dimension(:), allocatable, intent(out) :: process_id
     type(rt_data_t), intent(inout) :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     type(ds_table_t) :: ds_table
     type(split_constraints_t) :: constraints
     type(pdg_array_t), dimension(:), allocatable :: pa_out
     character(80) :: buffer
     character :: p_or_a
     type(string_t) :: process_string, libname_cur
     type(flavor_t) :: flv_in, flv_out
     type(string_t) :: prt_in
     type(string_t), dimension(:), allocatable :: prt_out
     type(process_configuration_t) :: prc_config
     integer :: i, j, k
     call flv_in%init (pdg_in, global%model)
     if (rad) then
        call constraints%init (2)
     else
        call constraints%init (3)
        call constraints%set (3, constrain_radiation ())
     end if
     call constraints%set (1, constrain_n_tot (mult))
     call constraints%set (2, &
          constrain_mass_sum (flv_in%get_mass (), margin = 0._default))
     call ds_table%make (global%model, pdg_in, constraints)
     prt_in = flv_in%get_name ()
     if (pdg_in > 0) then
        p_or_a = "p"
     else
        p_or_a = "a"
     end if
     if (ds_table%get_length () == 0) then
        call msg_warning ("Auto-decays: Particle " // char (prt_in) // ": " &
             // "no decays found")
        libname_dec = ""
        allocate (process_id (0))
     else
        call msg_message ("Creating decay process library for particle " &
             // char (prt_in))
        libname_cur = global%prclib%get_name ()
        write (buffer, "(A,A,I0)")  "_d", p_or_a, abs (pdg_in)
        libname_dec = libname_cur // trim (buffer)
        lib => global%prclib_stack%get_library_ptr (libname_dec)
        if (.not. (associated (lib))) then
           allocate (lib_entry)
           call lib_entry%init (libname_dec)
           lib => lib_entry%process_library_t
           call global%add_prclib (lib_entry)
        else
           call global%update_prclib (lib)
        end if
        allocate (process_id (ds_table%get_length ()))
        do i = 1, size (process_id)
           write (buffer, "(A,'_',A,I0,'_',I0)") &
                "decay", p_or_a, abs (pdg_in), i
           process_id(i) = trim (buffer)
           process_string = process_id(i) // ": " // prt_in // " =>"
           call ds_table%get_pdg_out (i, pa_out)
           allocate (prt_out (size (pa_out)))
           do j = 1, size (pa_out)
              do k = 1, pa_out(j)%get_length ()
                 call flv_out%init (pa_out(j)%get (k), global%model)
                 if (k == 1) then
                    prt_out(j) = flv_out%get_name ()
                 else
                    prt_out(j) = prt_out(j) // ":" // flv_out%get_name ()
                 end if
              end do
              process_string = process_string // " " // prt_out(j)
           end do
           call msg_message (char (process_string))
           call prc_config%init (process_id(i), 1, 1, &
                global%model, global%var_list, &
                nlo_process = global%nlo_fixed_order)
           call prc_config%setup_component (1, new_prt_spec ([prt_in]), &
                new_prt_spec (prt_out), global%model, global%var_list)
           call prc_config%record (global)
           deallocate (prt_out)
           deallocate (pa_out)
        end do
        lib => global%prclib_stack%get_library_ptr (libname_cur)
        call global%update_prclib (lib)
     end if
     call ds_table%final ()
   end subroutine create_auto_decays
 
 @ %def create_auto_decays
 @
 \subsubsection{(Stable particles}
 Revert the unstable declaration for a list of particles.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_stable_t
      private
      type(parse_node_p), dimension(:), allocatable :: pn_pdg
    contains
    <<Commands: cmd stable: TBP>>
   end type cmd_stable_t
 
 @ %def cmd_stable_t
 @ Output: we know only the number of particles.
 <<Commands: cmd stable: TBP>>=
   procedure :: write => cmd_stable_write
 <<Commands: procedures>>=
   subroutine cmd_stable_write (cmd, unit, indent)
     class(cmd_stable_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,I0)")  "stable:", size (cmd%pn_pdg)
   end subroutine cmd_stable_write
 
 @ %def cmd_stable_write
 @ Compile.  Assign parse nodes for the particle IDs.
 <<Commands: cmd stable: TBP>>=
   procedure :: compile => cmd_stable_compile
 <<Commands: procedures>>=
   subroutine cmd_stable_compile (cmd, global)
     class(cmd_stable_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_list, pn_prt
     integer :: n, i
     pn_list => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_list)
     call cmd%compile_options (global)
     n = parse_node_get_n_sub (pn_list)
     allocate (cmd%pn_pdg (n))
     pn_prt => parse_node_get_sub_ptr (pn_list)
     i = 1
     do while (associated (pn_prt))
        cmd%pn_pdg(i)%ptr => pn_prt
        pn_prt  => parse_node_get_next_ptr (pn_prt)
        i = i + 1
     end do
   end subroutine cmd_stable_compile
 
 @ %def cmd_stable_compile
 @ Execute: apply the modifications to the current model.
 <<Commands: cmd stable: TBP>>=
   procedure :: execute => cmd_stable_execute
 <<Commands: procedures>>=
   subroutine cmd_stable_execute (cmd, global)
     class(cmd_stable_t), intent(inout) :: cmd
     type(rt_data_t), target, intent(inout) :: global
     type(var_list_t), pointer :: var_list
     type(pdg_array_t) :: pa
     integer :: pdg
     type(flavor_t) :: flv
     integer :: i
     var_list => cmd%local%get_var_list_ptr ()
     do i = 1, size (cmd%pn_pdg)
        pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
        if (pdg_array_get_length (pa) /= 1) &
             call msg_fatal ("Stable: listed particles must be unique")
        pdg = pdg_array_get (pa, 1)
        call global%modify_particle (pdg, stable = .true., &
          isotropic_decay = .false., &
          diagonal_decay = .false., &
          polarized = .false.)
        call flv%init (pdg, cmd%local%model)
        call msg_message ("Particle " &
             // char (flv%get_name ()) &
             // " declared as stable")
     end do
   end subroutine cmd_stable_execute
 
 @ %def cmd_stable_execute
 @
 \subsubsection{Polarized particles}
 These commands mark particles as (un)polarized, to be applied in
 subsequent simulation passes.  Since this is technically the same as
 the [[stable]] command, we take a shortcut and make this an extension,
 just overriding methods.
 <<Commands: types>>=
   type, extends (cmd_stable_t) :: cmd_polarized_t
    contains
    <<Commands: cmd polarized: TBP>>
   end type cmd_polarized_t
 
   type, extends (cmd_stable_t) :: cmd_unpolarized_t
    contains
    <<Commands: cmd unpolarized: TBP>>
   end type cmd_unpolarized_t
 
 @ %def cmd_polarized_t cmd_unpolarized_t
 @ Output: we know only the number of particles.
 <<Commands: cmd polarized: TBP>>=
   procedure :: write => cmd_polarized_write
 <<Commands: cmd unpolarized: TBP>>=
   procedure :: write => cmd_unpolarized_write
 <<Commands: procedures>>=
   subroutine cmd_polarized_write (cmd, unit, indent)
     class(cmd_polarized_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,I0)")  "polarized:", size (cmd%pn_pdg)
   end subroutine cmd_polarized_write
 
   subroutine cmd_unpolarized_write (cmd, unit, indent)
     class(cmd_unpolarized_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,I0)")  "unpolarized:", size (cmd%pn_pdg)
   end subroutine cmd_unpolarized_write
 
 @ %def cmd_polarized_write
 @ %def cmd_unpolarized_write
 @ Compile: accounted for by the base command.
 
 Execute: apply the modifications to the current model.
 <<Commands: cmd polarized: TBP>>=
   procedure :: execute => cmd_polarized_execute
 <<Commands: cmd unpolarized: TBP>>=
   procedure :: execute => cmd_unpolarized_execute
 <<Commands: procedures>>=
   subroutine cmd_polarized_execute (cmd, global)
     class(cmd_polarized_t), intent(inout) :: cmd
     type(rt_data_t), target, intent(inout) :: global
     type(var_list_t), pointer :: var_list
     type(pdg_array_t) :: pa
     integer :: pdg
     type(flavor_t) :: flv
     integer :: i
     var_list => cmd%local%get_var_list_ptr ()
     do i = 1, size (cmd%pn_pdg)
        pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
        if (pdg_array_get_length (pa) /= 1) &
             call msg_fatal ("Polarized: listed particles must be unique")
        pdg = pdg_array_get (pa, 1)
        call global%modify_particle (pdg, polarized = .true., &
             stable = .true., &
             isotropic_decay = .false., &
             diagonal_decay = .false.)
        call flv%init (pdg, cmd%local%model)
        call msg_message ("Particle " &
             // char (flv%get_name ()) &
             // " declared as polarized")
     end do
   end subroutine cmd_polarized_execute
 
   subroutine cmd_unpolarized_execute (cmd, global)
     class(cmd_unpolarized_t), intent(inout) :: cmd
     type(rt_data_t), target, intent(inout) :: global
     type(var_list_t), pointer :: var_list
     type(pdg_array_t) :: pa
     integer :: pdg
     type(flavor_t) :: flv
     integer :: i
     var_list => cmd%local%get_var_list_ptr ()
     do i = 1, size (cmd%pn_pdg)
        pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
        if (pdg_array_get_length (pa) /= 1) &
             call msg_fatal ("Unpolarized: listed particles must be unique")
        pdg = pdg_array_get (pa, 1)
        call global%modify_particle (pdg, polarized = .false., &
             stable = .true., &
             isotropic_decay = .false., &
             diagonal_decay = .false.)
        call flv%init (pdg, cmd%local%model)
        call msg_message ("Particle " &
             // char (flv%get_name ()) &
             // " declared as unpolarized")
     end do
   end subroutine cmd_unpolarized_execute
 
 @ %def cmd_polarized_execute
 @ %def cmd_unpolarized_execute
 @
 \subsubsection{Parameters: formats for event-sample output}
 Specify all event formats that are to be used for output files in the
 subsequent simulation run.  (The raw format is on by default and can be turned
 off here.)
 <<Commands: types>>=
   type, extends (command_t) :: cmd_sample_format_t
      private
      type(string_t), dimension(:), allocatable :: format
    contains
    <<Commands: cmd sample format: TBP>>
   end type cmd_sample_format_t
 
 @ %def cmd_sample_format_t
 @ Output: here, everything is known.
 <<Commands: cmd sample format: TBP>>=
   procedure :: write => cmd_sample_format_write
 <<Commands: procedures>>=
   subroutine cmd_sample_format_write (cmd, unit, indent)
     class(cmd_sample_format_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "sample_format = "
     do i = 1, size (cmd%format)
        if (i > 1)  write (u, "(A,1x)", advance="no")  ","
        write (u, "(A)", advance="no")  char (cmd%format(i))
     end do
     write (u, "(A)")
   end subroutine cmd_sample_format_write
 
 @ %def cmd_sample_format_write
 @ Compile.  Initialize evaluation trees.
 <<Commands: cmd sample format: TBP>>=
   procedure :: compile => cmd_sample_format_compile
 <<Commands: procedures>>=
   subroutine cmd_sample_format_compile (cmd, global)
     class(cmd_sample_format_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg
     type(parse_node_t), pointer :: pn_format
     integer :: i, n_format
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
     if (associated (pn_arg)) then
        n_format = parse_node_get_n_sub (pn_arg)
        allocate (cmd%format (n_format))
        pn_format => parse_node_get_sub_ptr (pn_arg)
        i = 0
        do while (associated (pn_format))
           i = i + 1
           cmd%format(i) = parse_node_get_string (pn_format)
           pn_format => parse_node_get_next_ptr (pn_format)
        end do
     else
        allocate (cmd%format (0))
     end if
   end subroutine cmd_sample_format_compile
 
 @ %def cmd_sample_format_compile
 @ Execute.  Transfer the list of format specifications to the
 corresponding array in the runtime data set.
 <<Commands: cmd sample format: TBP>>=
   procedure :: execute => cmd_sample_format_execute
 <<Commands: procedures>>=
   subroutine cmd_sample_format_execute (cmd, global)
     class(cmd_sample_format_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (allocated (global%sample_fmt))  deallocate (global%sample_fmt)
     allocate (global%sample_fmt (size (cmd%format)), source = cmd%format)
   end subroutine cmd_sample_format_execute
 
 @ %def cmd_sample_format_execute
 @
 \subsubsection{The simulate command}
 This is the actual SINDARIN command.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_simulate_t
      ! not private anymore as required by the whizard-c-interface
      integer :: n_proc = 0
      type(string_t), dimension(:), allocatable :: process_id
    contains
    <<Commands: cmd simulate: TBP>>
   end type cmd_simulate_t
 
 @ %def cmd_simulate_t
 @ Output: we know the process IDs.
 <<Commands: cmd simulate: TBP>>=
   procedure :: write => cmd_simulate_write
 <<Commands: procedures>>=
   subroutine cmd_simulate_write (cmd, unit, indent)
     class(cmd_simulate_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "simulate ("
     do i = 1, cmd%n_proc
        if (i > 1)  write (u, "(A,1x)", advance="no")  ","
        write (u, "(A)", advance="no")  char (cmd%process_id(i))
     end do
     write (u, "(A)")  ")"
   end subroutine cmd_simulate_write
 
 @ %def cmd_simulate_write
 @ Compile. In contrast to WHIZARD 1 the confusing option to give the
 number of unweighted events for weighted events as if unweighting were
 to take place has been abandoned. (We both use [[n_events]] for
 weighted and unweighted events, the variable [[n_calls]] from WHIZARD
 1 has been discarded.
 <<Commands: cmd simulate: TBP>>=
   procedure :: compile => cmd_simulate_compile
 <<Commands: procedures>>=
   subroutine cmd_simulate_compile (cmd, global)
     class(cmd_simulate_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_proclist, pn_proc
     integer :: i
     pn_proclist => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
     call cmd%compile_options (global)
     cmd%n_proc = parse_node_get_n_sub (pn_proclist)
     allocate (cmd%process_id (cmd%n_proc))
     pn_proc => parse_node_get_sub_ptr (pn_proclist)
     do i = 1, cmd%n_proc
        cmd%process_id(i) = parse_node_get_string (pn_proc)
        call global%process_stack%init_result_vars (cmd%process_id(i))
        pn_proc => parse_node_get_next_ptr (pn_proc)
     end do
   end subroutine cmd_simulate_compile
 
 @ %def cmd_simulate_compile
 @ Execute command:  Simulate events.  This is done via a [[simulation_t]]
 object and its associated methods.
 
 Signal handling: the [[generate]] method may exit abnormally if there is a
 pending signal.  The current logic ensures that the [[es_array]] output
 channels are closed before the [[execute]] routine returns.  The program will
 terminate then in [[command_list_execute]].
 <<Commands: cmd simulate: TBP>>=
   procedure :: execute => cmd_simulate_execute
 <<Commands: procedures>>=
   subroutine cmd_simulate_execute (cmd, global)
     class(cmd_simulate_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(rt_data_t), dimension(:), allocatable, target :: alt_env
     integer :: n_events, n_fmt
     type(string_t) :: sample, sample_suffix
     logical :: rebuild_events, read_raw, write_raw
     type(simulation_t), target :: sim
     type(string_t), dimension(:), allocatable :: sample_fmt
     type(event_stream_array_t) :: es_array
     type(event_sample_data_t) :: data
     integer :: i, checkpoint, callback
    <<Commands: cmd simulate execute: variables>>
     var_list => cmd%local%var_list
     if (allocated (cmd%local%pn%alt_setup)) then
        allocate (alt_env (size (cmd%local%pn%alt_setup)))
        do i = 1, size (alt_env)
           call build_alt_setup (alt_env(i), cmd%local, &
                cmd%local%pn%alt_setup(i)%ptr)
        end do
        call sim%init (cmd%process_id, .true., .true., cmd%local, global, &
             alt_env)
     else
        call sim%init (cmd%process_id, .true., .true., cmd%local, global)
     end if
     if (signal_is_pending ())  return
     if (sim%is_valid ()) then
        call sim%init_process_selector ()
        call openmp_set_num_threads_verbose &
             (var_list%get_ival (var_str ("openmp_num_threads")), &
             var_list%get_lval (var_str ("?openmp_logging")))
        call sim%compute_n_events (n_events, var_list)
        sample_suffix = ""
      <<Commands: cmd simulate execute: init>>
        sample = var_list%get_sval (var_str ("$sample"))
        if (sample == "")  then
           sample = sim%get_default_sample_name () // sample_suffix
        else
           sample = var_list%get_sval (var_str ("$sample")) // sample_suffix
        end if
        rebuild_events = &
             var_list%get_lval (var_str ("?rebuild_events"))
        read_raw = &
             var_list%get_lval (var_str ("?read_raw")) &
             .and. .not. rebuild_events
        write_raw = &
             var_list%get_lval (var_str ("?write_raw"))
        checkpoint = &
             var_list%get_ival (var_str ("checkpoint"))
        callback = &
             var_list%get_ival (var_str ("event_callback_interval"))
        if (read_raw) then
           inquire (file = char (sample) // ".evx", exist = read_raw)
        end if
        if (allocated (cmd%local%sample_fmt)) then
           n_fmt = size (cmd%local%sample_fmt)
        else
           n_fmt = 0
        end if
        data = sim%get_data ()
        data%n_evt = n_events
        data%nlo_multiplier = sim%get_n_nlo_entries (1)
        if (read_raw) then
           allocate (sample_fmt (n_fmt))
           if (n_fmt > 0)  sample_fmt = cmd%local%sample_fmt
           call es_array%init (sample, &
                sample_fmt, cmd%local, &
                data = data, &
                input = var_str ("raw"), &
                allow_switch = write_raw, &
                checkpoint = checkpoint, &
                callback = callback)
           call sim%generate (n_events, es_array)
           call es_array%final ()
        else if (write_raw) then
           allocate (sample_fmt (n_fmt + 1))
           if (n_fmt > 0)  sample_fmt(:n_fmt) = cmd%local%sample_fmt
           sample_fmt(n_fmt+1) = var_str ("raw")
           call es_array%init (sample, &
                sample_fmt, cmd%local, &
                data = data, &
                checkpoint = checkpoint, &
                callback = callback)
           call sim%generate (n_events, es_array)
           call es_array%final ()
        else if (allocated (cmd%local%sample_fmt) &
             .or. checkpoint > 0 &
             .or. callback > 0) then
           allocate (sample_fmt (n_fmt))
           if (n_fmt > 0)  sample_fmt = cmd%local%sample_fmt
           call es_array%init (sample, &
                sample_fmt, cmd%local, &
                data = data, &
                checkpoint = checkpoint, &
                callback = callback)
           call sim%generate (n_events, es_array)
           call es_array%final ()
        else
           call sim%generate (n_events)
        end if
        if (allocated (alt_env)) then
           do i = 1, size (alt_env)
              call alt_env(i)%local_final ()
           end do
        end if
     end if
     call sim%final ()
   end subroutine cmd_simulate_execute
 
 @ %def cmd_simulate_execute
 <<Commands: cmd simulate execute: variables>>=
 @
 <<Commands: cmd simulate execute: init>>=
 @
 <<MPI: Commands: cmd simulate execute: variables>>=
   logical :: mpi_logging
   integer :: rank, n_size
 @ Append rank id to sample name.
 <<MPI: Commands: cmd simulate execute: init>>=
   call mpi_get_comm_id (n_size, rank)
   if (n_size > 1) then
      sample_suffix = var_str ("_") // str (rank)
   end if
   mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) &
        & .and. (n_size > 1)) &
        & .or. var_list%get_lval (var_str ("?mpi_logging")))
   call mpi_set_logging (mpi_logging)
 @
 @ Build an alternative setup: the parse tree is stored in the global
 environment.  We create a temporary command list to compile and execute this;
 the result is an alternative local environment [[alt_env]] which we can hand
 over to the [[simulate]] command.
 <<Commands: procedures>>=
   recursive subroutine build_alt_setup (alt_env, global, pn)
     type(rt_data_t), intent(inout), target :: alt_env
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), intent(in), target :: pn
     type(command_list_t), allocatable :: alt_options
     allocate (alt_options)
     call alt_env%local_init (global)
     call alt_env%activate ()
     call alt_options%compile (pn, alt_env)
     call alt_options%execute (alt_env)
     call alt_env%deactivate (global, keep_local = .true.)
     call alt_options%final ()
   end subroutine build_alt_setup
 
 @ %def build_alt_setup
 @
 \subsubsection{The rescan command}
 This is the actual SINDARIN command.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_rescan_t
      ! private
      type(parse_node_t), pointer :: pn_filename => null ()
      integer :: n_proc = 0
      type(string_t), dimension(:), allocatable :: process_id
    contains
    <<Commands: cmd rescan: TBP>>
   end type cmd_rescan_t
 
 @ %def cmd_rescan_t
 @ Output: we know the process IDs.
 <<Commands: cmd rescan: TBP>>=
   procedure :: write => cmd_rescan_write
 <<Commands: procedures>>=
   subroutine cmd_rescan_write (cmd, unit, indent)
     class(cmd_rescan_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "rescan ("
     do i = 1, cmd%n_proc
        if (i > 1)  write (u, "(A,1x)", advance="no")  ","
        write (u, "(A)", advance="no")  char (cmd%process_id(i))
     end do
     write (u, "(A)")  ")"
   end subroutine cmd_rescan_write
 
 @ %def cmd_rescan_write
 @ Compile.  The command takes a suffix argument, namely the file name
 of requested event file.
 <<Commands: cmd rescan: TBP>>=
   procedure :: compile => cmd_rescan_compile
 <<Commands: procedures>>=
   subroutine cmd_rescan_compile (cmd, global)
     class(cmd_rescan_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_filename, pn_proclist, pn_proc
     integer :: i
     pn_filename => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_proclist => parse_node_get_next_ptr (pn_filename)
     cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
     call cmd%compile_options (global)
     cmd%pn_filename => pn_filename
     cmd%n_proc = parse_node_get_n_sub (pn_proclist)
     allocate (cmd%process_id (cmd%n_proc))
     pn_proc => parse_node_get_sub_ptr (pn_proclist)
     do i = 1, cmd%n_proc
        cmd%process_id(i) = parse_node_get_string (pn_proc)
        pn_proc => parse_node_get_next_ptr (pn_proc)
     end do
   end subroutine cmd_rescan_compile
 
 @ %def cmd_rescan_compile
 @ Execute command:  Rescan events.  This is done via a [[simulation_t]]
 object and its associated methods.
 <<Commands: cmd rescan: TBP>>=
   procedure :: execute => cmd_rescan_execute
 <<Commands: procedures>>=
   subroutine cmd_rescan_execute (cmd, global)
     class(cmd_rescan_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(rt_data_t), dimension(:), allocatable, target :: alt_env
     type(string_t) :: sample, sample_suffix
     logical :: exist, write_raw, update_event, update_sqme
     type(simulation_t), target :: sim
     type(event_sample_data_t) :: input_data, data
     type(string_t) :: input_sample
     integer :: n_fmt
     type(string_t), dimension(:), allocatable :: sample_fmt
     type(string_t) :: input_format, input_ext, input_file
     type(string_t) :: lhef_extension, extension_hepmc, extension_lcio
     type(event_stream_array_t) :: es_array
     integer :: i, n_events
   <<Commands: cmd rescan execute: variables>>
     var_list => cmd%local%var_list
     if (allocated (cmd%local%pn%alt_setup)) then
        allocate (alt_env (size (cmd%local%pn%alt_setup)))
        do i = 1, size (alt_env)
           call build_alt_setup (alt_env(i), cmd%local, &
                cmd%local%pn%alt_setup(i)%ptr)
        end do
        call sim%init (cmd%process_id, .false., .false., cmd%local, global, &
             alt_env)
     else
        call sim%init (cmd%process_id, .false., .false., cmd%local, global)
     end if
     call sim%compute_n_events (n_events, var_list)
     input_sample = eval_string (cmd%pn_filename, var_list)
     input_format = var_list%get_sval (&
          var_str ("$rescan_input_format"))
     sample_suffix = ""
   <<Commands: cmd rescan execute: init>>
     sample = var_list%get_sval (var_str ("$sample"))
     if (sample == "") then
        sample = sim%get_default_sample_name () // sample_suffix
     else
        sample = var_list%get_sval (var_str ("$sample")) // sample_suffix
     end if
     write_raw = var_list%get_lval (var_str ("?write_raw"))
     if (allocated (cmd%local%sample_fmt)) then
        n_fmt = size (cmd%local%sample_fmt)
     else
        n_fmt = 0
     end if
     if (write_raw) then
        if (sample == input_sample) then
           call msg_error ("Rescan: ?write_raw = true: " &
                // "suppressing raw event output (filename clashes with input)")
           allocate (sample_fmt (n_fmt))
           if (n_fmt > 0)  sample_fmt = cmd%local%sample_fmt
        else
           allocate (sample_fmt (n_fmt + 1))
           if (n_fmt > 0)  sample_fmt(:n_fmt) = cmd%local%sample_fmt
           sample_fmt(n_fmt+1) = var_str ("raw")
        end if
     else
        allocate (sample_fmt (n_fmt))
        if (n_fmt > 0)  sample_fmt = cmd%local%sample_fmt
     end if
     update_event = &
          var_list%get_lval (var_str ("?update_event"))
     update_sqme = &
          var_list%get_lval (var_str ("?update_sqme"))
     if (update_event .or. update_sqme) then
        call msg_message ("Recalculating observables")
        if (update_sqme) then
           call msg_message ("Recalculating squared matrix elements")
        end if
     end if
     lhef_extension = &
          var_list%get_sval (var_str ("$lhef_extension"))
     extension_hepmc = &
          var_list%get_sval (var_str ("$extension_hepmc"))
     extension_lcio = &
          var_list%get_sval (var_str ("$extension_lcio"))
     select case (char (input_format))
     case ("raw");  input_ext = "evx"
        call cmd%local%set_log &
             (var_str ("?recover_beams"), .false., is_known=.true.)
     case ("lhef"); input_ext = lhef_extension
     case ("hepmc"); input_ext = extension_hepmc
     case ("lcio"); input_ext = extension_lcio
     case default
        call msg_fatal ("rescan: input sample format '" // char (input_format) &
             // "' not supported")
     end select
     input_file = input_sample // "." // input_ext
     inquire (file = char (input_file), exist = exist)
     if (exist) then
        input_data = sim%get_data (alt = .false.)
        input_data%n_evt = n_events
        data = sim%get_data ()
        data%n_evt = n_events
        input_data%md5sum_cfg = ""
        call es_array%init (sample, &
             sample_fmt, cmd%local, data, &
             input = input_format, input_sample = input_sample, &
             input_data = input_data, &
             allow_switch = .false.)
        call sim%rescan (n_events, es_array, global = cmd%local)
        call es_array%final ()
     else
        call msg_fatal ("Rescan: event file '" &
             // char (input_file) // "' not found")
     end if
     if (allocated (alt_env)) then
        do i = 1, size (alt_env)
           call alt_env(i)%local_final ()
        end do
     end if
     call sim%final ()
   end subroutine cmd_rescan_execute
 
 @ %def cmd_rescan_execute
 @
 <<Commands: cmd rescan execute: variables>>=
 @
 <<Commands: cmd rescan execute: init>>=
 @
 <<MPI: Commands: cmd rescan execute: variables>>=
   logical :: mpi_logging
   integer :: rank, n_size
 @ Append rank id to sample name.
 <<MPI: Commands: cmd rescan execute: init>>=
   call mpi_get_comm_id (n_size, rank)
   if (n_size > 1) then
      sample_suffix = var_str ("_") // str (rank)
   end if
   mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) &
        & .and. (n_size > 1)) &
        & .or. var_list%get_lval (var_str ("?mpi_logging")))
   call mpi_set_logging (mpi_logging)
 @
 \subsubsection{Parameters: number of iterations}
 Specify number of iterations and number of calls for one integration pass.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_iterations_t
      private
      integer :: n_pass = 0
      type(parse_node_p), dimension(:), allocatable :: pn_expr_n_it
      type(parse_node_p), dimension(:), allocatable :: pn_expr_n_calls
      type(parse_node_p), dimension(:), allocatable :: pn_sexpr_adapt
    contains
    <<Commands: cmd iterations: TBP>>
   end type cmd_iterations_t
 
 @ %def cmd_iterations_t
 @ Output.  Display the number of passes, which is known after compilation.
 <<Commands: cmd iterations: TBP>>=
   procedure :: write => cmd_iterations_write
 <<Commands: procedures>>=
   subroutine cmd_iterations_write (cmd, unit, indent)
     class(cmd_iterations_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_pass)
     case (0)
        write (u, "(1x,A)")  "iterations: [empty]"
     case (1)
        write (u, "(1x,A,I0,A)")  "iterations: ", cmd%n_pass, " pass"
     case default
        write (u, "(1x,A,I0,A)")  "iterations: ", cmd%n_pass, " passes"
     end select
   end subroutine cmd_iterations_write
 
 @ %def cmd_iterations_write
 @ Compile.  Initialize evaluation trees.
 <<Commands: cmd iterations: TBP>>=
   procedure :: compile => cmd_iterations_compile
 <<Commands: procedures>>=
   subroutine cmd_iterations_compile (cmd, global)
     class(cmd_iterations_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_n_it, pn_n_calls, pn_adapt
     type(parse_node_t), pointer :: pn_it_spec, pn_calls_spec, pn_adapt_spec
     integer :: i
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
     if (associated (pn_arg)) then
        cmd%n_pass = parse_node_get_n_sub (pn_arg)
        allocate (cmd%pn_expr_n_it (cmd%n_pass))
        allocate (cmd%pn_expr_n_calls (cmd%n_pass))
        allocate (cmd%pn_sexpr_adapt (cmd%n_pass))
        pn_it_spec => parse_node_get_sub_ptr (pn_arg)
        i = 1
        do while (associated (pn_it_spec))
           pn_n_it => parse_node_get_sub_ptr (pn_it_spec)
           pn_calls_spec => parse_node_get_next_ptr (pn_n_it)
           pn_n_calls => parse_node_get_sub_ptr (pn_calls_spec, 2)
           pn_adapt_spec => parse_node_get_next_ptr (pn_calls_spec)
           if (associated (pn_adapt_spec)) then
              pn_adapt => parse_node_get_sub_ptr (pn_adapt_spec, 2)
           else
              pn_adapt => null ()
           end if
           cmd%pn_expr_n_it(i)%ptr => pn_n_it
           cmd%pn_expr_n_calls(i)%ptr => pn_n_calls
           cmd%pn_sexpr_adapt(i)%ptr => pn_adapt
           i = i + 1
           pn_it_spec => parse_node_get_next_ptr (pn_it_spec)
        end do
     else
        allocate (cmd%pn_expr_n_it (0))
        allocate (cmd%pn_expr_n_calls (0))
     end if
   end subroutine cmd_iterations_compile
 
 @ %def cmd_iterations_compile
 @ Execute.  Evaluate the trees and transfer the results to the iteration
 list in the runtime data set.
 <<Commands: cmd iterations: TBP>>=
   procedure :: execute => cmd_iterations_execute
 <<Commands: procedures>>=
   subroutine cmd_iterations_execute (cmd, global)
     class(cmd_iterations_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     integer, dimension(cmd%n_pass) :: n_it, n_calls
     logical, dimension(cmd%n_pass) :: custom_adapt
     type(string_t), dimension(cmd%n_pass) :: adapt_code
     integer :: i
     var_list => global%get_var_list_ptr ()
     do i = 1, cmd%n_pass
        n_it(i) = eval_int (cmd%pn_expr_n_it(i)%ptr, var_list)
        n_calls(i) = &
             eval_int (cmd%pn_expr_n_calls(i)%ptr, var_list)
        if (associated (cmd%pn_sexpr_adapt(i)%ptr)) then
           adapt_code(i) = &
                eval_string (cmd%pn_sexpr_adapt(i)%ptr, &
                             var_list, is_known = custom_adapt(i))
        else
           custom_adapt(i) = .false.
        end if
     end do
     call global%it_list%init (n_it, n_calls, custom_adapt, adapt_code)
   end subroutine cmd_iterations_execute
 
 @ %def cmd_iterations_execute
 @
 \subsubsection{Range expressions}
 We need a special type for storing and evaluating range expressions.
 <<Commands: parameters>>=
   integer, parameter :: STEP_NONE = 0
   integer, parameter :: STEP_ADD = 1
   integer, parameter :: STEP_SUB = 2
   integer, parameter :: STEP_MUL = 3
   integer, parameter :: STEP_DIV = 4
   integer, parameter :: STEP_COMP_ADD = 11
   integer, parameter :: STEP_COMP_MUL = 13
 @
 There is an abstract base type and two implementations: scan over integers and
 scan over reals.
 <<Commands: types>>=
   type, abstract :: range_t
      type(parse_node_t), pointer :: pn_expr => null ()
      type(parse_node_t), pointer :: pn_term => null ()
      type(parse_node_t), pointer :: pn_factor => null ()
      type(parse_node_t), pointer :: pn_value => null ()
      type(parse_node_t), pointer :: pn_literal => null ()
      type(parse_node_t), pointer :: pn_beg => null ()
      type(parse_node_t), pointer :: pn_end => null ()
      type(parse_node_t), pointer :: pn_step => null ()
      type(eval_tree_t) :: expr_beg
      type(eval_tree_t) :: expr_end
      type(eval_tree_t) :: expr_step
      integer :: step_mode = 0
      integer :: n_step = 0
    contains
    <<Commands: range: TBP>>
   end type range_t
 
 @ %def range_t
 @ These are the implementations:
 <<Commands: types>>=
   type, extends (range_t) :: range_int_t
      integer :: i_beg = 0
      integer :: i_end = 0
      integer :: i_step = 0
    contains
    <<Commands: range int: TBP>>
 end type range_int_t
 
   type, extends (range_t) :: range_real_t
      real(default) :: r_beg = 0
      real(default) :: r_end = 0
      real(default) :: r_step = 0
      real(default) :: lr_beg  = 0
      real(default) :: lr_end  = 0
      real(default) :: lr_step = 0
    contains
    <<Commands: range real: TBP>>
 end type range_real_t
 
 @ %def range_int_t range_real_t
 @ Finalize the allocated dummy node.  The other nodes are just pointers.
 <<Commands: range: TBP>>=
   procedure :: final => range_final
 <<Commands: procedures>>=
   subroutine range_final (object)
     class(range_t), intent(inout) :: object
     if (associated (object%pn_expr)) then
        call parse_node_final (object%pn_expr, recursive = .false.)
        call parse_node_final (object%pn_term, recursive = .false.)
        call parse_node_final (object%pn_factor, recursive = .false.)
        call parse_node_final (object%pn_value, recursive = .false.)
        call parse_node_final (object%pn_literal, recursive = .false.)
        deallocate (object%pn_expr)
        deallocate (object%pn_term)
        deallocate (object%pn_factor)
        deallocate (object%pn_value)
        deallocate (object%pn_literal)
     end if
   end subroutine range_final
 
 @ %def range_final
 @ Output.
 <<Commands: range: TBP>>=
   procedure (range_write), deferred :: write
   procedure :: base_write => range_write
 <<Commands: range int: TBP>>=
   procedure :: write => range_int_write
 <<Commands: range real: TBP>>=
   procedure :: write => range_real_write
 <<Commands: procedures>>=
   subroutine range_write (object, unit)
     class(range_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Range specification:"
     if (associated (object%pn_expr)) then
        write (u, "(1x,A)")  "Dummy value:"
        call parse_node_write_rec (object%pn_expr, u)
     end if
     if (associated (object%pn_beg)) then
        write (u, "(1x,A)")  "Initial value:"
        call parse_node_write_rec (object%pn_beg, u)
        call object%expr_beg%write (u)
        if (associated (object%pn_end)) then
           write (u, "(1x,A)")  "Final value:"
           call parse_node_write_rec (object%pn_end, u)
           call object%expr_end%write (u)
           if (associated (object%pn_step)) then
              write (u, "(1x,A)")  "Step value:"
              call parse_node_write_rec (object%pn_step, u)
              select case (object%step_mode)
              case (STEP_ADD);   write (u, "(1x,A)")  "Step mode: +"
              case (STEP_SUB);   write (u, "(1x,A)")  "Step mode: -"
              case (STEP_MUL);   write (u, "(1x,A)")  "Step mode: *"
              case (STEP_DIV);   write (u, "(1x,A)")  "Step mode: /"
              case (STEP_COMP_ADD);  write (u, "(1x,A)")  "Division mode: +"
              case (STEP_COMP_MUL);  write (u, "(1x,A)")  "Division mode: *"
              end select
           end if
        end if
     else
        write (u, "(1x,A)")  "Expressions: [undefined]"
     end if
   end subroutine range_write
 
   subroutine range_int_write (object, unit)
     class(range_int_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call object%base_write (unit)
     write (u, "(1x,A)")  "Range parameters:"
     write (u, "(3x,A,I0)")  "i_beg  = ", object%i_beg
     write (u, "(3x,A,I0)")  "i_end  = ", object%i_end
     write (u, "(3x,A,I0)")  "i_step = ", object%i_step
     write (u, "(3x,A,I0)")  "n_step = ", object%n_step
   end subroutine range_int_write
 
   subroutine range_real_write (object, unit)
     class(range_real_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call object%base_write (unit)
     write (u, "(1x,A)")  "Range parameters:"
     write (u, "(3x,A," // FMT_19 // ")")  "r_beg  = ", object%r_beg
     write (u, "(3x,A," // FMT_19 // ")")  "r_end  = ", object%r_end
     write (u, "(3x,A," // FMT_19 // ")")  "r_step = ", object%r_end
     write (u, "(3x,A,I0)")  "n_step = ", object%n_step
   end subroutine range_real_write
 
 @ %def range_write
 @ Initialize, given a range expression parse node.  This is common to the
 implementations.
 <<Commands: range: TBP>>=
   procedure :: init => range_init
 <<Commands: procedures>>=
   subroutine range_init (range, pn)
     class(range_t), intent(out) :: range
     type(parse_node_t), intent(in), target :: pn
     type(parse_node_t), pointer :: pn_spec, pn_end, pn_step_spec, pn_op
     select case (char (parse_node_get_rule_key (pn)))
     case ("expr")
     case ("range_expr")
        range%pn_beg => parse_node_get_sub_ptr (pn)
        pn_spec => parse_node_get_next_ptr (range%pn_beg)
        if (associated (pn_spec)) then
           pn_end => parse_node_get_sub_ptr (pn_spec, 2)
           range%pn_end => pn_end
           pn_step_spec => parse_node_get_next_ptr (pn_end)
           if (associated (pn_step_spec)) then
              pn_op => parse_node_get_sub_ptr (pn_step_spec)
              range%pn_step => parse_node_get_next_ptr (pn_op)
              select case (char (parse_node_get_rule_key (pn_op)))
              case ("/+");  range%step_mode = STEP_ADD
              case ("/-");  range%step_mode = STEP_SUB
              case ("/*");  range%step_mode = STEP_MUL
              case ("//");  range%step_mode = STEP_DIV
              case ("/+/");  range%step_mode = STEP_COMP_ADD
              case ("/*/");  range%step_mode = STEP_COMP_MUL
              case default
                 call range%write ()
                 call msg_bug ("Range: step mode not implemented")
              end select
           else
              range%step_mode = STEP_ADD
           end if
        else
           range%step_mode = STEP_NONE
        end if
        call range%create_value_node ()
     case default
        call msg_bug ("range expression: node type '" &
             // char (parse_node_get_rule_key (pn)) &
             // "' not implemented")
     end select
   end subroutine range_init
 
 @ %def range_init
 @ This method manually creates a parse node (actually, a cascade of parse
 nodes) that hold a constant value as a literal.  The idea is that this node is
 inserted as the right-hand side of a fake variable assignment, which is
 prepended to each scan iteration.  Before the variable
 assignment is compiled and executed, we can manually reset the value of the
 literal and thus pretend that the loop variable is assigned this value.
 <<Commands: range: TBP>>=
   procedure :: create_value_node => range_create_value_node
 <<Commands: procedures>>=
   subroutine range_create_value_node (range)
     class(range_t), intent(inout) :: range
     allocate (range%pn_literal)
     allocate (range%pn_value)
     select type (range)
     type is (range_int_t)
        call parse_node_create_value (range%pn_literal, &
             syntax_get_rule_ptr (syntax_cmd_list, var_str ("integer_literal")),&
             ival = 0)
        call parse_node_create_branch (range%pn_value, &
             syntax_get_rule_ptr (syntax_cmd_list, var_str ("integer_value")))
     type is (range_real_t)
        call parse_node_create_value (range%pn_literal, &
             syntax_get_rule_ptr (syntax_cmd_list, var_str ("real_literal")),&
             rval = 0._default)
        call parse_node_create_branch (range%pn_value, &
             syntax_get_rule_ptr (syntax_cmd_list, var_str ("real_value")))
     class default
        call msg_bug ("range: create value node: type not implemented")
     end select
     call parse_node_append_sub (range%pn_value, range%pn_literal)
     call parse_node_freeze_branch (range%pn_value)
     allocate (range%pn_factor)
     call parse_node_create_branch (range%pn_factor, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("factor")))
     call parse_node_append_sub (range%pn_factor, range%pn_value)
     call parse_node_freeze_branch (range%pn_factor)
     allocate (range%pn_term)
     call parse_node_create_branch (range%pn_term, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("term")))
     call parse_node_append_sub (range%pn_term, range%pn_factor)
     call parse_node_freeze_branch (range%pn_term)
     allocate (range%pn_expr)
     call parse_node_create_branch (range%pn_expr, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("expr")))
     call parse_node_append_sub (range%pn_expr, range%pn_term)
     call parse_node_freeze_branch (range%pn_expr)
   end subroutine range_create_value_node
 
 @ %def range_create_value_node
 @ Compile, given an environment.
 <<Commands: range: TBP>>=
   procedure :: compile => range_compile
 <<Commands: procedures>>=
   subroutine range_compile (range, global)
     class(range_t), intent(inout) :: range
     type(rt_data_t), intent(in), target :: global
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     if (associated (range%pn_beg)) then
        call range%expr_beg%init_expr (range%pn_beg, var_list)
        if (associated (range%pn_end)) then
           call range%expr_end%init_expr (range%pn_end, var_list)
           if (associated (range%pn_step)) then
              call range%expr_step%init_expr (range%pn_step, var_list)
           end if
        end if
     end if
   end subroutine range_compile
 
 @ %def range_compile
 @ Evaluate: compute the actual bounds and parameters that determine the values
 that we can iterate.
 
 This is implementation-specific.
 <<Commands: range: TBP>>=
   procedure (range_evaluate), deferred :: evaluate
 <<Commands: interfaces>>=
   abstract interface
      subroutine range_evaluate (range)
        import
        class(range_t), intent(inout) :: range
      end subroutine range_evaluate
   end interface
 
 @ %def range_evaluate
 @ The version for an integer variable.  If the step is subtractive, we invert
 the sign and treat it as an additive step.  For a multiplicative step, the
 step must be greater than one, and the initial and final values must be of
 same sign and strictly ordered.  Analogously for a division step.
 <<Commands: range int: TBP>>=
   procedure :: evaluate => range_int_evaluate
 <<Commands: procedures>>=
   subroutine range_int_evaluate (range)
     class(range_int_t), intent(inout) :: range
     integer :: ival
     if (associated (range%pn_beg)) then
        call range%expr_beg%evaluate ()
        if (range%expr_beg%is_known ()) then
           range%i_beg = range%expr_beg%get_int ()
        else
           call range%write ()
           call msg_fatal &
                ("Range expression: initial value evaluates to unknown")
        end if
        if (associated (range%pn_end)) then
           call range%expr_end%evaluate ()
           if (range%expr_end%is_known ()) then
              range%i_end = range%expr_end%get_int ()
              if (associated (range%pn_step)) then
                 call range%expr_step%evaluate ()
                 if (range%expr_step%is_known ()) then
                    range%i_step = range%expr_step%get_int ()
                    select case (range%step_mode)
                    case (STEP_SUB);  range%i_step = - range%i_step
                    end select
                 else
                    call range%write ()
                    call msg_fatal &
                         ("Range expression: step value evaluates to unknown")
                 end if
              else
                 range%i_step = 1
              end if
           else
              call range%write ()
              call msg_fatal &
                   ("Range expression: final value evaluates to unknown")
           end if
        else
           range%i_end = range%i_beg
           range%i_step = 1
        end if
        select case (range%step_mode)
        case (STEP_NONE)
           range%n_step = 1
        case (STEP_ADD, STEP_SUB)
           if (range%i_step /= 0) then
              if (range%i_beg == range%i_end) then
                 range%n_step = 1
              else if (sign (1, range%i_end - range%i_beg) &
                   == sign (1, range%i_step)) then
                 range%n_step = (range%i_end - range%i_beg) / range%i_step + 1
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal ("range evaluation (add): step value is zero")
           end if
        case (STEP_MUL)
           if (range%i_step > 1) then
              if (range%i_beg == range%i_end) then
                 range%n_step = 1
              else if (range%i_beg == 0) then
                 call msg_fatal ("range evaluation (mul): initial value is zero")
              else if (sign (1, range%i_beg) == sign (1, range%i_end) &
                   .and. abs (range%i_beg) < abs (range%i_end)) then
                 range%n_step = 0
                 ival = range%i_beg
                 do while (abs (ival) <= abs (range%i_end))
                    range%n_step = range%n_step + 1
                    ival = ival * range%i_step
                 end do
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal &
                   ("range evaluation (mult): step value is one or less")
           end if
        case (STEP_DIV)
           if (range%i_step > 1) then
              if (range%i_beg == range%i_end) then
                 range%n_step = 1
              else if (sign (1, range%i_beg) == sign (1, range%i_end) &
                   .and. abs (range%i_beg) > abs (range%i_end)) then
                 range%n_step = 0
                 ival = range%i_beg
                 do while (abs (ival) >= abs (range%i_end))
                    range%n_step = range%n_step + 1
                    if (ival == 0)  exit
                    ival = ival / range%i_step
                 end do
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal &
                   ("range evaluation (div): step value is one or less")
           end if
        case (STEP_COMP_ADD)
           call msg_fatal ("range evaluation: &
                &step mode /+/ not allowed for integer variable")
        case (STEP_COMP_MUL)
           call msg_fatal ("range evaluation: &
                &step mode /*/ not allowed for integer variable")
        case default
           call range%write ()
           call msg_bug ("range evaluation: step mode not implemented")
        end select
     end if
   end subroutine range_int_evaluate
 
 @ %def range_int_evaluate
 @ The version for a real variable.
 <<Commands: range real: TBP>>=
   procedure :: evaluate => range_real_evaluate
 <<Commands: procedures>>=
   subroutine range_real_evaluate (range)
     class(range_real_t), intent(inout) :: range
     if (associated (range%pn_beg)) then
        call range%expr_beg%evaluate ()
        if (range%expr_beg%is_known ()) then
           range%r_beg = range%expr_beg%get_real ()
        else
           call range%write ()
           call msg_fatal &
                ("Range expression: initial value evaluates to unknown")
        end if
        if (associated (range%pn_end)) then
           call range%expr_end%evaluate ()
           if (range%expr_end%is_known ()) then
              range%r_end = range%expr_end%get_real ()
              if (associated (range%pn_step)) then
                 if (range%expr_step%is_known ()) then
                    select case (range%step_mode)
                    case (STEP_ADD, STEP_SUB, STEP_MUL, STEP_DIV)
                       call range%expr_step%evaluate ()
                       range%r_step = range%expr_step%get_real ()
                       select case (range%step_mode)
                       case (STEP_SUB);  range%r_step = - range%r_step
                       end select
                    case (STEP_COMP_ADD, STEP_COMP_MUL)
                       range%n_step = &
                            max (range%expr_step%get_int (), 0)
                    end select
                 else
                    call range%write ()
                    call msg_fatal &
                         ("Range expression: step value evaluates to unknown")
                 end if
              else
                 call range%write ()
                 call msg_fatal &
                      ("Range expression (real): step value must be provided")
              end if
           else
              call range%write ()
              call msg_fatal &
                   ("Range expression: final value evaluates to unknown")
           end if
        else
           range%r_end = range%r_beg
           range%r_step = 1
        end if
        select case (range%step_mode)
        case (STEP_NONE)
           range%n_step = 1
        case (STEP_ADD, STEP_SUB)
           if (range%r_step /= 0) then
              if (sign (1._default, range%r_end - range%r_beg) &
                   == sign (1._default, range%r_step)) then
                 range%n_step = &
                      nint ((range%r_end - range%r_beg) / range%r_step + 1)
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal ("range evaluation (add): step value is zero")
           end if
        case (STEP_MUL)
           if (range%r_step > 1) then
              if (range%r_beg == 0 .or. range%r_end == 0) then
                 call msg_fatal ("range evaluation (mul): bound is zero")
              else if (sign (1._default, range%r_beg) &
                   == sign (1._default, range%r_end) &
                   .and. abs (range%r_beg) <= abs (range%r_end)) then
                 range%lr_beg = log (abs (range%r_beg))
                 range%lr_end = log (abs (range%r_end))
                 range%lr_step = log (range%r_step)
                 range%n_step = nint &
                      (abs ((range%lr_end - range%lr_beg) / range%lr_step) + 1)
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal &
                   ("range evaluation (mult): step value is one or less")
           end if
        case (STEP_DIV)
           if (range%r_step > 1) then
              if (range%r_beg == 0 .or. range%r_end == 0) then
                 call msg_fatal ("range evaluation (div): bound is zero")
              else if (sign (1._default, range%r_beg) &
                   == sign (1._default, range%r_end) &
                   .and. abs (range%r_beg) >= abs (range%r_end)) then
                 range%lr_beg = log (abs (range%r_beg))
                 range%lr_end = log (abs (range%r_end))
                 range%lr_step = -log (range%r_step)
                 range%n_step = nint &
                      (abs ((range%lr_end - range%lr_beg) / range%lr_step) + 1)
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal &
                   ("range evaluation (mult): step value is one or less")
           end if
        case (STEP_COMP_ADD)
           ! Number of steps already known
        case (STEP_COMP_MUL)
           ! Number of steps already known
           if (range%r_beg == 0 .or. range%r_end == 0) then
              call msg_fatal ("range evaluation (mul): bound is zero")
           else if (sign (1._default, range%r_beg) &
                == sign (1._default, range%r_end)) then
              range%lr_beg = log (abs (range%r_beg))
              range%lr_end = log (abs (range%r_end))
           else
              range%n_step = 0
           end if
        case default
           call range%write ()
           call msg_bug ("range evaluation: step mode not implemented")
        end select
     end if
   end subroutine range_real_evaluate
 
 @ %def range_real_evaluate
 @ Return the number of iterations:
 <<Commands: range: TBP>>=
   procedure :: get_n_iterations => range_get_n_iterations
 <<Commands: procedures>>=
   function range_get_n_iterations (range) result (n)
     class(range_t), intent(in) :: range
     integer :: n
     n = range%n_step
   end function range_get_n_iterations
 
 @ %def range_get_n_iterations
 @ Compute the value for iteration [[i]] and store it in the embedded token.
 <<Commands: range: TBP>>=
   procedure (range_set_value), deferred :: set_value
 <<Commands: interfaces>>=
   abstract interface
      subroutine range_set_value (range, i)
        import
        class(range_t), intent(inout) :: range
        integer, intent(in) :: i
      end subroutine range_set_value
   end interface
 
 @ %def range_set_value
 @ In the integer case, we compute the value directly for additive step.  For
 multiplicative step, we perform a loop in the same way as above, where the
 number of iteration was determined.
 <<Commands: range int: TBP>>=
   procedure :: set_value => range_int_set_value
 <<Commands: procedures>>=
   subroutine range_int_set_value (range, i)
     class(range_int_t), intent(inout) :: range
     integer, intent(in) :: i
     integer :: k, ival
     select case (range%step_mode)
     case (STEP_NONE)
        ival = range%i_beg
     case (STEP_ADD, STEP_SUB)
        ival = range%i_beg + (i - 1) * range%i_step
     case (STEP_MUL)
        ival = range%i_beg
        do k = 1, i - 1
           ival = ival * range%i_step
        end do
     case (STEP_DIV)
        ival = range%i_beg
        do k = 1, i - 1
           ival = ival / range%i_step
        end do
     case default
        call range%write ()
        call msg_bug ("range iteration: step mode not implemented")
     end select
     call parse_node_set_value (range%pn_literal, ival = ival)
   end subroutine range_int_set_value
 
 @ %def range_int_set_value
 @ In the integer case, we compute the value directly for additive step.  For
 multiplicative step, we perform a loop in the same way as above, where the
 number of iteration was determined.
 <<Commands: range real: TBP>>=
   procedure :: set_value => range_real_set_value
 <<Commands: procedures>>=
   subroutine range_real_set_value (range, i)
     class(range_real_t), intent(inout) :: range
     integer, intent(in) :: i
     real(default) :: rval, x
     select case (range%step_mode)
     case (STEP_NONE)
        rval = range%r_beg
     case (STEP_ADD, STEP_SUB, STEP_COMP_ADD)
        if (range%n_step > 1) then
           x = real (i - 1, default) / (range%n_step - 1)
        else
           x = 1._default / 2
        end if
        rval = x * range%r_end + (1 - x) * range%r_beg
     case (STEP_MUL, STEP_DIV, STEP_COMP_MUL)
        if (range%n_step > 1) then
           x = real (i - 1, default) / (range%n_step - 1)
        else
           x = 1._default / 2
        end if
        rval = sign &
             (exp (x * range%lr_end + (1 - x) * range%lr_beg), range%r_beg)
     case default
        call range%write ()
        call msg_bug ("range iteration: step mode not implemented")
     end select
     call parse_node_set_value (range%pn_literal, rval = rval)
   end subroutine range_real_set_value
 
 @ %def range_real_set_value
 @
 \subsubsection{Scan over parameters and other objects}
 The scan command allocates a new parse node for the variable
 assignment (the lhs).  The rhs of this parse node is assigned from the
 available rhs expressions in the scan list, one at a time, so the
 compiled parse node can be prepended to the scan body.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_scan_t
      private
      type(string_t) :: name
      integer :: n_values = 0
      type(parse_node_p), dimension(:), allocatable :: scan_cmd
      class(range_t), dimension(:), allocatable :: range
    contains
    <<Commands: cmd scan: TBP>>
   end type cmd_scan_t
 
 @ %def cmd_scan_t
 @ Finalizer.
 
 The auxiliary parse nodes that we have constructed have to be treated
 carefully: the embedded pointers all point to persistent objects
 somewhere else and should not be finalized, so we should not call the
 finalizer recursively.
 <<Commands: cmd scan: TBP>>=
   procedure :: final => cmd_scan_final
 <<Commands: procedures>>=
   recursive subroutine cmd_scan_final (cmd)
     class(cmd_scan_t), intent(inout) :: cmd
     type(parse_node_t), pointer :: pn_var_single, pn_decl_single
     type(string_t) :: key
     integer :: i
     if (allocated (cmd%scan_cmd)) then
        do i = 1, size (cmd%scan_cmd)
           pn_var_single => parse_node_get_sub_ptr (cmd%scan_cmd(i)%ptr)
           key = parse_node_get_rule_key (pn_var_single)
           select case (char (key))
           case ("scan_string_decl", "scan_log_decl")
              pn_decl_single => parse_node_get_sub_ptr (pn_var_single, 2)
              call parse_node_final (pn_decl_single, recursive=.false.)
              deallocate (pn_decl_single)
           end select
           call parse_node_final (pn_var_single, recursive=.false.)
           deallocate (pn_var_single)
        end do
        deallocate (cmd%scan_cmd)
     end if
     if (allocated (cmd%range)) then
        do i = 1, size (cmd%range)
           call cmd%range(i)%final ()
        end do
     end if
   end subroutine cmd_scan_final
 
 @ %def cmd_scan_final
 @ Output.
 <<Commands: cmd scan: TBP>>=
   procedure :: write => cmd_scan_write
 <<Commands: procedures>>=
   subroutine cmd_scan_write (cmd, unit, indent)
     class(cmd_scan_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,A,1x,'(',I0,')')")  "scan:", char (cmd%name), &
          cmd%n_values
   end subroutine cmd_scan_write
 
 @ %def cmd_scan_write
 @ Compile the scan command.  We construct a new parse node that
 implements the variable assignment for a single element on the rhs,
 instead of the whole list that we get from the original parse tree.
 By simply copying the node, we copy all pointers and inherit the
 targets from the original.  During execution, we should replace the
 rhs by the stored rhs pointers (the list elements), one by one, then
 (re)compile the redefined node.
 <<Commands: cmd scan: TBP>>=
   procedure :: compile => cmd_scan_compile
 <<Commands: procedures>>=
   recursive subroutine cmd_scan_compile (cmd, global)
     class(cmd_scan_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(parse_node_t), pointer :: pn_var, pn_body, pn_body_first
     type(parse_node_t), pointer :: pn_decl, pn_name
     type(parse_node_t), pointer :: pn_arg, pn_scan_cmd, pn_rhs
     type(parse_node_t), pointer :: pn_decl_single, pn_var_single
     type(syntax_rule_t), pointer :: var_rule_decl, var_rule
     type(string_t) :: key
     integer :: var_type
     integer :: i
     if (debug_on) call msg_debug (D_CORE, "cmd_scan_compile")
     if (debug_active (D_CORE))  call parse_node_write_rec (cmd%pn)
     pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_body => parse_node_get_next_ptr (pn_var)
     if (associated (pn_body)) then
        pn_body_first => parse_node_get_sub_ptr (pn_body)
     else
        pn_body_first => null ()
     end if
     key = parse_node_get_rule_key (pn_var)
     select case (char (key))
     case ("scan_num")
        pn_name => parse_node_get_sub_ptr (pn_var)
        cmd%name = parse_node_get_string (pn_name)
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_num"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_int")
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_int"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_real")
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_real"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_complex")
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str("cmd_complex"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_alias")
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_alias"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_string_decl")
        pn_decl => parse_node_get_sub_ptr (pn_var, 2)
        pn_name => parse_node_get_sub_ptr (pn_decl, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_string"))
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_string_decl"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_log_decl")
        pn_decl => parse_node_get_sub_ptr (pn_var, 2)
        pn_name => parse_node_get_sub_ptr (pn_decl, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_log"))
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_log_decl"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_cuts")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_cuts"))
        cmd%name = "cuts"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_weight")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_weight"))
        cmd%name = "weight"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_scale")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_scale"))
        cmd%name = "scale"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_ren_scale")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_ren_scale"))
        cmd%name = "renormalization_scale"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_fac_scale")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_fac_scale"))
        cmd%name = "factorization_scale"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_selection")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_selection"))
        cmd%name = "selection"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_reweight")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_reweight"))
        cmd%name = "reweight"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_analysis")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_analysis"))
        cmd%name = "analysis"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_model")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_model"))
        cmd%name = "model"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_library")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_library"))
        cmd%name = "library"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case default
        call msg_bug ("scan: case '" // char (key) // "' not implemented")
     end select
     if (associated (pn_arg)) then
        cmd%n_values = parse_node_get_n_sub (pn_arg)
     end if
     var_list => global%get_var_list_ptr ()
     allocate (cmd%scan_cmd (cmd%n_values))
     select case (char (key))
     case ("scan_num")
        var_type = &
             var_list%get_type (cmd%name)
        select case (var_type)
        case (V_INT)
           allocate (range_int_t :: cmd%range (cmd%n_values))
        case (V_REAL)
           allocate (range_real_t :: cmd%range (cmd%n_values))
        case (V_CMPLX)
           call msg_fatal ("scan over complex variable not implemented")
        case (V_NONE)
           call msg_fatal ("scan: variable '" // char (cmd%name) //"' undefined")
        case default
           call msg_bug ("scan: impossible variable type")
        end select
     case ("scan_int")
        allocate (range_int_t :: cmd%range (cmd%n_values))
     case ("scan_real")
        allocate (range_real_t :: cmd%range (cmd%n_values))
     case ("scan_complex")
        call msg_fatal ("scan over complex variable not implemented")
     end select
     i = 1
     if (associated (pn_arg)) then
        pn_rhs => parse_node_get_sub_ptr (pn_arg)
     else
        pn_rhs => null ()
     end if
     do while (associated (pn_rhs))
        allocate (pn_scan_cmd)
        call parse_node_create_branch (pn_scan_cmd, &
             syntax_get_rule_ptr (syntax_cmd_list, var_str ("command_list")))
        allocate (pn_var_single)
        pn_var_single = pn_var
        call parse_node_replace_rule (pn_var_single, var_rule)
        select case (char (key))
        case ("scan_num", "scan_int", "scan_real", &
             "scan_complex", "scan_alias", &
             "scan_cuts", "scan_weight", &
             "scan_scale", "scan_ren_scale", "scan_fac_scale", &
             "scan_selection", "scan_reweight", "scan_analysis", &
             "scan_model", "scan_library")
           if (allocated (cmd%range)) then
              call cmd%range(i)%init (pn_rhs)
              call parse_node_replace_last_sub &
                   (pn_var_single, cmd%range(i)%pn_expr)
           else
              call parse_node_replace_last_sub (pn_var_single, pn_rhs)
           end if
        case ("scan_string_decl", "scan_log_decl")
           allocate (pn_decl_single)
           pn_decl_single = pn_decl
           call parse_node_replace_rule (pn_decl_single, var_rule_decl)
           call parse_node_replace_last_sub (pn_decl_single, pn_rhs)
           call parse_node_freeze_branch (pn_decl_single)
           call parse_node_replace_last_sub (pn_var_single, pn_decl_single)
        case default
           call msg_bug ("scan: case '" // char (key)  &
                // "' broken")
        end select
        call parse_node_freeze_branch (pn_var_single)
        call parse_node_append_sub (pn_scan_cmd, pn_var_single)
        call parse_node_append_sub (pn_scan_cmd, pn_body_first)
        call parse_node_freeze_branch (pn_scan_cmd)
        cmd%scan_cmd(i)%ptr => pn_scan_cmd
        i = i + 1
        pn_rhs => parse_node_get_next_ptr (pn_rhs)
     end do
     if (debug_active (D_CORE)) then
        do i = 1, cmd%n_values
           print *, "scan command ", i
           call parse_node_write_rec (cmd%scan_cmd(i)%ptr)
           if (allocated (cmd%range))  call cmd%range(i)%write ()
        end do
        print *, "original"
        call parse_node_write_rec (cmd%pn)
     end if
   end subroutine cmd_scan_compile
 
 @ %def cmd_scan_compile
 @ Execute the loop for all values in the step list.  We use the
 parse trees with single variable assignment that we have stored, to
 iteratively create a local environment, execute the stored commands, and
 destroy it again.  When we encounter a range object, we execute the commands
 for each value that this object provides.  Computing this value has the side
 effect of modifying the rhs of the variable assignment that heads the local
 command list, directly in the local parse tree.
 <<Commands: cmd scan: TBP>>=
   procedure :: execute => cmd_scan_execute
 <<Commands: procedures>>=
   recursive subroutine cmd_scan_execute (cmd, global)
     class(cmd_scan_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(rt_data_t), allocatable :: local
     integer :: i, j
     do i = 1, cmd%n_values
        if (allocated (cmd%range)) then
           call cmd%range(i)%compile (global)
           call cmd%range(i)%evaluate ()
           do j = 1, cmd%range(i)%get_n_iterations ()
              call cmd%range(i)%set_value (j)
              allocate (local)
              call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
              call local%local_final ()
              deallocate (local)
           end do
        else
           allocate (local)
           call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
           call local%local_final ()
           deallocate (local)
        end if
     end do
   end subroutine cmd_scan_execute
 
 @ %def cmd_scan_execute
 @
 \subsubsection{Conditionals}
 Conditionals are implemented as a list that is compiled and evaluated
 recursively; this allows for a straightforward representation of
 [[else if]] constructs.  A [[cmd_if_t]] object can hold either an
 [[else_if]] clause which is another object of this type, or an
 [[else_body]], but not both.
 
 If- or else-bodies are no scoping units, so all data remain global and
 no copy-in copy-out is needed.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_if_t
      private
      type(parse_node_t), pointer :: pn_if_lexpr => null ()
      type(command_list_t), pointer :: if_body => null ()
      type(cmd_if_t), dimension(:), pointer :: elsif_cmd => null ()
      type(command_list_t), pointer :: else_body => null ()
    contains
    <<Commands: cmd if: TBP>>
   end type cmd_if_t
 
 @ %def cmd_if_t
 @ Finalizer.  There are no local options, therefore we can simply override
 the default finalizer.
 <<Commands: cmd if: TBP>>=
   procedure :: final => cmd_if_final
 <<Commands: procedures>>=
   recursive subroutine cmd_if_final (cmd)
     class(cmd_if_t), intent(inout) :: cmd
     integer :: i
     if (associated (cmd%if_body)) then
        call command_list_final (cmd%if_body)
        deallocate (cmd%if_body)
     end if
     if (associated (cmd%elsif_cmd)) then
        do i = 1, size (cmd%elsif_cmd)
           call cmd_if_final (cmd%elsif_cmd(i))
        end do
        deallocate (cmd%elsif_cmd)
     end if
     if (associated (cmd%else_body)) then
        call command_list_final (cmd%else_body)
        deallocate (cmd%else_body)
     end if
   end subroutine cmd_if_final
 
 @ %def cmd_if_final
 @ Output.  Recursively write the command lists.
 <<Commands: cmd if: TBP>>=
   procedure :: write => cmd_if_write
 <<Commands: procedures>>=
   subroutine cmd_if_write (cmd, unit, indent)
     class(cmd_if_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, ind, i
     u = given_output_unit (unit);  if (u < 0)  return
     ind = 0;  if (present (indent))  ind = indent
     call write_indent (u, indent)
     write (u, "(A)")  "if <expr> then"
     if (associated (cmd%if_body)) then
        call cmd%if_body%write (unit, ind + 1)
     end if
     if (associated (cmd%elsif_cmd)) then
        do i = 1, size (cmd%elsif_cmd)
           call write_indent (u, indent)
           write (u, "(A)")  "elsif <expr> then"
           if (associated (cmd%elsif_cmd(i)%if_body)) then
              call cmd%elsif_cmd(i)%if_body%write (unit, ind + 1)
           end if
        end do
     end if
     if (associated (cmd%else_body)) then
        call write_indent (u, indent)
        write (u, "(A)")  "else"
        call cmd%else_body%write (unit, ind + 1)
     end if
   end subroutine cmd_if_write
 
 @ %def cmd_if_write
 @ Compile the conditional.
 <<Commands: cmd if: TBP>>=
   procedure :: compile => cmd_if_compile
 <<Commands: procedures>>=
   recursive subroutine cmd_if_compile (cmd, global)
     class(cmd_if_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_lexpr, pn_body
     type(parse_node_t), pointer :: pn_elsif_clauses, pn_cmd_elsif
     type(parse_node_t), pointer :: pn_else_clause, pn_cmd_else
     integer :: i, n_elsif
     pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_if_lexpr => pn_lexpr
     pn_body => parse_node_get_next_ptr (pn_lexpr, 2)
     select case (char (parse_node_get_rule_key (pn_body)))
     case ("command_list")
        allocate (cmd%if_body)
        call cmd%if_body%compile (pn_body, global)
        pn_elsif_clauses => parse_node_get_next_ptr (pn_body)
     case default
        pn_elsif_clauses => pn_body
     end select
     select case (char (parse_node_get_rule_key (pn_elsif_clauses)))
     case ("elsif_clauses")
        n_elsif = parse_node_get_n_sub (pn_elsif_clauses)
        allocate (cmd%elsif_cmd (n_elsif))
        pn_cmd_elsif => parse_node_get_sub_ptr (pn_elsif_clauses)
        do i = 1, n_elsif
           pn_lexpr => parse_node_get_sub_ptr (pn_cmd_elsif, 2)
           cmd%elsif_cmd(i)%pn_if_lexpr => pn_lexpr
           pn_body => parse_node_get_next_ptr (pn_lexpr, 2)
           if (associated (pn_body)) then
              allocate (cmd%elsif_cmd(i)%if_body)
              call cmd%elsif_cmd(i)%if_body%compile (pn_body, global)
           end if
           pn_cmd_elsif => parse_node_get_next_ptr (pn_cmd_elsif)
        end do
        pn_else_clause => parse_node_get_next_ptr (pn_elsif_clauses)
     case default
        pn_else_clause => pn_elsif_clauses
     end select
     select case (char (parse_node_get_rule_key (pn_else_clause)))
     case ("else_clause")
        pn_cmd_else => parse_node_get_sub_ptr (pn_else_clause)
        pn_body => parse_node_get_sub_ptr (pn_cmd_else, 2)
        if (associated (pn_body)) then
           allocate (cmd%else_body)
           call cmd%else_body%compile (pn_body, global)
        end if
     end select
   end subroutine cmd_if_compile
 
 @ %def global
 @ (Recursively) execute the condition.  Context remains global in all cases.
 <<Commands: cmd if: TBP>>=
   procedure :: execute => cmd_if_execute
 <<Commands: procedures>>=
   recursive subroutine cmd_if_execute (cmd, global)
     class(cmd_if_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     logical :: lval, is_known
     integer :: i
     var_list => global%get_var_list_ptr ()
     lval = eval_log (cmd%pn_if_lexpr, var_list, is_known=is_known)
     if (is_known) then
        if (lval) then
           if (associated (cmd%if_body)) then
              call cmd%if_body%execute (global)
           end if
           return
        end if
     else
        call error_undecided ()
        return
     end if
     if (associated (cmd%elsif_cmd)) then
        SCAN_ELSIF: do i = 1, size (cmd%elsif_cmd)
           lval = eval_log (cmd%elsif_cmd(i)%pn_if_lexpr, var_list, &
                 is_known=is_known)
           if (is_known) then
              if (lval) then
                 if (associated (cmd%elsif_cmd(i)%if_body)) then
                    call cmd%elsif_cmd(i)%if_body%execute (global)
                 end if
                 return
              end if
           else
              call error_undecided ()
              return
           end if
        end do SCAN_ELSIF
     end if
     if (associated (cmd%else_body)) then
        call cmd%else_body%execute (global)
     end if
   contains
     subroutine error_undecided ()
       call msg_error ("Undefined result of cmditional expression: " &
            // "neither branch will be executed")
     end subroutine error_undecided
   end subroutine cmd_if_execute
 
 @ %def cmd_if_execute
 @
 \subsubsection{Include another command-list file}
 The include command allocates a local parse tree.  This must not be
 deleted before the command object itself is deleted, since pointers
 may point to subobjects of it.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_include_t
      private
      type(string_t) :: file
      type(command_list_t), pointer :: command_list => null ()
      type(parse_tree_t) :: parse_tree
    contains
    <<Commands: cmd include: TBP>>
   end type cmd_include_t
 
 @ %def cmd_include_t
 @ Finalizer: delete the command list.  No options, so we can simply override
 the default finalizer.
 <<Commands: cmd include: TBP>>=
   procedure :: final => cmd_include_final
 <<Commands: procedures>>=
   subroutine cmd_include_final (cmd)
     class(cmd_include_t), intent(inout) :: cmd
     call parse_tree_final (cmd%parse_tree)
     if (associated (cmd%command_list)) then
        call cmd%command_list%final ()
        deallocate (cmd%command_list)
     end if
   end subroutine cmd_include_final
 
 @ %def cmd_include_final
 @ Write: display the command list as-is, if allocated.
 <<Commands: cmd include: TBP>>=
   procedure :: write => cmd_include_write
 <<Commands: procedures>>=
   subroutine cmd_include_write (cmd, unit, indent)
     class(cmd_include_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, ind
     u = given_output_unit (unit)
     ind = 0;  if (present (indent))  ind = indent
     call write_indent (u, indent)
     write (u, "(A,A,A,A)")  "include ", '"', char (cmd%file), '"'
     if (associated (cmd%command_list)) then
        call cmd%command_list%write (u, ind + 1)
     end if
   end subroutine cmd_include_write
 
 @ %def cmd_include_write
 @ Compile file contents: First parse the file, then immediately
 compile its contents.  Use the global data set.
 <<Commands: cmd include: TBP>>=
   procedure :: compile => cmd_include_compile
 <<Commands: procedures>>=
   subroutine cmd_include_compile (cmd, global)
     class(cmd_include_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_file
     type(string_t) :: file
     logical :: exist
     integer :: u
     type(stream_t), target :: stream
     type(lexer_t) :: lexer
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_file => parse_node_get_sub_ptr (pn_arg)
     file = parse_node_get_string (pn_file)
     inquire (file=char(file), exist=exist)
     if (exist) then
        cmd%file = file
     else
        cmd%file = global%os_data%whizard_cutspath // "/" // file
        inquire (file=char(cmd%file), exist=exist)
        if (.not. exist) then
           call msg_error ("Include file '" // char (file) // "' not found")
           return
        end if
     end if
     u = free_unit ()
     call lexer_init_cmd_list (lexer, global%lexer)
     call stream_init (stream, char (cmd%file))
     call lexer_assign_stream (lexer, stream)
     call parse_tree_init (cmd%parse_tree, syntax_cmd_list, lexer)
     call stream_final (stream)
     call lexer_final (lexer)
     close (u)
     allocate (cmd%command_list)
     call cmd%command_list%compile (cmd%parse_tree%get_root_ptr (), &
          global)
   end subroutine cmd_include_compile
 
 @ %def cmd_include_compile
 @ Execute file contents in the global context.
 <<Commands: cmd include: TBP>>=
   procedure :: execute => cmd_include_execute
 <<Commands: procedures>>=
   subroutine cmd_include_execute (cmd, global)
     class(cmd_include_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (associated (cmd%command_list)) then
        call msg_message &
             ("Including Sindarin from '" // char (cmd%file) // "'")
        call cmd%command_list%execute (global)
        call msg_message &
             ("End of included '" // char (cmd%file) // "'")
     end if
   end subroutine cmd_include_execute
 
 @ %def cmd_include_execute
 @
 \subsubsection{Export values}
 This command exports the current values of variables or other objects to the
 surrounding scope.  By default, a scope enclosed by braces keeps all objects
 local to it.  The [[export]] command exports the values that are generated
 within the scope to the corresponding object in the outer scope.
 
 The allowed set of exportable objects is, in principle, the same as the set of
 objects that the [[show]] command supports.  This includes some convenience
 abbreviations.
 
 TODO: The initial implementation inherits syntax from [[show]], but supports
 only the [[results]] pseudo-object.  The results (i.e., the process stack) is
 appended to the outer process stack instead of being discarded.  The behavior
 of the [[export]] command for other object kinds is to be defined on a
 case-by-case basis.  It may involve replacing the outer value or, instead,
 doing some sort of appending or reduction.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_export_t
      private
      type(string_t), dimension(:), allocatable :: name
    contains
    <<Commands: cmd export: TBP>>
   end type cmd_export_t
 
 @ %def cmd_export_t
 @ Output: list the object names, not values.
 <<Commands: cmd export: TBP>>=
   procedure :: write => cmd_export_write
 <<Commands: procedures>>=
   subroutine cmd_export_write (cmd, unit, indent)
     class(cmd_export_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "export: "
     if (allocated (cmd%name)) then
        do i = 1, size (cmd%name)
           write (u, "(1x,A)", advance="no")  char (cmd%name(i))
        end do
        write (u, *)
     else
        write (u, "(5x,A)")  "[undefined]"
     end if
   end subroutine cmd_export_write
 
 @ %def cmd_export_write
 @ Compile.  Allocate an array which is filled with the names of the
 variables to export.
 <<Commands: cmd export: TBP>>=
   procedure :: compile => cmd_export_compile
 <<Commands: procedures>>=
   subroutine cmd_export_compile (cmd, global)
     class(cmd_export_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
     type(string_t) :: key
     integer :: i, n_args
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (pn_arg)) then
        select case (char (parse_node_get_rule_key (pn_arg)))
        case ("show_arg")
           cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
        case default
           cmd%pn_opt => pn_arg
           pn_arg => null ()
        end select
     end if
     call cmd%compile_options (global)
     if (associated (pn_arg)) then
        n_args = parse_node_get_n_sub (pn_arg)
        allocate (cmd%name (n_args))
        pn_var => parse_node_get_sub_ptr (pn_arg)
        i = 0
        do while (associated (pn_var))
           i = i + 1
           select case (char (parse_node_get_rule_key (pn_var)))
           case ("model", "library", "beams", "iterations", &
                 "cuts", "weight", "int", "real", "complex", &
                 "scale", "factorization_scale", "renormalization_scale", &
                 "selection", "reweight", "analysis", "pdg", &
                 "stable", "unstable", "polarized", "unpolarized", &
                 "results", "expect", "intrinsic", "string", "logical")
              cmd%name(i) = parse_node_get_key (pn_var)
           case ("result_var")
              pn_prefix => parse_node_get_sub_ptr (pn_var)
              pn_name => parse_node_get_next_ptr (pn_prefix)
              if (associated (pn_name)) then
                 cmd%name(i) = parse_node_get_key (pn_prefix) &
                      // "(" // parse_node_get_string (pn_name) // ")"
              else
                 cmd%name(i) = parse_node_get_key (pn_prefix)
              end if
           case ("log_var", "string_var", "alias_var")
              pn_prefix => parse_node_get_sub_ptr (pn_var)
              pn_name => parse_node_get_next_ptr (pn_prefix)
              key = parse_node_get_key (pn_prefix)
              if (associated (pn_name)) then
                 select case (char (parse_node_get_rule_key (pn_name)))
                 case ("var_name")
                    select case (char (key))
                    case ("?", "$")  ! $ sign
                       cmd%name(i) = key // parse_node_get_string (pn_name)
                    case ("alias")
                       cmd%name(i) = parse_node_get_string (pn_name)
                    end select
                 case default
                    call parse_node_mismatch &
                         ("var_name",  pn_name)
                 end select
              else
                 cmd%name(i) = key
              end if
           case default
              cmd%name(i) = parse_node_get_string (pn_var)
           end select
           !!! restriction imposed by current lack of implementation
           select case (char (parse_node_get_rule_key (pn_var)))
           case ("results")
           case default
              call msg_fatal ("export: object (type) '" &
                   // char (parse_node_get_rule_key (pn_var)) &
                   // "' not supported yet")
           end select
           pn_var => parse_node_get_next_ptr (pn_var)
        end do
     else
        allocate (cmd%name (0))
     end if
   end subroutine cmd_export_compile
 
 @ %def cmd_export_compile
 @ Execute.  Scan the list of objects to export.
 <<Commands: cmd export: TBP>>=
   procedure :: execute => cmd_export_execute
 <<Commands: procedures>>=
   subroutine cmd_export_execute (cmd, global)
     class(cmd_export_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     call global%append_exports (cmd%name)
   end subroutine cmd_export_execute
 
 @ %def cmd_export_execute
 @
 \subsubsection{Quit command execution}
 The code is the return code of the whole program if it is terminated
 by this command.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_quit_t
      private
      logical :: has_code = .false.
      type(parse_node_t), pointer :: pn_code_expr => null ()
    contains
    <<Commands: cmd quit: TBP>>
   end type cmd_quit_t
 
 @ %def cmd_quit_t
 @ Output.
 <<Commands: cmd quit: TBP>>=
   procedure :: write => cmd_quit_write
 <<Commands: procedures>>=
   subroutine cmd_quit_write (cmd, unit, indent)
     class(cmd_quit_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,L1)")  "quit: has_code = ", cmd%has_code
   end subroutine cmd_quit_write
 
 @ %def cmd_quit_write
 @ Compile: allocate a [[quit]] object which serves as a placeholder.
 <<Commands: cmd quit: TBP>>=
   procedure :: compile => cmd_quit_compile
 <<Commands: procedures>>=
   subroutine cmd_quit_compile (cmd, global)
     class(cmd_quit_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (pn_arg)) then
        cmd%pn_code_expr => parse_node_get_sub_ptr (pn_arg)
        cmd%has_code = .true.
     end if
   end subroutine cmd_quit_compile
 
 @ %def cmd_quit_compile
 @ Execute: The quit command does not execute anything, it just stops
 command execution.  This is achieved by setting quit flag and quit
 code in the global variable list.  However, the return code, if
 present, is an expression which has to be evaluated.
 <<Commands: cmd quit: TBP>>=
   procedure :: execute => cmd_quit_execute
 <<Commands: procedures>>=
   subroutine cmd_quit_execute (cmd, global)
     class(cmd_quit_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     logical :: is_known
     var_list => global%get_var_list_ptr ()
     if (cmd%has_code) then
        global%quit_code = eval_int (cmd%pn_code_expr, var_list, &
             is_known=is_known)
        if (.not. is_known) then
           call msg_error ("Undefined return code of quit/exit command")
        end if
     end if
     global%quit = .true.
   end subroutine cmd_quit_execute
 
 @ %def cmd_quit_execute
 @
 \subsection{The command list}
 The command list holds a list of commands and relevant global data.
 <<Commands: public>>=
   public :: command_list_t
 <<Commands: types>>=
   type :: command_list_t
      ! not private anymore as required by the whizard-c-interface
      class(command_t), pointer :: first => null ()
      class(command_t), pointer :: last => null ()
    contains
    <<Commands: command list: TBP>>
   end type command_list_t
 
 @ %def command_list_t
 @ Output.
 <<Commands: command list: TBP>>=
   procedure :: write => command_list_write
 <<Commands: procedures>>=
   recursive subroutine command_list_write (cmd_list, unit, indent)
     class(command_list_t), intent(in) :: cmd_list
     integer, intent(in), optional :: unit, indent
     class(command_t), pointer :: cmd
     cmd => cmd_list%first
     do while (associated (cmd))
        call cmd%write (unit, indent)
        cmd => cmd%next
     end do
   end subroutine command_list_write
 
 @ %def command_list_write
 @ Append a new command to the list and free the original pointer.
 <<Commands: command list: TBP>>=
   procedure :: append => command_list_append
 <<Commands: procedures>>=
   subroutine command_list_append (cmd_list, command)
     class(command_list_t), intent(inout) :: cmd_list
     class(command_t), intent(inout), pointer :: command
     if (associated (cmd_list%last)) then
        cmd_list%last%next => command
     else
        cmd_list%first => command
     end if
     cmd_list%last => command
     command => null ()
   end subroutine command_list_append
 
 @ %def command_list_append
 @ Finalize.
 <<Commands: command list: TBP>>=
   procedure :: final => command_list_final
 <<Commands: procedures>>=
   recursive subroutine command_list_final (cmd_list)
     class(command_list_t), intent(inout) :: cmd_list
     class(command_t), pointer :: command
     do while (associated (cmd_list%first))
        command => cmd_list%first
        cmd_list%first => cmd_list%first%next
        call command%final ()
        deallocate (command)
     end do
     cmd_list%last => null ()
   end subroutine command_list_final
 
 @ %def command_list_final
 @
 \subsection{Compiling the parse tree}
 Transform a parse tree into a command list.  Initialization is assumed
 to be done.
 
 After each command, we set a breakpoint.
 <<Commands: command list: TBP>>=
   procedure :: compile => command_list_compile
 <<Commands: procedures>>=
   recursive subroutine command_list_compile (cmd_list, pn, global)
     class(command_list_t), intent(inout), target :: cmd_list
     type(parse_node_t), intent(in), target :: pn
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_cmd
     class(command_t), pointer :: command
     integer :: i
     pn_cmd => parse_node_get_sub_ptr (pn)
     do i = 1, parse_node_get_n_sub (pn)
        call dispatch_command (command, pn_cmd)
        call command%compile (global)
        call cmd_list%append (command)
        call terminate_now_if_signal ()
        pn_cmd => parse_node_get_next_ptr (pn_cmd)
     end do
   end subroutine command_list_compile
 
 @ %def command_list_compile
 @
 \subsection{Executing the command list}
 Before executing a command we should execute its options (if any).  After
 that, reset the options, i.e., remove temporary effects from the global
 state.
 
 Also here, after each command we set a breakpoint.
 <<Commands: command list: TBP>>=
   procedure :: execute => command_list_execute
 <<Commands: procedures>>=
   recursive subroutine command_list_execute (cmd_list, global)
     class(command_list_t), intent(in) :: cmd_list
     type(rt_data_t), intent(inout), target :: global
     class(command_t), pointer :: command
     command => cmd_list%first
     COMMAND_COND: do while (associated (command))
        call command%execute_options (global)
        call command%execute (global)
        call command%reset_options (global)
        call terminate_now_if_signal ()
        if (global%quit)  exit COMMAND_COND
        command => command%next
     end do COMMAND_COND
   end subroutine command_list_execute
 
 @ %def command_list_execute
 @
 \subsection{Command list syntax}
 <<Commands: public>>=
   public :: syntax_cmd_list
 <<Commands: variables>>=
   type(syntax_t), target, save :: syntax_cmd_list
 
 @ %def syntax_cmd_list
 <<Commands: public>>=
   public :: syntax_cmd_list_init
 <<Commands: procedures>>=
   subroutine syntax_cmd_list_init ()
     type(ifile_t) :: ifile
     call define_cmd_list_syntax (ifile)
     call syntax_init (syntax_cmd_list, ifile)
     call ifile_final (ifile)
   end subroutine syntax_cmd_list_init
 
 @ %def syntax_cmd_list_init
 <<Commands: public>>=
   public :: syntax_cmd_list_final
 <<Commands: procedures>>=
   subroutine syntax_cmd_list_final ()
     call syntax_final (syntax_cmd_list)
   end subroutine syntax_cmd_list_final
 
 @ %def syntax_cmd_list_final
 <<Commands: public>>=
   public :: syntax_cmd_list_write
 <<Commands: procedures>>=
   subroutine syntax_cmd_list_write (unit)
     integer, intent(in), optional :: unit
     call syntax_write (syntax_cmd_list, unit)
   end subroutine syntax_cmd_list_write
 
 @ %def syntax_cmd_list_write
 <<Commands: procedures>>=
   subroutine define_cmd_list_syntax (ifile)
     type(ifile_t), intent(inout) :: ifile
     call ifile_append (ifile, "SEQ command_list = command*")
     call ifile_append (ifile, "ALT command = " &
          // "cmd_model | cmd_library | cmd_iterations | cmd_sample_format | " &
          // "cmd_var | cmd_slha | " &
          // "cmd_show | cmd_clear | " &
          // "cmd_expect | " &
          // "cmd_cuts | cmd_scale | cmd_fac_scale | cmd_ren_scale | " &
          // "cmd_weight | cmd_selection | cmd_reweight | " &
          // "cmd_beams | cmd_beams_pol_density | cmd_beams_pol_fraction | " &
          // "cmd_beams_momentum | cmd_beams_theta | cmd_beams_phi | " &
          // "cmd_integrate | " &
          // "cmd_observable | cmd_histogram | cmd_plot | cmd_graph | " &
          // "cmd_record | " &
          // "cmd_analysis | cmd_alt_setup | " &
          // "cmd_unstable | cmd_stable | cmd_simulate | cmd_rescan | " &
          // "cmd_process | cmd_compile | cmd_exec | " &
          // "cmd_scan | cmd_if | cmd_include | cmd_quit | " &
          // "cmd_export | " &
          // "cmd_polarized | cmd_unpolarized | " &
          // "cmd_open_out | cmd_close_out | cmd_printf | " &
          // "cmd_write_analysis | cmd_compile_analysis | cmd_nlo | cmd_components")
     call ifile_append (ifile, "GRO options = '{' local_command_list '}'")
     call ifile_append (ifile, "SEQ local_command_list = local_command*")
     call ifile_append (ifile, "ALT local_command = " &
          // "cmd_model | cmd_library | cmd_iterations | cmd_sample_format | " &
          // "cmd_var | cmd_slha | " &
          // "cmd_show | " &
          // "cmd_expect | " &
          // "cmd_cuts | cmd_scale | cmd_fac_scale | cmd_ren_scale | " &
          // "cmd_weight | cmd_selection | cmd_reweight | " &
          // "cmd_beams | cmd_beams_pol_density | cmd_beams_pol_fraction | " &
          // "cmd_beams_momentum | cmd_beams_theta | cmd_beams_phi | " &
          // "cmd_observable | cmd_histogram | cmd_plot | cmd_graph | " &
          // "cmd_clear | cmd_record | " &
          // "cmd_analysis | cmd_alt_setup | " &
          // "cmd_open_out | cmd_close_out | cmd_printf | " &
          // "cmd_write_analysis | cmd_compile_analysis | cmd_nlo | cmd_components")
     call ifile_append (ifile, "SEQ cmd_model = model '=' model_name model_arg?")
     call ifile_append (ifile, "KEY model")
     call ifile_append (ifile, "ALT model_name = model_id | string_literal")
     call ifile_append (ifile, "IDE model_id")
     call ifile_append (ifile, "ARG model_arg = ( model_scheme? )")
     call ifile_append (ifile, "ALT model_scheme = " &
          // "ufo_spec | scheme_id | string_literal")
     call ifile_append (ifile, "SEQ ufo_spec = ufo ufo_arg?")
     call ifile_append (ifile, "KEY ufo")
     call ifile_append (ifile, "ARG ufo_arg = ( string_literal )")
     call ifile_append (ifile, "IDE scheme_id")
     call ifile_append (ifile, "SEQ cmd_library = library '=' lib_name")
     call ifile_append (ifile, "KEY library")
     call ifile_append (ifile, "ALT lib_name = lib_id | string_literal")
     call ifile_append (ifile, "IDE lib_id")
     call ifile_append (ifile, "ALT cmd_var = " &
          // "cmd_log_decl | cmd_log | " &
          // "cmd_int | cmd_real | cmd_complex | cmd_num | " &
          // "cmd_string_decl | cmd_string | cmd_alias | " &
          // "cmd_result")
     call ifile_append (ifile, "SEQ cmd_log_decl = logical cmd_log")
     call ifile_append (ifile, "SEQ cmd_log = '?' var_name '=' lexpr")
     call ifile_append (ifile, "SEQ cmd_int = int var_name '=' expr")
     call ifile_append (ifile, "SEQ cmd_real = real var_name '=' expr")
     call ifile_append (ifile, "SEQ cmd_complex = complex var_name '=' expr")
     call ifile_append (ifile, "SEQ cmd_num = var_name '=' expr")
     call ifile_append (ifile, "SEQ cmd_string_decl = string cmd_string")
     call ifile_append (ifile, "SEQ cmd_string = " &
          // "'$' var_name '=' sexpr") ! $
     call ifile_append (ifile, "SEQ cmd_alias = alias var_name '=' cexpr")
     call ifile_append (ifile, "SEQ cmd_result = result '=' expr")
     call ifile_append (ifile, "SEQ cmd_slha = slha_action slha_arg options?")
     call ifile_append (ifile, "ALT slha_action = " &
          // "read_slha | write_slha")
     call ifile_append (ifile, "KEY read_slha")
     call ifile_append (ifile, "KEY write_slha")
     call ifile_append (ifile, "ARG slha_arg = ( string_literal )")
     call ifile_append (ifile, "SEQ cmd_show = show show_arg options?")
     call ifile_append (ifile, "KEY show")
     call ifile_append (ifile, "ARG show_arg = ( showable* )")
     call ifile_append (ifile, "ALT showable = " &
          // "model | library | beams | iterations | " &
          // "cuts | weight | logical | string | pdg | " &
          // "scale | factorization_scale | renormalization_scale | " &
    // "selection | reweight | analysis | " &
          // "stable | unstable | polarized | unpolarized | " &
          // "expect | intrinsic | int | real | complex | " &
          // "alias_var | string | results | result_var | " &
          // "log_var | string_var | var_name")
     call ifile_append (ifile, "KEY results")
     call ifile_append (ifile, "KEY intrinsic")
     call ifile_append (ifile, "SEQ alias_var = alias var_name")
     call ifile_append (ifile, "SEQ result_var = result_key result_arg?")
     call ifile_append (ifile, "SEQ log_var = '?' var_name")
     call ifile_append (ifile, "SEQ string_var = '$' var_name")  ! $
     call ifile_append (ifile, "SEQ cmd_clear = clear clear_arg options?")
     call ifile_append (ifile, "KEY clear")
     call ifile_append (ifile, "ARG clear_arg = ( clearable* )")
     call ifile_append (ifile, "ALT clearable = " &
          // "beams | iterations | " &
          // "cuts | weight | " &
          // "scale | factorization_scale | renormalization_scale | " &
    // "selection | reweight | analysis | " &
          // "unstable | polarized | " &
          // "expect | " &
          // "log_var | string_var | var_name")
     call ifile_append (ifile, "SEQ cmd_expect = expect expect_arg options?")
     call ifile_append (ifile, "KEY expect")
     call ifile_append (ifile, "ARG expect_arg = ( lexpr )")
     call ifile_append (ifile, "SEQ cmd_cuts = cuts '=' lexpr")
     call ifile_append (ifile, "SEQ cmd_scale = scale '=' expr")
     call ifile_append (ifile, "SEQ cmd_fac_scale = " &
          // "factorization_scale '=' expr")
     call ifile_append (ifile, "SEQ cmd_ren_scale = " &
          // "renormalization_scale '=' expr")
     call ifile_append (ifile, "SEQ cmd_weight = weight '=' expr")
     call ifile_append (ifile, "SEQ cmd_selection = selection '=' lexpr")
     call ifile_append (ifile, "SEQ cmd_reweight = reweight '=' expr")
     call ifile_append (ifile, "KEY cuts")
     call ifile_append (ifile, "KEY scale")
     call ifile_append (ifile, "KEY factorization_scale")
     call ifile_append (ifile, "KEY renormalization_scale")
     call ifile_append (ifile, "KEY weight")
     call ifile_append (ifile, "KEY selection")
     call ifile_append (ifile, "KEY reweight")
     call ifile_append (ifile, "SEQ cmd_process = process process_id '=' " &
          // "process_prt '=>' prt_state_list options?")
     call ifile_append (ifile, "KEY process")
     call ifile_append (ifile, "KEY '=>'")
     call ifile_append (ifile, "LIS process_prt = cexpr+")
     call ifile_append (ifile, "LIS prt_state_list = prt_state_sum+")
     call ifile_append (ifile, "SEQ prt_state_sum = " &
          // "prt_state prt_state_addition*")
     call ifile_append (ifile, "SEQ prt_state_addition = '+' prt_state")
     call ifile_append (ifile, "ALT prt_state = grouped_prt_state_list | cexpr")
     call ifile_append (ifile, "GRO grouped_prt_state_list = " &
          // "( prt_state_list )")
     call ifile_append (ifile, "SEQ cmd_compile = compile_cmd options?")
     call ifile_append (ifile, "SEQ compile_cmd = compile_clause compile_arg?")
     call ifile_append (ifile, "SEQ compile_clause = compile exec_name_spec?")
     call ifile_append (ifile, "KEY compile")
     call ifile_append (ifile, "SEQ exec_name_spec = as exec_name")
     call ifile_append (ifile, "KEY as")
     call ifile_append (ifile, "ALT exec_name = exec_id | string_literal")
     call ifile_append (ifile, "IDE exec_id")
     call ifile_append (ifile, "ARG compile_arg = ( lib_name* )")
     call ifile_append (ifile, "SEQ cmd_exec = exec exec_arg")
     call ifile_append (ifile, "KEY exec")
     call ifile_append (ifile, "ARG exec_arg = ( sexpr )")
     call ifile_append (ifile, "SEQ cmd_beams = beams '=' beam_def")
     call ifile_append (ifile, "KEY beams")
     call ifile_append (ifile, "SEQ beam_def = beam_spec strfun_seq*")
     call ifile_append (ifile, "SEQ beam_spec = beam_list")
     call ifile_append (ifile, "LIS beam_list = cexpr, cexpr?")
     call ifile_append (ifile, "SEQ cmd_beams_pol_density = " &
          // "beams_pol_density '=' beams_pol_spec")
     call ifile_append (ifile, "KEY beams_pol_density")
     call ifile_append (ifile, "LIS beams_pol_spec = smatrix, smatrix?")
     call ifile_append (ifile, "SEQ smatrix = '@' smatrix_arg")
     ! call ifile_append (ifile, "KEY '@'")     !!! Key already exists
     call ifile_append (ifile, "ARG smatrix_arg = ( sentry* )")
     call ifile_append (ifile, "SEQ sentry = expr extra_sentry*")
     call ifile_append (ifile, "SEQ extra_sentry = ':' expr")
     call ifile_append (ifile, "SEQ cmd_beams_pol_fraction = " &
          // "beams_pol_fraction '=' beams_par_spec")
     call ifile_append (ifile, "KEY beams_pol_fraction")
     call ifile_append (ifile, "SEQ cmd_beams_momentum = " &
          // "beams_momentum '=' beams_par_spec")
     call ifile_append (ifile, "KEY beams_momentum")
     call ifile_append (ifile, "SEQ cmd_beams_theta = " &
          // "beams_theta '=' beams_par_spec")
     call ifile_append (ifile, "KEY beams_theta")
     call ifile_append (ifile, "SEQ cmd_beams_phi = " &
          // "beams_phi '=' beams_par_spec")
     call ifile_append (ifile, "KEY beams_phi")
     call ifile_append (ifile, "LIS beams_par_spec = expr, expr?")
     call ifile_append (ifile, "SEQ strfun_seq = '=>' strfun_pair")
     call ifile_append (ifile, "LIS strfun_pair = strfun_def, strfun_def?")
     call ifile_append (ifile, "SEQ strfun_def = strfun_id")
     call ifile_append (ifile, "ALT strfun_id = " &
           // "none | lhapdf | lhapdf_photon | pdf_builtin | pdf_builtin_photon | " &
           // "isr | epa | ewa | circe1 | circe2 | energy_scan | " &
           // "gaussian | beam_events")
     call ifile_append (ifile, "KEY none")
     call ifile_append (ifile, "KEY lhapdf")
     call ifile_append (ifile, "KEY lhapdf_photon")
     call ifile_append (ifile, "KEY pdf_builtin")
     call ifile_append (ifile, "KEY pdf_builtin_photon")
     call ifile_append (ifile, "KEY isr")
     call ifile_append (ifile, "KEY epa")
     call ifile_append (ifile, "KEY ewa")
     call ifile_append (ifile, "KEY circe1")
     call ifile_append (ifile, "KEY circe2")
     call ifile_append (ifile, "KEY energy_scan")
     call ifile_append (ifile, "KEY gaussian")
     call ifile_append (ifile, "KEY beam_events")
     call ifile_append (ifile, "SEQ cmd_integrate = " &
          // "integrate proc_arg options?")
     call ifile_append (ifile, "KEY integrate")
     call ifile_append (ifile, "ARG proc_arg = ( proc_id* )")
     call ifile_append (ifile, "IDE proc_id")
     call ifile_append (ifile, "SEQ cmd_iterations = " &
          // "iterations '=' iterations_list")
     call ifile_append (ifile, "KEY iterations")
     call ifile_append (ifile, "LIS iterations_list = iterations_spec+")
     call ifile_append (ifile, "ALT iterations_spec = it_spec")
     call ifile_append (ifile, "SEQ it_spec = expr calls_spec adapt_spec?")
     call ifile_append (ifile, "SEQ calls_spec = ':' expr")
     call ifile_append (ifile, "SEQ adapt_spec = ':' sexpr")
     call ifile_append (ifile, "SEQ cmd_components = " &
          // "active '=' component_list")
     call ifile_append (ifile, "KEY active")
     call ifile_append (ifile, "LIS component_list = sexpr+")
     call ifile_append (ifile, "SEQ cmd_sample_format = " &
          // "sample_format '=' event_format_list")
     call ifile_append (ifile, "KEY sample_format")
     call ifile_append (ifile, "LIS event_format_list = event_format+")
     call ifile_append (ifile, "IDE event_format")
     call ifile_append (ifile, "SEQ cmd_observable = " &
          // "observable analysis_tag options?")
     call ifile_append (ifile, "KEY observable")
     call ifile_append (ifile, "SEQ cmd_histogram = " &
          // "histogram analysis_tag histogram_arg " &
          // "options?")
     call ifile_append (ifile, "KEY histogram")
     call ifile_append (ifile, "ARG histogram_arg = (expr, expr, expr?)")
     call ifile_append (ifile, "SEQ cmd_plot = plot analysis_tag options?")
     call ifile_append (ifile, "KEY plot")
     call ifile_append (ifile, "SEQ cmd_graph = graph graph_term '=' graph_def")
     call ifile_append (ifile, "KEY graph")
     call ifile_append (ifile, "SEQ graph_term = analysis_tag options?")
     call ifile_append (ifile, "SEQ graph_def = graph_term graph_append*")
     call ifile_append (ifile, "SEQ graph_append = '&' graph_term")
     call ifile_append (ifile, "SEQ cmd_analysis = analysis '=' lexpr")
     call ifile_append (ifile, "KEY analysis")
     call ifile_append (ifile, "SEQ cmd_alt_setup = " &
          // "alt_setup '=' option_list_expr")
     call ifile_append (ifile, "KEY alt_setup")
     call ifile_append (ifile, "ALT option_list_expr = " &
          // "grouped_option_list | option_list")
     call ifile_append (ifile, "GRO grouped_option_list = ( option_list_expr )")
     call ifile_append (ifile, "LIS option_list = options+")
     call ifile_append (ifile, "SEQ cmd_open_out = open_out open_arg options?")
     call ifile_append (ifile, "SEQ cmd_close_out = close_out open_arg options?")
     call ifile_append (ifile, "KEY open_out")
     call ifile_append (ifile, "KEY close_out")
     call ifile_append (ifile, "ARG open_arg = (sexpr)")
     call ifile_append (ifile, "SEQ cmd_printf = printf_cmd options?")
     call ifile_append (ifile, "SEQ printf_cmd = printf_clause sprintf_args?")
     call ifile_append (ifile, "SEQ printf_clause = printf sexpr")
     call ifile_append (ifile, "KEY printf")
     call ifile_append (ifile, "SEQ cmd_record = record_cmd")
     call ifile_append (ifile, "SEQ cmd_unstable = " &
          // "unstable cexpr unstable_arg options?")
     call ifile_append (ifile, "KEY unstable")
     call ifile_append (ifile, "ARG unstable_arg = ( proc_id* )")
     call ifile_append (ifile, "SEQ cmd_stable = stable stable_list options?")
     call ifile_append (ifile, "KEY stable")
     call ifile_append (ifile, "LIS stable_list = cexpr+")
     call ifile_append (ifile, "KEY polarized")
     call ifile_append (ifile, "SEQ cmd_polarized = polarized polarized_list options?")
     call ifile_append (ifile, "LIS polarized_list = cexpr+")
     call ifile_append (ifile, "KEY unpolarized")
     call ifile_append (ifile, "SEQ cmd_unpolarized = unpolarized unpolarized_list options?")
     call ifile_append (ifile, "LIS unpolarized_list = cexpr+")
     call ifile_append (ifile, "SEQ cmd_simulate = " &
          // "simulate proc_arg options?")
     call ifile_append (ifile, "KEY simulate")
     call ifile_append (ifile, "SEQ cmd_rescan = " &
          // "rescan sexpr proc_arg options?")
     call ifile_append (ifile, "KEY rescan")
     call ifile_append (ifile, "SEQ cmd_scan = scan scan_var scan_body?")
     call ifile_append (ifile, "KEY scan")
     call ifile_append (ifile, "ALT scan_var = " &
          // "scan_log_decl | scan_log | " &
          // "scan_int | scan_real | scan_complex | scan_num | " &
          // "scan_string_decl | scan_string | scan_alias | " &
          // "scan_cuts | scan_weight | " &
          // "scan_scale | scan_ren_scale | scan_fac_scale | " &
          // "scan_selection | scan_reweight | scan_analysis | " &
          // "scan_model | scan_library")
     call ifile_append (ifile, "SEQ scan_log_decl = logical scan_log")
     call ifile_append (ifile, "SEQ scan_log = '?' var_name '=' scan_log_arg")
     call ifile_append (ifile, "ARG scan_log_arg = ( lexpr* )")
     call ifile_append (ifile, "SEQ scan_int = int var_name '=' scan_num_arg")
     call ifile_append (ifile, "SEQ scan_real = real var_name '=' scan_num_arg")
     call ifile_append (ifile, "SEQ scan_complex = " &
          // "complex var_name '=' scan_num_arg")
     call ifile_append (ifile, "SEQ scan_num = var_name '=' scan_num_arg")
     call ifile_append (ifile, "ARG scan_num_arg = ( range* )")
     call ifile_append (ifile, "ALT range = grouped_range | range_expr")
     call ifile_append (ifile, "GRO grouped_range = ( range_expr )")
     call ifile_append (ifile, "SEQ range_expr = expr range_spec?")
     call ifile_append (ifile, "SEQ range_spec = '=>' expr step_spec?")
     call ifile_append (ifile, "SEQ step_spec = step_op expr")
     call ifile_append (ifile, "ALT step_op = " &
          // "'/+' | '/-' | '/*' | '//' | '/+/' | '/*/'")
     call ifile_append (ifile, "KEY '/+'")
     call ifile_append (ifile, "KEY '/-'")
     call ifile_append (ifile, "KEY '/*'")
     call ifile_append (ifile, "KEY '//'")
     call ifile_append (ifile, "KEY '/+/'")
     call ifile_append (ifile, "KEY '/*/'")
     call ifile_append (ifile, "SEQ scan_string_decl = string scan_string")
     call ifile_append (ifile, "SEQ scan_string = " &
          // "'$' var_name '=' scan_string_arg")
     call ifile_append (ifile, "ARG scan_string_arg = ( sexpr* )")
     call ifile_append (ifile, "SEQ scan_alias = " &
          // "alias var_name '=' scan_alias_arg")
     call ifile_append (ifile, "ARG scan_alias_arg = ( cexpr* )")
     call ifile_append (ifile, "SEQ scan_cuts = cuts '=' scan_lexpr_arg")
     call ifile_append (ifile, "ARG scan_lexpr_arg = ( lexpr* )")
     call ifile_append (ifile, "SEQ scan_scale = scale '=' scan_expr_arg")
     call ifile_append (ifile, "ARG scan_expr_arg = ( expr* )")
     call ifile_append (ifile, "SEQ scan_fac_scale = " &
          // "factorization_scale '=' scan_expr_arg")
     call ifile_append (ifile, "SEQ scan_ren_scale = " &
          // "renormalization_scale '=' scan_expr_arg")
     call ifile_append (ifile, "SEQ scan_weight = weight '=' scan_expr_arg")
     call ifile_append (ifile, "SEQ scan_selection = selection '=' scan_lexpr_arg")
     call ifile_append (ifile, "SEQ scan_reweight = reweight '=' scan_expr_arg")
     call ifile_append (ifile, "SEQ scan_analysis = analysis '=' scan_lexpr_arg")
     call ifile_append (ifile, "SEQ scan_model = model '=' scan_model_arg")
     call ifile_append (ifile, "ARG scan_model_arg = ( model_name* )")
     call ifile_append (ifile, "SEQ scan_library = library '=' scan_library_arg")
     call ifile_append (ifile, "ARG scan_library_arg = ( lib_name* )")
     call ifile_append (ifile, "GRO scan_body = '{' command_list '}'")
     call ifile_append (ifile, "SEQ cmd_if = " &
          // "if lexpr then command_list elsif_clauses else_clause endif")
     call ifile_append (ifile, "SEQ elsif_clauses = cmd_elsif*")
     call ifile_append (ifile, "SEQ cmd_elsif = elsif lexpr then command_list")
     call ifile_append (ifile, "SEQ else_clause = cmd_else?")
     call ifile_append (ifile, "SEQ cmd_else = else command_list")
     call ifile_append (ifile, "SEQ cmd_include = include include_arg")
     call ifile_append (ifile, "KEY include")
     call ifile_append (ifile, "ARG include_arg = ( string_literal )")
     call ifile_append (ifile, "SEQ cmd_quit = quit_cmd quit_arg?")
     call ifile_append (ifile, "ALT quit_cmd = quit | exit")
     call ifile_append (ifile, "KEY quit")
     call ifile_append (ifile, "KEY exit")
     call ifile_append (ifile, "ARG quit_arg = ( expr )")
     call ifile_append (ifile, "SEQ cmd_export = export show_arg options?")
     call ifile_append (ifile, "KEY export")
     call ifile_append (ifile, "SEQ cmd_write_analysis = " &
          // "write_analysis_clause options?")
     call ifile_append (ifile, "SEQ cmd_compile_analysis = " &
          // "compile_analysis_clause options?")
     call ifile_append (ifile, "SEQ write_analysis_clause = " &
          // "write_analysis write_analysis_arg?")
     call ifile_append (ifile, "SEQ compile_analysis_clause = " &
          // "compile_analysis write_analysis_arg?")
     call ifile_append (ifile, "KEY write_analysis")
     call ifile_append (ifile, "KEY compile_analysis")
     call ifile_append (ifile, "ARG write_analysis_arg = ( analysis_tag* )")
     call ifile_append (ifile, "SEQ cmd_nlo = " &
                        // "nlo_calculation '=' nlo_calculation_list")
     call ifile_append (ifile, "KEY nlo_calculation")
     call ifile_append (ifile, "LIS nlo_calculation_list = nlo_comp+")
     call ifile_append (ifile, "ALT nlo_comp = " // &
          "full | born | real | virtual | dglap | subtraction | " // &
          "mismatch | GKS")
     call ifile_append (ifile, "KEY full")
     call ifile_append (ifile, "KEY born")
     call ifile_append (ifile, "KEY virtual")
     call ifile_append (ifile, "KEY dglap")
     call ifile_append (ifile, "KEY subtraction")
     call ifile_append (ifile, "KEY mismatch")
     call ifile_append (ifile, "KEY GKS")
     call define_expr_syntax (ifile, particles=.true., analysis=.true.)
   end subroutine define_cmd_list_syntax
 
 @ %def define_cmd_list_syntax
 <<Commands: public>>=
   public :: lexer_init_cmd_list
 <<Commands: procedures>>=
   subroutine lexer_init_cmd_list (lexer, parent_lexer)
     type(lexer_t), intent(out) :: lexer
     type(lexer_t), intent(in), optional, target :: parent_lexer
     call lexer_init (lexer, &
          comment_chars = "#!", &
          quote_chars = '"', &
          quote_match = '"', &
          single_chars = "()[]{},;:&%?$@", &
          special_class = [ "+-*/^", "<>=~ " ] , &
          keyword_list = syntax_get_keyword_list_ptr (syntax_cmd_list), &
          parent = parent_lexer)
   end subroutine lexer_init_cmd_list
 
 @ %def lexer_init_cmd_list
 @
 \subsection{Unit Tests}
 Test module, followed by the corresponding implementation module.
 <<[[commands_ut.f90]]>>=
 <<File header>>
 
 module commands_ut
   use unit_tests
   use commands_uti
 
 <<Standard module head>>
 
 <<Commands: public test>>
 
 contains
 
 <<Commands: test driver>>
 
 end module commands_ut
 @ %def commands_ut
 @
 <<[[commands_uti.f90]]>>=
 <<File header>>
 
 module commands_uti
 
   <<Use kinds>>
     use kinds, only: i64
   <<Use strings>>
     use io_units
     use ifiles
     use parser
     use interactions, only: reset_interaction_counter
     use prclib_stacks
     use analysis
     use variables, only: var_list_t
     use models
     use slha_interface
     use rt_data
     use event_base, only: generic_event_t, event_callback_t
 
     use commands
 
 <<Standard module head>>
 
 <<Commands: test declarations>>
 
 <<Commands: test auxiliary types>>
 
 contains
 
 <<Commands: tests>>
 
 <<Commands: test auxiliary>>
 
 end module commands_uti
 
 @ %def commands_uti
 @ API: driver for the unit tests below.
 <<Commands: public test>>=
   public :: commands_test
 <<Commands: test driver>>=
   subroutine commands_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Commands: execute tests>>
   end subroutine commands_test
 
 @ %def commands_test
 @
 \subsubsection{Prepare Sindarin code}
 This routine parses an internal file, prints the parse tree, and
 returns a parse node to the root.  We use the routine in the tests
 below.
 <<Commands: public test auxiliary>>=
   public :: parse_ifile
 <<Commands: test auxiliary>>=
   subroutine parse_ifile (ifile, pn_root, u)
     use ifiles
     use lexers
     use parser
     use commands
     type(ifile_t), intent(in) :: ifile
     type(parse_node_t), pointer, intent(out) :: pn_root
     integer, intent(in), optional :: u
     type(stream_t), target :: stream
     type(lexer_t), target :: lexer
     type(parse_tree_t) :: parse_tree
 
     call lexer_init_cmd_list (lexer)
     call stream_init (stream, ifile)
     call lexer_assign_stream (lexer, stream)
 
     call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
     if (present (u))  call parse_tree_write (parse_tree, u)
     pn_root => parse_tree%get_root_ptr ()
 
     call stream_final (stream)
     call lexer_final (lexer)
   end subroutine parse_ifile
 
 @ %def parse_ifile
 @
 \subsubsection{Empty command list}
 Compile and execute an empty command list.  Should do nothing but
 test the integrity of the workflow.
 <<Commands: execute tests>>=
   call test (commands_1, "commands_1", &
        "empty command list", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_1
 <<Commands: tests>>=
   subroutine commands_1 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_1"
     write (u, "(A)")  "*   Purpose: compile and execute empty command list"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Parse empty file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
 
     if (associated (pn_root)) then
        call command_list%compile (pn_root, global)
     end if
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
 
     call global%activate ()
     call command_list%execute (global)
     call global%deactivate ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call syntax_cmd_list_final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_1"
 
   end subroutine commands_1
 
 @ %def commands_1
 @
 \subsubsection{Read model}
 Execute a [[model]] assignment.
 <<Commands: execute tests>>=
   call test (commands_2, "commands_2", &
        "model", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_2
 <<Commands: tests>>=
   subroutine commands_2 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_2"
     write (u, "(A)")  "*   Purpose: set model"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_2"
 
   end subroutine commands_2
 
 @ %def commands_2
 @
 \subsubsection{Declare Process}
 Read a model, then declare a process.  The process library is allocated
 explicitly.  For the process definition, We take the default ([[omega]])
 method.  Since we do not compile, \oMega\ is not actually called.
 <<Commands: execute tests>>=
   call test (commands_3, "commands_3", &
        "process declaration", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_3
 <<Commands: tests>>=
   subroutine commands_3 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_3"
     write (u, "(A)")  "*   Purpose: define process"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%var_list%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd3"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process t3 = s, s => s, s')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%prclib_stack%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_3"
 
   end subroutine commands_3
 
 @ %def commands_3
 @
 \subsubsection{Compile Process}
 Read a model, then declare a process and compile the library.  The process
 library is allocated explicitly.  For the process definition, We take the
 default ([[unit_test]]) method.  There is no external code, so compilation of
 the library is merely a formal status change.
 <<Commands: execute tests>>=
   call test (commands_4, "commands_4", &
        "compilation", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_4
 <<Commands: tests>>=
   subroutine commands_4 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_4"
     write (u, "(A)")  "*   Purpose: define process and compile library"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd4"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process t4 = s, s => s, s')
     call ifile_append (ifile, 'compile ("lib_cmd4")')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%prclib_stack%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_4"
 
   end subroutine commands_4
 
 @ %def commands_4
 @
 \subsubsection{Integrate Process}
 Read a model, then declare a process, compile the library, and
 integrate over phase space.  We take the
 default ([[unit_test]]) method and use the simplest methods of
 phase-space parameterization and integration.
 <<Commands: execute tests>>=
   call test (commands_5, "commands_5", &
        "integration", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_5
 <<Commands: tests>>=
   subroutine commands_5 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_5"
     write (u, "(A)")  "*   Purpose: define process, iterations, and integrate"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
     call global%var_list%set_int (var_str ("seed"), 0, is_known=.true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd5"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process t5 = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (t5)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call command_list%execute (global)
 
     call global%it_list%write (u)
     write (u, "(A)")
     call global%process_stack%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_5"
 
   end subroutine commands_5
 
 @ %def commands_5
 @
 \subsubsection{Variables}
 Set intrinsic and user-defined variables.
 <<Commands: execute tests>>=
   call test (commands_6, "commands_6", &
        "variables", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_6
 <<Commands: tests>>=
   subroutine commands_6 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_6"
     write (u, "(A)")  "*   Purpose: define and set variables"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
     call global%write_vars (u, [ &
          var_str ("$run_id"), &
          var_str ("?unweighted"), &
          var_str ("sqrts")])
 
     write (u, "(A)")
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$run_id = "run1"')
     call ifile_append (ifile, '?unweighted = false')
     call ifile_append (ifile, 'sqrts = 1000')
     call ifile_append (ifile, 'int j = 10')
     call ifile_append (ifile, 'real x = 1000.')
     call ifile_append (ifile, 'complex z = 5')
     call ifile_append (ifile, 'string $text = "abcd"')
     call ifile_append (ifile, 'logical ?flag = true')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_vars (u, [ &
          var_str ("$run_id"), &
          var_str ("?unweighted"), &
          var_str ("sqrts"), &
          var_str ("j"), &
          var_str ("x"), &
          var_str ("z"), &
          var_str ("$text"), &
          var_str ("?flag")])
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call syntax_cmd_list_final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_6"
 
   end subroutine commands_6
 
 @ %def commands_6
 @
 \subsubsection{Process library}
 Open process libraries explicitly.
 <<Commands: execute tests>>=
   call test (commands_7, "commands_7", &
        "process library", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_7
 <<Commands: tests>>=
   subroutine commands_7 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_7"
     write (u, "(A)")  "*   Purpose: declare process libraries"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
     call global%var_list%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     global%os_data%fc = "Fortran-compiler"
     global%os_data%fcflags = "Fortran-flags"
 
     write (u, "(A)")
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'library = "lib_cmd7_1"')
     call ifile_append (ifile, 'library = "lib_cmd7_2"')
     call ifile_append (ifile, 'library = "lib_cmd7_1"')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_libraries (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call syntax_cmd_list_final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_7"
 
   end subroutine commands_7
 
 @ %def commands_7
 @
 \subsubsection{Generate events}
 Read a model, then declare a process, compile the library, and
 generate weighted events.  We take the
 default ([[unit_test]]) method and use the simplest methods of
 phase-space parameterization and integration.
 <<Commands: execute tests>>=
   call test (commands_8, "commands_8", &
        "event generation", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_8
 <<Commands: tests>>=
   subroutine commands_8 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_8"
     write (u, "(A)")  "*   Purpose: define process, integrate, generate events"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd8"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_8_p = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (commands_8_p)')
     call ifile_append (ifile, '?unweighted = false')
     call ifile_append (ifile, 'n_events = 3')
     call ifile_append (ifile, '?read_raw = false')
     call ifile_append (ifile, 'simulate (commands_8_p)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
 
     call command_list%execute (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_8"
 
   end subroutine commands_8
 
 @ %def commands_8
 @
 \subsubsection{Define cuts}
 Declare a cut expression.
 <<Commands: execute tests>>=
   call test (commands_9, "commands_9", &
        "cuts", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_9
 <<Commands: tests>>=
   subroutine commands_9 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(string_t), dimension(0) :: no_vars
 
     write (u, "(A)")  "* Test output: commands_9"
     write (u, "(A)")  "*   Purpose: define cuts"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'cuts = all Pt > 0 [particle]')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write (u, vars = no_vars)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_9"
 
   end subroutine commands_9
 
 @ %def commands_9
 @
 \subsubsection{Beams}
 Define beam setup.
 <<Commands: execute tests>>=
   call test (commands_10, "commands_10", &
        "beams", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_10
 <<Commands: tests>>=
   subroutine commands_10 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_10"
     write (u, "(A)")  "*   Purpose: define beams"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = QCD')
     call ifile_append (ifile, 'sqrts = 1000')
     call ifile_append (ifile, 'beams = p, p')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_beams (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_10"
 
   end subroutine commands_10
 
 @ %def commands_10
 @
 \subsubsection{Structure functions}
 Define beam setup with structure functions
 <<Commands: execute tests>>=
   call test (commands_11, "commands_11", &
        "structure functions", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_11
 <<Commands: tests>>=
   subroutine commands_11 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_11"
     write (u, "(A)")  "*   Purpose: define beams with structure functions"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = QCD')
     call ifile_append (ifile, 'sqrts = 1100')
     call ifile_append (ifile, 'beams = p, p => lhapdf => pdf_builtin, isr')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_beams (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_11"
 
   end subroutine commands_11
 
 @ %def commands_11
 @
 \subsubsection{Rescan events}
 Read a model, then declare a process, compile the library, and
 generate weighted events.  We take the
 default ([[unit_test]]) method and use the simplest methods of
 phase-space parameterization and integration.  Then, rescan the
 generated event sample.
 <<Commands: execute tests>>=
   call test (commands_12, "commands_12", &
        "event rescanning", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_12
 <<Commands: tests>>=
   subroutine commands_12 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_12"
     write (u, "(A)")  "*   Purpose: generate events and rescan"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%var_list%append_log (&
          var_str ("?rebuild_phase_space"), .false., &
          intrinsic=.true.)
     call global%var_list%append_log (&
          var_str ("?rebuild_grids"), .false., &
          intrinsic=.true.)
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd12"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_12_p = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (commands_12_p)')
     call ifile_append (ifile, '?unweighted = false')
     call ifile_append (ifile, 'n_events = 3')
     call ifile_append (ifile, '?read_raw = false')
     call ifile_append (ifile, 'simulate (commands_12_p)')
     call ifile_append (ifile, '?write_raw = false')
     call ifile_append (ifile, 'rescan "commands_12_p" (commands_12_p)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
 
     call command_list%execute (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_12"
 
   end subroutine commands_12
 
 @ %def commands_12
 @
 \subsubsection{Event Files}
 Set output formats for event files.
 <<Commands: execute tests>>=
   call test (commands_13, "commands_13", &
        "event output formats", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_13
 <<Commands: tests>>=
   subroutine commands_13 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
     logical :: exist
 
     write (u, "(A)")  "* Test output: commands_13"
     write (u, "(A)")  "*   Purpose: generate events and rescan"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd13"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_13_p = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (commands_13_p)')
     call ifile_append (ifile, '?unweighted = false')
     call ifile_append (ifile, 'n_events = 1')
     call ifile_append (ifile, '?read_raw = false')
     call ifile_append (ifile, 'sample_format = weight_stream')
     call ifile_append (ifile, 'simulate (commands_13_p)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
 
     call command_list%execute (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Verify output files"
     write (u, "(A)")
 
     inquire (file = "commands_13_p.evx", exist = exist)
     if (exist)  write (u, "(1x,A)")  "raw"
 
     inquire (file = "commands_13_p.weights.dat", exist = exist)
     if (exist)  write (u, "(1x,A)")  "weight_stream"
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_13"
 
   end subroutine commands_13
 
 @ %def commands_13
 @
 \subsubsection{Compile Empty Libraries}
 (This is a regression test:)  Declare two empty libraries and compile them.
 <<Commands: execute tests>>=
   call test (commands_14, "commands_14", &
        "empty libraries", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_14
 <<Commands: tests>>=
   subroutine commands_14 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_14"
     write (u, "(A)")  "*   Purpose: define and compile empty libraries"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_cmd_list_init ()
 
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'library = "lib1"')
     call ifile_append (ifile, 'library = "lib2"')
     call ifile_append (ifile, 'compile ()')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%prclib_stack%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
 
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_14"
 
   end subroutine commands_14
 
 @ %def commands_14
 @
 \subsubsection{Compile Process}
 Read a model, then declare a process and compile the library.  The process
 library is allocated explicitly.  For the process definition, We take the
 default ([[unit_test]]) method.  There is no external code, so compilation of
 the library is merely a formal status change.
 <<Commands: execute tests>>=
   call test (commands_15, "commands_15", &
        "compilation", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_15
 <<Commands: tests>>=
   subroutine commands_15 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_15"
     write (u, "(A)")  "*   Purpose: define process and compile library"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd15"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process t15 = s, s => s, s')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (t15)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%prclib_stack%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_15"
 
   end subroutine commands_15
 
 @ %def commands_15
 @
 \subsubsection{Observable}
 Declare an observable, fill it and display.
 <<Commands: execute tests>>=
   call test (commands_16, "commands_16", &
        "observables", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_16
 <<Commands: tests>>=
   subroutine commands_16 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_16"
     write (u, "(A)")  "*   Purpose: declare an observable"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$obs_label = "foo"')
     call ifile_append (ifile, '$obs_unit = "cm"')
     call ifile_append (ifile, '$title = "Observable foo"')
     call ifile_append (ifile, '$description = "This is observable foo"')
     call ifile_append (ifile, 'observable foo')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Record two data items"
     write (u, "(A)")
 
     call analysis_record_data (var_str ("foo"), 1._default)
     call analysis_record_data (var_str ("foo"), 3._default)
 
     write (u, "(A)")  "* Display analysis store"
     write (u, "(A)")
 
     call analysis_write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_16"
 
   end subroutine commands_16
 
 @ %def commands_16
 @
 \subsubsection{Histogram}
 Declare a histogram, fill it and display.
 <<Commands: execute tests>>=
   call test (commands_17, "commands_17", &
        "histograms", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_17
 <<Commands: tests>>=
   subroutine commands_17 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(string_t), dimension(3) :: name
     integer :: i
 
     write (u, "(A)")  "* Test output: commands_17"
     write (u, "(A)")  "*   Purpose: declare histograms"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$obs_label = "foo"')
     call ifile_append (ifile, '$obs_unit = "cm"')
     call ifile_append (ifile, '$title = "Histogram foo"')
     call ifile_append (ifile, '$description = "This is histogram foo"')
     call ifile_append (ifile, 'histogram foo (0,5,1)')
     call ifile_append (ifile, '$title = "Histogram bar"')
     call ifile_append (ifile, '$description = "This is histogram bar"')
     call ifile_append (ifile, 'n_bins = 2')
     call ifile_append (ifile, 'histogram bar (0,5)')
     call ifile_append (ifile, '$title = "Histogram gee"')
     call ifile_append (ifile, '$description = "This is histogram gee"')
     call ifile_append (ifile, '?normalize_bins = true')
     call ifile_append (ifile, 'histogram gee (0,5)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Record two data items"
     write (u, "(A)")
 
     name(1) = "foo"
     name(2) = "bar"
     name(3) = "gee"
 
     do i = 1, 3
        call analysis_record_data (name(i), 0.1_default, &
             weight = 0.25_default)
        call analysis_record_data (name(i), 3.1_default)
        call analysis_record_data (name(i), 4.1_default, &
             excess = 0.5_default)
        call analysis_record_data (name(i), 7.1_default)
     end do
 
     write (u, "(A)")  "* Display analysis store"
     write (u, "(A)")
 
     call analysis_write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_17"
 
   end subroutine commands_17
 
 @ %def commands_17
 @
 \subsubsection{Plot}
 Declare a plot, fill it and display contents.
 <<Commands: execute tests>>=
   call test (commands_18, "commands_18", &
        "plots", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_18
 <<Commands: tests>>=
   subroutine commands_18 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_18"
     write (u, "(A)")  "*   Purpose: declare a plot"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$obs_label = "foo"')
     call ifile_append (ifile, '$obs_unit = "cm"')
     call ifile_append (ifile, '$title = "Plot foo"')
     call ifile_append (ifile, '$description = "This is plot foo"')
     call ifile_append (ifile, '$x_label = "x axis"')
     call ifile_append (ifile, '$y_label = "y axis"')
     call ifile_append (ifile, '?x_log = false')
     call ifile_append (ifile, '?y_log = true')
     call ifile_append (ifile, 'x_min = -1')
     call ifile_append (ifile, 'x_max = 1')
     call ifile_append (ifile, 'y_min = 0.1')
     call ifile_append (ifile, 'y_max = 1000')
     call ifile_append (ifile, 'plot foo')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Record two data items"
     write (u, "(A)")
 
     call analysis_record_data (var_str ("foo"), 0._default, 20._default, &
          xerr = 0.25_default)
     call analysis_record_data (var_str ("foo"), 0.5_default, 0.2_default, &
          yerr = 0.07_default)
     call analysis_record_data (var_str ("foo"), 3._default, 2._default)
 
     write (u, "(A)")  "* Display analysis store"
     write (u, "(A)")
 
     call analysis_write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_18"
 
   end subroutine commands_18
 
 @ %def commands_18
 @
 \subsubsection{Graph}
 Combine two (empty) plots to a graph.
 <<Commands: execute tests>>=
   call test (commands_19, "commands_19", &
        "graphs", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_19
 <<Commands: tests>>=
   subroutine commands_19 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_19"
     write (u, "(A)")  "*   Purpose: combine two plots to a graph"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'plot a')
     call ifile_append (ifile, 'plot b')
     call ifile_append (ifile, '$title = "Graph foo"')
     call ifile_append (ifile, '$description = "This is graph foo"')
     call ifile_append (ifile, 'graph foo = a & b')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Display analysis object"
     write (u, "(A)")
 
     call analysis_write (var_str ("foo"), u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_19"
 
   end subroutine commands_19
 
 @ %def commands_19
 @
 \subsubsection{Record Data}
 Record data in previously allocated analysis objects.
 <<Commands: execute tests>>=
   call test (commands_20, "commands_20", &
        "record data", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_20
 <<Commands: tests>>=
   subroutine commands_20 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_20"
     write (u, "(A)")  "*   Purpose: record data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization: create observable, histogram, plot"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     call analysis_init_observable (var_str ("o"))
     call analysis_init_histogram (var_str ("h"), 0._default, 1._default, 3, &
          normalize_bins = .false.)
     call analysis_init_plot (var_str ("p"))
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'record o (1.234)')
     call ifile_append (ifile, 'record h (0.5)')
     call ifile_append (ifile, 'record p (1, 2)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Display analysis object"
     write (u, "(A)")
 
     call analysis_write (u, verbose = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_20"
 
   end subroutine commands_20
 
 @ %def commands_20
 @
 \subsubsection{Analysis}
 Declare an analysis expression and use it to fill an observable during
 event generation.
 <<Commands: execute tests>>=
   call test (commands_21, "commands_21", &
        "analysis expression", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_21
 <<Commands: tests>>=
   subroutine commands_21 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_21"
     write (u, "(A)")  "*   Purpose: create and use analysis expression"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization: create observable"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd8"))
     call global%add_prclib (lib)
 
     call analysis_init_observable (var_str ("m"))
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_21_p = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:100')
     call ifile_append (ifile, 'integrate (commands_21_p)')
     call ifile_append (ifile, '?unweighted = true')
     call ifile_append (ifile, 'n_events = 3')
     call ifile_append (ifile, '?read_raw = false')
     call ifile_append (ifile, 'observable m')
     call ifile_append (ifile, 'analysis = record m (eval M [s])')
     call ifile_append (ifile, 'simulate (commands_21_p)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Display analysis object"
     write (u, "(A)")
 
     call analysis_write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_21"
 
   end subroutine commands_21
 
 @ %def commands_21
 @
 \subsubsection{Write Analysis}
 Write accumulated analysis data to file.
 <<Commands: execute tests>>=
   call test (commands_22, "commands_22", &
        "write analysis", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_22
 <<Commands: tests>>=
   subroutine commands_22 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     integer :: u_file, iostat
     logical :: exist
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: commands_22"
     write (u, "(A)")  "*   Purpose: write analysis data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization: create observable"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     call analysis_init_observable (var_str ("m"))
     call analysis_record_data (var_str ("m"), 125._default)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$out_file = "commands_22.dat"')
     call ifile_append (ifile, 'write_analysis')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Display analysis data"
     write (u, "(A)")
 
     inquire (file = "commands_22.dat", exist = exist)
     if (.not. exist) then
        write (u, "(A)")  "ERROR: File commands_22.dat not found"
        return
     end if
 
     u_file = free_unit ()
     open (u_file, file = "commands_22.dat", &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_22"
 
   end subroutine commands_22
 
 @ %def commands_22
 @
 \subsubsection{Compile Analysis}
 Write accumulated analysis data to file and compile.
 <<Commands: execute tests>>=
   call test (commands_23, "commands_23", &
        "compile analysis", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_23
 <<Commands: tests>>=
   subroutine commands_23 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     integer :: u_file, iostat
     character(256) :: buffer
     logical :: exist
     type(graph_options_t) :: graph_options
 
     write (u, "(A)")  "* Test output: commands_23"
     write (u, "(A)")  "*   Purpose: write and compile analysis data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization: create and fill histogram"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     call graph_options_init (graph_options)
     call graph_options_set (graph_options, &
          title = var_str ("Histogram for test: commands 23"), &
          description = var_str ("This is a test."), &
          width_mm = 125, height_mm = 85)
     call analysis_init_histogram (var_str ("h"), &
          0._default, 10._default, 2._default, .false., &
          graph_options = graph_options)
     call analysis_record_data (var_str ("h"), 1._default)
     call analysis_record_data (var_str ("h"), 1._default)
     call analysis_record_data (var_str ("h"), 1._default)
     call analysis_record_data (var_str ("h"), 1._default)
     call analysis_record_data (var_str ("h"), 3._default)
     call analysis_record_data (var_str ("h"), 3._default)
     call analysis_record_data (var_str ("h"), 3._default)
     call analysis_record_data (var_str ("h"), 5._default)
     call analysis_record_data (var_str ("h"), 7._default)
     call analysis_record_data (var_str ("h"), 7._default)
     call analysis_record_data (var_str ("h"), 7._default)
     call analysis_record_data (var_str ("h"), 7._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$out_file = "commands_23.dat"')
     call ifile_append (ifile, 'compile_analysis')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Delete Postscript output"
     write (u, "(A)")
 
     inquire (file = "commands_23.ps", exist = exist)
     if (exist) then
        u_file = free_unit ()
        open (u_file, file = "commands_23.ps", action = "write", status = "old")
        close (u_file, status = "delete")
     end if
     inquire (file = "commands_23.ps", exist = exist)
     write (u, "(1x,A,L1)")  "Postcript output exists = ", exist
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* TeX file"
     write (u, "(A)")
 
     inquire (file = "commands_23.tex", exist = exist)
     if (.not. exist) then
        write (u, "(A)")  "ERROR: File commands_23.tex not found"
        return
     end if
 
     u_file = free_unit ()
     open (u_file, file = "commands_23.tex", &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
     write (u, *)
 
     inquire (file = "commands_23.ps", exist = exist)
     write (u, "(1x,A,L1)")  "Postcript output exists = ", exist
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_23"
 
   end subroutine commands_23
 
 @ %def commands_23
 @
 \subsubsection{Histogram}
 Declare a histogram, fill it and display.
 <<Commands: execute tests>>=
   call test (commands_24, "commands_24", &
        "drawing options", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_24
 <<Commands: tests>>=
   subroutine commands_24 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_24"
     write (u, "(A)")  "*   Purpose: check graph and drawing options"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$title = "Title"')
     call ifile_append (ifile, '$description = "Description"')
     call ifile_append (ifile, '$x_label = "X Label"')
     call ifile_append (ifile, '$y_label = "Y Label"')
     call ifile_append (ifile, 'graph_width_mm = 111')
     call ifile_append (ifile, 'graph_height_mm = 222')
     call ifile_append (ifile, 'x_min = -11')
     call ifile_append (ifile, 'x_max = 22')
     call ifile_append (ifile, 'y_min = -33')
     call ifile_append (ifile, 'y_max = 44')
     call ifile_append (ifile, '$gmlcode_bg = "GML Code BG"')
     call ifile_append (ifile, '$gmlcode_fg = "GML Code FG"')
     call ifile_append (ifile, '$fill_options = "Fill Options"')
     call ifile_append (ifile, '$draw_options = "Draw Options"')
     call ifile_append (ifile, '$err_options = "Error Options"')
     call ifile_append (ifile, '$symbol = "Symbol"')
     call ifile_append (ifile, 'histogram foo (0,1)')
     call ifile_append (ifile, 'plot bar')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Display analysis store"
     write (u, "(A)")
 
     call analysis_write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_24"
 
   end subroutine commands_24
 
 @ %def commands_24
 @
 \subsubsection{Local Environment}
 Declare a local environment.
 <<Commands: execute tests>>=
   call test (commands_25, "commands_25", &
        "local process environment", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_25
 <<Commands: tests>>=
   subroutine commands_25 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_25"
     write (u, "(A)")  "*   Purpose: declare local environment for process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_cmd_list_init ()
     call global%global_init ()
     call global%var_list%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'library = "commands_25_lib"')
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_25_p1 = g, g => g, g &
          &{ model = "QCD" }')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
     call global%write_libraries (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_25"
 
   end subroutine commands_25
 
 @ %def commands_25
 @
 \subsubsection{Alternative Setups}
 Declare a list of alternative setups.
 <<Commands: execute tests>>=
   call test (commands_26, "commands_26", &
        "alternative setups", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_26
 <<Commands: tests>>=
   subroutine commands_26 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_26"
     write (u, "(A)")  "*   Purpose: declare alternative setups for simulation"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'int i = 0')
     call ifile_append (ifile, 'alt_setup = ({ i = 1 }, { i = 2 })')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_expr (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_26"
 
   end subroutine commands_26
 
 @ %def commands_26
 @
 \subsubsection{Unstable Particle}
 Define decay processes and declare a particle as unstable.  Also check
 the commands stable, polarized, unpolarized.
 <<Commands: execute tests>>=
   call test (commands_27, "commands_27", &
        "unstable and polarized particles", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_27
 <<Commands: tests>>=
   subroutine commands_27 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_27"
     write (u, "(A)")  "*   Purpose: modify particle properties"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
 
     allocate (lib)
     call lib%init (var_str ("commands_27_lib"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'ff = 0.4')
     call ifile_append (ifile, 'process d1 = s => f, fbar')
     call ifile_append (ifile, 'unstable s (d1)')
     call ifile_append (ifile, 'polarized f, fbar')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Show model"
     write (u, "(A)")
 
     call global%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extra Input"
     write (u, "(A)")
 
     call ifile_final (ifile)
     call ifile_append (ifile, '?diagonal_decay = true')
     call ifile_append (ifile, 'unstable s (d1)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%final ()
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Show model"
     write (u, "(A)")
 
     call global%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extra Input"
     write (u, "(A)")
 
     call ifile_final (ifile)
     call ifile_append (ifile, '?isotropic_decay = true')
     call ifile_append (ifile, 'unstable s (d1)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%final ()
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Show model"
     write (u, "(A)")
 
     call global%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extra Input"
     write (u, "(A)")
 
     call ifile_final (ifile)
     call ifile_append (ifile, 'stable s')
     call ifile_append (ifile, 'unpolarized f')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%final ()
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Show model"
     write (u, "(A)")
 
     call global%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_model_file_init ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_27"
 
   end subroutine commands_27
 
 @ %def commands_27
 @
 \subsubsection{Quit the program}
 Quit the program.
 <<Commands: execute tests>>=
   call test (commands_28, "commands_28", &
        "quit", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_28
 <<Commands: tests>>=
   subroutine commands_28 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root1, pn_root2
     type(string_t), dimension(0) :: no_vars
 
     write (u, "(A)")  "* Test output: commands_28"
     write (u, "(A)")  "*   Purpose: quit the program"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file: quit without code"
     write (u, "(A)")
 
     call ifile_append (ifile, 'quit')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root1, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root1, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write (u, vars = no_vars)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Input file: quit with code"
     write (u, "(A)")
 
     call ifile_final (ifile)
     call command_list%final ()
     call ifile_append (ifile, 'quit ( 3 + 4 )')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root2, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root2, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write (u, vars = no_vars)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_28"
 
   end subroutine commands_28
 
 @ %def commands_28
 @
 \subsubsection{SLHA interface}
 Testing commands steering the SLHA interface.
 <<Commands: execute tests>>=
   call test (commands_29, "commands_29", &
        "SLHA interface", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_29
 <<Commands: tests>>=
   subroutine commands_29 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(var_list_t), pointer :: model_vars
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_29"
     write (u, "(A)")  "*   Purpose: test SLHA interface"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call syntax_slha_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Model MSSM, read SLHA file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "MSSM"')
     call ifile_append (ifile, '?slha_read_decays = true')
     call ifile_append (ifile, 'read_slha ("sps1ap_decays.slha")')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Model MSSM, default values:"
     write (u, "(A)")
 
     call global%model%write (u, verbose = .false., &
          show_vertices = .false., show_particles = .false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Selected global variables"
     write (u, "(A)")
 
     model_vars => global%model%get_var_list_ptr ()
 
     call model_vars%write_var (var_str ("mch1"), u)
     call model_vars%write_var (var_str ("wch1"), u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Model MSSM, values from SLHA file"
     write (u, "(A)")
 
     call global%model%write (u, verbose = .false., &
          show_vertices = .false., show_particles = .false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Selected global variables"
     write (u, "(A)")
 
     model_vars => global%model%get_var_list_ptr ()
 
     call model_vars%write_var (var_str ("mch1"), u)
     call model_vars%write_var (var_str ("wch1"), u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_slha_final ()
     call syntax_model_file_final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_29"
 
   end subroutine commands_29
 
 @ %def commands_29
 @
 \subsubsection{Expressions for scales}
 Declare a scale, factorization scale or factorization scale expression.
 <<Commands: execute tests>>=
   call test (commands_30, "commands_30", &
        "scales", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_30
 <<Commands: tests>>=
   subroutine commands_30 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_30"
     write (u, "(A)")  "*   Purpose: define scales"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'scale = 200 GeV')
     call ifile_append (ifile, &
          'factorization_scale = eval Pt [particle]')
     call ifile_append (ifile, &
          'renormalization_scale = eval E [particle]')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_expr (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_30"
 
   end subroutine commands_30
 
 @ %def commands_30
 @
 \subsubsection{Weight and reweight expressions}
 Declare an expression for event weights and reweighting.
 <<Commands: execute tests>>=
   call test (commands_31, "commands_31", &
        "event weights/reweighting", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_31
 <<Commands: tests>>=
   subroutine commands_31 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_31"
     write (u, "(A)")  "*   Purpose: define weight/reweight"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'weight = eval Pz [particle]')
     call ifile_append (ifile, 'reweight = eval M2 [particle]')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_expr (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_31"
 
   end subroutine commands_31
 
 @ %def commands_31
 @
 \subsubsection{Selecting events}
 Declare an expression for selecting events in an analysis.
 <<Commands: execute tests>>=
   call test (commands_32, "commands_32", &
        "event selection", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_32
 <<Commands: tests>>=
   subroutine commands_32 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_32"
     write (u, "(A)")  "*   Purpose: define selection"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'selection = any PDG == 13 [particle]')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_expr (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_32"
 
   end subroutine commands_32
 
 @ %def commands_32
 @
 \subsubsection{Executing shell commands}
 Execute a shell command.
 <<Commands: execute tests>>=
   call test (commands_33, "commands_33", &
        "execute shell command", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_33
 <<Commands: tests>>=
   subroutine commands_33 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     integer :: u_file, iostat
     character(3) :: buffer
 
     write (u, "(A)")  "* Test output: commands_33"
     write (u, "(A)")  "*   Purpose: execute shell command"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'exec ("echo foo >> bar")')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
     u_file = free_unit ()
     open (u_file, file = "bar", &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (iostat /= 0) exit
     end do
     write (u, "(A,A)")  "should be 'foo': ", trim (buffer)
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_33"
 
   end subroutine commands_33
 
 @ %def commands_33
 @
 \subsubsection{Callback}
 Instead of an explicit write, use the callback feature to write the
 analysis file during event generation.  We generate 4 events and
 arrange that the callback is executed while writing the 3rd event.
 <<Commands: execute tests>>=
   call test (commands_34, "commands_34", &
        "analysis via callback", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_34
 <<Commands: tests>>=
   subroutine commands_34 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
     type(event_callback_34_t) :: event_callback
 
     write (u, "(A)")  "* Test output: commands_34"
     write (u, "(A)")  "*   Purpose: write analysis data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization: create observable"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd34"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "* Prepare callback for writing analysis to I/O unit"
     write (u, "(A)")
 
     event_callback%u = u
     call global%set_event_callback (event_callback)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_34_p = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (commands_34_p)')
     call ifile_append (ifile, 'observable sq')
     call ifile_append (ifile, 'analysis = record sq (sqrts)')
     call ifile_append (ifile, 'n_events = 4')
     call ifile_append (ifile, 'event_callback_interval = 3')
     call ifile_append (ifile, 'simulate (commands_34_p)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_34"
 
   end subroutine commands_34
 
 @ %def commands_34
 @ For this test, we invent a callback object which simply writes the
 analysis file, using the standard call for this.  Here we rely on the
 fact that the analysis data are stored as a global entity, otherwise
 we would have to access them via the event object.
 <<Commands: test auxiliary types>>=
   type, extends (event_callback_t) :: event_callback_34_t
      private
      integer :: u = 0
    contains
      procedure :: write => event_callback_34_write
      procedure :: proc => event_callback_34
   end type event_callback_34_t
 
 @ %def event_callback_t
 @ The output routine is unused.  The actual callback should write the
 analysis data to the output unit that we have injected into the
 callback object.
 <<Commands: test auxiliary>>=
   subroutine event_callback_34_write (event_callback, unit)
     class(event_callback_34_t), intent(in) :: event_callback
     integer, intent(in), optional :: unit
   end subroutine event_callback_34_write
 
   subroutine event_callback_34 (event_callback, i, event)
     class(event_callback_34_t), intent(in) :: event_callback
     integer(i64), intent(in) :: i
     class(generic_event_t), intent(in) :: event
     call analysis_write (event_callback%u)
   end subroutine event_callback_34
 
 @ %def event_callback_34_write
 @ %def event_callback_34
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Toplevel module WHIZARD}
 <<[[whizard.f90]]>>=
 <<File header>>
 
 module whizard
 
   use io_units
 <<Use strings>>
   use system_defs, only: VERSION_STRING
   use system_defs, only: EOF, BACKSLASH
   use diagnostics
   use os_interface
   use ifiles
   use lexers
   use parser
   use eval_trees
   use models
   use phs_forests
   use prclib_stacks
   use slha_interface
   use blha_config
   use rt_data
   use commands
 
 <<Standard module head>>
 
 <<WHIZARD: public>>
 
 <<WHIZARD: types>>
 
   save
 
 contains
 
 <<WHIZARD: procedures>>
 
 end module whizard
 @ %def whizard
 @
 \subsection{Options}
 Here we introduce a wrapper that holds various user options, so they
 can transparently be passed from the main program to the [[whizard]]
 object.  Most parameters are used for initializing the [[global]]
 state.
 <<WHIZARD: public>>=
   public :: whizard_options_t
 <<WHIZARD: types>>=
   type :: whizard_options_t
      type(string_t) :: job_id
      type(string_t), dimension(:), allocatable :: pack_args
      type(string_t), dimension(:), allocatable :: unpack_args
      type(string_t) :: preload_model
      type(string_t) :: default_lib
      type(string_t) :: preload_libraries
      logical :: rebuild_library = .false.
      logical :: recompile_library = .false.
      logical :: rebuild_user
      logical :: rebuild_phs = .false.
      logical :: rebuild_grids = .false.
      logical :: rebuild_events = .false.
   end type whizard_options_t
 
 @ %def whizard_options_t
 @
 \subsection{Parse tree stack}
 We collect all parse trees that we generate in the [[whizard]] object.  To
 this end, we create a stack of parse trees.  They must not be finalized before
 the [[global]] object is finalized, because items such as a cut definition may
 contain references to the parse tree from which they were generated.
 <<WHIZARD: types>>=
   type, extends (parse_tree_t) :: pt_entry_t
      type(pt_entry_t), pointer :: previous => null ()
   end type pt_entry_t
 
 @ %def pt_entry_t
 @ This is the stack.  Since we always prepend, we just need the [[last]]
 pointer.
 <<WHIZARD: types>>=
   type :: pt_stack_t
      type(pt_entry_t), pointer :: last => null ()
    contains
    <<WHIZARD: pt stack: TBP>>
   end type pt_stack_t
 
 @ %def pt_stack_t
 @ The finalizer is called at the very end.
 <<WHIZARD: pt stack: TBP>>=
   procedure :: final => pt_stack_final
 <<WHIZARD: procedures>>=
   subroutine pt_stack_final (pt_stack)
     class(pt_stack_t), intent(inout) :: pt_stack
     type(pt_entry_t), pointer :: current
     do while (associated (pt_stack%last))
        current => pt_stack%last
        pt_stack%last => current%previous
        call parse_tree_final (current%parse_tree_t)
        deallocate (current)
     end do
   end subroutine pt_stack_final
 
 @ %def pt_stack_final
 @ Create and push a new entry, keeping the previous ones.
 <<WHIZARD: pt stack: TBP>>=
   procedure :: push => pt_stack_push
 <<WHIZARD: procedures>>=
   subroutine pt_stack_push (pt_stack, parse_tree)
     class(pt_stack_t), intent(inout) :: pt_stack
     type(parse_tree_t), intent(out), pointer :: parse_tree
     type(pt_entry_t), pointer :: current
     allocate (current)
     parse_tree => current%parse_tree_t
     current%previous => pt_stack%last
     pt_stack%last => current
   end subroutine pt_stack_push
 
 @ %def pt_stack_push
 @
 \subsection{The [[whizard]] object}
 An object of type [[whizard_t]] is the top-level wrapper for a
 \whizard\ instance.  The object holds various default
 settings and the current state of the generator, the [[global]] object
 of type [[rt_data_t]].  This object contains, for instance, the list
 of variables and the process libraries.
 
 Since components of the [[global]] subobject are frequently used as
 targets, the [[whizard]] object should also consistently carry the
 [[target]] attribute.
 
 The various self-tests do no not use this object.  They initialize
 only specific subsets of the system, according to their needs.
 
 Note: we intend to allow several concurrent instances.  In the current
 implementation, there are still a few obstacles to this: the model
 library and the syntax tables are global variables, and the error
 handling uses global state.  This should be improved.
 <<WHIZARD: public>>=
   public :: whizard_t
 <<WHIZARD: types>>=
   type :: whizard_t
      type(whizard_options_t) :: options
      type(rt_data_t) :: global
      type(pt_stack_t) :: pt_stack
    contains
    <<WHIZARD: whizard: TBP>>
   end type whizard_t
 
 @ %def whizard_t
 @
 \subsection{Initialization and finalization}
 <<WHIZARD: whizard: TBP>>=
   procedure :: init => whizard_init
 <<WHIZARD: procedures>>=
   subroutine whizard_init (whizard, options, paths, logfile)
     class(whizard_t), intent(out), target :: whizard
     type(whizard_options_t), intent(in) :: options
     type(paths_t), intent(in), optional :: paths
     type(string_t), intent(in), optional :: logfile
     call init_syntax_tables ()
     whizard%options = options
     call whizard%global%global_init (paths, logfile)
     call whizard%init_job_id ()
     call whizard%init_rebuild_flags ()
     call whizard%unpack_files ()
     call whizard%preload_model ()
     call whizard%preload_library ()
     call whizard%global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
   end subroutine whizard_init
 
 @ %def whizard_init
 @ Apart from the global data which have been initialized above, the
 process and model lists need to be finalized.
 <<WHIZARD: whizard: TBP>>=
   procedure :: final => whizard_final
 <<WHIZARD: procedures>>=
   subroutine whizard_final (whizard)
     class(whizard_t), intent(inout), target :: whizard
     call whizard%global%final ()
     call whizard%pt_stack%final ()
     call whizard%pack_files ()
 !!! JRR: WK please check (#529)
     !    call user_code_final ()
     call final_syntax_tables ()
   end subroutine whizard_final
 
 @ %def whizard_final
 @ Set the job ID, if nonempty.  If the ID string is empty, the value remains
 undefined.
 <<WHIZARD: whizard: TBP>>=
   procedure :: init_job_id => whizard_init_job_id
 <<WHIZARD: procedures>>=
   subroutine whizard_init_job_id (whizard)
     class(whizard_t), intent(inout), target :: whizard
     associate (var_list => whizard%global%var_list, options => whizard%options)
       if (options%job_id /= "") then
          call var_list%set_string (var_str ("$job_id"), &
               options%job_id, is_known=.true.)
       end if
     end associate
   end subroutine whizard_init_job_id
 
 @ %def whizard_init_job_id
 @
 Set the rebuild flags.  They can be specified on the command line and
 set the initial value for the associated logical variables.
 <<WHIZARD: whizard: TBP>>=
   procedure :: init_rebuild_flags => whizard_init_rebuild_flags
 <<WHIZARD: procedures>>=
   subroutine whizard_init_rebuild_flags (whizard)
     class(whizard_t), intent(inout), target :: whizard
     associate (var_list => whizard%global%var_list, options => whizard%options)
       call var_list%append_log (var_str ("?rebuild_library"), &
            options%rebuild_library, intrinsic=.true.)
       call var_list%append_log (var_str ("?recompile_library"), &
            options%recompile_library, intrinsic=.true.)
       call var_list%append_log (var_str ("?rebuild_phase_space"), &
            options%rebuild_phs, intrinsic=.true.)
       call var_list%append_log (var_str ("?rebuild_grids"), &
            options%rebuild_grids, intrinsic=.true.)
       call var_list%append_log (var_str ("?powheg_rebuild_grids"), &
            options%rebuild_grids, intrinsic=.true.)
       call var_list%append_log (var_str ("?rebuild_events"), &
            options%rebuild_events, intrinsic=.true.)
     end associate
   end subroutine whizard_init_rebuild_flags
 
 @ %def whizard_init_rebuild_flags
 @
 Pack/unpack files in the working directory, if requested.
 <<WHIZARD: whizard: TBP>>=
   procedure :: pack_files => whizard_pack_files
   procedure :: unpack_files => whizard_unpack_files
 <<WHIZARD: procedures>>=
   subroutine whizard_pack_files (whizard)
     class(whizard_t), intent(in), target :: whizard
     logical :: exist
     integer :: i
     type(string_t) :: file
     if (allocated (whizard%options%pack_args)) then
        do i = 1, size (whizard%options%pack_args)
           file = whizard%options%pack_args(i)
           call msg_message ("Packing file/dir '" // char (file) // "'")
           exist = os_file_exist (file) .or. os_dir_exist (file)
           if (exist) then
              call os_pack_file (whizard%options%pack_args(i), &
                   whizard%global%os_data)
           else
              call msg_error ("File/dir '" // char (file) // "' not found")
           end if
        end do
     end if
   end subroutine whizard_pack_files
 
   subroutine whizard_unpack_files (whizard)
     class(whizard_t), intent(in), target :: whizard
     logical :: exist
     integer :: i
     type(string_t) :: file
     if (allocated (whizard%options%unpack_args)) then
        do i = 1, size (whizard%options%unpack_args)
           file = whizard%options%unpack_args(i)
           call msg_message ("Unpacking file '" // char (file) // "'")
           exist = os_file_exist (file)
           if (exist) then
              call os_unpack_file (whizard%options%unpack_args(i), &
                   whizard%global%os_data)
           else
              call msg_error ("File '" // char (file) // "' not found")
           end if
        end do
     end if
   end subroutine whizard_unpack_files
 
 @ %def whizard_pack_files
 @ %def whizard_unpack_files
 @
 This procedure preloads a model, if a model name is given.
 <<WHIZARD: whizard: TBP>>=
   procedure :: preload_model => whizard_preload_model
 <<WHIZARD: procedures>>=
   subroutine whizard_preload_model (whizard)
     class(whizard_t), intent(inout), target :: whizard
     type(string_t) :: model_name
     model_name = whizard%options%preload_model
     if (model_name /= "") then
        call whizard%global%read_model (model_name, whizard%global%preload_model)
        whizard%global%model => whizard%global%preload_model
        if (associated (whizard%global%model)) then
           call whizard%global%model%link_var_list (whizard%global%var_list)
           call msg_message ("Preloaded model: " &
                // char (model_name))
        else
           call msg_fatal ("Preloading model " // char (model_name) &
                // " failed")
        end if
     else
        call msg_message ("No model preloaded")
     end if
   end subroutine whizard_preload_model
 
 @ %def whizard_preload_model
 @
 This procedure preloads a library, if a library name is given.
 
 Note: This version just opens a new library with that name.  It does not load
 (yet) an existing library on file, as previous \whizard\ versions would do.
 <<WHIZARD: whizard: TBP>>=
   procedure :: preload_library => whizard_preload_library
 <<WHIZARD: procedures>>=
   subroutine whizard_preload_library (whizard)
     class(whizard_t), intent(inout), target :: whizard
     type(string_t) :: library_name, libs
     type(string_t), dimension(:), allocatable :: libname_static
     type(prclib_entry_t), pointer :: lib_entry
     integer :: i
     call get_prclib_static (libname_static)
     do i = 1, size (libname_static)
        allocate (lib_entry)
        call lib_entry%init_static (libname_static(i))
        call whizard%global%add_prclib (lib_entry)
     end do
     libs = adjustl (whizard%options%preload_libraries)
     if (libs == "" .and. whizard%options%default_lib /= "") then
           allocate (lib_entry)
           call lib_entry%init (whizard%options%default_lib)
           call whizard%global%add_prclib (lib_entry)
           call msg_message ("Preloaded library: " // &
                char (whizard%options%default_lib))
        end if
     SCAN_LIBS: do while (libs /= "")
        call split (libs, library_name, " ")
        if (library_name /= "") then
           allocate (lib_entry)
           call lib_entry%init (library_name)
           call whizard%global%add_prclib (lib_entry)
           call msg_message ("Preloaded library: " // char (library_name))
        end if
     end do SCAN_LIBS
   end subroutine whizard_preload_library
 
 @ %def whizard_preload_library
 @
 \subsection{Initialization and finalization (old version)}
 These procedures initialize and finalize global variables.  Most of
 them are collected in the [[global]] data record located here, the
 others are syntax tables located in various modules, which do not
 change during program execution.  Furthermore, there is a global model
 list and a global process store, which get filled during program
 execution but are finalized here.
 
 During initialization, we can preload a default model and initialize a
 default library for setting up processes.  The default library is
 loaded if requested by the setup.  Further libraries can be loaded as
 specified by command-line flags.
 @ Initialize/finalize the syntax tables used by WHIZARD:
 <<WHIZARD: public>>=
   public :: init_syntax_tables
   public :: final_syntax_tables
 <<WHIZARD: procedures>>=
   subroutine init_syntax_tables ()
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
     call syntax_pexpr_init ()
     call syntax_slha_init ()
     call syntax_cmd_list_init ()
   end subroutine init_syntax_tables
 
   subroutine final_syntax_tables ()
     call syntax_model_file_final ()
     call syntax_phs_forest_final ()
     call syntax_pexpr_final ()
     call syntax_slha_final ()
     call syntax_cmd_list_final ()
   end subroutine final_syntax_tables
 
 @ %def init_syntax_tables
 @ %def final_syntax_tables
 @ Write the syntax tables to external files.
 <<WHIZARD: public>>=
   public :: write_syntax_tables
 <<WHIZARD: procedures>>=
   subroutine write_syntax_tables ()
     integer :: unit
     character(*), parameter :: file_model = "whizard.model_file.syntax"
     character(*), parameter :: file_phs = "whizard.phase_space_file.syntax"
     character(*), parameter :: file_pexpr = "whizard.prt_expressions.syntax"
     character(*), parameter :: file_slha = "whizard.slha.syntax"
     character(*), parameter :: file_sindarin = "whizard.sindarin.syntax"
     unit = free_unit ()
     print *, "Writing file '" // file_model // "'"
     open (unit=unit, file=file_model, status="replace", action="write")
     write (unit, "(A)")  VERSION_STRING
     write (unit, "(A)")  "Syntax definition file: " // file_model
     call syntax_model_file_write (unit)
     close (unit)
     print *, "Writing file '" // file_phs // "'"
     open (unit=unit, file=file_phs, status="replace", action="write")
     write (unit, "(A)")  VERSION_STRING
     write (unit, "(A)")  "Syntax definition file: " // file_phs
     call syntax_phs_forest_write (unit)
     close (unit)
     print *, "Writing file '" // file_pexpr // "'"
     open (unit=unit, file=file_pexpr, status="replace", action="write")
     write (unit, "(A)")  VERSION_STRING
     write (unit, "(A)")  "Syntax definition file: " // file_pexpr
     call syntax_pexpr_write (unit)
     close (unit)
     print *, "Writing file '" // file_slha // "'"
     open (unit=unit, file=file_slha, status="replace", action="write")
     write (unit, "(A)")  VERSION_STRING
     write (unit, "(A)")  "Syntax definition file: " // file_slha
     call syntax_slha_write (unit)
     close (unit)
     print *, "Writing file '" // file_sindarin // "'"
     open (unit=unit, file=file_sindarin, status="replace", action="write")
     write (unit, "(A)")  VERSION_STRING
     write (unit, "(A)")  "Syntax definition file: " // file_sindarin
     call syntax_cmd_list_write (unit)
     close (unit)
   end subroutine write_syntax_tables
 
 @ %def write_syntax_tables
 @
 \subsection{Execute command lists}
 Process commands given on the command line, stored as an [[ifile]].  The whole
 input is read, compiled and executed as a whole.
 <<WHIZARD: whizard: TBP>>=
   procedure :: process_ifile => whizard_process_ifile
 <<WHIZARD: procedures>>=
   subroutine whizard_process_ifile (whizard, ifile, quit, quit_code)
     class(whizard_t), intent(inout), target :: whizard
     type(ifile_t), intent(in) :: ifile
     logical, intent(out) :: quit
     integer, intent(out) :: quit_code
     type(lexer_t), target :: lexer
     type(stream_t), target :: stream
     call msg_message ("Reading commands given on the command line")
     call lexer_init_cmd_list (lexer)
     call stream_init (stream, ifile)
     call whizard%process_stream (stream, lexer, quit, quit_code)
     call stream_final (stream)
     call lexer_final (lexer)
   end subroutine whizard_process_ifile
 
 @ %def whizard_process_ifile
 @ Process standard input as a command list.  The whole input is read,
 compiled and executed as a whole.
 <<WHIZARD: whizard: TBP>>=
   procedure :: process_stdin => whizard_process_stdin
 <<WHIZARD: procedures>>=
   subroutine whizard_process_stdin (whizard, quit, quit_code)
     class(whizard_t), intent(inout), target :: whizard
     logical, intent(out) :: quit
     integer, intent(out) :: quit_code
     type(lexer_t), target :: lexer
     type(stream_t), target :: stream
     call msg_message ("Reading commands from standard input")
     call lexer_init_cmd_list (lexer)
     call stream_init (stream, 5)
     call whizard%process_stream (stream, lexer, quit, quit_code)
     call stream_final (stream)
     call lexer_final (lexer)
   end subroutine whizard_process_stdin
 
 @ %def whizard_process_stdin
 @ Process a file as a command list.
 <<WHIZARD: whizard: TBP>>=
   procedure :: process_file => whizard_process_file
 <<WHIZARD: procedures>>=
   subroutine whizard_process_file (whizard, file, quit, quit_code)
     class(whizard_t), intent(inout), target :: whizard
     type(string_t), intent(in) :: file
     logical, intent(out) :: quit
     integer, intent(out) :: quit_code
     type(lexer_t), target :: lexer
     type(stream_t), target :: stream
     logical :: exist
     call msg_message ("Reading commands from file '" // char (file) // "'")
     inquire (file=char(file), exist=exist)
     if (exist) then
        call lexer_init_cmd_list (lexer)
        call stream_init (stream, char (file))
        call whizard%process_stream (stream, lexer, quit, quit_code)
        call stream_final (stream)
        call lexer_final (lexer)
     else
        call msg_error ("File '" // char (file) // "' not found")
     end if
   end subroutine whizard_process_file
 
 @ %def whizard_process_file
 @
 <<WHIZARD: whizard: TBP>>=
   procedure :: process_stream => whizard_process_stream
 <<WHIZARD: procedures>>=
   subroutine whizard_process_stream (whizard, stream, lexer, quit, quit_code)
     class(whizard_t), intent(inout), target :: whizard
     type(stream_t), intent(inout), target :: stream
     type(lexer_t), intent(inout), target :: lexer
     logical, intent(out) :: quit
     integer, intent(out) :: quit_code
     type(parse_tree_t), pointer :: parse_tree
     type(command_list_t), target :: command_list
     call lexer_assign_stream (lexer, stream)
     call whizard%pt_stack%push (parse_tree)
     call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
     if (associated (parse_tree%get_root_ptr ())) then
        whizard%global%lexer => lexer
        call command_list%compile (parse_tree%get_root_ptr (), &
             whizard%global)
     end if
     call whizard%global%activate ()
     call command_list%execute (whizard%global)
     call command_list%final ()
     quit = whizard%global%quit
     quit_code = whizard%global%quit_code
   end subroutine whizard_process_stream
 
 @ %def whizard_process_stream
 @
 \subsection{The WHIZARD shell}
 This procedure implements interactive mode.  One line is processed at
 a time.
 <<WHIZARD: whizard: TBP>>=
   procedure :: shell => whizard_shell
 <<WHIZARD: procedures>>=
   subroutine whizard_shell (whizard, quit_code)
     class(whizard_t), intent(inout), target :: whizard
     integer, intent(out) :: quit_code
     type(lexer_t), target :: lexer
     type(stream_t), target :: stream
     type(string_t) :: prompt1
     type(string_t) :: prompt2
     type(string_t) :: input
     type(string_t) :: extra
     integer :: last
     integer :: iostat
     logical :: mask_tmp
     logical :: quit
     call msg_message ("Launching interactive shell")
     call lexer_init_cmd_list (lexer)
     prompt1 = "whish? "
     prompt2 = "     > "
     COMMAND_LOOP: do
        call put (6, prompt1)
        call get (5, input, iostat=iostat)
        if (iostat > 0 .or. iostat == EOF) exit COMMAND_LOOP
        CONTINUE_INPUT: do
           last = len_trim (input)
           if (extract (input, last, last) /= BACKSLASH)  exit CONTINUE_INPUT
           call put (6, prompt2)
           call get (5, extra, iostat=iostat)
           if (iostat > 0) exit COMMAND_LOOP
           input = replace (input, last, extra)
        end do CONTINUE_INPUT
        call stream_init (stream, input)
        mask_tmp = mask_fatal_errors
        mask_fatal_errors = .true.
        call whizard%process_stream (stream, lexer, quit, quit_code)
        msg_count = 0
        mask_fatal_errors = mask_tmp
        call stream_final (stream)
        if (quit)  exit COMMAND_LOOP
     end do COMMAND_LOOP
     print *
     call lexer_final (lexer)
   end subroutine whizard_shell
 
 @ %def whizard_shell
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Tools for the command line}
 
 We 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{Query Feature Support}
 This module accesses the various optional features (modules) that
 WHIZARD can support and repors on their availability.
 <<[[features.f90]]>>=
 module features
 
   use string_utils, only: lower_case
   use system_dependencies, only: WHIZARD_VERSION
 <<Features: dependencies>>
 
 <<Standard module head>>
 
 <<Features: public>>
 
 contains
 
 <<Features: procedures>>
 
 end module features
 @ %def features
 @
 \subsection{Output}
 <<Features: public>>=
   public :: print_features
 <<Features: procedures>>=
   subroutine print_features ()
     print "(A)", "WHIZARD " // WHIZARD_VERSION
     print "(A)", "Build configuration:"
   <<Features: config>>
     print "(A)", "Optional features available in this build:"
   <<Features: print>>
   end subroutine print_features
 
 @ %def print_features
 @
 \subsection{Query function}
 <<Features: procedures>>=
   subroutine check (feature, recognized, result, help)
     character(*), intent(in) :: feature
     logical, intent(out) :: recognized
     character(*), intent(out) :: result, help
     recognized = .true.
     result = "no"
     select case (lower_case (trim (feature)))
   <<Features: cases>>
     case default
        recognized = .false.
     end select
   end subroutine check
 
 @ %def check
 @ Print this result:
 <<Features: procedures>>=
   subroutine print_check (feature)
     character(*), intent(in) :: feature
     character(16) :: f
     logical :: recognized
     character(10) :: result
     character(48) :: help
     call check (feature, recognized, result, help)
     if (.not. recognized) then
        result = "unknown"
        help = ""
     end if
     f = feature
     print "(2x,A,1x,A,'(',A,')')", f, result, trim (help)
   end subroutine print_check
 
 @ %def print_check
 @
 \subsection{Basic configuration}
 <<Features: config>>=
   call print_check ("precision")
 <<Features: dependencies>>=
   use kinds, only: default
 <<Features: cases>>=
   case ("precision")
      write (result, "(I0)")  precision (1._default)
      help = "significant decimals of real/complex numbers"
 @
 \subsection{Optional features case by case}
 <<Features: print>>=
   call print_check ("OpenMP")
 <<Features: dependencies>>=
   use system_dependencies, only: openmp_is_active
 <<Features: cases>>=
   case ("openmp")
      if (openmp_is_active ()) then
         result = "yes"
      end if
      help = "OpenMP parallel execution"
 @
 <<Features: print>>=
   call print_check ("GoSam")
 <<Features: dependencies>>=
   use system_dependencies, only: GOSAM_AVAILABLE
 <<Features: cases>>=
   case ("gosam")
      if (GOSAM_AVAILABLE) then
         result = "yes"
      end if
      help = "external NLO matrix element provider"
 @
 <<Features: print>>=
   call print_check ("OpenLoops")
 <<Features: dependencies>>=
   use system_dependencies, only: OPENLOOPS_AVAILABLE
 <<Features: cases>>=
   case ("openloops")
      if (OPENLOOPS_AVAILABLE) then
         result = "yes"
      end if
      help = "external NLO matrix element provider"
 @
 <<Features: print>>=
   call print_check ("Recola")
 <<Features: dependencies>>=
   use system_dependencies, only: RECOLA_AVAILABLE
 <<Features: cases>>=
   case ("recola")
      if (RECOLA_AVAILABLE) then
         result = "yes"
      end if
      help = "external NLO matrix element provider"
 @
 <<Features: print>>=
   call print_check ("LHAPDF")
 <<Features: dependencies>>=
   use system_dependencies, only: LHAPDF5_AVAILABLE
   use system_dependencies, only: LHAPDF6_AVAILABLE
 <<Features: cases>>=
   case ("lhapdf")
      if (LHAPDF5_AVAILABLE) then
         result = "v5"
      else if (LHAPDF6_AVAILABLE) then
         result = "v6"
      end if
      help = "PDF library"
 @
 <<Features: print>>=
   call print_check ("HOPPET")
 <<Features: dependencies>>=
   use system_dependencies, only: HOPPET_AVAILABLE
 <<Features: cases>>=
   case ("hoppet")
      if (HOPPET_AVAILABLE) then
         result = "yes"
      end if
      help = "PDF evolution package"
 @
 <<Features: print>>=
   call print_check ("fastjet")
 <<Features: dependencies>>=
   use jets, only: fastjet_available
 <<Features: cases>>=
   case ("fastjet")
      if (fastjet_available ()) then
         result = "yes"
      end if
      help = "jet-clustering package"
 @
 <<Features: print>>=
   call print_check ("Pythia6")
 <<Features: dependencies>>=
   use system_dependencies, only: PYTHIA6_AVAILABLE
 <<Features: cases>>=
   case ("pythia6")
      if (PYTHIA6_AVAILABLE) then
         result = "yes"
      end if
      help = "direct access for shower/hadronization"
 @
 <<Features: print>>=
   call print_check ("Pythia8")
 <<Features: dependencies>>=
   use system_dependencies, only: PYTHIA8_AVAILABLE
 <<Features: cases>>=
   case ("pythia8")
      if (PYTHIA8_AVAILABLE) then
         result = "yes"
      end if
      help = "direct access for shower/hadronization"
 @
 <<Features: print>>=
   call print_check ("StdHEP")
 <<Features: cases>>=
   case ("stdhep")
      result = "yes"
      help = "event I/O format"
 @
 <<Features: print>>=
   call print_check ("HepMC")
 <<Features: dependencies>>=
   use hepmc_interface, only: hepmc_is_available
 <<Features: cases>>=
   case ("hepmc")
      if (hepmc_is_available ()) then
         result = "yes"
      end if
      help = "event I/O format"
 @
 <<Features: print>>=
   call print_check ("LCIO")
 <<Features: dependencies>>=
   use lcio_interface, only: lcio_is_available
 <<Features: cases>>=
   case ("lcio")
      if (lcio_is_available ()) then
         result = "yes"
      end if
      help = "event I/O format"
 @
 <<Features: print>>=
   call print_check ("MetaPost")
 <<Features: dependencies>>=
   use system_dependencies, only: EVENT_ANALYSIS
 <<Features: cases>>=
   case ("metapost")
      result = EVENT_ANALYSIS
      help = "graphical event analysis via LaTeX/MetaPost"
 @
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Driver program}
 The main program handles command options, initializes the environment,
 and runs WHIZARD in a particular mode (interactive, file, standard
 input).
 
 This is also used in the C interface:
 <<Main: cmdline arg len declaration>>=
   integer, parameter :: CMDLINE_ARG_LEN = 1000
 @ %def CMDLINE_ARG_LEN
 @
 The actual main program:
 <<[[main.f90]]>>=
 <<File header>>
 
 program main
 
 <<Use strings>>
   use system_dependencies
   use diagnostics
   use ifiles
   use os_interface
   use rt_data, only: show_description_of_string, show_tex_descriptions
   use whizard
 
   use cmdline_options
   use features
 
 <<Use mpi f08>>
 
   implicit none
 
 <<Main: cmdline arg len declaration>>
 
 !!! (WK 02/2016) Interface for the separate external routine below
   interface
      subroutine print_usage ()
      end subroutine print_usage
   end interface
 
 ! Main program variable declarations
   character(CMDLINE_ARG_LEN) :: arg
   character(2) :: option
   type(string_t) :: long_option, value
   integer :: i, j, arg_len, arg_status
   logical :: look_for_options
   logical :: interactive
   logical :: banner
   type(string_t) :: job_id, files, this, model, default_lib, library, libraries
   type(string_t) :: logfile, query_string
   logical :: user_code_enable = .false.
   integer :: n_user_src = 0, n_user_lib = 0
   type(string_t) :: user_src, user_lib, user_target
   type(paths_t) :: paths
   type(string_t) :: pack_arg, unpack_arg
   type(string_t), dimension(:), allocatable :: pack_args, unpack_args
   type(string_t), dimension(:), allocatable :: tmp_strings
   logical :: rebuild_library, rebuild_user
   logical :: rebuild_phs, rebuild_grids, rebuild_events
   logical :: recompile_library
   type(ifile_t) :: commands
   type(string_t) :: command, 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"
   user_src = ""
   user_lib = ""
   user_target = ""
   rebuild_library = .false.
   rebuild_user = .false.
   rebuild_phs = .false.
   rebuild_grids = .false.
   rebuild_events = .false.
   recompile_library = .false.
   call paths_init (paths)
 
 <<Main: MPI init>>
 
   ! Read and process options
   call init_options (print_usage)
   i = 0
   SCAN_CMDLINE: do
      i = i + 1
      call get_command_argument (i, arg, arg_len, arg_status)
      select case (arg_status)
      case (0)
      case (-1)
         call msg_error (" Command argument truncated: '" // arg // "'")
      case default
         exit SCAN_CMDLINE
      end select
      if (look_for_options) then
         select case (arg(1:2))
         case ("--")
            value = trim (arg)
            call split (value, long_option, "=")
            select case (char (long_option))
            case ("--version")
               call no_option_value (long_option, value)
               call print_version (); stop
            case ("--help")
               call no_option_value (long_option, value)
               call print_usage (); stop
            case ("--prefix")
               paths%prefix = get_option_value (i, long_option, value)
               cycle scan_cmdline
            case ("--exec-prefix")
               paths%exec_prefix = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--bindir")
               paths%bindir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--libdir")
               paths%libdir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--includedir")
               paths%includedir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--datarootdir")
               paths%datarootdir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--libtool")
               paths%libtool = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--lhapdfdir")
               paths%lhapdfdir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--check")
               call print_usage ()
               call msg_fatal ("Option --check not supported &
                    &(for unit tests, run whizard_ut instead)")
            case ("--show-config")
               call no_option_value (long_option, value)
               call print_features (); stop
            case ("--execute")
               command = get_option_value (i, long_option, value)
               call ifile_append (commands, command)
               cycle SCAN_CMDLINE
            case ("--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_user = .true.
               rebuild_phs = .true.
               rebuild_grids = .true.
               rebuild_events = .true.
               cycle SCAN_CMDLINE
            case ("--no-rebuild")
               call no_option_value (long_option, value)
               rebuild_library = .false.
               recompile_library = .false.
               rebuild_user = .false.
               rebuild_phs = .false.
               rebuild_grids = .false.
               rebuild_events = .false.
               cycle SCAN_CMDLINE
            case ("--rebuild-library")
               call no_option_value (long_option, value)
               rebuild_library = .true.
               cycle SCAN_CMDLINE
            case ("--rebuild-user")
               call no_option_value (long_option, value)
               rebuild_user = .true.
               cycle SCAN_CMDLINE
            case ("--rebuild-phase-space")
               call no_option_value (long_option, value)
               rebuild_phs = .true.
               cycle SCAN_CMDLINE
            case ("--rebuild-grids")
               call no_option_value (long_option, value)
               rebuild_grids = .true.
               cycle SCAN_CMDLINE
            case ("--rebuild-events")
               call no_option_value (long_option, value)
               rebuild_events = .true.
               cycle SCAN_CMDLINE
            case ("--recompile")
               call no_option_value (long_option, value)
               recompile_library = .true.
               rebuild_grids = .true.
               cycle SCAN_CMDLINE
            case ("--user")
               user_code_enable = .true.
               cycle SCAN_CMDLINE
            case ("--user-src")
               if (user_src == "") then
                  user_src = get_option_value (i, long_option, value)
               else
                  user_src = user_src // " " &
                       // get_option_value (i, long_option, value)
               end if
               n_user_src = n_user_src + 1
               cycle SCAN_CMDLINE
            case ("--user-lib")
               if (user_lib == "") then
                  user_lib = get_option_value (i, long_option, value)
               else
                  user_lib = user_lib // " " &
                       // get_option_value (i, long_option, value)
               end if
               n_user_lib = n_user_lib + 1
               cycle SCAN_CMDLINE
            case ("--user-target")
               user_target = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--write-syntax-tables")
               call no_option_value (long_option, value)
         call init_syntax_tables ()
               call write_syntax_tables ()
               call final_syntax_tables ()
               stop
               cycle SCAN_CMDLINE
            case default
               call print_usage ()
               call msg_fatal ("Option '" // trim (arg) // "' not recognized")
            end select
         end select
         select case (arg(1:1))
         case ("-")
            j = 1
            if (len_trim (arg) == 1) then
               look_for_options = .false.
            else
               SCAN_SHORT_OPTIONS: do
                  j = j + 1
                  if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS
                  option = "-" // arg(j:j)
                  select case (option)
                  case ("-V")
                     call print_version (); stop
                  case ("-?", "-h")
                     call print_usage (); stop
                  case ("-e")
                     command = get_option_value (i, var_str (option))
                     call ifile_append (commands, command)
                     cycle SCAN_CMDLINE
                  case ("-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_user = .true.
                     rebuild_phs = .true.
                     rebuild_grids = .true.
                     rebuild_events = .true.
                     cycle SCAN_SHORT_OPTIONS
                  case ("-u")
                     user_code_enable = .true.
                     cycle SCAN_SHORT_OPTIONS
                  case default
                     call print_usage ()
                     call msg_fatal &
                          ("Option '" // option // "' not recognized")
                  end select
               end do SCAN_SHORT_OPTIONS
            end if
         case default
            files = files // " " // trim (arg)
         end select
      else
         files = files // " " // trim (arg)
      end if
   end do SCAN_CMDLINE
 
   ! Overall initialization
   if (logfile /= "")  call logfile_init (logfile)
   if (banner)  call msg_banner ()
 
    allocate (options)
    allocate (whizard_instance)
 
    if (.not. quit) then
 
       ! Set options and initialize the whizard object
       options%job_id = job_id
       if (allocated (pack_args)) then
          options%pack_args = pack_args
       else
          allocate (options%pack_args (0))
       end if
       if (allocated (unpack_args)) then
          options%unpack_args = unpack_args
       else
          allocate (options%unpack_args (0))
       end if
       options%preload_model = model
       options%default_lib = default_lib
       options%preload_libraries = libraries
       options%rebuild_library = rebuild_library
       options%recompile_library = recompile_library
       options%rebuild_user = rebuild_user
       options%rebuild_phs = rebuild_phs
       options%rebuild_grids = rebuild_grids
       options%rebuild_events = rebuild_events
     <<Main: dependent flags>>
 
       call whizard_instance%init (options, paths, logfile)
 
       call mask_term_signals ()
 
    end if
 
    ! Run commands given on the command line
    if (.not. quit .and. ifile_get_length (commands) > 0) then
       call whizard_instance%process_ifile (commands, quit, quit_code)
    end if
 
    if (.not. quit) then
       ! Process commands from standard input
       if (.not. interactive .and. files == "") then
          call whizard_instance%process_stdin (quit, quit_code)
 
          ! ... or process commands from file
       else
          files = trim (adjustl (files))
          SCAN_FILES: do while (files /= "")
             call split (files, this, " ")
             call whizard_instance%process_file (this, quit, quit_code)
             if (quit)  exit SCAN_FILES
          end do SCAN_FILES
 
       end if
   end if
 
   ! Enter an interactive shell if requested
   if (.not. quit .and. interactive) then
      call whizard_instance%shell (quit_code)
   end if
 
   ! Overall finalization
   call ifile_final (commands)
 
   deallocate (options)
 
   call whizard_instance%final ()
   deallocate (whizard_instance)
 
 <<Main: MPI finalize>>
 
   call terminate_now_if_signal ()
   call release_term_signals ()
   call msg_terminate (quit_code = quit_code)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 contains
 
   subroutine print_version ()
     print "(A)", "WHIZARD " // WHIZARD_VERSION
     print "(A)", "Copyright (C) 1999-2019 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-user    rebuild user-provided code"
     print "(A)", "    --rebuild-phase-space"
     print "(A)", "                      rebuild phase-space configuration"
     print "(A)", "    --rebuild-grids   rebuild integration grids"
     print "(A)", "    --rebuild-events  rebuild event samples"
     print "(A)", "    --recompile       recompile process code"
     print "(A)", "    --show-config     show build-time configuration"
     print "(A)", "    --unpack FILE     untar/gunzip FILE before job"
     print "(A)", "-u  --user            enable user-provided code"
     print "(A)", "    --user-src FILE   user-provided source file"
     print "(A)", "    --user-lib FILE   user-provided library file"
     print "(A)", "    --user-target BN  basename of created user library (default: user)"
     print "(A)", "-V, --version         output version information and exit"
     print "(A)", "    --write-syntax-tables"
     print "(A)", "                      write the internal syntax tables to files and exit"
     print "(A)", "-                     further options are taken as filenames"
     print *
     print "(A)", "With no FILE, read standard input."
   end subroutine print_usage
 
 @ %def main
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Driver program for the unit tests}
 This is a variant of the above main program that takes unit-test names
 as command-line options and runs those tests.
 <<[[main_ut.f90]]>>=
 <<File header>>
 
 program main_ut
 
 <<Use strings>>
   use unit_tests
   use io_units
   use system_dependencies
   use diagnostics
   use os_interface
 
   use cmdline_options
 
   use model_testbed !NODEP!
 <<Use mpi f08>>
 
 <<Main: use tests>>
 
   implicit none
 
 <<Main: cmdline arg len declaration>>
 
 !!! (WK 02/2016) Interface for the separate external routine below
   interface
      subroutine print_usage ()
      end subroutine print_usage
   end interface
 
   ! Main program variable declarations
   character(CMDLINE_ARG_LEN) :: arg
   character(2) :: option
   type(string_t) :: long_option, value
   integer :: i, j, arg_len, arg_status
   logical :: look_for_options
   logical :: banner
   type(string_t) :: check, checks
   type(test_results_t) :: test_results
   logical :: success
 
   ! Exit status
   integer :: quit_code = 0
 
   ! Initial values
   look_for_options = .true.
   banner = .true.
   logging = .false.
   msg_level = RESULT
   check = ""
   checks = ""
 
 <<Main: MPI init>>
 
   ! Read and process options
   call init_options (print_usage)
   i = 0
   SCAN_CMDLINE: do
      i = i + 1
      call get_command_argument (i, arg, arg_len, arg_status)
      select case (arg_status)
      case (0)
      case (-1)
         call msg_error (" Command argument truncated: '" // arg // "'")
      case default
         exit SCAN_CMDLINE
      end select
      if (look_for_options) then
         select case (arg(1:2))
         case ("--")
            value = trim (arg)
            call split (value, long_option, "=")
            select case (char (long_option))
            case ("--version")
               call no_option_value (long_option, value)
               call print_version (); stop
            case ("--help")
               call no_option_value (long_option, value)
               call print_usage (); stop
            case ("--banner")
               call no_option_value (long_option, value)
               banner = .true.
               cycle SCAN_CMDLINE
            case ("--no-banner")
               call no_option_value (long_option, value)
               banner = .false.
               cycle SCAN_CMDLINE
            case ("--check")
               check = get_option_value (i, long_option, value)
               checks = checks // " " // check
               cycle SCAN_CMDLINE
            case ("--debug")
               call no_option_value (long_option, value)
               call set_debug_levels (get_option_value (i, long_option, value))
               cycle SCAN_CMDLINE
            case ("--debug2")
               call no_option_value (long_option, value)
               call set_debug2_levels (get_option_value (i, long_option, value))
               cycle SCAN_CMDLINE
            case default
               call print_usage ()
               call msg_fatal ("Option '" // trim (arg) // "' not recognized")
            end select
         end select
         select case (arg(1:1))
         case ("-")
            j = 1
            if (len_trim (arg) == 1) then
               look_for_options = .false.
            else
               SCAN_SHORT_OPTIONS: do
                  j = j + 1
                  if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS
                  option = "-" // arg(j:j)
                  select case (option)
                  case ("-V")
                     call print_version (); stop
                  case ("-?", "-h")
                     call print_usage (); stop
                  case default
                     call print_usage ()
                     call msg_fatal &
                          ("Option '" // option // "' not recognized")
                  end select
               end do SCAN_SHORT_OPTIONS
            end if
         case default
            call print_usage ()
            call msg_fatal ("Option '" // trim (arg) // "' not recognized")
         end select
      else
         call print_usage ()
         call msg_fatal ("Option '" // trim (arg) // "' not recognized")
      end if
   end do SCAN_CMDLINE
 
   ! Overall initialization
   if (banner)  call msg_banner ()
 
    ! Run any self-checks (and no commands)
    if (checks /= "") then
       checks = trim (adjustl (checks))
       RUN_CHECKS: do while (checks /= "")
          call split (checks, check, " ")
          call whizard_check (check, test_results)
       end do RUN_CHECKS
       call test_results%wrapup (6, success)
       if (.not. success)  quit_code = 7
    end if
 
  <<Main: MPI finalize>>
 
    call msg_terminate (quit_code = quit_code)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 contains
 
   subroutine print_version ()
     print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)"
     print "(A)", "Copyright (C) 1999-2019 Wolfgang Kilian, Thorsten Ohl, Juergen Reuter"
     print "(A)", "              ---------------------------------------                "
     print "(A)", "This is free software; see the source for copying conditions.  There is NO"
     print "(A)", "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
     print *
   end subroutine print_version
 
 <<Main: tests>>
 
 end program main_ut
 
 !!! (WK 02/2016)
 !!! Separate subroutine, because this becomes a procedure pointer target
 !!! Internal procedures as targets are not supported by some compilers.
 
   subroutine print_usage ()
     use system_dependencies, only: WHIZARD_VERSION
     print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)"
     print "(A)", "Usage: whizard_ut [OPTIONS] [FILE]"
     print "(A)", "Run WHIZARD unit tests as given on the command line"
     print "(A)", "Options:"
     print "(A)", "-h, --help            display this help and exit"
     print "(A)", "    --banner          display banner at startup (default)"
     print "(A)", "    --no-banner       do not display banner at startup"
     print "(A)", "    --debug AREA      switch on debug output for AREA."
     print "(A)", "                      AREA can be one of Whizard's src dirs or 'all'"
     print "(A)", "    --debug2 AREA     switch on more verbose debug output for AREA."
     print "(A)", "-V, --version         output version information and exit"
     print "(A)", "    --check TEST      run unit test TEST"
   end subroutine print_usage
 @ %def main_ut
 @
 <<Main: MPI init>>=
 @
 <<Main: MPI finalize>>=
 @
 @ MPI init.
 <<MPI: Main: MPI init>>=
   call MPI_init ()
 <<MPI: Main: MPI finalize>>=
   call MPI_finalize ()
 @ %def MPI_init MPI_finalize
 <<Main: dependent flags>>=
 @
 Every rebuild action is forbidden for the slave workers except
 [[rebuild_grids]], which is handled correctly inside the corresponding
 integration object.
 <<MPI: Main: dependent flags>>=
   if (.not. mpi_is_comm_master ()) then
     options%rebuild_library = .false.
     options%recompile_library = .false.
     options%rebuild_user = .false.
     options%rebuild_phs = .false.
     options%rebuild_events = .false.
   end if
 @
 \subsection{Self-tests}
 For those self-tests, we need some auxiliary routines that provide an
 enviroment.  The environment depends on things that are not available at the
 level of the module that we want to test.
 
 \subsubsection{Testbed for event I/O}
 This subroutine prepares a test process with a single event.  All objects are
 allocated via anonymous pointers, because we want to recover the pointers and
 delete the objects in a separate procedure.
 <<Main: tests>>=
   subroutine prepare_eio_test (event, unweighted, n_alt)
     use variables, only: var_list_t
     use model_data
     use process, only: process_t
     use instances, only: process_instance_t
     use processes_ut, only: prepare_test_process
     use event_base
     use events
 
     class(generic_event_t), intent(inout), pointer :: event
     logical, intent(in), optional :: unweighted
     integer, intent(in), optional :: n_alt
     type(model_data_t), pointer :: model
     type(var_list_t) :: var_list
     type(process_t), pointer :: proc
     type(process_instance_t), pointer :: process_instance
 
     allocate (model)
     call model%init_test ()
 
     allocate (proc)
     allocate (process_instance)
 
     call prepare_test_process (proc, process_instance, model, &
          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
        call var_list%append_string (&
             var_str ("$sample_normalization"), &
             var_str ("auto"), intrinsic = .true.)
        call event%basic_init (var_list, n_alt)
        call event%connect (process_instance, proc%get_model_ptr ())
        call var_list%final ()
     end select
 
   end subroutine prepare_eio_test
 
 @ %def prepare_eio_test_event
 @ Recover those pointers, finalize the objects and deallocate.
 <<Main: tests>>=
   subroutine cleanup_eio_test (event)
     use model_data
     use process, only: process_t
     use instances, only: process_instance_t
     use processes_ut, only: cleanup_test_process
     use event_base
     use events
 
     class(generic_event_t), intent(inout), pointer :: event
     type(process_t), pointer :: proc
     type(process_instance_t), pointer :: process_instance
 
     select type (event)
     type is (event_t)
        proc => event%get_process_ptr ()
        process_instance => event%get_process_instance_ptr ()
        call cleanup_test_process (proc, process_instance)
        deallocate (process_instance)
        deallocate (proc)
        call event%final ()
     end select
     deallocate (event)
 
   end subroutine cleanup_eio_test
 
 @ %def cleanup_eio_test_event
 @ Assign those procedures to appropriate pointers (module variables) in the
 [[eio_base]] module, so they can be called as if they were module procedures.
 <<Main: use tests>>=
   use eio_base_ut, only: eio_prepare_test
   use eio_base_ut, only: eio_cleanup_test
 <<Main: prepare testbed>>=
   eio_prepare_test => prepare_eio_test
   eio_cleanup_test => cleanup_eio_test
 @
 \subsubsection{Any Model}
 This procedure reads any model from file and, optionally, assigns a
 var-list pointer.  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{MD5}
 <<Main: use tests>>=
   use md5_ut, only: md5_test
 <<Main: test cases>>=
   case ("md5")
      call md5_test (u, results)
 <<Main: all tests>>=
   call md5_test (u, results)
 @
 \subsubsection{OS Interface}
 <<Main: use tests>>=
   use os_interface_ut, only: os_interface_test
 <<Main: test cases>>=
   case ("os_interface")
      call os_interface_test (u, results)
 <<Main: all tests>>=
   call os_interface_test (u, results)
 @
 \subsubsection{Sorting}
 <<Main: use tests>>=
   use sorting_ut, only: sorting_test
 <<Main: test cases>>=
   case ("sorting")
      call sorting_test (u, results)
 <<Main: all tests>>=
   call sorting_test (u, results)
 @
 \subsubsection{Grids}
 <<Main: use tests>>=
   use grids_ut, only: grids_test
 <<Main: test cases>>=
   case ("grids")
      call grids_test (u, results)
 <<Main: all tests>>=
   call grids_test (u, results)
 @
 \subsubsection{Solver}
 <<Main: use tests>>=
   use solver_ut, only: solver_test
 <<Main: test cases>>=
   case ("solver")
      call solver_test (u, results)
 <<Main: all tests>>=
   call solver_test (u, results)
 @
 \subsubsection{CPU Time}
 <<Main: use tests>>=
   use cputime_ut, only: cputime_test
 <<Main: test cases>>=
   case ("cputime")
      call cputime_test (u, results)
 <<Main: all tests>>=
   call cputime_test (u, results)
 @
 \subsubsection{SM QCD}
 <<Main: use tests>>=
   use sm_qcd_ut, only: sm_qcd_test
 <<Main: test cases>>=
   case ("sm_qcd")
      call sm_qcd_test (u, results)
 <<Main: all tests>>=
   call sm_qcd_test (u, results)
 @
 \subsubsection{SM physics}
 <<Main: use tests>>=
   use sm_physics_ut, only: sm_physics_test
 <<Main: test cases>>=
   case ("sm_physics")
      call sm_physics_test (u, results)
 <<Main: all tests>>=
   call sm_physics_test (u, results)
 @
 \subsubsection{Lexers}
 <<Main: use tests>>=
   use lexers_ut, only: lexer_test
 <<Main: test cases>>=
   case ("lexers")
      call lexer_test (u, results)
 <<Main: all tests>>=
   call lexer_test (u, results)
 @
 \subsubsection{Parser}
 <<Main: use tests>>=
   use parser_ut, only: parse_test
 <<Main: test cases>>=
   case ("parser")
      call parse_test (u, results)
 <<Main: all tests>>=
   call parse_test (u, results)
 @
 \subsubsection{XML}
 <<Main: use tests>>=
   use xml_ut, only: xml_test
 <<Main: test cases>>=
   case ("xml")
      call xml_test (u, results)
 <<Main: all tests>>=
   call xml_test (u, results)
 @
 \subsubsection{Colors}
 <<Main: use tests>>=
   use colors_ut, only: color_test
 <<Main: test cases>>=
   case ("colors")
      call color_test (u, results)
 <<Main: all tests>>=
   call color_test (u, results)
 @
 \subsubsection{State matrices}
 <<Main: use tests>>=
   use state_matrices_ut, only: state_matrix_test
 <<Main: test cases>>=
   case ("state_matrices")
      call state_matrix_test (u, results)
 <<Main: all tests>>=
   call state_matrix_test (u, results)
 @
 \subsubsection{Analysis}
 <<Main: use tests>>=
   use analysis_ut, only: analysis_test
 <<Main: test cases>>=
   case ("analysis")
      call analysis_test (u, results)
 <<Main: all tests>>=
   call analysis_test (u, results)
 @
 \subsubsection{Particles}
 <<Main: use tests>>=
   use particles_ut, only: particles_test
 <<Main: test cases>>=
   case ("particles")
      call particles_test (u, results)
 <<Main: all tests>>=
   call particles_test (u, results)
 @
 \subsubsection{Models}
 <<Main: use tests>>=
   use models_ut, only: models_test
 <<Main: test cases>>=
   case ("models")
      call models_test (u, results)
 <<Main: all tests>>=
   call models_test (u, results)
 @
 \subsubsection{Auto Components}
 <<Main: use tests>>=
   use auto_components_ut, only: auto_components_test
 <<Main: test cases>>=
   case ("auto_components")
      call auto_components_test (u, results)
 <<Main: all tests>>=
   call auto_components_test (u, results)
 @
 \subsubsection{Radiation Generator}
 <<Main: use tests>>=
   use radiation_generator_ut, only: radiation_generator_test
 <<Main: test cases>>=
   case ("radiation_generator")
      call radiation_generator_test (u, results)
 <<Main: all tests>>=
   call radiation_generator_test (u, results)
 @
 \subsection{BLHA}
 <<Main: use tests>>=
   use blha_ut, only: blha_test
 <<Main: test cases>>=
   case ("blha")
      call blha_test (u, results)
 <<Main: all tests>>=
   call blha_test (u, results)
 @
 \subsubsection{Evaluators}
 <<Main: use tests>>=
   use evaluators_ut, only: evaluator_test
 <<Main: test cases>>=
   case ("evaluators")
      call evaluator_test (u, results)
 <<Main: all tests>>=
   call evaluator_test (u, results)
 @
 \subsubsection{Expressions}
 <<Main: use tests>>=
   use eval_trees_ut, only: expressions_test
 <<Main: test cases>>=
   case ("expressions")
      call expressions_test (u, results)
 <<Main: all tests>>=
   call expressions_test (u, results)
 @
 \subsubsection{Resonances}
 <<Main: use tests>>=
   use resonances_ut, only: resonances_test
 <<Main: test cases>>=
   case ("resonances")
      call resonances_test (u, results)
 <<Main: all tests>>=
   call resonances_test (u, results)
 @
 \subsubsection{PHS Trees}
 <<Main: use tests>>=
   use phs_trees_ut, only: phs_trees_test
 <<Main: test cases>>=
   case ("phs_trees")
      call phs_trees_test (u, results)
 <<Main: all tests>>=
   call phs_trees_test (u, results)
 @
 \subsubsection{PHS Forests}
 <<Main: use tests>>=
   use phs_forests_ut, only: phs_forests_test
 <<Main: test cases>>=
   case ("phs_forests")
      call phs_forests_test (u, results)
 <<Main: all tests>>=
   call phs_forests_test (u, results)
 @
 \subsubsection{Beams}
 <<Main: use tests>>=
   use beams_ut, only: beams_test
 <<Main: test cases>>=
   case ("beams")
      call beams_test (u, results)
 <<Main: all tests>>=
   call beams_test (u, results)
 @
 \subsubsection{$su(N)$ Algebra}
 <<Main: use tests>>=
   use su_algebra_ut, only: su_algebra_test
 <<Main: test cases>>=
   case ("su_algebra")
      call su_algebra_test (u, results)
 <<Main: all tests>>=
   call su_algebra_test (u, results)
 @
 \subsubsection{Bloch Vectors}
 <<Main: use tests>>=
   use bloch_vectors_ut, only: bloch_vectors_test
 <<Main: test cases>>=
   case ("bloch_vectors")
      call bloch_vectors_test (u, results)
 <<Main: all tests>>=
   call bloch_vectors_test (u, results)
 @
 \subsubsection{Polarizations}
 <<Main: use tests>>=
   use polarizations_ut, only: polarizations_test
 <<Main: test cases>>=
   case ("polarizations")
      call polarizations_test (u, results)
 <<Main: all tests>>=
   call polarizations_test (u, results)
 @
 \subsubsection{SF Aux}
 <<Main: use tests>>=
   use sf_aux_ut, only: sf_aux_test
 <<Main: test cases>>=
   case ("sf_aux")
      call sf_aux_test (u, results)
 <<Main: all tests>>=
   call sf_aux_test (u, results)
 @
 \subsubsection{SF Mappings}
 <<Main: use tests>>=
   use sf_mappings_ut, only: sf_mappings_test
 <<Main: test cases>>=
   case ("sf_mappings")
      call sf_mappings_test (u, results)
 <<Main: all tests>>=
   call sf_mappings_test (u, results)
 @
 \subsubsection{SF Base}
 <<Main: use tests>>=
   use sf_base_ut, only: sf_base_test
 <<Main: test cases>>=
   case ("sf_base")
      call sf_base_test (u, results)
 <<Main: all tests>>=
   call sf_base_test (u, results)
 @
 \subsubsection{SF PDF Builtin}
 <<Main: use tests>>=
   use sf_pdf_builtin_ut, only: sf_pdf_builtin_test
 <<Main: test cases>>=
   case ("sf_pdf_builtin")
      call sf_pdf_builtin_test (u, results)
 <<Main: all tests>>=
   call sf_pdf_builtin_test (u, results)
 @
 \subsubsection{SF LHAPDF}
 <<Main: use tests>>=
   use sf_lhapdf_ut, only: sf_lhapdf_test
 <<Main: test cases>>=
   case ("sf_lhapdf")
      call sf_lhapdf_test (u, results)
 <<Main: all tests>>=
   call sf_lhapdf_test (u, results)
 @
 \subsubsection{SF ISR}
 <<Main: use tests>>=
   use sf_isr_ut, only: sf_isr_test
 <<Main: test cases>>=
   case ("sf_isr")
      call sf_isr_test (u, results)
 <<Main: all tests>>=
   call sf_isr_test (u, results)
 @
 \subsubsection{SF EPA}
 <<Main: use tests>>=
   use sf_epa_ut, only: sf_epa_test
 <<Main: test cases>>=
   case ("sf_epa")
      call sf_epa_test (u, results)
 <<Main: all tests>>=
   call sf_epa_test (u, results)
 @
 \subsubsection{SF EWA}
 <<Main: use tests>>=
   use sf_ewa_ut, only: sf_ewa_test
 <<Main: test cases>>=
   case ("sf_ewa")
      call sf_ewa_test (u, results)
 <<Main: all tests>>=
   call sf_ewa_test (u, results)
 @
 \subsubsection{SF CIRCE1}
 <<Main: use tests>>=
   use sf_circe1_ut, only: sf_circe1_test
 <<Main: test cases>>=
   case ("sf_circe1")
      call sf_circe1_test (u, results)
 <<Main: all tests>>=
   call sf_circe1_test (u, results)
 @
 \subsubsection{SF CIRCE2}
 <<Main: use tests>>=
   use sf_circe2_ut, only: sf_circe2_test
 <<Main: test cases>>=
   case ("sf_circe2")
      call sf_circe2_test (u, results)
 <<Main: all tests>>=
   call sf_circe2_test (u, results)
 @
 \subsubsection{SF Gaussian}
 <<Main: use tests>>=
   use sf_gaussian_ut, only: sf_gaussian_test
 <<Main: test cases>>=
   case ("sf_gaussian")
      call sf_gaussian_test (u, results)
 <<Main: all tests>>=
   call sf_gaussian_test (u, results)
 @
 \subsubsection{SF Beam Events}
 <<Main: use tests>>=
   use sf_beam_events_ut, only: sf_beam_events_test
 <<Main: test cases>>=
   case ("sf_beam_events")
      call sf_beam_events_test (u, results)
 <<Main: all tests>>=
   call sf_beam_events_test (u, results)
 @
 \subsubsection{SF EScan}
 <<Main: use tests>>=
   use sf_escan_ut, only: sf_escan_test
 <<Main: test cases>>=
   case ("sf_escan")
      call sf_escan_test (u, results)
 <<Main: all tests>>=
   call sf_escan_test (u, results)
 @
 \subsubsection{PHS Base}
 <<Main: use tests>>=
   use phs_base_ut, only: phs_base_test
 <<Main: test cases>>=
   case ("phs_base")
      call phs_base_test (u, results)
 <<Main: all tests>>=
   call phs_base_test (u, results)
 @
 \subsubsection{PHS None}
 <<Main: use tests>>=
   use phs_none_ut, only: phs_none_test
 <<Main: test cases>>=
   case ("phs_none")
      call phs_none_test (u, results)
 <<Main: all tests>>=
   call phs_none_test (u, results)
 @
 \subsubsection{PHS Single}
 <<Main: use tests>>=
   use phs_single_ut, only: phs_single_test
 <<Main: test cases>>=
   case ("phs_single")
      call phs_single_test (u, results)
 <<Main: all tests>>=
   call phs_single_test (u, results)
 @
 \subsubsection{PHS Rambo}
 <<Main: use tests>>=
   use phs_rambo_ut, only: phs_rambo_test
 <<Main: test cases>>=
   case ("phs_rambo")
      call phs_rambo_test (u, results)
 <<Main: all tests>>=
   call phs_rambo_test (u, results)
 @
 \subsubsection{PHS Wood}
 <<Main: use tests>>=
   use phs_wood_ut, only: phs_wood_test
   use phs_wood_ut, only: phs_wood_vis_test
 <<Main: test cases>>=
   case ("phs_wood")
      call phs_wood_test (u, results)
   case ("phs_wood_vis")
      call phs_wood_vis_test (u, results)
 <<Main: all tests>>=
   call phs_wood_test (u, results)
   call phs_wood_vis_test (u, results)
 @
 \subsubsection{PHS FKS Generator}
 <<Main: use tests>>=
   use phs_fks_ut, only: phs_fks_generator_test
 <<Main: test cases>>=
   case ("phs_fks_generator")
      call phs_fks_generator_test (u, results)
 <<Main: all tests>>=
   call phs_fks_generator_test (u, results)
 @
 \subsubsection{FKS regions}
 <<Main: use tests>>=
   use fks_regions_ut, only: fks_regions_test
 <<Main: test cases>>=
   case ("fks_regions")
      call fks_regions_test (u, results)
 <<Main: all tests>>=
   call fks_regions_test (u, results)
 @
 \subsubsection{Real subtraction}
 <<Main: use tests>>=
   use real_subtraction_ut, only: real_subtraction_test
 <<Main: test cases>>=
   case ("real_subtraction")
      call real_subtraction_test (u, results)
 <<Main: all tests>>=
   call real_subtraction_test (u, results)
 @
 \subsubsection{RECOLA}
 <<Main: use tests>>=
   use prc_recola_ut, only: prc_recola_test
 <<Main: test cases>>=
   case ("prc_recola")
      call prc_recola_test (u, results)
 <<Main: all tests>>=
   call prc_recola_test (u, results)
 @
 \subsubsection{RNG Base}
 <<Main: use tests>>=
   use rng_base_ut, only: rng_base_test
 <<Main: test cases>>=
   case ("rng_base")
      call rng_base_test (u, results)
 <<Main: all tests>>=
   call rng_base_test (u, results)
 @
 \subsubsection{RNG Tao}
 <<Main: use tests>>=
   use rng_tao_ut, only: rng_tao_test
 <<Main: test cases>>=
   case ("rng_tao")
      call rng_tao_test (u, results)
 <<Main: all tests>>=
   call rng_tao_test (u, results)
 @
 \subsubsection{RNG Stream}
 <<Main: use tests>>=
   use rng_stream_ut, only: rng_stream_test
 <<Main: test cases>>=
   case ("rng_stream")
      call rng_stream_test (u, results)
 <<Main: all tests>>=
   call rng_stream_test (u, results)
 @
 \subsubsection{Selectors}
 <<Main: use tests>>=
   use selectors_ut, only: selectors_test
 <<Main: test cases>>=
   case ("selectors")
      call selectors_test (u, results)
 <<Main: all tests>>=
   call selectors_test (u, results)
 @
 \subsubsection{VEGAS}
 <<Main: use tests>>=
   use vegas_ut, only: vegas_test
 <<Main: test cases>>=
   case ("vegas")
      call vegas_test (u, results)
 <<Main: all tests>>=
   call vegas_test (u, results)
 @
 \subsubsection{VAMP2}
 <<Main: use tests>>=
   use vamp2_ut, only: vamp2_test
 <<Main: test cases>>=
   case ("vamp2")
      call vamp2_test (u, results)
 <<Main: all tests>>=
   call vamp2_test (u, results)
 @
 \subsubsection{MCI Base}
 <<Main: use tests>>=
   use mci_base_ut, only: mci_base_test
 <<Main: test cases>>=
   case ("mci_base")
      call mci_base_test (u, results)
 <<Main: all tests>>=
   call mci_base_test (u, results)
 @
 \subsubsection{MCI None}
 <<Main: use tests>>=
   use mci_none_ut, only: mci_none_test
 <<Main: test cases>>=
   case ("mci_none")
      call mci_none_test (u, results)
 <<Main: all tests>>=
   call mci_none_test (u, results)
 @
 \subsubsection{MCI Midpoint}
 <<Main: use tests>>=
   use mci_midpoint_ut, only: mci_midpoint_test
 <<Main: test cases>>=
   case ("mci_midpoint")
      call mci_midpoint_test (u, results)
 <<Main: all tests>>=
   call mci_midpoint_test (u, results)
 @
 \subsubsection{MCI VAMP}
 <<Main: use tests>>=
   use mci_vamp_ut, only: mci_vamp_test
 <<Main: test cases>>=
   case ("mci_vamp")
      call mci_vamp_test (u, results)
 <<Main: all tests>>=
   call mci_vamp_test (u, results)
 @
 \subsubsection{MCI VAMP2}
 <<Main: use tests>>=
   use mci_vamp2_ut, only: mci_vamp2_test
 <<Main: test cases>>=
   case ("mci_vamp2")
      call mci_vamp2_test (u, results)
 <<Main: all tests>>=
   call mci_vamp2_test (u, results)
 @
 \subsubsection{Integration Results}
 <<Main: use tests>>=
   use integration_results_ut, only: integration_results_test
 <<Main: test cases>>=
   case ("integration_results")
      call integration_results_test (u, results)
 <<Main: all tests>>=
   call integration_results_test (u, results)
 @
 \subsubsection{PRCLib Interfaces}
 <<Main: use tests>>=
   use prclib_interfaces_ut, only: prclib_interfaces_test
 <<Main: test cases>>=
   case ("prclib_interfaces")
      call prclib_interfaces_test (u, results)
 <<Main: all tests>>=
   call prclib_interfaces_test (u, results)
 @
 \subsubsection{Particle Specifiers}
 <<Main: use tests>>=
   use particle_specifiers_ut, only: particle_specifiers_test
 <<Main: test cases>>=
   case ("particle_specifiers")
      call particle_specifiers_test (u, results)
 <<Main: all tests>>=
   call particle_specifiers_test (u, results)
 @
 \subsubsection{Process Libraries}
 <<Main: use tests>>=
   use process_libraries_ut, only: process_libraries_test
 <<Main: test cases>>=
   case ("process_libraries")
      call process_libraries_test (u, results)
 <<Main: all tests>>=
   call process_libraries_test (u, results)
 @
 \subsubsection{PRCLib Stacks}
 <<Main: use tests>>=
   use prclib_stacks_ut, only: prclib_stacks_test
 <<Main: test cases>>=
   case ("prclib_stacks")
      call prclib_stacks_test (u, results)
 <<Main: all tests>>=
   call prclib_stacks_test (u, results)
 @
 \subsubsection{HepMC}
 <<Main: use tests>>=
   use hepmc_interface_ut, only: hepmc_interface_test
 <<Main: test cases>>=
   case ("hepmc")
      call hepmc_interface_test (u, results)
 <<Main: all tests>>=
   call hepmc_interface_test (u, results)
 @
 \subsubsection{LCIO}
 <<Main: use tests>>=
   use lcio_interface_ut, only: lcio_interface_test
 <<Main: test cases>>=
   case ("lcio")
      call lcio_interface_test (u, results)
 <<Main: all tests>>=
   call lcio_interface_test (u, results)
 @
 \subsubsection{Jets}
 <<Main: use tests>>=
   use jets_ut, only: jets_test
 <<Main: test cases>>=
   case ("jets")
      call jets_test (u, results)
 <<Main: all tests>>=
   call jets_test (u, results)
 @
 \subsection{LHA User Process WHIZARD}
 <<Main: use tests>>=
   use whizard_lha_ut, only: whizard_lha_test
 <<Main: test cases>>=
   case ("whizard_lha")
      call whizard_lha_test (u, results)
 <<Main: all tests>>=
   call whizard_lha_test (u, results)
 @
 \subsection{Pythia8}
 <<Main: use tests>>=
   use pythia8_ut, only: pythia8_test
 <<Main: test cases>>=
   case ("pythia8")
      call pythia8_test (u, results)
 <<Main: all tests>>=
   call pythia8_test (u, results)
 @
 \subsubsection{PDG Arrays}
 <<Main: use tests>>=
   use pdg_arrays_ut, only: pdg_arrays_test
 <<Main: test cases>>=
   case ("pdg_arrays")
      call pdg_arrays_test (u, results)
 <<Main: all tests>>=
   call pdg_arrays_test (u, results)
 @
 \subsubsection{interactions}
 <<Main: use tests>>=
   use interactions_ut, only: interaction_test
 <<Main: test cases>>=
   case ("interactions")
      call interaction_test (u, results)
 <<Main: all tests>>=
   call interaction_test (u, results)
 @
 \subsubsection{SLHA}
 <<Main: use tests>>=
   use slha_interface_ut, only: slha_test
 <<Main: test cases>>=
   case ("slha_interface")
      call slha_test (u, results)
 <<Main: all tests>>=
   call slha_test (u, results)
 @
 \subsubsection{Cascades}
 <<Main: use tests>>=
   use cascades_ut, only: cascades_test
 <<Main: test cases>>=
   case ("cascades")
      call cascades_test (u, results)
 <<Main: all tests>>=
   call cascades_test (u, results)
 @
 \subsubsection{Cascades2 lexer}
 <<Main: use tests>>=
   use cascades2_lexer_ut, only: cascades2_lexer_test
 <<Main: test cases>>=
   case ("cascades2_lexer")
      call cascades2_lexer_test (u, results)
 <<Main: all tests>>=
   call cascades2_lexer_test (u, results)
 @
 \subsubsection{Cascades2}
 <<Main: use tests>>=
   use cascades2_ut, only: cascades2_test
 <<Main: test cases>>=
   case ("cascades2")
      call cascades2_test (u, results)
 <<Main: all tests>>=
   call cascades2_test (u, results)
 @
 \subsubsection{PRC Test}
 <<Main: use tests>>=
   use prc_test_ut, only: prc_test_test
 <<Main: test cases>>=
   case ("prc_test")
      call prc_test_test (u, results)
 <<Main: all tests>>=
   call prc_test_test (u, results)
 @
 \subsubsection{PRC Template ME}
 <<Main: use tests>>=
   use prc_template_me_ut, only: prc_template_me_test
 <<Main: test cases>>=
   case ("prc_template_me")
      call prc_template_me_test (u, results)
 <<Main: all tests>>=
   call prc_template_me_test (u, results)
 @
 \subsubsection{PRC OMega}
 <<Main: use tests>>=
   use prc_omega_ut, only: prc_omega_test
   use prc_omega_ut, only: prc_omega_diags_test
 <<Main: test cases>>=
   case ("prc_omega")
      call prc_omega_test (u, results)
   case ("prc_omega_diags")
      call prc_omega_diags_test (u, results)
 <<Main: all tests>>=
   call prc_omega_test (u, results)
   call prc_omega_diags_test (u, results)
 @
 \subsubsection{Parton States}
 <<Main: use tests>>=
   use parton_states_ut, only: parton_states_test
 <<Main: test cases>>=
   case ("parton_states")
      call parton_states_test (u, results)
 <<Main: all tests>>=
   call parton_states_test (u, results)
 @
 \subsubsection{Subevt Expr}
 <<Main: use tests>>=
   use expr_tests_ut, only: subevt_expr_test
 <<Main: test cases>>=
   case ("subevt_expr")
      call subevt_expr_test (u, results)
 <<Main: all tests>>=
   call subevt_expr_test (u, results)
 @
 \subsubsection{Processes}
 <<Main: use tests>>=
   use processes_ut, only: processes_test
 <<Main: test cases>>=
   case ("processes")
      call processes_test (u, results)
 <<Main: all tests>>=
   call processes_test (u, results)
 @
 \subsubsection{Process Stacks}
 <<Main: use tests>>=
   use process_stacks_ut, only: process_stacks_test
 <<Main: test cases>>=
   case ("process_stacks")
      call process_stacks_test (u, results)
 <<Main: all tests>>=
   call process_stacks_test (u, results)
 @
 \subsubsection{Event Transforms}
 <<Main: use tests>>=
   use event_transforms_ut, only: event_transforms_test
 <<Main: test cases>>=
   case ("event_transforms")
      call event_transforms_test (u, results)
 <<Main: all tests>>=
   call event_transforms_test (u, results)
 @
 \subsubsection{Resonance Insertion Transform}
 <<Main: use tests>>=
   use resonance_insertion_ut, only: resonance_insertion_test
 <<Main: test cases>>=
   case ("resonance_insertion")
      call resonance_insertion_test (u, results)
 <<Main: all tests>>=
   call resonance_insertion_test (u, results)
 @
 \subsubsection{Recoil Kinematics}
 <<Main: use tests>>=
   use recoil_kinematics_ut, only: recoil_kinematics_test
 <<Main: test cases>>=
   case ("recoil_kinematics")
      call recoil_kinematics_test (u, results)
 <<Main: all tests>>=
   call recoil_kinematics_test (u, results)
 @
 \subsubsection{ISR Handler}
 <<Main: use tests>>=
   use isr_epa_handler_ut, only: isr_handler_test
 <<Main: test cases>>=
   case ("isr_handler")
      call isr_handler_test (u, results)
 <<Main: all tests>>=
   call isr_handler_test (u, results)
 @
 \subsubsection{EPA Handler}
 <<Main: use tests>>=
   use isr_epa_handler_ut, only: epa_handler_test
 <<Main: test cases>>=
   case ("epa_handler")
      call epa_handler_test (u, results)
 <<Main: all tests>>=
   call epa_handler_test (u, results)
 @
 \subsubsection{Decays}
 <<Main: use tests>>=
   use decays_ut, only: decays_test
 <<Main: test cases>>=
   case ("decays")
      call decays_test (u, results)
 <<Main: all tests>>=
   call decays_test (u, results)
 @
 \subsubsection{Shower}
 <<Main: use tests>>=
   use shower_ut, only: shower_test
 <<Main: test cases>>=
   case ("shower")
      call shower_test (u, results)
 <<Main: all tests>>=
   call shower_test (u, results)
 @
 \subsubsection{Events}
 <<Main: use tests>>=
   use events_ut, only: events_test
 <<Main: test cases>>=
   case ("events")
      call events_test (u, results)
 <<Main: all tests>>=
   call events_test (u, results)
 @
 \subsubsection{HEP Events}
 <<Main: use tests>>=
   use hep_events_ut, only: hep_events_test
 <<Main: test cases>>=
   case ("hep_events")
      call hep_events_test (u, results)
 <<Main: all tests>>=
   call hep_events_test (u, results)
 @
 \subsubsection{EIO Data}
 <<Main: use tests>>=
   use eio_data_ut, only: eio_data_test
 <<Main: test cases>>=
   case ("eio_data")
      call eio_data_test (u, results)
 <<Main: all tests>>=
   call eio_data_test (u, results)
 @
 \subsubsection{EIO Base}
 <<Main: use tests>>=
   use eio_base_ut, only: eio_base_test
 <<Main: test cases>>=
   case ("eio_base")
      call eio_base_test (u, results)
 <<Main: all tests>>=
   call eio_base_test (u, results)
 @
 \subsubsection{EIO Direct}
 <<Main: use tests>>=
   use eio_direct_ut, only: eio_direct_test
 <<Main: test cases>>=
   case ("eio_direct")
      call eio_direct_test (u, results)
 <<Main: all tests>>=
   call eio_direct_test (u, results)
 @
 \subsubsection{EIO Raw}
 <<Main: use tests>>=
   use eio_raw_ut, only: eio_raw_test
 <<Main: test cases>>=
   case ("eio_raw")
      call eio_raw_test (u, results)
 <<Main: all tests>>=
   call eio_raw_test (u, results)
 @
 \subsubsection{EIO Checkpoints}
 <<Main: use tests>>=
   use eio_checkpoints_ut, only: eio_checkpoints_test
 <<Main: test cases>>=
   case ("eio_checkpoints")
      call eio_checkpoints_test (u, results)
 <<Main: all tests>>=
   call eio_checkpoints_test (u, results)
 @
 \subsubsection{EIO LHEF}
 <<Main: use tests>>=
   use eio_lhef_ut, only: eio_lhef_test
 <<Main: test cases>>=
   case ("eio_lhef")
      call eio_lhef_test (u, results)
 <<Main: all tests>>=
   call eio_lhef_test (u, results)
 @
 \subsubsection{EIO HepMC}
 <<Main: use tests>>=
   use eio_hepmc_ut, only: eio_hepmc_test
 <<Main: test cases>>=
   case ("eio_hepmc")
      call eio_hepmc_test (u, results)
 <<Main: all tests>>=
   call eio_hepmc_test (u, results)
 @
 \subsubsection{EIO LCIO}
 <<Main: use tests>>=
   use eio_lcio_ut, only: eio_lcio_test
 <<Main: test cases>>=
   case ("eio_lcio")
      call eio_lcio_test (u, results)
 <<Main: all tests>>=
   call eio_lcio_test (u, results)
 @
 \subsubsection{EIO StdHEP}
 <<Main: use tests>>=
   use eio_stdhep_ut, only: eio_stdhep_test
 <<Main: test cases>>=
   case ("eio_stdhep")
      call eio_stdhep_test (u, results)
 <<Main: all tests>>=
   call eio_stdhep_test (u, results)
 @
 \subsubsection{EIO ASCII}
 <<Main: use tests>>=
   use eio_ascii_ut, only: eio_ascii_test
 <<Main: test cases>>=
   case ("eio_ascii")
      call eio_ascii_test (u, results)
 <<Main: all tests>>=
   call eio_ascii_test (u, results)
 @
 \subsubsection{EIO Weights}
 <<Main: use tests>>=
   use eio_weights_ut, only: eio_weights_test
 <<Main: test cases>>=
   case ("eio_weights")
      call eio_weights_test (u, results)
 <<Main: all tests>>=
   call eio_weights_test (u, results)
 @
 \subsubsection{EIO Dump}
 <<Main: use tests>>=
   use eio_dump_ut, only: eio_dump_test
 <<Main: test cases>>=
   case ("eio_dump")
      call eio_dump_test (u, results)
 <<Main: all tests>>=
   call eio_dump_test (u, results)
 @
 \subsubsection{Iterations}
 <<Main: use tests>>=
   use iterations_ut, only: iterations_test
 <<Main: test cases>>=
   case ("iterations")
      call iterations_test (u, results)
 <<Main: all tests>>=
   call iterations_test (u, results)
 @
 \subsubsection{Beam Structures}
 <<Main: use tests>>=
   use beam_structures_ut, only: beam_structures_test
 <<Main: test cases>>=
   case ("beam_structures")
      call beam_structures_test (u, results)
 <<Main: all tests>>=
   call beam_structures_test (u, results)
 @
 \subsubsection{RT Data}
 <<Main: use tests>>=
   use rt_data_ut, only: rt_data_test
 <<Main: test cases>>=
   case ("rt_data")
      call rt_data_test (u, results)
 <<Main: all tests>>=
   call rt_data_test (u, results)
 @
 \subsubsection{Dispatch}
 <<Main: use tests>>=
   use dispatch_ut, only: dispatch_test
 <<Main: test cases>>=
   case ("dispatch")
      call dispatch_test (u, results)
 <<Main: all tests>>=
   call dispatch_test (u, results)
 @
 \subsubsection{Dispatch RNG}
 <<Main: use tests>>=
   use dispatch_rng_ut, only: dispatch_rng_test
 <<Main: test cases>>=
   case ("dispatch_rng")
      call dispatch_rng_test (u, results)
 <<Main: all tests>>=
   call dispatch_rng_test (u, results)
 @
 \subsubsection{Dispatch MCI}
 <<Main: use tests>>=
   use dispatch_mci_ut, only: dispatch_mci_test
 <<Main: test cases>>=
   case ("dispatch_mci")
      call dispatch_mci_test (u, results)
 <<Main: all tests>>=
   call dispatch_mci_test (u, results)
 @
 \subsubsection{Dispatch PHS}
 <<Main: use tests>>=
   use dispatch_phs_ut, only: dispatch_phs_test
 <<Main: test cases>>=
   case ("dispatch_phs")
      call dispatch_phs_test (u, results)
 <<Main: all tests>>=
   call dispatch_phs_test (u, results)
 @
 \subsubsection{Dispatch transforms}
 <<Main: use tests>>=
   use dispatch_transforms_ut, only: dispatch_transforms_test
 <<Main: test cases>>=
   case ("dispatch_transforms")
      call dispatch_transforms_test (u, results)
 <<Main: all tests>>=
   call dispatch_transforms_test (u, results)
 @
 \subsubsection{Shower partons}
 <<Main: use tests>>=
   use shower_base_ut, only: shower_base_test
 <<Main: test cases>>=
   case ("shower_base")
      call shower_base_test (u, results)
 <<Main: all tests>>=
   call shower_base_test (u, results)
 @
 \subsubsection{Process Configurations}
 <<Main: use tests>>=
   use process_configurations_ut, only: process_configurations_test
 <<Main: test cases>>=
   case ("process_configurations")
      call process_configurations_test (u, results)
 <<Main: all tests>>=
   call process_configurations_test (u, results)
 @
 \subsubsection{Compilations}
 <<Main: use tests>>=
   use compilations_ut, only: compilations_test
   use compilations_ut, only: compilations_static_test
 <<Main: test cases>>=
   case ("compilations")
      call compilations_test (u, results)
   case ("compilations_static")
      call compilations_static_test (u, results)
 <<Main: all tests>>=
   call compilations_test (u, results)
   call compilations_static_test (u, results)
 @
 \subsubsection{Integrations}
 <<Main: use tests>>=
   use integrations_ut, only: integrations_test
   use integrations_ut, only: integrations_history_test
 <<Main: test cases>>=
   case ("integrations")
      call integrations_test (u, results)
   case ("integrations_history")
      call integrations_history_test (u, results)
 <<Main: all tests>>=
   call integrations_test (u, results)
   call integrations_history_test (u, results)
 @
 \subsubsection{Event Streams}
 <<Main: use tests>>=
   use event_streams_ut, only: event_streams_test
 <<Main: test cases>>=
   case ("event_streams")
      call event_streams_test (u, results)
 <<Main: all tests>>=
   call event_streams_test (u, results)
 @
 \subsubsection{Restricted Subprocesses}
 <<Main: use tests>>=
   use restricted_subprocesses_ut, only: restricted_subprocesses_test
 <<Main: test cases>>=
   case ("restricted_subprocesses")
      call restricted_subprocesses_test (u, results)
 <<Main: all tests>>=
   call restricted_subprocesses_test (u, results)
 @
 \subsubsection{Simulations}
 <<Main: use tests>>=
   use simulations_ut, only: simulations_test
 <<Main: test cases>>=
   case ("simulations")
      call simulations_test (u, results)
 <<Main: all tests>>=
   call simulations_test (u, results)
 @
 \subsubsection{Commands}
 <<Main: use tests>>=
   use commands_ut, only: commands_test
 <<Main: test cases>>=
   case ("commands")
      call commands_test (u, results)
 <<Main: all tests>>=
   call commands_test (u, results)
 @
 \subsubsection{$ttV$ formfactors}
 <<Main: use tests>>=
   use ttv_formfactors_ut, only: ttv_formfactors_test
 <<Main: test cases>>=
   case ("ttv_formfactors")
      call ttv_formfactors_test (u, results)
 <<Main: all tests>>=
   call ttv_formfactors_test (u, results)
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Whizard-C-Interface}
 <<[[whizard-c-interface.f90]]>>=
 <<File header>>
 
 <<Whizard-C-Interface: Internals>>
 <<Whizard-C-Interface: Init and Finalize>>
 <<Whizard-C-Interface: Interfaced Commads>>
 <<Whizard-C-Interface: HepMC>>
 
 @
 <<Whizard-C-Interface: Internals>>=
   subroutine c_whizard_convert_string (c_string, f_string)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     character(kind=c_char), intent(in) :: c_string(*)
     type(string_t), intent(inout) :: f_string
     character(len=1) :: dummy_char
     integer :: dummy_i = 1
 
     f_string = ""
     do
        if (c_string(dummy_i) == c_null_char) then
           exit
        else if (c_string(dummy_i) == c_new_line) then
           dummy_char = CHAR(13)
           f_string = f_string // dummy_char
           dummy_char = CHAR(10)
        else
           dummy_char = c_string (dummy_i)
        end if
        f_string = f_string // dummy_char
        dummy_i = dummy_i + 1
     end do
     dummy_i = 1
   end subroutine c_whizard_convert_string
 
   subroutine c_whizard_commands (w_c_instance, cmds)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
     use commands
     use diagnostics
     use lexers
     use models
     use parser
     use whizard
 
     type(c_ptr), intent(inout) :: w_c_instance
     type(whizard_t), pointer :: whizard_instance
     type(string_t) :: cmds
     type(parse_tree_t) :: parse_tree
     type(parse_node_t), pointer :: pn_root
     type(stream_t), target :: stream
     type(lexer_t) :: lexer
     type(command_list_t), target :: cmd_list
 
     call c_f_pointer (w_c_instance, whizard_instance)
     call lexer_init_cmd_list (lexer)
     call syntax_cmd_list_init ()
 
     call stream_init (stream, cmds)
     call lexer_assign_stream (lexer, stream)
     call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
     pn_root => parse_tree%get_root_ptr ()
 
     if (associated (pn_root)) then
        call cmd_list%compile (pn_root, whizard_instance%global)
     end if
     call whizard_instance%global%activate ()
     call cmd_list%execute (whizard_instance%global)
     call cmd_list%final ()
 
     call parse_tree_final (parse_tree)
     call stream_final (stream)
     call lexer_final (lexer)
     call syntax_cmd_list_final ()
   end subroutine c_whizard_commands
 
 @
 <<Whizard-C-Interface: Init and Finalize>>=
   subroutine c_whizard_init (w_c_instance) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
     use system_dependencies
     use diagnostics
     use ifiles
     use os_interface
     use whizard
 
     implicit none
 
   <<Main: cmdline arg len declaration>>
 
     type(c_ptr), intent(out) :: w_c_instance
     logical :: banner
     type(string_t) :: files, model, default_lib, library, libraries
 !     type(string_t) :: check, checks
     type(string_t) :: logfile
     type(string_t) :: user_src, user_lib
     type(paths_t) :: paths
     logical :: rebuild_library, rebuild_user
     logical :: rebuild_phs, rebuild_grids, rebuild_events
 
     type(whizard_options_t), allocatable :: options
     type(whizard_t), pointer :: whizard_instance
 
 
     ! Initial values
     files = ""
     model = "SM"
     default_lib = "default_lib"
     library = ""
     libraries = ""
     banner = .true.
     logging = .true.
     logfile = "whizard.log"
 !     check = ""
 !     checks = ""
     user_src = ""
     user_lib = ""
     rebuild_library = .false.
     rebuild_user = .false.
     rebuild_phs = .false.
     rebuild_grids = .false.
     rebuild_events = .false.
     call paths_init (paths)
 
     ! Overall initialization
     if (logfile /= "")  call logfile_init (logfile)
     call mask_term_signals ()
     if (banner)  call msg_banner ()
 
     ! Set options and initialize the whizard object
     allocate (options)
     options%preload_model = model
     options%default_lib = default_lib
     options%preload_libraries = libraries
     options%rebuild_library = rebuild_library
     options%rebuild_user = rebuild_user
     options%rebuild_phs = rebuild_phs
     options%rebuild_grids = rebuild_grids
     options%rebuild_events = rebuild_events
 
     allocate (whizard_instance)
     call whizard_instance%init (options, paths)
 
 !     if (checks /= "") then
 !        checks = trim (adjustl (checks))
 !        RUN_CHECKS: do while (checks /= "")
 !           call split (checks, check, " ")
 !           call whizard_check (check, test_results)
 !        end do RUN_CHECKS
 !        call test_results%wrapup (6, success)
 !        if (.not. success)  quit_code = 7
 !        quit = .true.
 !     end if
 
     w_c_instance = c_loc (whizard_instance)
 
   end subroutine c_whizard_init
 
   subroutine c_whizard_finalize (w_c_instance) bind(C)
     use, intrinsic :: iso_c_binding
     use system_dependencies
     use diagnostics
     use ifiles
     use os_interface
     use whizard
 
     type(c_ptr), intent(in) :: w_c_instance
     type(whizard_t), pointer :: whizard_instance
     integer :: quit_code = 0
 
     call c_f_pointer (w_c_instance, whizard_instance)
     call whizard_instance%final ()
     deallocate (whizard_instance)
     call terminate_now_if_signal ()
     call release_term_signals ()
     call msg_terminate (quit_code = quit_code)
   end subroutine c_whizard_finalize
 
   subroutine c_whizard_process_string (w_c_instance, c_cmds_in) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_cmds_in(*)
     type(string_t) :: f_cmds
 
     call c_whizard_convert_string (c_cmds_in, f_cmds)
     call c_whizard_commands (w_c_instance, f_cmds)
   end subroutine c_whizard_process_string
 
 @
 <<Whizard-C-Interface: Interfaced Commads>>=
   subroutine c_whizard_model (w_c_instance, c_model) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_model(*)
     type(string_t) :: model, mdl_str
 
     call c_whizard_convert_string (c_model, model)
     mdl_str = "model = " // model
     call c_whizard_commands (w_c_instance, mdl_str)
   end subroutine c_whizard_model
 
   subroutine c_whizard_library (w_c_instance, c_library) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_library(*)
     type(string_t) :: library, lib_str
 
     call c_whizard_convert_string(c_library, library)
     lib_str = "library = " // library
     call c_whizard_commands (w_c_instance, lib_str)
   end subroutine c_whizard_library
 
   subroutine c_whizard_process (w_c_instance, c_id, c_in, c_out) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_id(*), c_in(*), c_out(*)
     type(string_t) :: proc_str, id, in, out
 
     call c_whizard_convert_string (c_id, id)
     call c_whizard_convert_string (c_in, in)
     call c_whizard_convert_string (c_out, out)
     proc_str = "process " // id // " = " // in // " => " // out
     call c_whizard_commands (w_c_instance, proc_str)
   end subroutine c_whizard_process
 
   subroutine c_whizard_compile (w_c_instance) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     type(c_ptr), intent(inout) :: w_c_instance
     type(string_t) :: cmp_str
     cmp_str = "compile"
     call c_whizard_commands (w_c_instance, cmp_str)
   end subroutine c_whizard_compile
 
   subroutine c_whizard_beams (w_c_instance, c_specs) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_specs(*)
     type(string_t) :: specs, beam_str
 
     call c_whizard_convert_string (c_specs, specs)
     beam_str = "beams = " // specs
     call c_whizard_commands (w_c_instance, beam_str)
   end subroutine c_whizard_beams
 
   subroutine c_whizard_integrate (w_c_instance, c_process) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_process(*)
     type(string_t) :: process, int_str
 
     call c_whizard_convert_string (c_process, process)
     int_str = "integrate (" // process //")"
     call c_whizard_commands (w_c_instance, int_str)
   end subroutine c_whizard_integrate
 
   subroutine c_whizard_matrix_element_test &
        (w_c_instance, c_process, n_calls) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     integer(kind=c_int) :: n_calls
     character(kind=c_char) :: c_process(*)
     type(string_t) :: process, me_str
     character(len=8) :: buffer
 
     call c_whizard_convert_string (c_process, process)
     write (buffer, "(I0)")  n_calls
     me_str = "integrate (" // process // ") { ?phs_only = true" // &
          "  n_calls_test = " // trim (buffer)
     call c_whizard_commands (w_c_instance, me_str)
   end subroutine c_whizard_matrix_element_test
 
   subroutine c_whizard_simulate (w_c_instance, c_id) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_id(*)
     type(string_t) :: sim_str, id
 
     call c_whizard_convert_string(c_id, id)
     sim_str = "simulate (" // id // ")"
     call c_whizard_commands (w_c_instance, sim_str)
   end subroutine c_whizard_simulate
 
   subroutine c_whizard_sqrts (w_c_instance, c_value, c_unit) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_unit(*)
     integer(kind=c_int) :: c_value
     integer :: f_value
     character(len=8) :: f_val
     type(string_t) :: val, unit, sqrts_str
 
     f_value = c_value
     write (f_val,'(i8)') f_value
     val = f_val
     call c_whizard_convert_string (c_unit, unit)
     sqrts_str = "sqrts =" // val // unit
     call c_whizard_commands (w_c_instance, sqrts_str)
   end subroutine c_whizard_sqrts
 
 @
 <<Whizard-C-Interface: HepMC>>=
   type(c_ptr) function c_whizard_hepmc_test &
        (w_c_instance, c_id, c_proc_id, c_event_id) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
     use commands
     use diagnostics
     use events
     use hepmc_interface
     use lexers
     use models
     use parser
     use instances
     use rt_data
     use simulations
     use whizard
     use os_interface
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     type(string_t) :: sim_str
     type(parse_tree_t) :: parse_tree
     type(parse_node_t), pointer :: pn_root
     type(stream_t), target :: stream
     type(lexer_t) :: lexer
     type(command_list_t), pointer :: cmd_list
     type(whizard_t), pointer :: whizard_instance
 
     type(simulation_t), target :: sim
 
     character(kind=c_char), intent(in) :: c_id(*)
     type(string_t) :: id
     integer(kind=c_int), value :: c_proc_id, c_event_id
     integer :: proc_id
 
     type(hepmc_event_t), pointer :: hepmc_event
 
     call c_f_pointer (w_c_instance, whizard_instance)
 
     call c_whizard_convert_string (c_id, id)
     sim_str = "simulate (" // id // ")"
 
     proc_id = c_proc_id
 
     allocate (hepmc_event)
     call hepmc_event_init (hepmc_event, c_proc_id, c_event_id)
 
     call syntax_cmd_list_init ()
     call lexer_init_cmd_list (lexer)
 
     call stream_init (stream, sim_str)
     call lexer_assign_stream (lexer, stream)
     call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
     pn_root => parse_tree%get_root_ptr ()
 
     allocate (cmd_list)
     if (associated (pn_root)) then
        call cmd_list%compile (pn_root, whizard_instance%global)
     end if
 
     call sim%init ([id], .true., .true., whizard_instance%global)
 
     !!! This should generate a HepMC event as hepmc_event_t type
     call msg_message ("Not enabled for the moment.")
 
     call sim%final ()
 
     call cmd_list%final ()
 
     call parse_tree_final (parse_tree)
     call stream_final (stream)
     call lexer_final (lexer)
     call syntax_cmd_list_final ()
 
     c_whizard_hepmc_test = c_loc(hepmc_event)
     return
   end function c_whizard_hepmc_test
 @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Index: trunk/share/tests/functional_tests/ref-output/show_1.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/show_1.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output/show_1.ref	(revision 8371)
@@ -1,359 +1,359 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 | Switching to model 'SM', scheme 'default'
 | Process library 'show_1_lib': recorded process 'show_1_p1'
 process_num_id = 77
 | Process library 'show_1_lib': recorded process 'show_1_p2' (77)
 | Process library 'show_1_lib': recorded process 'show_1_p3'
 error_threshold =  1.000000000000E-08
 | Integrate: current process library needs compilation
 | Process library 'show_1_lib': compiling ...
 | Process library 'show_1_lib': writing makefile
 | Process library 'show_1_lib': removing old files
 | Process library 'show_1_lib': writing driver
 | Process library 'show_1_lib': creating source code
 | Process library 'show_1_lib': compiling sources
 | Process library 'show_1_lib': linking
 | Process library 'show_1_lib': loading
 | Process library 'show_1_lib': ... success.
 | Integrate: compilation done
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process show_1_p1:
 | Beam structure: [any particles]
 | Beam data (decay):
 |   H  (mass = 1.2500000E+02 GeV)
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'show_1_p1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [decay]: 'show_1_p1'
 |   Library name  = 'show_1_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'show_1_p1_i1':   H => b, bbar [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 Warning: No cuts have been defined.
 | Starting integration for process 'show_1_p1'
 | Integrate: iterations not specified, using default
 | Integrate: iterations = 1:100:""
 | Integrator: 1 chains, 1 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[GeV] Error[GeV]  Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100  4.3122140E-03  0.00E+00    0.00    0.00* 100.00
 |-----------------------------------------------------------------------------|
    1        100  4.3122140E-03  0.00E+00    0.00    0.00  100.00
 |=============================================================================|
 | Unstable particle H: computed branching ratios:
 |   show_1_p1: 1.0000000E+00   b, bbar
 |   Total width = 4.3122140E-03 GeV (computed)
 |               = 4.1430000E-03 GeV (preset)
 |   Decay options: helicity treated exactly
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Initializing integration for process show_1_p2:
 | Beam structure: [any particles]
 | Beam data (decay):
 |   W+  (mass = 8.0419000E+01 GeV)
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'show_1_p2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [decay]: 'show_1_p2'
 |   ID (num)      = 77
 |   Library name  = 'show_1_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'show_1_p2_i1':   W+ => e+, nue [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 Warning: No cuts have been defined.
 | Starting integration for process 'show_1_p2'
 | Integrate: iterations not specified, using default
 | Integrate: iterations = 1:100:""
 | Integrator: 1 chains, 1 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[GeV] Error[GeV]  Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100  2.2756406E-01  0.00E+00    0.00    0.00* 100.00
 |-----------------------------------------------------------------------------|
    1        100  2.2756406E-01  0.00E+00    0.00    0.00  100.00
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process show_1_p3:
 | Beam structure: [any particles]
 | Beam data (decay):
 |   W+  (mass = 8.0419000E+01 GeV)
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'show_1_p3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [decay]: 'show_1_p3'
 |   Library name  = 'show_1_lib'
 |   Process index = 3
 |   Process components:
 |     1: 'show_1_p3_i1':   W+ => mu+, numu [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 Warning: No cuts have been defined.
 | Starting integration for process 'show_1_p3'
 | Integrate: iterations not specified, using default
 | Integrate: iterations = 1:100:""
 | Integrator: 1 chains, 1 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[GeV] Error[GeV]  Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100  2.2756347E-01  0.00E+00    0.00    0.00* 100.00
 |-----------------------------------------------------------------------------|
    1        100  2.2756347E-01  0.00E+00    0.00    0.00  100.00
 |=============================================================================|
 | Unstable particle W+: computed branching ratios:
 |   show_1_p2: 5.0000065E-01   e+, nue
 |   show_1_p3: 4.9999935E-01   mu+, numu
 |   Total width = 4.5512753E-01 GeV (computed)
 |               = 2.0490000E+00 GeV (preset)
 |   Decay options: helicity treated exactly
 | Particle b declared as polarized
 | Particle bbar declared as polarized
 sqrts =  1.400000000000E+04
 $lhapdf_dir = "/lhapdf/dir"
 $lhapdf_file = "datafile.lhapdf"
 $lhapdf_photon_file = "photonfile.lhapdf"
 lhapdf_member = 4
 lhapdf_photon_scheme = 1
 Model: SM
   Scheme: 'default' (1)
   Particles:
     d               1
     dbar           -1
     u               2
     ubar           -2
     s               3
     sbar           -3
     c               4
     cbar           -4
     b               5   polarized
     bbar           -5   polarized
     t               6
     tbar           -6
     e-             11
     e+            -11
     nue            12
     nuebar        -12
     mu-            13
     mu+           -13
     numu           14
     numubar       -14
     tau-           15
     tau+          -15
     nutau          16
     nutaubar      -16
     gl             21
     A              22
     Z              23
     W+             24   decays: show_1_p2 show_1_p3
     W-            -24
     H              25   decays: show_1_p1
     p            2212
     pbar        -2212
     hr             90
     hr1            91
     hr3            92
     hr3bar        -92
     hr8            93
   Independent parameters:
     GF         =  1.166390000000E-05
     mZ         =  9.118820000000E+01
     mW         =  8.041900000000E+01
     mH         =  1.250000000000E+02
     alphas     =  1.178000000000E-01
     me         =  5.109970000000E-04
     mmu        =  1.056583890000E-01
     mtau       =  1.777050000000E+00
     ms         =  9.500000000000E-02
     mc         =  1.200000000000E+00
     mb         =  4.200000000000E+00
     mtop       =  1.731000000000E+02
     wtop       =  1.523000000000E+00
     wZ         =  2.443000000000E+00
     wW         =  2.049000000000E+00
     wH         =  4.143000000000E-03
     khgaz      =  0.000000000000E+00
     khgaga     =  0.000000000000E+00
     khgg       =  0.000000000000E+00
     xi0        =  0.000000000000E+00
     xipm       =  0.000000000000E+00
   Derived parameters:
     v          =  2.462184581018E+02
     cw         =  8.819013863636E-01
     sw         =  4.714339240339E-01
     ee         =  3.079561542961E-01
     alpha_em_i =  1.325049458125E+02
 Process library: show_1_lib
   external        = T
   makefile exists = T
   driver exists   = T
   code status     = active
   Processes:
     show_1_p1 [SM]
       show_1_p1_i1: H => b, bbar  [omega]
     show_1_p2 (77) [SM]
       show_1_p2_i1: W+ => e+, nue  [omega]
     show_1_p3 [SM]
       show_1_p3_i1: W+ => mu+, numu  [omega]
 Process library: show_1_lib
   external        = T
   makefile exists = T
   driver exists   = T
   code status     = active
   Processes:
     show_1_p1 [SM]
       show_1_p1_i1: H => b, bbar  [omega]
     show_1_p2 (77) [SM]
       show_1_p2_i1: W+ => e+, nue  [omega]
     show_1_p3 [SM]
       show_1_p3_i1: W+ => mu+, numu  [omega]
  Beam structure: p, p => pdf_builtin
   sqrts = 1.400000000000E+04 GeV
   PDF set = "CTEQ6L"
  Beam structure: p, p => lhapdf
   sqrts = 1.400000000000E+04 GeV
   LHAPDF dir    = "/lhapdf/dir"
   LHAPDF file   = "datafile.lhapdf"
   LHAPDF member = 4
  Beam structure: p, p => lhapdf_photon
   sqrts = 1.400000000000E+04 GeV
   LHAPDF dir    = "/lhapdf/dir"
   LHAPDF file   = "photonfile.lhapdf"
   LHAPDF member = 4
   LHAPDF scheme = 1
  Beam structure: e-, e+ => isr
   sqrts = 1.400000000000E+04 GeV
   ISR alpha        = 0.000000000000E+00
   ISR Q max        = 0.000000000000E+00
   ISR mass         = 0.000000000000E+00
   ISR order        = 3
   ISR recoil       = F
   ISR energy cons. = F
  Beam structure: e-, e+ => epa
   sqrts = 1.400000000000E+04 GeV
   EPA alpha         = 0.000000000000E+00
   EPA x min         = 0.000000000000E+00
   EPA Q min         = 0.000000000000E+00
-  EPA E max         = 0.000000000000E+00
+  EPA Q max         = 0.000000000000E+00
   EPA mass          = 0.000000000000E+00
   EPA recoil        = F
   EPA  energy cons. = F
 iterations = 1:1000:"gw", 3:5000:"gw"
 Expression: cuts (parse tree):
 +  SEQUENCE    <lexpr>  =  <lsinglet>
 +  SEQUENCE    <lsinglet>  =  <lterm>
 |  +  SEQUENCE    <lterm>  =  true
 |  |  +  KEYWORD     true  = [keyword] true
 Expression: scale (parse tree):
 +  SEQUENCE    <expr>  =  <term>
 +  SEQUENCE    <term>  =  <factor>
 |  +  SEQUENCE    <factor>  =  <integer_value>
 |  |  +  SEQUENCE    <integer_value>  =  <integer_literal>
 |  |  |  +  INTEGER     <integer_literal>  = 1
 Expression: factorization_scale (parse tree):
 +  SEQUENCE    <expr>  =  <term>
 +  SEQUENCE    <term>  =  <factor>
 |  +  SEQUENCE    <factor>  =  <integer_value>
 |  |  +  SEQUENCE    <integer_value>  =  <integer_literal>
 |  |  |  +  INTEGER     <integer_literal>  = 2
 Expression: renormalization_scale (parse tree):
 +  SEQUENCE    <expr>  =  <term>
 +  SEQUENCE    <term>  =  <factor>
 |  +  SEQUENCE    <factor>  =  <integer_value>
 |  |  +  SEQUENCE    <integer_value>  =  <integer_literal>
 |  |  |  +  INTEGER     <integer_literal>  = 3
 Expression: weight (parse tree):
 +  SEQUENCE    <expr>  =  <term>
 +  SEQUENCE    <term>  =  <factor>
 |  +  SEQUENCE    <factor>  =  <integer_value>
 |  |  +  SEQUENCE    <integer_value>  =  <integer_literal>
 |  |  |  +  INTEGER     <integer_literal>  = 4
 Expression: selection (parse tree):
 +  SEQUENCE    <lexpr>  =  <lsinglet>
 +  SEQUENCE    <lsinglet>  =  <lterm>
 |  +  SEQUENCE    <lterm>  =  false
 |  |  +  KEYWORD     false  = [keyword] false
 Expression: reweight (parse tree):
 +  SEQUENCE    <expr>  =  <term>
 +  SEQUENCE    <term>  =  <factor>
 |  +  SEQUENCE    <factor>  =  <integer_value>
 |  |  +  SEQUENCE    <integer_value>  =  <integer_literal>
 |  |  |  +  INTEGER     <integer_literal>  = 5
 Expression: analysis (parse tree):
 +  SEQUENCE    <lexpr>  =  <lsinglet>
 +  SEQUENCE    <lsinglet>  =  <lterm>
 |  +  SEQUENCE    <lterm>  =  true
 |  |  +  KEYWORD     true  = [keyword] true
 sqrts =  1.400000000000E+04
 $lhapdf_dir = "/lhapdf/dir"
 ?unweighted = true
 SM.e1* = PDG(11)
 SM.me =>  5.109970000000E-04
 [user variable] i = 42
 [user variable] i = 42
 Process: show_1_p1 [SM]
   1: H => b, bbar [omega]
   Computed width = 4.3122140E-03 +- 0.00E+00 GeV (  0.    %)
 Process: show_1_p2 (77) [SM]
   1: W+ => e+, nue [omega]
   Computed width = 2.2756406E-01 +- 0.00E+00 GeV (  0.    %)
 show_1_p1:
    4.3122140E-03 +- 0.00E+00 GeV (  0.    %)
 show_1_p2 (77):
    2.2756406E-01 +- 0.00E+00 GeV (  0.    %)
 show_1_p3:
    2.2756347E-01 +- 0.00E+00 GeV (  0.    %)
 [user variable] i = 2
 | expect: success
 | Summary of value checks:
 |   Failures: 0 / Total: 1
 Stable particles:  d dbar u ubar s sbar c cbar b bbar t tbar e- e+ nue nuebar mu- mu+ numu numubar tau- tau+ nutau nutaubar gl A Z W- p pbar hr hr1 hr3 hr3bar hr8
 Unstable particles:  W+ H
 Unstable particle W+: computed branching ratios:
   show_1_p2: 5.0000065E-01   e+, nue
   show_1_p3: 4.9999935E-01   mu+, numu
   Total width = 4.5512753E-01 GeV (computed)
               = 2.0490000E+00 GeV (preset)
   Decay options: helicity treated exactly
 Unstable particle H: computed branching ratios:
   show_1_p1: 1.0000000E+00   b, bbar
   Total width = 4.3122140E-03 GeV (computed)
               = 4.1430000E-03 GeV (preset)
   Decay options: helicity treated exactly
 Polarized particles:  b bbar
 Unpolarized particles:  d dbar u ubar s sbar c cbar t tbar e- e+ nue nuebar mu- mu+ numu numubar tau- tau+ nutau nutaubar gl A Z W+ W- H p pbar hr hr1 hr3 hr3bar hr8
 integral(show_1_p1) =  4.312214000135E-03
 error(show_1_p1) =  0.000000000000E+00
 | Summary of value checks:
 |   Failures: 0 / Total: 1
 | There were no errors and    3 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output/epa_1.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/epa_1.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output/epa_1.ref	(revision 8371)
@@ -1,140 +1,140 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?pacify = true
 | Process library 'epa_1_lib': recorded process 'epa_1a'
 | Process library 'epa_1_lib': recorded process 'epa_1b'
 | Process library 'epa_1_lib': compiling ...
 | Process library 'epa_1_lib': writing makefile
 | Process library 'epa_1_lib': removing old files
 | Process library 'epa_1_lib': writing driver
 | Process library 'epa_1_lib': creating source code
 | Process library 'epa_1_lib': compiling sources
 | Process library 'epa_1_lib': linking
 | Process library 'epa_1_lib': loading
 | Process library 'epa_1_lib': ... success.
 sqrts =  1.00000E+02
 openmp_num_threads = 1
 SM.me =>  0.00000E+00
 epa_mass =  5.11000E-04
 epa_x_min =  1.00000E-02
 ?epa_recoil = false
 seed = 0
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process epa_1a:
 | Beam structure: e-, e+ => epa
 | Beam data (collision):
 |   e-  (mass = 0.0000000E+00 GeV)
 |   e+  (mass = 0.0000000E+00 GeV)
 |   sqrts = 1.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'epa_1a.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'epa_1a'
 |   Library name  = 'epa_1_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'epa_1a_i1':   A, A => mu-, mu+ [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'epa_1a'
 | Integrate: iterations = 1:1000
 | Integrator: 1 chains, 4 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1       1000     1.444E+05   3.49E+04   24.14    7.63     1.4
+   1       1000     1.446E+05   3.54E+04   24.48    7.74     1.3
 |-----------------------------------------------------------------------------|
-   1       1000     1.444E+05   3.49E+04   24.14    7.63     1.4
+   1       1000     1.446E+05   3.54E+04   24.48    7.74     1.3
 |=============================================================================|
 seed = 0
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process epa_1b:
 | Beam structure: e-, e+ => epa
 | Beam data (collision):
 |   e-  (mass = 0.0000000E+00 GeV)
 |   e+  (mass = 0.0000000E+00 GeV)
 |   sqrts = 1.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'epa_1b.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'epa_1b'
 |   Library name  = 'epa_1_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'epa_1b_i1':   A, A => mu-, mu+ [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'epa_1b'
 | Integrate: iterations = 1:1000
 | Integrator: 1 chains, 4 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1       1000     1.444E+05   3.49E+04   24.14    7.63     1.4
+   1       1000     1.446E+05   3.54E+04   24.48    7.74     1.3
 |-----------------------------------------------------------------------------|
-   1       1000     1.444E+05   3.49E+04   24.14    7.63     1.4
+   1       1000     1.446E+05   3.54E+04   24.48    7.74     1.3
 |=============================================================================|
 ?keep_beams = true
 ?keep_remnants = true
 ?epa_handler = false
 $sample = "epa_1a"
 n_events = 1
 | Starting simulation for process 'epa_1a'
 | Simulate: using integration grids from file 'epa_1a.m1.vg'
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Simulation: requested number of events = 1
-|             corr. to luminosity [fb-1] =   6.9234E-06
+|             corr. to luminosity [fb-1] =   6.9158E-06
 | Events: writing to LHEF file 'epa_1a.lhe'
 | Events: writing to raw file 'epa_1a.evx'
 | Events: generating 1 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: actual unweighting efficiency =   1.59 %
 | Events: closing LHEF file 'epa_1a.lhe'
 | Events: closing raw file 'epa_1a.evx'
 ?epa_handler = true
 $epa_handler_mode = "recoil"
 $sample = "epa_1b"
 n_events = 1
 | Starting simulation for process 'epa_1b'
 | Simulate: using integration grids from file 'epa_1b.m1.vg'
 | Simulate: activating EPA handler
 | Simulate: ISR/EPA handler mode: pair recoil
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Simulation: requested number of events = 1
-|             corr. to luminosity [fb-1] =   6.9234E-06
+|             corr. to luminosity [fb-1] =   6.9158E-06
 | Events: writing to LHEF file 'epa_1b.lhe'
 | Events: writing to raw file 'epa_1b.evx'
 | Events: generating 1 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: actual unweighting efficiency =   1.59 %
 | Events: closing LHEF file 'epa_1b.lhe'
 | Events: closing raw file 'epa_1b.evx'
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output/isr_epa_1.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/isr_epa_1.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output/isr_epa_1.ref	(revision 8371)
@@ -1,99 +1,99 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?pacify = true
 | Process library 'isr_epa_1_lib': recorded process 'isr_epa_1a'
 | Process library 'isr_epa_1_lib': compiling ...
 | Process library 'isr_epa_1_lib': writing makefile
 | Process library 'isr_epa_1_lib': removing old files
 | Process library 'isr_epa_1_lib': writing driver
 | Process library 'isr_epa_1_lib': creating source code
 | Process library 'isr_epa_1_lib': compiling sources
 | Process library 'isr_epa_1_lib': linking
 | Process library 'isr_epa_1_lib': loading
 | Process library 'isr_epa_1_lib': ... success.
 sqrts =  1.00000E+02
 openmp_num_threads = 1
 SM.me =>  0.00000E+00
 isr_mass =  5.11000E-04
 isr_q_max =  2.00000E+00
 ?isr_recoil = false
 epa_mass =  5.11000E-04
 epa_x_min =  1.00000E-02
 epa_q_max =  1.00000E+00
 ?epa_recoil = false
 seed = 0
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process isr_epa_1a:
 | Beam structure: e-, e+ => isr, epa
 | Beam data (collision):
 |   e-  (mass = 0.0000000E+00 GeV)
 |   e+  (mass = 0.0000000E+00 GeV)
 |   sqrts = 1.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'isr_epa_1a.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'isr_epa_1a'
 |   Library name  = 'isr_epa_1_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'isr_epa_1a_i1':   e-, A => e-, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: isr, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'isr_epa_1a'
 | Integrate: iterations = 1:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999     1.508E+04   2.40E+03   15.90    5.03     2.0
+   1        999     1.363E+04   2.21E+03   16.20    5.12     1.9
 |-----------------------------------------------------------------------------|
-   1        999     1.508E+04   2.40E+03   15.90    5.03     2.0
+   1        999     1.363E+04   2.21E+03   16.20    5.12     1.9
 |=============================================================================|
 ?isr_handler = true
 ?epa_handler = true
 $isr_handler_mode = "recoil"
 $epa_handler_mode = "recoil"
 n_events = 100
 | Starting simulation for process 'isr_epa_1a'
 | Simulate: using integration grids from file 'isr_epa_1a.m1.vg'
 | Simulate: activating ISR handler
 | Simulate: activating EPA handler
 | Simulate: ISR/EPA handler mode: pair recoil
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Simulation: requested number of events = 100
-|             corr. to luminosity [fb-1] =   6.6299E-03
+|             corr. to luminosity [fb-1] =   7.3361E-03
 | Events: writing to raw file 'isr_epa_1a.evx'
 | Events: generating 100 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
-| Events: actual unweighting efficiency =   2.72 %
+| Events: actual unweighting efficiency =   2.74 %
 Warning: Encountered events with excess weight: 19 events ( 19.000 %)
-| Maximum excess weight = 8.059E+00
-| Average excess weight = 1.260E-01
+| Maximum excess weight = 7.146E+00
+| Average excess weight = 1.111E-01
 | Events: closing raw file 'isr_epa_1a.evx'
 $out_file = "isr_epa_1a.dat"
 | Opening file 'isr_epa_1a.dat' for output
 | Writing analysis data to file 'isr_epa_1a.dat'
 | Closing file 'isr_epa_1a.dat' for output
 | There were no errors and    1 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
 Event breakdown (ISR):
   Q < Qmax: 100
   Q > Qmax:   0
 Event breakdown (EPA):
   Q < Qmax: 100
   Q > Qmax:   0
Index: trunk/share/tests/functional_tests/ref-output/epa_2.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/epa_2.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output/epa_2.ref	(revision 8371)
@@ -1,90 +1,90 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?pacify = true
 | Process library 'epa_2_lib': recorded process 'epa_2a'
 | Process library 'epa_2_lib': compiling ...
 | Process library 'epa_2_lib': writing makefile
 | Process library 'epa_2_lib': removing old files
 | Process library 'epa_2_lib': writing driver
 | Process library 'epa_2_lib': creating source code
 | Process library 'epa_2_lib': compiling sources
 | Process library 'epa_2_lib': linking
 | Process library 'epa_2_lib': loading
 | Process library 'epa_2_lib': ... success.
 sqrts =  1.00000E+02
 openmp_num_threads = 1
 SM.me =>  0.00000E+00
 epa_mass =  5.11000E-04
 epa_x_min =  1.00000E-02
 epa_q_max =  2.00000E+00
 ?epa_recoil = false
 seed = 0
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process epa_2a:
 | Beam structure: e-, e+ => epa
 | Beam data (collision):
 |   e-  (mass = 0.0000000E+00 GeV)
 |   e+  (mass = 0.0000000E+00 GeV)
 |   sqrts = 1.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'epa_2a.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'epa_2a'
 |   Library name  = 'epa_2_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'epa_2a_i1':   A, A => mu-, mu+ [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'epa_2a'
 | Integrate: iterations = 1:1000
 | Integrator: 1 chains, 4 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1       1000     1.444E+05   3.49E+04   24.14    7.63     1.4
+   1       1000     1.097E+05   2.99E+04   27.25    8.62     1.2
 |-----------------------------------------------------------------------------|
-   1       1000     1.444E+05   3.49E+04   24.14    7.63     1.4
+   1       1000     1.097E+05   2.99E+04   27.25    8.62     1.2
 |=============================================================================|
 ?epa_handler = true
 $epa_handler_mode = "recoil"
 n_events = 100
 | Starting simulation for process 'epa_2a'
 | Simulate: using integration grids from file 'epa_2a.m1.vg'
 | Simulate: activating EPA handler
 | Simulate: ISR/EPA handler mode: pair recoil
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Simulation: requested number of events = 100
-|             corr. to luminosity [fb-1] =   6.9234E-04
+|             corr. to luminosity [fb-1] =   9.1189E-04
 | Events: writing to raw file 'epa_2a.evx'
 | Events: generating 100 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
-| Events: actual unweighting efficiency =   0.96 %
-Warning: Encountered events with excess weight: 14 events ( 14.000 %)
-| Maximum excess weight = 1.190E+01
-| Average excess weight = 2.949E-01
+| Events: actual unweighting efficiency =   0.84 %
+Warning: Encountered events with excess weight: 12 events ( 12.000 %)
+| Maximum excess weight = 1.215E+01
+| Average excess weight = 3.097E-01
 | Events: closing raw file 'epa_2a.evx'
 $out_file = "epa_2a.dat"
 | Opening file 'epa_2a.dat' for output
 | Writing analysis data to file 'epa_2a.dat'
 | Closing file 'epa_2a.dat' for output
 | There were no errors and    1 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
 Event breakdown:
   Q < Qmax: 100
   Q > Qmax:   0
Index: trunk/share/tests/functional_tests/ref-output-double/ilc.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-double/ilc.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-double/ilc.ref	(revision 8371)
@@ -1,338 +1,338 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?pacify = true
 | Process library 'ilc_lib': recorded process 'ilc_zh'
 | Process library 'ilc_lib': recorded process 'ilc_ww'
 | Process library 'ilc_lib': compiling ...
 | Process library 'ilc_lib': writing makefile
 | Process library 'ilc_lib': removing old files
 | Process library 'ilc_lib': writing driver
 | Process library 'ilc_lib': creating source code
 | Process library 'ilc_lib': compiling sources
 | Process library 'ilc_lib': linking
 | Process library 'ilc_lib': loading
 | Process library 'ilc_lib': ... success.
 seed = 1
 sqrts =  5.00000E+02
 openmp_num_threads = 1
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     5.807E+01   1.78E+00    3.06    0.31    76.1
 |-----------------------------------------------------------------------------|
    1        100     5.807E+01   1.78E+00    3.06    0.31    76.1
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+ => isr
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 | Beam structure: isr, none => none, isr
 | Beam structure: 1 channels, 2 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     6.267E+01   2.33E+00    3.72    0.37    50.5
 |-----------------------------------------------------------------------------|
    1        100     6.267E+01   2.33E+00    3.72    0.37    50.5
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+ => circe1
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 4
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 | Beam structure: circe1
 | Beam structure: 1 channels, 0 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     6.003E+01   1.69E+00    2.82    0.28    68.8
 |-----------------------------------------------------------------------------|
    1        100     6.003E+01   1.69E+00    2.82    0.28    68.8
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 5
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+ => circe1 => isr
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 6
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 | Beam structure: circe1 => isr, none => none, isr
 | Beam structure: 1 channels, 2 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     6.483E+01   2.50E+00    3.85    0.39    54.3
 |-----------------------------------------------------------------------------|
    1        100     6.483E+01   2.50E+00    3.85    0.39    54.3
 |=============================================================================|
 epa_x_min =  1.00000E-01
 epa_mass =  5.10997E-04
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 7
 | Initializing integration for process ilc_ww:
 | Beam structure: e-, e+ => epa
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_ww.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_ww'
 |   Library name  = 'ilc_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'ilc_ww_i1':   A, A => W+, W- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_ww'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 4 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        100     1.781E+02   2.29E+01   12.84    1.28    29.4
+   1        100     1.783E+02   2.29E+01   12.86    1.29    29.3
 |-----------------------------------------------------------------------------|
-   1        100     1.781E+02   2.29E+01   12.84    1.28    29.4
+   1        100     1.783E+02   2.29E+01   12.86    1.29    29.3
 |=============================================================================|
 $circe2_file = "teslagg_500.circe"
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 8
 | Initializing integration for process ilc_ww:
 | Beam structure: A, A => circe2
 | Beam data (collision):
 |   A  (mass = 0.0000000E+00 GeV)
 |   A  (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE2: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 9
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_ww.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_ww'
 |   Library name  = 'ilc_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'ilc_ww_i1':   A, A => W+, W- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe2
 | Beam structure: 1 channels, 0 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_ww'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 4 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     1.830E+04   3.27E+03   17.88    1.79    18.7
 |-----------------------------------------------------------------------------|
    1        100     1.830E+04   3.27E+03   17.88    1.79    18.7
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 10
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+ => energy_scan
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 | Beam structure: energy_scan
 | Beam structure: 1 channels, 1 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     3.942E+04   3.95E+03   10.02    1.00    31.0
 |-----------------------------------------------------------------------------|
    1        100     3.942E+04   3.95E+03   10.02    1.00    31.0
 |=============================================================================|
 $beam_events_file = "uniform_spread_2.5%.dat"
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 11
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+ => beam_events
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 | Beam structure: beam_events
 | Beam structure: 1 channels, 0 dimensions
 Warning: No cuts have been defined.
 | Beam events: reading from file 'uniform_spread_2.5%.dat'
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     5.707E+01   1.74E+00    3.05    0.30    71.5
 |-----------------------------------------------------------------------------|
    1        100     5.707E+01   1.74E+00    3.05    0.30    71.5
 |=============================================================================|
 | Beam events: closed file 'uniform_spread_2.5%.dat'
 | There were no errors and    8 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-double/ep_2.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-double/ep_2.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-double/ep_2.ref	(revision 8371)
@@ -1,220 +1,220 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 $method = "omega"
 | Process library 'ep_2_lib': recorded process 'ep_2_p1'
 | Process library 'ep_2_lib': recorded process 'ep_2_p2'
 | Process library 'ep_2_lib': recorded process 'ep_2_q1'
 | Process library 'ep_2_lib': recorded process 'ep_2_q2'
 seed = 0
 | Process library 'ep_2_lib': compiling ...
 | Process library 'ep_2_lib': writing makefile
 | Process library 'ep_2_lib': removing old files
 | Process library 'ep_2_lib': writing driver
 | Process library 'ep_2_lib': creating source code
 | Process library 'ep_2_lib': compiling sources
 | Process library 'ep_2_lib': linking
 | Process library 'ep_2_lib': loading
 | Process library 'ep_2_lib': ... success.
 $phs_method = "wood"
 $integration_method = "vamp"
 sqrts =  5.000000000000E+02
 openmp_num_threads = 1
 [user variable] n = 1000
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process ep_2_p1:
 | Beam structure: A, p => none, pdf_builtin
 | Beam data (collision):
 |   A  (mass = 0.0000000E+00 GeV)
 |   p  (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Initialized builtin PDF CTEQ6L
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ep_2_p1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ep_2_p1'
 |   Library name  = 'ep_2_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ep_2_p1_i1':   A, u => A, u [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: none, pdf_builtin
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'ep_2_p1'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  3.8616031E+04  8.51E+03   22.04    6.97*   1.19
    2        999  2.7857398E+04  1.78E+03    6.38    2.02*   5.08
    3        999  3.0216543E+04  9.45E+02    3.13    0.99*  18.37
    4        999  2.9325633E+04  6.18E+02    2.11    0.67*  27.51
    5        999  2.9745325E+04  5.38E+02    1.81    0.57*  29.57
 |-----------------------------------------------------------------------------|
    5       4995  2.9606237E+04  3.65E+02    1.23    0.87   29.57    0.69   5
 |-----------------------------------------------------------------------------|
    6        999  3.0455669E+04  5.73E+02    1.88    0.59   17.92
    7        999  3.0224269E+04  5.49E+02    1.82    0.57*  17.79
    8        999  2.8109698E+04  5.53E+02    1.97    0.62   16.54
 |-----------------------------------------------------------------------------|
    8       2997  2.9579653E+04  3.22E+02    1.09    0.60   16.54    5.39   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Initializing integration for process ep_2_q1:
 | Beam structure: p, A => pdf_builtin, none
 | Beam data (collision):
 |   p  (mass = 0.0000000E+00 GeV)
 |   A  (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ep_2_q1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ep_2_q1'
 |   Library name  = 'ep_2_lib'
 |   Process index = 3
 |   Process components:
 |     1: 'ep_2_q1_i1':   u, A => A, u [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: pdf_builtin, none
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'ep_2_q1'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  2.2336268E+04  4.60E+03   20.58    6.50*   1.16
    2        999  2.8528596E+04  1.83E+03    6.42    2.03*   6.51
    3        999  3.0843141E+04  9.52E+02    3.09    0.98*  14.57
    4        999  2.9185732E+04  7.06E+02    2.42    0.76*  13.28
    5        999  2.9596313E+04  5.77E+02    1.95    0.62*  26.31
 |-----------------------------------------------------------------------------|
    5       4995  2.9579008E+04  3.94E+02    1.33    0.94   26.31    1.22   5
 |-----------------------------------------------------------------------------|
    6        999  2.8623331E+04  5.70E+02    1.99    0.63   22.46
    7        999  2.8920442E+04  5.73E+02    1.98    0.63*  21.85
    8        999  2.8297972E+04  5.53E+02    1.96    0.62*  21.38
 |-----------------------------------------------------------------------------|
    8       2997  2.8606415E+04  3.26E+02    1.14    0.62   21.38    0.31   3
 |=============================================================================|
 epa_x_min =  1.000000000000E-01
 epa_mass =  5.109970000000E-04
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process ep_2_p2:
 | Beam structure: e-, p => epa, pdf_builtin
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   p   (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ep_2_p2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ep_2_p2'
 |   Library name  = 'ep_2_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'ep_2_p2_i1':   A, u => A, u [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, pdf_builtin
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'ep_2_p2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  2.0971640E+03  2.61E+02   12.42    3.93*   2.66
-   2        999  2.3639786E+03  1.37E+02    5.80    1.83*   5.50
-   3        999  2.5365100E+03  1.08E+02    4.27    1.35*  10.56
-   4        999  2.4062099E+03  9.43E+01    3.92    1.24*  13.50
-   5        999  2.3485461E+03  8.33E+01    3.55    1.12*  16.31
-|-----------------------------------------------------------------------------|
-   5       4995  2.3965231E+03  4.94E+01    2.06    1.46   16.31    0.85   5
-|-----------------------------------------------------------------------------|
-   6        999  2.3183838E+03  8.26E+01    3.56    1.13   13.20
-   7        999  2.2765332E+03  8.16E+01    3.59    1.13   12.15
-   8        999  2.2944443E+03  8.68E+01    3.79    1.20    9.37
+   1        999  2.0996710E+03  2.61E+02   12.43    3.93*   2.66
+   2        999  2.3606296E+03  1.37E+02    5.80    1.83*   5.55
+   3        999  2.5328780E+03  1.08E+02    4.27    1.35*  10.60
+   4        999  2.4528978E+03  9.87E+01    4.02    1.27*  11.27
+   5        999  2.3358734E+03  8.25E+01    3.53    1.12*  17.21
+|-----------------------------------------------------------------------------|
+   5       4995  2.4021080E+03  4.98E+01    2.07    1.47   17.21    0.95   5
+|-----------------------------------------------------------------------------|
+   6        999  2.3192755E+03  8.39E+01    3.62    1.14   14.92
+   7        999  2.2511873E+03  8.05E+01    3.58    1.13*  12.98
+   8        999  2.2793484E+03  8.48E+01    3.72    1.18   10.80
 |-----------------------------------------------------------------------------|
-   8       2997  2.2963643E+03  4.83E+01    2.10    1.15    9.37    0.07   3
+   8       2997  2.2823951E+03  4.79E+01    2.10    1.15   10.80    0.17   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Initializing integration for process ep_2_q2:
 | Beam structure: p, e- => pdf_builtin, epa
 | Beam data (collision):
 |   p   (mass = 0.0000000E+00 GeV)
 |   e-  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ep_2_q2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ep_2_q2'
 |   Library name  = 'ep_2_lib'
 |   Process index = 4
 |   Process components:
 |     1: 'ep_2_q2_i1':   u, A => A, u [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: pdf_builtin, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'ep_2_q2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  2.5267593E+03  3.79E+02   15.01    4.74*   1.76
-   2        999  2.3238030E+03  1.12E+02    4.84    1.53*   8.11
-   3        999  2.2524251E+03  8.33E+01    3.70    1.17*  13.00
-   4        999  2.4213836E+03  8.58E+01    3.54    1.12*  14.30
-   5        999  2.2597607E+03  7.71E+01    3.41    1.08*  15.48
-|-----------------------------------------------------------------------------|
-   5       4995  2.3118379E+03  4.33E+01    1.87    1.32   15.48    0.73   5
-|-----------------------------------------------------------------------------|
-   6        999  2.2015100E+03  7.46E+01    3.39    1.07*  14.79
-   7        999  2.2685604E+03  7.71E+01    3.40    1.07   15.16
-   8        999  2.3794253E+03  8.01E+01    3.37    1.06*  15.18
+   1        999  2.5294262E+03  3.80E+02   15.03    4.75*   1.76
+   2        999  2.3270607E+03  1.13E+02    4.85    1.53*   8.10
+   3        999  2.2554892E+03  8.35E+01    3.70    1.17*  12.88
+   4        999  2.4205094E+03  8.59E+01    3.55    1.12*  14.28
+   5        999  2.2705193E+03  7.83E+01    3.45    1.09*  15.03
+|-----------------------------------------------------------------------------|
+   5       4995  2.3167919E+03  4.35E+01    1.88    1.33   15.03    0.67   5
+|-----------------------------------------------------------------------------|
+   6        999  2.2113811E+03  7.60E+01    3.44    1.09*  14.61
+   7        999  2.2480812E+03  7.67E+01    3.41    1.08*  14.73
+   8        999  2.4005326E+03  8.12E+01    3.38    1.07*  15.00
 |-----------------------------------------------------------------------------|
-   8       2997  2.2789778E+03  4.45E+01    1.95    1.07   15.18    1.33   3
+   8       2997  2.2819411E+03  4.50E+01    1.97    1.08   15.00    1.59   3
 |=============================================================================|
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-double/circe1_photons_1.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-double/circe1_photons_1.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-double/circe1_photons_1.ref	(revision 8371)
@@ -1,227 +1,227 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 $method = "omega"
 | Process library 'circe1_photons_1_lib': recorded process 'circe1_photons_1_p1'
 | Process library 'circe1_photons_1_lib': recorded process 'circe1_photons_1_p2'
 | Process library 'circe1_photons_1_lib': recorded process 'circe1_photons_1_p3'
 | Process library 'circe1_photons_1_lib': recorded process 'circe1_photons_1_p4'
 seed = 0
 | Process library 'circe1_photons_1_lib': compiling ...
 | Process library 'circe1_photons_1_lib': writing makefile
 | Process library 'circe1_photons_1_lib': removing old files
 | Process library 'circe1_photons_1_lib': writing driver
 | Process library 'circe1_photons_1_lib': creating source code
 | Process library 'circe1_photons_1_lib': compiling sources
 | Process library 'circe1_photons_1_lib': linking
 | Process library 'circe1_photons_1_lib': loading
 | Process library 'circe1_photons_1_lib': ... success.
 $phs_method = "wood"
 $integration_method = "vamp"
 sqrts =  5.000000000000E+02
 openmp_num_threads = 1
 [user variable] n = 1000
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process circe1_photons_1_p1:
 | Beam structure: [any particles]
 | Beam data (collision):
 |   A  (mass = 0.0000000E+00 GeV)
 |   A  (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_1_p1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_1_p1'
 |   Library name  = 'circe1_photons_1_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'circe1_photons_1_p1_i1':   A, A => m-, m+ [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_1_p1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 1 chains, 4 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        800  7.2013796E+03  8.03E+01    1.12    0.32*  59.65
    2        800  7.1156829E+03  7.28E+01    1.02    0.29*  25.90
    3        800  7.1457172E+03  5.40E+01    0.76    0.21*  40.03
 |-----------------------------------------------------------------------------|
    3       2400  7.1500260E+03  3.81E+01    0.53    0.26   40.03    0.32   3
 |-----------------------------------------------------------------------------|
    4        800  7.1750086E+03  4.75E+01    0.66    0.19*  40.14
    5        800  7.0045848E+03  5.01E+01    0.71    0.20   39.19
    6        800  7.1951189E+03  5.08E+01    0.71    0.20*  40.12
 |-----------------------------------------------------------------------------|
    6       2400  7.1260940E+03  2.85E+01    0.40    0.20   40.12    4.40   3
 |=============================================================================|
 epa_x_min =  1.000000000000E-01
 epa_mass =  5.110000000000E-04
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Initializing integration for process circe1_photons_1_p2:
 | Beam structure: e-, e+ => epa
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)
 |   e+  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_1_p2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_1_p2'
 |   Library name  = 'circe1_photons_1_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'circe1_photons_1_p2_i1':   A, A => m-, m+ [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_1_p2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 1 chains, 4 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1       1000  6.5288858E+02  2.50E+01    3.83    1.21*  14.21
-   2       1000  6.4308014E+02  9.67E+00    1.50    0.48*  40.19
-   3       1000  6.3142989E+02  9.32E+00    1.48    0.47*  36.51
-   4       1000  6.3406600E+02  9.33E+00    1.47    0.47*  32.71
-   5       1000  6.1046577E+02  9.24E+00    1.51    0.48   43.55
-|-----------------------------------------------------------------------------|
-   5       5000  6.3023693E+02  4.61E+00    0.73    0.52   43.55    1.84   5
-|-----------------------------------------------------------------------------|
-   6       1000  6.2475239E+02  9.51E+00    1.52    0.48   33.76
-   7       1000  6.1910576E+02  9.40E+00    1.52    0.48*  32.43
-   8       1000  6.3347071E+02  9.28E+00    1.47    0.46*  33.08
+   1       1000  6.5293943E+02  2.49E+01    3.81    1.21*  14.29
+   2       1000  6.4337581E+02  9.66E+00    1.50    0.47*  40.22
+   3       1000  6.3169751E+02  9.32E+00    1.48    0.47*  36.53
+   4       1000  6.3418223E+02  9.34E+00    1.47    0.47*  32.71
+   5       1000  6.1042585E+02  9.23E+00    1.51    0.48   43.61
+|-----------------------------------------------------------------------------|
+   5       5000  6.3038741E+02  4.61E+00    0.73    0.52   43.61    1.87   5
+|-----------------------------------------------------------------------------|
+   6       1000  6.2481366E+02  9.50E+00    1.52    0.48   33.80
+   7       1000  6.1894270E+02  9.40E+00    1.52    0.48*  32.42
+   8       1000  6.3193035E+02  9.26E+00    1.46    0.46*  33.00
 |-----------------------------------------------------------------------------|
-   8       3000  6.2585132E+02  5.43E+00    0.87    0.47   33.08    0.60   3
+   8       3000  6.2530116E+02  5.42E+00    0.87    0.47   33.00    0.49   3
 |=============================================================================|
 $circe1_acc = "TESLA"
 circe1_chat = 2
 ?circe1_generate = true
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process circe1_photons_1_p3:
 | Beam structure: e-, e+ => circe1 => epa
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)
 |   e+  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_1_p3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_1_p3'
 |   Library name  = 'circe1_photons_1_lib'
 |   Process index = 3
 |   Process components:
 |     1: 'circe1_photons_1_p3_i1':   A, A => m-, m+ [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => epa, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_1_p3'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 1 chains, 4 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1       1000  5.9727301E+02  2.32E+01    3.89    1.23*  15.16
-   2       1000  6.4830974E+02  1.06E+01    1.63    0.51*  40.30
-   3       1000  6.5061319E+02  9.39E+00    1.44    0.46*  31.45
-   4       1000  6.4633994E+02  9.80E+00    1.52    0.48   26.65
-   5       1000  6.4932002E+02  9.09E+00    1.40    0.44*  41.16
-|-----------------------------------------------------------------------------|
-   5       5000  6.4659613E+02  4.73E+00    0.73    0.52   41.16    1.20   5
-|-----------------------------------------------------------------------------|
-   6       1000  6.3854940E+02  9.24E+00    1.45    0.46   33.09
-   7       1000  6.4749417E+02  9.09E+00    1.40    0.44*  31.15
-   8       1000  6.4063320E+02  8.90E+00    1.39    0.44*  30.82
+   1       1000  5.9763043E+02  2.32E+01    3.88    1.23*  15.24
+   2       1000  6.4856263E+02  1.05E+01    1.63    0.51*  40.37
+   3       1000  6.5090899E+02  9.39E+00    1.44    0.46*  31.46
+   4       1000  6.4671784E+02  9.80E+00    1.52    0.48   26.66
+   5       1000  6.4818885E+02  9.10E+00    1.40    0.44*  41.39
+|-----------------------------------------------------------------------------|
+   5       5000  6.4650924E+02  4.73E+00    0.73    0.52   41.39    1.18   5
+|-----------------------------------------------------------------------------|
+   6       1000  6.3913110E+02  9.25E+00    1.45    0.46   33.12
+   7       1000  6.4761237E+02  9.09E+00    1.40    0.44*  31.17
+   8       1000  6.4069364E+02  8.90E+00    1.39    0.44*  30.84
 |-----------------------------------------------------------------------------|
-   8       3000  6.4224167E+02  5.24E+00    0.82    0.45   30.82    0.26   3
+   8       3000  6.4248925E+02  5.24E+00    0.82    0.45   30.84    0.25   3
 |=============================================================================|
 [user variable] n = 1000
 ?circe1_photon1 = true
 ?circe1_photon2 = true
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 4
 | Initializing integration for process circe1_photons_1_p4:
 | Beam structure: e-, e+ => circe1
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)
 |   e+  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 5
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_1_p4.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_1_p4'
 |   Library name  = 'circe1_photons_1_lib'
 |   Process index = 4
 |   Process components:
 |     1: 'circe1_photons_1_p4_i1':   A, A => m-, m+ [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1
 | Beam structure: 1 channels, 0 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_1_p4'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 1 chains, 4 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        800  7.9004458E+03  2.81E+03   35.63   10.08*   0.94
    2        800  2.1176515E+03  1.09E+03   51.28   14.50    0.60
    3        800  4.3831108E+03  1.44E+03   32.75    9.26*   1.08
    4        800  7.8541264E+03  3.94E+03   50.13   14.18    0.71
    5        800  4.7989410E+03  2.04E+03   42.52   12.03*   0.77
 |-----------------------------------------------------------------------------|
    5       4000  3.7294400E+03  7.53E+02   20.19   12.77    0.77    1.49   5
 |-----------------------------------------------------------------------------|
    6        800  5.0242330E+03  2.61E+03   52.04   14.72    0.55
    7        800  8.7251882E+03  2.77E+03   31.71    8.97*   0.73
    8        800  5.0432242E+03  2.13E+03   42.15   11.92    0.42
 |-----------------------------------------------------------------------------|
    8       2400  6.0030746E+03  1.42E+03   23.60   11.56    0.42    0.66   3
 |=============================================================================|
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-double/circe1_photons_2.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-double/circe1_photons_2.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-double/circe1_photons_2.ref	(revision 8371)
@@ -1,172 +1,172 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 $method = "omega"
 | Process library 'circe1_photons_2_lib': recorded process 'circe1_photons_2_p1'
 | Process library 'circe1_photons_2_lib': recorded process 'circe1_photons_2_p2'
 | Process library 'circe1_photons_2_lib': recorded process 'circe1_photons_2_p3'
 seed = 0
 | Process library 'circe1_photons_2_lib': compiling ...
 | Process library 'circe1_photons_2_lib': writing makefile
 | Process library 'circe1_photons_2_lib': removing old files
 | Process library 'circe1_photons_2_lib': writing driver
 | Process library 'circe1_photons_2_lib': creating source code
 | Process library 'circe1_photons_2_lib': compiling sources
 | Process library 'circe1_photons_2_lib': linking
 | Process library 'circe1_photons_2_lib': loading
 | Process library 'circe1_photons_2_lib': ... success.
 $phs_method = "wood"
 $integration_method = "vamp"
 sqrts =  5.000000000000E+02
 openmp_num_threads = 1
 [user variable] n = 1000
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process circe1_photons_2_p1:
 | Beam structure: [any particles]
 | Beam data (collision):
 |   A  (mass = 0.0000000E+00 GeV)
 |   A  (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_2_p1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_2_p1'
 |   Library name  = 'circe1_photons_2_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'circe1_photons_2_p1_i1':   A, A => b, bbar [omega]
 | ------------------------------------------------------------------------
 | Phase space: 5 channels, 2 dimensions
 | Phase space: found 5 channels, collected in 2 groves.
 | Phase space: Using 9 equivalences between channels.
 | Phase space: wood
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_2_p1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 5 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1       1000  2.7865916E+02  2.95E+00    1.06    0.34*  56.03
    2       1000  2.7849276E+02  2.31E+00    0.83    0.26*  40.36
    3       1000  2.7851341E+02  2.00E+00    0.72    0.23*  43.86
 |-----------------------------------------------------------------------------|
    3       3000  2.7853666E+02  1.35E+00    0.48    0.26   43.86    0.00   3
 |-----------------------------------------------------------------------------|
    4       1000  2.7239954E+02  2.03E+00    0.75    0.24   42.16
    5       1000  2.7384472E+02  2.36E+00    0.86    0.27   41.89
    6       1000  2.7457965E+02  2.18E+00    0.79    0.25*  41.92
 |-----------------------------------------------------------------------------|
    6       3000  2.7353474E+02  1.26E+00    0.46    0.25   41.92    0.28   3
 |=============================================================================|
 epa_x_min =  1.000000000000E-01
 epa_mass =  5.109970000000E-04
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Initializing integration for process circe1_photons_2_p2:
 | Beam structure: e-, e+ => epa
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_2_p2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_2_p2'
 |   Library name  = 'circe1_photons_2_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'circe1_photons_2_p2_i1':   A, A => b, bbar [omega]
 | ------------------------------------------------------------------------
 | Phase space: 5 channels, 2 dimensions
 | Phase space: found 5 channels, collected in 2 groves.
 | Phase space: Using 9 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, epa
 | Beam structure: 2 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_2_p2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 5 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1       1000  2.7423868E+01  1.14E+00    4.16    1.32*  16.28
-   2       1000  2.6507221E+01  4.34E-01    1.64    0.52*  41.31
-   3       1000  2.6309619E+01  4.37E-01    1.66    0.52   33.28
-   4       1000  2.6283528E+01  4.01E-01    1.52    0.48*  40.09
-   5       1000  2.5225994E+01  4.17E-01    1.65    0.52   41.26
-|-----------------------------------------------------------------------------|
-   5       5000  2.6117343E+01  2.07E-01    0.79    0.56   41.26    1.76   5
-|-----------------------------------------------------------------------------|
-   6       1000  2.5943285E+01  4.19E-01    1.61    0.51*  37.91
-   7       1000  2.6152644E+01  4.39E-01    1.68    0.53   31.92
-   8       1000  2.6279144E+01  4.20E-01    1.60    0.51*  28.97
+   1       1000  2.7443889E+01  1.14E+00    4.14    1.31*  16.37
+   2       1000  2.6524911E+01  4.34E-01    1.64    0.52*  41.36
+   3       1000  2.6310876E+01  4.36E-01    1.66    0.52   33.30
+   4       1000  2.6299155E+01  4.00E-01    1.52    0.48*  40.12
+   5       1000  2.5227508E+01  4.17E-01    1.65    0.52   41.70
+|-----------------------------------------------------------------------------|
+   5       5000  2.6127298E+01  2.07E-01    0.79    0.56   41.70    1.80   5
+|-----------------------------------------------------------------------------|
+   6       1000  2.5951035E+01  4.18E-01    1.61    0.51*  37.95
+   7       1000  2.6089287E+01  4.38E-01    1.68    0.53   31.83
+   8       1000  2.6295050E+01  4.20E-01    1.60    0.50*  28.97
 |-----------------------------------------------------------------------------|
-   8       3000  2.6123751E+01  2.46E-01    0.94    0.52   28.97    0.16   3
+   8       3000  2.6112023E+01  2.45E-01    0.94    0.51   28.97    0.17   3
 |=============================================================================|
 $circe1_acc = "TESLA"
 circe1_chat = 2
 ?circe1_generate = true
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process circe1_photons_2_p3:
 | Beam structure: e-, e+ => circe1 => epa
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_2_p3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_2_p3'
 |   Library name  = 'circe1_photons_2_lib'
 |   Process index = 3
 |   Process components:
 |     1: 'circe1_photons_2_p3_i1':   A, A => b, bbar [omega]
 | ------------------------------------------------------------------------
 | Phase space: 5 channels, 2 dimensions
 | Phase space: found 5 channels, collected in 2 groves.
 | Phase space: Using 9 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => epa, none => none, epa
 | Beam structure: 2 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_2_p3'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 5 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1       1000  2.5269378E+01  1.07E+00    4.24    1.34*  15.25
-   2       1000  2.7105504E+01  4.74E-01    1.75    0.55*  38.78
-   3       1000  2.6982652E+01  4.29E-01    1.59    0.50*  30.09
-   4       1000  2.6741590E+01  4.65E-01    1.74    0.55   26.96
-   5       1000  2.6961428E+01  4.32E-01    1.60    0.51*  37.71
-|-----------------------------------------------------------------------------|
-   5       5000  2.6877827E+01  2.20E-01    0.82    0.58   37.71    0.67   5
-|-----------------------------------------------------------------------------|
-   6       1000  2.6729330E+01  4.33E-01    1.62    0.51   33.26
-   7       1000  2.6654538E+01  4.02E-01    1.51    0.48*  33.17
-   8       1000  2.7181659E+01  4.16E-01    1.53    0.48   33.83
+   1       1000  2.5299075E+01  1.07E+00    4.22    1.33*  15.34
+   2       1000  2.7101306E+01  4.73E-01    1.75    0.55*  38.79
+   3       1000  2.6931455E+01  4.30E-01    1.60    0.50*  30.01
+   4       1000  2.6679340E+01  4.65E-01    1.74    0.55   26.98
+   5       1000  2.6932111E+01  4.31E-01    1.60    0.51*  37.58
+|-----------------------------------------------------------------------------|
+   5       5000  2.6843029E+01  2.20E-01    0.82    0.58   37.58    0.65   5
+|-----------------------------------------------------------------------------|
+   6       1000  2.6713104E+01  4.31E-01    1.61    0.51   33.22
+   7       1000  2.6638032E+01  4.04E-01    1.52    0.48*  33.13
+   8       1000  2.7123651E+01  4.13E-01    1.52    0.48   33.73
 |-----------------------------------------------------------------------------|
-   8       3000  2.6854056E+01  2.40E-01    0.90    0.49   33.83    0.48   3
+   8       3000  2.6825223E+01  2.40E-01    0.89    0.49   33.73    0.40   3
 |=============================================================================|
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-double/circe1_photons_4.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-double/circe1_photons_4.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-double/circe1_photons_4.ref	(revision 8371)
@@ -1,405 +1,405 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 $method = "omega"
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_p1'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_p2'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_p3'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_p4'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_q1'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_q2'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_q3'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_q4'
 seed = 0
 | Process library 'circe1_photons_4_lib': compiling ...
 | Process library 'circe1_photons_4_lib': writing makefile
 | Process library 'circe1_photons_4_lib': removing old files
 | Process library 'circe1_photons_4_lib': writing driver
 | Process library 'circe1_photons_4_lib': creating source code
 | Process library 'circe1_photons_4_lib': compiling sources
 | Process library 'circe1_photons_4_lib': linking
 | Process library 'circe1_photons_4_lib': loading
 | Process library 'circe1_photons_4_lib': ... success.
 $phs_method = "wood"
 $integration_method = "vamp"
 sqrts =  5.000000000000E+02
 openmp_num_threads = 1
 [user variable] n = 1000
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process circe1_photons_4_p1:
 | Beam structure: [any particles]
 | Beam data (collision):
 |   A   (mass = 0.0000000E+00 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_p1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_p1'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'circe1_photons_4_p1_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_p1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        864  4.4544622E+03  4.86E+01    1.09    0.32*  27.39
    2        864  4.3162333E+03  3.73E+01    0.87    0.25*  30.78
    3        864  4.3681296E+03  2.11E+01    0.48    0.14*  55.81
 |-----------------------------------------------------------------------------|
    3       2592  4.3679259E+03  1.72E+01    0.39    0.20   55.81    2.54   3
 |-----------------------------------------------------------------------------|
    4        864  4.3145027E+03  2.50E+01    0.58    0.17   54.92
    5        864  4.3662593E+03  2.34E+01    0.54    0.16*  55.34
    6        864  4.3433271E+03  2.04E+01    0.47    0.14*  54.99
 |-----------------------------------------------------------------------------|
    6       2592  4.3426117E+03  1.31E+01    0.30    0.15   54.99    1.14   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Initializing integration for process circe1_photons_4_q1:
 | Beam structure: [any particles]
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   A   (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_q1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_q1'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 5
 |   Process components:
 |     1: 'circe1_photons_4_q1_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_q1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        864  4.2582932E+03  4.85E+01    1.14    0.34*  27.22
    2        864  4.3068621E+03  3.12E+01    0.73    0.21*  40.74
    3        864  4.3405439E+03  2.44E+01    0.56    0.17*  52.28
 |-----------------------------------------------------------------------------|
    3       2592  4.3183669E+03  1.79E+01    0.41    0.21   52.28    1.25   3
 |-----------------------------------------------------------------------------|
    4        864  4.3017340E+03  2.40E+01    0.56    0.16*  51.73
    5        864  4.3650485E+03  2.29E+01    0.53    0.15*  52.19
    6        864  4.3751988E+03  2.59E+01    0.59    0.17   52.28
 |-----------------------------------------------------------------------------|
    6       2592  4.3466493E+03  1.40E+01    0.32    0.16   52.28    2.68   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process circe1_photons_4_p2:
 | Beam structure: A, e- => none, isr
 | Beam data (collision):
 |   A   (mass = 0.0000000E+00 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_p2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_p2'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'circe1_photons_4_p2_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: none, isr
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_p2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  4.9839516E+03  2.75E+02    5.52    1.75*   5.10
    2        999  4.7090673E+03  1.07E+02    2.28    0.72*  17.19
    3        999  4.8907180E+03  8.31E+01    1.70    0.54*  19.55
    4        999  4.8542484E+03  6.25E+01    1.29    0.41*  25.11
    5        999  4.7981041E+03  5.45E+01    1.14    0.36*  36.22
 |-----------------------------------------------------------------------------|
    5       4995  4.8249994E+03  3.46E+01    0.72    0.51   36.22    0.65   5
 |-----------------------------------------------------------------------------|
    6        999  4.7915063E+03  5.37E+01    1.12    0.35*  31.87
    7        999  4.8489006E+03  5.08E+01    1.05    0.33*  32.25
    8        999  4.8264311E+03  5.28E+01    1.09    0.35   32.10
 |-----------------------------------------------------------------------------|
    8       2997  4.8233452E+03  3.03E+01    0.63    0.34   32.10    0.30   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Initializing integration for process circe1_photons_4_q2:
 | Beam structure: e+, A => isr, none
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   A   (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_q2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_q2'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 6
 |   Process components:
 |     1: 'circe1_photons_4_q2_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: isr, none
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_q2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  4.9588354E+03  1.64E+02    3.31    1.05*  21.07
    2        999  4.8493798E+03  1.17E+02    2.41    0.76*  10.42
    3        999  4.7706663E+03  7.58E+01    1.59    0.50*  20.35
    4        999  4.7290822E+03  6.62E+01    1.40    0.44*  26.62
    5        999  4.7813614E+03  5.84E+01    1.22    0.39*  27.92
 |-----------------------------------------------------------------------------|
    5       4995  4.7785777E+03  3.52E+01    0.74    0.52   27.92    0.54   5
 |-----------------------------------------------------------------------------|
    6        999  4.7815042E+03  5.62E+01    1.18    0.37*  23.71
    7        999  4.7549014E+03  5.97E+01    1.26    0.40   21.97
    8        999  4.7777871E+03  6.08E+01    1.27    0.40   22.08
 |-----------------------------------------------------------------------------|
    8       2997  4.7717426E+03  3.40E+01    0.71    0.39   22.08    0.06   3
 |=============================================================================|
 epa_x_min =  1.000000000000E-01
 epa_mass =  5.110000000000E-04
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 4
 | Initializing integration for process circe1_photons_4_p3:
 | Beam structure: e+, e- => epa, none
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_p3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_p3'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 3
 |   Process components:
 |     1: 'circe1_photons_4_p3_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_p3'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.3926717E+03  5.68E+01    4.08    1.29*  13.96
-   2        999  1.4432813E+03  2.25E+01    1.56    0.49*  34.82
-   3        999  1.4442731E+03  1.52E+01    1.05    0.33*  43.82
+   1        999  1.3931691E+03  5.67E+01    4.07    1.29*  14.00
+   2        999  1.4434319E+03  2.25E+01    1.56    0.49*  34.85
+   3        999  1.4441285E+03  1.52E+01    1.05    0.33*  43.82
 |-----------------------------------------------------------------------------|
-   3       2997  1.4415650E+03  1.23E+01    0.85    0.47   43.82    0.39   3
+   3       2997  1.4415344E+03  1.23E+01    0.85    0.47   43.82    0.38   3
 |-----------------------------------------------------------------------------|
-   4        999  1.4306159E+03  1.45E+01    1.01    0.32*  43.40
-   5        999  1.4686724E+03  1.42E+01    0.96    0.30*  44.56
-   6        999  1.4285169E+03  1.55E+01    1.09    0.34   43.34
+   4        999  1.4308992E+03  1.45E+01    1.01    0.32*  43.42
+   5        999  1.4660554E+03  1.42E+01    0.97    0.31*  44.48
+   6        999  1.4285759E+03  1.55E+01    1.09    0.34   43.35
 |-----------------------------------------------------------------------------|
-   6       2997  1.4436321E+03  8.48E+00    0.59    0.32   43.34    2.44   3
+   6       2997  1.4428169E+03  8.48E+00    0.59    0.32   43.35    2.11   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 5
 | Initializing integration for process circe1_photons_4_q3:
 | Beam structure: e+, e- => none, epa
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_q3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_q3'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 7
 |   Process components:
 |     1: 'circe1_photons_4_q3_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: none, epa
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_q3'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.4810514E+03  6.46E+01    4.36    1.38*  14.35
-   2        999  1.4604768E+03  2.05E+01    1.40    0.44*  44.89
-   3        999  1.4467172E+03  1.57E+01    1.08    0.34*  49.41
-   4        999  1.4471817E+03  1.35E+01    0.94    0.30*  51.92
-   5        999  1.4413587E+03  1.34E+01    0.93    0.29*  50.63
-|-----------------------------------------------------------------------------|
-   5       4995  1.4474781E+03  7.51E+00    0.52    0.37   50.63    0.22   5
-|-----------------------------------------------------------------------------|
-   6        999  1.4504120E+03  1.38E+01    0.95    0.30   49.59
-   7        999  1.4241650E+03  1.39E+01    0.98    0.31   47.97
-   8        999  1.4197089E+03  1.36E+01    0.96    0.30*  47.82
+   1        999  1.4809489E+03  6.45E+01    4.35    1.38*  14.39
+   2        999  1.4604257E+03  2.05E+01    1.40    0.44*  44.88
+   3        999  1.4468449E+03  1.57E+01    1.08    0.34*  49.44
+   4        999  1.4472144E+03  1.35E+01    0.94    0.30*  51.93
+   5        999  1.4419147E+03  1.34E+01    0.93    0.29*  50.51
+|-----------------------------------------------------------------------------|
+   5       4995  1.4476907E+03  7.51E+00    0.52    0.37   50.51    0.21   5
+|-----------------------------------------------------------------------------|
+   6        999  1.4503449E+03  1.38E+01    0.95    0.30   49.52
+   7        999  1.4244624E+03  1.39E+01    0.98    0.31   47.90
+   8        999  1.4197696E+03  1.36E+01    0.96    0.30*  47.74
 |-----------------------------------------------------------------------------|
-   8       2997  1.4313140E+03  7.95E+00    0.56    0.30   47.82    1.45   3
+   8       2997  1.4314109E+03  7.95E+00    0.56    0.30   47.74    1.43   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 6
 | Initializing integration for process circe1_photons_4_p4:
 | Beam structure: e+, e- => epa, isr
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_p4.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_p4'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 4
 |   Process components:
 |     1: 'circe1_photons_4_p4_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, isr
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_p4'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.5750317E+03  6.80E+01    4.32    1.36*  10.53
-   2        999  1.5184774E+03  2.37E+01    1.56    0.49*  33.45
-   3        999  1.5476682E+03  1.86E+01    1.20    0.38*  25.86
-   4        999  1.5339126E+03  1.99E+01    1.30    0.41   25.51
-   5        999  1.5354354E+03  1.95E+01    1.27    0.40*  25.54
-|-----------------------------------------------------------------------------|
-   5       4995  1.5364121E+03  9.98E+00    0.65    0.46   25.54    0.32   5
-|-----------------------------------------------------------------------------|
-   6        999  1.5352213E+03  2.18E+01    1.42    0.45   19.57
-   7        999  1.5263775E+03  1.88E+01    1.23    0.39*  19.46
-   8        999  1.5642549E+03  2.21E+01    1.41    0.45   17.47
+   1        999  1.5752080E+03  6.79E+01    4.31    1.36*  10.55
+   2        999  1.5182842E+03  2.37E+01    1.56    0.49*  33.45
+   3        999  1.5482501E+03  1.87E+01    1.21    0.38*  25.90
+   4        999  1.5342920E+03  1.99E+01    1.30    0.41   25.52
+   5        999  1.5326332E+03  1.94E+01    1.26    0.40*  25.40
+|-----------------------------------------------------------------------------|
+   5       4995  1.5358868E+03  9.97E+00    0.65    0.46   25.40    0.34   5
+|-----------------------------------------------------------------------------|
+   6        999  1.5320669E+03  2.18E+01    1.42    0.45   19.47
+   7        999  1.5278762E+03  1.88E+01    1.23    0.39*  19.42
+   8        999  1.5665346E+03  2.21E+01    1.41    0.45   17.51
 |-----------------------------------------------------------------------------|
-   8       2997  1.5401431E+03  1.20E+01    0.78    0.43   17.47    0.89   3
+   8       2997  1.5404523E+03  1.20E+01    0.78    0.43   17.51    0.99   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 7
 | Initializing integration for process circe1_photons_4_q4:
 | Beam structure: e+, e- => isr, epa
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_q4.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_q4'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 8
 |   Process components:
 |     1: 'circe1_photons_4_q4_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: isr, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_q4'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.5139845E+03  6.80E+01    4.49    1.42*  11.93
-   2        999  1.5854321E+03  2.61E+01    1.65    0.52*  25.14
-   3        999  1.5546049E+03  1.81E+01    1.16    0.37*  35.35
-   4        999  1.5085178E+03  1.67E+01    1.11    0.35*  37.31
-   5        999  1.5563063E+03  2.14E+01    1.37    0.43   20.35
-|-----------------------------------------------------------------------------|
-   5       4995  1.5426653E+03  9.75E+00    0.63    0.45   20.35    1.97   5
-|-----------------------------------------------------------------------------|
-   6        999  1.5242179E+03  1.89E+01    1.24    0.39*  15.07
-   7        999  1.5626322E+03  2.06E+01    1.32    0.42   15.12
-   8        999  1.5927273E+03  2.56E+01    1.61    0.51   14.85
+   1        999  1.5139686E+03  6.79E+01    4.49    1.42*  11.96
+   2        999  1.5852591E+03  2.61E+01    1.65    0.52*  25.17
+   3        999  1.5509582E+03  1.81E+01    1.16    0.37*  35.24
+   4        999  1.5071595E+03  1.67E+01    1.11    0.35*  37.10
+   5        999  1.5635419E+03  2.32E+01    1.48    0.47   16.14
+|-----------------------------------------------------------------------------|
+   5       4995  1.5420168E+03  9.90E+00    0.64    0.45   16.14    2.09   5
+|-----------------------------------------------------------------------------|
+   6        999  1.5249866E+03  1.87E+01    1.23    0.39*  12.60
+   7        999  1.5603531E+03  2.06E+01    1.32    0.42   12.60
+   8        999  1.5860535E+03  2.56E+01    1.61    0.51   12.40
 |-----------------------------------------------------------------------------|
-   8       2997  1.5534271E+03  1.22E+01    0.79    0.43   14.85    2.47   3
+   8       2997  1.5511994E+03  1.22E+01    0.78    0.43   12.40    2.01   3
 |=============================================================================|
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-double/circe1_photons_5.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-double/circe1_photons_5.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-double/circe1_photons_5.ref	(revision 8371)
@@ -1,446 +1,446 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 $method = "omega"
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_p1'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_p2'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_p3'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_p4'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_q1'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_q2'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_q3'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_q4'
 seed = 0
 | Process library 'circe1_photons_5_lib': compiling ...
 | Process library 'circe1_photons_5_lib': writing makefile
 | Process library 'circe1_photons_5_lib': removing old files
 | Process library 'circe1_photons_5_lib': writing driver
 | Process library 'circe1_photons_5_lib': creating source code
 | Process library 'circe1_photons_5_lib': compiling sources
 | Process library 'circe1_photons_5_lib': linking
 | Process library 'circe1_photons_5_lib': loading
 | Process library 'circe1_photons_5_lib': ... success.
 $phs_method = "wood"
 $integration_method = "vamp"
 sqrts =  5.000000000000E+02
 openmp_num_threads = 1
 [user variable] n = 1000
 $circe1_acc = "TESLA"
 circe1_chat = 2
 ?circe1_generate = true
 ?circe1_photon1 = true
 ?circe1_photon2 = false
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process circe1_photons_5_p1:
 | Beam structure: e+, e- => circe1
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_p1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_p1'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'circe1_photons_5_p1_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1
 | Beam structure: 1 channels, 0 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_p1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        864  3.3070912E+04  2.39E+03    7.22    2.12*   7.28
    2        864  3.4385791E+04  2.14E+03    6.21    1.83*  11.94
    3        864  3.5408781E+04  2.20E+03    6.22    1.83   12.31
 |-----------------------------------------------------------------------------|
    3       2592  3.4352695E+04  1.29E+03    3.76    1.91   12.31    0.26   3
 |-----------------------------------------------------------------------------|
    4        864  3.2892593E+04  2.06E+03    6.27    1.84   11.16
    5        864  3.1709123E+04  1.99E+03    6.27    1.84   10.76
    6        864  3.0778856E+04  1.90E+03    6.18    1.82*  10.44
 |-----------------------------------------------------------------------------|
    6       2592  3.1736416E+04  1.14E+03    3.60    1.83   10.44    0.28   3
 |=============================================================================|
 ?circe1_photon1 = false
 ?circe1_photon2 = true
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process circe1_photons_5_q1:
 | Beam structure: e+, e- => circe1
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_q1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_q1'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 5
 |   Process components:
 |     1: 'circe1_photons_5_q1_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1
 | Beam structure: 1 channels, 0 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_q1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        864  3.4490793E+04  2.45E+03    7.11    2.09*   8.22
    2        864  3.2967456E+04  2.02E+03    6.13    1.80*  11.48
    3        864  2.7228734E+04  1.78E+03    6.52    1.92   10.43
 |-----------------------------------------------------------------------------|
    3       2592  3.0818157E+04  1.17E+03    3.80    1.94   10.43    3.73   3
 |-----------------------------------------------------------------------------|
    4        864  3.3705996E+04  2.08E+03    6.17    1.81*  11.69
    5        864  3.3497693E+04  2.07E+03    6.19    1.82   10.96
    6        864  2.8262411E+04  1.86E+03    6.58    1.93    9.24
 |-----------------------------------------------------------------------------|
    6       2592  3.1550962E+04  1.15E+03    3.65    1.86    9.24    2.54   3
 |=============================================================================|
 ?circe1_photon1 = true
 ?circe1_photon2 = false
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 4
 | Initializing integration for process circe1_photons_5_p2:
 | Beam structure: e+, e- => circe1 => none, isr
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 5
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_p2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_p2'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'circe1_photons_5_p2_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => none, isr
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_p2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  3.5258516E+04  2.65E+03    7.52    2.38*   7.40
    2        999  3.2056745E+04  1.94E+03    6.05    1.91*  11.25
    3        999  2.7573358E+04  1.82E+03    6.62    2.09    9.77
    4        999  3.1811769E+04  1.92E+03    6.03    1.90*  10.15
    5        999  2.9680458E+04  1.88E+03    6.35    2.01   10.36
 |-----------------------------------------------------------------------------|
    5       4995  3.0767704E+04  8.90E+02    2.89    2.04   10.36    1.75   5
 |-----------------------------------------------------------------------------|
    6        999  2.8021040E+04  1.75E+03    6.24    1.97*   9.21
    7        999  2.8260962E+04  1.76E+03    6.23    1.97*   9.29
    8        999  3.1015957E+04  1.89E+03    6.10    1.93*  10.19
 |-----------------------------------------------------------------------------|
    8       2997  2.9005449E+04  1.04E+03    3.58    1.96   10.19    0.81   3
 |=============================================================================|
 ?circe1_photon1 = false
 ?circe1_photon2 = true
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 6
 | Initializing integration for process circe1_photons_5_q2:
 | Beam structure: e+, e- => circe1 => isr, none
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 7
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_q2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_q2'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 6
 |   Process components:
 |     1: 'circe1_photons_5_q2_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => isr, none
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_q2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  2.6877249E+04  2.23E+03    8.29    2.62*   5.53
    2        999  3.1482465E+04  1.93E+03    6.13    1.94*  11.62
    3        999  2.8938754E+04  1.73E+03    5.98    1.89*  11.20
    4        999  3.4533249E+04  1.99E+03    5.77    1.83*   9.84
    5        999  3.2308188E+04  1.82E+03    5.65    1.78*  10.58
 |-----------------------------------------------------------------------------|
    5       4995  3.0920270E+04  8.59E+02    2.78    1.96   10.58    2.14   5
 |-----------------------------------------------------------------------------|
    6        999  3.0225138E+04  1.88E+03    6.23    1.97    9.53
    7        999  3.3248488E+04  1.95E+03    5.86    1.85*   8.87
    8        999  2.8118941E+04  1.78E+03    6.33    2.00    7.30
 |-----------------------------------------------------------------------------|
    8       2997  3.0378435E+04  1.08E+03    3.55    1.94    7.30    1.89   3
 |=============================================================================|
 epa_x_min =  1.000000000000E-01
 epa_mass =  5.110000000000E-04
 ?circe1_photon1 = false
 ?circe1_photon2 = false
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 8
 | Initializing integration for process circe1_photons_5_p3:
 | Beam structure: e+, e- => circe1 => epa, none
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 9
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_p3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_p3'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 3
 |   Process components:
 |     1: 'circe1_photons_5_p3_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => epa, none
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_p3'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.5374487E+03  6.77E+01    4.40    1.39*  12.99
-   2        999  1.4625554E+03  2.31E+01    1.58    0.50*  43.59
-   3        999  1.4383331E+03  1.58E+01    1.10    0.35*  55.82
+   1        999  1.5371464E+03  6.76E+01    4.40    1.39*  13.01
+   2        999  1.4629753E+03  2.31E+01    1.58    0.50*  43.62
+   3        999  1.4389660E+03  1.58E+01    1.10    0.35*  54.06
 |-----------------------------------------------------------------------------|
-   3       2997  1.4492975E+03  1.28E+01    0.88    0.48   55.82    1.26   3
+   3       2997  1.4498602E+03  1.28E+01    0.88    0.48   54.06    1.23   3
 |-----------------------------------------------------------------------------|
-   4        999  1.4851639E+03  1.40E+01    0.95    0.30*  55.37
-   5        999  1.4948870E+03  1.39E+01    0.93    0.29*  49.19
-   6        999  1.4751412E+03  1.51E+01    1.02    0.32   47.97
+   4        999  1.4852694E+03  1.40E+01    0.95    0.30*  55.45
+   5        999  1.4950285E+03  1.39E+01    0.93    0.29*  49.31
+   6        999  1.4755730E+03  1.51E+01    1.02    0.32   48.10
 |-----------------------------------------------------------------------------|
-   6       2997  1.4856046E+03  8.26E+00    0.56    0.30   47.97    0.47   3
+   6       2997  1.4858211E+03  8.25E+00    0.56    0.30   48.10    0.45   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 10
 | Initializing integration for process circe1_photons_5_q3:
 | Beam structure: e+, e- => circe1 => none, epa
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 11
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_q3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_q3'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 7
 |   Process components:
 |     1: 'circe1_photons_5_q3_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => none, epa
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_q3'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.4975346E+03  6.28E+01    4.19    1.33*  14.16
-   2        999  1.4859737E+03  2.20E+01    1.48    0.47*  41.11
-   3        999  1.4696684E+03  1.61E+01    1.10    0.35*  52.96
-   4        999  1.4473461E+03  1.46E+01    1.01    0.32*  55.54
-   5        999  1.4827502E+03  1.33E+01    0.90    0.28*  48.05
-|-----------------------------------------------------------------------------|
-   5       4995  1.4702775E+03  7.78E+00    0.53    0.37   48.05    1.01   5
-|-----------------------------------------------------------------------------|
-   6        999  1.4929148E+03  1.28E+01    0.86    0.27*  47.79
-   7        999  1.4963127E+03  1.76E+01    1.18    0.37   28.63
-   8        999  1.4581451E+03  1.41E+01    0.97    0.31*  27.90
+   1        999  1.4975662E+03  6.27E+01    4.19    1.32*  14.20
+   2        999  1.4861291E+03  2.20E+01    1.48    0.47*  41.15
+   3        999  1.4700230E+03  1.61E+01    1.10    0.35*  52.98
+   4        999  1.4477122E+03  1.46E+01    1.01    0.32*  55.52
+   5        999  1.4828759E+03  1.33E+01    0.90    0.28*  48.05
+|-----------------------------------------------------------------------------|
+   5       4995  1.4705271E+03  7.78E+00    0.53    0.37   48.05    1.00   5
+|-----------------------------------------------------------------------------|
+   6        999  1.4930120E+03  1.28E+01    0.86    0.27*  47.78
+   7        999  1.4962256E+03  1.76E+01    1.18    0.37   28.63
+   8        999  1.4580244E+03  1.41E+01    0.97    0.31*  27.90
 |-----------------------------------------------------------------------------|
-   8       2997  1.4814711E+03  8.35E+00    0.56    0.31   27.90    2.12   3
+   8       2997  1.4814459E+03  8.35E+00    0.56    0.31   27.90    2.14   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 12
 | Initializing integration for process circe1_photons_5_p4:
 | Beam structure: e+, e- => circe1 => epa, isr
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 13
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_p4.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_p4'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 4
 |   Process components:
 |     1: 'circe1_photons_5_p4_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => epa, none => none, isr
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_p4'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.5276000E+03  6.66E+01    4.36    1.38*  10.87
-   2        999  1.6030374E+03  2.93E+01    1.83    0.58*  31.66
-   3        999  1.5866605E+03  2.05E+01    1.29    0.41*  27.29
-   4        999  1.5875340E+03  1.90E+01    1.20    0.38*  32.44
-   5        999  1.5774237E+03  1.82E+01    1.15    0.36*  32.32
-|-----------------------------------------------------------------------------|
-   5       4995  1.5845953E+03  1.02E+01    0.64    0.46   32.32    0.33   5
-|-----------------------------------------------------------------------------|
-   6        999  1.5843668E+03  2.05E+01    1.30    0.41   24.53
-   7        999  1.5777881E+03  1.96E+01    1.24    0.39*  24.43
-   8        999  1.6096793E+03  1.78E+01    1.10    0.35*  24.92
+   1        999  1.5278174E+03  6.65E+01    4.35    1.38*  10.87
+   2        999  1.6030817E+03  2.92E+01    1.82    0.58*  31.65
+   3        999  1.5866878E+03  2.05E+01    1.29    0.41*  27.30
+   4        999  1.5862039E+03  1.91E+01    1.20    0.38*  32.34
+   5        999  1.5809117E+03  1.85E+01    1.17    0.37*  27.92
+|-----------------------------------------------------------------------------|
+   5       4995  1.5853787E+03  1.03E+01    0.65    0.46   27.92    0.29   5
+|-----------------------------------------------------------------------------|
+   6        999  1.5840381E+03  2.05E+01    1.30    0.41   24.54
+   7        999  1.5766025E+03  1.96E+01    1.24    0.39*  24.42
+   8        999  1.6085782E+03  1.77E+01    1.10    0.35*  24.92
 |-----------------------------------------------------------------------------|
-   8       2997  1.5921166E+03  1.11E+01    0.70    0.38   24.92    0.83   3
+   8       2997  1.5912186E+03  1.11E+01    0.70    0.38   24.92    0.82   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 14
 | Initializing integration for process circe1_photons_5_q4:
 | Beam structure: e+, e- => circe1 => isr, epa
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 15
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_q4.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_q4'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 8
 |   Process components:
 |     1: 'circe1_photons_5_q4_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => isr, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_q4'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.6363356E+03  7.12E+01    4.35    1.38*  11.25
-   2        999  1.5297356E+03  2.77E+01    1.81    0.57*  21.68
-   3        999  1.5391704E+03  1.97E+01    1.28    0.41*  36.90
-   4        999  1.5734232E+03  1.92E+01    1.22    0.38*  31.79
-   5        999  1.5976951E+03  1.84E+01    1.15    0.36*  27.69
-|-----------------------------------------------------------------------------|
-   5       4995  1.5671850E+03  1.01E+01    0.65    0.46   27.69    1.91   5
-|-----------------------------------------------------------------------------|
-   6        999  1.5733991E+03  1.81E+01    1.15    0.36   27.27
-   7        999  1.5894320E+03  1.82E+01    1.14    0.36*  27.28
-   8        999  1.6092257E+03  1.94E+01    1.21    0.38   25.79
+   1        999  1.6365027E+03  7.11E+01    4.35    1.37*  11.25
+   2        999  1.5304048E+03  2.77E+01    1.81    0.57*  21.69
+   3        999  1.5389688E+03  1.97E+01    1.28    0.41*  36.88
+   4        999  1.5711152E+03  1.92E+01    1.22    0.39*  31.71
+   5        999  1.5974151E+03  1.84E+01    1.15    0.36*  27.61
+|-----------------------------------------------------------------------------|
+   5       4995  1.5665199E+03  1.01E+01    0.65    0.46   27.61    1.88   5
+|-----------------------------------------------------------------------------|
+   6        999  1.5719844E+03  1.81E+01    1.15    0.36*  27.17
+   7        999  1.5955534E+03  1.81E+01    1.13    0.36*  27.35
+   8        999  1.6072593E+03  1.94E+01    1.21    0.38   25.64
 |-----------------------------------------------------------------------------|
-   8       2997  1.5898535E+03  1.07E+01    0.67    0.37   25.79    0.91   3
+   8       2997  1.5908840E+03  1.07E+01    0.67    0.37   25.64    0.94   3
 |=============================================================================|
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_2.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_2.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_2.ref	(revision 8371)
@@ -1,172 +1,172 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 $method = "omega"
 | Process library 'circe1_photons_2_lib': recorded process 'circe1_photons_2_p1'
 | Process library 'circe1_photons_2_lib': recorded process 'circe1_photons_2_p2'
 | Process library 'circe1_photons_2_lib': recorded process 'circe1_photons_2_p3'
 seed = 0
 | Process library 'circe1_photons_2_lib': compiling ...
 | Process library 'circe1_photons_2_lib': writing makefile
 | Process library 'circe1_photons_2_lib': removing old files
 | Process library 'circe1_photons_2_lib': writing driver
 | Process library 'circe1_photons_2_lib': creating source code
 | Process library 'circe1_photons_2_lib': compiling sources
 | Process library 'circe1_photons_2_lib': linking
 | Process library 'circe1_photons_2_lib': loading
 | Process library 'circe1_photons_2_lib': ... success.
 $phs_method = "wood"
 $integration_method = "vamp"
 sqrts =  5.000000000000E+02
 openmp_num_threads = 1
 [user variable] n = 1000
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process circe1_photons_2_p1:
 | Beam structure: [any particles]
 | Beam data (collision):
 |   A  (mass = 0.0000000E+00 GeV)
 |   A  (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_2_p1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_2_p1'
 |   Library name  = 'circe1_photons_2_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'circe1_photons_2_p1_i1':   A, A => b, bbar [omega]
 | ------------------------------------------------------------------------
 | Phase space: 5 channels, 2 dimensions
 | Phase space: found 5 channels, collected in 2 groves.
 | Phase space: Using 9 equivalences between channels.
 | Phase space: wood
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_2_p1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 5 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1       1000  2.7865916E+02  2.95E+00    1.06    0.34*  56.03
    2       1000  2.7849276E+02  2.31E+00    0.83    0.26*  40.36
    3       1000  2.7851341E+02  2.00E+00    0.72    0.23*  43.86
 |-----------------------------------------------------------------------------|
    3       3000  2.7853666E+02  1.35E+00    0.48    0.26   43.86    0.00   3
 |-----------------------------------------------------------------------------|
    4       1000  2.7239954E+02  2.03E+00    0.75    0.24   42.16
    5       1000  2.7384472E+02  2.36E+00    0.86    0.27   41.89
    6       1000  2.7457965E+02  2.18E+00    0.79    0.25*  41.92
 |-----------------------------------------------------------------------------|
    6       3000  2.7353474E+02  1.26E+00    0.46    0.25   41.92    0.28   3
 |=============================================================================|
 epa_x_min =  1.000000000000E-01
 epa_mass =  5.109970000000E-04
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Initializing integration for process circe1_photons_2_p2:
 | Beam structure: e-, e+ => epa
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_2_p2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_2_p2'
 |   Library name  = 'circe1_photons_2_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'circe1_photons_2_p2_i1':   A, A => b, bbar [omega]
 | ------------------------------------------------------------------------
 | Phase space: 5 channels, 2 dimensions
 | Phase space: found 5 channels, collected in 2 groves.
 | Phase space: Using 9 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, epa
 | Beam structure: 2 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_2_p2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 5 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1       1000  2.7423868E+01  1.14E+00    4.16    1.32*  16.28
-   2       1000  2.6507156E+01  4.34E-01    1.64    0.52*  41.31
-   3       1000  2.6309549E+01  4.37E-01    1.66    0.52   33.28
-   4       1000  2.6283460E+01  4.01E-01    1.52    0.48*  40.09
-   5       1000  2.5225933E+01  4.17E-01    1.65    0.52   41.26
-|-----------------------------------------------------------------------------|
-   5       5000  2.6117280E+01  2.07E-01    0.79    0.56   41.26    1.76   5
-|-----------------------------------------------------------------------------|
-   6       1000  2.5943213E+01  4.19E-01    1.61    0.51*  37.91
-   7       1000  2.6152585E+01  4.39E-01    1.68    0.53   31.92
-   8       1000  2.6279078E+01  4.20E-01    1.60    0.51*  28.97
+   1       1000  2.7443889E+01  1.14E+00    4.14    1.31*  16.37
+   2       1000  2.6524846E+01  4.34E-01    1.64    0.52*  41.36
+   3       1000  2.6310807E+01  4.36E-01    1.66    0.52   33.30
+   4       1000  2.6299085E+01  4.00E-01    1.52    0.48*  40.12
+   5       1000  2.5227446E+01  4.17E-01    1.65    0.52   41.70
+|-----------------------------------------------------------------------------|
+   5       5000  2.6127234E+01  2.07E-01    0.79    0.56   41.70    1.80   5
+|-----------------------------------------------------------------------------|
+   6       1000  2.5950963E+01  4.18E-01    1.61    0.51*  37.95
+   7       1000  2.6089229E+01  4.38E-01    1.68    0.53   31.83
+   8       1000  2.6294983E+01  4.20E-01    1.60    0.50*  28.97
 |-----------------------------------------------------------------------------|
-   8       3000  2.6123685E+01  2.46E-01    0.94    0.52   28.97    0.16   3
+   8       3000  2.6111956E+01  2.45E-01    0.94    0.51   28.97    0.17   3
 |=============================================================================|
 $circe1_acc = "TESLA"
 circe1_chat = 2
 ?circe1_generate = true
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process circe1_photons_2_p3:
 | Beam structure: e-, e+ => circe1 => epa
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_2_p3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_2_p3'
 |   Library name  = 'circe1_photons_2_lib'
 |   Process index = 3
 |   Process components:
 |     1: 'circe1_photons_2_p3_i1':   A, A => b, bbar [omega]
 | ------------------------------------------------------------------------
 | Phase space: 5 channels, 2 dimensions
 | Phase space: found 5 channels, collected in 2 groves.
 | Phase space: Using 9 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => epa, none => none, epa
 | Beam structure: 2 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_2_p3'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 5 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1       1000  2.5269378E+01  1.07E+00    4.24    1.34*  15.25
-   2       1000  2.7105471E+01  4.74E-01    1.75    0.55*  38.78
-   3       1000  2.6982617E+01  4.29E-01    1.59    0.50*  30.09
-   4       1000  2.6741557E+01  4.65E-01    1.74    0.55   26.96
-   5       1000  2.6961406E+01  4.32E-01    1.60    0.51*  37.71
-|-----------------------------------------------------------------------------|
-   5       5000  2.6877797E+01  2.20E-01    0.82    0.58   37.71    0.67   5
-|-----------------------------------------------------------------------------|
-   6       1000  2.6729314E+01  4.33E-01    1.62    0.51   33.26
-   7       1000  2.6654530E+01  4.02E-01    1.51    0.48*  33.17
-   8       1000  2.7181641E+01  4.16E-01    1.53    0.48   33.83
+   1       1000  2.5299075E+01  1.07E+00    4.22    1.33*  15.34
+   2       1000  2.7101274E+01  4.73E-01    1.75    0.55*  38.79
+   3       1000  2.6931418E+01  4.30E-01    1.60    0.50*  30.01
+   4       1000  2.6679308E+01  4.65E-01    1.74    0.55   26.98
+   5       1000  2.6932091E+01  4.31E-01    1.60    0.51*  37.58
+|-----------------------------------------------------------------------------|
+   5       5000  2.6843000E+01  2.20E-01    0.82    0.58   37.58    0.65   5
+|-----------------------------------------------------------------------------|
+   6       1000  2.6713082E+01  4.31E-01    1.61    0.51   33.22
+   7       1000  2.6638023E+01  4.04E-01    1.52    0.48*  33.13
+   8       1000  2.7123632E+01  4.13E-01    1.52    0.48   33.73
 |-----------------------------------------------------------------------------|
-   8       3000  2.6854042E+01  2.40E-01    0.90    0.49   33.83    0.48   3
+   8       3000  2.6825207E+01  2.40E-01    0.89    0.49   33.73    0.40   3
 |=============================================================================|
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_4.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_4.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_4.ref	(revision 8371)
@@ -1,405 +1,405 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 $method = "omega"
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_p1'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_p2'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_p3'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_p4'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_q1'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_q2'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_q3'
 | Process library 'circe1_photons_4_lib': recorded process 'circe1_photons_4_q4'
 seed = 0
 | Process library 'circe1_photons_4_lib': compiling ...
 | Process library 'circe1_photons_4_lib': writing makefile
 | Process library 'circe1_photons_4_lib': removing old files
 | Process library 'circe1_photons_4_lib': writing driver
 | Process library 'circe1_photons_4_lib': creating source code
 | Process library 'circe1_photons_4_lib': compiling sources
 | Process library 'circe1_photons_4_lib': linking
 | Process library 'circe1_photons_4_lib': loading
 | Process library 'circe1_photons_4_lib': ... success.
 $phs_method = "wood"
 $integration_method = "vamp"
 sqrts =  5.000000000000E+02
 openmp_num_threads = 1
 [user variable] n = 1000
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process circe1_photons_4_p1:
 | Beam structure: [any particles]
 | Beam data (collision):
 |   A   (mass = 0.0000000E+00 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_p1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_p1'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'circe1_photons_4_p1_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_p1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        864  4.4544622E+03  4.86E+01    1.09    0.32*  27.39
    2        864  4.3162333E+03  3.73E+01    0.87    0.25*  30.78
    3        864  4.3679694E+03  2.11E+01    0.48    0.14*  55.80
 |-----------------------------------------------------------------------------|
    3       2592  4.3678197E+03  1.72E+01    0.39    0.20   55.80    2.54   3
 |-----------------------------------------------------------------------------|
    4        864  4.3143461E+03  2.50E+01    0.58    0.17   54.92
    5        864  4.3657212E+03  2.34E+01    0.54    0.16*  55.34
    6        864  4.3431563E+03  2.04E+01    0.47    0.14*  54.99
 |-----------------------------------------------------------------------------|
    6       2592  4.3423288E+03  1.31E+01    0.30    0.15   54.99    1.13   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Initializing integration for process circe1_photons_4_q1:
 | Beam structure: [any particles]
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   A   (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_q1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_q1'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 5
 |   Process components:
 |     1: 'circe1_photons_4_q1_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_q1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        864  4.2582932E+03  4.85E+01    1.14    0.34*  27.22
    2        864  4.3068621E+03  3.12E+01    0.73    0.21*  40.74
    3        864  4.3405211E+03  2.44E+01    0.56    0.17*  52.28
 |-----------------------------------------------------------------------------|
    3       2592  4.3183561E+03  1.79E+01    0.41    0.21   52.28    1.25   3
 |-----------------------------------------------------------------------------|
    4        864  4.3021537E+03  2.41E+01    0.56    0.16*  51.74
    5        864  4.3650034E+03  2.29E+01    0.53    0.15*  52.19
    6        864  4.3751689E+03  2.59E+01    0.59    0.17   52.28
 |-----------------------------------------------------------------------------|
    6       2592  4.3467944E+03  1.40E+01    0.32    0.16   52.28    2.64   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process circe1_photons_4_p2:
 | Beam structure: A, e- => none, isr
 | Beam data (collision):
 |   A   (mass = 0.0000000E+00 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_p2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_p2'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'circe1_photons_4_p2_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: none, isr
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_p2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  4.9839516E+03  2.75E+02    5.52    1.75*   5.10
    2        999  4.7090673E+03  1.07E+02    2.28    0.72*  17.19
    3        999  4.8907180E+03  8.31E+01    1.70    0.54*  19.55
    4        999  4.8539873E+03  6.25E+01    1.29    0.41*  25.11
    5        999  4.7978726E+03  5.45E+01    1.14    0.36*  36.22
 |-----------------------------------------------------------------------------|
    5       4995  4.8248245E+03  3.45E+01    0.72    0.51   36.22    0.65   5
 |-----------------------------------------------------------------------------|
    6        999  4.7914071E+03  5.37E+01    1.12    0.35*  31.87
    7        999  4.8486423E+03  5.07E+01    1.05    0.33*  32.25
    8        999  4.8263454E+03  5.28E+01    1.09    0.35   32.10
 |-----------------------------------------------------------------------------|
    8       2997  4.8231947E+03  3.02E+01    0.63    0.34   32.10    0.30   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Initializing integration for process circe1_photons_4_q2:
 | Beam structure: e+, A => isr, none
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   A   (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_q2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_q2'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 6
 |   Process components:
 |     1: 'circe1_photons_4_q2_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: isr, none
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_q2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  4.9588354E+03  1.64E+02    3.31    1.05*  21.07
    2        999  4.8493798E+03  1.17E+02    2.41    0.76*  10.42
    3        999  4.7705823E+03  7.58E+01    1.59    0.50*  20.35
    4        999  4.7289891E+03  6.62E+01    1.40    0.44*  26.62
    5        999  4.7812562E+03  5.84E+01    1.22    0.39*  27.92
 |-----------------------------------------------------------------------------|
    5       4995  4.7784940E+03  3.52E+01    0.74    0.52   27.92    0.54   5
 |-----------------------------------------------------------------------------|
    6        999  4.7813980E+03  5.62E+01    1.18    0.37*  23.71
    7        999  4.7548012E+03  5.97E+01    1.26    0.40   21.97
    8        999  4.7776833E+03  6.08E+01    1.27    0.40   22.08
 |-----------------------------------------------------------------------------|
    8       2997  4.7716391E+03  3.40E+01    0.71    0.39   22.08    0.06   3
 |=============================================================================|
 epa_x_min =  1.000000000000E-01
 epa_mass =  5.110000000000E-04
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 4
 | Initializing integration for process circe1_photons_4_p3:
 | Beam structure: e+, e- => epa, none
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_p3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_p3'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 3
 |   Process components:
 |     1: 'circe1_photons_4_p3_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_p3'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.3926717E+03  5.68E+01    4.08    1.29*  13.96
-   2        999  1.4432813E+03  2.25E+01    1.56    0.49*  34.82
-   3        999  1.4442592E+03  1.52E+01    1.05    0.33*  43.82
+   1        999  1.3931691E+03  5.67E+01    4.07    1.29*  14.00
+   2        999  1.4434319E+03  2.25E+01    1.56    0.49*  34.85
+   3        999  1.4441146E+03  1.52E+01    1.05    0.33*  43.82
 |-----------------------------------------------------------------------------|
-   3       2997  1.4415561E+03  1.23E+01    0.85    0.47   43.82    0.39   3
+   3       2997  1.4415255E+03  1.23E+01    0.85    0.47   43.82    0.38   3
 |-----------------------------------------------------------------------------|
-   4        999  1.4306043E+03  1.45E+01    1.01    0.32*  43.41
-   5        999  1.4686578E+03  1.42E+01    0.96    0.30*  44.56
-   6        999  1.4285028E+03  1.55E+01    1.09    0.34   43.34
+   4        999  1.4308874E+03  1.45E+01    1.01    0.32*  43.42
+   5        999  1.4660411E+03  1.42E+01    0.97    0.31*  44.49
+   6        999  1.4285619E+03  1.55E+01    1.09    0.34   43.35
 |-----------------------------------------------------------------------------|
-   6       2997  1.4436189E+03  8.48E+00    0.59    0.32   43.34    2.44   3
+   6       2997  1.4428037E+03  8.48E+00    0.59    0.32   43.35    2.11   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 5
 | Initializing integration for process circe1_photons_4_q3:
 | Beam structure: e+, e- => none, epa
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_q3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_q3'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 7
 |   Process components:
 |     1: 'circe1_photons_4_q3_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: none, epa
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_q3'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.4810514E+03  6.46E+01    4.36    1.38*  14.35
-   2        999  1.4604768E+03  2.05E+01    1.40    0.44*  44.89
-   3        999  1.4467172E+03  1.57E+01    1.08    0.34*  49.41
-   4        999  1.4471817E+03  1.35E+01    0.94    0.30*  51.92
-   5        999  1.4413587E+03  1.34E+01    0.93    0.29*  50.63
-|-----------------------------------------------------------------------------|
-   5       4995  1.4474781E+03  7.51E+00    0.52    0.37   50.63    0.22   5
-|-----------------------------------------------------------------------------|
-   6        999  1.4504120E+03  1.38E+01    0.95    0.30   49.59
-   7        999  1.4241650E+03  1.39E+01    0.98    0.31   47.97
-   8        999  1.4197089E+03  1.36E+01    0.96    0.30*  47.82
+   1        999  1.4809489E+03  6.45E+01    4.35    1.38*  14.39
+   2        999  1.4604257E+03  2.05E+01    1.40    0.44*  44.88
+   3        999  1.4468449E+03  1.57E+01    1.08    0.34*  49.44
+   4        999  1.4472144E+03  1.35E+01    0.94    0.30*  51.93
+   5        999  1.4419147E+03  1.34E+01    0.93    0.29*  50.51
+|-----------------------------------------------------------------------------|
+   5       4995  1.4476907E+03  7.51E+00    0.52    0.37   50.51    0.21   5
+|-----------------------------------------------------------------------------|
+   6        999  1.4503449E+03  1.38E+01    0.95    0.30   49.52
+   7        999  1.4244624E+03  1.39E+01    0.98    0.31   47.90
+   8        999  1.4197696E+03  1.36E+01    0.96    0.30*  47.74
 |-----------------------------------------------------------------------------|
-   8       2997  1.4313140E+03  7.95E+00    0.56    0.30   47.82    1.45   3
+   8       2997  1.4314109E+03  7.95E+00    0.56    0.30   47.74    1.43   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 6
 | Initializing integration for process circe1_photons_4_p4:
 | Beam structure: e+, e- => epa, isr
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_p4.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_p4'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 4
 |   Process components:
 |     1: 'circe1_photons_4_p4_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, isr
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_p4'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.5750317E+03  6.80E+01    4.32    1.36*  10.53
-   2        999  1.5184774E+03  2.37E+01    1.56    0.49*  33.45
-   3        999  1.5476560E+03  1.86E+01    1.20    0.38*  25.86
-   4        999  1.5338964E+03  1.99E+01    1.30    0.41   25.51
-   5        999  1.5354124E+03  1.95E+01    1.27    0.40*  25.54
-|-----------------------------------------------------------------------------|
-   5       4995  1.5363986E+03  9.98E+00    0.65    0.46   25.54    0.32   5
-|-----------------------------------------------------------------------------|
-   6        999  1.5352006E+03  2.18E+01    1.42    0.45   19.57
-   7        999  1.5263543E+03  1.88E+01    1.23    0.39*  19.46
-   8        999  1.5642330E+03  2.21E+01    1.41    0.45   17.47
+   1        999  1.5752080E+03  6.79E+01    4.31    1.36*  10.55
+   2        999  1.5182842E+03  2.37E+01    1.56    0.49*  33.45
+   3        999  1.5482380E+03  1.87E+01    1.21    0.38*  25.90
+   4        999  1.5342441E+03  1.99E+01    1.30    0.41   25.52
+   5        999  1.5326125E+03  1.94E+01    1.26    0.40*  25.40
+|-----------------------------------------------------------------------------|
+   5       4995  1.5358659E+03  9.97E+00    0.65    0.46   25.40    0.34   5
+|-----------------------------------------------------------------------------|
+   6        999  1.5319813E+03  2.18E+01    1.42    0.45   19.47
+   7        999  1.5278400E+03  1.88E+01    1.23    0.39*  19.42
+   8        999  1.5664587E+03  2.21E+01    1.41    0.45   17.51
 |-----------------------------------------------------------------------------|
-   8       2997  1.5401209E+03  1.20E+01    0.78    0.43   17.47    0.89   3
+   8       2997  1.5403892E+03  1.20E+01    0.78    0.43   17.51    0.99   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 7
 | Initializing integration for process circe1_photons_4_q4:
 | Beam structure: e+, e- => isr, epa
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_4_q4.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_4_q4'
 |   Library name  = 'circe1_photons_4_lib'
 |   Process index = 8
 |   Process components:
 |     1: 'circe1_photons_4_q4_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: isr, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_4_q4'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.5139845E+03  6.80E+01    4.49    1.42*  11.93
-   2        999  1.5854321E+03  2.61E+01    1.65    0.52*  25.14
-   3        999  1.5545927E+03  1.81E+01    1.16    0.37*  35.35
-   4        999  1.5085037E+03  1.67E+01    1.11    0.35*  37.31
-   5        999  1.5562867E+03  2.14E+01    1.37    0.43   20.35
-|-----------------------------------------------------------------------------|
-   5       4995  1.5426527E+03  9.75E+00    0.63    0.45   20.35    1.97   5
-|-----------------------------------------------------------------------------|
-   6        999  1.5240448E+03  1.89E+01    1.24    0.39*  15.07
-   7        999  1.5626140E+03  2.06E+01    1.32    0.42   15.12
-   8        999  1.5927064E+03  2.56E+01    1.61    0.51   14.85
+   1        999  1.5139686E+03  6.79E+01    4.49    1.42*  11.96
+   2        999  1.5852591E+03  2.61E+01    1.65    0.52*  25.17
+   3        999  1.5509460E+03  1.81E+01    1.16    0.37*  35.24
+   4        999  1.5071452E+03  1.67E+01    1.11    0.35*  37.10
+   5        999  1.5635226E+03  2.32E+01    1.48    0.47   16.14
+|-----------------------------------------------------------------------------|
+   5       4995  1.5420044E+03  9.90E+00    0.64    0.45   16.14    2.09   5
+|-----------------------------------------------------------------------------|
+   6        999  1.5249682E+03  1.87E+01    1.23    0.39*  12.60
+   7        999  1.5602538E+03  2.06E+01    1.32    0.42   12.60
+   8        999  1.5859826E+03  2.56E+01    1.61    0.51   12.40
 |-----------------------------------------------------------------------------|
-   8       2997  1.5533422E+03  1.22E+01    0.79    0.43   14.85    2.49   3
+   8       2997  1.5511411E+03  1.22E+01    0.78    0.43   12.40    2.00   3
 |=============================================================================|
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_5.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_5.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_5.ref	(revision 8371)
@@ -1,446 +1,446 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 $method = "omega"
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_p1'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_p2'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_p3'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_p4'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_q1'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_q2'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_q3'
 | Process library 'circe1_photons_5_lib': recorded process 'circe1_photons_5_q4'
 seed = 0
 | Process library 'circe1_photons_5_lib': compiling ...
 | Process library 'circe1_photons_5_lib': writing makefile
 | Process library 'circe1_photons_5_lib': removing old files
 | Process library 'circe1_photons_5_lib': writing driver
 | Process library 'circe1_photons_5_lib': creating source code
 | Process library 'circe1_photons_5_lib': compiling sources
 | Process library 'circe1_photons_5_lib': linking
 | Process library 'circe1_photons_5_lib': loading
 | Process library 'circe1_photons_5_lib': ... success.
 $phs_method = "wood"
 $integration_method = "vamp"
 sqrts =  5.000000000000E+02
 openmp_num_threads = 1
 [user variable] n = 1000
 $circe1_acc = "TESLA"
 circe1_chat = 2
 ?circe1_generate = true
 ?circe1_photon1 = true
 ?circe1_photon2 = false
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process circe1_photons_5_p1:
 | Beam structure: e+, e- => circe1
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_p1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_p1'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'circe1_photons_5_p1_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1
 | Beam structure: 1 channels, 0 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_p1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        864  3.3070912E+04  2.39E+03    7.22    2.12*   7.28
    2        864  3.4385791E+04  2.14E+03    6.21    1.83*  11.94
    3        864  3.5408411E+04  2.20E+03    6.22    1.83   12.31
 |-----------------------------------------------------------------------------|
    3       2592  3.4352576E+04  1.29E+03    3.76    1.91   12.31    0.26   3
 |-----------------------------------------------------------------------------|
    4        864  3.2892243E+04  2.06E+03    6.27    1.84   11.16
    5        864  3.1708740E+04  1.99E+03    6.27    1.84   10.76
    6        864  3.0778500E+04  1.90E+03    6.18    1.82*  10.44
 |-----------------------------------------------------------------------------|
    6       2592  3.1736053E+04  1.14E+03    3.60    1.83   10.44    0.28   3
 |=============================================================================|
 ?circe1_photon1 = false
 ?circe1_photon2 = true
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process circe1_photons_5_q1:
 | Beam structure: e+, e- => circe1
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_q1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_q1'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 5
 |   Process components:
 |     1: 'circe1_photons_5_q1_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1
 | Beam structure: 1 channels, 0 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_q1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        864  3.4490793E+04  2.45E+03    7.11    2.09*   8.22
    2        864  3.2967456E+04  2.02E+03    6.13    1.80*  11.48
    3        864  2.7228354E+04  1.78E+03    6.52    1.92   10.43
 |-----------------------------------------------------------------------------|
    3       2592  3.0817944E+04  1.17E+03    3.80    1.94   10.43    3.73   3
 |-----------------------------------------------------------------------------|
    4        864  3.3705583E+04  2.08E+03    6.17    1.81*  11.69
    5        864  3.3497304E+04  2.07E+03    6.19    1.82   10.96
    6        864  2.8262063E+04  1.86E+03    6.58    1.93    9.24
 |-----------------------------------------------------------------------------|
    6       2592  3.1550579E+04  1.15E+03    3.65    1.86    9.24    2.54   3
 |=============================================================================|
 ?circe1_photon1 = true
 ?circe1_photon2 = false
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 4
 | Initializing integration for process circe1_photons_5_p2:
 | Beam structure: e+, e- => circe1 => none, isr
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 5
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_p2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_p2'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'circe1_photons_5_p2_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => none, isr
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_p2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  3.5258516E+04  2.65E+03    7.52    2.38*   7.40
    2        999  3.2056202E+04  1.94E+03    6.05    1.91*  11.25
    3        999  2.7572603E+04  1.82E+03    6.62    2.09    9.77
    4        999  3.1810932E+04  1.92E+03    6.03    1.90*  10.15
    5        999  2.9679338E+04  1.88E+03    6.35    2.01   10.36
 |-----------------------------------------------------------------------------|
    5       4995  3.0766946E+04  8.90E+02    2.89    2.04   10.36    1.75   5
 |-----------------------------------------------------------------------------|
    6        999  2.8020027E+04  1.75E+03    6.24    1.97*   9.21
    7        999  2.8260016E+04  1.76E+03    6.23    1.97*   9.29
    8        999  3.1014994E+04  1.89E+03    6.10    1.93*  10.19
 |-----------------------------------------------------------------------------|
    8       2997  2.9004469E+04  1.04E+03    3.58    1.96   10.19    0.81   3
 |=============================================================================|
 ?circe1_photon1 = false
 ?circe1_photon2 = true
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 6
 | Initializing integration for process circe1_photons_5_q2:
 | Beam structure: e+, e- => circe1 => isr, none
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 7
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_q2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_q2'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 6
 |   Process components:
 |     1: 'circe1_photons_5_q2_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => isr, none
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_q2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  2.6877249E+04  2.23E+03    8.29    2.62*   5.53
    2        999  3.1481731E+04  1.93E+03    6.13    1.94*  11.62
    3        999  2.8937819E+04  1.73E+03    5.98    1.89*  11.20
    4        999  3.4535801E+04  1.99E+03    5.77    1.82*   9.85
    5        999  3.2314014E+04  1.82E+03    5.65    1.78*  10.59
 |-----------------------------------------------------------------------------|
    5       4995  3.0921640E+04  8.59E+02    2.78    1.96   10.59    2.14   5
 |-----------------------------------------------------------------------------|
    6        999  3.0224671E+04  1.88E+03    6.23    1.97    9.53
    7        999  3.3238451E+04  1.95E+03    5.86    1.85*   8.87
    8        999  2.8117669E+04  1.78E+03    6.33    2.00    7.30
 |-----------------------------------------------------------------------------|
    8       2997  3.0375080E+04  1.08E+03    3.55    1.94    7.30    1.89   3
 |=============================================================================|
 epa_x_min =  1.000000000000E-01
 epa_mass =  5.110000000000E-04
 ?circe1_photon1 = false
 ?circe1_photon2 = false
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 8
 | Initializing integration for process circe1_photons_5_p3:
 | Beam structure: e+, e- => circe1 => epa, none
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 9
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_p3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_p3'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 3
 |   Process components:
 |     1: 'circe1_photons_5_p3_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => epa, none
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_p3'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.5374487E+03  6.77E+01    4.40    1.39*  12.99
-   2        999  1.4625554E+03  2.31E+01    1.58    0.50*  43.59
-   3        999  1.4383113E+03  1.58E+01    1.10    0.35*  55.82
+   1        999  1.5371464E+03  6.76E+01    4.40    1.39*  13.01
+   2        999  1.4629753E+03  2.31E+01    1.58    0.50*  43.62
+   3        999  1.4389442E+03  1.58E+01    1.10    0.35*  54.07
 |-----------------------------------------------------------------------------|
-   3       2997  1.4492827E+03  1.28E+01    0.88    0.48   55.82    1.26   3
+   3       2997  1.4498454E+03  1.28E+01    0.88    0.48   54.07    1.24   3
 |-----------------------------------------------------------------------------|
-   4        999  1.4851395E+03  1.40E+01    0.95    0.30*  55.38
-   5        999  1.4948625E+03  1.39E+01    0.93    0.29*  49.19
-   6        999  1.4751166E+03  1.51E+01    1.02    0.32   47.97
+   4        999  1.4852449E+03  1.40E+01    0.95    0.30*  55.46
+   5        999  1.4950040E+03  1.39E+01    0.93    0.29*  49.31
+   6        999  1.4755484E+03  1.51E+01    1.02    0.32   48.11
 |-----------------------------------------------------------------------------|
-   6       2997  1.4855801E+03  8.26E+00    0.56    0.30   47.97    0.47   3
+   6       2997  1.4857966E+03  8.25E+00    0.56    0.30   48.11    0.45   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 10
 | Initializing integration for process circe1_photons_5_q3:
 | Beam structure: e+, e- => circe1 => none, epa
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 11
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_q3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_q3'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 7
 |   Process components:
 |     1: 'circe1_photons_5_q3_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => none, epa
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_q3'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.4975346E+03  6.28E+01    4.19    1.33*  14.16
-   2        999  1.4859737E+03  2.20E+01    1.48    0.47*  41.11
-   3        999  1.4696684E+03  1.61E+01    1.10    0.35*  52.96
-   4        999  1.4473461E+03  1.46E+01    1.01    0.32*  55.54
-   5        999  1.4827502E+03  1.33E+01    0.90    0.28*  48.05
-|-----------------------------------------------------------------------------|
-   5       4995  1.4702775E+03  7.78E+00    0.53    0.37   48.05    1.01   5
-|-----------------------------------------------------------------------------|
-   6        999  1.4929148E+03  1.28E+01    0.86    0.27*  47.79
-   7        999  1.4963127E+03  1.76E+01    1.18    0.37   28.63
-   8        999  1.4581451E+03  1.41E+01    0.97    0.31*  27.90
+   1        999  1.4975662E+03  6.27E+01    4.19    1.32*  14.20
+   2        999  1.4861291E+03  2.20E+01    1.48    0.47*  41.15
+   3        999  1.4700230E+03  1.61E+01    1.10    0.35*  52.98
+   4        999  1.4477122E+03  1.46E+01    1.01    0.32*  55.52
+   5        999  1.4828759E+03  1.33E+01    0.90    0.28*  48.05
+|-----------------------------------------------------------------------------|
+   5       4995  1.4705271E+03  7.78E+00    0.53    0.37   48.05    1.00   5
+|-----------------------------------------------------------------------------|
+   6        999  1.4930120E+03  1.28E+01    0.86    0.27*  47.78
+   7        999  1.4962256E+03  1.76E+01    1.18    0.37   28.63
+   8        999  1.4580244E+03  1.41E+01    0.97    0.31*  27.90
 |-----------------------------------------------------------------------------|
-   8       2997  1.4814711E+03  8.35E+00    0.56    0.31   27.90    2.12   3
+   8       2997  1.4814459E+03  8.35E+00    0.56    0.31   27.90    2.14   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 12
 | Initializing integration for process circe1_photons_5_p4:
 | Beam structure: e+, e- => circe1 => epa, isr
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 13
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_p4.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_p4'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 4
 |   Process components:
 |     1: 'circe1_photons_5_p4_i1':   A, e- => A, e- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => epa, none => none, isr
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_p4'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.5276000E+03  6.66E+01    4.36    1.38*  10.87
-   2        999  1.6030374E+03  2.93E+01    1.83    0.58*  31.66
-   3        999  1.5866459E+03  2.05E+01    1.29    0.41*  27.29
-   4        999  1.5875178E+03  1.90E+01    1.20    0.38*  32.44
-   5        999  1.5776850E+03  1.82E+01    1.15    0.36*  32.32
-|-----------------------------------------------------------------------------|
-   5       4995  1.5846697E+03  1.02E+01    0.64    0.46   32.32    0.33   5
-|-----------------------------------------------------------------------------|
-   6        999  1.5843516E+03  2.05E+01    1.30    0.41   24.53
-   7        999  1.5777715E+03  1.96E+01    1.24    0.39*  24.43
-   8        999  1.6096644E+03  1.78E+01    1.10    0.35*  24.92
+   1        999  1.5278174E+03  6.65E+01    4.35    1.38*  10.87
+   2        999  1.6030817E+03  2.92E+01    1.82    0.58*  31.65
+   3        999  1.5866732E+03  2.05E+01    1.29    0.41*  27.30
+   4        999  1.5861878E+03  1.91E+01    1.20    0.38*  32.34
+   5        999  1.5808954E+03  1.85E+01    1.17    0.37*  27.92
+|-----------------------------------------------------------------------------|
+   5       4995  1.5853652E+03  1.03E+01    0.65    0.46   27.92    0.29   5
+|-----------------------------------------------------------------------------|
+   6        999  1.5840228E+03  2.05E+01    1.30    0.41   24.54
+   7        999  1.5765859E+03  1.96E+01    1.24    0.39*  24.42
+   8        999  1.6085632E+03  1.77E+01    1.10    0.35*  24.92
 |-----------------------------------------------------------------------------|
-   8       2997  1.5921009E+03  1.11E+01    0.70    0.38   24.92    0.83   3
+   8       2997  1.5912028E+03  1.11E+01    0.70    0.38   24.92    0.82   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 14
 | Initializing integration for process circe1_photons_5_q4:
 | Beam structure: e+, e- => circe1 => isr, epa
 | Beam data (collision):
 |   e+  (mass = 5.1100000E-04 GeV)
 |   e-  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 15
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_5_q4.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_5_q4'
 |   Library name  = 'circe1_photons_5_lib'
 |   Process index = 8
 |   Process components:
 |     1: 'circe1_photons_5_q4_i1':   e+, A => e+, A [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => isr, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_5_q4'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  1.6363356E+03  7.12E+01    4.35    1.38*  11.25
-   2        999  1.5297356E+03  2.77E+01    1.81    0.57*  21.68
-   3        999  1.5391598E+03  1.97E+01    1.28    0.41*  36.89
-   4        999  1.5734076E+03  1.92E+01    1.22    0.38*  31.79
-   5        999  1.5976790E+03  1.84E+01    1.15    0.36*  27.69
-|-----------------------------------------------------------------------------|
-   5       4995  1.5671731E+03  1.01E+01    0.65    0.46   27.69    1.91   5
-|-----------------------------------------------------------------------------|
-   6        999  1.5733827E+03  1.81E+01    1.15    0.36   27.27
-   7        999  1.5894150E+03  1.82E+01    1.14    0.36*  27.28
-   8        999  1.6092095E+03  1.94E+01    1.21    0.38   25.79
+   1        999  1.6365027E+03  7.11E+01    4.35    1.37*  11.25
+   2        999  1.5304048E+03  2.77E+01    1.81    0.57*  21.69
+   3        999  1.5389582E+03  1.97E+01    1.28    0.41*  36.88
+   4        999  1.5710998E+03  1.92E+01    1.22    0.39*  31.71
+   5        999  1.5973988E+03  1.84E+01    1.15    0.36*  27.61
+|-----------------------------------------------------------------------------|
+   5       4995  1.5665080E+03  1.01E+01    0.65    0.46   27.61    1.88   5
+|-----------------------------------------------------------------------------|
+   6        999  1.5719962E+03  1.81E+01    1.15    0.36*  27.17
+   7        999  1.5955362E+03  1.81E+01    1.13    0.36*  27.35
+   8        999  1.6072431E+03  1.94E+01    1.21    0.38   25.64
 |-----------------------------------------------------------------------------|
-   8       2997  1.5898369E+03  1.07E+01    0.67    0.37   25.79    0.91   3
+   8       2997  1.5908770E+03  1.07E+01    0.67    0.37   25.64    0.94   3
 |=============================================================================|
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-prec/ilc.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-prec/ilc.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-prec/ilc.ref	(revision 8371)
@@ -1,338 +1,338 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?pacify = true
 | Process library 'ilc_lib': recorded process 'ilc_zh'
 | Process library 'ilc_lib': recorded process 'ilc_ww'
 | Process library 'ilc_lib': compiling ...
 | Process library 'ilc_lib': writing makefile
 | Process library 'ilc_lib': removing old files
 | Process library 'ilc_lib': writing driver
 | Process library 'ilc_lib': creating source code
 | Process library 'ilc_lib': compiling sources
 | Process library 'ilc_lib': linking
 | Process library 'ilc_lib': loading
 | Process library 'ilc_lib': ... success.
 seed = 1
 sqrts =  5.00000E+02
 openmp_num_threads = 1
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     5.807E+01   1.78E+00    3.06    0.31    76.1
 |-----------------------------------------------------------------------------|
    1        100     5.807E+01   1.78E+00    3.06    0.31    76.1
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+ => isr
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 | Beam structure: isr, none => none, isr
 | Beam structure: 1 channels, 2 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     6.264E+01   2.33E+00    3.72    0.37    50.5
 |-----------------------------------------------------------------------------|
    1        100     6.264E+01   2.33E+00    3.72    0.37    50.5
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+ => circe1
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 4
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 | Beam structure: circe1
 | Beam structure: 1 channels, 0 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     6.003E+01   1.69E+00    2.82    0.28    68.8
 |-----------------------------------------------------------------------------|
    1        100     6.003E+01   1.69E+00    2.82    0.28    68.8
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 5
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+ => circe1 => isr
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 6
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 | Beam structure: circe1 => isr, none => none, isr
 | Beam structure: 1 channels, 2 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     6.483E+01   2.50E+00    3.85    0.39    54.3
 |-----------------------------------------------------------------------------|
    1        100     6.483E+01   2.50E+00    3.85    0.39    54.3
 |=============================================================================|
 epa_x_min =  1.00000E-01
 epa_mass =  5.10997E-04
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 7
 | Initializing integration for process ilc_ww:
 | Beam structure: e-, e+ => epa
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_ww.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_ww'
 |   Library name  = 'ilc_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'ilc_ww_i1':   A, A => W+, W- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_ww'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 4 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        100     1.781E+02   2.29E+01   12.84    1.28    29.4
+   1        100     1.783E+02   2.29E+01   12.86    1.29    29.3
 |-----------------------------------------------------------------------------|
-   1        100     1.781E+02   2.29E+01   12.84    1.28    29.4
+   1        100     1.783E+02   2.29E+01   12.86    1.29    29.3
 |=============================================================================|
 $circe2_file = "teslagg_500.circe"
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 8
 | Initializing integration for process ilc_ww:
 | Beam structure: A, A => circe2
 | Beam data (collision):
 |   A  (mass = 0.0000000E+00 GeV)
 |   A  (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE2: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 9
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_ww.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_ww'
 |   Library name  = 'ilc_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'ilc_ww_i1':   A, A => W+, W- [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe2
 | Beam structure: 1 channels, 0 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_ww'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 4 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     1.830E+04   3.27E+03   17.88    1.79    18.7
 |-----------------------------------------------------------------------------|
    1        100     1.830E+04   3.27E+03   17.88    1.79    18.7
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 10
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+ => energy_scan
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 | Beam structure: energy_scan
 | Beam structure: 1 channels, 1 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     3.942E+04   3.95E+03   10.02    1.00    31.0
 |-----------------------------------------------------------------------------|
    1        100     3.942E+04   3.95E+03   10.02    1.00    31.0
 |=============================================================================|
 $beam_events_file = "uniform_spread_2.5%.dat"
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 11
 | Initializing integration for process ilc_zh:
 | Beam structure: e-, e+ => beam_events
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ilc_zh.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ilc_zh'
 |   Library name  = 'ilc_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ilc_zh_i1':   e-, e+ => Z, H [omega]
 | ------------------------------------------------------------------------
 | Phase space: 1 channels, 2 dimensions
 | Phase space: found 1 channel, collected in 1 grove.
 | Phase space: Using 1 equivalence between channels.
 | Phase space: wood
 | Beam structure: beam_events
 | Beam structure: 1 channels, 0 dimensions
 Warning: No cuts have been defined.
 | Beam events: reading from file 'uniform_spread_2.5%.dat'
 | Starting integration for process 'ilc_zh'
 | Integrate: iterations = 1:100
 | Integrator: 1 chains, 1 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 100 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        100     5.707E+01   1.74E+00    3.05    0.30    71.5
 |-----------------------------------------------------------------------------|
    1        100     5.707E+01   1.74E+00    3.05    0.30    71.5
 |=============================================================================|
 | Beam events: closed file 'uniform_spread_2.5%.dat'
 | There were no errors and    8 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-prec/ep_2.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-prec/ep_2.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-prec/ep_2.ref	(revision 8371)
@@ -1,220 +1,220 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 $method = "omega"
 | Process library 'ep_2_lib': recorded process 'ep_2_p1'
 | Process library 'ep_2_lib': recorded process 'ep_2_p2'
 | Process library 'ep_2_lib': recorded process 'ep_2_q1'
 | Process library 'ep_2_lib': recorded process 'ep_2_q2'
 seed = 0
 | Process library 'ep_2_lib': compiling ...
 | Process library 'ep_2_lib': writing makefile
 | Process library 'ep_2_lib': removing old files
 | Process library 'ep_2_lib': writing driver
 | Process library 'ep_2_lib': creating source code
 | Process library 'ep_2_lib': compiling sources
 | Process library 'ep_2_lib': linking
 | Process library 'ep_2_lib': loading
 | Process library 'ep_2_lib': ... success.
 $phs_method = "wood"
 $integration_method = "vamp"
 sqrts =  5.000000000000E+02
 openmp_num_threads = 1
 [user variable] n = 1000
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process ep_2_p1:
 | Beam structure: A, p => none, pdf_builtin
 | Beam data (collision):
 |   A  (mass = 0.0000000E+00 GeV)
 |   p  (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Initialized builtin PDF CTEQ6L
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ep_2_p1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ep_2_p1'
 |   Library name  = 'ep_2_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'ep_2_p1_i1':   A, u => A, u [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: none, pdf_builtin
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'ep_2_p1'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  3.8616031E+04  8.51E+03   22.04    6.97*   1.19
    2        999  2.7857398E+04  1.78E+03    6.38    2.02*   5.08
    3        999  3.0216543E+04  9.45E+02    3.13    0.99*  18.37
    4        999  2.9322626E+04  6.18E+02    2.11    0.67*  27.51
    5        999  2.9741141E+04  5.38E+02    1.81    0.57*  29.57
 |-----------------------------------------------------------------------------|
    5       4995  2.9603259E+04  3.65E+02    1.23    0.87   29.57    0.69   5
 |-----------------------------------------------------------------------------|
    6        999  3.0451498E+04  5.72E+02    1.88    0.59   17.93
    7        999  3.0219585E+04  5.49E+02    1.82    0.57*  17.79
    8        999  2.8109027E+04  5.53E+02    1.97    0.62   16.55
 |-----------------------------------------------------------------------------|
    8       2997  2.9576611E+04  3.22E+02    1.09    0.60   16.55    5.38   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Initializing integration for process ep_2_q1:
 | Beam structure: p, A => pdf_builtin, none
 | Beam data (collision):
 |   p  (mass = 0.0000000E+00 GeV)
 |   A  (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ep_2_q1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ep_2_q1'
 |   Library name  = 'ep_2_lib'
 |   Process index = 3
 |   Process components:
 |     1: 'ep_2_q1_i1':   u, A => A, u [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: pdf_builtin, none
 | Beam structure: 1 channels, 1 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'ep_2_q1'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 3 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        999  2.2336268E+04  4.60E+03   20.58    6.50*   1.16
    2        999  2.8528596E+04  1.83E+03    6.42    2.03*   6.51
    3        999  3.0843141E+04  9.52E+02    3.09    0.98*  14.57
    4        999  2.9186505E+04  7.06E+02    2.42    0.76*  13.29
    5        999  2.9592321E+04  5.77E+02    1.95    0.62*  26.33
 |-----------------------------------------------------------------------------|
    5       4995  2.9577391E+04  3.93E+02    1.33    0.94   26.33    1.22   5
 |-----------------------------------------------------------------------------|
    6        999  2.8638694E+04  5.71E+02    1.99    0.63   22.49
    7        999  2.8915831E+04  5.73E+02    1.98    0.63*  21.87
    8        999  2.8276971E+04  5.53E+02    1.96    0.62*  21.38
 |-----------------------------------------------------------------------------|
    8       2997  2.8602459E+04  3.26E+02    1.14    0.62   21.38    0.32   3
 |=============================================================================|
 epa_x_min =  1.000000000000E-01
 epa_mass =  5.109970000000E-04
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process ep_2_p2:
 | Beam structure: e-, p => epa, pdf_builtin
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   p   (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ep_2_p2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ep_2_p2'
 |   Library name  = 'ep_2_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'ep_2_p2_i1':   A, u => A, u [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, pdf_builtin
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'ep_2_p2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  2.0971640E+03  2.61E+02   12.42    3.93*   2.66
-   2        999  2.3639786E+03  1.37E+02    5.80    1.83*   5.50
-   3        999  2.5364680E+03  1.08E+02    4.27    1.35*  10.56
-   4        999  2.4060945E+03  9.43E+01    3.92    1.24*  13.50
-   5        999  2.3483825E+03  8.33E+01    3.55    1.12*  16.31
-|-----------------------------------------------------------------------------|
-   5       4995  2.3964230E+03  4.94E+01    2.06    1.46   16.31    0.85   5
-|-----------------------------------------------------------------------------|
-   6        999  2.3177334E+03  8.26E+01    3.56    1.13   13.20
-   7        999  2.2763476E+03  8.16E+01    3.59    1.13   12.15
-   8        999  2.2938908E+03  8.68E+01    3.78    1.20    9.37
+   1        999  2.0996710E+03  2.61E+02   12.43    3.93*   2.66
+   2        999  2.3606296E+03  1.37E+02    5.80    1.83*   5.55
+   3        999  2.5328365E+03  1.08E+02    4.27    1.35*  10.60
+   4        999  2.4527861E+03  9.87E+01    4.02    1.27*  11.27
+   5        999  2.3357076E+03  8.25E+01    3.53    1.12*  17.21
+|-----------------------------------------------------------------------------|
+   5       4995  2.4020074E+03  4.98E+01    2.07    1.47   17.21    0.95   5
+|-----------------------------------------------------------------------------|
+   6        999  2.3192942E+03  8.39E+01    3.62    1.14   14.93
+   7        999  2.2510219E+03  8.05E+01    3.58    1.13*  12.98
+   8        999  2.2790822E+03  8.48E+01    3.72    1.18   10.80
 |-----------------------------------------------------------------------------|
-   8       2997  2.2959079E+03  4.83E+01    2.10    1.15    9.37    0.06   3
+   8       2997  2.2822552E+03  4.79E+01    2.10    1.15   10.80    0.17   3
 |=============================================================================|
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Initializing integration for process ep_2_q2:
 | Beam structure: p, e- => pdf_builtin, epa
 | Beam data (collision):
 |   p   (mass = 0.0000000E+00 GeV)
 |   e-  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'ep_2_q2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'ep_2_q2'
 |   Library name  = 'ep_2_lib'
 |   Process index = 4
 |   Process components:
 |     1: 'ep_2_q2_i1':   u, A => A, u [omega]
 | ------------------------------------------------------------------------
 | Phase space: 3 channels, 2 dimensions
 | Phase space: found 3 channels, collected in 2 groves.
 | Phase space: Using 3 equivalences between channels.
 | Phase space: wood
 | Beam structure: pdf_builtin, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'ep_2_q2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 2 chains, 3 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1        999  2.5267593E+03  3.79E+02   15.01    4.74*   1.76
-   2        999  2.3238030E+03  1.12E+02    4.84    1.53*   8.11
-   3        999  2.2523896E+03  8.33E+01    3.70    1.17*  13.00
-   4        999  2.4212901E+03  8.58E+01    3.54    1.12*  14.30
-   5        999  2.2598343E+03  7.71E+01    3.41    1.08*  15.48
-|-----------------------------------------------------------------------------|
-   5       4995  2.3118325E+03  4.33E+01    1.87    1.32   15.48    0.73   5
-|-----------------------------------------------------------------------------|
-   6        999  2.2009251E+03  7.46E+01    3.39    1.07*  14.79
-   7        999  2.2684545E+03  7.71E+01    3.40    1.07   15.16
-   8        999  2.3791813E+03  8.01E+01    3.37    1.06*  15.18
+   1        999  2.5294262E+03  3.80E+02   15.03    4.75*   1.76
+   2        999  2.3270607E+03  1.13E+02    4.85    1.53*   8.10
+   3        999  2.2554544E+03  8.35E+01    3.70    1.17*  12.88
+   4        999  2.4204189E+03  8.59E+01    3.55    1.12*  14.28
+   5        999  2.2704469E+03  7.83E+01    3.45    1.09*  15.03
+|-----------------------------------------------------------------------------|
+   5       4995  2.3167376E+03  4.35E+01    1.88    1.33   15.03    0.67   5
+|-----------------------------------------------------------------------------|
+   6        999  2.2112124E+03  7.60E+01    3.44    1.09*  14.62
+   7        999  2.2479798E+03  7.67E+01    3.41    1.08*  14.74
+   8        999  2.4001921E+03  8.12E+01    3.38    1.07*  15.00
 |-----------------------------------------------------------------------------|
-   8       2997  2.2786465E+03  4.45E+01    1.95    1.07   15.18    1.34   3
+   8       2997  2.2817533E+03  4.50E+01    1.97    1.08   15.00    1.59   3
 |=============================================================================|
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_1.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_1.ref	(revision 8370)
+++ trunk/share/tests/functional_tests/ref-output-prec/circe1_photons_1.ref	(revision 8371)
@@ -1,227 +1,227 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 $method = "omega"
 | Process library 'circe1_photons_1_lib': recorded process 'circe1_photons_1_p1'
 | Process library 'circe1_photons_1_lib': recorded process 'circe1_photons_1_p2'
 | Process library 'circe1_photons_1_lib': recorded process 'circe1_photons_1_p3'
 | Process library 'circe1_photons_1_lib': recorded process 'circe1_photons_1_p4'
 seed = 0
 | Process library 'circe1_photons_1_lib': compiling ...
 | Process library 'circe1_photons_1_lib': writing makefile
 | Process library 'circe1_photons_1_lib': removing old files
 | Process library 'circe1_photons_1_lib': writing driver
 | Process library 'circe1_photons_1_lib': creating source code
 | Process library 'circe1_photons_1_lib': compiling sources
 | Process library 'circe1_photons_1_lib': linking
 | Process library 'circe1_photons_1_lib': loading
 | Process library 'circe1_photons_1_lib': ... success.
 $phs_method = "wood"
 $integration_method = "vamp"
 sqrts =  5.000000000000E+02
 openmp_num_threads = 1
 [user variable] n = 1000
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process circe1_photons_1_p1:
 | Beam structure: [any particles]
 | Beam data (collision):
 |   A  (mass = 0.0000000E+00 GeV)
 |   A  (mass = 0.0000000E+00 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_1_p1.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_1_p1'
 |   Library name  = 'circe1_photons_1_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'circe1_photons_1_p1_i1':   A, A => m-, m+ [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_1_p1'
 | Integrate: iterations = 3:1000:"g", 3:1000
 | Integrator: 1 chains, 4 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        800  7.2013796E+03  8.03E+01    1.12    0.32*  59.65
    2        800  7.1156829E+03  7.28E+01    1.02    0.29*  25.90
    3        800  7.1457172E+03  5.40E+01    0.76    0.21*  40.03
 |-----------------------------------------------------------------------------|
    3       2400  7.1500260E+03  3.81E+01    0.53    0.26   40.03    0.32   3
 |-----------------------------------------------------------------------------|
    4        800  7.1750086E+03  4.75E+01    0.66    0.19*  40.14
    5        800  7.0045848E+03  5.01E+01    0.71    0.20   39.19
    6        800  7.1951189E+03  5.08E+01    0.71    0.20*  40.12
 |-----------------------------------------------------------------------------|
    6       2400  7.1260940E+03  2.85E+01    0.40    0.20   40.12    4.40   3
 |=============================================================================|
 epa_x_min =  1.000000000000E-01
 epa_mass =  5.110000000000E-04
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 | Initializing integration for process circe1_photons_1_p2:
 | Beam structure: e-, e+ => epa
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)
 |   e+  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_1_p2.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_1_p2'
 |   Library name  = 'circe1_photons_1_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'circe1_photons_1_p2_i1':   A, A => m-, m+ [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: epa, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_1_p2'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 1 chains, 4 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1       1000  6.5288858E+02  2.50E+01    3.83    1.21*  14.21
-   2       1000  6.4307124E+02  9.67E+00    1.50    0.48*  40.19
-   3       1000  6.3116825E+02  9.31E+00    1.48    0.47*  36.49
-   4       1000  6.3339006E+02  9.32E+00    1.47    0.47*  32.67
-   5       1000  6.0989872E+02  9.23E+00    1.51    0.48   43.62
-|-----------------------------------------------------------------------------|
-   5       5000  6.2985189E+02  4.61E+00    0.73    0.52   43.62    1.89   5
-|-----------------------------------------------------------------------------|
-   6       1000  6.2368414E+02  9.47E+00    1.52    0.48   33.83
-   7       1000  6.1972436E+02  9.40E+00    1.52    0.48*  32.53
-   8       1000  6.3622331E+02  9.31E+00    1.46    0.46*  33.28
+   1       1000  6.5293943E+02  2.49E+01    3.81    1.21*  14.29
+   2       1000  6.4336691E+02  9.66E+00    1.50    0.47*  40.22
+   3       1000  6.3168603E+02  9.32E+00    1.48    0.47*  36.52
+   4       1000  6.3413038E+02  9.34E+00    1.47    0.47*  32.70
+   5       1000  6.1041587E+02  9.23E+00    1.51    0.48   43.62
+|-----------------------------------------------------------------------------|
+   5       5000  6.3036708E+02  4.61E+00    0.73    0.52   43.62    1.87   5
+|-----------------------------------------------------------------------------|
+   6       1000  6.2480563E+02  9.50E+00    1.52    0.48   33.80
+   7       1000  6.1893096E+02  9.40E+00    1.52    0.48*  32.43
+   8       1000  6.3192818E+02  9.26E+00    1.46    0.46*  33.00
 |-----------------------------------------------------------------------------|
-   8       3000  6.2662152E+02  5.42E+00    0.87    0.47   33.28    0.85   3
+   8       3000  6.2529379E+02  5.42E+00    0.87    0.47   33.00    0.49   3
 |=============================================================================|
 $circe1_acc = "TESLA"
 circe1_chat = 2
 ?circe1_generate = true
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 | Initializing integration for process circe1_photons_1_p3:
 | Beam structure: e-, e+ => circe1 => epa
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)
 |   e+  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_1_p3.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_1_p3'
 |   Library name  = 'circe1_photons_1_lib'
 |   Process index = 3
 |   Process components:
 |     1: 'circe1_photons_1_p3_i1':   A, A => m-, m+ [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1 => epa, none => none, epa
 | Beam structure: 1 channels, 2 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_1_p3'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 1 chains, 4 channels, 4 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
-   1       1000  5.9727301E+02  2.32E+01    3.89    1.23*  15.16
-   2       1000  6.4830974E+02  1.06E+01    1.63    0.51*  40.30
-   3       1000  6.5061319E+02  9.39E+00    1.44    0.46*  31.45
-   4       1000  6.4633994E+02  9.80E+00    1.52    0.48   26.65
-   5       1000  6.4932002E+02  9.09E+00    1.40    0.44*  41.16
-|-----------------------------------------------------------------------------|
-   5       5000  6.4659613E+02  4.73E+00    0.73    0.52   41.16    1.20   5
-|-----------------------------------------------------------------------------|
-   6       1000  6.3854940E+02  9.24E+00    1.45    0.46   33.09
-   7       1000  6.4749417E+02  9.09E+00    1.40    0.44*  31.15
-   8       1000  6.4063320E+02  8.90E+00    1.39    0.44*  30.82
+   1       1000  5.9763043E+02  2.32E+01    3.88    1.23*  15.24
+   2       1000  6.4856263E+02  1.05E+01    1.63    0.51*  40.37
+   3       1000  6.5090899E+02  9.39E+00    1.44    0.46*  31.46
+   4       1000  6.4671784E+02  9.80E+00    1.52    0.48   26.66
+   5       1000  6.4818885E+02  9.10E+00    1.40    0.44*  41.39
+|-----------------------------------------------------------------------------|
+   5       5000  6.4650924E+02  4.73E+00    0.73    0.52   41.39    1.18   5
+|-----------------------------------------------------------------------------|
+   6       1000  6.3913110E+02  9.25E+00    1.45    0.46   33.12
+   7       1000  6.4761237E+02  9.09E+00    1.40    0.44*  31.17
+   8       1000  6.4069364E+02  8.90E+00    1.39    0.44*  30.84
 |-----------------------------------------------------------------------------|
-   8       3000  6.4224167E+02  5.24E+00    0.82    0.45   30.82    0.26   3
+   8       3000  6.4248925E+02  5.24E+00    0.82    0.45   30.84    0.25   3
 |=============================================================================|
 [user variable] n = 1000
 ?circe1_photon1 = true
 ?circe1_photon2 = true
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 4
 | Initializing integration for process circe1_photons_1_p4:
 | Beam structure: e-, e+ => circe1
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)
 |   e+  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE1: activating generator mode
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 5
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'circe1_photons_1_p4.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'circe1_photons_1_p4'
 |   Library name  = 'circe1_photons_1_lib'
 |   Process index = 4
 |   Process components:
 |     1: 'circe1_photons_1_p4_i1':   A, A => m-, m+ [omega]
 | ------------------------------------------------------------------------
 | Phase space: 4 channels, 2 dimensions
 | Phase space: found 4 channels, collected in 1 grove.
 | Phase space: Using 8 equivalences between channels.
 | Phase space: wood
 | Beam structure: circe1
 | Beam structure: 1 channels, 0 dimensions
 | Applying user-defined cuts.
 | Starting integration for process 'circe1_photons_1_p4'
 | Integrate: iterations = 5:1000:"g", 3:1000
 | Integrator: 1 chains, 4 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 1000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        800  7.9004458E+03  2.81E+03   35.63   10.08*   0.94
    2        800  2.1173742E+03  1.09E+03   51.28   14.51    0.60
    3        800  4.3818702E+03  1.44E+03   32.75    9.26*   1.08
    4        800  7.8531593E+03  3.94E+03   50.13   14.18    0.71
    5        800  4.7985507E+03  2.04E+03   42.53   12.03*   0.77
 |-----------------------------------------------------------------------------|
    5       4000  3.7287815E+03  7.53E+02   20.19   12.77    0.77    1.49   5
 |-----------------------------------------------------------------------------|
    6        800  5.0234385E+03  2.61E+03   52.05   14.72    0.55
    7        800  8.7248466E+03  2.77E+03   31.71    8.97*   0.73
    8        800  5.0425301E+03  2.13E+03   42.15   11.92    0.42
 |-----------------------------------------------------------------------------|
    8       2400  6.0022839E+03  1.42E+03   23.60   11.56    0.42    0.66   3
 |=============================================================================|
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/ChangeLog
===================================================================
--- trunk/ChangeLog	(revision 8370)
+++ trunk/ChangeLog	(revision 8371)
@@ -1,1990 +1,1993 @@
 ChangeLog -- Summary of changes to the WHIZARD package
 
 Use svn log to see detailed changes.
 
 	Version 2.8.3
 
 2020-01-09
 	RELEASE: version 2.8.3
 
+2020-01-28
+	Bugfix for left-over EPA parameter epa_e_max (replaced by epa_q_max)
+
 2020-01-23
 	Bugfix for real components of NLO QCD 2->1 processes
 
 2020-01-22
         Bug fix: correct random number sequencing during parallel MPI event
 	   generation with rng_stream
 
 2020-01-21
 	Consistent distribution of events during parallel MPI event generation
 
 2020-01-20
 	Bugfix for configure setup for automake v1.16+
 
 2020-01-18
 	General SLHA parameter files for UFO models supported
 
 2020-01-08
 	Bug fix: correctly register RECOLA processes with flavor sums
 
 2019-12-19
 	Support for UFO customized propagators
 	O'Mega unit tests for fermion-number violating interactions
 
 2019-12-10
 	For distribution building: check for graphviz/dot
 	   version 2.40 or newer
 
 2019-11-21
 	Bug fix: alternate setups now work correctly
 	Infrastructure for accessing alpha_QED event-by-event
 	Guard against tiny numbers that break ASCII event output
 	Enable inverse hyperbolic functions as SINDARIN observables
 	Remove old compiler bug workarounds
 
 2019-11-20
 	Allow quoted -e argument, implemented -f option
 
 2019-11-19
 	Bug fix: resonance histories now work also with UFO models
 	Fix in numerical precision of ASCII VAMP2 grids
 
 2019-11-06
 	Add squared matrix elements to the LCIO event header
 
 2019-11-05
 	Do not include RNG state in MD5 sum for CIRCE1/2
 
 2019-11-04
 	Full CIRCE2 ILC 250 and 500 GeV beam spectra added
 	Minor update on LCIO event header information
 
 2019-10-30
 	NLO QCD for final states completed
 	When using Openloops, v2.1.1+ mandatory
 
 2019-10-25
 	Binary grid files for VAMP2 integrator
 
 ##################################################################
 
 2019-10-24
 	RELEASE: version 2.8.2
 
 2019-10-20
 	Bug fix for HepMC linker flags
 
 2019-10-19
 	Support for spin-2 particles from UFO files
 
 2019-09-27
 	LCIO event format allows rescan and alternate weights
 
 2019-09-24
 	Compatibility fix for OCaml v4.08.0+
 
 ##################################################################
 
 2019-09-21
 	RELEASE: version 2.8.1
 
 2019-09-19
 	Carriage return characters in UFO models can be parsed
 	Mathematica symbols in UFO models possible
 	Unused/undefined parameters in UFO models handled
 
 2019-09-13
 	New extended NLO test suite for ee and pp processes
 
 2019-09-09
 	Photon isolation (separation of perturbative and fragmentation
 	   part a la Frixione)
 
 2019-09-05
 	Major progress on NLO QCD for hadron collisions:
 	- correctly assign flavor structures for alpha regions
 	- fix crossing of particles for initial state splittings
 	- correct assignment for PDF factors for real subtractions
 	- fix kinematics for collinear splittings
 	- bug fix for integrated virtual subtraction terms
 
 2019-09-03
 	b and c jet selection in cuts and analysis
 
 2019-08-27
 	Support for Intel MPI
 
 2019-08-20
 	Complete (preliminary) HepMC3 support (incl.
 	   backwards HepMC2 write/read mode)
 
 2019-08-08
 	Bug fix: handle carriage returns in UFO files (non-Unix OS)
 
 ##################################################################
 
 2019-08-07
 	RELEASE: version 2.8.0
 
 2019-07-31
 	Complete WHIZARD UFO interface:
 	- general Lorentz structures
 	- matrix element support for general color factors
 	- missing features: Majorana fermions and SLHA
 
 2019-07-20
 	Make WHIZARD compatible with OCaml 4.08.0+
 
 2019-07-19
 	Fix version testing for LHAPDF 6.2.3 and newer
 	Minimal required OCaml version is now 4.02.3.
 
 2019-04-18
 	Correctly generate ordered FKS tuples for alpha regions
 	   from all possible underlying Born processes
 
 2019-04-08
 	Extended O'Mega/Recola matrix element test suite
 
 2019-03-29
 	Correct identical particle symmetry factors for FKS subtraction
 
 2019-03-28
 	Correct assertion of spin-correlated matrix
 	   elements for hadron collisions
 
 2019-03-27
 	Bug fix for cut-off parameter delta_i for
 	   collinear plus/minus regions
 
 ##################################################################
 
 2019-03-27
 	RELEASE: version 2.7.1
 
 2019-02-19
 	Further infrastructure for HepMC3 interface (v3.01.00)
 
 2019-02-07
 	Explicit configure option for using debugging options
 	Bug fix for performance by removing unnecessary debug operations
 
 2019-01-29
 	Bug fix for DGLAP remnants with cut-off parameter delta_i
 
 2019-01-24
 	Radiative decay neu2 -> neu1 A added to MSSM_Hgg model
 
 ##################################################################
 
 2019-01-21
 	RELEASE: version 2.7.0
 
 2018-12-18
 	Support RECOLA for integrated und unintegrated subtractions
 
 2018-12-11
 	FCNC top-up sector in model SM_top_anom
 
 2018-12-05
 	Use libtirpc instead of SunRPC on Arch Linux etc.
 
 2018-11-30
 	Display rescaling factor for weighted event samples with cuts
 
 2018-11-29
 	Reintroduce check against different masses in flavor sums
 	Bug fix for wrong couplings in the Littlest Higgs model(s)
 
 2018-11-22
 	Bug fix for rescanning events with beam structure
 
 2018-11-09
 	Major refactoring of internal process data
 
 2018-11-02
 	PYTHIA8 interface
 
 2018-10-29
         Flat phase space parametrization with RAMBO (on diet) implemented
 
 2018-10-17
 	Revise extended test suite
 
 2018-09-27
 	Process container for RECOLA processes
 
 2018-09-15
 	Fixes by M. Berggren for PYTHIA6 interface
 
 2018-09-14
 	First fixes after HepForge modernization
 
 ##################################################################
 
 2018-08-23
 	RELEASE: version 2.6.4
 
 2018-08-09
 	Infrastructure to check colored subevents
 
 2018-07-10
 	Infrastructure for running WHIZARD in batch mode
 
 2018-07-04
 	MPI available from distribution tarball
 
 2018-06-03
 	Support Intel Fortran Compiler under MAC OS X
 
 2018-05-07
 	FKS slicing parameter delta_i (initial state) implementend
 
 2018-05-03
 	Refactor structure function assignment for NLO
 
 2018-05-02
 	FKS slicing parameter xi_cut, delta_0 implemented
 
 2018-04-20
 	Workspace subdirectory for process integration (grid/phs files)
 	Packing/unpacking of files at job end/start
 	Exporting integration results from scan loops
 
 2018-04-13
 	Extended QCD NLO test suite
 
 2018-04-09
 	Bug fix for Higgs Singlet Extension model
 
 2018-04-06
 	Workspace subdirectory for process generation and compilation
 	--job-id option for creating job-specific names
 
 2018-03-20
 	Bug fix for color flow matching in hadron collisions
 	   with identical initial state quarks
 
 2018-03-08
 	Structure functions quantum numbers correctly assigned for NLO
 
 2018-02-24
 	Configure setup includes 'pgfortran' and 'flang'
 
 2018-02-21
 	Include spin-correlated matrix elements in interactions
 
 2018-02-15
 	Separate module for QED ISR structure functions
 
 ##################################################################
 
 2018-02-10
 	RELEASE: version 2.6.3
 
 2018-02-08
 	Improvements in memory management for PS generation
 
 2018-01-31
 	Partial refactoring: quantum number assigment NLO
 	Initial-state QCD splittings for hadron collisions
 
 2018-01-25
 	Bug fix for weighted events with VAMP2
 
 2018-01-17
 	Generalized interface for Recola versions 1.3+  and 2.1+
 
 2018-01-15
 	Channel equivalences also for VAMP2 integrator
 
 2018-01-12
 	Fix for OCaml compiler 4.06 (and newer)
 
 2017-12-19
 	RECOLA matrix elements with flavor sums can be integrated
 
 2017-12-18
 	Bug fix for segmentation fault in empty resonance histories
 
 2017-12-16
 	Fixing a bug in PYTHIA6 PYHEPC routine by omitting CMShowers
 	  from transferral between PYTHIA and WHIZARD event records
 
 2017-12-15
 	Event index for multiple processes in event file correct
 
 ##################################################################
 
 2017-12-13
 	RELEASE: version 2.6.2
 
 2017-12-07
 	User can set offset in event numbers
 
 2017-11-29
 	Possibility to have more than one RECOLA process in one file
 
 2017-11-23
 	Transversal/mixed (and unitarized) dim-8 operators
 
 2017-11-16
 	epa_q_max replaces epa_e_max (trivial factor 2)
 
 2017-11-15
 	O'Mega matrix element compilation silent now
 
 2017-11-14
 	Complete expanded P-wave form factor for top threshold
 
 2017-11-10
 	Incoming particles can be accessed in SINDARIN
 
 2017-11-08
 	Improved handling of resonance insertion, additional parameters
 
 2017-11-04
 	Added Higgs-electron coupling (SM_Higgs)
 
 ##################################################################
 
 2017-11-03
 	RELEASE: version 2.6.1
 
 2017-10-20
 	More than 5 NLO components possible at same time
 
 2017-10-19
 	Gaussian cutoff for shower resonance matching
 
 2017-10-12
 	Alternative (more efficient) method to generate
 	   phase space file
 
 2017-10-11
 	Bug fix for shower resonance histories for processes
 	   with multiple components
 
 2017-09-25
 	Bugfix for process libraries in shower resonance histories
 
 2017-09-21
 	Correctly generate pT distribution for EPA remnants
 
 2017-09-20
 	Set branching ratios for unstable particles also by hand
 
 2017-09-14
 	Correctly generate pT distribution for ISR photons
 
 ##################################################################
 
 2017-09-08
 	RELEASE: version 2.6.0
 
 2017-09-05
 	Bug fix for initial state NLO QCD flavor structures
 	Real and virtual NLO QCD hadron collider processes
 	   work with internal interactions
 
 2017-09-04
 	Fully validated MPI integration and event generation
 
 2017-09-01
 	Resonance histories for shower: full support
 	Bug fix in O'Mega model constraints
 	O'Mega allows to output a parsable form of the DAG
 
 2017-08-24
 	Resonance histories in events for transferral
 	   to parton shower (e.g. in ee -> jjjj)
 
 2017-08-01
 	Alpha version of HepMC v3 interface
 	   (not yet really functional)
 
 2017-07-31
 	Beta version for RECOLA OLP support
 
 2017-07-06
 	Radiation generator fix for LHC processes
 
 2017-06-30
 	Fix bug for NLO with structure
 	   functions and/or polarization
 
 2017-06-23
 	Collinear limit for QED corrections works
 
 2017-06-17
 	POWHEG grids generated already during integration
 
 2017-06-12
 	Soft limit for QED corrections works
 
 2017-05-16
 	Beta version of full MPI parallelization (VAMP2)
 	Check consistency of POWHEG grid files
 	Logfile config-summary.log for configure summary
 
 2017-05-12
 	Allow polarization in top threshold
 
 2017-05-09
 	Minimal demand automake 1.12.2
 	Silent rules for make procedures
 
 2017-05-07
 	Major fix for POWHEG damping
 	Correctly initialize FKS ISR phasespace
 
 ##################################################################
 
 2017-05-06
 	RELEASE: version 2.5.0
 
 2017-05-05
 	Full UFO support (SM-like models)
 	Fixed-beam ISR FKS phase space
 
 2017-04-26
 	QED splittings in radiation generator
 
 2017-04-10
 	Retire deprecated O'Mega vertex cache files
 
 ##################################################################
 
 2017-03-24
 	RELEASE: version 2.4.1
 
 2017-03-16
 	Distinguish resonance charge in phase space channels
 	Keep track of resonance histories in phase space
 	Complex mass scheme default for OpenLoops amplitudes
 
 2017-03-13
 	Fix helicities for polarized OpenLoops calculations
 
 2017-03-09
 	Possibility to advance RNG state in rng_stream
 
 2017-03-04
 	General setup for partitioning real emission
 	   phase space
 
 2017-03-06
 	Bugfix on rescan command for converting event files
 
 2017-02-27
 	Alternative multi-channel VEGAS implementation
 	   VAMP2: serial backbone for MPI setup
 	Smoothstep top threshold matching
 
 2017-02-25
 	Single-beam structure function with
 	   s-channel mapping supported
 	Safeguard against invalid process libraries
 
 2017-02-16
 	Radiation generator for photon emission
 
 2017-02-10
 	Fixes for NLO QCD processes (color correlations)
 
 2017-01-16
 	LCIO variable takes precedence over LCIO_DIR
 
 2017-01-13
 	Alternative random number generator
 	   rng_stream (cf. L'Ecuyer et al.)
 
 2017-01-01
 	Fix for multi-flavor BLHA tree
 	   matrix elements
 
 2016-12-31
 	Grid path option for VAMP grids
 
 2016-12-28
 	Alpha version of Recola OLP support
 
 2016-12-27
 	Dalitz plots for FKS phase space
 
 2016-12-14
 	NLO multi-flavor events possible
 
 2016-12-09
 	LCIO event header information added
 
 2016-12-02
 	Alpha version of RECOLA interface
 	Bugfix for generator status in LCIO
 
 ##################################################################
 
 2016-11-28
 	RELEASE: version 2.4.0
 
 2016-11-24
 	Bugfix for OpenLoops interface: EW scheme
 	   is set by WHIZARD
 	Bugfixes for top threshold implementation
 
 2016-11-11
 	Refactoring of dispatching
 
 2016-10-18
 	Bug fix for LCIO output
 
 2016-10-10
 	First implementation for collinear soft terms
 
 2016-10-06
 	First full WHIZARD models from UFO files
 
 2016-10-05
 	WHIZARD does not support legacy gcc 4.7.4 any longer
 
 2016-09-30
 	Major refactoring of process core and NLO components
 
 2016-09-23
 	WHIZARD homogeneous entity: discarding subconfigures
 	  for CIRCE1/2, O'Mega, VAMP subpackages; these are
 	  reconstructable by script projectors
 
 2016-09-06
 	Introduce main configure summary
 
 2016-08-26
 	Fix memory leak in event generation
 
 ##################################################################
 
 2016-08-25
 	RELEASE: version 2.3.1
 
 2016-08-19
 	Bug fix for EW-scheme dependence of gluino propagators
 
 2016-08-01
 	Beta version of complex mass scheme support
 
 2016-07-26
 	Fix bug in POWHEG damping for the matching
 
 ##################################################################
 
 2016-07-21
 	RELEASE: version 2.3.0
 
 2016-07-20
 	UFO file support (alpha version) in O'Mega
 
 2016-07-13
 	New (more) stable of WHIZARD GUI
 	Support for EW schemes for OpenLoops
 	Factorized NLO top decays for threshold model
 
 2016-06-15
 	Passing factorization scale to PYTHIA6
 	Adding charge and neutral observables
 
 2016-06-14
 	Correcting angular distribution/tweaked kinematics in
 	   non-collinear structure functions splittings
 
 2016-05-10
 	Include (Fortran) TAUOLA/PHOTOS for tau decays via PYTHIA6
 	   (backwards validation of LC CDR/TDR samples)
 
 2016-04-27
 	Within OpenLoops virtuals: support for Collier library
 
 2016-04-25
 	O'Mega vertex tables only loaded at first usage
 
 2016-04-21
 	New CJ15 PDF parameterizations added
 
 2016-04-21
 	Support for hadron collisions at NLO QCD
 
 2016-04-05
 	Support for different (parameter) schemes in model files
 
 2016-03-31
 	Correct transferral of lifetime/vertex from PYTHIA/TAUOLA
 	  into the event record
 
 2016-03-21
 	New internal implementation of polarization
 	  via Bloch vectors, remove pointer constructions
 
 2016-03-13
 	Extension of cascade syntax for processes:
 	  exclude propagators/vertices etc. possible
 
 2016-02-24
 	Full support for OpenLoops QCD NLO matrix
 	  elements, inclusion in test suite
 
 2016-02-12
 	Substantial progress on QCD NLO support
 
 2016-02-02
 	Automated resonance mapping for FKS subtraction
 
 2015-12-17
 	New BSM model WZW for diphoton resonances
 
 ##################################################################
 
 2015-11-22
 	RELEASE: version 2.2.8
 
 2015-11-21
 	Bugfix for fixed-order NLO events
 
 2015-11-20
 	Anomalous FCNC top-charm vertices
 
 2015-11-19
 	StdHEP output via HEPEVT/HEPEV4 supported
 
 2015-11-18
 	Full set of electroweak dim-6 operators included
 
 2015-10-22
 	Polarized one-loop amplitudes supported
 
 2015-10-21
 	Fixes for event formats for showered events
 
 2015-10-14
 	Callback mechanism for event output
 
 2015-09-22
 	Bypass matrix elements in pure event sample rescans
 	StdHep frozen final version v5.06.01 included internally
 
 2015-09-21
 	configure option --with-precision to
 	  demand 64bit, 80bit, or 128bit Fortran
 	  and bind C precision types
 
 2015-09-07
 	More extensive tests of NLO
 	   infrastructure and POWHEG matching
 
 2015-09-01
 	NLO decay infrastructure
 	User-defined squared matrix elements
 	Inclusive FastJet algorithm plugin
 	Numerical improvement for small boosts
 
 ##################################################################
 
 2015-08-11
 	RELEASE: version 2.2.7
 
 2015-08-10
 	Infrastructure for damped POWHEG
 	Massive emitters in POWHEG
 	Born matrix elements via BLHA
 	GoSam filters via SINDARIN
 	Minor running coupling bug fixes
 	Fixed-order NLO events
 
 2015-08-06
 	CT14 PDFs included (LO, NLO, NNLL)
 
 2015-07-07
 	Revalidation of ILC WHIZARD-PYTHIA event chain
 	Extended test suite for showered events
 	Alpha version of massive FSR for POWHEG
 
 2015-06-09
 	Fix memory leak in interaction for long cascades
 	Catch mismatch between beam definition and CIRCE2 spectrum
 
 2015-06-08
 	Automated POWHEG matching: beta version
 	Infrastructure for GKS matching
 	Alpha version of fixed-order NLO events
 	CIRCE2 polarization averaged spectra with
 	   explicitly polarized beams
 
 2015-05-12
 	Abstract matching type: OO structure for matching/merging
 
 2015-05-07
 	Bug fix in event record WHIZARD-PYTHIA6 transferral
 	Gaussian beam spectra for lepton colliders
 
 ##################################################################
 
 2015-05-02
 	RELEASE: version 2.2.6
 
 2015-05-01
 	Models for (unitarized) tensor resonances in VBS
 
 2015-04-28
 	Bug fix in channel weights for event generation.
 
 2015-04-18
 	Improved event record transfer WHIZARD/PYTHIA6
 
 2015-03-19
 	POWHEG matching: alpha version
 
 ##################################################################
 
 2015-02-27
 	RELEASE: version 2.2.5
 
 2015-02-26
 	Abstract types for quantum numbers
 
 2015-02-25
 	Read-in of StdHEP events, self-tests
 
 2015-02-22
 	Bugfix for mother-daughter relations in
 	   showered/hadronized events
 
 2015-02-20
 	Projection on polarization in intermediate states
 
 2015-02-13
 	Correct treatment of beam remnants in
 	   event formats (also LC remnants)
 
 ##################################################################
 
 2015-02-06
 	RELEASE: version 2.2.4
 
 2015-02-06
 	Bugfix in event output
 
 2015-02-05
 	LCIO event format supported
 
 2015-01-30
 	Including state matrices in WHIZARD's internal IO
 	Versioning for WHIZARD's internal IO
 	Libtool update from 2.4.3 to 2.4.5
 	LCIO event output (beta version)
 
 2015-01-27
 	Progress on NLO integration
 	Fixing a bug for multiple processes in a single
 	   event file when using beam event files
 
 2015-01-19
 	Bug fix for spin correlations evaluated in the rest
 	   frame of the mother particle
 
 2015-01-17
 	Regression fix for statically linked processes
 	   from SARAH and FeynRules
 
 2015-01-10
 	NLO: massive FKS emitters supported (experimental)
 
 2015-01-06
 	MMHT2014 PDF sets included
 
 2015-01-05
 	Handling mass degeneracies in auto_decays
 
 2014-12-19
 	Fixing bug in rescan of event files
 
 ##################################################################
 
 2014-11-30
 	RELEASE: version 2.2.3
 
 2014-11-29
 	Beta version of LO continuum/NLL-threshold
 	matched top threshold model for e+e- physics
 
 2014-11-28
 	More internal refactoring: disentanglement of module
 	   dependencies
 
 2014-11-21
 	OVM: O'Mega Virtual Machine, bytecode instructions
 	   instead of compiled Fortran code
 
 2014-11-01
 	Higgs Singlet extension model included
 
 2014-10-18
 	Internal restructuring of code; half-way
 	  WHIZARD main code file disassembled
 
 2014-07-09
 	Alpha version of NLO infrastructure
 
 ##################################################################
 
 2014-07-06
 	RELEASE: version 2.2.2
 
 2014-07-05
 	CIRCE2: correlated LC beam spectra and
 	  GuineaPig Interface to LC machine parameters
 
 2014-07-01
 	Reading LHEF for decayed/factorized/showered/
 	   hadronized events
 
 2014-06-25
 	Configure support for GoSAM/Ninja/Form/QGraf
 
 2014-06-22
 	LHAPDF6 interface
 
 2014-06-18
 	Module for automatic generation of
 	  radiation and loop infrastructure code
 
 2014-06-11
 	Improved internal directory structure
 
 ##################################################################
 
 2014-06-03
 	RELEASE: version 2.2.1
 
 2014-05-30
 	Extensions of internal PDG arrays
 
 2014-05-26
 	FastJet interface
 
 2014-05-24
 	CJ12 PDFs included
 
 2014-05-20
 	Regression fix for external models (via SARAH
 	    or FeynRules)
 
 ##################################################################
 
 2014-05-18
 	RELEASE: version 2.2.0
 
 2014-04-11
 	Multiple components: inclusive process definitions,
 	   syntax: process A + B + ...
 
 2014-03-13
 	Improved PS mappings for e+e- ISR
 	ILC TDR and CLIC spectra included in CIRCE1
 
 2014-02-23
 	New models: AltH w\ Higgs for exclusion purposes,
 	  SM_rx for Dim 6-/Dim-8 operators, SSC for
 	  general strong interactions (w/ Higgs), and
 	  NoH_rx (w\ Higgs)
 
 2014-02-14
 	Improved s-channel mapping, new on-shell
 	  production mapping (e.g. Drell-Yan)
 
 2014-02-03
 	PRE-RELEASE: version 2.2.0_beta
 
 2014-01-26
 	O'Mega: Feynman diagram generation possible (again)
 
 2013-12-16
 	HOPPET interface for b parton matching
 
 2013-11-15
 	PRE-RELEASE: version 2.2.0_alpha-4
 
 2013-10-27
 	LHEF standards 1.0/2.0/3.0 implemented
 
 2013-10-15
 	PRE-RELEASE: version 2.2.0_alpha-3
 
 2013-10-02
 	PRE-RELEASE: version 2.2.0_alpha-2
 
 2013-09-25
 	PRE-RELEASE: version 2.2.0_alpha-1
 
 2013-09-12
 	PRE-RELEASE: version 2.2.0_alpha
 
 2013-09-03
 	General 2HDM implemented
 
 2013-08-18
 	Rescanning/recalculating events
 
 2013-06-07
 	Reconstruction of complete event
 	  from 4-momenta possible
 
 2013-05-06
 	Process library stacks
 
 2013-05-02
 	Process stacks
 
 2013-04-29
 	Single-particle phase space module
 
 2013-04-26
 	Abstract interface for random
 	  number generator
 
 2013-04-24
 	More object-orientation on modules
 	Midpoint-rule integrator
 
 2013-04-05
 	Object-oriented integration and
 	  event generation
 
 2013-03-12
 	Processes recasted object-oriented:
 	  MEs, scales, structure functions
 	First infrastructure for general Lorentz
 	  structures
 
 2013-01-17
 	Object-orientated reworking of library and
 	   process core, more variable internal structure,
 	   unit tests
 
 2012-12-14
 	Update Pythia version to 6.4.27
 
 2012-12-04
 	Fix the phase in HAZ vertices
 
 2012-11-21
 	First O'Mega unit tests, some infrastructure
 
 2012-11-13
 	Bugfix in anom. HVV Lorentz structures
 
 ##################################################################
 
 2012-09-18
 	RELEASE: version 2.1.1
 
 2012-09-11
 	Model MSSM_Hgg with Hgg and HAA vertices
 
 2012-09-10
 	First version of implementation of multiple
 	   interactions in WHIZARD
 
 2012-09-05
 	Infrastructure for internal CKKW matching
 
 2012-09-02
 	C, C++, Python API
 
 2012-07-19
 	Fixing particle numbering in HepMC format
 
 ##################################################################
 
 2012-06-15
 	RELEASE: version 2.1.0
 
 2012-06-14
 	Analytical and kT-ordered shower officially
 	  released
 	PYTHIA interface officially released
 
 2012-05-09
 	Intrisince PDFs can be used for showering
 
 2012-05-04
 	Anomalous Higgs couplings a la hep-ph/9902321
 
 ##################################################################
 
 2012-03-19
 	RELEASE: version 2.0.7
 
 2012-03-15
 	Run IDs are available now
 	More event variables in analysis
 	Modified raw event format (compatibility mode exists)
 
 2012-03-12
 	Bugfix in decay-integration order
 	MLM matching steered completely internally now
 
 2012-03-09
 	Special phase space mapping for narrow resonances
 	  decaying to 4-particle final states with far off-shell
 	  intermediate states
 	Running alphas from PDF collaborations with
 	  builtin PDFs
 
 2012-02-16
 	Bug fix in cascades decay infrastructure
 
 2012-02-04
 	WHIZARD documentation compatible with TeXLive 2011
 
 2012-02-01
 	Bug fix in FeynRules interface with --prefix flag
 
 2012-01-29
 	Bug fix with name clash of O'Mega variable names
 
 2012-01-27
 	Update internal PYTHIA to version 6.4.26
 	Bug fix in LHEF output
 
 2012-01-21
 	Catching stricter automake 1.11.2 rules
 
 2011-12-23
 	Bug fix in decay cascade setup
 
 2011-12-20
 	Bug fix in helicity selection rules
 
 2011-12-16
 	Accuracy goal reimplemented
 
 2011-12-14
 	WHIZARD compatible with TeXLive 2011
 
 2011-12-09
 	Option --user-target added
 
 ##################################################################
 
 2011-12-07
 	RELEASE: version 2.0.6
 
 2011-12-07
 	Bug fixes in SM_top_anom
 	Added missing entries to HepMC format
 
 2011-12-06
 	Allow to pass options to O'Mega
 	Bug fix for HEPEVT block for showered/hadronized events
 
 2011-12-01
 	Reenabled user plug-in for external code for
 	   cuts, structure functions, routines etc.
 
 2011-11-29
 	Changed model SM_Higgs for Higgs phenomenology
 
 2011-11-25
 	Supporting a Y, (B-L) Z' model
 
 2011-11-23
 	Make WHIZARD compatible for MAC OS X Lion/XCode 4
 
 2011-09-25
 	WHIZARD paper published: Eur.Phys.J. C71 (2011) 1742
 
 2011-08-16
 	Model SM_QCD: QCD with one EW insertion
 
 2011-07-19
 	Explicit output channel for dvips avoids printing
 
 2011-07-10
 	Test suite for WHIZARD unit tests
 
 2011-07-01
 	Commands for matrix element tests
 	More OpenMP parallelization of kinematics
 	Added unit tests
 
 2011-06-23
 	Conversion of CIRCE2 from F77 to F90, major
 	  clean-up
 
 2011-06-14
 	Conversion of CIRCE1 from F77 to F90
 
 2011-06-10
 	OpenMP parallelization of channel kinematics
 		(by Matthias Trudewind)
 
 2011-05-31
 	RELEASE: version 1.97
 
 2011-05-24
 	Minor bug fixes: update grids and elsif statement.
 
 ##################################################################
 
 2011-05-10
 	RELEASE: version 2.0.5
 
 2011-05-09
 	Fixed bug in final state flavor sums
 	Minor improvements on phase-space setup
 
 2011-05-05
 	Minor bug fixes
 
 2011-04-15
 	WHIZARD as a precompiled 64-bit binary available
 
 2011-04-06
 	Wall clock instead of cpu time for time estimates
 
 2011-04-05
 	Major improvement on the phase space setup
 
 2011-04-02
 	OpenMP parallelization for helicity loop in O'Mega
 	   matrix elements
 
 2011-03-31
 	Tools for relocating WHIZARD and use in batch
 	environments
 
 2011-03-29
 	Completely static builds possible, profiling options
 
 2011-03-28
 	Visualization of integration history
 
 2011-03-27
 	Fixed broken K-matrix implementation
 
 2011-03-23
 	Including the GAMELAN manual in the distribution
 
 2011-01-26
 	WHIZARD analysis can handle hadronized event files
 
 2011-01-17
 	MSTW2008 and CT10 PDF sets included
 
 2010-12-23
 	Inclusion of NMSSM with Hgg couplings
 
 2010-12-21
 	Advanced options for integration passes
 
 2010-11-16
 	WHIZARD supports CTEQ6 and possibly other PDFs
 	directly; data files included in the distribution
 
 ##################################################################
 
 2010-10-26
 	RELEASE: version 2.0.4
 
 2010-10-06
 	Bug fix in MSSM implementation
 
 2010-10-01
 	Update to libtool 2.4
 
 2010-09-29
 	Support for anomalous top couplings (form factors etc.)
 	Bug fix for running gauge Yukawa SUSY couplings
 
 2010-09-28
 	RELEASE: version 1.96
 
 2010-09-21
 	Beam remnants and pT spectra for lepton collider re-enabled
 	Restructuring subevt class
 
 2010-09-16
 	Shower and matching are disabled by default
 	PYTHIA as a conditional on these two options
 
 2010-09-14
 	Possibility to read in beam spectra re-enabled (e.g. Guinea
 	   Pig)
 
 2010-09-13
 	Energy scan as (pseudo-) structure functions re-implemented
 
 2010-09-10
 	CIRCE2 included again in WHIZARD 2 and validated
 
 2010-09-02
 	Re-implementation of asymmetric beam energies and collision
 	  angles, e-p collisions work, inclusion of a HERA DIS test
 	  case
 
 ##################################################################
 
 2010-10-18
 	RELEASE: version 2.0.3
 
 2010-08-08
 	Bug in CP-violating anomalous triple TGCs fixed
 
 2010-08-06
 	Solving backwards compatibility problem with O'Caml 3.12.0
 
 2010-07-12
 	Conserved quantum numbers speed up O'Mega code generation
 
 2010-07-07
 	Attaching full ISR/FSR parton shower and MPI/ISR
 	   module
 	Added SM model containing Hgg, HAA, HAZ vertices
 
 2010-07-02
 	Matching output available as LHEF and STDHEP
 
 2010-06-30
 	Various bug fixes, missing files, typos
 
 2010-06-26
 	CIRCE1 completely re-enabled
 	Chaining structure functions supported
 
 2010-06-25
 	Partial support for conserved quantum numbers in
 	   O'Mega
 
 2010-06-21
 	Major upgrade of the graphics package: error bars,
 	   smarter SINDARIN steering, documentation, and all that...
 
 2010-06-17
 	MLM matching with PYTHIA shower included
 
 2010-06-16
 	Added full CIRCE1 and CIRCE2 versions including
 	full documentation and miscellanea to the trunk
 
 2010-06-12
 	User file management supported, improved variable
 	and command structure
 
 2010-05-24
 	Improved handling of variables in local command lists
 
 2010-05-20
 	PYTHIA interface re-enabled
 
 2010-05-19
 	ASCII file formats for interfacing ROOT and gnuplot in
 	   data analysis
 
 ##################################################################
 
 2010-05-18
 	RELEASE: version 2.0.2
 
 2010-05-14
 	Reimplementation of visualization of phase space
 	   channels
 	Minor bug fixes
 
 2010-05-12
 	Improved phase space - elimination of redundancies
 
 2010-05-08
 	Interface for polarization completed: polarized beams etc.
 
 2010-05-06
 	Full quantum numbers appear in process log
 	Integration results are usable as user variables
 	Communication with external programs
 
 2010-05-05
 	Split module commands into commands, integration,
 	   simulation modules
 
 2010-05-04
 	FSR+ISR for the first time connected to the WHIZARD 2 core
 
 ##################################################################
 
 2010-04-25
 	RELEASE: version 2.0.1
 
 2010-04-23
 	Automatic compile and integrate if simulate is called
 	Minor bug fixes in O'Mega
 
 2010-04-21
 	Checkpointing for event generation
 	Flush statements to use WHIZARD inside a pipe
 
 2010-04-20
 	Reimplementation of signal handling in WGIZARD 2.0
 
 2010-04-19
 	VAMP is now a separately configurable and installable unit of
 	   WHIZARD, included VAMP self-checks
 	Support again compilation in quadruple precision
 
 2010-04-06
 	Allow for logarithmic plots in GAMELAN, reimplement the
 	   possibility to set the number of bins
 
 2010-04-15
 	Improvement on time estimates for event generation
 
 ##################################################################
 
 2010-04-12
 	RELEASE: version 2.0.0
 
 2010-04-09
 	Per default, the code for the amplitudes is subdivided to allow
 	  faster compiler optimization
 	More advanced and unified and straightforward command language
 	  syntax
 	Final bug fixes
 
 2010-04-07
 	Improvement on SINDARIN syntax; printf, sprintf function
 	  thorugh a C interface
 
 2010-04-05
 	Colorizing DAGs instead of model vertices: speed boost
 	  in colored code generation
 
 2010-03-31
 	Generalized options for normalization of weighted and
 	  unweighted events
 	Grid and weight histories added again to log files
 	Weights can be used in analyses
 
 2010-03-28
 	Cascade decays completely implemented including color and
 	   spin correlations
 
 2010-03-07
 	Added new WHIZARD header with logo
 
 2010-03-05
 	Removed conflict in O'Mega amplitudes between flavour sums
 	   and cascades
 	StdHEP interface re-implemented
 
 2010-03-03
 	RELEASE: version 2.0.0rc3
 	Several bug fixes for preventing abuse in input files
 	OpenMP support for amplitudes
 	Reimplementation of WHIZARD 1 HEPEVT ASCII event formats
 	FeynRules interface successfully passed MSSM test
 
 2010-02-26
 	Eliminating ghost gluons from multi-gluon amplitudes
 
 2010-02-25
 	RELEASE: version 1.95
 	HEPEVT format from WHIZARD 1 re-implemented in WHIZARD 2
 
 2010-02-23
 	Running alpha_s implemented in the FeynRules interface
 
 2010-02-19
 	MSSM (semi-) automatized self-tests finalized
 
 2010-02-17
 	RELEASE: version 1.94
 
 2010-02-16
 	Closed memory corruption in WHIZARD 1
 	Fixed problems of old MadGraph and CompHep drivers
 	   with modern compilers
 	Uncolored vertex selection rules for colored amplitudes in
 	   O'Mega
 
 2010-02-15
 	Infrastructure for color correlation computation in O'Mega
 	   finished
 	Forbidden processes are warned about, but treated as non-fatal
 
 2010-02-14
 	Color correlation computation in O'Mega finalized
 
 2010-02-10
 	Improving phase space mappings for identical particles in
 	initial and final states
 	Introduction of more extended multi-line error message
 
 2010-02-08
 	First O'Caml code for computation of color correlations in
 	O'Mega
 
 2010-02-07
 	First MLM matching with e+ e- -> jets
 
 ##################################################################
 
 2010-02-06
 	RELEASE: version 2.0.0rc2
 
 2010-02-05
 	Reconsidered the Makefile structure and more extended tests
 	Catch a crash between WHIZARD and O'Mega for forbidden processes
 	Tensor products of arbitrary color structures in jet definitions
 
 2010-02-04
 	Color correlation computation in O'Mega finalized
 
 ##################################################################
 
 2010-02-03
 	RELEASE: version 2.0.0rc1
 
 ##################################################################
 
 2010-01-31
 	Reimplemented numerical helicity selection rules
 	Phase space functionality of version 1 restored and improved
 
 2009-12-05
 	NMSSM validated with FeynRules in WHIZARD 1 (Felix Braam)
 
 2009-12-04
 	RELEASE: version 2.0.0alpha
 
 ##################################################################
 
 2009-04-16
 	RELEASE: version 1.93
 
 2009-04-15
 	Clean-up of Makefiles and configure scripts
 	Reconfiguration of BSM model implementation
 	extended supersymmetric models
 
 2008-12-23
 	New model NMSSM	(Felix Braam)
 	SLHA2 added
 	Bug in LHAPDF interface fixed
 
 2008-08-16
 	Bug fixed in K matrix implementation
 	Gravitino option in the MSSM added
 
 2008-03-20
 	Improved color and flavor sums
 
 ##################################################################
 
 2008-03-12
 	RELEASE: version 1.92
 	LHEF (Les Houches Event File) format added
 	Fortran 2003 command-line interface (if supported by the compiler)
 	Automated interface to colored models
 	More bug fixes and workarounds for compiler compatibility
 
 ##################################################################
 
 2008-03-06
 	RELEASE: version 1.91
 	New model K-matrix (resonances and anom. couplings in WW scattering)
 	EWA spectrum
 	Energy-scan pseudo spectrum
 	Preliminary parton shower module (only from final-state quarks)
 	Cleanup and improvements of configure process
 	Improvements for O'Mega parameter files
 	Quadruple precision works again
 	More plotting options: lines, symbols, errors
 	Documentation with PDF bookmarks enabled
 	Various bug fixes
 
 2007-11-29
 	New model UED
 
 ##################################################################
 
 2007-11-23
 	RELEASE: version 1.90
 	O'Mega now part of the WHIZARD tree
 	Madgraph/CompHEP disabled by default (but still usable)
 	Support for LHAPDF (preliminary)
 	Added new models: SMZprime, SM_km, Template
 	Improved compiler recognition and compatibility
 	Minor bug fixes
 
 ##################################################################
 
 2006-06-15
 	RELEASE: version 1.51
 	Support for anomaly-type Higgs couplings (to gluon and photon/Z)
 	Support for spin 3/2 and spin 2
 	New models: Little Higgs (4 versions), toy models for extra dimensions
           and gravitinos
 	Fixes to the whizard.nw source documentation to run through LaTeX
 	Intel 9.0 bug workaround (deallocation of some arrays)
 
 2006-05-15
 	O'Mega RELEASE: version 0.11
 	merged JRR's O'Mega extensions
 
 ##################################################################
 
 2006-02-07
 	RELEASE: version 1.50
         To avoid confusion: Mention outdated manual example in BUGS file
         O'Mega becomes part of the WHIZARD generator
 
 2006-02-02   [bug fix update]
 	Bug fix: spurious error when writing event files for weighted events
 	Bug fix: 'r' option for omega produced garbage for some particle names
 	Workaround for ifort90 bug (crash when compiling whizard_event)
 	Workaround for ifort90 bug (crash when compiling hepevt_common)
 
 2006-01-27
 	Added process definition files for MSSM 2->2 processes
 	Included beam recoil for EPA (T.Barklow)
 	Updated STDHEP byte counts (for STDHEP 5.04.02)
 	Fixed STDHEP compatibility (avoid linking of incomplete .so libs)
 	Fixed issue with comphep requiring Xlibs on Opteron
 	Fixed issue with ifort 8.x on Opteron (compiling 'signal' interface)
 	Fixed color-flow code: was broken for omega with option 'c' and 'w'
 	Workaround hacks for g95 compatibility
 
 2005-11-07
 	O'Mega RELEASE: version 0.10
 	O'Mega, merged JRR's and WK's color hack for WHiZard
         O'Mega, EXPERIMENTAL: cache fusion tables (required for colors
 	  a la JRR/WK)
         O'Mega, make JRR's MSSM official
 
 ##################################################################
 
 2005-10-25
 	RELEASE: version 1.43
 	Minor fixes in MSSM couplings (Higgs/3rd gen squarks).
 	  This should be final, since the MSSM results agree now completely
           with Madgraph and Sherpa
 	User-defined lower and upper limits for split event file count
 	Allow for counters (events, bytes) exceeding $2^{31}$
 	Revised checksum treatment and implementation (now MD5)
         Bug fix: missing process energy scale in raw event file
 
 ##################################################################
 
 2005-09-30
 	RELEASE: version 1.42
 	Graphical display of integration history ('make history')
 	Allow for switching off signals even if supported (configure option)
 
 2005-09-29
 	Revised phase space generation code, in particular for flavor sums
 	Negative cut and histogram codes use initial beams instead of
 	  initial parton momenta.  This allows for computing, e.g., E_miss
 	Support constant-width and zero-width options for O'Mega
 	Width options now denoted by w:X (X=f,c,z).  f option obsolescent
 	Bug fix: colorized code: flipped indices could screw up result
 	Bug fix: O'Mega with 'c' and 'w:f' option together (still some problem)
 	Bug fix: dvips on systems where dvips defaults to lpr
 	Bug fix: integer overflow if too many events are requested
 
 2005-07-29
 	Allow for 2 -> 1 processes (if structure functions are on)
 
 2005-07-26
 	Fixed and expanded the 'test' matrix element:
 	  Unit matrix element with option 'u' / default: normalized phase space
 
 ##################################################################
 
 2005-07-15
 	RELEASE: version 1.41
 	Bug fix: no result for particle decay processes with width=0
 	Bug fix: line breaks in O'Mega files with color decomposition
 
 2005-06-02
 	New self-tests (make test-QED / test-QCD / test-SM)
 	  check lists of 2->2 processes
 	Bug fix: HELAS calling convention for wwwwxx and jwwwxx (4W-Vertex)
 
 2005-05-25
 	Revised Makefile structure
 	Eliminated obsolete references to ISAJET/SUSY (superseded by SLHA)
 
 2005-05-19
 	Support for color in O'Mega (using color flow decomposition)
 	New model QCD
 	Parameter file changes that correspond to replaced SM module in O'Mega
 	Bug fixes in MSSM (O'Mega) parameter file
 
 2005-05-18
 	New event file formats, useful for LHC applications:
           ATHENA and Les Houches Accord (external fragmentation)
         Naive (i.e., leading 1/N) color factor now implemented both for
           incoming and outgoing partons
 
 2005-01-26
 	include missing HELAS files for bundle
 	pgf90 compatibility issues [note: still internal error in pgf90]
 
 ##################################################################
 
 2004-12-13
 	RELEASE: version 1.40
 	compatibility fix: preprocessor marks in helas code now commented out
 	minor bug fix: format string in madgraph source
 
 2004-12-03
 	support for arbitray beam energies and directions
 	allow for pT kick in structure functions
 	bug fix: rounding error could result in zero cross section
 	  (compiler-dependent)
 
 2004-10-07
 	simulate decay processes
 	list fraction (of total width/cross section) instead of efficiency
           in process summary
 	new cut/analysis parameters AA, AAD, CTA: absolute polar angle
 
 2004-10-04
 	Replaced Madgraph I by Madgraph II.  Main improvement: model no
           longer hardcoded
 	introduced parameter reset_seed_each_process (useful for debugging)
         bug fix: color initialization for some processes was undefined
 
 2004-09-21
 	don't compile unix_args module if it is not required
 
 ##################################################################
 
 2004-09-20
 	RELEASE: version 1.30
 	g95 compatibility issues resolved
 	some (irrelevant) memory leaks closed
 	removed obsolete warning in circe1
 	manual update (essentially) finished
 
 2004-08-03
 	O'Mega RELEASE: version 0.9
 	O'Mega, src/trie.mli, src/trie.ml: make interface compatible with
           the O'Caml 3.08 library (remains compatible with older
           versions).  Implementation of unused functions still
           incomplete.
 
 2004-07-26
 	minor fixes and improvements in make process
 
 2004-06-29
 	workarounds for new Intel compiler bugs ...
 	no rebuild of madgraph/comphep executables after 'make clean'
 	bug fix in phase space routine:
           wrong energy for massive initial particles
         bug fix in (new) model interface: name checks for antiparticles
         pre-run checks for comphep improved
         ww-strong model file extended
         Model files particle name fixes, chep SM vertices included
 
 2004-06-22
 	O'Mega RELEASE: version 0.8
 	O'Mega MSSM: sign of W+/W-/A and W+/W-/Z couplings
 
 2004-05-05
 	Fixed bug in PDFLIB interface: p+pbar was initialized as p+p (ThO)
 	NAG compiler: set number of continuation lines to 200 as default
 	Extended format for cross section summary; appears now in whizard.out
 	Fixed 'bundle' feature
 
 2004-04-28
 	Fixed compatibility with revised O'Mega SM_ac model
 	Fixed problem with x=0 or x=1 when calling PDFLIB (ThO)
 	Fixed bug in comphep module: Vtb was overlooked
 
 ##################################################################
 
 2004-04-15
 	RELEASE: version 1.28
         Fixed bug: Color factor was missing for O'Mega processes with
           four quarks and more
         Manual partially updated
 
 2004-04-08
 	Support for grid files in binary format
 	New default value show_histories=F (reduce output file size)
 	Revised phase space switches: removed annihilation_lines,
 	  removed s_channel_resonance, changed meaning of
 	  extra_off_shell_lines, added show_deleted_channels
 	Bug fixed which lead to omission of some phase space channels
 	Color flow guessed only if requested by guess_color_flow
 
 2004-03-10
 	New model interface: Only one model name specified in whizard.prc
         All model-dependent files reside in conf/models (modellib removed)
 
 2004-03-03
 	Support for input/output in SUSY Les Houches Accord format
 	Split event files if requested
 	Support for overall time limit
 	Support for CIRCE and CIRCE2 generator mode
 	Support for reading beam events from file
 
 2004-02-05
 	Fixed compiler problems with Intel Fortran 7.1 and 8.0
 	Support for catching signals
 
 ##################################################################
 
 2003-08-06
 	RELEASE: version 1.27
 	User-defined PDF libraries as an alternative to the standard PDFLIB
 
 2003-07-23
 	Revised phase space module: improved mappings for massless particles,
 	  equivalences of phase space channels are exploited
 	Improved mapping for PDF (hadron colliders)
 	Madgraph module: increased max number of color flows from 250 to 1000
 
 ##################################################################
 
 2003-06-23
 	RELEASE: version 1.26
 	CIRCE2 support
 	Fixed problem with 'TC' integer kind [Intel compiler complained]
 
 2003-05-28
 	Support for drawing histograms of grids
 	Bug fixes for MSSM definitions
 
 ##################################################################
 
 2003-05-22
 	RELEASE: version 1.25
 	Experimental MSSM support with ISAJET interface
 	Improved capabilities of generating/analyzing weighted events
 	Optional drawing phase space diagrams using FeynMF
 
 ##################################################################
 
 2003-01-31
 	RELEASE: version 1.24
 	A few more fixes and workarounds (Intel and Lahey compiler)
 
 2003-01-15
 	Fixes and workarounds needed for WHIZARD to run with Intel compiler
 	Command-line option interface for the Lahey compiler
 
 	Bug fix: problem with reading whizard.phs
 
 ##################################################################
 
 2002-12-10
 	RELEASE: version 1.23
 
 	Command-line options (on some systems)
 
 	Allow for initial particles in the event record, ordered:
           [beams, initials] - [remnants] - outgoing partons
 
 	Support for PYTHIA 6.2: Les Houches external process interface
 	String pythia_parameters can be up to 1000 characters long
 	Select color flow states in (internal) analysis
 	Bug fix in color flow content of raw event files
 
 	Support for transversal polarization of fermion beams
 	Cut codes: PHI now for absolute azimuthal angle, DPHI for distance
 	'Test' matrix elements optionally respect polarization
 
 	User-defined code can be inserted for spectra, structure functions
           and fragmentation
 
 	Time limits can be specified for adaptation and simulation
 	User-defined file names and file directory
         Initial weights in input file no longer supported
 
         Bug fix in MadGraph (wave function counter could overflow)
 
 	Bug fix: Gamelan (graphical analysis) was not built if noweb absent
 
 ##################################################################
 
 2002-03-16
 	RELEASE: version 1.22
 	Allow for beam remnants in the event record
 
 2002-03-01
         Handling of aliases in whizard.prc fixed (aliases are whole tokens)
 
 2002-02-28
 	Optimized phase space handling routines
 	  (total execution time reduced by 20-60%, depending on process)
 
 ##################################################################
 
 2002-02-26
 	RELEASE: version 1.21
 	Fixed ISR formula (ISR was underestimated in previous versions).
           New version includes ISR in leading-log approximation up to
           third order.  Parameter ISR_sqrts renamed to ISR_scale.
 
 ##################################################################
 
 2002-02-19
 	RELEASE: version 1.20
 	New process-generating method 'test' (dummy matrix element)
 	Compatibility with autoconf 2.50 and current O'Mega version
 
 2002-02-05
 	Prevent integration channels from being dropped (optionally)
 	New internal mapping for structure functions improves performance
 	Old whizard.phx file deleted after recompiling (could cause trouble)
 
 2002-01-24
 	Support for user-defined cuts and matrix element reweighting
 	STDHEP output now written by write_events_format=20 (was 3)
 
 2002-01-16
 	Improved structure function handling; small changes in user interface:
           new parameter structured_beams in &process_input
           parameter fixed_energy in &beam_input removed
 	Support for multiple initial states
 	Eta-phi (cone) cut possible (hadron collider applications)
 	Fixed bug: Whizard library was not always recompiled when necessary
 	Fixed bug: Default cuts were insufficient in some cases
 	Fixed bug: Unusable phase space mappings generated in some cases
 
 2001-12-06
 	Reorganized document source
 
 2001-12-05
 	Preliminary CIRCE2 support (no functionality yet)
 
 2001-11-27
 	Intel compiler support (does not yet work because of compiler bugs)
 	New cut and analysis mode cos-theta* and related
 	Fixed circular jetset_interface dependency warning
 	Some broadcast routines removed (parallel support disabled anyway)
 	Minor shifts in cleanup targets (Makefiles)
         Modified library search, check for pdflib8*
 
 2001-08-06
 	Fixed bug: I/O unit number could be undefined when reading phase space
 	Fixed bug: Unitialized variable could cause segfault when
                    event generation was disabled
 	Fixed bug: Undefined subroutine in CIRCE replacement module
 	Enabled feature: TGCs in O'Mega (not yet CompHEP!) matrix elements
 		   (CompHEP model sm-GF #5, O'Mega model SM_ac)
 	Fixed portability issue: Makefile did rely on PWD environment variable
 	Fixed portability issue: PYTHIA library search ambiguity resolved
 
 2001-08-01
 	Default whizard.prc and whizard.in depend on activated modules
 	Fixed bug: TEX=latex was not properly enabled when making plots
 
 2001-07-20
 	Fixed output settings in PERL script calls
 	Cache enabled in various configure checks
 
 2001-07-13
 	Support for multiple processes in a single WHIZARD run.  The
           integrations are kept separate, but the generated events are mixed
 	The whizard.evx format has changed (incompatible), including now
 	  the color flow information for PYTHIA fragmentation
 	Output files are now process-specific, except for the event file
 	Phase space file whizard.phs (if present) is used only as input,
 	  program-generated phase space is now in whizard.phx
 
 2001-07-10
 	Bug fix: Undefined parameters in parameters_SM_ac.f90 removed
 
 2001-07-04
 	Bug fix: Compiler options for the case OMEGA is disabled
 	Small inconsistencies in whizard.out format fixed
 
 2001-07-01
 	Workaround for missing PDFLIB dummy routines in PYTHIA library
 
 ##################################################################
 
 2001-06-30
 	RELEASE: version 1.13
 	Default path /cern/pro/lib in configure script
 
 2001-06-20
 	New fragmentation option: Interface for PYTHIA with full color flow
           information, beam remnants etc.
 
 2001-06-18
 	Severe bug fixed in madgraph interface: 3-gluon coupling was missing
 	Enabled color flow information in madgraph
 
 2001-06-11
 	VAMP interface module rewritten
 	Revised output format: Multiple VAMP iterations count as one WHIZARD
           iteration in integration passes 1 and 3
 	Improved message and error handling
 	Bug fix in VAMP: handle exceptional cases in rebinning_weights
 
 2001-05-31
 	new parameters for grid adaptation: accuracy_goal and efficiency_goal
 
 ##################################################################
 
 2001-05-29
 	RELEASE: version 1.12
 	bug fixes (compilation problems): deleted/modified unused functions
 
 2001-05-16
 	diagram selection improved and documented
 
 2001-05-06
         allow for disabling packages during configuration
 
 2001-05-03
 	slight changes in whizard.out format; manual extended
 
 ##################################################################
 
 2001-04-20
 	RELEASE: version 1.11
 	fixed some configuration and compilation problems (PDFLIB etc.)
 
 2001-04-18
 	linked PDFLIB: support for quark/gluon structure functions
 
 2001-04-05
 	parameter interface written by PERL script
 	SM_ac model file: fixed error in continuation line
 
 2001-03-13
 	O'Mega, O'Caml 3.01: incompatible changes
 	O'Mega, src/trie.mli: add covariance annotation to T.t
 	  This breaks O'Caml 3.00, but is required for O'Caml 3.01.
 	O'Mega, many instances: replace `sig include Module.T end' by
 	  `Module.T', since the bug is fixed in O'Caml 3.01
 
 2001-02-28
 	O'Mega, src/model.mli:
             new field Model.vertices required for model functors, will
 	    retire Model.fuse2, Model.fuse3, Model.fusen soon.
 
 ##################################################################
 
 2001-03-27
 	RELEASE: version 1.10
 	reorganized the modules as libraries
 	linked PYTHIA: support for parton fragmentation
 
 2000-12-14
 	fixed some configuration problems (if noweb etc. are absent)
 
 ##################################################################
 
 2000-12-01
 	RELEASE of first public version: version 1.00beta