Index: trunk/src/transforms/transforms.nw
===================================================================
--- trunk/src/transforms/transforms.nw	(revision 8384)
+++ trunk/src/transforms/transforms.nw	(revision 8385)
@@ -1,14086 +1,14092 @@
 % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
 % WHIZARD event transforms and event API
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Event Implementation}
 \includemodulegraph{transforms}
 
 With a process object and the associated methods at hand, we can
 generate events for elementary processes and, by subsequent
 transformation, for complete physical processes.
 
 We have the following modules:
 \begin{description}
 \item[event\_transforms]
   Abstract base type for transforming a physical process with process
   instance and included evaluators, etc., into a new
   object.  The following modules extend this base type.
 \item[resonance\_insertion]
   Insert a resonance history into an event record, based on
   kinematical and matrix-element information.
 \item[recoil\_kinematics]
   Common kinematics routines for the ISR and EPA handlers.
 \item[isr\_photon\_handler]
   Transform collinear kinematics, as it results from applying ISR
   radiation, to non-collinear kinematics with a reasonable
   transverse-momentum distribution of the radiated photons, and also
   of the recoiling partonic event.
 \item[epa\_beam\_handler]
   For photon-initiated processes where the effective photon
   approximation is used in integration, to add in beam-particle
   recoil.  Analogous to the ISR handler.
 \item[decays]
   Combine the elementary process with elementary decay processes and
   thus transform the elementary event into a decayed event, still at
   the parton level.
 \item[showers]
   Create QED/QCD showers out of the partons that are emitted by
   elementary processes.  This should be interleaved with showering of
   radiated particles (structure functions) and multiple interactions.
 \item[hadrons]
   (not implemented yet) Apply hadronization to the partonic events,
   interleaved with hadron decays.  (The current setup relies on
   hadronizing partonic events externally.)
 \item[tau\_decays]
   (not implemented yet) Let $\tau$ leptons decay taking full spin
   correlations into account.
 \item[evt\_nlo]
   Handler for fixed-order NLO events.
 \item[events]
   Combine all pieces to generate full events.
 \item[eio\_raw]
   Raw I/O for complete events.
 \end{description}
 
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Abstract Event Transforms}
 <<[[event_transforms.f90]]>>=
 <<File header>>
 
 module event_transforms
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_utils, only: write_separator
   use diagnostics
   use model_data
   use interactions
   use particles
   use subevents
   use rng_base
   use quantum_numbers, only: quantum_numbers_t
   use process, only: process_t
   use instances, only: process_instance_t
   use process_stacks
 
 <<Standard module head>>
 
 <<Event transforms: public>>
 
 <<Event transforms: types>>
 
 <<Event transforms: interfaces>>
 
 contains
 
 <<Event transforms: procedures>>
 
 end module event_transforms
 
 @ %def event_transforms
 @
 \subsection{Abstract base type}
 Essentially, all methods are abstract, but some get minimal base
 versions.  We know that there will be a random-number generator at top
 level, and that we will relate to an elementary process.
 
 The model is stored separately.  It may contain modified setting that differ
 from the model instance stored in the process object.
 
 Each event transform contains a particle set that it can fill for
 further use.  There is a flag that indicates this.
 
 We will collect event transforms in a list, therefore we include
 [[previous]] and [[next]] pointers.
 <<Event transforms: public>>=
   public :: evt_t
 <<Event transforms: types>>=
   type, abstract :: evt_t
      type(process_t), pointer :: process => null ()
      type(process_instance_t), pointer :: process_instance => null ()
      class(model_data_t), pointer :: model => null ()
      class(rng_t), allocatable :: rng
      integer :: rejection_count = 0
      logical :: particle_set_exists = .false.
      type(particle_set_t) :: particle_set
      class(evt_t), pointer :: previous => null ()
      class(evt_t), pointer :: next => null ()
      real(default) :: weight = 0._default
      logical :: only_weighted_events = .false.
    contains
    <<Event transforms: evt: TBP>>
   end type evt_t
 
 @ %def evt_t
 @ Finalizer.  In any case, we finalize the r.n.g.  The process
 instance is a pointer and should not be finalized here.
 <<Event transforms: evt: TBP>>=
   procedure :: final => evt_final
   procedure :: base_final => evt_final
 <<Event transforms: procedures>>=
   subroutine evt_final (evt)
     class(evt_t), intent(inout) :: evt
     if (allocated (evt%rng))  call evt%rng%final ()
     if (evt%particle_set_exists) &
          call evt%particle_set%final ()
   end subroutine evt_final
 
 @ %def evt_final
 @ Print out the type of the [[evt]].
 <<Event transforms: evt: TBP>>=
   procedure (evt_write_name), deferred :: write_name
 <<Event transforms: interfaces>>=
   abstract interface
      subroutine evt_write_name (evt, unit)
        import
        class(evt_t), intent(in) :: evt
        integer, intent(in), optional :: unit
      end subroutine evt_write_name
   end interface
 
 @ %def evt_write_name
 @
 <<Event transforms: evt: TBP>>=
   procedure (evt_write), deferred :: write
 <<Event transforms: interfaces>>=
   abstract interface
      subroutine evt_write (evt, unit, verbose, more_verbose, testflag)
        import
        class(evt_t), intent(in) :: evt
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: verbose, more_verbose, testflag
      end subroutine evt_write
   end interface
 
 @ %def evt_write
 @ Output.  We can print r.n.g. info.
 <<Event transforms: evt: TBP>>=
   procedure :: base_write => evt_base_write
 <<Event transforms: procedures>>=
   subroutine evt_base_write (evt, unit, testflag, show_set)
     class(evt_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag, show_set
     integer :: u
     logical :: show
     u = given_output_unit (unit)
     show = .true.;  if (present (show_set))  show = show_set
     if (associated (evt%process)) then
        write (u, "(3x,A,A,A)")   "Associated process: '", &
             char (evt%process%get_id ()), "'"
     end if
     if (allocated (evt%rng)) then
        call evt%rng%write (u, 1)
        write (u, "(3x,A,I0)")  "Number of tries = ", evt%rejection_count
     end if
     if (show) then
        if (evt%particle_set_exists) then
           call write_separator (u)
           call evt%particle_set%write (u, testflag = testflag)
        end if
     end if
   end subroutine evt_base_write
 
 @ %def evt_base_write
 @ Connect the transform with a process instance (and thus with the
 associated process).  Use this to allocate the master random-number
 generator.
 
 This is not an initializer; we may initialize the transform by
 implementation-specific methods.
 <<Event transforms: evt: TBP>>=
   procedure :: connect => evt_connect
   procedure :: base_connect => evt_connect
 <<Event transforms: procedures>>=
   subroutine evt_connect (evt, process_instance, model, process_stack)
     class(evt_t), intent(inout), target :: evt
     type(process_instance_t), intent(in), target :: process_instance
     class(model_data_t), intent(in), target :: model
     type(process_stack_t), intent(in), optional :: process_stack
     evt%process => process_instance%process
     evt%process_instance => process_instance
     evt%model => model
     call evt%process%make_rng (evt%rng)
   end subroutine evt_connect
 
 @ %def evt_connect
 @ Reset internal state.
 <<Event transforms: evt: TBP>>=
   procedure :: reset => evt_reset
   procedure :: base_reset => evt_reset
 <<Event transforms: procedures>>=
   subroutine evt_reset (evt)
     class(evt_t), intent(inout) :: evt
     evt%rejection_count = 0
     call evt%particle_set%final ()
     evt%particle_set_exists = .false.
   end subroutine evt_reset
 
 @ %def evt_reset
 @ Prepare for a new event: reset internal state, if necessary.  We
 provide MCI and term index of the parent process.
 <<Event transforms: evt: TBP>>=
   procedure (evt_prepare_new_event), deferred :: prepare_new_event
 <<Event transforms: interfaces>>=
   interface
      subroutine evt_prepare_new_event (evt, i_mci, i_term)
        import
        class(evt_t), intent(inout) :: evt
        integer, intent(in) :: i_mci, i_term
      end subroutine evt_prepare_new_event
   end interface
 
 @ %def evt_prepare_new_event
 @ Generate a weighted event, using a valid initiator event in the
 process instance, and the random-number generator.  The returned event
 probability should be a number between zero and one that we can use for
 rejection.
 <<Event transforms: evt: TBP>>=
   procedure (evt_generate_weighted), deferred :: generate_weighted
 <<Event transforms: interfaces>>=
   abstract interface
      subroutine evt_generate_weighted (evt, probability)
        import
        class(evt_t), intent(inout) :: evt
        real(default), intent(inout) :: probability
      end subroutine evt_generate_weighted
   end interface
 
 @ %def evt_generate_weighted
 @ The unweighted event generation routine is actually implemented.  It
 uses the random-number generator for simple rejection.  Of course, the
 implementation may override this and implement a different way of
 generating an unweighted event.
 <<Event transforms: evt: TBP>>=
   procedure :: generate_unweighted => evt_generate_unweighted
   procedure :: base_generate_unweighted => evt_generate_unweighted
 <<Event transforms: procedures>>=
   subroutine evt_generate_unweighted (evt)
     class(evt_t), intent(inout) :: evt
     real(default) :: p, x
     evt%rejection_count = 0
     REJECTION: do
        evt%rejection_count = evt%rejection_count + 1
        call evt%generate_weighted (p)
        if (signal_is_pending ())  return
        call evt%rng%generate (x)
        if (x < p)  exit REJECTION
     end do REJECTION
   end subroutine evt_generate_unweighted
 
 @ %def evt_generate_unweighted
 @ Make a particle set.  This should take the most recent evaluator (or
 whatever stores the event), factorize the density matrix if necessary,
 and store as a particle set.
 
 If applicable, the factorization should make use of the
 [[factorization_mode]] and [[keep_correlations]] settings.
 
 The values [[r]], if set, should control the factorization in more
 detail, e.g., bypassing the random-number generator.
 <<Event transforms: evt: TBP>>=
   procedure (evt_make_particle_set), deferred :: make_particle_set
 <<Event transforms: interfaces>>=
   interface
      subroutine evt_make_particle_set &
           (evt, factorization_mode, keep_correlations, r)
        import
        class(evt_t), intent(inout) :: evt
        integer, intent(in) :: factorization_mode
        logical, intent(in) :: keep_correlations
        real(default), dimension(:), intent(in), optional :: r
      end subroutine evt_make_particle_set
   end interface
 
 @ %def evt_make_particle_set
 @ Copy an existing particle set into the event record.  This bypasses
 all methods to evaluate the internal state, but may be sufficient for
 further processing.
 <<Event transforms: evt: TBP>>=
   procedure :: set_particle_set => evt_set_particle_set
 <<Event transforms: procedures>>=
   subroutine evt_set_particle_set (evt, particle_set, i_mci, i_term)
     class(evt_t), intent(inout) :: evt
     type(particle_set_t), intent(in) :: particle_set
     integer, intent(in) :: i_term, i_mci
     call evt%prepare_new_event (i_mci, i_term)
     evt%particle_set = particle_set
     evt%particle_set_exists = .true.
   end subroutine evt_set_particle_set
 
 @ %def evt_set_particle_set
 @ This procedure can help in the previous task, if the particles are
 available in the form of an interaction object.  (We need two
 interactions, one with color summed over, and one with the probability
 distributed among flows.)
 
 We use the two values from the random number generator for factorizing
 the state.  For testing purposes, we can provide those numbers explicitly.
 <<Event transforms: evt: TBP>>=
   procedure :: factorize_interactions => evt_factorize_interactions
 <<Event transforms: procedures>>=
   subroutine evt_factorize_interactions &
        (evt, int_matrix, int_flows, factorization_mode, &
        keep_correlations, r, qn_select)
     class(evt_t), intent(inout) :: evt
     type(interaction_t), intent(in), target :: int_matrix, int_flows
     integer, intent(in) :: factorization_mode
     logical, intent(in) :: keep_correlations
     real(default), dimension(:), intent(in), optional :: r
     type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_select
     real(default), dimension(2) :: x
     if (present (r)) then
        if (size (r) == 2) then
           x = r
        else
           call msg_bug ("event factorization: size of r array must be 2")
        end if
     else
        call evt%rng%generate (x)
     end if
     call evt%particle_set%init (evt%particle_set_exists, &
          int_matrix, int_flows, factorization_mode, x, &
          keep_correlations, keep_virtual=.true., qn_select = qn_select)
     evt%particle_set_exists = .true.
   end subroutine evt_factorize_interactions
 
 @ %def evt_factorize_interactions
 @
 <<Event transforms: public>>=
   public :: make_factorized_particle_set
 <<Event transforms: procedures>>=
   subroutine make_factorized_particle_set (evt, factorization_mode, &
          keep_correlations, r, ii_term, qn_select)
     class(evt_t), intent(inout) :: evt
     integer, intent(in) :: factorization_mode
     logical, intent(in) :: keep_correlations
     real(default), dimension(:), intent(in), optional :: r
     integer, intent(in), optional :: ii_term
     type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_select
     integer :: i_term
     type(interaction_t), pointer :: int_matrix, int_flows
     if (evt%process_instance%is_complete_event ()) then
        if (present (ii_term)) then
           i_term = ii_term
        else
           i_term = evt%process_instance%select_i_term ()
        end if
        int_matrix => evt%process_instance%get_matrix_int_ptr (i_term)
        int_flows  => evt%process_instance%get_flows_int_ptr (i_term)
        call evt%factorize_interactions (int_matrix, int_flows, &
             factorization_mode, keep_correlations, r, qn_select)
        call evt%tag_incoming ()
     else
        call msg_bug ("Event factorization: event is incomplete")
     end if
   end subroutine make_factorized_particle_set
 
 @ %def make_factorized_particle_set
 @ Mark the incoming particles as incoming in the particle set.  This
 is necessary because in the interaction objects they are usually
 marked as virtual.
 
 In the inquiry functions we set the term index to one; the indices of
 beams and incoming particles should be identical for all process
 terms.
 
 We use the initial elementary process for obtaining the indices.
 Thus, we implicitly assume that the beam and incoming indices stay the
 same across event transforms.  If this is not true for a transform
 (say, MPI), it should override this method.
 <<Event transforms: evt: TBP>>=
   procedure :: tag_incoming => evt_tag_incoming
 <<Event transforms: procedures>>=
   subroutine evt_tag_incoming (evt)
     class(evt_t), intent(inout) :: evt
     integer :: i_term, n_in
     integer, dimension(:), allocatable :: beam_index, in_index
     n_in = evt%process%get_n_in ()
     i_term = 1
     allocate (beam_index (n_in))
     call evt%process_instance%get_beam_index (i_term, beam_index)
     call evt%particle_set%reset_status (beam_index, PRT_BEAM)
     allocate (in_index (n_in))
     call evt%process_instance%get_in_index (i_term, in_index)
     call evt%particle_set%reset_status (in_index, PRT_INCOMING)
   end subroutine evt_tag_incoming
 
 @ %def evt_tag_incoming
 @
 \subsection{Implementation: Trivial transform}
 This transform contains just a pointer to process and process
 instance.  The [[generate]] methods do nothing.
 <<Event transforms: public>>=
   public :: evt_trivial_t
 <<Event transforms: types>>=
   type, extends (evt_t) :: evt_trivial_t
    contains
    <<Event transforms: evt trivial: TBP>>
   end type evt_trivial_t
 
 @ %def evt_trivial_t
 @
 <<Event transforms: evt trivial: TBP>>=
   procedure :: write_name => evt_trivial_write_name
 <<Event transforms: procedures>>=
   subroutine evt_trivial_write_name (evt, unit)
     class(evt_trivial_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event transform: trivial (hard process)"
   end subroutine evt_trivial_write_name
 
 @ %def evt_trivial_write_name
 @ The finalizer is trivial.  Some output:
 <<Event transforms: evt trivial: TBP>>=
   procedure :: write => evt_trivial_write
 <<Event transforms: procedures>>=
   subroutine evt_trivial_write (evt, unit, verbose, more_verbose, testflag)
     class(evt_trivial_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose, more_verbose, testflag
     integer :: u
     u = given_output_unit (unit)
     call write_separator (u, 2)
     call evt%write_name (u)
     call write_separator (u)
     call evt%base_write (u, testflag = testflag)
   end subroutine evt_trivial_write
 
 @ %def evt_trivial_write
 @ Nothing to do here:
 <<Event transforms: evt trivial: TBP>>=
   procedure :: prepare_new_event => evt_trivial_prepare_new_event
 <<Event transforms: procedures>>=
   subroutine evt_trivial_prepare_new_event (evt, i_mci, i_term)
     class(evt_trivial_t), intent(inout) :: evt
     integer, intent(in) :: i_mci, i_term
     call evt%reset ()
   end subroutine evt_trivial_prepare_new_event
 
 @ %def evt_trivial_prepare_new_event
 @ The weighted generator is, surprisingly, trivial.
 <<Event transforms: evt trivial: TBP>>=
   procedure :: generate_weighted => evt_trivial_generate_weighted
 <<Event transforms: procedures>>=
   subroutine evt_trivial_generate_weighted (evt, probability)
     class(evt_trivial_t), intent(inout) :: evt
     real(default), intent(inout) :: probability
     probability = 1
   end subroutine evt_trivial_generate_weighted
 
 @ %def evt_trivial_generate_weighted
 @ This routine makes a particle set, using the associated process
 instance as-is.
 <<Event transforms: evt trivial: TBP>>=
   procedure :: make_particle_set => evt_trivial_make_particle_set
 <<Event transforms: procedures>>=
   subroutine evt_trivial_make_particle_set &
        (evt, factorization_mode, keep_correlations, r)
     class(evt_trivial_t), intent(inout) :: evt
     integer, intent(in) :: factorization_mode
     logical, intent(in) :: keep_correlations
     real(default), dimension(:), intent(in), optional :: r
     call make_factorized_particle_set (evt, factorization_mode, &
          keep_correlations, r)
     evt%particle_set_exists = .true.
   end subroutine evt_trivial_make_particle_set
 
 @ %def event_trivial_make_particle_set
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[event_transforms_ut.f90]]>>=
 <<File header>>
 
 module event_transforms_ut
   use unit_tests
   use event_transforms_uti
 
 <<Standard module head>>
 
 <<Event transforms: public test>>
 
 contains
 
 <<Event transforms: test driver>>
 
 end module event_transforms_ut
 @ %def event_transforms_ut
 @
 <<[[event_transforms_uti.f90]]>>=
 <<File header>>
 
 module event_transforms_uti
 
 <<Use kinds>>
 <<Use strings>>
   use format_utils, only: write_separator
   use os_interface
   use sm_qcd
   use models
   use state_matrices, only: FM_IGNORE_HELICITY
   use interactions, only: reset_interaction_counter
   use process_libraries
   use rng_base
   use mci_base
   use mci_midpoint
   use phs_base
   use phs_single
   use prc_core
   use prc_test, only: prc_test_create_library
 
   use process, only: process_t
   use instances, only: process_instance_t
 
   use event_transforms
 
   use rng_base_ut, only: rng_test_factory_t
 
 <<Standard module head>>
 
 <<Event transforms: test declarations>>
 
 contains
 
 <<Event transforms: tests>>
 
 <<Event transforms: test auxiliary>>
 
 end module event_transforms_uti
 
 @ %def event_transforms_uti
 @ API: driver for the unit tests below.
 <<Event transforms: public test>>=
   public :: event_transforms_test
 <<Event transforms: test driver>>=
   subroutine event_transforms_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Event transforms: execute tests>>
   end subroutine event_transforms_test
 
 @ %def event_transforms_test
 @
 \subsubsection{Test trivial event transform}
 The trivial transform, as an instance of the abstract transform, does
 nothing but to trigger event generation for an elementary process.
 <<Event transforms: execute tests>>=
   call test (event_transforms_1, "event_transforms_1", &
        "trivial event transform", &
        u, results)
 <<Event transforms: test declarations>>=
   public :: event_transforms_1
 <<Event transforms: tests>>=
   subroutine event_transforms_1 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(model_t), target :: model
     type(process_library_t), target :: lib
     type(string_t) :: libname, procname1
     class(phs_config_t), allocatable :: phs_config_template
     real(default) :: sqrts
     type(process_t), allocatable, target :: process
     type(process_instance_t), allocatable, target :: process_instance
     class(evt_t), allocatable :: evt
     integer :: factorization_mode
     logical :: keep_correlations
 
     write (u, "(A)")  "* Test output: event_transforms_1"
     write (u, "(A)")  "*   Purpose: handle trivial transform"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment and parent process"
     write (u, "(A)")
 
     call os_data%init ()
 
     libname = "event_transforms_1_lib"
     procname1 = "event_transforms_1_p"
 
     call prc_test_create_library (libname, lib, &
          scattering = .true., procname1 = procname1)
     call reset_interaction_counter ()
 
     call model%init_test ()
 
     allocate (process)
     call process%init (procname1, lib, os_data, model)
     call process%setup_test_cores ()
 
     allocate (phs_single_config_t :: phs_config_template)
     call process%init_components (phs_config_template)
 
     sqrts = 1000
     call process%setup_beams_sqrts (sqrts, i_core = 1)
     call process%configure_phs ()
     call process%setup_mci (dispatch_mci_test_midpoint)
     call process%setup_terms ()
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%integrate (1, n_it=1, n_calls=100)
     call process%final_integration (1)
     call process_instance%final ()
     deallocate (process_instance)
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%setup_event_data ()
     call process_instance%init_simulation (1)
 
     write (u, "(A)")  "* Initialize trivial event transform"
     write (u, "(A)")
 
     allocate (evt_trivial_t :: evt)
     call evt%connect (process_instance, process%get_model_ptr ())
 
     write (u, "(A)")  "* Generate event and subsequent transform"
     write (u, "(A)")
 
     call process_instance%generate_unweighted_event (1)
     call process_instance%evaluate_event_data ()
 
     call evt%prepare_new_event (1, 1)
     call evt%generate_unweighted ()
 
     call write_separator (u, 2)
     call evt%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Obtain particle set"
     write (u, "(A)")
 
     factorization_mode = FM_IGNORE_HELICITY
     keep_correlations = .false.
 
     call evt%make_particle_set (factorization_mode, keep_correlations)
 
     call write_separator (u, 2)
     call evt%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt%final ()
     call process_instance%final ()
     deallocate (process_instance)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: event_transforms_1"
 
   end subroutine event_transforms_1
 
 @ %def event_transforms_1
 @ MCI record prepared for midpoint integrator.
 <<Event transforms: test auxiliary>>=
   subroutine dispatch_mci_test_midpoint (mci, var_list, process_id, is_nlo)
     use variables, only: var_list_t
     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
     allocate (mci_midpoint_t :: mci)
   end subroutine dispatch_mci_test_midpoint
  
 @ %def dispatch_mci_test_midpoint
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Hadronization interface}
 <<[[hadrons.f90]]>>=
 <<File header>>
 
 module hadrons
 
 <<Use kinds with double>>
 <<Use strings>>
 <<Use debug>>
   use constants
   use diagnostics
   use event_transforms
   use format_utils, only: write_separator
   use helicities
   use hep_common
   use io_units
   use lorentz
   use model_data
   use models
   use numeric_utils, only: vanishes
   use particles
   use physics_defs
   use process, only: process_t
   use instances, only: process_instance_t
   use process_stacks
   use pythia8
   use rng_base, only: rng_t
   use shower_base
   use shower_pythia6
   use sm_qcd
   use subevents
   use variables
   use whizard_lha
 
 <<Standard module head>>
 
 <<Hadrons: public>>
 
 <<Hadrons: parameters>>
 
 <<Hadrons: types>>
 
 <<Hadrons: interfaces>>
 
 contains
 
 <<Hadrons: procedures>>
 
 end module hadrons
 @ %def hadrons
 @
 \subsection{Hadronization implementations}
 <<Hadrons: public>>=
   public :: HADRONS_UNDEFINED, HADRONS_WHIZARD, HADRONS_PYTHIA6, HADRONS_PYTHIA8
 <<Hadrons: parameters>>=
   integer, parameter :: HADRONS_UNDEFINED = 0
   integer, parameter :: HADRONS_WHIZARD = 1
   integer, parameter :: HADRONS_PYTHIA6 = 2
   integer, parameter :: HADRONS_PYTHIA8 = 3
 @ %def HADRONS_UNDEFINED HADRONS_WHIZARD HADRONS_PYTHIA6 HADRONS_PYTHIA8
 @ A dictionary
 <<Hadrons: public>>=
   public :: hadrons_method
 <<Hadrons: interfaces>>=
   interface hadrons_method
      module procedure hadrons_method_of_string
      module procedure hadrons_method_to_string
   end interface
 <<Hadrons: procedures>>=
   elemental function hadrons_method_of_string (string) result (i)
     integer :: i
     type(string_t), intent(in) :: string
     select case (char(string))
     case ("WHIZARD")
        i = HADRONS_WHIZARD
     case ("PYTHIA6")
        i = HADRONS_PYTHIA6
     case ("PYTHIA8")
        i = HADRONS_PYTHIA8
     case default
        i = HADRONS_UNDEFINED
     end select
   end function hadrons_method_of_string
 
   elemental function hadrons_method_to_string (i) result (string)
     type(string_t) :: string
     integer, intent(in) :: i
     select case (i)
     case (HADRONS_WHIZARD)
        string = "WHIZARD"
     case (HADRONS_PYTHIA6)
        string = "PYTHIA6"
     case (HADRONS_PYTHIA8)
        string = "PYTHIA8"
     case default
        string = "UNDEFINED"
     end select
   end function hadrons_method_to_string
 
 @ %def hadrons_method
 @
 \subsection{Hadronization settings}
 These are the general settings and parameters for the different shower
 methods.
 <<Hadrons: public>>=
   public :: hadron_settings_t
 <<Hadrons: types>>=
   type :: hadron_settings_t
      logical :: active = .false.
      integer :: method = HADRONS_UNDEFINED
      real(default) :: enhanced_fraction = 0
      real(default) :: enhanced_width = 0
    contains
    <<Hadrons: hadron settings: TBP>>
   end type hadron_settings_t
 
 @ %def hadron_settings_t
 @ Read in the hadronization settings.
 <<Hadrons: hadron settings: TBP>>=
   procedure :: init => hadron_settings_init
 <<Hadrons: procedures>>=
   subroutine hadron_settings_init (hadron_settings, var_list)
     class(hadron_settings_t), intent(out) :: hadron_settings
     type(var_list_t), intent(in) :: var_list
     hadron_settings%active = &
          var_list%get_lval (var_str ("?hadronization_active"))
     hadron_settings%method = hadrons_method_of_string ( &
          var_list%get_sval (var_str ("$hadronization_method")))
     hadron_settings%enhanced_fraction = &
          var_list%get_rval (var_str ("hadron_enhanced_fraction"))
     hadron_settings%enhanced_width = &
          var_list%get_rval (var_str ("hadron_enhanced_width"))
   end subroutine hadron_settings_init
 
 @ %def hadron_settings_init
 @
 <<Hadrons: hadron settings: TBP>>=
   procedure :: write => hadron_settings_write
 <<Hadrons: procedures>>=
   subroutine hadron_settings_write (settings, unit)
     class(hadron_settings_t), intent(in) :: settings
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)")  "Hadronization settings:"
     call write_separator (u)
     write (u, "(1x,A)")  "Master switches:"
     write (u, "(3x,A,1x,L1)") &
          "active                = ", settings%active
     write (u, "(1x,A)")  "General settings:"
     if (settings%active) then
        write (u, "(3x,A)") &
             "hadron_method         =  " // &
             char (hadrons_method_to_string (settings%method))
     else
        write (u, "(3x,A)") " [Hadronization off]"
     end if
     write (u, "(1x,A)")  "pT generation parameters"
     write (u, "(3x,A,1x,ES19.12)") &
          "enhanced_fraction     = ", settings%enhanced_fraction
     write (u, "(3x,A,1x,ES19.12)") &
          "enhanced_width        = ", settings%enhanced_width
   end subroutine hadron_settings_write
 
 @ %def hadron_settings_write
 @
 \subsection{Abstract Hadronization Type}
 The [[model]] is the fallback model including all hadrons
 <<Hadrons: types>>=
   type, abstract :: hadrons_t
      class(rng_t), allocatable :: rng
      type(shower_settings_t) :: shower_settings
      type(hadron_settings_t) :: hadron_settings
      type(model_t), pointer :: model => null()
    contains
    <<Hadrons: hadrons: TBP>>
   end type hadrons_t
 
 @ %def hadrons_t
 @
 <<Hadrons: hadrons: TBP>>=
   procedure (hadrons_init), deferred :: init
 <<Hadrons: interfaces>>=
   abstract interface
     subroutine hadrons_init &
          (hadrons, shower_settings, hadron_settings, model_hadrons)
       import
       class(hadrons_t), intent(out) :: hadrons
       type(shower_settings_t), intent(in) :: shower_settings
       type(hadron_settings_t), intent(in) :: hadron_settings
       type(model_t), target, intent(in) :: model_hadrons
     end subroutine hadrons_init
    end interface
 
 @ %def hadrons_init
 @
 <<Hadrons: hadrons: TBP>>=
   procedure (hadrons_hadronize), deferred :: hadronize
 <<Hadrons: interfaces>>=
   abstract interface
      subroutine hadrons_hadronize (hadrons, particle_set, valid)
        import
        class(hadrons_t), intent(inout) :: hadrons
        type(particle_set_t), intent(in) :: particle_set
        logical, intent(out) :: valid
      end subroutine hadrons_hadronize
   end interface
 @ %def hadrons_hadronize
 @
 <<Hadrons: hadrons: TBP>>=
   procedure (hadrons_make_particle_set), deferred :: make_particle_set
 <<Hadrons: interfaces>>=
   abstract interface
      subroutine hadrons_make_particle_set (hadrons, particle_set, &
           model, valid)
        import
        class(hadrons_t), intent(in) :: hadrons
        type(particle_set_t), intent(inout) :: particle_set
        class(model_data_t), intent(in), target :: model
        logical, intent(out) :: valid
      end subroutine hadrons_make_particle_set
   end interface
 
 @ %def hadrons_make_particle_set
 @
 <<Hadrons: hadrons: TBP>>=
   procedure :: import_rng => hadrons_import_rng
 <<Hadrons: procedures>>=
   pure subroutine hadrons_import_rng (hadrons, rng)
     class(hadrons_t), intent(inout) :: hadrons
     class(rng_t), intent(inout), allocatable :: rng
     call move_alloc (from = rng, to = hadrons%rng)
   end subroutine hadrons_import_rng
 
 @ %def hadrons_import_rng
 @
 \subsection{[[WHIZARD]] Hadronization Type}
 Hadronization can be (incompletely) performed through \whizard's internal
 routine.
 <<Hadrons: public>>=
   public :: hadrons_hadrons_t
 <<Hadrons: types>>=
   type, extends (hadrons_t) :: hadrons_hadrons_t
      contains
        <<Hadrons: hadrons hadrons: TBP>>
     end type hadrons_hadrons_t
 
 @ %def hadrons_hadrons_t
 @
 <<Hadrons: hadrons hadrons: TBP>>=
   procedure :: init => hadrons_hadrons_init
 <<Hadrons: procedures>>=
   subroutine hadrons_hadrons_init &
        (hadrons, shower_settings, hadron_settings, model_hadrons)
     class(hadrons_hadrons_t), intent(out) :: hadrons
     type(shower_settings_t), intent(in) :: shower_settings
     type(hadron_settings_t), intent(in) :: hadron_settings
     type(model_t), intent(in), target :: model_hadrons
     hadrons%model => model_hadrons
     hadrons%shower_settings = shower_settings
     hadrons%hadron_settings = hadron_settings
     call msg_message &
          ("Hadronization: WHIZARD model for hadronization and decays")
   end subroutine hadrons_hadrons_init
 
 @ %def hadrons_hadrons_init
 @
 <<Hadrons: hadrons hadrons: TBP>>=
   procedure :: hadronize => hadrons_hadrons_hadronize
 <<Hadrons: procedures>>=
   subroutine hadrons_hadrons_hadronize (hadrons, particle_set, valid)
     class(hadrons_hadrons_t), intent(inout) :: hadrons
     type(particle_set_t), intent(in) :: particle_set
     logical, intent(out) :: valid
     integer, dimension(:), allocatable :: cols, acols, octs
     integer :: n
     if (signal_is_pending ()) return
     if (debug_on) call msg_debug (D_TRANSFORMS, "hadrons_hadrons_hadronize")
     call particle_set%write (6, compressed=.true.)
     n = particle_set%get_n_tot ()
     allocate (cols (n), acols (n), octs (n))
     call extract_color_systems (particle_set, cols, acols, octs)
     print *, "size(cols)  = ", size (cols)
     if (size(cols) > 0) then
        print *, "cols  = ", cols
     end if
     print *, "size(acols) = ", size(acols)
     if (size(acols) > 0) then
        print *, "acols = ", acols
     end if
     print *, "size(octs)  = ", size(octs)
     if (size (octs) > 0) then
        print *, "octs  = ", octs
     end if
     !!! if all arrays are empty, i.e. zero particles found, nothing to do
   end subroutine hadrons_hadrons_hadronize
 
 @ %def hadrons_hadrons_hadronize
 @ This type contains a flavor selector for the creation of hadrons,
 including parameters for the special handling of baryons.
 <<Hadrons: public>>=
   public :: had_flav_t
 <<Hadrons: types>>=
   type had_flav_t
   end type had_flav_t
 
 @ %def had_flav_t
 @ This is the type for the ends of Lund strings.
 <<Hadrons: public>>=
   public :: lund_end
 <<Hadrons: types>>=
   type lund_end
      logical :: from_pos
      integer :: i_end
      integer :: i_max
      integer :: id_had
      integer :: i_pos_old
      integer :: i_neg_old
      integer :: i_pos_new
      integer :: i_neg_new
      real(default) :: px_old
      real(default) :: py_old
      real(default) :: px_new
      real(default) :: py_new
      real(default) :: px_had
      real(default) :: py_had
      real(default) :: m_had
      real(default) :: mT2_had
      real(default) :: z_had
      real(default) :: gamma_old
      real(default) :: gamma_new
      real(default) :: x_pos_old
      real(default) :: x_pos_new
      real(default) :: x_pos_had
      real(default) :: x_neg_old
      real(default) :: x_neg_new
      real(default) :: x_neg_had
      type(had_flav_t) :: old_flav
      type(had_flav_t) :: new_flav
      type(vector4_t) :: p_had
      type(vector4_t) :: p_pre
   end type lund_end
 
 @ %def lund_end
 @ Generator for transverse momentum for the fragmentation.
 <<Hadrons: public>>=
   public :: lund_pt_t
 <<Hadrons: types>>=
   type lund_pt_t
      real(default) :: sigma_min
      real(default) :: sigma_q
      real(default) :: enhanced_frac
      real(default) :: enhanced_width
      real(default) :: sigma_to_had
      class(rng_t), allocatable :: rng
    contains
    <<Hadrons: lund pT: TBP>>
   end type lund_pt_t
 
 @ %def lund_pt
 <<Hadrons: lund pT: TBP>>=
   procedure :: init => lund_pt_init
 <<Hadrons: procedures>>=
   subroutine lund_pt_init (lund_pt, settings)
     class (lund_pt_t), intent(out) :: lund_pt
     type(hadron_settings_t), intent(in) :: settings
   end subroutine lund_pt_init
 
 @ %def lund_pt_init
 @
 <<Hadrons: hadrons hadrons: TBP>>=
   procedure :: make_particle_set => hadrons_hadrons_make_particle_set
 <<Hadrons: procedures>>=
   subroutine hadrons_hadrons_make_particle_set &
          (hadrons, particle_set, model, valid)
     class(hadrons_hadrons_t), intent(in) :: hadrons
     type(particle_set_t), intent(inout) :: particle_set
     class(model_data_t), intent(in), target :: model
     logical, intent(out) :: valid
     if (signal_is_pending ()) return
     valid = .false.
     if (valid) then
     else
        call msg_fatal ("WHIZARD hadronization not yet implemented")
     end if
   end subroutine hadrons_hadrons_make_particle_set
 
 @ %def hadrons_hadrons_make_particle_set
 @
 <<Hadrons: procedures>>=
   subroutine extract_color_systems (p_set, cols, acols, octs)
     type(particle_set_t), intent(in) :: p_set
     integer, dimension(:), allocatable, intent(out) :: cols, acols, octs
     logical, dimension(:), allocatable :: mask
     integer :: i, n, n_cols, n_acols, n_octs
     n = p_set%get_n_tot ()
     allocate (mask (n))
     do i = 1, n
        mask(i) = p_set%prt(i)%col%get_col () /= 0 .and. &
             p_set%prt(i)%col%get_acl () == 0 .and. &
             p_set%prt(i)%get_status () == PRT_OUTGOING
     end do
     n_cols = count (mask)
     allocate (cols (n_cols))
     cols = p_set%get_indices (mask)
     do i = 1, n
        mask(i) = p_set%prt(i)%col%get_col () == 0 .and. &
             p_set%prt(i)%col%get_acl () /= 0 .and. &
             p_set%prt(i)%get_status () == PRT_OUTGOING
     end do
     n_acols = count (mask)
     allocate (acols (n_acols))
     acols = p_set%get_indices (mask)
     do i = 1, n
        mask(i) = p_set%prt(i)%col%get_col () /= 0 .and. &
             p_set%prt(i)%col%get_acl () /= 0 .and. &
             p_set%prt(i)%get_status () == PRT_OUTGOING
     end do
     n_octs = count (mask)
     allocate (octs (n_octs))
     octs = p_set%get_indices (mask)
   end subroutine extract_color_systems
 
 @ %def extract_color_systems
 @
 \subsection{[[PYTHIA6]] Hadronization Type}
 Hadronization via [[PYTHIA6]] is at another option for
 hadronization within \whizard.
 <<Hadrons: public>>=
   public :: hadrons_pythia6_t
 <<Hadrons: types>>=
   type, extends (hadrons_t) :: hadrons_pythia6_t
    contains
    <<Hadrons: hadrons pythia6: TBP>>
   end type hadrons_pythia6_t
 
 @ %def hadrons_pythia6_t
 <<Hadrons: hadrons pythia6: TBP>>=
   procedure :: init => hadrons_pythia6_init
 <<Hadrons: procedures>>=
   subroutine hadrons_pythia6_init &
        (hadrons, shower_settings, hadron_settings, model_hadrons)
     class(hadrons_pythia6_t), intent(out) :: hadrons
     type(shower_settings_t), intent(in) :: shower_settings
     type(hadron_settings_t), intent(in) :: hadron_settings
     type(model_t), intent(in), target :: model_hadrons
     logical :: pygive_not_set_by_shower
     hadrons%model => model_hadrons
     hadrons%shower_settings = shower_settings
     hadrons%hadron_settings = hadron_settings
     pygive_not_set_by_shower = .not. (shower_settings%method == PS_PYTHIA6 &
          .and. (shower_settings%isr_active .or. shower_settings%fsr_active))
     if (pygive_not_set_by_shower) then
        call pythia6_set_verbose (shower_settings%verbose)
        call pythia6_set_config (shower_settings%pythia6_pygive)
     end if
     call msg_message &
          ("Hadronization: Using PYTHIA6 interface for hadronization and decays")
   end subroutine hadrons_pythia6_init
 
 @ %def hadrons_pythia6_init
 @ Assume that the event record is still in the PYTHIA COMMON BLOCKS
 transferred there by the WHIZARD or PYTHIA6 shower routines.
 <<Hadrons: hadrons pythia6: TBP>>=
   procedure :: hadronize => hadrons_pythia6_hadronize
 <<Hadrons: procedures>>=
   subroutine hadrons_pythia6_hadronize (hadrons, particle_set, valid)
     class(hadrons_pythia6_t), intent(inout) :: hadrons
     type(particle_set_t), intent(in) :: particle_set
     logical, intent(out) :: valid
     integer :: N, NPAD, K
     real(double) :: P, V
     common /PYJETS/ N, NPAD, K(4000,5), P(4000,5), V(4000,5)
     save /PYJETS/
     if (signal_is_pending ()) return
     if (debug_on) call msg_debug (D_TRANSFORMS, "hadrons_pythia6_hadronize")
     call pygive ("MSTP(111)=1")    !!! Switch on hadronization and decays
     call pygive ("MSTJ(1)=1")      !!! String fragmentation
     call pygive ("MSTJ(21)=2")     !!! String fragmentation keeping resonance momentum
     call pygive ("MSTJ(28)=0")     !!! Switch off tau decays
     if (debug_active (D_TRANSFORMS)) then
        call msg_debug (D_TRANSFORMS, "N", N)
        call pylist(2)
        print *, ' line 7 : ', k(7,1:5), p(7,1:5)
     end if
     call pyedit (12)
     call pythia6_set_last_treated_line (N)
     call pyexec ()
     call pyedit (12)
     valid = .true.
   end subroutine hadrons_pythia6_hadronize
 
 @ %def hadrons_pythia6_hadronize
 @
 <<Hadrons: hadrons pythia6: TBP>>=
   procedure :: make_particle_set => hadrons_pythia6_make_particle_set
 <<Hadrons: procedures>>=
   subroutine hadrons_pythia6_make_particle_set &
          (hadrons, particle_set, model, valid)
     class(hadrons_pythia6_t), intent(in) :: hadrons
     type(particle_set_t), intent(inout) :: particle_set
     class(model_data_t), intent(in), target :: model
     logical, intent(out) :: valid
     if (signal_is_pending ()) return
     valid = pythia6_handle_errors ()
     if (valid) then
        call pythia6_combine_with_particle_set &
             (particle_set, model, hadrons%model, hadrons%shower_settings)
     end if
   end subroutine hadrons_pythia6_make_particle_set
 
 @ %def hadrons_pythia6_make_particle_set
 @
 \subsection{[[PYTHIA8]] Hadronization}
 @
 <<Hadrons: public>>=
   public :: hadrons_pythia8_t
 <<Hadrons: types>>=
   type, extends (hadrons_t) :: hadrons_pythia8_t
      type(pythia8_t) :: pythia
      type(whizard_lha_t) :: lhaup
      logical :: user_process_set = .false.
      logical :: pythia_initialized = .false., &
           lhaup_initialized = .false.
   contains
    <<Hadrons: hadrons pythia8: TBP>>
   end type hadrons_pythia8_t
 
 @ %def hadrons_pythia8_t
 @
 <<Hadrons: hadrons pythia8: TBP>>=
   procedure :: init => hadrons_pythia8_init
 <<Hadrons: procedures>>=
   subroutine hadrons_pythia8_init &
        (hadrons, shower_settings, hadron_settings, model_hadrons)
     class(hadrons_pythia8_t), intent(out) :: hadrons
     type(shower_settings_t), intent(in) :: shower_settings
     type(hadron_settings_t), intent(in) :: hadron_settings
     type(model_t), intent(in), target :: model_hadrons
     hadrons%model => model_hadrons
     hadrons%shower_settings = shower_settings
     hadrons%hadron_settings = hadron_settings
     call msg_message &
          ("Hadronization: Using PYTHIA8 interface for hadronization and decays.")
     ! TODO sbrass which verbose?
     call hadrons%pythia%init (verbose = shower_settings%verbose)
     call hadrons%lhaup%init ()
   end subroutine hadrons_pythia8_init
 
 @ %def hadrons_pythia8_init
 @ Transfer hadron settings to [[PYTHIA8]].
 <<Hadrons: hadrons pythia8: TBP>>=
   procedure, private :: transfer_settings => hadrons_pythia8_transfer_settings
 <<Hadrons: procedures>>=
   subroutine hadrons_pythia8_transfer_settings (hadrons)
     class(hadrons_pythia8_t), intent(inout), target :: hadrons
     real(default) :: r
     if (debug_on) call msg_debug (D_TRANSFORMS, "hadrons_pythia8_transfer_settings")
     if (debug_on) call msg_debug2 (D_TRANSFORMS, "pythia_initialized", hadrons%pythia_initialized)
     if (hadrons%pythia_initialized) return
     call hadrons%pythia%import_rng (hadrons%rng)
     call hadrons%pythia%parse_and_set_config (hadrons%shower_settings%pythia8_config)
     if (len (hadrons%shower_settings%pythia8_config_file) > 0) &
          call hadrons%pythia%read_file (hadrons%shower_settings%pythia8_config_file)
     call hadrons%pythia%read_string (var_str ("Beams:frameType = 5"))
     call hadrons%pythia%read_string (var_str ("ProcessLevel:all = off"))
     if (.not. hadrons%shower_settings%verbose) then
        call hadrons%pythia%read_string (var_str ("Print:quiet = on"))
     end if
     call hadrons%pythia%set_lhaup_ptr (hadrons%lhaup)
     call hadrons%pythia%init_pythia ()
     hadrons%pythia_initialized = .true.
   end subroutine hadrons_pythia8_transfer_settings
 
 @ %def hadrons_pythia8_transfer_settings
 @ Set user process for the LHA interface.
 <<Hadrons: hadrons pythia8: TBP>>=
   procedure, private :: set_user_process => hadrons_pythia8_set_user_process
 <<Hadrons: procedures>>=
   subroutine hadrons_pythia8_set_user_process (hadrons, pset)
     class(hadrons_pythia8_t), intent(inout) :: hadrons
     type(particle_set_t), intent(in) :: pset
     integer, dimension(2) :: beam_pdg
     real(default), dimension(2) :: beam_energy
     integer, parameter :: process_id = 0, n_processes = 0
     if (debug_on) call msg_debug (D_TRANSFORMS, "hadrons_pythia8_set_user_process")
     beam_pdg = [pset%prt(1)%get_pdg (), pset%prt(2)%get_pdg ()]
     beam_energy = [energy(pset%prt(1)%p), energy(pset%prt(2)%p)]
     call hadrons%lhaup%set_init (beam_pdg, beam_energy, &
          n_processes, unweighted = .false., negative_weights = .false.)
     call hadrons%lhaup%set_process_parameters (process_id = process_id, &
          cross_section = one, error = one)
   end subroutine hadrons_pythia8_set_user_process
 
 @ %def hadrons_pythia8_set_user_process
 @ Import particle set.
 <<Hadrons: hadrons pythia8: TBP>>=
   procedure, private :: import_particle_set => hadrons_pythia8_import_particle_set
 <<Hadrons: procedures>>=
   subroutine hadrons_pythia8_import_particle_set (hadrons, particle_set)
     class(hadrons_pythia8_t), target, intent(inout) :: hadrons
     type(particle_set_t), intent(in) :: particle_set
     type(particle_set_t) :: pset_reduced
     integer, parameter :: PROCESS_ID = 1
     if (debug_on) call msg_debug (D_TRANSFORMS, "hadrons_pythia8_import_particle_set")
     if (.not. hadrons%user_process_set) then
        call hadrons%set_user_process (particle_set)
        hadrons%user_process_set = .true.
     end if
     call hadrons%lhaup%set_event_process (process_id = PROCESS_ID, scale = -one, &
          alpha_qcd = -one, alpha_qed = -one, weight = -one)
     call hadrons%lhaup%set_event (process_id = PROCESS_ID, particle_set = particle_set, &
          polarization = .true.)
     if (debug_active (D_TRANSFORMS)) then
        call hadrons%lhaup%list_init ()
     end if
   end subroutine hadrons_pythia8_import_particle_set
 
 @ %def hadrons_pythia8_import_particle_set
 @
 <<Hadrons: hadrons pythia8: TBP>>=
   procedure :: hadronize => hadrons_pythia8_hadronize
 <<Hadrons: procedures>>=
   subroutine hadrons_pythia8_hadronize (hadrons, particle_set, valid)
     class(hadrons_pythia8_t), intent(inout) :: hadrons
     type(particle_set_t), intent(in) :: particle_set
     logical, intent(out) :: valid
     if (signal_is_pending ()) return
     call hadrons%import_particle_set (particle_set)
     if (.not. hadrons%pythia_initialized) &
          call hadrons%transfer_settings ()
     call hadrons%pythia%next (valid)
     if (debug_active (D_TRANSFORMS)) then
        call hadrons%pythia%list_event ()
        call particle_set%write (summary=.true., compressed=.true.)
     end if
   end subroutine hadrons_pythia8_hadronize
 
 @ %def hadrons_pythia8_hadronize
 @
 <<Hadrons: hadrons pythia8: TBP>>=
   procedure :: make_particle_set => hadrons_pythia8_make_particle_set
 <<Hadrons: procedures>>=
   subroutine hadrons_pythia8_make_particle_set &
          (hadrons, particle_set, model, valid)
     class(hadrons_pythia8_t), intent(in) :: hadrons
     type(particle_set_t), intent(inout) :: particle_set
     class(model_data_t), intent(in), target :: model
     logical, intent(out) :: valid
     type(particle_t), dimension(:), allocatable :: beam
     if (debug_on) call msg_debug (D_TRANSFORMS, "hadrons_pythia8_make_particle_set")
     if (signal_is_pending ()) return
     associate (settings => hadrons%shower_settings)
       if (debug_active (D_TRANSFORMS)) then
          call msg_debug (D_TRANSFORMS, 'Combine PYTHIA8 with particle set')
          call msg_debug (D_TRANSFORMS, 'Particle set before replacing')
          call particle_set%write (summary=.true., compressed=.true.)
          call hadrons%pythia%list_event ()
          call msg_debug (D_TRANSFORMS, string = "settings%hadron_collision", &
               value = settings%hadron_collision)
       end if
       call hadrons%pythia%get_hadron_particles (&
            model, hadrons%model, particle_set, &
            helicity = PRT_DEFINITE_HELICITY)
     end associate
     if (debug_active (D_TRANSFORMS)) then
        print *, 'Particle set after replacing'
        call particle_set%write (summary=.true., compressed=.true.)
     end if
     valid = .true.
   end subroutine hadrons_pythia8_make_particle_set
 
 @ %def hadrons_pythia8_make_particle_set
 @
 \subsection{Hadronization Event Transform}
 This is the type for the hadronization event transform.  It does not
 depend on the specific hadronization implementation of
 [[hadrons_t]].
 <<Hadrons: public>>=
   public :: evt_hadrons_t
 <<Hadrons: types>>=
   type, extends (evt_t) :: evt_hadrons_t
      class(hadrons_t), allocatable :: hadrons
      type(model_t), pointer :: model_hadrons => null()
      type(qcd_t) :: qcd
      logical :: is_first_event
    contains
    <<Hadrons: evt hadrons: TBP>>
   end type evt_hadrons_t
 
 @ %def evt_hadrons_t
 @ Initialize the parameters.  The [[model_hadrons]] is supposed to be
 the SM variant that contains all hadrons that may be generated in the
 shower.
 <<Hadrons: evt hadrons: TBP>>=
   procedure :: init => evt_hadrons_init
 <<Hadrons: procedures>>=
   subroutine evt_hadrons_init (evt, model_hadrons)
     class(evt_hadrons_t), intent(out) :: evt
     type(model_t), intent(in), target :: model_hadrons
     evt%model_hadrons => model_hadrons
     evt%is_first_event = .true.
   end subroutine evt_hadrons_init
 
 @ %def evt_hadrons_init
 @
 <<Hadrons: evt hadrons: TBP>>=
   procedure :: write_name => evt_hadrons_write_name
 <<Hadrons: procedures>>=
   subroutine evt_hadrons_write_name (evt, unit)
     class(evt_hadrons_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event transform: hadronization"
   end subroutine evt_hadrons_write_name
 
 @ %def evt_hadrons_write_name
 @ Output.
 <<Hadrons: evt hadrons: TBP>>=
   procedure :: write => evt_hadrons_write
 <<Hadrons: procedures>>=
   subroutine evt_hadrons_write (evt, unit, verbose, more_verbose, testflag)
     class(evt_hadrons_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose, more_verbose, testflag
     integer :: u
     u = given_output_unit (unit)
     call write_separator (u, 2)
     call evt%write_name (u)
     call write_separator (u)
     call evt%base_write (u, testflag = testflag, show_set = .false.)
     if (evt%particle_set_exists)  &
          call evt%particle_set%write &
          (u, summary = .true., compressed = .true., testflag = testflag)
     call write_separator (u)
     call evt%hadrons%shower_settings%write (u)
     call write_separator (u)
     call evt%hadrons%hadron_settings%write (u)
   end subroutine evt_hadrons_write
 
 @ %def evt_hadrons_write
 @
 <<Hadrons: evt hadrons: TBP>>=
   procedure :: first_event => evt_hadrons_first_event
 <<Hadrons: procedures>>=
   subroutine evt_hadrons_first_event (evt)
     class(evt_hadrons_t), intent(inout) :: evt
     if (debug_on) call msg_debug (D_TRANSFORMS, "evt_hadrons_first_event")
     associate (settings => evt%hadrons%shower_settings)
        settings%hadron_collision = .false.
        !!! !!! !!! Workaround for PGF90 16.1
        !!! if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () <= 39)) then
        if (evt%particle_set%prt(1)%flv%get_pdg_abs () <= 39 .and. &
            evt%particle_set%prt(2)%flv%get_pdg_abs () <= 39) then
           settings%hadron_collision = .false.
        !!! else if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () >= 100)) then
        else if (evt%particle_set%prt(1)%flv%get_pdg_abs () >= 100 .and. &
                 evt%particle_set%prt(2)%flv%get_pdg_abs () >= 100) then
           settings%hadron_collision = .true.
        else
           call msg_fatal ("evt_hadrons didn't recognize beams setup")
        end if
        if (debug_on) call msg_debug (D_TRANSFORMS, "hadron_collision", settings%hadron_collision)
        if (.not. (settings%isr_active .or. settings%fsr_active)) then
           call msg_fatal ("Hadronization without shower is not supported")
        end if
     end associate
     evt%is_first_event = .false.
   end subroutine evt_hadrons_first_event
 
 @ %def evt_hadrons_first_event
 @ Here we take the particle set from the previous event transform and
 apply the hadronization.  The result is stored in the [[evt%hadrons]]
 object.  We always return a probability of unity as we don't have the
 analytic weight of the hadronization.  Invalid events have to be
 discarded by the caller which is why we mark the particle set as
 invalid.
 <<Hadrons: evt hadrons: TBP>>=
   procedure :: generate_weighted => evt_hadrons_generate_weighted
 <<Hadrons: procedures>>=
   subroutine evt_hadrons_generate_weighted (evt, probability)
     class(evt_hadrons_t), intent(inout) :: evt
     real(default), intent(inout) :: probability
     logical :: valid
     if (signal_is_pending ())  return
     evt%particle_set = evt%previous%particle_set
     if (evt%is_first_event) then
        call evt%first_event ()
     end if
     call evt%hadrons%hadronize (evt%particle_set, valid)
     probability = 1
     evt%particle_set_exists = valid
   end subroutine evt_hadrons_generate_weighted
 
 @ %def evt_hadrons_generate_weighted
 @ The factorization parameters are irrelevant.
 <<Hadrons: evt hadrons: TBP>>=
   procedure :: make_particle_set => evt_hadrons_make_particle_set
 <<Hadrons: procedures>>=
   subroutine evt_hadrons_make_particle_set &
        (evt, factorization_mode, keep_correlations, r)
     class(evt_hadrons_t), intent(inout) :: evt
     integer, intent(in) :: factorization_mode
     logical, intent(in) :: keep_correlations
     real(default), dimension(:), intent(in), optional :: r
     logical :: valid
     call evt%hadrons%make_particle_set (evt%particle_set, evt%model, valid)
     evt%particle_set_exists = evt%particle_set_exists .and. valid
   end subroutine evt_hadrons_make_particle_set
 
 @ %def event_hadrons_make_particle_set
 @ Connect the process with the hadrons object.
 <<Hadrons: evt hadrons: TBP>>=
   procedure :: connect => evt_hadrons_connect
 <<Hadrons: procedures>>=
   subroutine evt_hadrons_connect &
        (evt, process_instance, model, process_stack)
     class(evt_hadrons_t), intent(inout), target :: evt
     type(process_instance_t), intent(in), target :: process_instance
     class(model_data_t), intent(in), target :: model
     type(process_stack_t), intent(in), optional :: process_stack
     call evt%base_connect (process_instance, model, process_stack)
     call evt%make_rng (evt%process)
   end subroutine evt_hadrons_connect
 
 @ %def evt_hadrons_connect
 @ Create RNG instances, spawned by the process object.
 <<Hadrons: evt hadrons: TBP>>=
   procedure :: make_rng => evt_hadrons_make_rng
 <<Hadrons: procedures>>=
   subroutine evt_hadrons_make_rng (evt, process)
     class(evt_hadrons_t), intent(inout) :: evt
     type(process_t), intent(inout) :: process
     class(rng_t), allocatable :: rng
     call process%make_rng (rng)
     call evt%hadrons%import_rng (rng)
   end subroutine evt_hadrons_make_rng
 
 @ %def evt_hadrons_make_rng
 @
 <<Hadrons: evt hadrons: TBP>>=
   procedure :: prepare_new_event => evt_hadrons_prepare_new_event
 <<Hadrons: procedures>>=
   subroutine evt_hadrons_prepare_new_event (evt, i_mci, i_term)
     class(evt_hadrons_t), intent(inout) :: evt
     integer, intent(in) :: i_mci, i_term
     call evt%reset ()
   end subroutine evt_hadrons_prepare_new_event
 
 @ %def evt_hadrons_prepare_new_event
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Resonance Insertion}
 <<[[resonance_insertion.f90]]>>=
 <<File header>>
 
 module resonance_insertion
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_utils, only: write_separator
   use format_defs, only: FMT_12
   use rng_base, only: rng_t
   use selectors, only: selector_t
   use sm_qcd
   use model_data
   use interactions, only: interaction_t
   use particles, only: particle_t, particle_set_t
   use subevents, only: PRT_RESONANT
   use models
   use resonances, only: resonance_history_set_t
   use resonances, only: resonance_tree_t
   use instances, only: process_instance_ptr_t
   use event_transforms
 
 <<Standard module head>>
 
 <<Resonance insertion: public>>
 
 <<Resonance insertion: types>>
 
 contains
 
 <<Resonance insertion: procedures>>
 
 end module resonance_insertion
 @ %def resonance_insertion
 @
 \subsection{Resonance-Insertion Event Transform}
 This is the type for the event transform that applies resonance insertion.
 The resonance history set describe the resonance histories that we may
 consider.  There is a process library with process objects that correspond to
 the resonance histories.  Library creation, compilation etc.\ is done outside
 the scope of this module.
 <<Resonance insertion: public>>=
   public :: evt_resonance_t
 <<Resonance insertion: types>>=
   type, extends (evt_t) :: evt_resonance_t
      type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
      integer, dimension(:), allocatable :: index_offset
      integer :: selected_component = 0
      type(string_t) :: libname
      type(string_t), dimension(:), allocatable :: proc_id
      real(default) :: on_shell_limit = 0
      real(default) :: on_shell_turnoff = 0
      real(default) :: background_factor = 1
      logical :: selector_active = .false.
      type(selector_t) :: selector
      integer :: selected_history = 0
      type(process_instance_ptr_t), dimension(:), allocatable :: instance
    contains
    <<Resonance insertion: evt resonance: TBP>>
   end type evt_resonance_t
 
 @ %def evt_resonance_t
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: write_name => evt_resonance_write_name
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_write_name (evt, unit)
     class(evt_resonance_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event transform: resonance insertion"
   end subroutine evt_resonance_write_name
 
 @ %def evt_resonance_write_name
 @ Output.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: write => evt_resonance_write
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_write (evt, unit, verbose, more_verbose, testflag)
     class(evt_resonance_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose, more_verbose, testflag
     integer :: u, i
     u = given_output_unit (unit)
     call write_separator (u, 2)
     call evt%write_name (u)
     call write_separator (u, 2)
     write (u, "(1x,A,A,A)")  "Process library = '", char (evt%libname), "'"
     if (allocated (evt%res_history_set)) then
        do i = 1, size (evt%res_history_set)
           if (i == evt%selected_component) then
              write (u, "(1x,A,I0,A)")  "Component #", i, ": *"
           else
              write (u, "(1x,A,I0,A)")  "Component #", i, ":"
           end if
           call evt%res_history_set(i)%write (u, indent=1)
        end do
     end if
     call write_separator (u)
     if (allocated (evt%instance)) then
        write (u, "(1x,A)")  "Subprocess instances: allocated"
     else
        write (u, "(1x,A)")  "Subprocess instances: not allocated"
     end if
     if (evt%particle_set_exists) then
        if (evt%selected_history > 0) then
           write (u, "(1x,A,I0)")  "Selected: resonance history #", &
                evt%selected_history
        else
           write (u, "(1x,A)")  "Selected: no resonance history"
        end if
     else
        write (u, "(1x,A)")  "Selected: [none]"
     end if
     write (u, "(1x,A,1x," // FMT_12 // ")")  &
          "On-shell limit    =", evt%on_shell_limit
     write (u, "(1x,A,1x," // FMT_12 // ")")  &
          "On-shell turnoff  =", evt%on_shell_turnoff
     write (u, "(1x,A,1x," // FMT_12 // ")")  &
          "Background factor =", evt%background_factor
     call write_separator (u)
     if (evt%selector_active) then
        write (u, "(2x)", advance="no")
        call evt%selector%write (u, testflag=testflag)
        call write_separator (u)
     end if
     call evt%base_write (u, testflag = testflag, show_set = .false.)
     call write_separator (u)
     if (evt%particle_set_exists) then
        call evt%particle_set%write &
             (u, summary = .true., compressed = .true., testflag = testflag)
        call write_separator (u)
     end if
   end subroutine evt_resonance_write
 
 @ %def evt_resonance_write
 @
 \subsection{Set contained data}
 Insert the resonance data, in form of a pre-generated resonance
 history set.  Accumulate the number of histories for each set, to
 initialize an array of index offsets for lookup.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: set_resonance_data => evt_resonance_set_resonance_data
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_set_resonance_data (evt, res_history_set)
     class(evt_resonance_t), intent(inout) :: evt
     type(resonance_history_set_t), dimension(:), intent(in) :: res_history_set
     integer :: i
     evt%res_history_set = res_history_set
     allocate (evt%index_offset (size (evt%res_history_set)), source = 0)
     do i = 2, size (evt%res_history_set)
        evt%index_offset(i) = &
             evt%index_offset(i-1) + evt%res_history_set(i-1)%get_n_history ()
     end do
   end subroutine evt_resonance_set_resonance_data
   
 @ %def evt_resonance_set_resonance_data  
 @ Set the library that contains the resonant subprocesses.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: set_library => evt_resonance_set_library
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_set_library (evt, libname)
     class(evt_resonance_t), intent(inout) :: evt
     type(string_t), intent(in) :: libname
     evt%libname = libname
   end subroutine evt_resonance_set_library
 
 @ %def evt_resonance_set_library
 @ Assign pointers to subprocess instances.  Once a subprocess has been
 selected, the instance is used for generating the particle set with
 valid quantum-number assignments, ready for resonance insertion.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: set_subprocess_instances &
        => evt_resonance_set_subprocess_instances
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_set_subprocess_instances (evt, instance)
     class(evt_resonance_t), intent(inout) :: evt
     type(process_instance_ptr_t), dimension(:), intent(in) :: instance
     evt%instance = instance
   end subroutine evt_resonance_set_subprocess_instances
   
 @ %def evt_resonance_set_subprocess_instances
 @ Set the on-shell limit, the relative distance from a resonance that
 is still considered to be on-shell.  The probability for being
 considered on-shell can be reduced by the turnoff parameter below.
 For details, see the [[resonances]] module.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: set_on_shell_limit => evt_resonance_set_on_shell_limit
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_set_on_shell_limit (evt, on_shell_limit)
     class(evt_resonance_t), intent(inout) :: evt
     real(default), intent(in) :: on_shell_limit
     evt%on_shell_limit = on_shell_limit
   end subroutine evt_resonance_set_on_shell_limit
   
 @ %def evt_resonance_set_on_shell_limit
 @ Set the Gaussian on-shell turnoff parameter, the width of the
 weighting factor for the resonance squared matrix element.  If the
 resonance is off shell, this factor reduces the weight of the matrix
 element in the selector, such that the probability for considered
 resonant is reduced.  The factor is applied only if the offshellness
 is less than the [[on_shell_limit]] above.  For details, see the
 [[resonances]] module.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: set_on_shell_turnoff => evt_resonance_set_on_shell_turnoff
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_set_on_shell_turnoff (evt, on_shell_turnoff)
     class(evt_resonance_t), intent(inout) :: evt
     real(default), intent(in) :: on_shell_turnoff
     evt%on_shell_turnoff = on_shell_turnoff
   end subroutine evt_resonance_set_on_shell_turnoff
   
 @ %def evt_resonance_set_on_shell_turnoff
 @ Reweight (suppress) the background contribution if there is a resonance
 history that applies.  The event will be registered as background if there is
 no applicable resonance history, or if the background configuration has been
 selected based on (reweighted) squared matrix elements.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: set_background_factor => evt_resonance_set_background_factor
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_set_background_factor (evt, background_factor)
     class(evt_resonance_t), intent(inout) :: evt
     real(default), intent(in) :: background_factor
     evt%background_factor = background_factor
   end subroutine evt_resonance_set_background_factor
   
 @ %def evt_resonance_set_background_factor
 @
 \subsection{Selector}
 Manually import a random-number generator object.  This should be
 done only for testing purposes.  The standard procedure is to
 [[connect]] a process to an event transform; this will create an
 appropriate [[rng]] from the RNG factory in the process object.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: import_rng => evt_resonance_import_rng
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_import_rng (evt, rng)
     class(evt_resonance_t), intent(inout) :: evt
     class(rng_t), allocatable, intent(inout) :: rng
     call move_alloc (from = rng, to = evt%rng)
   end subroutine evt_resonance_import_rng
 
 @ %def evt_resonance_import_rng
 @
 We use a standard selector object to choose from the available resonance
 histories.  If the selector is inactive, we do not insert resonances.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: write_selector => evt_resonance_write_selector
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_write_selector (evt, unit, testflag)
     class(evt_resonance_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     if (evt%selector_active) then
        call evt%selector%write (u, testflag)
     else
        write (u, "(1x,A)")  "Selector: [inactive]"
     end if
   end subroutine evt_resonance_write_selector
     
 @ %def evt_resonance_write_selector
 @
 The selector is initialized with relative weights of
 histories which need not be normalized.  Channels with weight zero are
 ignored.
 
 The [[offset]] will normally be $-1$, so we count from zero, and zero
 is a valid result from the selector.  Selecting the zero entry implies
 no resonance insertion.  However, this behavior is not hard-coded
 here (without offset, no resonance is not possible as a result).
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: init_selector => evt_resonance_init_selector
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_init_selector (evt, weight, offset)
     class(evt_resonance_t), intent(inout) :: evt
     real(default), dimension(:), intent(in) :: weight
     integer, intent(in), optional :: offset
     if (any (weight > 0)) then
        call evt%selector%init (weight, offset = offset)
        evt%selector_active = .true.
     else
        evt%selector_active = .false.
     end if
   end subroutine evt_resonance_init_selector
     
 @ %def evt_resonance_init_selector
 @ Return all selector weights, for inspection.  Note that the index
 counts from zero.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: get_selector_weights => evt_resonance_get_selector_weights
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_get_selector_weights (evt, weight)
     class(evt_resonance_t), intent(in) :: evt
     real(default), dimension(0:), intent(out) :: weight
     integer :: i
     do i = 0, ubound (weight,1)
        weight(i) = evt%selector%get_weight (i)
     end do
   end subroutine evt_resonance_get_selector_weights
   
 @ %def evt_resonance_get_selector_weights
 @
 \subsection{Runtime calculations}
 Use the associated master process instance and the subprocess
 instances to distribute the current momentum set, then compute the
 squared matrix elements weights for all subprocesses.
 
 NOTE: Procedures in this subsection are not covered by unit tests
 in this module, but by unit tests of the [[restricted_subprocesses]]
 module.
 
 Fill the particle set, so the momentum configuration can be used by
 the subprocess instances.  The standard workflow is to copy from the
 previous particle set.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: fill_momenta => evt_resonance_fill_momenta
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_fill_momenta (evt)
     class(evt_resonance_t), intent(inout) :: evt
     integer :: i, n
     if (associated (evt%previous)) then
        evt%particle_set = evt%previous%particle_set
     else if (associated (evt%process_instance)) then
        ! this branch only for unit test
        call evt%process_instance%get_trace &
             (evt%particle_set, i_term=1, n_incoming=evt%process%get_n_in ())
     end if
   end subroutine evt_resonance_fill_momenta
 
 @ %def evt_resonance_fill_momenta
 @
 Return the indices of those subprocesses which can be considered
 on-shell.  The result depends on the stored particle set (outgoing
 momenta) and on the on-shell limit value.
 
 The index [[evt%selected_component]] identifies the particular history set that
 corresponds to the given process component.  Recall that process
 components may have different external particles, so they have
 distinct history sets.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: determine_on_shell_histories &
        => evt_resonance_determine_on_shell_histories
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_determine_on_shell_histories &
        (evt, index_array)
     class(evt_resonance_t), intent(in) :: evt
     integer, dimension(:), allocatable, intent(out) :: index_array
     integer :: i
     i = evt%selected_component
     call evt%res_history_set(i)%determine_on_shell_histories &
          (evt%particle_set%get_outgoing_momenta (), &
          evt%on_shell_limit, &
          index_array)
   end subroutine evt_resonance_determine_on_shell_histories
     
 @ %def evt_resonance_determine_on_shell_histories
 @ Evaluate selected subprocesses.  (In actual operation, the ones that
 have been tagged as on-shell.)
 
 We assume that the MCI, term, and channel indices for the subprocesses
 can all be set to 1.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: evaluate_subprocess => evt_resonance_evaluate_subprocess
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_evaluate_subprocess (evt, index_array)
     class(evt_resonance_t), intent(inout) :: evt
     integer, dimension(:), intent(in) :: index_array
     integer :: k, i
     if (allocated (evt%instance)) then
        do k = 1, size (index_array)
           i = index_array(k)
           associate (instance => evt%instance(i)%p)
             call instance%choose_mci (1)
             call instance%set_trace (evt%particle_set, 1, check_match=.false.)
             call instance%recover (channel = 1, i_term = 1, &
                  update_sqme = .true., recover_phs = .false.)
           end associate
        end do
     end if
   end subroutine evt_resonance_evaluate_subprocess
     
 @ %def evt_resonance_evaluate_subprocess
 @ Return the current squared matrix-element value of the master
 process, and of the selected resonant subprocesses, respectively.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: get_master_sqme => evt_resonance_get_master_sqme
   procedure :: get_subprocess_sqme => evt_resonance_get_subprocess_sqme
 <<Resonance insertion: procedures>>=
   function evt_resonance_get_master_sqme (evt) result (sqme)
     class(evt_resonance_t), intent(in) :: evt
     real(default) :: sqme
     sqme = evt%process_instance%get_sqme ()
   end function evt_resonance_get_master_sqme
   
   subroutine evt_resonance_get_subprocess_sqme (evt, sqme, index_array)
     class(evt_resonance_t), intent(in) :: evt
     real(default), dimension(:), intent(out) :: sqme
     integer, dimension(:), intent(in), optional :: index_array
     integer :: k, i
     if (present (index_array)) then
        sqme = 0
        do k = 1, size (index_array)
           call get_sqme (index_array(k))
        end do
     else
        do i = 1, size (evt%instance)
           call get_sqme (i)
        end do
     end if
   contains
     subroutine get_sqme (i)
       integer, intent(in) :: i
       associate (instance => evt%instance(i)%p)
         sqme(i) = instance%get_sqme ()
       end associate
     end subroutine get_sqme
   end subroutine evt_resonance_get_subprocess_sqme
   
 @ %def evt_resonance_get_master_sqme
 @ %def evt_resonance_get_subprocess_sqme
 @ Apply a turnoff factor for off-shell kinematics to the [[sqme]]
 values.  The [[sqme]] array indices are offset from the resonance
 history set entries.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: apply_turnoff_factor => evt_resonance_apply_turnoff_factor
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_apply_turnoff_factor (evt, sqme, index_array)
     class(evt_resonance_t), intent(in) :: evt
     real(default), dimension(:), intent(inout) :: sqme
     integer, dimension(:), intent(in) :: index_array
     integer :: k, i_res, i_prc
     do k = 1, size (index_array)
        i_res = evt%selected_component
        i_prc = index_array(k) + evt%index_offset(i_res)
        sqme(i_prc) = sqme(i_prc) &
             * evt%res_history_set(i_res)%evaluate_gaussian &
             &   (evt%particle_set%get_outgoing_momenta (), &
             &    evt%on_shell_turnoff, index_array(k))
     end do
   end subroutine evt_resonance_apply_turnoff_factor
   
 @ %def evt_resonance_apply_turnoff_factor
 @ We use the calculations of resonant matrix elements to determine
 probabilities for all applicable resonance configurations.  This method combines
 the steps implemented above.  
 
 First, we determine the selected process component.
 
 TODO: the version below selects the first component which is found
 active.  This make sense only for standard LO process components,
 where exactly one component corresponds to a MCI set.
 
 For the selected process component, we query the kinematics and
 determine the applicable resonance histories.  We collect squared
 matrix elements for those resonance histories and compare them to the
 master-process squared matrix element.
 
 The result is the probability for each resonance history
 together with the probability for non-resonant background (zeroth
 entry).  The latter is defined as the difference between the complete
 process result and the sum of the resonances, ignoring the possibility
 for interference.  If the complete process result is actually
 undershooting the sum of resonances, we nevertheless count the
 background with positive probability.
 
 When looking up the subprocess sqme, we must add the [[index_offset]]
 to the resulting array, since the indices returned by the individual
 history set all count from one, while the subprocess instances that
 belong to process components are collected in one flat array.
 
 After determining matrix elements and background, we may reduce the
 weight of the matrix elements in the selector by applying a turnoff
 factor.
 
 The factor [[background_factor]] indicates whether to include the background
 contribution at all, as long as there is a nonvanishing resonance
 contribution.  Note that instead of setting background to zero, we just
 multiply it by a very small number.  This ensures that indices are assigned
 correctly, and that background will eventually be selected if smooth turnoff
 is chosen.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: compute_probabilities => evt_resonance_compute_probabilities
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_compute_probabilities (evt)
     class(evt_resonance_t), intent(inout) :: evt
     integer, dimension(:), allocatable :: index_array
     real(default) :: sqme_master, sqme_sum, sqme_bg
     real(default), dimension(:), allocatable :: sqme_res
     integer :: n, ic
     if (.not. associated (evt%process_instance))  return
     n = size (evt%instance)
     call evt%select_component (0)
     FIND_ACTIVE_COMPONENT: do ic = 1, evt%process%get_n_components ()
        if (evt%process%component_is_selected (ic)) then
           call evt%select_component (ic)
           exit FIND_ACTIVE_COMPONENT
        end if
     end do FIND_ACTIVE_COMPONENT
     if (evt%selected_component > 0) then
        call evt%determine_on_shell_histories (index_array)
     else
        allocate (index_array (0))
     end if
     call evt%evaluate_subprocess &
          (index_array + evt%index_offset(evt%selected_component))
     allocate (sqme_res (n), source = 0._default)
     call evt%get_subprocess_sqme &
          (sqme_res, index_array + evt%index_offset(evt%selected_component))
     sqme_master = evt%get_master_sqme ()
     sqme_sum = sum (sqme_res)
     sqme_bg = abs (sqme_master - sqme_sum)
     if (evt%on_shell_turnoff > 0) then
        call evt%apply_turnoff_factor (sqme_res, index_array)
     end if
     if (any (sqme_res > 0)) then
        sqme_bg = sqme_bg * evt%background_factor
     end if
     call evt%init_selector ([sqme_bg, sqme_res], offset = -1)
   end subroutine evt_resonance_compute_probabilities
     
 @ %def evt_resonance_compute_probabilities
 @ Set the selected component (unit tests).
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: select_component => evt_resonance_select_component
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_select_component (evt, i_component)
     class(evt_resonance_t), intent(inout) :: evt
     integer, intent(in) :: i_component
     evt%selected_component = i_component
   end subroutine evt_resonance_select_component
   
 @ %def evt_resonance_select_component
 @ 
 \subsection{Sanity check}
 Check the color assignment, which may be wrong for the inserted resonances.
 Delegated to the particle-set component.  Return offending particle
 indices and, optionally, particles as arrays.
 
 This is done in a unit test.  The current algorithm, i.e., selecting
 the color assignment from the resonant-subprocess instance, should not
 generate invalid color assignments.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: find_prt_invalid_color => evt_resonance_find_prt_invalid_color
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_find_prt_invalid_color (evt, index, prt)
     class(evt_resonance_t), intent(in) :: evt
     integer, dimension(:), allocatable, intent(out) :: index
     type(particle_t), dimension(:), allocatable, intent(out), optional :: prt
     if (evt%particle_set_exists) then
        call evt%particle_set%find_prt_invalid_color (index, prt)
     else
        allocate (prt (0))
     end if
   end subroutine evt_resonance_find_prt_invalid_color
   
 @ %def evt_resonance_find_prt_invalid_color
 @
 \subsection{API implementation}
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: prepare_new_event => evt_resonance_prepare_new_event
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_prepare_new_event (evt, i_mci, i_term)
     class(evt_resonance_t), intent(inout) :: evt
     integer, intent(in) :: i_mci, i_term
     call evt%reset ()
   end subroutine evt_resonance_prepare_new_event
 
 @ %def evt_resonance_prepare_new_event
 @ Select one of the histories, based on the momentum array from the
 current particle set.  Compute the probabilities for all resonant
 subprocesses and initialize the selector accordingly.  Then select one
 resonance history, or none.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: generate_weighted => evt_resonance_generate_weighted
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_generate_weighted (evt, probability)
     class(evt_resonance_t), intent(inout) :: evt
     real(default), intent(inout) :: probability
     call evt%fill_momenta ()
     call evt%compute_probabilities ()
     call evt%selector%generate (evt%rng, evt%selected_history)
     probability = 1
   end subroutine evt_resonance_generate_weighted
 
 @ %def evt_resonance_generate_weighted
 @ Here take the current particle set and insert resonance intermediate
 states if applicable.  The resonance history has already been chosen
 by the generator above.  If no resonance history applies, just retain
 the particle set.
 
 If a resonance history applies, we factorize the exclusive interaction
 of the selected (resonance-process) process instance.  With a
 temporary particle set [[prt_set]] as workspace, we the insert the
 resonances, reinstate parent-child relations and set colors and
 momenta for the resonances.  The temporary is then copied back.
 
 Taking the event data from the resonant subprocess instead of the
 master process, guarantees that all flavor, helicity, and color
 assignments are valid for the selected resonance history.  Note that
 the transform may thus choose a quantum-number combination that is
 different from the one chosen by the master process.
 
 The [[i_term]] value for the selected subprocess instance is always
 1.  We support only LO process.  For those, the master process may
 have several terms (= components) that correspond to different
 external states.  The subprocesses are distinct, each one corresponds
 to a definite master component, and by itself it consists of a single
 component/term.
 
 However, if the selector chooses resonance history \#0, i.e., no
 resonance, we just copy the particle set from the previous (i.e.,
 trivial) event transform and ignore all subprocess data.
 <<Resonance insertion: evt resonance: TBP>>=
   procedure :: make_particle_set => evt_resonance_make_particle_set
 <<Resonance insertion: procedures>>=
   subroutine evt_resonance_make_particle_set &
        (evt, factorization_mode, keep_correlations, r)
     class(evt_resonance_t), intent(inout) :: evt
     integer, intent(in) :: factorization_mode
     logical, intent(in) :: keep_correlations
     real(default), dimension(:), intent(in), optional :: r
     type(particle_set_t), target :: prt_set
     type(particle_t), dimension(:), allocatable :: prt
     integer :: n_beam, n_in, n_vir, n_res, n_out, i, i_res, i_term, i_tree
     type(interaction_t), pointer :: int_matrix, int_flows
     integer, dimension(:), allocatable :: map
     type(resonance_tree_t) :: res_tree
     if (associated (evt%previous)) then
        if (evt%previous%particle_set_exists) then
           if (evt%selected_history > 0) then
              if (allocated (evt%instance)) then
                 associate (instance => evt%instance(evt%selected_history)%p)
                   call instance%evaluate_event_data (weight = 1._default)
                   i_term = 1
                   int_matrix => instance%get_matrix_int_ptr (i_term)
                   int_flows  => instance%get_flows_int_ptr (i_term)
                   call evt%factorize_interactions (int_matrix, int_flows, &
                        factorization_mode, keep_correlations, r)
                   call evt%tag_incoming ()
                 end associate
              else  ! this branch only for unit test
                 evt%particle_set = evt%previous%particle_set
              end if
              i_tree = evt%selected_history &
                   - evt%index_offset(evt%selected_component)
              call evt%res_history_set(evt%selected_component)%get_tree &
                   (i_tree, res_tree)
              n_beam = evt%particle_set%get_n_beam ()
              n_in = evt%particle_set%get_n_in ()
              n_vir = evt%particle_set%get_n_vir ()
              n_out = evt%particle_set%get_n_out ()
              n_res = res_tree%get_n_resonances ()
              allocate (map (n_beam + n_in + n_vir + n_out))
              map(1:n_beam+n_in+n_vir) &
                   = [(i, i = 1, n_beam+n_in+n_vir)]
              map(n_beam+n_in+n_vir+1:n_beam+n_in+n_vir+n_out) &
                   = [(i + n_res, &
                   &   i = n_beam+n_in+n_vir+1, &
                   &       n_beam+n_in+n_vir+n_out)]
              call prt_set%transfer (evt%particle_set, n_res, map)
              do i = 1, n_res
                 i_res = n_beam + n_in + n_vir + i
                 call prt_set%insert (i_res, &
                      PRT_RESONANT, &
                      res_tree%get_flv (i), &
                      res_tree%get_children (i, &
                      &   n_beam+n_in+n_vir, n_beam+n_in+n_vir+n_res))
              end do
              do i = n_res, 1, -1
                 i_res = n_beam + n_in + n_vir + i
                 call prt_set%recover_color (i_res)
              end do
              call prt_set%set_momentum &
                   (map(:), evt%particle_set%get_momenta (), on_shell = .true.)
              do i = n_res, 1, -1
                 i_res = n_beam + n_in + n_vir + i
                 call prt_set%recover_momentum (i_res)
              end do
              call evt%particle_set%final ()
              evt%particle_set = prt_set
              call prt_set%final ()
              evt%particle_set_exists = .true.
           else  ! retain particle set, as copied from previous evt
              evt%particle_set_exists = .true.
           end if
        else
           evt%particle_set_exists = .false.
        end if
     else
        evt%particle_set_exists = .false.
     end if
   end subroutine evt_resonance_make_particle_set
 
 @ %def event_resonance_make_particle_set
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[resonance_insertion_ut.f90]]>>=
 <<File header>>
 
 module resonance_insertion_ut
   use unit_tests
   use resonance_insertion_uti
 
 <<Standard module head>>
 
 <<Resonance insertion: public test>>
 
 contains
 
 <<Resonance insertion: test driver>>
 
 end module resonance_insertion_ut
 @ %def resonance_insertion_ut
 @
 <<[[resonance_insertion_uti.f90]]>>=
 <<File header>>
 
 module resonance_insertion_uti
 
 <<Use kinds>>
 <<Use strings>>
   use format_utils, only: write_separator
   use os_interface
   use lorentz
   use rng_base, only: rng_t
   use flavors, only: flavor_t
   use colors, only: color_t
   use models, only: syntax_model_file_init, syntax_model_file_final
   use models, only: model_list_t, model_t
   use particles, only: particle_t, particle_set_t
 
   use resonances, only: resonance_info_t
   use resonances, only: resonance_history_t
   use resonances, only: resonance_history_set_t
 
   use event_transforms
   use resonance_insertion
 
   use rng_base_ut, only: rng_test_t
 
 <<Standard module head>>
 
 <<Resonance insertion: test declarations>>
 
 contains
 
 <<Resonance insertion: tests>>
 
 end module resonance_insertion_uti
 
 @ %def resonance_insertion_uti
 @ API: driver for the unit tests below.
 <<Resonance insertion: public test>>=
   public :: resonance_insertion_test
 <<Resonance insertion: test driver>>=
   subroutine resonance_insertion_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Resonance insertion: execute tests>>
   end subroutine resonance_insertion_test
 
 @ %def resonance_insertion_test
 @
 \subsubsection{Test resonance insertion as event transform}
 Insert a resonance (W boson) into an event with momentum assignment.
 <<Resonance insertion: execute tests>>=
   call test (resonance_insertion_1, "resonance_insertion_1", &
        "simple resonance insertion", &
        u, results)
 <<Resonance insertion: test declarations>>=
   public :: resonance_insertion_1
 <<Resonance insertion: tests>>=
   subroutine resonance_insertion_1 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(particle_set_t) :: pset
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     type(flavor_t) :: fw
     type(color_t) :: col
     real(default) :: mw, ew, pw
     type(vector4_t), dimension(5) :: p
     class(rng_t), allocatable :: rng
     real(default) :: probability
     integer, dimension(:), allocatable :: i_invalid
     type(particle_t), dimension(:), allocatable :: prt_invalid
     integer :: i
 
     write (u, "(A)")  "* Test output: resonance_insertion_1"
     write (u, "(A)")  "*   Purpose: apply simple resonance insertion"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
     ! reset slightly in order to avoid a rounding ambiguity
     call model%set_real (var_str ("mW"), 80.418_default)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 3, &
          pdg = [1, -1, 1, -2, 24], model = model)
 
     call fw%init (24, model)
 
     mw = fw%get_mass ()
     ew = 200._default
     pw = sqrt (ew**2 - mw**2)
 
     p(1) = vector4_moving (ew, ew, 3)
     p(2) = vector4_moving (ew,-ew, 3)
     p(3) = vector4_moving (ew/2, vector3_moving ([pw/2, mw/2, 0._default]))
     p(4) = vector4_moving (ew/2, vector3_moving ([pw/2,-mw/2, 0._default]))
     p(5) = vector4_moving (ew, vector3_moving ([-pw, 0._default, 0._default]))
 
     call pset%set_momentum (p, on_shell = .true.)
     
     call col%init_col_acl (1,0)
     call pset%set_color (1, col)
     
     call col%init_col_acl (0,1)
     call pset%set_color (2, col)
 
     call col%init_col_acl (2,0)
     call pset%set_color (3, col)
     
     call col%init_col_acl (0,2)
     call pset%set_color (4, col)
 
     call col%init_col_acl (0,0)
     call pset%set_color (5, col)
 
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Prepare resonance history set"
     write (u, "(A)")
     
     call res_history_set(1)%init ()
 
     call res_info%init (3, -24, model, 2)
     call res_history%add_resonance (res_info)
     call res_history_set(1)%enter (res_history)
     call res_history%clear ()
 
     call res_history_set(1)%freeze ()
 
     write (u, "(A)")  "* Initialize resonance insertion transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
     
     allocate (rng_test_t :: rng)
     call evt_resonance%import_rng (rng)
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call evt_resonance%write (u)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill resonance insertion transform"
     write (u, "(A)")
     
     call evt_resonance%prepare_new_event (1, 1)
     call evt_resonance%init_selector ([1._default])
     call evt_resonance%generate_weighted (probability)
     call evt_resonance%make_particle_set (0, .false.)
     
     call evt_resonance%write (u)
     
     write (u, "(A)")
     write (u, "(A,1x,F8.5)")  "Event probability =", probability
 
     write (u, "(A)")
     call evt_resonance%find_prt_invalid_color (i_invalid, prt_invalid)
     write (u, "(A)")  "Particles with invalid color:"
     select case (size (prt_invalid))
     case (0)
        write (u, "(2x,A)")  "[none]"
     case default
        do i = 1, size (prt_invalid)
           write (u, "(1x,A,1x,I0)", advance="no")  "Particle", i_invalid(i)
           call prt_invalid(i)%write (u)
        end do
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_resonance%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonance_insertion_1"
 
   end subroutine resonance_insertion_1
 
 @ %def resonance_insertion_1
 @
 \subsubsection{Resonance insertion with color mismatch}
 Same as previous test (but no momenta); resonance insertion should fail
 because of color mismatch: W boson is color-neutral.
 <<Resonance insertion: execute tests>>=
   call test (resonance_insertion_2, "resonance_insertion_2", &
        "resonance color mismatch", &
        u, results)
 <<Resonance insertion: test declarations>>=
   public :: resonance_insertion_2
 <<Resonance insertion: tests>>=
   subroutine resonance_insertion_2 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(particle_set_t) :: pset
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     type(color_t) :: col
     class(rng_t), allocatable :: rng
     real(default) :: probability
     type(particle_t), dimension(:), allocatable :: prt_invalid
     integer, dimension(:), allocatable :: i_invalid
     integer :: i
 
     write (u, "(A)")  "* Test output: resonance_insertion_2"
     write (u, "(A)")  "*   Purpose: resonance insertion with color mismatch"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 3, &
          pdg = [1, -1, 1, -2, 24], model = model)
 
     call col%init_col_acl (1,0)
     call pset%set_color (1, col)
     
     call col%init_col_acl (0,2)
     call pset%set_color (2, col)
 
     call col%init_col_acl (1,0)
     call pset%set_color (3, col)
     
     call col%init_col_acl (0,2)
     call pset%set_color (4, col)
 
     call col%init_col_acl (0,0)
     call pset%set_color (5, col)
 
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Prepare resonance history set"
     write (u, "(A)")
     
     call res_history_set(1)%init ()
 
     call res_info%init (3, -24, model, 2)
     call res_history%add_resonance (res_info)
     call res_history_set(1)%enter (res_history)
     call res_history%clear ()
 
     call res_history_set(1)%freeze ()
 
     write (u, "(A)")  "* Initialize resonance insertion transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
     
     allocate (rng_test_t :: rng)
     call evt_resonance%import_rng (rng)
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call evt_resonance%write (u)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill resonance insertion transform"
     write (u, "(A)")
     
     call evt_resonance%prepare_new_event (1, 1)
     call evt_resonance%init_selector ([1._default])
     call evt_resonance%generate_weighted (probability)
     call evt_resonance%make_particle_set (0, .false.)
     
     call evt_resonance%write (u)
     
     write (u, "(A)")
     write (u, "(A,1x,F8.5)")  "Event probability =", probability
 
     write (u, "(A)")
     call evt_resonance%find_prt_invalid_color (i_invalid, prt_invalid)
     write (u, "(A)")  "Particles with invalid color:"
     select case (size (prt_invalid))
     case (0)
        write (u, "(2x,A)")  "[none]"
     case default
        do i = 1, size (prt_invalid)
           write (u, "(1x,A,1x,I0)", advance="no")  "Particle", i_invalid(i)
           call prt_invalid(i)%write (u)
        end do
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_resonance%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonance_insertion_2"
 
   end subroutine resonance_insertion_2
 
 @ %def resonance_insertion_2
 @
 \subsubsection{Complex resonance history}
 This is the resonance history $u\bar u \to (t\to W^+ b) + (\bar t\to
 (h \to b\bar b) + (\bar t^\ast \to W^-\bar b))$.
 <<Resonance insertion: execute tests>>=
   call test (resonance_insertion_3, "resonance_insertion_3", &
        "complex resonance history", &
        u, results)
 <<Resonance insertion: test declarations>>=
   public :: resonance_insertion_3
 <<Resonance insertion: tests>>=
   subroutine resonance_insertion_3 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(particle_set_t) :: pset
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     type(color_t) :: col
     class(rng_t), allocatable :: rng
     real(default) :: probability
     type(particle_t), dimension(:), allocatable :: prt_invalid
     integer, dimension(:), allocatable :: i_invalid
     integer :: i
 
     write (u, "(A)")  "* Test output: resonance_insertion_3"
     write (u, "(A)")  "*   Purpose: resonance insertion with color mismatch"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 6, &
          pdg = [2, -2, 24, 5, 5, -5, -24, -5], model = model)
 
     call col%init_col_acl (1,0)
     call pset%set_color (1, col)
     
     call col%init_col_acl (0,2)
     call pset%set_color (2, col)
 
     call col%init_col_acl (0,0)
     call pset%set_color (3, col)
     
     call col%init_col_acl (1,0)
     call pset%set_color (4, col)
 
     call col%init_col_acl (3,0)
     call pset%set_color (5, col)
 
     call col%init_col_acl (0,3)
     call pset%set_color (6, col)
 
     call col%init_col_acl (0,0)
     call pset%set_color (7, col)
 
     call col%init_col_acl (0,2)
     call pset%set_color (8, col)
 
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Prepare resonance history set"
     write (u, "(A)")
     
     call res_history_set(1)%init ()
 
     call res_info%init (3, 6, model, 6)
     call res_history%add_resonance (res_info)
     call res_info%init (12, 25, model, 6)
     call res_history%add_resonance (res_info)
     call res_info%init (60, -6, model, 6)
     call res_history%add_resonance (res_info)
     call res_history_set(1)%enter (res_history)
     call res_history%clear ()
 
     call res_history_set(1)%freeze ()
 
     write (u, "(A)")  "* Initialize resonance insertion transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
     
     allocate (rng_test_t :: rng)
     call evt_resonance%import_rng (rng)
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call evt_resonance%write (u)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill resonance insertion transform"
     write (u, "(A)")
     
     call evt_resonance%prepare_new_event (1, 1)
     call evt_resonance%init_selector ([1._default])
     call evt_resonance%generate_weighted (probability)
     call evt_resonance%make_particle_set (0, .false.)
     
     call evt_resonance%write (u)
     
     write (u, "(A)")
     call evt_resonance%find_prt_invalid_color (i_invalid, prt_invalid)
     write (u, "(A)")  "Particles with invalid color:"
     select case (size (prt_invalid))
     case (0)
        write (u, "(2x,A)")  "[none]"
     case default
        do i = 1, size (prt_invalid)
           write (u, "(1x,A,1x,I0)", advance="no")  "Particle", i_invalid(i)
           call prt_invalid(i)%write (u)
        end do
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_resonance%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonance_insertion_3"
 
   end subroutine resonance_insertion_3
 
 @ %def resonance_insertion_3
 @
 \subsubsection{Resonance history selection}
 Another test with zero momenta: select one of several resonant channels
 using the selector component.
 <<Resonance insertion: execute tests>>=
   call test (resonance_insertion_4, "resonance_insertion_4", &
        "resonance history selection", &
        u, results)
 <<Resonance insertion: test declarations>>=
   public :: resonance_insertion_4
 <<Resonance insertion: tests>>=
   subroutine resonance_insertion_4 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(particle_set_t) :: pset
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     type(color_t) :: col
     class(rng_t), allocatable :: rng
     real(default) :: probability
     integer :: i
 
     write (u, "(A)")  "* Test output: resonance_insertion_4"
     write (u, "(A)")  "*   Purpose: resonance history selection"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 4, &
          pdg = [1, -1, 1, -2, -3, 4], model = model)
 
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Prepare resonance history set"
     write (u, "(A)")
     
     call res_history_set(1)%init ()
 
     call res_info%init (3, -24, model, 4)
     call res_history%add_resonance (res_info)
     call res_history_set(1)%enter (res_history)
     call res_history%clear ()
 
     call res_info%init (12, 24, model, 4)
     call res_history%add_resonance (res_info)
     call res_history_set(1)%enter (res_history)
     call res_history%clear ()
 
     call res_info%init (12, 24, model, 4)
     call res_history%add_resonance (res_info)
     call res_info%init (15, 25, model, 4)
     call res_history%add_resonance (res_info)
     call res_history_set(1)%enter (res_history)
     call res_history%clear ()
 
     call res_history_set(1)%freeze ()
 
     write (u, "(A)")  "* Initialize resonance insertion transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
     
     allocate (rng_test_t :: rng)
     call evt_resonance%import_rng (rng)
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call evt_resonance%write (u)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill resonance insertion transform"
     write (u, "(A)")
     
     do i = 1, 6
        write (u, "(A,1x,I0)")  "* Event #", i
        write (u, "(A)")
     
        call evt_resonance%prepare_new_event (1, 1)
        call evt_resonance%init_selector ([1._default, 2._default, 1._default])
        call evt_resonance%generate_weighted (probability)
        call evt_resonance%make_particle_set (0, .false.)
     
        call evt_resonance%write (u)
        write (u, "(A)")
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_resonance%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonance_insertion_4"
 
   end subroutine resonance_insertion_4
 
 @ %def resonance_insertion_4
 @
 \subsubsection{Resonance history selection}
 Another test with zero momenta: select either a resonant channel or no
 resonance.
 <<Resonance insertion: execute tests>>=
   call test (resonance_insertion_5, "resonance_insertion_5", &
        "resonance history on/off", &
        u, results)
 <<Resonance insertion: test declarations>>=
   public :: resonance_insertion_5
 <<Resonance insertion: tests>>=
   subroutine resonance_insertion_5 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(particle_set_t) :: pset
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     type(color_t) :: col
     class(rng_t), allocatable :: rng
     real(default) :: probability
     integer :: i
 
     write (u, "(A)")  "* Test output: resonance_insertion_5"
     write (u, "(A)")  "*   Purpose: resonance history selection including no resonance"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 4, &
          pdg = [1, -1, 1, -2, -3, 4], model = model)
 
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
 
     write (u, "(A)")  "* Prepare resonance history set"
     write (u, "(A)")
     
     call res_history_set(1)%init ()
 
     call res_info%init (3, -24, model, 4)
     call res_history%add_resonance (res_info)
     call res_history_set(1)%enter (res_history)
     call res_history%clear ()
 
     call res_history_set(1)%freeze ()
 
     write (u, "(A)")  "* Initialize resonance insertion transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
     
     allocate (rng_test_t :: rng)
     call evt_resonance%import_rng (rng)
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     
     write (u, "(A)")  "* Fill resonance insertion transform"
     write (u, "(A)")
     
     do i = 1, 2
        write (u, "(A,1x,I0)")  "* Event #", i
        write (u, "(A)")
     
        call evt_resonance%prepare_new_event (1, 1)
        call evt_resonance%init_selector ([1._default, 3._default], offset = -1)
        call evt_resonance%generate_weighted (probability)
        call evt_resonance%make_particle_set (0, .false.)
     
        call evt_resonance%write (u)
        write (u, "(A)")
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_resonance%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonance_insertion_5"
 
   end subroutine resonance_insertion_5
 
 @ %def resonance_insertion_5
 @
 \subsubsection{Resonance insertion with structured beams}
 Insert a resonance (W boson) into an event with beam and virtual
 particles.
 <<Resonance insertion: execute tests>>=
   call test (resonance_insertion_6, "resonance_insertion_6", &
        "resonance insertion with beam structure", &
        u, results)
 <<Resonance insertion: test declarations>>=
   public :: resonance_insertion_6
 <<Resonance insertion: tests>>=
   subroutine resonance_insertion_6 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(model_list_t) :: model_list
     type(particle_set_t) :: pset
     type(model_t), pointer :: model
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     class(rng_t), allocatable :: rng
     real(default) :: probability
 
     write (u, "(A)")  "* Test output: resonance_insertion_6"
     write (u, "(A)")  "*   Purpose: resonance insertion with structured beams"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
          pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)
 
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Prepare resonance history set"
     write (u, "(A)")
     
     call res_history_set(1)%init ()
 
     call res_info%init (3, 23, model, 2)
     call res_history%add_resonance (res_info)
     call res_history_set(1)%enter (res_history)
     call res_history%clear ()
 
     call res_history_set(1)%freeze ()
 
     write (u, "(A)")  "* Initialize resonance insertion transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
     
     allocate (rng_test_t :: rng)
     call evt_resonance%import_rng (rng)
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call evt_resonance%write (u)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill resonance insertion transform"
     write (u, "(A)")
     
     call evt_resonance%prepare_new_event (1, 1)
     call evt_resonance%init_selector ([1._default])
     call evt_resonance%generate_weighted (probability)
     call evt_resonance%make_particle_set (0, .false.)
     
     call evt_resonance%write (u)
     
     write (u, "(A)")
     write (u, "(A,1x,F8.5)")  "Event probability =", probability
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_resonance%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonance_insertion_6"
 
   end subroutine resonance_insertion_6
 
 @ %def resonance_insertion_6
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Recoil kinematics}
 <<[[recoil_kinematics.f90]]>>=
 <<File header>>
 
 module recoil_kinematics
 
 <<Use kinds>>
   use constants, only: twopi
   use lorentz, only: vector4_t
   use lorentz, only: vector4_moving
   use lorentz, only: vector3_moving
   use lorentz, only: transverse_part
   use lorentz, only: lorentz_transformation_t
   use lorentz, only: inverse
   use lorentz, only: boost
   use lorentz, only: transformation
   use lorentz, only: operator(+)
   use lorentz, only: operator(-)
   use lorentz, only: operator(*)
   use lorentz, only: operator(**)
 
 <<Standard module head>>
 
 <<Recoil kinematics: public>>
 
 <<Recoil kinematics: parameters>>
 
 <<Recoil kinematics: types>>
 
 contains
 
 <<Recoil kinematics: procedures>>
 
 end module recoil_kinematics
 @ %def recoil_kinematics
 @ 
 \subsection{$\phi$ sampler}
 This is trivial.  Generate an azimuthal angle, given a $(0,1)$ RNG parameter.
 <<Recoil kinematics: procedures>>=
   elemental subroutine generate_phi_recoil (r, phi)
     real(default), intent(in) :: r
     real(default), intent(out) :: phi
 
     phi = r * twopi
 
   end subroutine generate_phi_recoil
   
 @ %def generate_phi_recoil
 @
 \subsection{$Q^2$ sampler}
 The dynamics of factorization suggests to generate a flat $Q^2$
 distribution from a (random) number, event by event.   
 
 At the lowest momentum transfer values, the particle (electron) mass
 sets a smooth cutoff.  The formula can produce $Q$ values below the
 electron mass, down to zero, but with a power distribution that
 eventually evolves into the expected logarithmic distribution for $Q^2 >
 m^2$.
 
 We are talking about the absolute value here, so all $Q^2$
 values are positive.  For the actual momentum transfer, $q^2=-Q^2$.
 <<Recoil kinematics: public>>=
   public :: generate_q2_recoil
 <<Recoil kinematics: procedures>>=
   elemental subroutine generate_q2_recoil (s, x_bar, q2_max, m2, r, q2)
     real(default), intent(in) :: s
     real(default), intent(in) :: q2_max
     real(default), intent(in) :: x_bar
     real(default), intent(in) :: m2
     real(default), intent(in) :: r
     real(default), intent(out) :: q2
 
     real(default) :: q2_max_evt
 
     q2_max_evt = q2_max_event (s, x_bar, q2_max)
     
     q2 = m2 * (exp (r * log (1 + (q2_max_evt / m2))) - 1)
 
   end subroutine generate_q2_recoil
   
 @ %def generate_q_recoil
 @ 
 The $Q$ distribution is cut off from above by the kinematic limit,
 which depends on the energy that is available for the radiated photon,
 or by a user-defined cutoff -- whichever is less.  The kinematic limit
 fits the formulas for recoil momenta (see below), and it also
 implicitly enters the ISR collinear structure function, so the
 normalization of the distribution should be correct.
 <<Recoil kinematics: procedures>>=
   elemental function q2_max_event (s, x_bar, q2_max) result (q2)
     real(default), intent(in) :: s
     real(default), intent(in) :: x_bar
     real(default), intent(in) :: q2_max
     real(default) :: q2
     
     q2 = min (x_bar * s, q2_max)
     
   end function q2_max_event
     
 @ %def q2_max_event
 @
 \subsection{Kinematics functions}
 Given values for energies, $Q_{1,2}^2$, azimuthal angle, compute the
 matching polar angle of the radiating particle.  The subroutine
 returns $\sin\theta$ and $\cos\theta$.
 <<Recoil kinematics: procedures>>=
   subroutine polar_angles (s, xb, rho, ee, q2, sin_th, cos_th, ok)
     real(default), intent(in) :: s
     real(default), intent(in) :: xb
     real(default), intent(in) :: rho
     real(default), dimension(2), intent(in) :: ee
     real(default), dimension(2), intent(in) :: q2
     real(default), dimension(2), intent(out) :: sin_th
     real(default), dimension(2), intent(out) :: cos_th
     logical, intent(out) :: ok
 
     real(default), dimension(2) :: sin2_th_2
 
     sin2_th_2 = q2 / (ee * rho * xb * s)
     
     if (all (sin2_th_2 <= 1)) then
        sin_th = 2 * sqrt (sin2_th_2 * (1 - sin2_th_2))
        cos_th = 1 - 2 * sin2_th_2
        ok = .true.
     else
        sin_th = 0
        cos_th = 1
        ok = .false.
     end if
 
   end subroutine polar_angles
 
 @ %def polar_angles
 @
 Compute the acollinearity parameter $\lambda$ from azimuthal and polar
 angles.  The result is a number between $0$ and $1$.
 <<Recoil kinematics: procedures>>=
   function lambda_factor (sin_th, cos_th, cphi) result (lambda)
     real(default), dimension(2), intent(in) :: sin_th
     real(default), dimension(2), intent(in) :: cos_th
     real(default), intent(in) :: cphi
     real(default) :: lambda
 
     lambda = (1 - cos_th(1) * cos_th(2) - cphi * sin_th(1) * sin_th(2)) / 2
 
   end function lambda_factor
 
 @ %def lambda_factor
 @
 Compute the factor that rescales photon energies, such that the
 radiation angles match the kinematics parameters.
 
 For small values of $\bar x/\cosh\eta$, we have to use the Taylor
 expansion if we do not want to lose precision.  The optional argument
 allows for a unit test that compares exact and approximate.
 <<Recoil kinematics: procedures>>=
   function scale_factor (che, lambda, xb0, approximate) result (rho)
     real(default), intent(in) :: che
     real(default), intent(in) :: lambda
     real(default), intent(in) :: xb0
     logical, intent(in), optional :: approximate
     real(default) :: rho
 
     real(default), parameter :: &
          e0 = (100 * epsilon (1._default)) ** (0.3_default)
     logical :: approx
 
     if (present (approximate)) then
        approx = approximate
     else
        approx = (xb0/che) < e0
     end if
 
     if (approx) then
        rho = 1 - lambda * (xb0/(2*che)) * (1 + (1-lambda) * (xb0/che))
     else
        rho =  (che / ((1-lambda)*xb0)) &
          * (1 - sqrt (1 - 2 * (1-lambda) * (xb0/che) &
          &    + (1-lambda) * (xb0 / che)**2))
     end if
 
   end function scale_factor
 
 @ %def scale_factor
 @ The code snippet below is not used anywhere, but may be manually
 inserted in a unit test to numerically verify the approximation above.
 <<Recoil kinematics: extra test code>>=
     write (u, "(A)")
     write (u, "(A)") "*** Table: scale factor calculation"
     write (u, "(A)")
 
     lambda = 0.25_default
     write (u, FMT1)  "lambda =", lambda
     
     che = 4._default
     write (u, FMT1)  "che    =", che
     
     write (u, "(A)")  "   x0    rho(exact)   rho(approx)   rho(chosen)"
     xb0 = 1._default
     do i = 1, 30
        xb0 = xb0 / 10
        write (u, FMT4)   xb0, &
             scale_factor (che, lambda, xb0, approximate=.false.), &
             scale_factor (che, lambda, xb0, approximate=.true.), &
             scale_factor (che, lambda, xb0)
     end do
 @ 
 Compute the current values for the $x_{1,2}$ parameters, given the
 updated scale factor $\rho$ and the collinear parameters.
 <<Recoil kinematics: procedures>>=
   subroutine scaled_x (rho, ee, xb0, x, xb)
     real(default), intent(in) :: rho
     real(default), dimension(2), intent(in) :: ee
     real(default), intent(in) :: xb0
     real(default), dimension(2), intent(out) :: x
     real(default), dimension(2), intent(out) :: xb
     
     xb = rho * ee * xb0
     x = 1 - xb
 
   end subroutine scaled_x
 
 @ %def scaled_x
 @
 \subsection{Iterative solution of kinematics constraints}
 Find a solution of the kinematics constraints.  We know the parameters
 appropriate for collinear kinematics $\sqrt{s}$, $x^c_{1,2}$.  We
 have picked values vor the momentum transfer $Q_{1,2}$ and the
 azimuthal angles $\phi_{1,2}$.  The solution consists of modified energy
 fractions $x_{1,2}$ and polar angles $\theta_{1,2}$.
 
 If the computation fails, which can happen for large momentum
 transfer, the flag [[ok]] will indicate this.
 <<Recoil kinematics: public>>=
   public :: solve_recoil
 <<Recoil kinematics: procedures>>=
   subroutine solve_recoil (sqrts, xc, xcb, phi, q2, x, xb, cos_th, sin_th, ok)
     real(default), intent(in) :: sqrts
     real(default), dimension(2), intent(in) :: xc
     real(default), dimension(2), intent(in) :: xcb
     real(default), dimension(2), intent(in) :: phi
     real(default), dimension(2), intent(in) :: q2
     real(default), dimension(2), intent(out) :: x
     real(default), dimension(2), intent(out) :: xb
     real(default), dimension(2), intent(out) :: cos_th
     real(default), dimension(2), intent(out) :: sin_th
     logical, intent(out) :: ok
 
     real(default) :: s
     real(default), dimension(2) :: ee
     real(default), dimension(2) :: th
     real(default) :: xb0, cphi
     real(default) :: che, lambda
     real(default) :: rho_new, rho, rho_old
     real(default) :: dr_old, dr_new
     real(default), parameter :: dr_limit = 100 * epsilon (1._default)
     integer, parameter :: n_it_max = 20
     integer :: i
 
     ok = .true.
 
     s = sqrts**2
     ee = sqrt ([xcb(1)/xcb(2), xcb(2)/xcb(1)])
     che = sum (ee) / 2
     xb0 = sqrt (xcb(1) * xcb(2))
     cphi = cos (phi(1) - phi(2))
 
     rho_old = 10
     rho = 1
     th = 0
     sin_th = sin (th)
     cos_th = cos (th)
     lambda = lambda_factor (sin_th, cos_th, cphi)
     call scaled_x (rho, ee, xb0, x, xb)
     
     iterate_loop: do i = 1, n_it_max
 
        call polar_angles (s, xb0, rho, ee, q2, sin_th, cos_th, ok)
        if (.not. ok)  return
        th = atan2 (sin_th, cos_th)
 
        lambda = lambda_factor (sin_th, cos_th, cphi)
        rho_new = scale_factor (che, lambda, xb0)
        call scaled_x (rho_new, ee, xb0, x, xb)
 
        dr_old = abs (rho - rho_old)
        dr_new = abs (rho_new - rho)
 
        rho_old = rho
        rho = rho_new
        
        if (dr_new < dr_limit .or. dr_new >= dr_old)  exit iterate_loop
 
     end do iterate_loop
 
   end subroutine solve_recoil
 
 @ %def solve_recoil
 @
 With all kinematics parameters known, construct actual four-vectors
 for the recoil momenta, the off-shell (spacelike) parton momenta, and
 on-shell projected parton momenta.
 <<Recoil kinematics: public>>=
   public :: recoil_momenta
 <<Recoil kinematics: procedures>>=
   subroutine recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
     real(default), intent(in) :: sqrts
     real(default), dimension(2), intent(in) :: xc
     real(default), dimension(2), intent(in) :: xb
     real(default), dimension(2), intent(in) :: cos_th
     real(default), dimension(2), intent(in) :: sin_th
     real(default), dimension(2), intent(in) :: phi
     type(vector4_t), dimension(2), intent(out) :: km
     type(vector4_t), dimension(2), intent(out) :: qm
     type(vector4_t), dimension(2), intent(out) :: qo
 
     type(vector4_t), dimension(2) :: pm
     type(lorentz_transformation_t) :: lt
     real(default) :: sqsh
 
     pm(1) = &
          vector4_moving (sqrts/2, &
          vector3_moving ([0._default, 0._default, sqrts/2]))
     pm(2) = &
          vector4_moving (sqrts/2, &
          vector3_moving ([0._default, 0._default,-sqrts/2]))
 
     km(1) = xb(1) * (sqrts/2) * vector4_moving ( &
          1._default, &
          vector3_moving ([ &
          &     sin_th(1) * cos (phi(1)), &
          &     sin_th(1) * sin (phi(1)), &
          &     cos_th(1)]) &
          )
     km(2) = xb(2) * (sqrts/2) * vector4_moving ( &
          1._default, &
          vector3_moving ([ &
          &    -sin_th(2) * cos (phi(2)), &
          &    -sin_th(2) * sin (phi(2)), &
          &    -cos_th(2)]) &
          )
 
     qm(1) = pm(1) - km(1)
     qm(2) = pm(2) - km(2)
 
     sqsh = sqrt (xc(1)*xc(2)) * sqrts
     lt = transformation (3, qm(1), qm(2), sqsh)
 
     qo(1) = lt * vector4_moving (sqsh/2, sqsh/2, 3)
     qo(2) = lt * vector4_moving (sqsh/2,-sqsh/2, 3)
 
   end subroutine recoil_momenta
 
 @ %def recoil_momenta
 @ 
 Compute the Lorentz transformation that we can use to transform any
 outgoing momenta into the new c.m.\ system of the incoming partons.
 Not relying on the previous calculations, we determine the
 transformation that transforms the original collinear partons into
 their c.m.\ system, and then transform this to the new c.m.\ system.
 <<Recoil kinematics: public>>=
   public :: recoil_transformation
 <<Recoil kinematics: procedures>>=
   subroutine recoil_transformation (sqrts, xc, qo, lt)
     real(default), intent(in) :: sqrts
     real(default), dimension(2), intent(in) :: xc
     type(vector4_t), dimension(2), intent(in) :: qo
     type(lorentz_transformation_t), intent(out) :: lt
 
     real(default) :: sqsh
     type(vector4_t), dimension(2) :: qc
     type(lorentz_transformation_t) :: ltc, lto
     
     qc(1) = xc(1) * vector4_moving (sqrts/2, sqrts/2, 3)
     qc(2) = xc(2) * vector4_moving (sqrts/2,-sqrts/2, 3)
     
     sqsh = sqrt (xc(1) * xc(2)) * sqrts
     ltc = transformation (3, qc(1), qc(2), sqsh)
     lto = transformation (3, qo(1), qo(2), sqsh)
     lt = lto * inverse (ltc)
 
   end subroutine recoil_transformation
   
 @ %def recoil_transformation
 @
 Compute the Lorentz boost that transforms the c.m.\ frame of the
 momenta into the lab frame where they are given.  Also return their
 common invariant mass, $\sqrt{s}$.
 
 If the initial momenta are not collinear, [[ok]] is set false.
 <<Recoil kinematics: public>>=
   public :: initial_transformation
 <<Recoil kinematics: procedures>>=
   subroutine initial_transformation (p, sqrts, lt, ok)
     type(vector4_t), dimension(2), intent(in) :: p
     real(default), intent(out) :: sqrts
     type(lorentz_transformation_t), intent(out) :: lt
     logical, intent(out) :: ok
     
     ok = all (transverse_part (p) == 0)
 
     sqrts = (p(1) + p(2)) ** 1
     lt = boost (p(1) + p(2), sqrts)
 
   end subroutine initial_transformation
   
 @ %def initial_transformation
 @
 \subsection{Generate recoil event}
 Combine the above kinematics calculations.  First generate azimuthal
 angles and momentum transfer, solve kinematics and compute momenta for
 the radiated photons and the on-shell projected, recoiling partons.
 
 If [[ok]] is false, the data point has failed and we should repeat the
 procedure for a new set of RNG parameters [[r]].
 <<Recoil kinematics: public>>=
   public :: generate_recoil
 <<Recoil kinematics: procedures>>=
   subroutine generate_recoil (sqrts, q_max, m, xc, xcb, r, km, qm, qo, ok)
     real(default), intent(in) :: sqrts
     real(default), intent(in), dimension(2) :: q_max
     real(default), intent(in), dimension(2) :: m
     real(default), intent(in), dimension(2) :: xc
     real(default), intent(in), dimension(2) :: xcb
     real(default), intent(in), dimension(4) :: r
     type(vector4_t), dimension(2), intent(out) :: km
     type(vector4_t), dimension(2), intent(out) :: qm
     type(vector4_t), dimension(2), intent(out) :: qo
     logical, intent(out) :: ok
 
     real(default), dimension(2) :: q2
     real(default), dimension(2) :: phi
     real(default), dimension(2) :: x
     real(default), dimension(2) :: xb
     real(default), dimension(2) :: cos_th
     real(default), dimension(2) :: sin_th
 
     call generate_q2_recoil (sqrts**2, xcb, q_max**2, m**2, r(1:2), q2)
     call generate_phi_recoil (r(3:4), phi)
     
     call solve_recoil (sqrts, xc, xcb, phi, q2, x, xb, cos_th, sin_th, ok)
     if (ok) then
        call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
     end if
 
   end subroutine generate_recoil
   
 @ %def generate_recoil
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[recoil_kinematics_ut.f90]]>>=
 <<File header>>
 
 module recoil_kinematics_ut
   use unit_tests
   use recoil_kinematics_uti
 
 <<Standard module head>>
 
 <<Recoil kinematics: public test>>
 
 contains
 
 <<Recoil kinematics: test driver>>
 
 end module recoil_kinematics_ut
 @ %def recoil_kinematics_ut
 @
 <<[[recoil_kinematics_uti.f90]]>>=
 <<File header>>
 
 module recoil_kinematics_uti
 
 <<Use kinds>>
   use constants, only: twopi
   use constants, only: degree
   use lorentz, only: vector4_t
   use lorentz, only: vector4_moving
   use lorentz, only: lorentz_transformation_t
   use lorentz, only: inverse
   use lorentz, only: operator(+)
   use lorentz, only: operator(*)
   use lorentz, only: operator(**)
   use lorentz, only: pacify
 
   use recoil_kinematics, only: solve_recoil
   use recoil_kinematics, only: recoil_momenta
   use recoil_kinematics, only: recoil_transformation
   use recoil_kinematics, only: initial_transformation
   use recoil_kinematics, only: generate_q2_recoil
   use recoil_kinematics, only: generate_recoil
 
 <<Standard module head>>
 
 <<Recoil kinematics: test declarations>>
 
 contains
 
 <<Recoil kinematics: tests>>
 
 end module recoil_kinematics_uti
 
 @ %def recoil_kinematics_uti
 @ API: driver for the unit tests below.
 <<Recoil kinematics: public test>>=
   public :: recoil_kinematics_test
 <<Recoil kinematics: test driver>>=
   subroutine recoil_kinematics_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Recoil kinematics: execute tests>>
   end subroutine recoil_kinematics_test
 
 @ %def recoil_kinematics_test
 @
 \subsubsection{Recoil kinematics}
 For a set of input data, solve the kinematics constraints and generate
 momenta accordingly.
 <<Recoil kinematics: execute tests>>=
   call test (recoil_kinematics_1, "recoil_kinematics_1", &
        "iterative solution of non-collinear kinematics", &
        u, results)
 <<Recoil kinematics: test declarations>>=
   public :: recoil_kinematics_1
 <<Recoil kinematics: tests>>=
   subroutine recoil_kinematics_1 (u)
     integer, intent(in) :: u
 
     real(default) :: sqrts
     real(default), dimension(2) :: xc, xcb
     real(default), dimension(2) :: q
     real(default), dimension(2) :: phi
     real(default), dimension(2) :: cos_th, sin_th
     real(default), dimension(2) :: x
     real(default), dimension(2) :: xb
     type(vector4_t), dimension(2) :: km
     type(vector4_t), dimension(2) :: qm
     type(vector4_t), dimension(2) :: qo
     integer :: i
     logical :: ok
     
     character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
     character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"
     character(*), parameter :: FMT4 = "(3x,ES8.1,9(1x,ES19.12))"
 
     write (u, "(A)")  "* Test output: recoil_kinematics_1"
     write (u, "(A)")  "*   Purpose: compute kinematics for various input data"
     write (u, "(A)")
 
     sqrts = 100
     write (u, FMT1)  "sqrts =", sqrts
     
     write (u, "(A)")
     write (u, "(A)") "*** collinear data set"
     write (u, "(A)")
 
     xc = [0.6_default, 0.9_default]
     xcb = 1 - xc
     phi = [0.1_default, 0.2_default] * twopi
     q = 0
 
     call show_data
     call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
     call show_results
 
     call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
     call show_momenta
 
     write (u, "(A)")
     write (u, "(A)") "*** moderate data set"
     write (u, "(A)")
 
     xc = [0.6_default, 0.9_default]
     xcb = 1 - xc
     phi = [0.1_default, 0.2_default] * twopi
     q = [0.2_default, 0.05_default] * sqrts
 
     call show_data
     call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
     call show_results
     
     call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
     call show_momenta
 
     write (u, "(A)")
     write (u, "(A)") "*** semi-soft data set"
     write (u, "(A)")
 
     xcb= [0.1_default, 0.0001_default]
     xc = 1 - xcb
     phi = [0.1_default, 0.2_default] * twopi
     q = [0.2_default, 0.00001_default] * sqrts
 
     call show_data
     call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
     call show_results
 
     call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
     call show_momenta
 
     write (u, "(A)")
     write (u, "(A)") "*** hard-soft data set"
     write (u, "(A)")
 
     xcb= [0.1_default, 1.e-30_default]
     xc = 1 - xcb
     phi = [0.1_default, 0.2_default] * twopi
     q = [0.2_default, 1.e-35_default] * sqrts
 
     call show_data
     call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
     call show_results
 
     call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
     call show_momenta
 
     write (u, "(A)")
     write (u, "(A)") "*** hard data set"
     write (u, "(A)")
 
     xc = [0.2_default, 0.4_default]
     xcb = 1 - xc
     phi = [0.1_default, 0.8_default] * twopi
     q = [0.74_default, 0.3_default] * sqrts
 
     call show_data
     call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
     call show_results
 
     call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
     call show_momenta
 
     write (u, "(A)")
     write (u, "(A)") "*** failing data set"
     write (u, "(A)")
 
     xc = [0.2_default, 0.4_default]
     xcb = 1 - xc
     phi = [0.1_default, 0.8_default] * twopi
     q = [0.9_default, 0.3_default] * sqrts
     
     call show_data
     call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
     if (.not. ok) then
        write (u, "(A)")
        write (u, "(A)") "Failed as expected."
     end if
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: recoil_kinematics_1"
 
   contains
 
     subroutine show_data
       write (u, FMT1) "sqs_h =", sqrt (xc(1) * xc(2)) * sqrts
       write (u, FMT1) "xc    =", xc
       write (u, FMT1) "xcb   =", xcb
       write (u, FMT1) "Q     =", Q
       write (u, FMT1) "phi/D =", phi / degree
     end subroutine show_data
 
     subroutine show_results
       write (u, "(A)")
       write (u, "(A)") "Result:"
       write (u, FMT1) "th/D  =", atan2 (sin_th, cos_th) / degree
       write (u, FMT1) "x     =", x
       write (u, "(A)")
     end subroutine show_results
     
     subroutine show_momenta
       type(vector4_t) :: qm0, qo0
       real(default), parameter :: tol = 1.e-7_default
       call pacify (km, tol)
       call pacify (qm, tol)
       call pacify (qo, tol)
       write (u, "(A)") "Momenta: k"
       call km(1)%write (u, testflag=.true.)
       call km(2)%write (u, testflag=.true.)
       write (u, FMT1) "k^2 =", abs (km(1)**2), abs (km(2)**2)
       write (u, "(A)")
       write (u, "(A)") "Momenta: q"
       call qm(1)%write (u, testflag=.true.)
       call qm(2)%write (u, testflag=.true.)
       write (u, "(A)")
       write (u, "(A)") "Momenta: q(os)"
       call qo(1)%write (u, testflag=.true.)
       call qo(2)%write (u, testflag=.true.)
       write (u, "(A)")
       write (u, "(A)") "Check: parton momentum sum: q vs q(os)"
       qm0 = qm(1) + qm(2)
       call qm0%write (u, testflag=.true.)
       qo0 = qo(1) + qo(2)
       call qo0%write (u, testflag=.true.)
       write (u, "(A)")
       write (u, "(A)") "* Check: momentum transfer (off-shell/on-shell)"
       write (u, FMT2) "|q| =", abs (qm(1)**1), abs (qm(2)**1)
       write (u, FMT2) "Q   =", q
       write (u, FMT2) "|qo|=", abs (qo(1)**1), abs (qo(2)**1)
       write (u, "(A)")
       write (u, "(A)") "* Check: sqrts, sqrts_hat"
       write (u, FMT1) "|p| =", (km(1)+km(2)+qm(1)+qm(2))**1, (qm(1)+qm(2))**1
       write (u, FMT1) "sqs =", sqrts, sqrt (product (xc)) * sqrts
       write (u, FMT1) "|po|=", abs ((km(1)+km(2)+qo(1)+qo(2))**1), abs ((qo(1)+qo(2))**1)
     end subroutine show_momenta
 
   end subroutine recoil_kinematics_1
 
 @ %def recoil_kinematics_1
 @
 \subsubsection{Recoil $Q$ distribution}
 Sample the $Q$ distribution for equidistant bins in the input variable.
 <<Recoil kinematics: execute tests>>=
   call test (recoil_kinematics_2, "recoil_kinematics_2", &
        "Q distribution", &
        u, results)
 <<Recoil kinematics: test declarations>>=
   public :: recoil_kinematics_2
 <<Recoil kinematics: tests>>=
   subroutine recoil_kinematics_2 (u)
     integer, intent(in) :: u
 
     real(default) :: sqrts
     real(default) :: q_max
     real(default) :: m
     real(default) :: x_bar
     real(default) :: r
     real(default) :: q2, q2_old
     integer :: i
     integer :: n_bin
     
     character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
     character(*), parameter :: FMT3 = "(2x,9(1x,F10.5))"
 
     write (u, "(A)")  "* Test output: recoil_kinematics_2"
     write (u, "(A)")  "*   Purpose: compute Q distribution"
     write (u, "(A)")
 
     n_bin = 20
 
     write (u, "(A)") "* No Q cutoff, xbar = 1"
     write (u, "(A)")
 
     sqrts = 100
     q_max = sqrts
     m = 0.511e-3_default
     x_bar = 1._default
     call show_table
 
     write (u, "(A)")
     write (u, "(A)") "* With Q cutoff, xbar = 1"
     write (u, "(A)")
 
     q_max = 10
     call show_table
 
     write (u, "(A)")
     write (u, "(A)") "* No Q cutoff, xbar = 0.01"
     write (u, "(A)")
 
     q_max = sqrts
     x_bar = 0.01_default
     call show_table
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: recoil_kinematics_2"
 
   contains
     
     subroutine show_table
       write (u, FMT1)  "sqrts =", sqrts
       write (u, FMT1)  "q_max =", q_max
       write (u, FMT1)  "m     =", m
       write (u, FMT1)  "x_bar =", x_bar
       write (u, "(A)")
       write (u, "(1x,A)")  "Table:  r         |Q|    |Q_i/Q_(i-1)|"
       q2_old = 0
       do i = 0, n_bin
          r = real (i, default) / n_bin
          call generate_q2_recoil (sqrts**2, x_bar, q_max**2, m**2, r, q2)
          if (q2_old > 0) then
             write (u, FMT3)  r, sqrt (q2), sqrt (q2 / q2_old)
          else
             write (u, FMT3)  r, sqrt (q2)
          end if
          q2_old = q2
       end do
     end subroutine show_table
     
   end subroutine recoil_kinematics_2
 
 @ %def recoil_kinematics_2
 @
 \subsubsection{Generate recoil event}
 Combine $Q^2$ sampling with momentum generation.
 <<Recoil kinematics: execute tests>>=
   call test (recoil_kinematics_3, "recoil_kinematics_3", &
        "generate recoil event", &
        u, results)
 <<Recoil kinematics: test declarations>>=
   public :: recoil_kinematics_3
 <<Recoil kinematics: tests>>=
   subroutine recoil_kinematics_3 (u)
     integer, intent(in) :: u
 
     real(default) :: sqrts
     real(default), dimension(2) :: q_max
     real(default), dimension(2) :: m
     real(default), dimension(2) :: xc, xcb
     real(default), dimension(4) :: r
     type(vector4_t), dimension(2) :: km
     type(vector4_t), dimension(2) :: qm
     type(vector4_t), dimension(2) :: qo
     logical :: ok
     
     character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
     character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"
 
     write (u, "(A)")  "* Test output: recoil_kinematics_3"
     write (u, "(A)")  "*   Purpose: generate momenta from RNG parameters"
     write (u, "(A)")
 
     write (u, "(A)") "*** collinear data set"
     write (u, "(A)")
 
     sqrts = 100
     q_max = sqrts
     m     = 0.511e-3_default
 
     xc = [0.6_default, 0.9_default]
     xcb = 1 - xc
 
     r = [0._default, 0._default, 0._default, 0._default]
 
     call show_data
     call generate_recoil (sqrts, q_max, m, xc, xcb, r, km, qm, qo, ok)
     call show_momenta
 
     write (u, "(A)")
     write (u, "(A)") "*** moderate data set"
     write (u, "(A)")
 
     xc = [0.6_default, 0.9_default]
     xcb = 1 - xc
 
     r = [0.8_default, 0.2_default, 0.1_default, 0.2_default]
 
     call show_data
     call generate_recoil (sqrts, q_max, m, xc, xcb, r, km, qm, qo, ok)
     call show_momenta
 
     write (u, "(A)")
     write (u, "(A)") "*** failing data set"
     write (u, "(A)")
 
     xc = [0.2_default, 0.4_default]
     xcb = 1 - xc
     
     r = [0.9999_default, 0.3_default, 0.1_default, 0.8_default]
 
     call show_data
     call generate_recoil (sqrts, q_max, m, xc, xcb, r, km, qm, qo, ok)
     if (.not. ok) then
        write (u, "(A)")
        write (u, "(A)") "Failed as expected."
     else
        call show_momenta
     end if
     
   contains
     
     subroutine show_data
       write (u, FMT1)  "sqrts =", sqrts
       write (u, FMT1)  "q_max =", q_max
       write (u, FMT1)  "m     =", m
       write (u, FMT1)  "xc    =", xc
       write (u, FMT1)  "xcb   =", xcb
       write (u, FMT1)  "r     =", r
     end subroutine show_data
     
     subroutine show_momenta
       real(default), parameter :: tol = 1.e-7_default
       call pacify (km, tol)
       call pacify (qo, tol)
       write (u, "(A)")
       write (u, "(A)") "* Momenta: k"
       call km(1)%write (u, testflag=.true.)
       call km(2)%write (u, testflag=.true.)
       write (u, FMT1) "k^2 =", abs (km(1)**2), abs (km(2)**2)
       write (u, "(A)")
       write (u, "(A)") "* Momenta: q(os)"
       call qo(1)%write (u, testflag=.true.)
       call qo(2)%write (u, testflag=.true.)
       write (u, FMT1) "q^2 =", abs (qo(1)**2), abs (qo(2)**2)
       write (u, "(A)")
       write (u, "(A)") "* Check: momentum transfer (off-shell/on-shell)"
       write (u, FMT2) "Q   =", q_check (1), q_check (2)
       write (u, FMT2) "|q| =", abs (qm(1)**1), abs (qm(2)**1)
       write (u, "(A)")
       write (u, "(A)") "* Check: sqrts, sqrts_hat"
       write (u, FMT1) "sqs =", sqrts, sqrt (product (xc)) * sqrts
       write (u, FMT1) "|po|=", abs ((km(1)+km(2)+qo(1)+qo(2))**1), abs ((qo(1)+qo(2))**1)
     end subroutine show_momenta
     
     function q_check (i) result (q)
       integer, intent(in) :: i
       real(default) :: q
       real(default) :: q2
       call generate_q2_recoil (sqrts**2, xcb(i), q_max(i)**2, m(i)**2, r(i), q2)
       q = sqrt (q2)
     end function q_check
 
   end subroutine recoil_kinematics_3
 
 @ %def recoil_kinematics_3
 @
 \subsubsection{Transformation after recoil}
 Given a solution to recoil kinematics, compute the Lorentz
 transformation that transforms the old collinear parton momenta into
 the new parton momenta.
 <<Recoil kinematics: execute tests>>=
   call test (recoil_kinematics_4, "recoil_kinematics_4", &
        "reference frame", &
        u, results)
 <<Recoil kinematics: test declarations>>=
   public :: recoil_kinematics_4
 <<Recoil kinematics: tests>>=
   subroutine recoil_kinematics_4 (u)
     integer, intent(in) :: u
 
     real(default) :: sqrts
     real(default), dimension(2) :: xc, xcb
     real(default), dimension(2) :: q
     real(default), dimension(2) :: phi
     real(default), dimension(2) :: cos_th, sin_th
     real(default), dimension(2) :: x
     real(default), dimension(2) :: xb
     type(vector4_t), dimension(2) :: km
     type(vector4_t), dimension(2) :: qm
     type(vector4_t), dimension(2) :: qo
     type(lorentz_transformation_t) :: lt
     logical :: ok
     
     character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
     character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"
 
     write (u, "(A)")  "* Test output: recoil_kinematics_4"
     write (u, "(A)")  "*   Purpose: check Lorentz transformation for recoil"
     write (u, "(A)")
 
     sqrts = 100
     write (u, FMT1)  "sqrts =", sqrts
     
 
     write (u, "(A)")
     write (u, "(A)") "*** collinear data set"
     write (u, "(A)")
 
     xc = [0.6_default, 0.9_default]
     xcb = 1 - xc
     phi = [0.1_default, 0.2_default] * twopi
     q = 0
 
     call show_data
     call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
     call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
     call recoil_transformation (sqrts, xc, qo, lt)
     call show_transformation
 
     write (u, "(A)")
     write (u, "(A)") "*** moderate data set"
     write (u, "(A)")
 
     xc = [0.6_default, 0.9_default]
     xcb = 1 - xc
     phi = [0.1_default, 0.2_default] * twopi
     q = [0.2_default, 0.05_default] * sqrts
 
     call show_data
     call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
     call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
     call recoil_transformation (sqrts, xc, qo, lt)
     call show_transformation
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: recoil_kinematics_4"
 
   contains
 
     subroutine show_data
       write (u, FMT1) "sqs_h =", sqrt (xc(1) * xc(2)) * sqrts
       write (u, FMT1) "xc    =", xc
       write (u, FMT1) "xcb   =", xcb
       write (u, FMT1) "Q     =", Q
       write (u, FMT1) "phi/D =", phi / degree
     end subroutine show_data
 
     subroutine show_transformation
       type(vector4_t), dimension(2) :: qc
       type(vector4_t), dimension(2) :: qct
       real(default), parameter :: tol = 1.e-7_default
       qc(1) = xc(1) * vector4_moving (sqrts/2, sqrts/2, 3)
       qc(2) = xc(2) * vector4_moving (sqrts/2,-sqrts/2, 3)
       qct = lt * qc
       call pacify (qct, tol)
       write (u, "(A)")
       write (u, "(A)") "Momenta: q(os)"
       call qo(1)%write (u, testflag=.true.)
       call qo(2)%write (u, testflag=.true.)
       write (u, "(A)")
       write (u, "(A)") "Momenta: LT * qc"
       call qct(1)%write (u, testflag=.true.)
       call qct(2)%write (u, testflag=.true.)
     end subroutine show_transformation
 
   end subroutine recoil_kinematics_4
 
 @ %def recoil_kinematics_4
 @
 \subsubsection{Transformation before recoil}
 Given a pair of incoming `beam' partons (i.e., before ISR splitting),
 compute the transformation that transforms their common c.m.\ frame
 into the lab frame.
 <<Recoil kinematics: execute tests>>=
   call test (recoil_kinematics_5, "recoil_kinematics_5", &
        "initial reference frame", &
        u, results)
 <<Recoil kinematics: test declarations>>=
   public :: recoil_kinematics_5
 <<Recoil kinematics: tests>>=
   subroutine recoil_kinematics_5 (u)
     integer, intent(in) :: u
 
     real(default) :: sqrts
     real(default) :: sqrtsi
     real(default), dimension(2) :: x
     type(vector4_t), dimension(2) :: p
     type(vector4_t), dimension(2) :: pi
     type(vector4_t), dimension(2) :: p0
     type(lorentz_transformation_t) :: lt
     logical :: ok
     
     character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
     character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"
 
     write (u, "(A)")  "* Test output: recoil_kinematics_5"
     write (u, "(A)")  "*   Purpose: determine initial Lorentz transformation"
     write (u, "(A)")
 
     sqrts = 100
     write (u, FMT1)  "sqrts =", sqrts
     
     x = [0.6_default, 0.9_default]
 
     p(1) = x(1) * vector4_moving (sqrts/2, sqrts/2, 3)
     p(2) = x(2) * vector4_moving (sqrts/2,-sqrts/2, 3)
 
     call show_data
     call initial_transformation (p, sqrtsi, lt, ok)
     
     pi(1) = vector4_moving (sqrtsi/2, sqrtsi/2, 3)
     pi(2) = vector4_moving (sqrtsi/2,-sqrtsi/2, 3)
 
     p0 = inverse (lt) * p
     
     call show_momenta
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: recoil_kinematics_5"
 
   contains
 
     subroutine show_data
       write (u, FMT1) "sqrts =", sqrts
       write (u, FMT1) "x     =", x
     end subroutine show_data
 
     
     subroutine show_momenta
       real(default), parameter :: tol = 1.e-7_default
       write (u, "(A)")
       write (u, "(A)") "* Momenta: p_in(c.m.)"
       call pi(1)%write (u, testflag=.true.)
       call pi(2)%write (u, testflag=.true.)
       write (u, "(A)")
       write (u, "(A)") "* Momenta: inv(LT) * p_in(lab)"
       call p0(1)%write (u, testflag=.true.)
       call p0(2)%write (u, testflag=.true.)
     end subroutine show_momenta
 
   end subroutine recoil_kinematics_5
 
 @ %def recoil_kinematics_5
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Transverse momentum for the ISR and EPA approximations}
 
 The ISR and EPA handler takes an event with a single radiated collinear
 particle (photon for ISR, beam particle for EPA) for each beam, respectively,
 and inserts transverse momentum for both.  The four-particle kinematics allows
 us to generate $Q^2$ and azimuthal angles independently, without violating
 energy-momentum conservation.  The $Q^2$ distribution is logarithmic, as
 required by the effective particle approximation, and reflected in the
 inclusive ISR/EPA structure functions.  We also conserve the invariant mass of
 the partonic systm after radiation.  The total transverse-momentum kick is
 applied in form of a Lorentz transformation to the elementary process, both
 in- and out-particles.  In fact, the incoming partons (beam particle for ISR,
 photon for EPA) which would be virtual space-like in the exact kinematics
 configuration, are replaced by on-shell incoming partons, such that energy,
 momentum, and invariant mass $\sqrt{\hat s}$ are conserved.
 
 Regarding kinematics, we treat all particles as massless.  The beam-particle
 mass only appears as the parameter [[isr_mass]] or [[epa_mass]], respectively,
 and cuts off the logarithmic distribution.  The upper cutoff is [[isr_q_max]]
 ([[epa_q_max]]), which defaults to the available energy $\sqrt{s}$.
 
 The only differences between ISR and EPA, in this context, are the particle
 types, and an extra $\bar x$ factor in the lower cutoff for EPA, see below.
 <<[[isr_epa_handler.f90]]>>=
 <<File header>>
 
 module isr_epa_handler
 
 <<Use kinds>>
 <<Use strings>>
   use diagnostics, only: msg_fatal
   use diagnostics, only: msg_bug
   use io_units
   use format_defs, only: FMT_12, FMT_19
   use format_utils, only: write_separator
   use format_utils, only: pac_fmt
   use physics_defs, only: PHOTON
   use lorentz, only: vector4_t
   use lorentz, only: energy
   use lorentz, only: lorentz_transformation_t
   use lorentz, only: identity
   use lorentz, only: inverse
   use lorentz, only: operator(*)
   use sm_qcd
   use flavors, only: flavor_t
   use particles, only: particle_t
   use model_data
   use models
   use rng_base, only: rng_t
   use event_transforms
   use recoil_kinematics, only: initial_transformation
   use recoil_kinematics, only: generate_recoil
   use recoil_kinematics, only: recoil_transformation
 
 <<Standard module head>>
 
 <<ISR/EPA handler: public>>
 
 <<ISR/EPA handler: parameters>>
 
 <<ISR/EPA handler: types>>
 
 contains
 
 <<ISR/EPA handler: procedures>>
 
 end module isr_epa_handler
 @ %def isr_epa_handler
 @
 \subsection{Event transform type}
 Convention: [[beam]] are the incoming partons before ISR -- not
 necessarily the actual beams, need not be in c.m.\ frame.  [[radiated]]
 are the radiated particles (photon for ISR), and [[parton]] are the
 remainders which 
 initiate the elementary process.  These particles are copied verbatim
 from the event record, and must be collinear.
 
 The kinematical parameters are [[sqrts]] = invariant mass of the
 [[beam]] particles, [[q_max]] and [[m]] determining the $Q^2$
 distribution, and [[xc]]/[[xcb]] as the energy fraction (complement)
 of the partons, relative to the beams.
 
 Transformations: [[lti]] is the Lorentz transformation that would
 boosts [[pi]] (c.m. frame) back to the original [[beam]] momenta (lab
 frame).  [[lto]] is the recoil transformation, transforming the partons
 after ISR from the collinear frame to the recoiling frame.  [[lt]] is
 the combination of both, which is to be applied to all particles after
 the hard interaction.
 
 Momenta: [[pi]] are the beams transformed to their common c.m.\ frame.
 [[ki]] and [[qi]] are the photon/parton
 momenta in the [[pi]] c.m.\ frame.  [[km]] and [[qm]] are the
 photon/parton momenta with the $Q$ distribution applied, and finally
 [[qo]] are the partons [[qm]] projected on-shell.
 <<ISR/EPA handler: public>>=
   public :: evt_isr_epa_t
 <<ISR/EPA handler: types>>=
   type, extends (evt_t) :: evt_isr_epa_t
      private
      integer :: mode = ISR_TRIVIAL_COLLINEAR
      logical :: isr_active = .false.
      logical :: epa_active = .false.
      real(default) :: isr_q_max = 0
      real(default) :: epa_q_max = 0
      real(default) :: isr_mass = 0
      real(default) :: epa_mass = 0
      real(default) :: sqrts = 0
      integer, dimension(2) :: rad_mode = BEAM_RAD_NONE
      real(default), dimension(2) :: q_max = 0
      real(default), dimension(2) :: m = 0
      real(default), dimension(2) :: xc = 0
      real(default), dimension(2) :: xcb = 0
      type(lorentz_transformation_t) :: lti = identity
      type(lorentz_transformation_t) :: lto = identity
      type(lorentz_transformation_t) :: lt  = identity
      integer, dimension(2) :: i_beam = 0
      type(particle_t), dimension(2) :: beam
      type(vector4_t), dimension(2) :: pi
      integer, dimension(2) :: i_radiated = 0
      type(particle_t), dimension(2) :: radiated
      type(vector4_t), dimension(2) :: ki
      type(vector4_t), dimension(2) :: km
      integer, dimension(2) :: i_parton = 0
      type(particle_t), dimension(2) :: parton
      type(vector4_t), dimension(2) :: qi
      type(vector4_t), dimension(2) :: qm
      type(vector4_t), dimension(2) :: qo
    contains
    <<ISR/EPA handler: evt isr: TBP>>
   end type evt_isr_epa_t
 
 @ %def evt_isr_epa_t
 @
 \subsection{ISR/EPA distinction}
 <<ISR/EPA handler: parameters>>=
   integer, parameter, public :: BEAM_RAD_NONE = 0
   integer, parameter, public :: BEAM_RAD_ISR = 1
   integer, parameter, public :: BEAM_RAD_EPA = 2
   
 @ %def BEAM_RAD_NONE
 @ %def BEAM_RAD_ISR
 @ %def BEAM_RAD_EPA
 <<ISR/EPA handler: procedures>>=
   function rad_mode_string (mode) result (string)
     type(string_t) :: string
     integer, intent(in) :: mode
     select case (mode)
     case (BEAM_RAD_NONE);  string = "---"
     case (BEAM_RAD_ISR);   string = "ISR"
     case (BEAM_RAD_EPA);   string = "EPA"
     case default;  string = "???"
     end select
   end function rad_mode_string
   
 @ %def rad_mode_string
 @
 \subsection{Photon insertion modes}
 <<ISR/EPA handler: parameters>>=
   integer, parameter, public :: ISR_TRIVIAL_COLLINEAR = 0
   integer, parameter, public :: ISR_PAIR_RECOIL = 1
   
 @ %def ISR_TRIVIAL_COLLINEAR ISR_PAIR_RECOIL
 @
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: get_mode_string => evt_isr_epa_get_mode_string
 <<ISR/EPA handler: procedures>>=
   function evt_isr_epa_get_mode_string (evt) result (string)
     type(string_t) :: string
     class(evt_isr_epa_t), intent(in) :: evt
     select case (evt%mode)
     case (ISR_TRIVIAL_COLLINEAR)
        string = "trivial, collinear"
     case (ISR_PAIR_RECOIL)
        string = "pair recoil"
     case default
        string = "[undefined]"
     end select
   end function evt_isr_epa_get_mode_string
 
 @ %def evt_isr_epa_get_mode_string
 @ Set the numerical mode ID from a user-level string representation.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: set_mode_string => evt_isr_epa_set_mode_string
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_set_mode_string (evt, string)
     class(evt_isr_epa_t), intent(inout) :: evt
     type(string_t), intent(in) :: string
     select case (char (string))
     case ("trivial")
        evt%mode = ISR_TRIVIAL_COLLINEAR
     case ("recoil")
        evt%mode = ISR_PAIR_RECOIL
     case default
        call msg_fatal ("ISR handler: mode '" // char (string) &
             // "' is undefined")
     end select
   end subroutine evt_isr_epa_set_mode_string
 
 @ %def evt_isr_epa_set_mode_string
 @ 
 \subsection{Output}
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: write_name => evt_isr_epa_write_name
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_write_name (evt, unit)
     class(evt_isr_epa_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event transform: ISR/EPA handler"
   end subroutine evt_isr_epa_write_name
 
 @ %def evt_isr_epa_write_name
 @ The overall recoil-handling mode.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: write_mode => evt_isr_epa_write_mode
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_write_mode (evt, unit)
     class(evt_isr_epa_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A,1x,I0,':',1x,A)")  "Insertion mode =", evt%mode, &
          char (evt%get_mode_string ())
   end subroutine evt_isr_epa_write_mode
   
 @ %def evt_isr_epa_write_mode
 @ The input data for ISR and EPA, respectively.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: write_input => evt_isr_epa_write_input
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_write_input (evt, unit, testflag)
     class(evt_isr_epa_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     character(len=7) :: fmt
     integer :: u
     u = given_output_unit (unit)
     call pac_fmt (fmt, FMT_19, FMT_12, testflag)
     if (evt%isr_active) then
        write (u, "(3x,A,1x," // fmt // ")") "ISR: Q_max =", evt%isr_q_max
        write (u, "(3x,A,1x," // fmt // ")") "     m     =", evt%isr_mass
     else
        write (u, "(3x,A)") "ISR: [inactive]"
     end if
     if (evt%epa_active) then
        write (u, "(3x,A,1x," // fmt // ")") "EPA: Q_max =", evt%epa_q_max
        write (u, "(3x,A,1x," // fmt // ")") "     m     =", evt%epa_mass
     else
        write (u, "(3x,A)") "EPA: [inactive]"
     end if
   end subroutine evt_isr_epa_write_input
 
 @ %def evt_isr_epa_write_input
 @ The trivial mode does not depend on any data, since it does nothing
 to the event.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: write_data => evt_isr_epa_write_data
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_write_data (evt, unit, testflag)
     class(evt_isr_epa_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     character(len=7), parameter :: FMTL_19 = "A3,16x"
     character(len=7), parameter :: FMTL_12 = "A3,9x"
     character(len=7) :: fmt, fmtl
     integer :: u
     u = given_output_unit (unit)
     call pac_fmt (fmt, FMT_19, FMT_12, testflag)
     call pac_fmt (fmtl, FMTL_19, FMTL_12, testflag)
     select case (evt%mode)
     case (ISR_PAIR_RECOIL)
        write (u, "(1x,A)")  "Event:"
        write (u, "(3x,A,2(1x," // fmtl // "))") &
             "mode  = ", &
             char (rad_mode_string (evt%rad_mode(1))), &
             char (rad_mode_string (evt%rad_mode(2)))
        write (u, "(3x,A,2(1x," // fmt // "))") "Q_max =", evt%q_max
        write (u, "(3x,A,2(1x," // fmt // "))") "m     =", evt%m
        write (u, "(3x,A,2(1x," // fmt // "))") "x     =", evt%xc
        write (u, "(3x,A,2(1x," // fmt // "))") "xb    =", evt%xcb
        write (u, "(3x,A,1x," // fmt // ")")    "sqrts =", evt%sqrts
        call write_separator (u)
        write (u, "(A)")  "Lorentz boost (partons before radiation &
             &c.m. -> lab) ="
        call evt%lti%write (u, testflag)
        write (u, "(A)")  "Lorentz transformation (collinear partons &
             &-> partons with recoil in c.m.) ="
        call evt%lto%write (u, testflag)
        write (u, "(A)")  "Combined transformation (partons &
             &-> partons with recoil in lab frame) ="
        call evt%lt%write (u, testflag)
     end select
   end subroutine evt_isr_epa_write_data
 
 @ %def evt_isr_epa_write_data
 @ Output method.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: write => evt_isr_epa_write
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_write (evt, unit, verbose, more_verbose, testflag)
     class(evt_isr_epa_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose, more_verbose, testflag
     logical :: show_mass
     integer :: u, i
     u = given_output_unit (unit)
     if (present (testflag)) then
        show_mass = .not. testflag
     else
        show_mass = .true.
     end if
     call write_separator (u, 2)
     call evt%write_name (u)
     call write_separator (u, 2)
     call evt%write_mode (u)
     call evt%write_input (u, testflag=testflag)
     call evt%write_data (u, testflag=testflag)
     call write_separator (u)
     call evt%base_write (u, testflag = testflag, show_set = .false.)
     if (all (evt%i_beam > 0)) then
        call write_separator (u)
        write (u, "(A,2(1x,I0))")  "Partons before radiation:", evt%i_beam
        do i = 1, 2
           call evt%beam(i)%write (u, testflag=testflag)
        end do
        call write_separator (u)
        write (u, "(A)")  "... boosted to c.m.:"
        do i = 1, 2
           call evt%pi(i)%write (u, show_mass=show_mass, testflag=testflag)
        end do
     end if
     if (all (evt%i_radiated > 0)) then
        call write_separator (u)
        write (u, "(A,2(1x,I0))")  "Radiated particles, collinear:", &
             evt%i_radiated
        do i = 1, 2
           call evt%radiated(i)%write (u, testflag=testflag)
        end do
        call write_separator (u)
        write (u, "(A)")  "... boosted to c.m.:"
        do i = 1, 2
           call evt%ki(i)%write (u, show_mass=show_mass, testflag=testflag)
        end do
        call write_separator (u)
        write (u, "(A)")  "... with kT:"
        do i = 1, 2
           call evt%km(i)%write (u, show_mass=show_mass, testflag=testflag)
        end do
     end if
     if (all (evt%i_parton > 0)) then
        call write_separator (u)
        write (u, "(A,2(1x,I0))")  "Partons after radiation, collinear:", &
             evt%i_parton
        do i = 1, 2
           call evt%parton(i)%write (u, testflag=testflag)
        end do
        call write_separator (u)
        write (u, "(A)")  "... boosted to c.m.:"
        do i = 1, 2
           call evt%qi(i)%write (u, show_mass=show_mass, testflag=testflag)
        end do
        call write_separator (u)
        write (u, "(A)")  "... with qT, off-shell:"
        do i = 1, 2
           call evt%qm(i)%write (u, show_mass=show_mass, testflag=testflag)
        end do
        call write_separator (u)
        write (u, "(A)")  "... projected on-shell:"
        do i = 1, 2
           call evt%qo(i)%write (u, show_mass=show_mass, testflag=testflag)
        end do
        call write_separator (u)
     end if
     if (evt%particle_set_exists)  &
          call evt%particle_set%write &
          (u, summary = .true., compressed = .true., testflag = testflag)
     call write_separator (u)
   end subroutine evt_isr_epa_write
 
 @ %def evt_isr_epa_write
 @
 \subsection{Initialization}
 Manually import a random-number generator object.  This should be
 done only for testing purposes.  The standard procedure is to
 [[connect]] a process to an event transform; this will create an
 appropriate [[rng]] from the RNG factory in the process object.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: import_rng => evt_isr_epa_import_rng
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_import_rng (evt, rng)
     class(evt_isr_epa_t), intent(inout) :: evt
     class(rng_t), allocatable, intent(inout) :: rng
     call move_alloc (from = rng, to = evt%rng)
   end subroutine evt_isr_epa_import_rng
 
 @ %def evt_isr_epa_import_rng
 @ Set constant kinematics limits and initialize for ISR.  Note that [[sqrts]]
 is used only as the fallback value for [[q_max]].  The actual [[sqrts]] value
 for the transform object is inferred from the incoming particles, event by
 event.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: set_data_isr => evt_isr_epa_set_data_isr
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_set_data_isr (evt, sqrts, q_max, m)
     class(evt_isr_epa_t), intent(inout) :: evt
     real(default), intent(in) :: sqrts
     real(default), intent(in) :: q_max
     real(default), intent(in) :: m
     if (sqrts <= 0) then
        call msg_fatal ("ISR handler: sqrts value must be positive")
     end if
     if (q_max <= 0 .or. q_max > sqrts) then
        evt%isr_q_max = sqrts
     else
        evt%isr_q_max = q_max
     end if
     if (m > 0) then
        evt%isr_mass = m
     else
        call msg_fatal ("ISR handler: ISR_mass value must be positive")
     end if
     evt%isr_active = .true.
   end subroutine evt_isr_epa_set_data_isr
     
 @ %def evt_isr_epa_set_data_isr
 @ Set constant kinematics limits and initialize for EPA.  Note that [[sqrts]] is
 used only as the fallback value for [[q_max]].  The actual [[sqrts]]
 value for the transform object is inferred from the incoming
 particles, event by event.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: set_data_epa => evt_isr_epa_set_data_epa
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_set_data_epa (evt, sqrts, q_max, m)
     class(evt_isr_epa_t), intent(inout) :: evt
     real(default), intent(in) :: sqrts
     real(default), intent(in) :: q_max
     real(default), intent(in) :: m
     if (sqrts <= 0) then
        call msg_fatal ("EPA handler: sqrts value must be positive")
     end if
     if (q_max <= 0 .or. q_max > sqrts) then
        evt%epa_q_max = sqrts
     else
        evt%epa_q_max = q_max
     end if
     if (m > 0) then
        evt%epa_mass = m
     else
        call msg_fatal ("EPA handler: EPA_mass value must be positive")
     end if
     evt%epa_active = .true.
   end subroutine evt_isr_epa_set_data_epa
     
 @ %def evt_isr_epa_set_data_epa
 @
 \subsection{Fetch event data}
 Identify the radiated particles and the recoil momenta in the
 particle set.  Without much sophistication, start from the end and
 find particles with the ``remnant'' status.  Their parents should point to
 the recoiling parton.  If successful, set the particle indices in the
 [[evt]] object, for further processing.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure, private :: identify_radiated
 <<ISR/EPA handler: procedures>>=
   subroutine identify_radiated (evt)
     class(evt_isr_epa_t), intent(inout) :: evt
     integer :: i, k
     k = 2
     FIND_LAST_RADIATED: do i = evt%particle_set%get_n_tot (), 1, -1
        associate (prt => evt%particle_set%prt(i))
          if (prt%is_beam_remnant ()) then
             evt%i_radiated(k) = i
             evt%radiated(k) = prt
             k = k - 1
             if (k == 0)  exit FIND_LAST_RADIATED
          end if
        end associate
     end do FIND_LAST_RADIATED
     if (k /= 0)  call err_count
   contains
     subroutine err_count
       call evt%particle_set%write ()
       call msg_fatal ("ISR/EPA handler: &
            &event does not contain two radiated particles")
     end subroutine err_count
   end subroutine identify_radiated
   
 @ %def identify_radiated
 @ When the radiated particles are known, we can fetch their parent
 particles and ask for the other child, the incoming parton.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure, private :: identify_partons
 <<ISR/EPA handler: procedures>>=
   subroutine identify_partons (evt)
     class(evt_isr_epa_t), intent(inout) :: evt
     integer, dimension(:), allocatable :: parent, child
     integer :: i, j
     if (all (evt%i_radiated > 0)) then
        do i = 1, 2
           parent = evt%radiated(i)%get_parents ()
           if (size (parent) /= 1)  call err_mismatch
           evt%i_beam(i) = parent(1)
           evt%beam(i) = evt%particle_set%prt(parent(1))
           associate (prt => evt%beam(i))
             child = prt%get_children ()
             if (size (child) /= 2)  call err_mismatch
             do j = 1, 2
                if (child(j) /= evt%i_radiated(i)) then
                   evt%i_parton(i) = child(j)
                   evt%parton(i) = evt%particle_set%prt(child(j))
                end if
             end do
           end associate
        end do
     end if
   contains
     subroutine err_mismatch
       call evt%particle_set%write ()
       call msg_bug ("ISR/EPA handler: mismatch in parent-child relations")
     end subroutine err_mismatch
   end subroutine identify_partons
   
 @ %def identify_partons
 @ Check whether the radiated particle is a photon, or the incoming
 parton is a photon.  Then set the ISR/EPA switch appropriately, for
 each beam.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: check_radiation => evt_isr_epa_check_radiation
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_check_radiation (evt)
     class(evt_isr_epa_t), intent(inout) :: evt
     type(flavor_t) :: flv
     integer :: i
     do i = 1, 2
        flv = evt%radiated(i)%get_flv ()
        if (flv%get_pdg () == PHOTON) then
           if (evt%isr_active) then
              evt%rad_mode(i) = BEAM_RAD_ISR
           else
              call err_isr_init
           end if
        else
           flv = evt%parton(i)%get_flv ()
           if (flv%get_pdg () == PHOTON) then
              if (evt%epa_active) then
                 evt%rad_mode(i) = BEAM_RAD_EPA
              else
                 call err_epa_init
              end if
           else
              call err_no_photon
           end if
        end if
     end do
   contains
     subroutine err_isr_init
       call evt%particle_set%write ()
       call msg_fatal ("ISR/EPA handler: &
            &event contains radiated photon, but ISR is not initialized")
     end subroutine err_isr_init
     subroutine err_epa_init
       call evt%particle_set%write ()
       call msg_fatal ("ISR/EPA handler: &
            &event contains incoming photon, but EPA is not initialized")
     end subroutine err_epa_init
     subroutine err_no_photon
       call evt%particle_set%write ()
       call msg_fatal ("ISR/EPA handler: &
            &event does not appear to be ISR or EPA - missing photon")
     end subroutine err_no_photon
   end subroutine evt_isr_epa_check_radiation
   
 @ %def evt_isr_epa_check_radiation
 @ Internally set the appropriate parameters (ISR/EPA) for the two
 beams in the recoil mode.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: set_recoil_parameters => evt_isr_epa_set_recoil_parameters
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_set_recoil_parameters (evt)
     class(evt_isr_epa_t), intent(inout) :: evt
     integer :: i
     do i = 1, 2
        select case (evt%rad_mode(i))
        case (BEAM_RAD_ISR)
           evt%q_max(i) = evt%isr_q_max
           evt%m(i) = evt%isr_mass
        case (BEAM_RAD_EPA)
           evt%q_max(i) = evt%epa_q_max
           evt%m(i) = evt%epa_mass
        end select
     end do
   end subroutine evt_isr_epa_set_recoil_parameters
 
 @ %def evt_isr_epa_set_recoil_parameters
 @ Boost the particles that participate in ISR to their proper
 c.m.\ frame, copying the momenta to [[pi]], [[ki]], [[qi]].  Also
 assign [[sqrts]] properly.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure, private :: boost_to_cm
 <<ISR/EPA handler: procedures>>=
   subroutine boost_to_cm (evt)
     class(evt_isr_epa_t), intent(inout) :: evt
     type(vector4_t), dimension(2) :: p
     type(vector4_t), dimension(2) :: k
     type(vector4_t), dimension(2) :: q
     logical :: ok
     p = evt%beam%get_momentum ()
     k = evt%radiated%get_momentum ()
     q = evt%parton%get_momentum ()
     call initial_transformation (p, evt%sqrts, evt%lti, ok)
     if (.not. ok)  call err_non_collinear
     evt%pi = inverse (evt%lti) * p
     evt%ki = inverse (evt%lti) * k
     evt%qi = inverse (evt%lti) * q
   contains
     subroutine err_non_collinear
       call evt%particle_set%write ()
       call msg_fatal ("ISR/EPA handler: &
            &partons before radiation are not collinear")
     end subroutine err_non_collinear
   end subroutine boost_to_cm
 
 @ %def boost_to_cm    
 @ We can infer the $x$ and $\bar x$ values of the event by looking at
 the energy fractions of the radiated particles and incoming partons,
 respectively, relative to their 
 parents.  Of course, we must assume that they are all collinear, and
 that energy is conserved.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure, private :: infer_x
 <<ISR/EPA handler: procedures>>=
   subroutine infer_x (evt)
     class(evt_isr_epa_t), intent(inout) :: evt
     real(default) :: E_parent, E_radiated, E_parton
     integer :: i
     if (all (evt%i_radiated > 0)) then
        do i = 1, 2
           E_parent = energy (evt%pi(i))
           E_radiated = energy (evt%ki(i))
           E_parton = energy (evt%qi(i))
           if (E_parent > 0) then
              evt%xc(i) = E_parton / E_parent
              evt%xcb(i)= E_radiated / E_parent
           else
              call err_energy
           end if
        end do
     end if
   contains
     subroutine err_energy
       call evt%particle_set%write ()
       call msg_bug ("ISR/EPA handler: non-positive energy in splitting")
     end subroutine err_energy
   end subroutine infer_x
   
 @ %def infer_x
 @
 \subsection{Two-parton recoil}
 For transforming partons into recoil momenta, we make use of the
 routines in the [[recoil_kinematics]] module.  In addition to the
 collinear momenta, we use the $x$ energy fractions, and four numbers
 from the RNG.
 
 There is one subtle difference w.r.t.\ ISR case: the EPA mass
 parameter is multiplied by the energy fraction $x$, separately for
 each beam.  This is the effective lower $Q$ cutoff.
 
 For certain kinematics, close to the $Q_\text{max}$ endpoint, this may
 fail, and [[ok]] is set to false.  In that case, we should generate
 new recoil momenta for the same event.  This is handled by the generic
 unweighting procedure.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure, private :: generate_recoil => evt_generate_recoil
 <<ISR/EPA handler: procedures>>=
   subroutine evt_generate_recoil (evt, ok)
     class(evt_isr_epa_t), intent(inout) :: evt
     logical, intent(out) :: ok
     real(default), dimension(4) :: r
     real(default), dimension(2) :: m
     integer :: i
     call evt%rng%generate (r)
     do i = 1, 2
        select case (evt%rad_mode(i))
        case (BEAM_RAD_ISR);  m(i) = evt%m(i)
        case (BEAM_RAD_EPA);  m(i) = evt%xc(i) * evt%m(i)
        case default;         m(i) = 0
        end select
     end do
     call generate_recoil (evt%sqrts, evt%q_max, m, evt%xc, evt%xcb, r, &
          evt%km, evt%qm, evt%qo, ok)
   end subroutine evt_generate_recoil
 
 @ %def evt_generate_recoil
 @ Replace the collinear radiated (incoming) parton momenta by the
 momenta that we 
 have generated, respectively.  Recall that the recoil has been applied
 in the c.m.\ system of the partons before ISR, so we apply the stored
 Lorentz transformation to boost them to the lab frame.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure, private :: replace_radiated
   procedure, private :: replace_partons
 <<ISR/EPA handler: procedures>>=
   subroutine replace_radiated (evt)
     class(evt_isr_epa_t), intent(inout) :: evt
     integer :: i
     do i = 1, 2
        associate (prt => evt%particle_set%prt(evt%i_radiated(i)))
          call prt%set_momentum (evt%lti * evt%km(i))
        end associate
     end do
   end subroutine replace_radiated
 
   subroutine replace_partons (evt)
     class(evt_isr_epa_t), intent(inout) :: evt
     integer :: i
     do i = 1, 2
        associate (prt => evt%particle_set%prt(evt%i_parton(i)))
          call prt%set_momentum (evt%lti * evt%qo(i))
        end associate
     end do
   end subroutine replace_partons
 
 @ %def replace_radiated
 @ %def replace_partons
 @
 \subsection{Transform the event}
 Knowing the new incoming partons for the elementary process, we can
 make use of another procedure in [[recoil_kinematics]] to determine
 the Lorentz transformation that transforms the collinear frame into
 the frame with transverse momentum.  We apply this transformation,
 recursively, to all particles that originate from those incoming
 partons in the original particle set.
 
 We have to allow for the pre-ISR partons being not in their common
 c.m.\ frame.  Taking into account non-commutativity, we actually have
 to first transform the outgoing particles to that c.m.\ frame, then
 apply the recoil transformation, then boost back to the lab frame.
 
 The [[mask]] keep track of particles that we transform, just in case
 the parent-child tree is multiply connected.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: transform_outgoing => evt_transform_outgoing
 <<ISR/EPA handler: procedures>>=
   subroutine evt_transform_outgoing (evt)
     class(evt_isr_epa_t), intent(inout) :: evt
     logical, dimension(:), allocatable :: mask
     call recoil_transformation (evt%sqrts, evt%xc, evt%qo, evt%lto)
     evt%lt = evt%lti * evt%lto * inverse (evt%lti)
     allocate (mask (evt%particle_set%get_n_tot ()), source=.false.)
     call transform_children (evt%i_parton(1))
   contains
     recursive subroutine transform_children (i)
       integer, intent(in) :: i
       integer :: j, n_child, c
       integer, dimension(:), allocatable :: child
       child = evt%particle_set%prt(i)%get_children ()
       do j = 1, size (child)
          c = child(j)
          if (.not. mask(c)) then
             associate (prt => evt%particle_set%prt(c))
               call prt%set_momentum (evt%lt * prt%get_momentum ())
               mask(c) = .true.
               call transform_children (c)
             end associate
          end if
       end do
     end subroutine transform_children
   end subroutine evt_transform_outgoing
   
 @ %def evt_transform_outgoing
 @
 \subsection{Implemented methods}
 Here we take the particle set from the previous event transform and
 copy it, then generate the transverse momentum for the radiated
 particles and for 
 the incoming partons.  If this fails (rarely, for large $p_T$),
 return zero for the probability, to trigger another try.
 
 NOTE: The boost for the initial partonic system, if not in the
 c.m.\ frame, has not been implemented yet.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: generate_weighted => &
        evt_isr_epa_generate_weighted
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_generate_weighted (evt, probability)
     class(evt_isr_epa_t), intent(inout) :: evt
     real(default), intent(inout) :: probability
     logical :: valid
     call evt%particle_set%final ()
     evt%particle_set = evt%previous%particle_set
     evt%particle_set_exists = .true.
     select case (evt%mode)
     case (ISR_TRIVIAL_COLLINEAR)
        probability = 1
        valid = .true.
     case (ISR_PAIR_RECOIL)
        call evt%identify_radiated ()
        call evt%identify_partons ()
        call evt%check_radiation ()
        call evt%set_recoil_parameters ()
        call evt%boost_to_cm ()
        call evt%infer_x ()
        call evt%generate_recoil (valid)
        if (valid) then
           probability = 1
        else
           probability = 0
        end if
     case default
        call msg_bug ("ISR/EPA handler: generate weighted: unsupported mode")
     end select
     evt%particle_set_exists = .false.
   end subroutine evt_isr_epa_generate_weighted
 
 @ %def evt_isr_epa_generate_weighted
 @ Insert the generated radiated particles and incoming partons with
 $p_T$ in their respective places.
 
 The factorization parameters are irrelevant.
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: make_particle_set => &
        evt_isr_epa_make_particle_set
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_make_particle_set &
        (evt, factorization_mode, keep_correlations, r)
     class(evt_isr_epa_t), intent(inout) :: evt
     integer, intent(in) :: factorization_mode
     logical, intent(in) :: keep_correlations
     real(default), dimension(:), intent(in), optional :: r
     select case (evt%mode)
     case (ISR_TRIVIAL_COLLINEAR)
     case (ISR_PAIR_RECOIL)
        call evt%replace_radiated ()
        call evt%replace_partons ()
        call evt%transform_outgoing ()
     case default
        call msg_bug ("ISR/EPA handler: make particle set: unsupported mode")
     end select
     evt%particle_set_exists = .true.
   end subroutine evt_isr_epa_make_particle_set
 
 @ %def event_isr_epa_handler_make_particle_set
 @
 <<ISR/EPA handler: evt isr: TBP>>=
   procedure :: prepare_new_event => &
        evt_isr_epa_prepare_new_event
 <<ISR/EPA handler: procedures>>=
   subroutine evt_isr_epa_prepare_new_event (evt, i_mci, i_term)
     class(evt_isr_epa_t), intent(inout) :: evt
     integer, intent(in) :: i_mci, i_term
     call evt%reset ()
   end subroutine evt_isr_epa_prepare_new_event
 
 @ %def evt_isr_epa_prepare_new_event
 @
 \subsection{Unit tests: ISR}
 Test module, followed by the corresponding implementation module.
 
 This test module differs from most of the other test modules, since it
 contains two test subroutines: one for ISR and one for EPA below.
 <<[[isr_epa_handler_ut.f90]]>>=
 <<File header>>
 
 module isr_epa_handler_ut
   use unit_tests
   use isr_epa_handler_uti
 
 <<Standard module head>>
 
 <<ISR/EPA handler: public test>>
 
 contains
 
 <<ISR/EPA handler: test driver>>
 
 end module isr_epa_handler_ut
 @ %def isr_epa_handler_ut
 @
 <<[[isr_epa_handler_uti.f90]]>>=
 <<File header>>
 
 module isr_epa_handler_uti
 
 <<Use kinds>>
 <<Use strings>>
   use format_utils, only: write_separator
   use os_interface
   use lorentz, only: vector4_t, vector4_moving, operator(*)
   use rng_base, only: rng_t
   use models, only: syntax_model_file_init, syntax_model_file_final
   use models, only: model_list_t, model_t
   use particles, only: particle_set_t
 
   use event_transforms
   use isr_epa_handler, only: evt_isr_epa_t
 
   use rng_base_ut, only: rng_test_t
 
 <<Standard module head>>
 
 <<ISR/EPA handler: test declarations>>
 
 contains
 
 <<ISR/EPA handler: tests>>
 
 end module isr_epa_handler_uti
 
 @ %def isr_epa_handler_uti
 @ API: driver for the unit tests below.
 <<ISR/EPA handler: public test>>=
   public :: isr_handler_test
 <<ISR/EPA handler: test driver>>=
   subroutine isr_handler_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<ISR/EPA handler: execute ISR tests>>
   end subroutine isr_handler_test
 
 @ %def isr_handler_test
 @
 \subsubsection{Trivial case}
 Handle photons resulting from ISR radiation.  This test is for the
 trivial case where the event is kept collinear.
 <<ISR/EPA handler: execute ISR tests>>=
   call test (isr_handler_1, "isr_handler_1", &
        "collinear case, no modification", &
        u, results)
 <<ISR/EPA handler: test declarations>>=
   public :: isr_handler_1
 <<ISR/EPA handler: tests>>=
   subroutine isr_handler_1 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(particle_set_t) :: pset
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(evt_trivial_t), target :: evt_trivial
     type(evt_isr_epa_t), target :: evt_isr_epa
     type(vector4_t), dimension(8) :: p
     real(default) :: sqrts
     real(default), dimension(2) :: x, xb
     real(default) :: probability
 
     write (u, "(A)")  "* Test output: isr_handler_1"
     write (u, "(A)")  "*   Purpose: apply photon handler trivially (no-op)"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
          pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)
 
     sqrts = 100._default
     x = [0.6_default, 0.9_default]
     xb= 1 - x
 
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     p(3:4) = x * p(1:2)
     p(5:6) = xb  * p(1:2)
     p(7:8) = p(3:4)
 
     call pset%set_momentum (p, on_shell = .false.)
     
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize ISR handler transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_isr_epa
     evt_isr_epa%previous => evt_trivial
     
     call evt_isr_epa%write (u)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill ISR handler transform"
     write (u, "(A)")
     
     call evt_isr_epa%prepare_new_event (1, 1)
     call evt_isr_epa%generate_weighted (probability)
     call evt_isr_epa%make_particle_set (0, .false.)
     
     call evt_isr_epa%write (u)
     
     write (u, "(A)")
     write (u, "(A,1x,F8.5)")  "Event probability =", probability
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_isr_epa%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: isr_handler_1"
 
   end subroutine isr_handler_1
 
 @ %def isr_handler_1
 @
 \subsubsection{Photon pair with recoil}
 Handle photons resulting from ISR radiation.  This test invokes the
 two-photon recoil mechanism.  Both photons acquire transverse
 momentum, the parton momenta recoil, such that total energy-momentum
 is conserved, and all outgoing photons and partons are on-shell
 (massless).
 <<ISR/EPA handler: execute ISR tests>>=
   call test (isr_handler_2, "isr_handler_2", &
        "two-photon recoil", &
        u, results)
 <<ISR/EPA handler: test declarations>>=
   public :: isr_handler_2
 <<ISR/EPA handler: tests>>=
   subroutine isr_handler_2 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(particle_set_t) :: pset
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(evt_trivial_t), target :: evt_trivial
     type(evt_isr_epa_t), target :: evt_isr_epa
     type(vector4_t), dimension(8) :: p
     real(default) :: sqrts
     real(default), dimension(2) :: x, xb
     class(rng_t), allocatable :: rng
     real(default) :: probability
 
     write (u, "(A)")  "* Test output: isr_handler_2"
     write (u, "(A)")  "*   Purpose: apply photon handler with two-photon recoil"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
          pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)
 
     sqrts = 100._default
     x = [0.6_default, 0.9_default]
     xb= 1 - x
 
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     p(3:4) = x * p(1:2)
     p(5:6) = xb  * p(1:2)
     p(7:8) = p(3:4)
 
     call pset%set_momentum (p, on_shell = .false.)
     
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize ISR handler transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_isr_epa
     evt_isr_epa%previous => evt_trivial
     
     call evt_isr_epa%set_mode_string (var_str ("recoil"))
     call evt_isr_epa%set_data_isr ( &
          sqrts = sqrts, &
          q_max = sqrts, &
          m = 511.e-3_default &
          )
 
     allocate (rng_test_t :: rng)
     call rng%init (3)  ! default would produce pi for azimuthal angle
     call evt_isr_epa%import_rng (rng)
 
     call evt_isr_epa%write (u, testflag=.true.)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill ISR handler transform"
     write (u, "(A)")
     
     call evt_isr_epa%prepare_new_event (1, 1)
     call evt_isr_epa%generate_weighted (probability)
     call evt_isr_epa%make_particle_set (0, .false.)
     
     call evt_isr_epa%write (u, testflag=.true.)
     
     write (u, "(A)")
     write (u, "(A,1x,F8.5)")  "Event probability =", probability
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_isr_epa%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: isr_handler_2"
 
   end subroutine isr_handler_2
 
 @ %def isr_handler_2
 @
 \subsubsection{Boosted beams}
 Handle photons resulting from ISR radiation.  This test invokes the
 two-photon recoil mechanism, in the case that the partons before ISR
 are not in their c.m.\ frame (but collinear).
 <<ISR/EPA handler: execute ISR tests>>=
   call test (isr_handler_3, "isr_handler_3", &
        "two-photon recoil with boost", &
        u, results)
 <<ISR/EPA handler: test declarations>>=
   public :: isr_handler_3
 <<ISR/EPA handler: tests>>=
   subroutine isr_handler_3 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(particle_set_t) :: pset
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(evt_trivial_t), target :: evt_trivial
     type(evt_isr_epa_t), target :: evt_isr_epa
     type(vector4_t), dimension(8) :: p
     real(default) :: sqrts
     real(default), dimension(2) :: x0
     real(default), dimension(2) :: x, xb
     class(rng_t), allocatable :: rng
     real(default) :: probability
 
     write (u, "(A)")  "* Test output: isr_handler_3"
     write (u, "(A)")  "*   Purpose: apply photon handler for boosted beams &
          &and two-photon recoil"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
          pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)
 
     write (u, "(A)")  "* Event data"
     write (u, "(A)")
 
     sqrts = 100._default
     write (u, "(A,2(1x,F12.7))")  "sqrts   =", sqrts
 
     x0 = [0.9_default, 0.4_default]
     write (u, "(A,2(1x,F12.7))")  "x0      =", x0
 
     write (u, "(A)")
     write (u, "(A,2(1x,F12.7))")  "sqs_hat =", sqrts * sqrt (product (x0))
 
     x = [0.6_default, 0.9_default]
     xb= 1 - x
     write (u, "(A,2(1x,F12.7))")  "x       =", x
 
     write (u, "(A)")
     write (u, "(A,2(1x,F12.7))")  "x0 * x  =", x0 * x
 
     p(1) = x0(1) * vector4_moving (sqrts/2, sqrts/2, 3)
     p(2) = x0(2) * vector4_moving (sqrts/2,-sqrts/2, 3)
     p(3:4) = x * p(1:2)
     p(5:6) = xb  * p(1:2)
     p(7:8) = p(3:4)
 
     call pset%set_momentum (p, on_shell = .false.)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize ISR handler transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_isr_epa
     evt_isr_epa%previous => evt_trivial
     
     call evt_isr_epa%set_mode_string (var_str ("recoil"))
     call evt_isr_epa%set_data_isr ( &
          sqrts = sqrts, &
          q_max = sqrts, &
          m = 511.e-3_default &
          )
 
     allocate (rng_test_t :: rng)
     call rng%init (3)  ! default would produce pi for azimuthal angle
     call evt_isr_epa%import_rng (rng)
 
     call evt_isr_epa%write (u, testflag=.true.)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill ISR handler transform"
     write (u, "(A)")
     
     call evt_isr_epa%prepare_new_event (1, 1)
     call evt_isr_epa%generate_weighted (probability)
     call evt_isr_epa%make_particle_set (0, .false.)
     
     call evt_isr_epa%write (u, testflag=.true.)
     
     write (u, "(A)")
     write (u, "(A,1x,F8.5)")  "Event probability =", probability
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_isr_epa%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: isr_handler_3"
 
   end subroutine isr_handler_3
 
 @ %def isr_handler_3
 @
 \subsection{Unit tests: EPA}
 API: Extra driver for the unit tests below.
 <<ISR/EPA handler: public test>>=
   public :: epa_handler_test
 <<ISR/EPA handler: test driver>>=
   subroutine epa_handler_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<ISR/EPA handler: execute EPA tests>>
   end subroutine epa_handler_test
 
 @ %def epa_handler_test
 @
 \subsubsection{Trivial case}
 Handle events resulting from the EPA approximation.  This test is for the
 trivial case where the event is kept collinear.
 <<ISR/EPA handler: execute EPA tests>>=
   call test (epa_handler_1, "epa_handler_1", &
        "collinear case, no modification", &
        u, results)
 <<ISR/EPA handler: test declarations>>=
   public :: epa_handler_1
 <<ISR/EPA handler: tests>>=
   subroutine epa_handler_1 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(particle_set_t) :: pset
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(evt_trivial_t), target :: evt_trivial
     type(evt_isr_epa_t), target :: evt_isr_epa
     type(vector4_t), dimension(8) :: p
     real(default) :: sqrts
     real(default), dimension(2) :: x, xb
     real(default) :: probability
 
     write (u, "(A)")  "* Test output: epa_handler_1"
     write (u, "(A)")  "*   Purpose: apply beam handler trivially (no-op)"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct &
          (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
          pdg = [11, -11, 22, 22, 11, -11, 13, -13], &
          model = model)
 
     sqrts = 100._default
     x = [0.6_default, 0.9_default]
     xb= 1 - x
 
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     p(3:4) = x * p(1:2)
     p(5:6) = xb  * p(1:2)
     p(7:8) = p(3:4)
 
     call pset%set_momentum (p, on_shell = .false.)
     
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize EPA handler transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_isr_epa
     evt_isr_epa%previous => evt_trivial
     
     call evt_isr_epa%write (u)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill EPA handler transform"
     write (u, "(A)")
     
     call evt_isr_epa%prepare_new_event (1, 1)
     call evt_isr_epa%generate_weighted (probability)
     call evt_isr_epa%make_particle_set (0, .false.)
     
     call evt_isr_epa%write (u)
     
     write (u, "(A)")
     write (u, "(A,1x,F8.5)")  "Event probability =", probability
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_isr_epa%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: epa_handler_1"
 
   end subroutine epa_handler_1
 
 @ %def epa_handler_1
 @
 \subsubsection{Beam pair with recoil}
 Handle beams resulting from the EPA approximation.  This test invokes the
 two-beam recoil mechanism.  Both beam remnants acquire transverse
 momentum, the photon momenta recoil, such that total energy-momentum
 is conserved, and all outgoing beam remnants and photons are on-shell
 (massless).
 <<ISR/EPA handler: execute EPA tests>>=
   call test (epa_handler_2, "epa_handler_2", &
        "two-beam recoil", &
        u, results)
 <<ISR/EPA handler: test declarations>>=
   public :: epa_handler_2
 <<ISR/EPA handler: tests>>=
   subroutine epa_handler_2 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(particle_set_t) :: pset
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(evt_trivial_t), target :: evt_trivial
     type(evt_isr_epa_t), target :: evt_isr_epa
     type(vector4_t), dimension(8) :: p
     real(default) :: sqrts
     real(default), dimension(2) :: x, xb
     class(rng_t), allocatable :: rng
     real(default) :: probability
 
     write (u, "(A)")  "* Test output: epa_handler_2"
     write (u, "(A)")  "*   Purpose: apply beam handler with two-beam recoil"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
          pdg = [11, -11, 22, 22, 11, -11, 13, -13], model = model)
 
     sqrts = 100._default
     x = [0.6_default, 0.9_default]
     xb= 1 - x
 
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     p(3:4) = x * p(1:2)
     p(5:6) = xb  * p(1:2)
     p(7:8) = p(3:4)
 
     call pset%set_momentum (p, on_shell = .false.)
     
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize EPA handler transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_isr_epa
     evt_isr_epa%previous => evt_trivial
     
     call evt_isr_epa%set_mode_string (var_str ("recoil"))
     call evt_isr_epa%set_data_epa ( &
          sqrts = sqrts, &
          q_max = sqrts, &
          m = 511.e-3_default &
          )
 
     allocate (rng_test_t :: rng)
     call rng%init (3)  ! default would produce pi for azimuthal angle
     call evt_isr_epa%import_rng (rng)
 
     call evt_isr_epa%write (u, testflag=.true.)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill EPA handler transform"
     write (u, "(A)")
     
     call evt_isr_epa%prepare_new_event (1, 1)
     call evt_isr_epa%generate_weighted (probability)
     call evt_isr_epa%make_particle_set (0, .false.)
     
     call evt_isr_epa%write (u, testflag=.true.)
     
     write (u, "(A)")
     write (u, "(A,1x,F8.5)")  "Event probability =", probability
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_isr_epa%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: epa_handler_2"
 
   end subroutine epa_handler_2
 
 @ %def epa_handler_2
 @
 \subsubsection{Boosted beams}
 Handle radiated beam remnants resulting from EPA radiation.  This test
 invokes the two-beam recoil mechanism, in the case that the partons
 before EPA are not in their c.m.\ frame (but collinear).
 <<ISR/EPA handler: execute EPA tests>>=
   call test (epa_handler_3, "epa_handler_3", &
        "two-beam recoil with boost", &
        u, results)
 <<ISR/EPA handler: test declarations>>=
   public :: epa_handler_3
 <<ISR/EPA handler: tests>>=
   subroutine epa_handler_3 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(particle_set_t) :: pset
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(evt_trivial_t), target :: evt_trivial
     type(evt_isr_epa_t), target :: evt_isr_epa
     type(vector4_t), dimension(8) :: p
     real(default) :: sqrts
     real(default), dimension(2) :: x0
     real(default), dimension(2) :: x, xb
     class(rng_t), allocatable :: rng
     real(default) :: probability
 
     write (u, "(A)")  "* Test output: epa_handler_3"
     write (u, "(A)")  "*   Purpose: apply beam handler for boosted beams &
          &and two-beam recoil"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM"), var_str ("SM.mdl"), &
          os_data, model)
 
     write (u, "(A)")  "* Initialize particle set"
     write (u, "(A)")
     
     call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
          pdg = [11, -11, 22, 22, 11, -11, 13, -13], model = model)
 
     write (u, "(A)")  "* Event data"
     write (u, "(A)")
 
     sqrts = 100._default
     write (u, "(A,2(1x,F12.7))")  "sqrts   =", sqrts
 
     x0 = [0.9_default, 0.4_default]
     write (u, "(A,2(1x,F12.7))")  "x0      =", x0
 
     write (u, "(A)")
     write (u, "(A,2(1x,F12.7))")  "sqs_hat =", sqrts * sqrt (product (x0))
 
     x = [0.6_default, 0.9_default]
     xb= 1 - x
     write (u, "(A,2(1x,F12.7))")  "x       =", x
 
     write (u, "(A)")
     write (u, "(A,2(1x,F12.7))")  "x0 * x  =", x0 * x
 
     p(1) = x0(1) * vector4_moving (sqrts/2, sqrts/2, 3)
     p(2) = x0(2) * vector4_moving (sqrts/2,-sqrts/2, 3)
     p(3:4) = x * p(1:2)
     p(5:6) = xb  * p(1:2)
     p(7:8) = p(3:4)
 
     call pset%set_momentum (p, on_shell = .false.)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill trivial event transform"
     write (u, "(A)")
 
     call evt_trivial%reset ()
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
     call write_separator (u, 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize EPA handler transform"
     write (u, "(A)")
     
     evt_trivial%next => evt_isr_epa
     evt_isr_epa%previous => evt_trivial
     
     call evt_isr_epa%set_mode_string (var_str ("recoil"))
     call evt_isr_epa%set_data_epa ( &
          sqrts = sqrts, &
          q_max = sqrts, &
          m = 511.e-3_default &
          )
 
     allocate (rng_test_t :: rng)
     call rng%init (3)  ! default would produce pi for azimuthal angle
     call evt_isr_epa%import_rng (rng)
 
     call evt_isr_epa%write (u, testflag=.true.)
     
     write (u, "(A)")
     write (u, "(A)")  "* Fill EPA handler transform"
     write (u, "(A)")
     
     call evt_isr_epa%prepare_new_event (1, 1)
     call evt_isr_epa%generate_weighted (probability)
     call evt_isr_epa%make_particle_set (0, .false.)
     
     call evt_isr_epa%write (u, testflag=.true.)
     
     write (u, "(A)")
     write (u, "(A,1x,F8.5)")  "Event probability =", probability
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_isr_epa%final ()
     call evt_trivial%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: epa_handler_3"
 
   end subroutine epa_handler_3
 
 @ %def epa_handler_3
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Decays}
 <<[[decays.f90]]>>=
 <<File header>>
 
 module decays
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_utils, only: write_indent, write_separator
   use format_defs, only: FMT_15
   use numeric_utils
   use diagnostics
   use flavors
   use helicities
   use quantum_numbers
   use interactions
   use evaluators
   use variables, only: var_list_t
   use model_data
   use rng_base
   use selectors
   use parton_states
   use process, only: process_t
   use instances, only: process_instance_t, pacify
   use process_stacks
   use event_transforms
 
 <<Standard module head>>
 
 <<Decays: public>>
 
 <<Decays: types>>
 
 <<Decays: interfaces>>
 
 contains
 
 <<Decays: procedures>>
 
 end module decays
 
 @ %def decays
 @
 \subsection{Final-State Particle Configuration}
 A final-state particle may be either stable or unstable.  Here is an
 empty abstract type as the parent of both, with holds just the flavor
 information.
 <<Decays: types>>=
   type, abstract :: any_config_t
      private
    contains
    <<Decays: any config: TBP>>
   end type any_config_t
 
 @ %def any_config_t
 @ Finalizer, depends on the implementation.
 <<Decays: any config: TBP>>=
   procedure (any_config_final), deferred :: final
 <<Decays: interfaces>>=
   interface
      subroutine any_config_final (object)
        import
        class(any_config_t), intent(inout) :: object
      end subroutine any_config_final
   end interface
 
 @ %def any_config_final
 @ The output is also deferred:
 <<Decays: any config: TBP>>=
   procedure (any_config_write), deferred :: write
 <<Decays: interfaces>>=
   interface
      subroutine any_config_write (object, unit, indent, verbose)
        import
        class(any_config_t), intent(in) :: object
        integer, intent(in), optional :: unit, indent
        logical, intent(in), optional :: verbose
      end subroutine any_config_write
   end interface
 
 @ %def any_config_write
 @ This is a container for a stable or unstable particle configurator.
 We need this wrapper for preparing arrays that mix stable and unstable
 particles.
 <<Decays: types>>=
   type :: particle_config_t
      private
      class(any_config_t), allocatable :: c
   end type particle_config_t
 
 @ %def particle_config_t
 @
 \subsection{Final-State Particle}
 In theory, for the particle instance we only need to consider the
 unstable case.  However, it is more straightforward to treat
 configuration and instance on the same footing, and to introduce a
 wrapper for particle objects as above.
 <<Decays: types>>=
   type, abstract :: any_t
      private
    contains
    <<Decays: any: TBP>>
   end type any_t
 
 @ %def any_t
 @ Finalizer, depends on the implementation.
 <<Decays: any: TBP>>=
   procedure (any_final), deferred :: final
 <<Decays: interfaces>>=
   interface
      subroutine any_final (object)
        import
        class(any_t), intent(inout) :: object
      end subroutine any_final
   end interface
 
 @ %def any_final
 @ The output is also deferred:
 <<Decays: any: TBP>>=
   procedure (any_write), deferred :: write
 <<Decays: interfaces>>=
   interface
      subroutine any_write (object, unit, indent)
        import
        class(any_t), intent(in) :: object
        integer, intent(in), optional :: unit, indent
      end subroutine any_write
   end interface
 
 @ %def any_write
 @ This is a container for a stable or unstable outgoing particle.
 We need this wrapper for preparing arrays that mix stable and unstable
 particles.
 <<Decays: types>>=
   type :: particle_out_t
      private
      class(any_t), allocatable :: c
   end type particle_out_t
 
 @ %def particle_config_t
 @
 \subsection{Decay Term Configuration}
 A decay term is a distinct final state, corresponding to a process
 term.  Each decay process may give rise to several terms with,
 possibly, differing flavor content.
 <<Decays: types>>=
   type :: decay_term_config_t
      private
      type(particle_config_t), dimension(:), allocatable :: prt
    contains
    <<Decays: decay term config: TBP>>
   end type decay_term_config_t
 
 @ %def decay_term_config_t
 @ Finalizer, recursive.
 <<Decays: decay term config: TBP>>=
   procedure :: final => decay_term_config_final
 <<Decays: procedures>>=
   recursive subroutine decay_term_config_final (object)
     class(decay_term_config_t), intent(inout) :: object
     integer :: i
     if (allocated (object%prt)) then
        do i = 1, size (object%prt)
           if (allocated (object%prt(i)%c))  call object%prt(i)%c%final ()
        end do
     end if
   end subroutine decay_term_config_final
 
 @ %def decay_term_config_final
 @ Output, with optional indentation
 <<Decays: decay term config: TBP>>=
   procedure :: write => decay_term_config_write
 <<Decays: procedures>>=
   recursive subroutine decay_term_config_write (object, unit, indent, verbose)
     class(decay_term_config_t), intent(in) :: object
     integer, intent(in), optional :: unit, indent
     logical, intent(in), optional :: verbose
     integer :: i, j, u, ind
     logical :: verb
     u = given_output_unit (unit)
     ind = 0;  if (present (indent))  ind = indent
     verb = .true.;  if (present (verbose))  verb = verbose
     call write_indent (u, ind)
     write (u, "(1x,A)", advance="no")  "Final state:"
     do i = 1, size (object%prt)
        select type (prt_config => object%prt(i)%c)
        type is (stable_config_t)
           write (u, "(1x,A)", advance="no") &
                char (prt_config%flv(1)%get_name ())
           do j = 2, size (prt_config%flv)
              write (u, "(':',A)", advance="no") &
                   char (prt_config%flv(j)%get_name ())
           end do
        type is (unstable_config_t)
           write (u, "(1x,A)", advance="no") &
                char (prt_config%flv%get_name ())
        end select
     end do
     write (u, *)
     if (verb) then
        do i = 1, size (object%prt)
           call object%prt(i)%c%write (u, ind)
        end do
     end if
   end subroutine decay_term_config_write
 
 @ %def decay_term_config_write
 @ Initialize, given a set of flavors.  For each flavor, we must indicate
 whether the particle is stable.  The second index of the flavor array runs
 over alternatives for each decay product; alternatives are allowed only if the
 decay product is itself stable.
 <<Decays: decay term config: TBP>>=
   procedure :: init => decay_term_config_init
 <<Decays: procedures>>=
   recursive subroutine decay_term_config_init &
        (term, flv, stable, model, process_stack, var_list)
     class(decay_term_config_t), intent(out) :: term
     type(flavor_t), dimension(:,:), intent(in) :: flv
     logical, dimension(:), intent(in) :: stable
     class(model_data_t), intent(in), target :: model
     type(process_stack_t), intent(in), optional :: process_stack
     type(var_list_t), intent(in), optional :: var_list
     type(string_t), dimension(:), allocatable :: decay
     integer :: i
     allocate (term%prt (size (flv, 1)))
     do i = 1, size (flv, 1)
        associate (prt => term%prt(i))
          if (stable(i)) then
             allocate (stable_config_t :: prt%c)
          else
             allocate (unstable_config_t :: prt%c)
          end if
          select type (prt_config => prt%c)
          type is (stable_config_t)
             call prt_config%init (flv(i,:))
          type is (unstable_config_t)
             if (all (flv(i,:) == flv(i,1))) then
                call prt_config%init (flv(i,1))
                call flv(i,1)%get_decays (decay)
                call prt_config%init_decays &
                     (decay, model, process_stack, var_list)
             else
                call prt_config%write ()
                call msg_fatal ("Decay configuration: &
                     &unstable product must be unique")
             end if
          end select
        end associate
     end do
   end subroutine decay_term_config_init
 
 @ %def decay_term_config_init
 @ Recursively compute widths and branching ratios for all unstable particles.
 <<Decays: decay term config: TBP>>=
   procedure :: compute => decay_term_config_compute
 <<Decays: procedures>>=
   recursive subroutine decay_term_config_compute (term)
     class(decay_term_config_t), intent(inout) :: term
     integer :: i
     do i = 1, size (term%prt)
        select type (unstable_config => term%prt(i)%c)
        type is (unstable_config_t)
           call unstable_config%compute ()
        end select
     end do
   end subroutine decay_term_config_compute
 
 @ %def decay_term_config_compute
 @
 \subsection{Decay Term}
 A decay term instance is selected when we generate an event for the associated
 process instance.  When evaluated, it triggers further decays down the chain.
 
 Only unstable products are allocated as child particles.
 <<Decays: types>>=
   type :: decay_term_t
      private
      type(decay_term_config_t), pointer :: config => null ()
      type(particle_out_t), dimension(:), allocatable :: particle_out
    contains
    <<Decays: decay term: TBP>>
   end type decay_term_t
 
 @ %def decay_term_t
 @ Finalizer.
 <<Decays: decay term: TBP>>=
   procedure :: final => decay_term_final
 <<Decays: procedures>>=
   recursive subroutine decay_term_final (object)
     class(decay_term_t), intent(inout) :: object
     integer :: i
     if (allocated (object%particle_out)) then
        do i = 1, size (object%particle_out)
           call object%particle_out(i)%c%final ()
        end do
     end if
   end subroutine decay_term_final
 
 @ %def decay_term_final
 @ Output.
 <<Decays: decay term: TBP>>=
   procedure :: write => decay_term_write
 <<Decays: procedures>>=
   recursive subroutine decay_term_write (object, unit, indent)
     class(decay_term_t), intent(in) :: object
     integer, intent(in), optional :: unit, indent
     integer :: i, u, ind
     u = given_output_unit (unit)
     ind = 0;  if (present (indent))  ind = indent
     call object%config%write (u, ind, verbose = .false.)
     do i = 1, size (object%particle_out)
        call object%particle_out(i)%c%write (u, ind)
     end do
   end subroutine decay_term_write
 
 @ %def decay_term_write
 @ Recursively write the embedded process instances.
 <<Decays: decay term: TBP>>=
   procedure :: write_process_instances => decay_term_write_process_instances
 <<Decays: procedures>>=
   recursive subroutine decay_term_write_process_instances (term, unit, verbose)
     class(decay_term_t), intent(in) :: term
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: i
     do i = 1, size (term%particle_out)
        select type (unstable => term%particle_out(i)%c)
        type is (unstable_t)
           call unstable%write_process_instances (unit, verbose)
        end select
     end do
   end subroutine decay_term_write_process_instances
 
 @ %def decay_term_write_process_instances
 @ Initialization, using the configuration object.  We allocate
 particle objects in parallel to the particle configuration objects
 which we use to initialize them, one at a time.
 <<Decays: decay term: TBP>>=
   procedure :: init => decay_term_init
 <<Decays: procedures>>=
   recursive subroutine decay_term_init (term, config)
     class(decay_term_t), intent(out) :: term
     type(decay_term_config_t), intent(in), target :: config
     integer :: i
     term%config => config
     allocate (term%particle_out (size (config%prt)))
     do i = 1, size (config%prt)
        select type (prt_config => config%prt(i)%c)
        type is (stable_config_t)
           allocate (stable_t :: term%particle_out(i)%c)
           select type (stable => term%particle_out(i)%c)
           type is (stable_t)
              call stable%init (prt_config)
           end select
        type is (unstable_config_t)
           allocate (unstable_t :: term%particle_out(i)%c)
           select type (unstable => term%particle_out(i)%c)
           type is (unstable_t)
              call unstable%init (prt_config)
           end select
        end select
     end do
   end subroutine decay_term_init
 
 @ %def decay_term_init
 @ Implement a RNG instance, spawned by the process object.
 <<Decays: decay term: TBP>>=
   procedure :: make_rng => decay_term_make_rng
 <<Decays: procedures>>=
   subroutine decay_term_make_rng (term, process)
     class(decay_term_t), intent(inout) :: term
     type(process_t), intent(inout) :: process
     class(rng_t), allocatable :: rng
     integer :: i
     do i = 1, size (term%particle_out)
        select type (unstable => term%particle_out(i)%c)
        type is (unstable_t)
           call process%make_rng (rng)
           call unstable%import_rng (rng)
        end select
     end do
   end subroutine decay_term_make_rng
 
 @ %def decay_term_make_rng
 @ Link the interactions for unstable decay products to the
 interaction of the parent process.
 <<Decays: decay term: TBP>>=
   procedure :: link_interactions => decay_term_link_interactions
 <<Decays: procedures>>=
   recursive subroutine decay_term_link_interactions (term, trace)
     class(decay_term_t), intent(inout) :: term
     type(interaction_t), intent(in), target :: trace
     integer :: i
     do i = 1, size (term%particle_out)
        select type (unstable => term%particle_out(i)%c)
        type is (unstable_t)
           call unstable%link_interactions (i, trace)
        end select
     end do
   end subroutine decay_term_link_interactions
 
 @ %def decay_term_link_interactions
 @ Recursively generate a decay chain, for each of the unstable
 particles in the final state.
 <<Decays: decay term: TBP>>=
   procedure :: select_chain => decay_term_select_chain
 <<Decays: procedures>>=
   recursive subroutine decay_term_select_chain (term)
     class(decay_term_t), intent(inout) :: term
     integer :: i
     do i = 1, size (term%particle_out)
        select type (unstable => term%particle_out(i)%c)
        type is (unstable_t)
           call unstable%select_chain ()
        end select
     end do
   end subroutine decay_term_select_chain
 
 @ %def decay_term_select_chain
 @ Recursively generate a decay event, for each of the unstable
 particles in the final state.
 <<Decays: decay term: TBP>>=
   procedure :: generate => decay_term_generate
 <<Decays: procedures>>=
   recursive subroutine decay_term_generate (term)
     class(decay_term_t), intent(inout) :: term
     integer :: i
     do i = 1, size (term%particle_out)
        select type (unstable => term%particle_out(i)%c)
        type is (unstable_t)
           call unstable%generate ()
        end select
     end do
   end subroutine decay_term_generate
 
 @ %def decay_term_generate
 @
 \subsection{Decay Root Configuration}
 At the root of a decay chain, there is a parent process.  The decay root
 stores a pointer to the parent process and the set of decay configurations.
 <<Decays: public>>=
   public :: decay_root_config_t
 <<Decays: types>>=
   type :: decay_root_config_t
      private
      type(string_t) :: process_id
      type(process_t), pointer :: process => null ()
      class(model_data_t), pointer :: model => null ()
      type(decay_term_config_t), dimension(:), allocatable :: term_config
    contains
    <<Decays: decay root config: TBP>>
   end type decay_root_config_t
 
 @ %def decay_root_config_t
 @ The finalizer is recursive since there may be cascade decays.
 <<Decays: decay root config: TBP>>=
   procedure :: final => decay_root_config_final
 <<Decays: procedures>>=
   recursive subroutine decay_root_config_final (object)
     class(decay_root_config_t), intent(inout) :: object
     integer :: i
     if (allocated (object%term_config)) then
        do i = 1, size (object%term_config)
           call object%term_config(i)%final ()
        end do
     end if
   end subroutine decay_root_config_final
 
 @ %def decay_root_config_final
 @ The output routine is also recursive, and it contains an adjustable
 indentation.
 <<Decays: decay root config: TBP>>=
   procedure :: write => decay_root_config_write
   procedure :: write_header => decay_root_config_write_header
   procedure :: write_terms => decay_root_config_write_terms
 <<Decays: procedures>>=
   recursive subroutine decay_root_config_write (object, unit, indent, verbose)
     class(decay_root_config_t), intent(in) :: object
     integer, intent(in), optional :: unit, indent
     logical, intent(in), optional :: verbose
     integer :: u, ind
     u = given_output_unit (unit)
     ind = 0;  if (present (indent))  ind = indent
     call write_indent (u, ind)
     write (u, "(1x,A)")  "Final-state decay tree:"
     call object%write_header (unit, indent)
     call object%write_terms (unit, indent, verbose)
   end subroutine decay_root_config_write
 
   subroutine decay_root_config_write_header (object, unit, indent)
     class(decay_root_config_t), intent(in) :: object
     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, ind)
     if (associated (object%process)) then
        write (u, 3)  "process ID      =", char (object%process_id), "*"
     else
        write (u, 3)  "process ID      =", char (object%process_id)
     end if
 3   format (3x,A,2(1x,A))
   end subroutine decay_root_config_write_header
 
   recursive subroutine decay_root_config_write_terms &
        (object, unit, indent, verbose)
     class(decay_root_config_t), intent(in) :: object
     integer, intent(in), optional :: unit, indent
     logical, intent(in), optional :: verbose
     integer :: i, u, ind
     logical :: verb
     u = given_output_unit (unit)
     ind = 0;  if (present (indent))  ind = indent
     verb = .true.;  if (present (verbose))  verb = verbose
     if (verb .and. allocated (object%term_config)) then
        do i = 1, size (object%term_config)
           call object%term_config(i)%write (u, ind + 1)
        end do
     end if
   end subroutine decay_root_config_write_terms
 
 @ %def decay_root_config_write
 @ Initialize for a named process and (optionally) a pre-determined
 number of terms.
 <<Decays: decay root config: TBP>>=
   procedure :: init => decay_root_config_init
 <<Decays: procedures>>=
   subroutine decay_root_config_init (decay, model, process_id, n_terms)
     class(decay_root_config_t), intent(out) :: decay
     class(model_data_t), intent(in), target :: model
     type(string_t), intent(in) :: process_id
     integer, intent(in), optional :: n_terms
     decay%model => model
     decay%process_id = process_id
     if (present (n_terms)) then
        allocate (decay%term_config (n_terms))
     end if
   end subroutine decay_root_config_init
 
 @ %def decay_root_config_init
 @ Declare a decay term, given an array of flavors.
 <<Decays: decay root config: TBP>>=
   procedure :: init_term => decay_root_config_init_term
 <<Decays: procedures>>=
   recursive subroutine decay_root_config_init_term &
        (decay, i, flv, stable, model, process_stack, var_list)
     class(decay_root_config_t), intent(inout) :: decay
     integer, intent(in) :: i
     type(flavor_t), dimension(:,:), intent(in) :: flv
     logical, dimension(:), intent(in) :: stable
     class(model_data_t), intent(in), target :: model
     type(process_stack_t), intent(in), optional :: process_stack
     type(var_list_t), intent(in), optional, target :: var_list
     call decay%term_config(i)%init (flv, stable, model, process_stack, var_list)
   end subroutine decay_root_config_init_term
 
 @ %def decay_root_config_init_term
 @ Connect the decay root configuration with a process object (which should
 represent the parent process).  This includes initialization, therefore
 intent(out).
 
 The flavor state is retrieved from the process term object.  However, we have
 to be careful: the flavor object points to the model instance that is stored
 in the process object.  This model instance may not contain the current
 setting for unstable particles and decay.  Therefore, we assign the model
 directly.
 
 If the [[process_instance]] argument is provided, we use this for the
 flavor state.  This applies to the decay root only, where the process
 can be entangled with a beam setup, and the latter contains beam
 remnants as further outgoing particles.  These must be included in the
 set of outgoing flavors, since the decay application is also done on
 the connected state.
 
 Infer stability from the particle properties, using the first row in the set
 of flavor states.  For unstable particles, we look for decays,
 recursively, available from the process stack (if present).
 
 For the unstable particles, we have to check whether their masses
 match between the production and the decay.  Fortunately, both
 versions are available for comparison.
 
 The optional [[var_list]] argument may override integral/error
 values for decay processes.
 <<Decays: decay root config: TBP>>=
   procedure :: connect => decay_root_config_connect
 <<Decays: procedures>>=
   recursive subroutine decay_root_config_connect &
        (decay, process, model, process_stack, process_instance, var_list)
     class(decay_root_config_t), intent(out) :: decay
     type(process_t), intent(in), target :: process
     class(model_data_t), intent(in), target :: model
     type(process_stack_t), intent(in), optional :: process_stack
     type(process_instance_t), intent(in), optional, target :: process_instance
     type(var_list_t), intent(in), optional, target :: var_list
     type(connected_state_t), pointer :: connected_state
     type(interaction_t), pointer :: int
     type(flavor_t), dimension(:,:), allocatable :: flv
     logical, dimension(:), allocatable :: stable
     real(default), dimension(:), allocatable :: m_prod, m_dec
     integer :: i
     call decay%init (model, process%get_id (), process%get_n_terms ())
     do i = 1, size (decay%term_config)
        if (present (process_instance)) then
           connected_state => process_instance%get_connected_state_ptr (i)
           int => connected_state%get_matrix_int_ptr ()
           call interaction_get_flv_out (int, flv)
        else
           call process%get_term_flv_out (i, flv)
        end if
        allocate (m_prod (size (flv(:,1)%get_mass ())))
        m_prod = flv(:,1)%get_mass ()
        call flv%set_model (model)
        allocate (m_dec (size (flv(:,1)%get_mass ())))
        m_dec = flv(:,1)%get_mass ()
        allocate (stable (size (flv, 1)))
        stable = flv(:,1)%is_stable ()
        call check_masses ()
        call decay%init_term (i, flv, stable, model, process_stack, var_list)
        deallocate (flv, stable, m_prod, m_dec)
     end do
     decay%process => process
   contains
     subroutine check_masses ()
       integer :: i
       logical :: ok
       ok = .true.
       do i = 1, size (m_prod)
          if (.not. stable(i)) then
             if (.not. nearly_equal (m_prod(i), m_dec(i))) then
                write (msg_buffer, "(A,A,A)")  "particle '", &
                     char (flv(i,1)%get_name ()), "':"
                call msg_message
                write (msg_buffer, &
                     "(2x,A,1x," // FMT_15 // ",3x,A,1x," // FMT_15 // ")") &
                     "m_prod =", m_prod(i), "m_dec =", m_dec(i)
                call msg_message
                ok = .false.
             end if
          end if
       end do
       if (.not. ok)  call msg_fatal &
            ("Particle mass mismatch between production and decay")
     end subroutine check_masses
   end subroutine decay_root_config_connect
 
 @ %def decay_root_config_connect
 @ Recursively compute widths, errors, and branching ratios.
 <<Decays: decay root config: TBP>>=
   procedure :: compute => decay_root_config_compute
 <<Decays: procedures>>=
   recursive subroutine decay_root_config_compute (decay)
     class(decay_root_config_t), intent(inout) :: decay
     integer :: i
     do i = 1, size (decay%term_config)
        call decay%term_config(i)%compute ()
     end do
   end subroutine decay_root_config_compute
 
 @ %def decay_root_config_compute
 @
 \subsection{Decay Root Instance}
 This is the common parent type for decay and decay root.  The process instance
 points to the parent process.  The model pointer is separate because particle
 settings may be updated w.r.t.\ the parent process object.
 <<Decays: types>>=
   type, abstract :: decay_gen_t
      private
      type(decay_term_t), dimension(:), allocatable :: term
      type(process_instance_t), pointer :: process_instance => null ()
      integer :: selected_mci = 0
      integer :: selected_term = 0
    contains
    <<Decays: decay gen: TBP>>
   end type decay_gen_t
 
 @ %def decay_gen_t
 @
 The decay root represents the parent process.  When an event is generated, the
 generator selects the term to which the decay chain applies (if possible).
 
 The process instance is just a pointer.
 <<Decays: public>>=
   public :: decay_root_t
 <<Decays: types>>=
   type, extends (decay_gen_t) :: decay_root_t
      private
      type(decay_root_config_t), pointer :: config => null ()
    contains
    <<Decays: decay root: TBP>>
   end type decay_root_t
 
 @ %def decay_root_t
 @ The finalizer has to recursively finalize the terms, but we can skip the
 process instance which is not explicitly allocated.
 <<Decays: decay gen: TBP>>=
   procedure :: base_final => decay_gen_final
 <<Decays: procedures>>=
   recursive subroutine decay_gen_final (object)
     class(decay_gen_t), intent(inout) :: object
     integer :: i
     if (allocated (object%term)) then
        do i = 1, size (object%term)
           call object%term(i)%final ()
        end do
     end if
   end subroutine decay_gen_final
 
 @ %def decay_gen_final
 @ No extra finalization for the decay root.
 <<Decays: decay root: TBP>>=
   procedure :: final => decay_root_final
 <<Decays: procedures>>=
   subroutine decay_root_final (object)
     class(decay_root_t), intent(inout) :: object
     call object%base_final ()
   end subroutine decay_root_final
 
 @ %def decay_gen_final
 @ Output.
 <<Decays: decay root: TBP>>=
   procedure :: write => decay_root_write
 <<Decays: procedures>>=
   subroutine decay_root_write (object, unit)
     class(decay_root_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     if (associated (object%config)) then
        call object%config%write (unit, verbose = .false.)
     else
        write (u, "(1x,A)")  "Final-state decay tree: [not configured]"
     end if
     if (object%selected_mci > 0) then
        write (u, "(3x,A,I0)")  "Selected MCI    = ", object%selected_mci
     else
        write (u, "(3x,A)")  "Selected MCI    = [undefined]"
     end if
     if (object%selected_term > 0) then
        write (u, "(3x,A,I0)")  "Selected term   = ", object%selected_term
        call object%term(object%selected_term)%write (u, 1)
     else
        write (u, "(3x,A)")  "Selected term   = [undefined]"
     end if
   end subroutine decay_root_write
 
 @ %def decay_root_write
 @ Write the process instances, recursively.
 <<Decays: decay gen: TBP>>=
   procedure :: write_process_instances => decay_gen_write_process_instances
 <<Decays: procedures>>=
   recursive subroutine decay_gen_write_process_instances (decay, unit, verbose)
     class(decay_gen_t), intent(in) :: decay
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     logical :: verb
     verb = .true.;  if (present (verbose))  verb = verbose
     if (associated (decay%process_instance)) then
        if (verb) then
           call decay%process_instance%write (unit)
        else
           call decay%process_instance%write_header (unit)
        end if
     end if
     if (decay%selected_term > 0) then
        call decay%term(decay%selected_term)%write_process_instances (unit, verb)
     end if
   end subroutine decay_gen_write_process_instances
 
 @ %def decay_gen_write_process_instances
 @ Generic initializer.  All can be done recursively.
 <<Decays: decay gen: TBP>>=
   procedure :: base_init => decay_gen_init
 <<Decays: procedures>>=
   recursive subroutine decay_gen_init (decay, term_config)
     class(decay_gen_t), intent(out) :: decay
     type(decay_term_config_t), dimension(:), intent(in), target :: term_config
     integer :: i
     allocate (decay%term (size (term_config)))
     do i = 1, size (decay%term)
        call decay%term(i)%init (term_config(i))
     end do
   end subroutine decay_gen_init
 
 @ %def decay_gen_init
 @ Specific initializer.  We assign the configuration object, which should
 correspond to a completely initialized decay configuration tree.  We
 also connect to an existing process instance.  Then, we recursively
 link the child interactions to the parent process.
 <<Decays: decay root: TBP>>=
   procedure :: init => decay_root_init
 <<Decays: procedures>>=
   subroutine decay_root_init (decay_root, config, process_instance)
     class(decay_root_t), intent(out) :: decay_root
     type(decay_root_config_t), intent(in), target :: config
     type(process_instance_t), intent(in), target :: process_instance
     call decay_root%base_init (config%term_config)
     decay_root%config => config
     decay_root%process_instance => process_instance
     call decay_root%make_term_rng (config%process)
     call decay_root%link_term_interactions ()
   end subroutine decay_root_init
 
 @ %def decay_root_init
 @ Explicitly set/get mci and term indices.  (Used in unit test.)
 <<Decays: decay gen: TBP>>=
   procedure :: set_mci => decay_gen_set_mci
   procedure :: set_term => decay_gen_set_term
   procedure :: get_mci => decay_gen_get_mci
   procedure :: get_term => decay_gen_get_term
 <<Decays: procedures>>=
   subroutine decay_gen_set_mci (decay, i)
     class(decay_gen_t), intent(inout) :: decay
     integer, intent(in) :: i
     decay%selected_mci = i
   end subroutine decay_gen_set_mci
 
   subroutine decay_gen_set_term (decay, i)
     class(decay_gen_t), intent(inout) :: decay
     integer, intent(in) :: i
     decay%selected_term = i
   end subroutine decay_gen_set_term
 
   function decay_gen_get_mci (decay) result (i)
     class(decay_gen_t), intent(inout) :: decay
     integer :: i
     i = decay%selected_mci
   end function decay_gen_get_mci
 
   function decay_gen_get_term (decay) result (i)
     class(decay_gen_t), intent(inout) :: decay
     integer :: i
     i = decay%selected_term
   end function decay_gen_get_term
 
 @ %def decay_gen_set_mci
 @ %def decay_gen_set_term
 @ %def decay_gen_get_mci
 @ %def decay_gen_get_term
 @ Implement random-number generators for unstable decay selection in
 all terms.  This is not recursive.
 
 We also make use of the fact that [[process]] is a pointer; the (state
 of the RNG factory inside the) target process will be modified by the
 rng-spawning method, but not the pointer.
 <<Decays: decay gen: TBP>>=
   procedure :: make_term_rng => decay_gen_make_term_rng
 <<Decays: procedures>>=
   subroutine decay_gen_make_term_rng (decay, process)
     class(decay_gen_t), intent(inout) :: decay
     type(process_t), intent(in), pointer :: process
     integer :: i
     do i = 1, size (decay%term)
        call decay%term(i)%make_rng (process)
     end do
   end subroutine decay_gen_make_term_rng
 
 @ %def decay_gen_make_term_rng
 @ Recursively link interactions of the enclosed decay terms to the
 corresponding terms in the current process instance.
 <<Decays: decay gen: TBP>>=
   procedure :: link_term_interactions => decay_gen_link_term_interactions
 <<Decays: procedures>>=
   recursive subroutine decay_gen_link_term_interactions (decay)
     class(decay_gen_t), intent(inout) :: decay
     integer :: i
     type(interaction_t), pointer :: trace
     associate (instance => decay%process_instance)
       do i = 1, size (decay%term)
          trace => instance%get_trace_int_ptr (i)
          call decay%term(i)%link_interactions (trace)
       end do
     end associate
   end subroutine decay_gen_link_term_interactions
 
 @ %def decay_gen_link_term_interactions
 @ Select a decay chain: decay modes and process components.
 <<Decays: decay root: TBP>>=
   procedure :: select_chain => decay_root_select_chain
 <<Decays: procedures>>=
   subroutine decay_root_select_chain (decay_root)
     class(decay_root_t), intent(inout) :: decay_root
     if (decay_root%selected_term > 0) then
        call decay_root%term(decay_root%selected_term)%select_chain ()
     else
        call msg_bug ("Decays: no term selected for parent process")
     end if
   end subroutine decay_root_select_chain
 
 @ %def decay_root_select_chain
 @ Generate a decay tree, i.e., for the selected term in the parent
 process, recursively generate a decay event for all unstable
 particles.
 
 Factor out the trace of the connected state of the parent process.
 This trace should not be taken into account for unweighting the decay
 chain, since it was already used for unweighting the parent event, or
 it determines the overall event weight.
 <<Decays: decay root: TBP>>=
   procedure :: generate => decay_root_generate
 <<Decays: procedures>>=
   subroutine decay_root_generate (decay_root)
     class(decay_root_t), intent(inout) :: decay_root
     type(connected_state_t), pointer :: connected_state
     if (decay_root%selected_term > 0) then
        connected_state => decay_root%process_instance%get_connected_state_ptr &
             (decay_root%selected_term)
        call connected_state%normalize_matrix_by_trace ()
        call decay_root%term(decay_root%selected_term)%generate ()
     else
        call msg_bug ("Decays: no term selected for parent process")
     end if
   end subroutine decay_root_generate
 
 @ %def decay_root_generate
 @
 \subsection{Decay Configuration}
 A decay configuration describes a distinct decay mode of a particle.  Each
 decay mode may include several terms, which correspond to the terms in the
 associated process.  In addition to the base type, the decay configuration
 object contains the integral of the parent process and the selector for the
 MCI group inside this process.
 
 The flavor component should be identical to the flavor component of the parent
 particle ([[unstable]] object).
 <<Decays: types>>=
   type, extends (decay_root_config_t) :: decay_config_t
      private
      type(flavor_t) :: flv
      real(default) :: weight = 0
      real(default) :: integral = 0
      real(default) :: abs_error = 0
      real(default) :: rel_error = 0
      type(selector_t) :: mci_selector
    contains
    <<Decays: decay config: TBP>>
   end type decay_config_t
 
 @ %def decay_config_t
 @ The output routine extends the decay-root writer by listing numerical
 component values.
 <<Decays: decay config: TBP>>=
   procedure :: write => decay_config_write
 <<Decays: procedures>>=
   recursive subroutine decay_config_write (object, unit, indent, verbose)
     class(decay_config_t), intent(in) :: object
     integer, intent(in), optional :: unit, indent
     logical, intent(in), optional :: verbose
     integer :: u, ind
     u = given_output_unit (unit)
     ind = 0;  if (present (indent))  ind = indent
     call write_indent (u, ind)
     write (u, "(1x,A)")  "Decay:"
     call object%write_header (unit, indent)
     call write_indent (u, ind)
     write (u, 2)  "branching ratio =", object%weight * 100
     call write_indent (u, ind)
     write (u, 1)  "partial width   =", object%integral
     call write_indent (u, ind)
     write (u, 1)  "error (abs)     =", object%abs_error
     call write_indent (u, ind)
     write (u, 1)  "error (rel)     =", object%rel_error
 1   format (3x,A,ES19.12)
 2   format (3x,A,F11.6,1x,'%')
     call object%write_terms (unit, indent, verbose)
   end subroutine decay_config_write
 
 @ %def decay_config_write
 @ Connect a decay configuration with a process object (which should
 represent the decay).  This includes initialization, therefore
 intent(out).  We first connect the process itself, then do initializations
 that are specific for this decay.
 
 Infer stability from the particle properties, using the first row in the set
 of flavor states.  Once we can deal with predetermined decay chains, they
 should be used instead.
 
 If there is an optional [[var_list]], check if the stored values for
 the decay partial width and error have been overridden there.
 <<Decays: decay config: TBP>>=
   procedure :: connect => decay_config_connect
 <<Decays: procedures>>=
   recursive subroutine decay_config_connect &
        (decay, process, model, process_stack, process_instance, var_list)
     class(decay_config_t), intent(out) :: decay
     type(process_t), intent(in), target :: process
     class(model_data_t), intent(in), target :: model
     type(process_stack_t), intent(in), optional :: process_stack
     type(process_instance_t), intent(in), optional, target :: process_instance
     type(var_list_t), intent(in), optional, target :: var_list
     real(default), dimension(:), allocatable :: integral_mci
     type(string_t) :: process_id
     integer :: i, n_mci
     call decay%decay_root_config_t%connect &
          (process, model, process_stack, var_list=var_list)
     process_id = process%get_id ()
     if (process%cm_frame ()) then
        call msg_fatal ("Decay process " // char (process_id) &
             // ": unusable because rest frame is fixed.")
     end if
     decay%integral = process%get_integral ()
     decay%abs_error = process%get_error ()
     if (present (var_list)) then
        call update (decay%integral, "integral(" // process_id // ")")
        call update (decay%abs_error, "error(" // process_id // ")")
     end if
     n_mci = process%get_n_mci ()
     allocate (integral_mci (n_mci))
     do i = 1, n_mci
        integral_mci(i) = process%get_integral_mci (i)
     end do
     call decay%mci_selector%init (integral_mci)
   contains
     subroutine update (var, var_name)
       real(default), intent(inout) :: var
       type(string_t), intent(in) :: var_name
       if (var_list%contains (var_name)) then
          var = var_list%get_rval (var_name)
       end if
     end subroutine update
   end subroutine decay_config_connect
 
 @ %def decay_config_connect
 @ Set the flavor entry, which repeats the flavor of the parent unstable
 particle.
 <<Decays: decay config: TBP>>=
   procedure :: set_flv => decay_config_set_flv
 <<Decays: procedures>>=
   subroutine decay_config_set_flv (decay, flv)
     class(decay_config_t), intent(inout) :: decay
     type(flavor_t), intent(in) :: flv
     decay%flv = flv
   end subroutine decay_config_set_flv
 
 @ %def decay_config_set_flv
 @ Compute embedded branchings and the relative error.  This method does not
 apply to the decay root.
 <<Decays: decay config: TBP>>=
   procedure :: compute => decay_config_compute
 <<Decays: procedures>>=
   recursive subroutine decay_config_compute (decay)
     class(decay_config_t), intent(inout) :: decay
     call decay%decay_root_config_t%compute ()
     if (.not. vanishes (decay%integral)) then
        decay%rel_error = decay%abs_error / decay%integral
     else
        decay%rel_error = 0
     end if
   end subroutine decay_config_compute
 
 @ %def decay_config_compute
 @
 \subsection{Decay Instance}
 The decay contains a collection of terms.  One of them is selected when the
 decay is evaluated.  This is similar to the decay root, but we implement it
 independently.
 
 The process instance object is allocated via a pointer, so it automatically
 behaves as a target.
 <<Decays: types>>=
   type, extends (decay_gen_t) :: decay_t
      private
      type(decay_config_t), pointer :: config => null ()
      class(rng_t), allocatable :: rng
    contains
    <<Decays: decay: TBP>>
   end type decay_t
 
 @ %def decay_t
 @ The finalizer is recursive.
 <<Decays: decay: TBP>>=
   procedure :: final => decay_final
 <<Decays: procedures>>=
   recursive subroutine decay_final (object)
     class(decay_t), intent(inout) :: object
     integer :: i
     call object%base_final ()
     do i = 1, object%config%process%get_n_mci ()
        call object%process_instance%final_simulation (i)
     end do
     call object%process_instance%final ()
     deallocate (object%process_instance)
   end subroutine decay_final
 
 @ %def decay_final
 @ Output.
 <<Decays: decay: TBP>>=
   procedure :: write => decay_write
 <<Decays: procedures>>=
   recursive subroutine decay_write (object, unit, indent, recursive)
     class(decay_t), intent(in) :: object
     integer, intent(in), optional :: unit, indent, recursive
     integer :: u, ind
     u = given_output_unit (unit)
     ind = 0;  if (present (indent))  ind = indent
     call object%config%write (unit, indent, verbose = .false.)
     if (allocated (object%rng)) then
        call object%rng%write (u, ind + 1)
     end if
     call write_indent (u, ind)
     if (object%selected_mci > 0) then
        write (u, "(3x,A,I0)")  "Selected MCI    = ", object%selected_mci
     else
        write (u, "(3x,A)")  "Selected MCI    = [undefined]"
     end if
     call write_indent (u, ind)
     if (object%selected_term > 0) then
        write (u, "(3x,A,I0)")  "Selected term   = ", object%selected_term
        call object%term(object%selected_term)%write (u, ind + 1)
     else
        write (u, "(3x,A)")  "Selected term   = [undefined]"
     end if
   end subroutine decay_write
 
 @ %def decay_write
 @ Initializer.  Base initialization is done recursively.  Then, we
 prepare the current process instance and allocate a random-number
 generator for term selection.  For all unstable particles, we also
 allocate a r.n.g. as spawned by the current process.
 <<Decays: decay: TBP>>=
   procedure :: init => decay_init
 <<Decays: procedures>>=
   recursive subroutine decay_init (decay, config)
     class(decay_t), intent(out) :: decay
     type(decay_config_t), intent(in), target :: config
     integer :: i
     call decay%base_init (config%term_config)
     decay%config => config
     allocate (decay%process_instance)
     call decay%process_instance%init (decay%config%process)
     call decay%process_instance%setup_event_data (decay%config%model)
     do i = 1, decay%config%process%get_n_mci ()
        call decay%process_instance%init_simulation (i)
     end do
     call decay%config%process%make_rng (decay%rng)
     call decay%make_term_rng (decay%config%process)
   end subroutine decay_init
 
 @ %def decay_init
 @ Link interactions to the parent process.  [[i_prt]] is the index of
 the current outgoing particle in the parent interaction, for which we
 take the trace evaluator.  We link it to the beam particle in the beam
 interaction of the decay process instance.  Then, repeat the procedure
 for the outgoing particles.
 <<Decays: decay: TBP>>=
   procedure :: link_interactions => decay_link_interactions
 <<Decays: procedures>>=
   recursive subroutine decay_link_interactions (decay, i_prt, trace)
     class(decay_t), intent(inout) :: decay
     integer, intent(in) :: i_prt
     type(interaction_t), intent(in), target :: trace
     type(interaction_t), pointer :: beam_int
     integer :: n_in, n_vir
     beam_int => decay%process_instance%get_beam_int_ptr ()
     n_in = trace%get_n_in ()
     n_vir = trace%get_n_vir ()
     call beam_int%set_source_link (1, trace, &
          n_in + n_vir + i_prt)
     call decay%link_term_interactions ()
   end subroutine decay_link_interactions
 
 @ %def decay_link_interactions
 @ Determine a decay chain.  For each unstable particle we select one
 of the possible decay modes, and for each decay process we select one
 of the possible decay MCI components, calling the random-number
 generators.  We do not generate momenta, yet.
 <<Decays: decay: TBP>>=
   procedure :: select_chain => decay_select_chain
 <<Decays: procedures>>=
   recursive subroutine decay_select_chain (decay)
     class(decay_t), intent(inout) :: decay
     real(default) :: x
     integer :: i
     call decay%rng%generate (x)
     decay%selected_mci = decay%config%mci_selector%select (x)
     call decay%process_instance%choose_mci (decay%selected_mci)
     decay%selected_term = decay%process_instance%select_i_term ()
     do i = 1, size (decay%term)
        call decay%term(i)%select_chain ()
     end do
   end subroutine decay_select_chain
 
 @ %def decay_select_chain
 @ Generate a decay.  We first receive the beam momenta from the parent
 process (assuming that this is properly linked), then call the
 associated process object for a new event.
 
 Factor out the trace of the helicity density matrix of the isolated
 state (the one that will be used for the decay chain).  The trace is
 taken into account for unweighting the individual decay event and
 should therefore be ignored for unweighting the correlated decay
 chain afterwards.
 <<Decays: decay: TBP>>=
   procedure :: generate => decay_generate
 <<Decays: procedures>>=
   recursive subroutine decay_generate (decay)
     class(decay_t), intent(inout) :: decay
     type(isolated_state_t), pointer :: isolated_state
     integer :: i
     call decay%process_instance%receive_beam_momenta ()
     call decay%process_instance%generate_unweighted_event (decay%selected_mci)
     if (signal_is_pending ())  return
     call decay%process_instance%evaluate_event_data ()
     isolated_state => &
          decay%process_instance%get_isolated_state_ptr (decay%selected_term)
     call isolated_state%normalize_matrix_by_trace ()
     do i = 1, size (decay%term)
        call decay%term(i)%generate ()
        if (signal_is_pending ())  return
     end do
   end subroutine decay_generate
 
 @ %def decay_generate
 @
 \subsection{Stable Particles}
 This is a stable particle.  The flavor can be ambiguous (e.g., partons).
 <<Decays: types>>=
   type, extends (any_config_t) :: stable_config_t
      private
      type(flavor_t), dimension(:), allocatable :: flv
    contains
    <<Decays: stable config: TBP>>
   end type stable_config_t
 
 @ %def stable_config_t
 @ The finalizer is empty:
 <<Decays: stable config: TBP>>=
   procedure :: final => stable_config_final
 <<Decays: procedures>>=
   subroutine stable_config_final (object)
     class(stable_config_t), intent(inout) :: object
   end subroutine stable_config_final
 
 @ %def stable_config_final
 @ Output.
 <<Decays: stable config: TBP>>=
   procedure :: write => stable_config_write
 <<Decays: procedures>>=
   recursive subroutine stable_config_write (object, unit, indent, verbose)
     class(stable_config_t), intent(in) :: object
     integer, intent(in), optional :: unit, indent
     logical, intent(in), optional :: verbose
     integer :: u, i, ind
     u = given_output_unit (unit)
     ind = 0;  if (present (indent))  ind = indent
     call write_indent (u, ind)
     write (u, "(1x,'+',1x,A)", advance = "no")  "Stable:"
     write (u, "(1x,A)", advance = "no")  char (object%flv(1)%get_name ())
     do i = 2, size (object%flv)
        write (u, "(':',A)", advance = "no") &
             char (object%flv(i)%get_name ())
     end do
     write (u, *)
   end subroutine stable_config_write
 
 @ %def stable_config_write
 @ Initializer.  We are presented with an array of flavors, but there may be
 double entries which we remove, so we store only the distinct flavors.
 <<Decays: stable config: TBP>>=
   procedure :: init => stable_config_init
 <<Decays: procedures>>=
   subroutine stable_config_init (config, flv)
     class(stable_config_t), intent(out) :: config
     type(flavor_t), dimension(:), intent(in) :: flv
     integer, dimension (size (flv)) :: pdg
     logical, dimension (size (flv)) :: mask
     integer :: i
     pdg = flv%get_pdg ()
     mask(1) = .true.
     forall (i = 2 : size (pdg))
        mask(i) = all (pdg(i) /= pdg(1:i-1))
     end forall
     allocate (config%flv (count (mask)))
     config%flv = pack (flv, mask)
   end subroutine stable_config_init
 
 @ %def stable_config_init
 @ Here is the corresponding object instance.  Except for the pointer
 to the configuration, there is no content.
 <<Decays: types>>=
   type, extends (any_t) :: stable_t
      private
      type(stable_config_t), pointer :: config => null ()
    contains
    <<Decays: stable: TBP>>
   end type stable_t
 
 @ %def stable_t
 @ The finalizer does nothing.
 <<Decays: stable: TBP>>=
   procedure :: final => stable_final
 <<Decays: procedures>>=
   subroutine stable_final (object)
     class(stable_t), intent(inout) :: object
   end subroutine stable_final
 
 @ %def stable_final
 @ We can delegate output to the configuration object.
 <<Decays: stable: TBP>>=
   procedure :: write => stable_write
 <<Decays: procedures>>=
   subroutine stable_write (object, unit, indent)
     class(stable_t), intent(in) :: object
     integer, intent(in), optional :: unit, indent
     call object%config%write (unit, indent)
   end subroutine stable_write
 
 @ %def stable_write
 @ Initializer: just assign the configuration.
 <<Decays: stable: TBP>>=
   procedure :: init => stable_init
 <<Decays: procedures>>=
   subroutine stable_init (stable, config)
     class(stable_t), intent(out) :: stable
     type(stable_config_t), intent(in), target :: config
     stable%config => config
   end subroutine stable_init
 
 @ %def stable_init
 @
 \subsection{Unstable Particles}
 A branching configuration enables us to select among distinct decay
 modes of a particle.  We store the particle flavor (with its implicit
 link to a model), an array of decay configurations, and a selector object.
 
 The total width, absolute and relative error are stored as
 [[integral]], [[abs_error]], and [[rel_error]], respectively.
 
 The flavor must be unique in this case.
 <<Decays: public>>=
   public :: unstable_config_t
 <<Decays: types>>=
   type, extends (any_config_t) :: unstable_config_t
      private
      type(flavor_t) :: flv
      real(default) :: integral = 0
      real(default) :: abs_error = 0
      real(default) :: rel_error = 0
      type(selector_t) :: selector
      type(decay_config_t), dimension(:), allocatable :: decay_config
    contains
    <<Decays: unstable config: TBP>>
   end type unstable_config_t
 
 @ %def unstable_config_t
 @ Finalizer.  The branching configuration can be a recursive structure.
 <<Decays: unstable config: TBP>>=
   procedure :: final => unstable_config_final
 <<Decays: procedures>>=
   recursive subroutine unstable_config_final (object)
     class(unstable_config_t), intent(inout) :: object
     integer :: i
     if (allocated (object%decay_config)) then
        do i = 1, size (object%decay_config)
           call object%decay_config(i)%final ()
        end do
     end if
   end subroutine unstable_config_final
 
 @ %def unstable_config_final
 @ Output.  Since this may be recursive, we include indentation.
 <<Decays: unstable config: TBP>>=
   procedure :: write => unstable_config_write
 <<Decays: procedures>>=
   recursive subroutine unstable_config_write (object, unit, indent, verbose)
     class(unstable_config_t), intent(in) :: object
     integer, intent(in), optional :: unit, indent
     logical, intent(in), optional :: verbose
     integer :: u, i, ind
     logical :: verb
     u = given_output_unit (unit)
     ind = 0;  if (present (indent))  ind = indent
     verb = .true.;  if (present (verbose))  verb = verbose
     call write_indent (u, ind)
     write (u, "(1x,'+',1x,A,1x,A)")  "Unstable:", &
          char (object%flv%get_name ())
     call write_indent (u, ind)
     write (u, 1)  "total width =", object%integral
     call write_indent (u, ind)
     write (u, 1)  "error (abs) =", object%abs_error
     call write_indent (u, ind)
     write (u, 1)  "error (rel) =", object%rel_error
 1   format (5x,A,ES19.12)
     if (verb .and. allocated (object%decay_config)) then
        do i = 1, size (object%decay_config)
           call object%decay_config(i)%write (u, ind + 1)
        end do
     end if
   end subroutine unstable_config_write
 
 @ %def unstable_config_write
 @ Initializer.  For the unstable particle, the flavor is unique.
 <<Decays: unstable config: TBP>>=
   procedure :: init => unstable_config_init
 <<Decays: procedures>>=
   subroutine unstable_config_init (unstable, flv, set_decays, model)
     class(unstable_config_t), intent(out) :: unstable
     type(flavor_t), intent(in) :: flv
     logical, intent(in), optional :: set_decays
     class(model_data_t), intent(in), optional, target :: model
     type(string_t), dimension(:), allocatable :: decay
     unstable%flv = flv
     if (present (set_decays)) then
        call unstable%flv%get_decays (decay)
        call unstable%init_decays (decay, model)
     end if
   end subroutine unstable_config_init
 
 @ %def unstable_config_init
 @ Further initialization: determine the number of decay modes.  We can assume
 that the flavor of the particle has been set already.
 
 If the process stack is given, we can delve recursively into actually
 assigning decay processes.  Otherwise, we just initialize with decay
 process names.
 <<Decays: unstable config: TBP>>=
   procedure :: init_decays => unstable_config_init_decays
 <<Decays: procedures>>=
   recursive subroutine unstable_config_init_decays &
        (unstable, decay_id, model, process_stack, var_list)
     class(unstable_config_t), intent(inout) :: unstable
     type(string_t), dimension(:), intent(in) :: decay_id
     class(model_data_t), intent(in), target :: model
     type(process_stack_t), intent(in), optional :: process_stack
     type(var_list_t), intent(in), optional :: var_list
     integer :: i
     allocate (unstable%decay_config (size (decay_id)))
     do i = 1, size (decay_id)
        associate (decay => unstable%decay_config(i))
          if (present (process_stack)) then
             call decay%connect (process_stack%get_process_ptr (decay_id(i)), &
                  model, process_stack, var_list=var_list)
          else
             call decay%init (model, decay_id(i))
          end if
          call decay%set_flv (unstable%flv)
        end associate
     end do
   end subroutine unstable_config_init_decays
 
 @ %def unstable_config_init
 @ Explicitly connect a specific decay with a process.  This is used only in
 unit tests.
 <<Decays: unstable config: TBP>>=
   procedure :: connect_decay => unstable_config_connect_decay
 <<Decays: procedures>>=
   subroutine unstable_config_connect_decay (unstable, i, process, model)
     class(unstable_config_t), intent(inout) :: unstable
     integer, intent(in) :: i
     type(process_t), intent(in), target :: process
     class(model_data_t), intent(in), target :: model
     associate (decay => unstable%decay_config(i))
       call decay%connect (process, model)
     end associate
   end subroutine unstable_config_connect_decay
 
 @ %def unstable_config_connect_decay
 @ Compute the total width and branching ratios, initializing the decay
 selector.
 <<Decays: unstable config: TBP>>=
   procedure :: compute => unstable_config_compute
 <<Decays: procedures>>=
   recursive subroutine unstable_config_compute (unstable)
     class(unstable_config_t), intent(inout) :: unstable
     integer :: i
     do i = 1, size (unstable%decay_config)
        call unstable%decay_config(i)%compute ()
     end do
     unstable%integral = sum (unstable%decay_config%integral)
     if (unstable%integral <= 0) then
        call unstable%write ()
        call msg_fatal ("Decay configuration: computed total width is zero")
     end if
     unstable%abs_error = sqrt (sum (unstable%decay_config%abs_error ** 2))
     unstable%rel_error = unstable%abs_error / unstable%integral
     call unstable%selector%init (unstable%decay_config%integral)
     do i = 1, size (unstable%decay_config)
        unstable%decay_config(i)%weight &
             = unstable%selector%get_weight (i)
     end do
   end subroutine unstable_config_compute
 
 @ %def unstable_config_compute
 @
 Now we define the instance of an unstable particle.
 <<Decays: public>>=
   public :: unstable_t
 <<Decays: types>>=
   type, extends (any_t) :: unstable_t
      private
      type(unstable_config_t), pointer :: config => null ()
      class(rng_t), allocatable :: rng
      integer :: selected_decay = 0
      type(decay_t), dimension(:), allocatable :: decay
    contains
    <<Decays: unstable: TBP>>
   end type unstable_t
 
 @ %def unstable_t
 @ Recursive finalizer.
 <<Decays: unstable: TBP>>=
   procedure :: final => unstable_final
 <<Decays: procedures>>=
   recursive subroutine unstable_final (object)
     class(unstable_t), intent(inout) :: object
     integer :: i
     if (allocated (object%decay)) then
        do i = 1, size (object%decay)
           call object%decay(i)%final ()
        end do
     end if
   end subroutine unstable_final
 
 @ %def unstable_final
 @ Output.
 <<Decays: unstable: TBP>>=
   procedure :: write => unstable_write
 <<Decays: procedures>>=
   recursive subroutine unstable_write (object, unit, indent)
     class(unstable_t), intent(in) :: object
     integer, intent(in), optional :: unit, indent
     integer :: u, ind
     u = given_output_unit (unit)
     ind = 0;  if (present (indent))  ind = indent
     call object%config%write (u, ind, verbose=.false.)
     if (allocated (object%rng)) then
        call object%rng%write (u, ind + 2)
     end if
     call write_indent (u, ind)
     if (object%selected_decay > 0) then
        write (u, "(5x,A,I0)") "Sel. decay  = ", object%selected_decay
        call object%decay(object%selected_decay)%write (u, ind + 1)
     else
        write (u, "(5x,A)")  "Sel. decay  = [undefined]"
     end if
   end subroutine unstable_write
 
 @ %def unstable_write
 @ Write the embedded process instances.
 <<Decays: unstable: TBP>>=
   procedure :: write_process_instances => unstable_write_process_instances
 <<Decays: procedures>>=
   recursive subroutine unstable_write_process_instances &
        (unstable, unit, verbose)
     class(unstable_t), intent(in) :: unstable
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     if (unstable%selected_decay > 0) then
        call unstable%decay(unstable%selected_decay)% &
             write_process_instances (unit, verbose)
     end if
   end subroutine unstable_write_process_instances
 
 @ %def unstable_write_process_instances
 @ Initialization, using the configuration object.
 <<Decays: unstable: TBP>>=
   procedure :: init => unstable_init
 <<Decays: procedures>>=
   recursive subroutine unstable_init (unstable, config)
     class(unstable_t), intent(out) :: unstable
     type(unstable_config_t), intent(in), target :: config
     integer :: i
     unstable%config => config
     allocate (unstable%decay (size (config%decay_config)))
     do i = 1, size (config%decay_config)
        call unstable%decay(i)%init (config%decay_config(i))
     end do
   end subroutine unstable_init
 
 @ %def unstable_init
 @ Recursively link interactions to the parent process.  [[i_prt]] is
 the index of the current outgoing particle in the parent interaction.
 <<Decays: unstable: TBP>>=
   procedure :: link_interactions => unstable_link_interactions
 <<Decays: procedures>>=
   recursive subroutine unstable_link_interactions (unstable, i_prt, trace)
     class(unstable_t), intent(inout) :: unstable
     integer, intent(in) :: i_prt
     type(interaction_t), intent(in), target :: trace
     integer :: i
     do i = 1, size (unstable%decay)
        call unstable%decay(i)%link_interactions (i_prt, trace)
     end do
   end subroutine unstable_link_interactions
 
 @ %def unstable_link_interactions
 @ Import the random-number generator state.
 <<Decays: unstable: TBP>>=
   procedure :: import_rng => unstable_import_rng
 <<Decays: procedures>>=
   subroutine unstable_import_rng (unstable, rng)
     class(unstable_t), intent(inout) :: unstable
     class(rng_t), intent(inout), allocatable :: rng
     call move_alloc (from = rng, to = unstable%rng)
   end subroutine unstable_import_rng
 
 @ %def unstable_import_rng
 @ Generate a decay chain.  First select a decay mode, then call the
 [[select_chain]] method of the selected mode.
 <<Decays: unstable: TBP>>=
   procedure :: select_chain => unstable_select_chain
 <<Decays: procedures>>=
   recursive subroutine unstable_select_chain (unstable)
     class(unstable_t), intent(inout) :: unstable
     real(default) :: x
     call unstable%rng%generate (x)
     unstable%selected_decay = unstable%config%selector%select (x)
     call unstable%decay(unstable%selected_decay)%select_chain ()
   end subroutine unstable_select_chain
 
 @ %def unstable_select_chain
 @ Generate a decay event.
 <<Decays: unstable: TBP>>=
   procedure :: generate => unstable_generate
 <<Decays: procedures>>=
   recursive subroutine unstable_generate (unstable)
     class(unstable_t), intent(inout) :: unstable
     call unstable%decay(unstable%selected_decay)%generate ()
   end subroutine unstable_generate
 
 @ %def unstable_generate
 @
 \subsection{Decay Chain}
 While the decay configuration tree and the decay tree are static
 entities (during a simulation run), the decay chain is dynamically
 generated for each event.  The reason is that with the possibility of
 several decay modes for each particle, and several terms for each
 process, the total number of distinct decay chains is not under control.
 
 Each entry in the decay chain is a connected parton state.  The origin
 of the chain is a connected state in the parent process (not part of
 the chain itself).  For each decay, mode and term chosen, we convolute
 this with the isolated (!) state of the current decay, to generate a
 new connected state.  We accumulate this chain by recursively
 traversing the allocated decay tree.  Whenever a particle decays, it
 becomes virtual and is replaced by its decay product, while all other
 particles stay in the parton state as spectators.
 
 Technically, we implement the decay chain as a stack structure and
 include information from the associated decay object for easier
 debugging.  This is a decay chain entry:
 <<Decays: types>>=
   type, extends (connected_state_t) :: decay_chain_entry_t
      private
      integer :: index = 0
      type(decay_config_t), pointer :: config => null ()
      integer :: selected_mci = 0
      integer :: selected_term = 0
      type(decay_chain_entry_t), pointer :: previous => null ()
   end type decay_chain_entry_t
 
 @ %def decay_chain_entry_t
 @ This is the complete chain; we need just a pointer to the last
 entry.  We also include a pointer to the master process instance,
 which serves as the seed for the decay chain.
 
 The evaluator [[correlated_trace]] traces over all quantum numbers
 for the final spin-correlated (but color-summed) evaluator of the
 decay chain.  This allows us to compute the probability for a momentum
 configuration, given that all individual density matrices (of the
 initial process and the subsequent decays) have been normalized to one.
 
 Note: This trace is summed over color, so color is treated exactly
 when computing spin correlations.  However, we do not keep
 non-diagonal color correlations.  When an event is accepted, we
 compute probabilities for all color states and can choose one of them.
 <<Decays: public>>=
   public :: decay_chain_t
 <<Decays: types>>=
   type :: decay_chain_t
      private
      type(process_instance_t), pointer :: process_instance => null ()
      integer :: selected_term = 0
      type(evaluator_t) :: correlated_trace
      type(decay_chain_entry_t), pointer :: last => null ()
    contains
    <<Decays: decay chain: TBP>>
   end type decay_chain_t
 
 @ %def decay_chain_t
 @ The finalizer recursively deletes and deallocates the entries.
 <<Decays: decay chain: TBP>>=
   procedure :: final => decay_chain_final
 <<Decays: procedures>>=
   subroutine decay_chain_final (object)
     class(decay_chain_t), intent(inout) :: object
     type(decay_chain_entry_t), pointer :: entry
     do while (associated (object%last))
        entry => object%last
        object%last => entry%previous
        call entry%final ()
        deallocate (entry)
     end do
     call object%correlated_trace%final ()
   end subroutine decay_chain_final
 
 @ %def decay_chain_final
 @ Doing output recursively allows us to display the chain in
 chronological order.
 <<Decays: decay chain: TBP>>=
   procedure :: write => decay_chain_write
 <<Decays: procedures>>=
   subroutine decay_chain_write (object, unit)
     class(decay_chain_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call write_separator (u, 2)
     write (u, "(1x,A)")  "Decay chain:"
     call write_entries (object%last)
     call write_separator (u, 2)
     write (u, "(1x,A)")  "Evaluator (correlated trace of the decay chain):"
     call write_separator (u)
     call object%correlated_trace%write (u)
     call write_separator (u, 2)
   contains
     recursive subroutine write_entries (entry)
       type(decay_chain_entry_t), intent(in), pointer :: entry
       if (associated (entry)) then
          call write_entries (entry%previous)
          call write_separator (u, 2)
          write (u, "(1x,A,I0)")  "Decay #", entry%index
          call entry%config%write_header (u)
          write (u, "(3x,A,I0)")  "Selected MCI    = ", entry%selected_mci
          write (u, "(3x,A,I0)")  "Selected term   = ", entry%selected_term
          call entry%config%term_config(entry%selected_term)%write (u, indent=1)
          call entry%write (u)
       end if
     end subroutine write_entries
   end subroutine decay_chain_write
 
 @ %def decay_chain_write
 @
 Build a decay chain, recursively following the selected decays and
 terms in a decay tree.  Before start, we finalize the chain, deleting
 any previous contents.
 <<Decays: decay chain: TBP>>=
   procedure :: build => decay_chain_build
 <<Decays: procedures>>=
   subroutine decay_chain_build (chain, decay_root)
     class(decay_chain_t), intent(inout), target :: chain
     type(decay_root_t), intent(in) :: decay_root
     type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
     type(interaction_t), pointer :: int_last_decay
     call chain%final ()
     if (decay_root%selected_term > 0) then
        chain%process_instance => decay_root%process_instance
        chain%selected_term = decay_root%selected_term
        call chain%build_term_entries (decay_root%term(decay_root%selected_term))
     end if
     int_last_decay => chain%last%get_matrix_int_ptr ()
     allocate (qn_mask (int_last_decay%get_n_tot ()))
     call qn_mask%init (mask_f = .true., mask_c = .true., mask_h = .true.)
     call chain%correlated_trace%init_qn_sum (int_last_decay, qn_mask)
   end subroutine decay_chain_build
 
 @ %def decay_chain_build
 @ Build the entries that correspond to a decay term.  We have to scan
 all unstable particles.
 <<Decays: decay chain: TBP>>=
   procedure :: build_term_entries => decay_chain_build_term_entries
 <<Decays: procedures>>=
   recursive subroutine decay_chain_build_term_entries (chain, term)
     class(decay_chain_t), intent(inout) :: chain
     type(decay_term_t), intent(in) :: term
     integer :: i
     do i = 1, size (term%particle_out)
        select type (unstable => term%particle_out(i)%c)
        type is (unstable_t)
           if (unstable%selected_decay > 0) then
              call chain%build_decay_entries &
                   (unstable%decay(unstable%selected_decay))
           end if
        end select
     end do
   end subroutine decay_chain_build_term_entries
 
 @ %def decay_chain_build_term_entries
 @ Build the entries that correspond to a specific decay.  The
 decay term should have been determined, so we allocate a decay chain
 entry and fill it, then proceed to child decays.
 
 For the first entry, we convolute the connected state of the parent process
 instance with the isolated state of the current
 decay (which does not contain an extra beam entry for the parent).
 For subsequent entries, we take the previous entry as first factor.
 
 In principle, each chain entry (as a parton state) is capable of
 holding a subevent object and associated expressions.  We currently do
 not make use of that feature.
 
 Before generating the decays, factor out the trace of the helicity
 density matrix of the parent parton state.  This trace has
 been used for unweighting the original event (unweighted case) or it
 determines the overall weight, so it should not be taken into account
 in the decay chain generation.
 <<Decays: decay chain: TBP>>=
   procedure :: build_decay_entries => decay_chain_build_decay_entries
 <<Decays: procedures>>=
   recursive subroutine decay_chain_build_decay_entries (chain, decay)
     class(decay_chain_t), intent(inout) :: chain
     type(decay_t), intent(in) :: decay
     type(decay_chain_entry_t), pointer :: entry
     type(connected_state_t), pointer :: previous_state
     type(isolated_state_t), pointer :: current_decay
     type(helicity_t) :: hel
     type(quantum_numbers_t) :: qn_filter_conn
     allocate (entry)
     if (associated (chain%last)) then
        entry%previous => chain%last
        entry%index = entry%previous%index + 1
        previous_state => entry%previous%connected_state_t
     else
        entry%index = 1
        previous_state => &
             chain%process_instance%get_connected_state_ptr (chain%selected_term)
     end if
     entry%config => decay%config
     entry%selected_mci = decay%selected_mci
     entry%selected_term = decay%selected_term
     current_decay => decay%process_instance%get_isolated_state_ptr &
          (decay%selected_term)
     call entry%setup_connected_trace &
          (current_decay, previous_state%get_trace_int_ptr (), resonant=.true.)
     if (entry%config%flv%has_decay_helicity ()) then
        call hel%init (entry%config%flv%get_decay_helicity ())
        call qn_filter_conn%init (hel)
        call entry%setup_connected_matrix &
             (current_decay, previous_state%get_matrix_int_ptr (), &
             resonant=.true., qn_filter_conn = qn_filter_conn)
        call entry%setup_connected_flows &
             (current_decay, previous_state%get_flows_int_ptr (), &
             resonant=.true., qn_filter_conn = qn_filter_conn)
     else
        call entry%setup_connected_matrix &
             (current_decay, previous_state%get_matrix_int_ptr (), &
             resonant=.true.)
        call entry%setup_connected_flows &
             (current_decay, previous_state%get_flows_int_ptr (), &
             resonant=.true.)
     end if
     chain%last => entry
     call chain%build_term_entries (decay%term(decay%selected_term))
   end subroutine decay_chain_build_decay_entries
 
 @ %def decay_chain_build_decay_entries
 @ Recursively fill the decay chain with momenta and evaluate the
 matrix elements.  Since all evaluators should have correct source
 entries at this point, momenta are automatically retrieved from the
 appropriate process instance.
 
 
 Like we did above for the parent process, factor out the trace for
 each subsequent decay (the helicity density matrix in the isolated
 state, which is taken for the convolution).
 <<Decays: decay chain: TBP>>=
   procedure :: evaluate => decay_chain_evaluate
 <<Decays: procedures>>=
   subroutine decay_chain_evaluate (chain)
     class(decay_chain_t), intent(inout) :: chain
     call evaluate (chain%last)
     call chain%correlated_trace%receive_momenta ()
     call chain%correlated_trace%evaluate ()
   contains
     recursive subroutine evaluate (entry)
       type(decay_chain_entry_t), intent(inout), pointer :: entry
       if (associated (entry)) then
          call evaluate (entry%previous)
          call entry%receive_kinematics ()
          call entry%evaluate_trace ()
          call entry%evaluate_event_data ()
       end if
     end subroutine evaluate
   end subroutine decay_chain_evaluate
 
 @ %def decay_chain_evaluate
 @ Return the probability of a decay chain.  This is given as the trace
 of the density matrix with intermediate helicity correlations,
 normalized by the product of the uncorrelated density matrix traces.  This
 works only if an event has been evaluated and the [[correlated_trace]]
 evaluator is filled.  By definition, this evaluator has only one
 matrix element, and this must be real.
 <<Decays: decay chain: TBP>>=
   procedure :: get_probability => decay_chain_get_probability
 <<Decays: procedures>>=
   function decay_chain_get_probability (chain) result (x)
     class(decay_chain_t), intent(in) :: chain
     real(default) :: x
     x = real (chain%correlated_trace%get_matrix_element (1))
   end function decay_chain_get_probability
 
 @ %def decay_chain_get_probability
 @
 \subsection{Decay as Event Transform}
 The [[evt_decay]] object combines decay configuration, decay tree, and
 chain in a single object, as an implementation of the [[evt]] (event
 transform) abstract type.
 
 The [[var_list]] may be a pointer to the user variable list, which
 could contain overridden parameters for the decay processes.
 <<Decays: public>>=
   public :: evt_decay_t
 <<Decays: types>>=
   type, extends (evt_t) :: evt_decay_t
      private
      type(decay_root_config_t) :: decay_root_config
      type(decay_root_t) :: decay_root
      type(decay_chain_t) :: decay_chain
      type(var_list_t), pointer :: var_list => null ()
    contains
    <<Decays: evt decay: TBP>>
   end type evt_decay_t
 
 @ %def evt_decay_t
 @
 <<Decays: evt decay: TBP>>=
   procedure :: write_name => evt_decay_write_name
 <<Decays: procedures>>=
   subroutine evt_decay_write_name (evt, unit)
     class(evt_decay_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event transform: partonic decays"
   end subroutine evt_decay_write_name
 
 @ %def evt_decay_write_name
 @ Output.  We display the currently selected decay tree, which
 includes configuration data, and the decay chain, i.e., the evaluators.
 <<Decays: evt decay: TBP>>=
   procedure :: write => evt_decay_write
 <<Decays: procedures>>=
   subroutine evt_decay_write (evt, unit, verbose, more_verbose, testflag)
     class(evt_decay_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose, more_verbose, testflag
     logical :: verb, verb2
     integer :: u
     u = given_output_unit (unit)
     verb = .true.;  if (present (verbose))  verb = verbose
     verb2 = .false.;  if (present (more_verbose))  verb2 = more_verbose
     call write_separator (u, 2)
     call evt%write_name (u)
     call write_separator (u, 2)
     call evt%base_write (u, testflag = testflag)
     if (associated (evt%var_list)) then
        call write_separator (u)
        write (u, "(1x,A)")  "Variable list for simulation: &
             &[associated, not shown]"
     end if
     if (verb) then
        call write_separator (u)
        call evt%decay_root%write (u)
        if (verb2) then
           call evt%decay_chain%write (u)
           call evt%decay_root%write_process_instances (u, verb)
        end if
     else
        call write_separator (u, 2)
     end if
   end subroutine evt_decay_write
 
 @ %def evt_decay_write
 @ Set the pointer to a user variable list.
 <<Decays: evt decay: TBP>>=
   procedure :: set_var_list => evt_decay_set_var_list
 <<Decays: procedures>>=
   subroutine evt_decay_set_var_list (evt, var_list)
     class(evt_decay_t), intent(inout) :: evt
     type(var_list_t), intent(in), target :: var_list
     evt%var_list => var_list
   end subroutine evt_decay_set_var_list
   
 @ %def evt_decay_set_var_list
 @ Connect with a process instance and process.  This initializes the
 decay configuration.  The process stack is used to look for process
 objects that implement daughter decays.
 
 When all processes are assigned, configure the decay tree instance, using the
 decay tree configuration.  First obtain the branching ratios, then allocate
 the decay tree.  This is done once for all events.
 <<Decays: evt decay: TBP>>=
   procedure :: connect => evt_decay_connect
 <<Decays: procedures>>=
   subroutine evt_decay_connect (evt, process_instance, model, process_stack)
     class(evt_decay_t), intent(inout), target :: evt
     type(process_instance_t), intent(in), target :: process_instance
     class(model_data_t), intent(in), target :: model
     type(process_stack_t), intent(in), optional :: process_stack
     call evt%base_connect (process_instance, model)
     if (associated (evt%var_list)) then
        call evt%decay_root_config%connect (process_instance%process, &
             model, process_stack, process_instance, evt%var_list)
     else
        call evt%decay_root_config%connect (process_instance%process, &
             model, process_stack, process_instance)
     end if
     call evt%decay_root_config%compute ()
     call evt%decay_root%init (evt%decay_root_config, evt%process_instance)
   end subroutine evt_decay_connect
 
 @ %def evt_decay_connect
 @ Prepare a new event: Select a decay chain and build the corresponding chain
 object.
 <<Decays: evt decay: TBP>>=
   procedure :: prepare_new_event => evt_decay_prepare_new_event
 <<Decays: procedures>>=
   subroutine evt_decay_prepare_new_event (evt, i_mci, i_term)
     class(evt_decay_t), intent(inout) :: evt
     integer, intent(in) :: i_mci, i_term
     call evt%reset ()
     evt%decay_root%selected_mci = i_mci
     evt%decay_root%selected_term = i_term
     call evt%decay_root%select_chain ()
     call evt%decay_chain%build (evt%decay_root)
   end subroutine evt_decay_prepare_new_event
 
 @ %def evt_decay_prepare_new_event
 @ Generate a weighted event and assign the resulting weight
 (probability).  We use a chain initialized by the preceding
 subroutine, fill it with momenta and evaluate.
 <<Decays: evt decay: TBP>>=
   procedure :: generate_weighted => evt_decay_generate_weighted
 <<Decays: procedures>>=
   subroutine evt_decay_generate_weighted (evt, probability)
     class(evt_decay_t), intent(inout) :: evt
     real(default), intent(inout) :: probability
     call evt%decay_root%generate ()
     if (signal_is_pending ())  return
     call evt%decay_chain%evaluate ()
     probability = evt%decay_chain%get_probability ()
   end subroutine evt_decay_generate_weighted
 
 @ %def evt_decay_generate_weighted
 @ To create a usable event, we have to transform the interaction into a
 particle set; this requires factorization for the correlated density matrix,
 according to the factorization mode.
 <<Decays: evt decay: TBP>>=
   procedure :: make_particle_set => evt_decay_make_particle_set
 <<Decays: procedures>>=
   subroutine evt_decay_make_particle_set &
        (evt, factorization_mode, keep_correlations, r)
     class(evt_decay_t), intent(inout) :: evt
     integer, intent(in) :: factorization_mode
     logical, intent(in) :: keep_correlations
     real(default), dimension(:), intent(in), optional :: r
     type(interaction_t), pointer :: int_matrix, int_flows
     type(decay_chain_entry_t), pointer :: last_entry
     last_entry => evt%decay_chain%last
     int_matrix => last_entry%get_matrix_int_ptr ()
     int_flows  => last_entry%get_flows_int_ptr ()
     call evt%factorize_interactions (int_matrix, int_flows, &
          factorization_mode, keep_correlations, r)
     call evt%tag_incoming ()
   end subroutine evt_decay_make_particle_set
 
 @ %def event_decay_make_particle_set
 @
 \subsubsection{Auxiliary}
 Eliminate numerical noise for the associated process instances.
 <<Decays: public>>=
   public :: pacify
 <<Decays: interfaces>>=
   interface pacify
      module procedure pacify_decay
      module procedure pacify_decay_gen
      module procedure pacify_term
      module procedure pacify_unstable
   end interface pacify
 <<Decays: procedures>>=
   subroutine pacify_decay (evt)
     class(evt_decay_t), intent(inout) :: evt
     call pacify_decay_gen (evt%decay_root)
   end subroutine pacify_decay
 
   recursive subroutine pacify_decay_gen (decay)
     class(decay_gen_t), intent(inout) :: decay
     if (associated (decay%process_instance)) then
        call pacify (decay%process_instance)
     end if
     if (decay%selected_term > 0) then
        call pacify_term (decay%term(decay%selected_term))
     end if
   end subroutine pacify_decay_gen
 
   recursive subroutine pacify_term (term)
     class(decay_term_t), intent(inout) :: term
     integer :: i
     do i = 1, size (term%particle_out)
        select type (unstable => term%particle_out(i)%c)
        type is (unstable_t);  call pacify_unstable (unstable)
        end select
     end do
   end subroutine pacify_term
 
   recursive subroutine pacify_unstable (unstable)
     class(unstable_t), intent(inout) :: unstable
     if (unstable%selected_decay > 0) then
        call pacify_decay_gen (unstable%decay(unstable%selected_decay))
     end if
   end subroutine pacify_unstable
 
 @ %def pacify
 @ Prepare specific configurations for use in unit tests.
 <<Decays: unstable config: TBP>>=
   procedure :: init_test_case1
   procedure :: init_test_case2
 <<Decays: procedures>>=
   subroutine init_test_case1 (unstable, i, flv, integral, relerr, model)
     class(unstable_config_t), intent(inout) :: unstable
     integer, intent(in) :: i
     type(flavor_t), dimension(:,:), intent(in) :: flv
     real(default), intent(in) :: integral
     real(default), intent(in) :: relerr
     class(model_data_t), intent(in), target :: model
     associate (decay => unstable%decay_config(i))
       allocate (decay%term_config (1))
       call decay%init_term (1, flv, stable = [.true., .true.], model=model)
       decay%integral = integral
       decay%abs_error = integral * relerr
     end associate
   end subroutine init_test_case1
 
   subroutine init_test_case2 (unstable, flv1, flv21, flv22, model)
     class(unstable_config_t), intent(inout) :: unstable
     type(flavor_t), dimension(:,:), intent(in) :: flv1, flv21, flv22
     class(model_data_t), intent(in), target :: model
     associate (decay => unstable%decay_config(1))
       decay%integral = 1.e-3_default
       decay%abs_error = decay%integral * .01_default
 
       allocate (decay%term_config (1))
       call decay%init_term (1, flv1, stable = [.false., .true.], model=model)
 
       select type (w => decay%term_config(1)%prt(1)%c)
       type is (unstable_config_t)
 
          associate (w_decay => w%decay_config(1))
            w_decay%integral = 2._default
            allocate (w_decay%term_config (1))
            call w_decay%init_term (1, flv21, stable = [.true., .true.], &
                 model=model)
          end associate
          associate (w_decay => w%decay_config(2))
            w_decay%integral = 1._default
            allocate (w_decay%term_config (1))
            call w_decay%init_term (1, flv22, stable = [.true., .true.], &
                 model=model)
          end associate
          call w%compute ()
 
       end select
     end associate
   end subroutine init_test_case2
 
 @ %def init_test_case1
 @ %def init_test_case2
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[decays_ut.f90]]>>=
 <<File header>>
 
 module decays_ut
   use unit_tests
   use decays_uti
 
 <<Standard module head>>
 
 <<Decays: public test>>
 
 <<Decays: public test auxiliary>>
 
 contains
 
 <<Decays: test driver>>
 
 end module decays_ut
 @ %def decays_ut
 @
 <<[[decays_uti.f90]]>>=
 <<File header>>
 
 module decays_uti
 
 <<Use kinds>>
 <<Use strings>>
   use os_interface
   use sm_qcd
   use model_data
   use models
   use state_matrices, only: FM_IGNORE_HELICITY
   use interactions, only: reset_interaction_counter
   use flavors
   use process_libraries
   use rng_base
   use mci_base
   use mci_midpoint
   use phs_base
   use phs_single
   use prc_core
   use prc_test, only: prc_test_create_library
   use process, only: process_t
   use instances, only: process_instance_t
   use process_stacks
 
   use decays
 
   use rng_base_ut, only: rng_test_t, rng_test_factory_t
 
 <<Standard module head>>
 
 <<Decays: public test auxiliary>>
 
 <<Decays: test declarations>>
 
 contains
 
 <<Decays: tests>>
 
 <<Decays: test auxiliary>>
 
 end module decays_uti
 
 @ %def decays_uti
 @ API: driver for the unit tests below.
 <<Decays: public test>>=
   public :: decays_test
 <<Decays: test driver>>=
   subroutine decays_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Decays: execute tests>>
   end subroutine decays_test
 
 @ %def decays_test
 @
 \subsubsection{Testbed}
 As a variation of the [[prepare_test_process]] routine used elsewhere, we
 define here a routine that creates two processes (scattering $ss\to ss$ and
 decay $s\to f\bar f$), compiles and integrates them and prepares for event
 generation.
 <<Decays: public test auxiliary>>=
   public :: prepare_testbed
 <<Decays: test auxiliary>>=
   subroutine prepare_testbed &
        (lib, process_stack, prefix, os_data, &
         scattering, decay, decay_rest_frame)
     type(process_library_t), intent(out), target :: lib
     type(process_stack_t), intent(out) :: process_stack
     type(string_t), intent(in) :: prefix
     type(os_data_t), intent(in) :: os_data
     logical, intent(in) :: scattering, decay
     logical, intent(in), optional :: decay_rest_frame
 
     type(model_t), target :: model
     type(model_t), target :: model_copy
     type(string_t) :: libname, procname1, procname2
     type(process_entry_t), pointer :: process
     type(process_instance_t), allocatable, target :: process_instance
     class(phs_config_t), allocatable :: phs_config_template
     type(field_data_t), pointer :: field_data
     real(default) :: sqrts
 
     libname = prefix // "_lib"
     procname1 = prefix // "_p"
     procname2 = prefix // "_d"
 
     call model%init_test ()
     call model%set_par (var_str ("ff"), 0.4_default)
     call model%set_par (var_str ("mf"), &
          model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))
 
     if (scattering .and. decay) then
        field_data => model%get_field_ptr (25)
        call field_data%set (p_is_stable = .false.)
     end if
 
     call prc_test_create_library (libname, lib, &
          scattering = .true., decay = .true., &
          procname1 = procname1, procname2 = procname2)
 
     call reset_interaction_counter ()
 
     allocate (phs_single_config_t :: phs_config_template)
 
     if (scattering) then
 
        call model_copy%init (model%get_name (), &
             model%get_n_real (), &
             model%get_n_complex (), &
             model%get_n_field (), &
             model%get_n_vtx ())
        call model_copy%copy_from (model)
 
        allocate (process)
        call process%init (procname1, lib, os_data, model_copy)
        call process%setup_test_cores ()
        call process%init_components (phs_config_template)
        sqrts = 1000
        call process%setup_beams_sqrts (sqrts, i_core = 1)
        call process%configure_phs ()
        call process%setup_mci (dispatch_mci_test_midpoint)
        call process%setup_terms ()
 
        allocate (process_instance)
        call process_instance%init (process%process_t)
        call process_instance%integrate (1, n_it = 1, n_calls = 100)
        call process%final_integration (1)
        call process_instance%final ()
        deallocate (process_instance)
 
        call process%prepare_simulation (1)
        call process_stack%push (process)
     end if
 
     if (decay) then
        call model_copy%init (model%get_name (), &
             model%get_n_real (), &
             model%get_n_complex (), &
             model%get_n_field (), &
             model%get_n_vtx ())
        call model_copy%copy_from (model)
 
        allocate (process)
        call process%init (procname2, lib, os_data, model_copy)
        call process%setup_test_cores ()
        call process%init_components (phs_config_template)
        if (present (decay_rest_frame)) then
           call process%setup_beams_decay (rest_frame = decay_rest_frame, i_core = 1)
        else
           call process%setup_beams_decay (rest_frame = .not. scattering, i_core = 1)
        end if
        call process%configure_phs ()
        call process%setup_mci (dispatch_mci_test_midpoint)
        call process%setup_terms ()
 
        allocate (process_instance)
        call process_instance%init (process%process_t)
        call process_instance%integrate (1, n_it=1, n_calls=100)
        call process%final_integration (1)
        call process_instance%final ()
        deallocate (process_instance)
 
        call process%prepare_simulation (1)
        call process_stack%push (process)
     end if
 
     call model%final ()
     call model_copy%final ()
 
   end subroutine prepare_testbed
 
 @ %def prepare_testbed
 @ MCI record prepared for midpoint integrator.
 <<Decays: test auxiliary>>=
   subroutine dispatch_mci_test_midpoint (mci, var_list, process_id, is_nlo)
     use variables, only: var_list_t
     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
     allocate (mci_midpoint_t :: mci)
   end subroutine dispatch_mci_test_midpoint
  
 @ %def dispatch_mci_test_midpoint
 @
 \subsubsection{Simple decay configuration}
 We define a branching configuration with two decay modes.  We set the
 integral values by hand, so we do not need to evaluate processes, yet.
 <<Decays: execute tests>>=
   call test (decays_1, "decays_1", &
        "branching and decay configuration", &
        u, results)
 <<Decays: test declarations>>=
   public :: decays_1
 <<Decays: tests>>=
   subroutine decays_1 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(model_data_t), target :: model
     type(flavor_t) :: flv_h
     type(flavor_t), dimension(2,1) :: flv_hbb, flv_hgg
     type(unstable_config_t), allocatable :: unstable
 
     write (u, "(A)")  "* Test output: decays_1"
     write (u, "(A)")  "*   Purpose: Set up branching and decay configuration"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call os_data%init ()
     call model%init_sm_test ()
 
     call flv_h%init (25, model)
     call flv_hbb(:,1)%init ([5, -5], model)
     call flv_hgg(:,1)%init ([22, 22], model)
 
     write (u, "(A)")  "* Set up branching and decay"
     write (u, "(A)")
 
     allocate (unstable)
     call unstable%init (flv_h)
     call unstable%init_decays ([var_str ("h_bb"), var_str ("h_gg")], model)
 
     call unstable%init_test_case1 &
          (1, flv_hbb, 1.234e-3_default, .02_default, model)
 
     call unstable%init_test_case1 &
          (2, flv_hgg, 3.085e-4_default, .08_default, model)
 
     call unstable%compute ()
     call unstable%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call unstable%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: decays_1"
 
   end subroutine decays_1
 
 @ %def decays_1
 @
 \subsubsection{Cascade decay configuration}
 We define a branching configuration with one decay, which is followed
 by another branching.
 <<Decays: execute tests>>=
   call test (decays_2, "decays_2", &
        "cascade decay configuration", &
        u, results)
 <<Decays: test declarations>>=
   public :: decays_2
 <<Decays: tests>>=
   subroutine decays_2 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(model_data_t), target :: model
     type(flavor_t) :: flv_h, flv_wp, flv_wm
     type(flavor_t), dimension(2,1) :: flv_hww, flv_wud, flv_wen
     type(unstable_config_t), allocatable :: unstable
 
     write (u, "(A)")  "* Test output: decays_2"
     write (u, "(A)")  "*   Purpose: Set up cascade branching"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call os_data%init ()
     call model%init_sm_test ()
 
     call model%set_unstable (25, [var_str ("h_ww")])
     call model%set_unstable (24, [var_str ("w_ud"), var_str ("w_en")])
 
     call flv_h%init (25, model)
     call flv_hww(:,1)%init ([24, -24], model)
     call flv_wp%init (24, model)
     call flv_wm%init (-24, model)
     call flv_wud(:,1)%init ([2, -1], model)
     call flv_wen(:,1)%init ([-11, 12], model)
 
 
     write (u, "(A)")  "* Set up branching and decay"
     write (u, "(A)")
 
     allocate (unstable)
     call unstable%init (flv_h, set_decays=.true., model=model)
 
     call unstable%init_test_case2 (flv_hww, flv_wud, flv_wen, model)
 
     call unstable%compute ()
     call unstable%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call unstable%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: decays_2"
 
   end subroutine decays_2
 
 @ %def decays_2
 @
 \subsubsection{Decay and Process Object}
 We define a branching configuration with one decay and connect this
 with an actual process object.
 <<Decays: execute tests>>=
   call test (decays_3, "decays_3", &
        "associate process", &
        u, results)
 <<Decays: test declarations>>=
   public :: decays_3
 <<Decays: tests>>=
   subroutine decays_3 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     class(model_data_t), pointer :: model
     type(process_library_t), target :: lib
     type(string_t) :: prefix
     type(string_t) :: procname2
     type(process_stack_t) :: process_stack
     type(process_t), pointer :: process
     type(unstable_config_t), allocatable :: unstable
     type(flavor_t) :: flv
 
     write (u, "(A)")  "* Test output: decays_3"
     write (u, "(A)")  "*   Purpose: Connect a decay configuration &
          &with a process"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment and integrate process"
     write (u, "(A)")
 
     call os_data%init ()
 
     prefix = "decays_3"
     call prepare_testbed &
          (lib, process_stack, prefix, os_data, &
          scattering=.false., decay=.true., decay_rest_frame=.false.)
 
     procname2 = prefix // "_d"
     process => process_stack%get_process_ptr (procname2)
     model => process%get_model_ptr ()
     call process%write (.false., u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Set up branching and decay"
     write (u, "(A)")
 
     call flv%init (25, model)
 
     allocate (unstable)
     call unstable%init (flv)
     call unstable%init_decays ([procname2], model)
 
     write (u, "(A)")  "* Connect decay with process object"
     write (u, "(A)")
 
     call unstable%connect_decay (1, process, model)
 
     call unstable%compute ()
     call unstable%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call unstable%final ()
     call process_stack%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: decays_3"
 
   end subroutine decays_3
 
 @ %def decays_3
 @
 \subsubsection{Decay and Process Object}
 Building upon the previous test, we set up a decay instance and generate a
 decay event.
 <<Decays: execute tests>>=
   call test (decays_4, "decays_4", &
        "decay instance", &
        u, results)
 <<Decays: test declarations>>=
   public :: decays_4
 <<Decays: tests>>=
   subroutine decays_4 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     class(model_data_t), pointer :: model
     type(process_library_t), target :: lib
     type(string_t) :: prefix, procname2
     class(rng_t), allocatable :: rng
     type(process_stack_t) :: process_stack
     type(process_t), pointer :: process
     type(unstable_config_t), allocatable, target :: unstable
     type(flavor_t) :: flv
     type(unstable_t), allocatable :: instance
 
     write (u, "(A)")  "* Test output: decays_4"
     write (u, "(A)")  "*   Purpose: Create a decay process and evaluate &
          &an instance"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment, process, &
          &and decay configuration"
     write (u, "(A)")
 
     call os_data%init ()
 
     prefix = "decays_4"
     call prepare_testbed &
          (lib, process_stack, prefix, os_data, &
          scattering=.false., decay=.true., decay_rest_frame = .false.)
 
     procname2 = prefix // "_d"
     process => process_stack%get_process_ptr (procname2)
     model => process%get_model_ptr ()
 
     call flv%init (25, model)
 
     allocate (unstable)
     call unstable%init (flv)
     call unstable%init_decays ([procname2], model)
 
     call model%set_unstable (25, [procname2])
 
     call unstable%connect_decay (1, process, model)
 
     call unstable%compute ()
 
     allocate (rng_test_t :: rng)
 
     allocate (instance)
     call instance%init (unstable)
     call instance%import_rng (rng)
 
     call instance%select_chain ()
     call instance%generate ()
     call instance%write (u)
 
     write (u, *)
     call instance%write_process_instances (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call instance%final ()
     call process_stack%final ()
     call unstable%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: decays_4"
 
   end subroutine decays_4
 
 @ %def decays_4
 @
 \subsubsection{Decay with Parent Process}
 We define a scattering process $ss\to ss$ and subsequent decays $s\to f\bar
 f$.
 <<Decays: execute tests>>=
   call test (decays_5, "decays_5", &
        "parent process and decay", &
        u, results)
 <<Decays: test declarations>>=
   public :: decays_5
 <<Decays: tests>>=
   subroutine decays_5 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     class(model_data_t), pointer :: model
     type(process_library_t), target :: lib
     type(string_t) :: prefix, procname1, procname2
     type(process_stack_t) :: process_stack
     type(process_t), pointer :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(decay_root_config_t), target :: decay_root_config
     type(decay_root_t) :: decay_root
     type(decay_chain_t) :: decay_chain
 
     write (u, "(A)")  "* Test output: decays_5"
     write (u, "(A)")  "*   Purpose: Handle a process with subsequent decays"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment and parent process"
     write (u, "(A)")
 
     call os_data%init ()
 
     prefix = "decays_5"
     procname1 = prefix // "_p"
     procname2 = prefix // "_d"
     call prepare_testbed &
          (lib, process_stack, prefix, os_data, &
          scattering=.true., decay=.true.)
 
     write (u, "(A)")  "* Initialize decay process"
     write (u, "(A)")
 
     process => process_stack%get_process_ptr (procname1)
     model => process%get_model_ptr ()
     call model%set_unstable (25, [procname2])
 
     write (u, "(A)")  "* Initialize decay tree configuration"
     write (u, "(A)")
 
     call decay_root_config%connect (process, model, process_stack)
     call decay_root_config%compute ()
     call decay_root_config%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize decay tree"
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%setup_event_data ()
     call process_instance%init_simulation (1)
 
     call decay_root%init (decay_root_config, process_instance)
 
     write (u, "(A)")
     write (u, "(A)")  "* Select decay chain"
     write (u, "(A)")
 
     call decay_root%set_mci (1)
     !!! Not yet implemented; there is only one term anyway:
     ! call process_instance%select_i_term (decay_root%selected_term)
     call decay_root%set_term (1)
     call decay_root%select_chain ()
 
     call decay_chain%build (decay_root)
 
     call decay_root%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate event"
     write (u, "(A)")
 
     call process_instance%generate_unweighted_event (decay_root%get_mci ())
     call process_instance%evaluate_event_data ()
 
     call decay_root%generate ()
 
     call pacify (decay_root)
 
     write (u, "(A)")  "* Process instances"
     write (u, "(A)")
 
     call decay_root%write_process_instances (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate decay chain"
     write (u, "(A)")
 
     call decay_chain%evaluate ()
     call decay_chain%write (u)
 
     write (u, *)
     write (u, "(A,ES19.12)")  "chain probability =", &
          decay_chain%get_probability ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call decay_chain%final ()
     call decay_root%final ()
     call decay_root_config%final ()
     call process_instance%final ()
     deallocate (process_instance)
 
     call process_stack%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: decays_5"
 
   end subroutine decays_5
 
 @ %def decays_5
 @
 \subsubsection{Decay as Event Transform}
 Again, we define a scattering process $ss\to ss$ and subsequent decays
 $s\to f\bar f$.
 <<Decays: execute tests>>=
   call test (decays_6, "decays_6", &
        "evt_decay object", &
        u, results)
 <<Decays: test declarations>>=
   public :: decays_6
 <<Decays: tests>>=
   subroutine decays_6 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     class(model_data_t), pointer :: model
     type(process_library_t), target :: lib
     type(string_t) :: prefix, procname1, procname2
     type(process_stack_t) :: process_stack
     type(process_t), pointer :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(evt_decay_t), target :: evt_decay
     integer :: factorization_mode
     logical :: keep_correlations
 
     write (u, "(A)")  "* Test output: decays_6"
     write (u, "(A)")  "*   Purpose: Handle a process with subsequent decays"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment and parent process"
     write (u, "(A)")
 
     call os_data%init ()
 
     prefix = "decays_6"
     procname1 = prefix // "_p"
     procname2 = prefix // "_d"
     call prepare_testbed &
          (lib, process_stack, prefix, os_data, &
          scattering=.true., decay=.true.)
 
     write (u, "(A)")  "* Initialize decay process"
 
     process => process_stack%get_process_ptr (procname1)
     model => process%get_model_ptr ()
     call model%set_unstable (25, [procname2])
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%setup_event_data ()
     call process_instance%init_simulation (1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize decay object"
 
     call evt_decay%connect (process_instance, model, process_stack)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate scattering event"
 
     call process_instance%generate_unweighted_event (1)
     call process_instance%evaluate_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Select decay chain and generate event"
     write (u, "(A)")
 
     call evt_decay%prepare_new_event (1, 1)
     call evt_decay%generate_unweighted ()
 
     factorization_mode = FM_IGNORE_HELICITY
     keep_correlations = .false.
     call evt_decay%make_particle_set (factorization_mode, keep_correlations)
 
     call evt_decay%write (u, verbose = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_decay%final ()
     call process_instance%final ()
     deallocate (process_instance)
 
     call process_stack%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: decays_6"
 
   end subroutine decays_6
 
 @ %def decays_6
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Tau decays}
 <<[[tau_decays.f90]]>>=
 <<File header>>
 
 module tau_decays
 
 <<Use kinds>>
   use io_units
   use format_utils, only: write_separator
   use sm_qcd
   use model_data
   use models
   use event_transforms
 
 <<Standard module head>>
 
 <<Tau decays: public>>
 
 <<Tau decays: types>>
 
 contains
 
 <<Tau decays: procedures>>
 
 end module tau_decays
 @ %def tau_decays
 \subsection{Tau Decays Event Transform}
 This is the type for the tau decay event transform.
 <<Tau decays: public>>=
   public :: evt_tau_decays_t
 <<Tau decays: types>>=
   type, extends (evt_t) :: evt_tau_decays_t
      type(model_t), pointer :: model_hadrons => null()
      type(qcd_t) :: qcd
    contains
    <<Tau decays: evt tau decays: TBP>>
   end type evt_tau_decays_t
 
 @ %def evt_tau_decays_t
 <<Tau decays: evt tau decays: TBP>>=
   procedure :: write_name => evt_tau_decays_write_name
 <<Tau decays: procedures>>=
   subroutine evt_tau_decays_write_name (evt, unit)
     class(evt_tau_decays_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event transform: tau decays"
   end subroutine evt_tau_decays_write_name
 
 @ %def evt_tau_decays_write_name
 @ Output.
 <<Tau decays: evt tau decays: TBP>>=
   procedure :: write => evt_tau_decays_write
 <<Tau decays: procedures>>=
   subroutine evt_tau_decays_write (evt, unit, verbose, more_verbose, testflag)
     class(evt_tau_decays_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose, more_verbose, testflag
     integer :: u
     u = given_output_unit (unit)
     call write_separator (u, 2)
     call evt%write_name (u)
     call write_separator (u)
     call evt%base_write (u, testflag = testflag, show_set = .false.)
     if (evt%particle_set_exists)  &
          call evt%particle_set%write &
          (u, summary = .true., compressed = .true., testflag = testflag)
     call write_separator (u)
   end subroutine evt_tau_decays_write
 
 @ %def evt_tau_decays_write
 @ Here we take the particle set from the previous event transform and
 apply the tau decays. What probability should be given back, the
 product of branching ratios of the corresponding tau decays?
 <<Tau decays: evt tau decays: TBP>>=
   procedure :: generate_weighted => evt_tau_decays_generate_weighted
 <<Tau decays: procedures>>=
   subroutine evt_tau_decays_generate_weighted (evt, probability)
     class(evt_tau_decays_t), intent(inout) :: evt
     real(default), intent(inout) :: probability
     logical :: valid
     evt%particle_set = evt%previous%particle_set
     !!! To be checked or expanded
     probability = 1
     valid = .true.
     evt%particle_set_exists = valid
   end subroutine evt_tau_decays_generate_weighted
 
 @ %def evt_tau_decays_generate_weighted
 @ The factorization parameters are irrelevant.
 <<Tau decays: evt tau decays: TBP>>=
   procedure :: make_particle_set => evt_tau_decays_make_particle_set
 <<Tau decays: procedures>>=
   subroutine evt_tau_decays_make_particle_set &
        (evt, factorization_mode, keep_correlations, r)
     class(evt_tau_decays_t), intent(inout) :: evt
     integer, intent(in) :: factorization_mode
     logical, intent(in) :: keep_correlations
     real(default), dimension(:), intent(in), optional :: r
     logical :: valid
     !!! to be checked and expanded
     valid = .true.
     evt%particle_set_exists = evt%particle_set_exists .and. valid
   end subroutine evt_tau_decays_make_particle_set
 
 @ %def event_tau_decays_make_particle_set
 @
 <<Tau decays: evt tau decays: TBP>>=
   procedure :: prepare_new_event => evt_tau_decays_prepare_new_event
 <<Tau decays: procedures>>=
   subroutine evt_tau_decays_prepare_new_event (evt, i_mci, i_term)
     class(evt_tau_decays_t), intent(inout) :: evt
     integer, intent(in) :: i_mci, i_term
     call evt%reset ()
   end subroutine evt_tau_decays_prepare_new_event
 
 @ %def evt_tau_decays_prepare_new_event
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Shower}
 We might use matrix elements of LO and NLO to increase the accuracy of
 the shower in the sense of matching as well as merging.
 <<[[shower.f90]]>>=
 <<File header>>
 
 module shower
 
 <<Use kinds>>
 <<Use strings>>
 <<Use debug>>
   use io_units
   use format_utils, only: write_separator
   use system_defs, only: LF
   use os_interface
   use diagnostics
   use lorentz
   use pdf
   use subevents, only: PRT_BEAM_REMNANT, PRT_INCOMING, PRT_OUTGOING
 
   use shower_base
   use matching_base
   use powheg_matching, only: powheg_matching_t
 
   use sm_qcd
   use model_data
   use rng_base
 
   use event_transforms
   use models
   use hep_common
   use process, only: process_t
   use instances, only: process_instance_t
   use process_stacks
 
 <<Standard module head>>
 
 <<Shower: public>>
 
 <<Shower: parameters>>
 
 <<Shower: types>>
 
 contains
 
 <<Shower: procedures>>
 
 end module shower
 @ %def shower
 @
 \subsection{Configuration Parameters}
 [[POWHEG_TESTING]] allows to disable the parton shower for validation
 and testing of the POWHEG procedure.
 <<Shower: parameters>>=
   logical, parameter :: POWHEG_TESTING = .false.
 
 @ %def POWHEG_TESTING
 @
 \subsection{Event Transform}
 The event transforms can do more than mere showering.  Especially, it
 may reweight showered events to fixed-order matrix elements.  The
 [[model_hadrons]] is supposed to be the SM variant that contains all
 hadrons that can be generated in the shower.
 <<Shower: public>>=
   public :: evt_shower_t
 <<Shower: types>>=
   type, extends (evt_t) :: evt_shower_t
      class(shower_base_t), allocatable :: shower
      class(matching_t), allocatable :: matching
      type(model_t), pointer :: model_hadrons => null ()
      type(qcd_t) :: qcd
      type(pdf_data_t) :: pdf_data
      type(os_data_t) :: os_data
      logical :: is_first_event
    contains
    <<Shower: evt shower: TBP>>
   end type evt_shower_t
 
 @ %def evt_shower_t
 @
 <<Shower: evt shower: TBP>>=
   procedure :: write_name => evt_shower_write_name
 <<Shower: procedures>>=
   subroutine evt_shower_write_name (evt, unit)
     class(evt_shower_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event transform: shower"
   end subroutine evt_shower_write_name
 
 @ %def evt_shower_write_name
 @ Output.
 <<Shower: evt shower: TBP>>=
   procedure :: write => evt_shower_write
 <<Shower: procedures>>=
   subroutine evt_shower_write (evt, unit, verbose, more_verbose, testflag)
     class(evt_shower_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose, more_verbose, testflag
     integer :: u
     u = given_output_unit (unit)
     call write_separator (u, 2)
     call evt%write_name (u)
     call write_separator (u)
     call evt%base_write (u, testflag = testflag, show_set = .false.)
     if (evt%particle_set_exists)  call evt%particle_set%write &
          (u, summary = .true., compressed = .true., testflag = testflag)
     call write_separator (u)
     call evt%shower%settings%write (u)
   end subroutine evt_shower_write
 
 @ %def evt_shower_write
 <<Shower: evt shower: TBP>>=
   procedure :: connect => evt_shower_connect
 <<Shower: procedures>>=
   subroutine evt_shower_connect &
        (evt, process_instance, model, process_stack)
     class(evt_shower_t), intent(inout), target :: evt
     type(process_instance_t), intent(in), target :: process_instance
     class(model_data_t), intent(in), target :: model
     type(process_stack_t), intent(in), optional :: process_stack
     call evt%base_connect (process_instance, model, process_stack)
     call evt%make_rng (evt%process)
     if (allocated (evt%matching)) then
        call evt%matching%connect (process_instance, model, evt%shower)
     end if
   end subroutine evt_shower_connect
 
 @ %def evt_shower_connect
 @ Initialize the event transformation.  This will be executed once
 during dispatching.  The [[model_hadrons]] is supposed to be the SM
 variant that contains all hadrons that may be generated in the
 shower.
 <<Shower: evt shower: TBP>>=
   procedure :: init => evt_shower_init
 <<Shower: procedures>>=
   subroutine evt_shower_init (evt, model_hadrons, os_data)
     class(evt_shower_t), intent(out) :: evt
     type(model_t), intent(in), target :: model_hadrons
     type(os_data_t), intent(in) :: os_data
     evt%os_data = os_data
     evt%model_hadrons => model_hadrons
     evt%is_first_event = .true.
   end subroutine evt_shower_init
 
 @ %def evt_shower_init
 @ Create RNG instances, spawned by the process object.
 <<Shower: evt shower: TBP>>=
   procedure :: make_rng => evt_shower_make_rng
 <<Shower: procedures>>=
   subroutine evt_shower_make_rng (evt, process)
     class(evt_shower_t), intent(inout) :: evt
     type(process_t), intent(inout) :: process
     class(rng_t), allocatable :: rng
     call process%make_rng (rng)
     call evt%shower%import_rng (rng)
     if (allocated (evt%matching)) then
        call process%make_rng (rng)
        call evt%matching%import_rng (rng)
     end if
   end subroutine evt_shower_make_rng
 
 @ %def evt_shower_make_rng
 @ Things we want to do for a new event before the whole event
 transformation chain is evaluated.
 <<Shower: evt shower: TBP>>=
   procedure :: prepare_new_event => evt_shower_prepare_new_event
 <<Shower: procedures>>=
   subroutine evt_shower_prepare_new_event (evt, i_mci, i_term)
     class(evt_shower_t), intent(inout) :: evt
     integer, intent(in) :: i_mci, i_term
     real(default) :: fac_scale, alpha_s
     fac_scale = evt%process_instance%get_fac_scale (i_term)
     alpha_s = evt%process_instance%get_alpha_s (i_term)
     call evt%reset ()
     call evt%shower%prepare_new_event (fac_scale, alpha_s)
   end subroutine evt_shower_prepare_new_event
 
 @ %def evt_shower_prepare_new_event
 @
 <<Shower: evt shower: TBP>>=
   procedure :: first_event => evt_shower_first_event
 <<Shower: procedures>>=
   subroutine evt_shower_first_event (evt)
     class(evt_shower_t), intent(inout) :: evt
     double precision :: pdftest
     if (debug_on) call msg_debug (D_TRANSFORMS, "evt_shower_first_event")
     associate (settings => evt%shower%settings)
        settings%hadron_collision = .false.
        !!! !!! !!! Workaround for PGF90 v16.1
        !!! if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () <= 39)) then
        if (evt%particle_set%prt(1)%flv%get_pdg_abs () <= 39 .and. &
            evt%particle_set%prt(2)%flv%get_pdg_abs () <= 39) then
           settings%hadron_collision = .false.
        !!! else if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () >= 100)) then
        else if (evt%particle_set%prt(1)%flv%get_pdg_abs () >= 100 .and. &
                 evt%particle_set%prt(2)%flv%get_pdg_abs () >= 100) then
           settings%hadron_collision = .true.
        else
           call msg_fatal ("evt_shower didn't recognize beams setup")
        end if
        if (debug_on) call msg_debug (D_TRANSFORMS, "hadron_collision", settings%hadron_collision)
        if (allocated (evt%matching)) then
           evt%matching%is_hadron_collision = settings%hadron_collision
           call evt%matching%first_event ()
        end if
        if (.not. settings%hadron_collision .and. settings%isr_active) then
           call msg_fatal ("?ps_isr_active is only intended for hadron-collisions")
        end if
        if (evt%pdf_data%type == STRF_LHAPDF5) then
           if (settings%isr_active .and. settings%hadron_collision) then
              call GetQ2max (0, pdftest)
              if (pdftest < epsilon (pdftest)) then
                 call msg_bug ("ISR QCD shower enabled, but LHAPDF not " // &
                      "initialized," // LF // "     aborting simulation")
                 return
              end if
           end if
        else if (evt%pdf_data%type == STRF_PDF_BUILTIN .and. &
                 settings%method == PS_PYTHIA6) then
           call msg_fatal ("Builtin PDFs cannot be used for PYTHIA showers," &
                // LF // "     aborting simulation")
           return
        end if
     end associate
     evt%is_first_event = .false.
   end subroutine evt_shower_first_event
 
 @ %def evt_shower_first_event
 @ Here we take the particle set from the previous event transform
 (assuming that there is always one) and apply the shower algorithm.  The
 result is stored in the event transform of the current object.  We
 always return a probability of unity as we don't have the analytic
 weight of the combination of shower, MLM matching and hadronization.  A
 subdivision into multiple event transformations is under construction.
 Invalid or vetoed events have to be discarded by the caller which is why
 we mark the particle set as invalid. This procedure directly takes the
 (MLM) matching into account.
 <<Shower: evt shower: TBP>>=
   procedure :: generate_weighted => evt_shower_generate_weighted
 <<Shower: procedures>>=
   subroutine evt_shower_generate_weighted (evt, probability)
     class(evt_shower_t), intent(inout) :: evt
     real(default), intent(inout) :: probability
     logical :: valid, vetoed
     if (debug_on) call msg_debug (D_TRANSFORMS, "evt_shower_generate_weighted")
     if (signal_is_pending ())  return
     evt%particle_set = evt%previous%particle_set
     valid = .true.;  vetoed = .false.
     if (evt%is_first_event)  call evt%first_event ()
     call evt%shower%import_particle_set (evt%particle_set)
     if (allocated (evt%matching)) then
        call evt%matching%before_shower (evt%particle_set, vetoed)
        if (msg_level(D_TRANSFORMS) >= DEBUG) then
           if (debug_on) call msg_debug (D_TRANSFORMS, "Matching before generate emissions")
           call evt%matching%write ()
        end if
     end if
     if (.not. (vetoed .or. POWHEG_TESTING)) then
        if (evt%shower%settings%method == PS_PYTHIA6 .or. &
            evt%shower%settings%hadronization_active) then
           call assure_heprup (evt%particle_set)
        end if
        call evt%shower%generate_emissions (valid)
     end if
     probability = 1
     evt%particle_set_exists = valid .and. .not. vetoed
   end subroutine evt_shower_generate_weighted
 
 @ %def evt_shower_generate_weighted
 @ Here, we fill the particle set with the partons from the shower.
 The factorization parameters are irrelevant.
 We make a sanity check that the initial energy lands either in the
 outgoing particles or add to the beam remnant.
 <<Shower: evt shower: TBP>>=
   procedure :: make_particle_set => evt_shower_make_particle_set
 <<Shower: procedures>>=
   subroutine evt_shower_make_particle_set &
        (evt, factorization_mode, keep_correlations, r)
     class(evt_shower_t), intent(inout) :: evt
     integer, intent(in) :: factorization_mode
     logical, intent(in) :: keep_correlations
     real(default), dimension(:), intent(in), optional :: r
     type(vector4_t) :: sum_vec_in, sum_vec_out, sum_vec_beamrem, &
          sum_vec_beamrem_before
     logical :: vetoed, sane
     if (evt%particle_set_exists) then
        vetoed = .false.
        sum_vec_beamrem_before = sum (evt%particle_set%prt%p, &
             mask=evt%particle_set%prt%get_status () == PRT_BEAM_REMNANT)
        call evt%shower%make_particle_set (evt%particle_set, &
             evt%model, evt%model_hadrons)
        if (allocated (evt%matching)) then
           call evt%matching%after_shower (evt%particle_set, vetoed)
        end if
        if (debug_active (D_TRANSFORMS)) then
           call msg_debug (D_TRANSFORMS, &
                "Shower: obtained particle set after shower + matching")
           call evt%particle_set%write (summary = .true., compressed = .true.)
        end if
        sum_vec_in = sum (evt%particle_set%prt%p, &
             mask=evt%particle_set%prt%get_status () == PRT_INCOMING)
        sum_vec_out = sum (evt%particle_set%prt%p, &
             mask=evt%particle_set%prt%get_status () == PRT_OUTGOING)
        sum_vec_beamrem = sum (evt%particle_set%prt%p, &
             mask=evt%particle_set%prt%get_status () == PRT_BEAM_REMNANT)
        sum_vec_beamrem = sum_vec_beamrem - sum_vec_beamrem_before
        sane = abs(sum_vec_out%p(0) - sum_vec_in%p(0)) < &
             sum_vec_in%p(0) / 10 .or. &
             abs((sum_vec_out%p(0) + sum_vec_beamrem%p(0)) - sum_vec_in%p(0)) < &
             sum_vec_in%p(0) / 10
        sane = .true.
        evt%particle_set_exists = .not. vetoed .and. sane
     end if
   end subroutine evt_shower_make_particle_set
 
 @ %def event_shower_make_particle_set
 @
 <<Shower: evt shower: TBP>>=
   procedure :: contains_powheg_matching => evt_shower_contains_powheg_matching
 <<Shower: procedures>>=
   function evt_shower_contains_powheg_matching (evt) result (val)
      logical :: val
      class(evt_shower_t), intent(in) :: evt
      val = .false.
      if (allocated (evt%matching)) &
         val = evt%matching%get_method () == "POWHEG"
   end function evt_shower_contains_powheg_matching
 
 @ %def evt_shower_contains_powheg_matching
 @
 <<Shower: evt shower: TBP>>=
   procedure :: disable_powheg_matching => evt_shower_disable_powheg_matching
 <<Shower: procedures>>=
   subroutine evt_shower_disable_powheg_matching (evt)
      class(evt_shower_t), intent(inout) :: evt
      select type (matching => evt%matching)
      type is (powheg_matching_t)
         matching%active = .false.
      class default
         call msg_fatal ("Trying to disable powheg but no powheg matching is allocated!")
      end select
   end subroutine evt_shower_disable_powheg_matching
 
 @ %def evt_shower_disable_powheg_matching
 @
 <<Shower: evt shower: TBP>>=
   procedure :: enable_powheg_matching => evt_shower_enable_powheg_matching
 <<Shower: procedures>>=
   subroutine evt_shower_enable_powheg_matching (evt)
      class(evt_shower_t), intent(inout) :: evt
      select type (matching => evt%matching)
      type is (powheg_matching_t)
         matching%active = .true.
      class default
         call msg_fatal ("Trying to enable powheg but no powheg matching is allocated!")
      end select
   end subroutine evt_shower_enable_powheg_matching
 
 @ %def evt_shower_enable_powheg_matching
 @
 <<Shower: evt shower: TBP>>=
   procedure :: final => evt_shower_final
 <<Shower: procedures>>=
   subroutine evt_shower_final (evt)
     class(evt_shower_t), intent(inout) :: evt
     call evt%base_final ()
     if (allocated (evt%matching))  call evt%matching%final ()
   end subroutine evt_shower_final
 
 @ %def evt_shower_final
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[shower_ut.f90]]>>=
 <<File header>>
 
 module shower_ut
   use unit_tests
   use shower_uti
 
 <<Standard module head>>
 
 <<Shower: public test>>
 
 contains
 
 <<Shower: test driver>>
 
 end module shower_ut
 @ %def shower_ut
 @
 <<[[shower_uti.f90]]>>=
 <<File header>>
 
 module shower_uti
 
 <<Use kinds>>
 <<Use strings>>
   use format_utils, only: write_separator
   use os_interface
   use sm_qcd
   use physics_defs, only: BORN
   use model_data
   use models
   use state_matrices, only: FM_IGNORE_HELICITY
   use process_libraries
   use rng_base
   use rng_tao
   use dispatch_rng, only: dispatch_rng_factory_fallback
   use mci_base
   use mci_midpoint
   use phs_base
   use phs_single
   use prc_core_def, only: prc_core_def_t
   use prc_core
   use prc_omega
   use variables
   use event_transforms
   use tauola_interface !NODEP!
 
   use process, only: process_t
   use instances, only: process_instance_t
 
   use pdf
   use shower_base
   use shower_core
 
   use dispatch_rng_ut, only: dispatch_rng_factory_tao
 
   use shower
 
 <<Standard module head>>
 
 <<Shower: test declarations>>
 
 contains
 
 <<Shower: tests>>
 
 end module shower_uti
 
 @ %def shower_uti
 @ API: driver for the unit tests below.
 <<Shower: public test>>=
   public :: shower_test
 <<Shower: test driver>>=
   subroutine shower_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Shower: execute tests>>
   end subroutine shower_test
 
 @ %def shower_test
 @
 \subsubsection{Testbed}
 This sequence sets up a two-jet process, ready for generating events.
 <<Shower: tests>>=
 <<setup testbed>>
 @
 <<setup testbed>>=
   subroutine setup_testbed &
        (prefix, os_data, lib, model_list, process, process_instance)
     type(string_t), intent(in) :: prefix
     type(os_data_t), intent(out) :: os_data
     type(process_library_t), intent(out), target :: lib
     type(model_list_t), intent(out) :: model_list
     type(model_t), pointer :: model
     type(model_t), pointer :: model_tmp
     type(process_t), target, intent(out) :: process
     type(process_instance_t), target, intent(out) :: process_instance
     type(var_list_t), pointer :: model_vars
     type(string_t) :: model_name, libname, procname
     type(process_def_entry_t), pointer :: entry
     type(string_t), dimension(:), allocatable :: prt_in, prt_out
     class(prc_core_t), allocatable :: core_template
     class(phs_config_t), allocatable :: phs_config_template
     real(default) :: sqrts
 
     model_name = "SM"
     libname = prefix // "_lib"
     procname = prefix // "p"
 
     call os_data%init ()
     dispatch_rng_factory_fallback => dispatch_rng_factory_tao
     allocate (model_tmp)
     call model_list%read_model (model_name, model_name // ".mdl", &
          os_data, model_tmp)
     model_vars => model_tmp%get_var_list_ptr ()
     call model_vars%set_real (var_str ("me"), 0._default, &
          is_known = .true.)
     model => model_tmp
 
     call lib%init (libname)
 
     allocate (prt_in (2), source = [var_str ("e-"), var_str ("e+")])
     allocate (prt_out (2), source = [var_str ("d"), var_str ("dbar")])
 
     allocate (entry)
     call entry%init (procname, model, n_in = 2, n_components = 1)
     call omega_make_process_component (entry, 1, &
          model_name, prt_in, prt_out, &
          report_progress=.true.)
     call lib%append (entry)
 
     call lib%configure (os_data)
     call lib%write_makefile (os_data, force = .true., verbose = .false.)
     call lib%clean (os_data, distclean = .false.)
     call lib%write_driver (force = .true.)
     call lib%load (os_data)
 
     call process%init (procname, lib, os_data, model)
 
     allocate (prc_omega_t :: core_template)
     allocate (phs_single_config_t :: phs_config_template)
 
     call process%setup_cores (dispatch_core_omega_test)
     
     call process%init_components (phs_config_template)
 
     sqrts = 1000
     call process%setup_beams_sqrts (sqrts, i_core = 1)
     call process%configure_phs ()
     call process%setup_mci (dispatch_mci_test_midpoint)
     call process%setup_terms ()
 
     call process_instance%init (process)
     call process_instance%integrate (1, 1, 1000)
     call process%final_integration (1)
 
     call process_instance%setup_event_data (i_core = 1)
     call process_instance%init_simulation (1)
     call process_instance%generate_weighted_event (1)
     call process_instance%evaluate_event_data ()
 
   end subroutine setup_testbed
 
 @ %def setup_testbed
 @ A minimal dispatcher version that allocates the core object for testing.
 <<setup testbed>>=
   subroutine dispatch_core_omega_test (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
     allocate (prc_omega_t :: core)
     select type (core)
     type is (prc_omega_t)
        call core%set_parameters (model)
     end select
   end subroutine dispatch_core_omega_test
      
 @ %def dispatch_core_omega_test
 @ MCI record prepared for midpoint integrator.
 <<setup testbed>>=
   subroutine dispatch_mci_test_midpoint (mci, var_list, process_id, is_nlo)
     use variables, only: var_list_t
     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
     allocate (mci_midpoint_t :: mci)
   end subroutine dispatch_mci_test_midpoint
  
 @ %def dispatch_mci_test_midpoint
 @
 \subsubsection{Trivial Test}
 We generate a two-jet event and shower it using default settings, i.e.
 in disabled mode.
 <<Shower: execute tests>>=
   call test (shower_1, "shower_1", &
        "disabled shower", &
        u, results)
 <<Shower: test declarations>>=
   public :: shower_1
 <<Shower: tests>>=
   subroutine shower_1 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(process_library_t), target :: lib
     type(model_list_t) :: model_list
     class(model_data_t), pointer :: model
     type(model_t), pointer :: model_hadrons
     type(process_t), target :: process
     type(process_instance_t), target :: process_instance
     type(pdf_data_t) :: pdf_data
     integer :: factorization_mode
     logical :: keep_correlations
     class(evt_t), allocatable, target :: evt_trivial
     class(evt_t), allocatable, target :: evt_shower
     type(shower_settings_t) :: settings
     type(taudec_settings_t) :: taudec_settings
 
     write (u, "(A)")  "* Test output: shower_1"
     write (u, "(A)")  "*   Purpose: Two-jet event with disabled shower"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"), &
          os_data, model_hadrons)
     call setup_testbed (var_str ("shower_1"), &
          os_data, lib, model_list, process, process_instance)
 
     write (u, "(A)")  "* Set up trivial transform"
     write (u, "(A)")
 
     allocate (evt_trivial_t :: evt_trivial)
     model => process%get_model_ptr ()
     call evt_trivial%connect (process_instance, model)
     call evt_trivial%prepare_new_event (1, 1)
     call evt_trivial%generate_unweighted ()
 
     factorization_mode = FM_IGNORE_HELICITY
     keep_correlations = .false.
     call evt_trivial%make_particle_set (factorization_mode, keep_correlations)
 
     select type (evt_trivial)
     type is (evt_trivial_t)
        call evt_trivial%write (u)
        call write_separator (u, 2)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Set up shower event transform"
     write (u, "(A)")
 
     allocate (evt_shower_t :: evt_shower)
     select type (evt_shower)
     type is (evt_shower_t)
        call evt_shower%init (model_hadrons, os_data)
        allocate (shower_t :: evt_shower%shower)
        call evt_shower%shower%init (settings, taudec_settings, pdf_data, os_data)
        call evt_shower%connect (process_instance, model)
     end select
 
     evt_trivial%next => evt_shower
     evt_shower%previous => evt_trivial
 
     call evt_shower%prepare_new_event (1, 1)
     call evt_shower%generate_unweighted ()
     call evt_shower%make_particle_set (factorization_mode, keep_correlations)
 
     select type (evt_shower)
     type is (evt_shower_t)
        call evt_shower%write (u)
        call write_separator (u, 2)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_shower%final ()
     call evt_trivial%final ()
     call process_instance%final ()
     call process%final ()
     call lib%final ()
     call model_hadrons%final ()
     deallocate (model_hadrons)
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: shower_1"
 
   end subroutine shower_1
 
 @ %def shower_1
 @
 \subsubsection{FSR Shower}
 We generate a two-jet event and shower it with the Whizard FSR shower.
 <<Shower: execute tests>>=
   call test (shower_2, "shower_2", &
        "final-state shower", &
        u, results)
 <<Shower: test declarations>>=
   public :: shower_2
 <<Shower: tests>>=
   subroutine shower_2 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(process_library_t), target :: lib
     type(model_list_t) :: model_list
     type(model_t), pointer :: model_hadrons
     class(model_data_t), pointer :: model
     type(process_t), target :: process
     type(process_instance_t), target :: process_instance
     integer :: factorization_mode
     logical :: keep_correlations
     type(pdf_data_t) :: pdf_data
     class(evt_t), allocatable, target :: evt_trivial
     class(evt_t), allocatable, target :: evt_shower
     type(shower_settings_t) :: settings
     type(taudec_settings_t) :: taudec_settings
 
     write (u, "(A)")  "* Test output: shower_2"
     write (u, "(A)")  "*   Purpose: Two-jet event with FSR shower"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize environment"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call os_data%init ()
     call model_list%read_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"), &
          os_data, model_hadrons)
     call setup_testbed (var_str ("shower_2"), &
          os_data, lib, model_list, process, process_instance)
     model => process%get_model_ptr ()
 
     write (u, "(A)")  "* Set up trivial transform"
     write (u, "(A)")
 
     allocate (evt_trivial_t :: evt_trivial)
     call evt_trivial%connect (process_instance, model)
     call evt_trivial%prepare_new_event (1, 1)
     call evt_trivial%generate_unweighted ()
 
     factorization_mode = FM_IGNORE_HELICITY
     keep_correlations = .false.
     call evt_trivial%make_particle_set (factorization_mode, keep_correlations)
 
     select type (evt_trivial)
     type is (evt_trivial_t)
        call evt_trivial%write (u)
        call write_separator (u, 2)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Set up shower event transform"
     write (u, "(A)")
 
     settings%fsr_active = .true.
 
     allocate (evt_shower_t :: evt_shower)
     select type (evt_shower)
     type is (evt_shower_t)
        call evt_shower%init (model_hadrons, os_data)
        allocate (shower_t :: evt_shower%shower)
        call evt_shower%shower%init (settings, taudec_settings, pdf_data, os_data)
        call evt_shower%connect (process_instance, model)
     end select
 
     evt_trivial%next => evt_shower
     evt_shower%previous => evt_trivial
 
     call evt_shower%prepare_new_event (1, 1)
     call evt_shower%generate_unweighted ()
     call evt_shower%make_particle_set (factorization_mode, keep_correlations)
 
     select type (evt_shower)
     type is (evt_shower_t)
        call evt_shower%write (u, testflag = .true.)
        call write_separator (u, 2)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call evt_shower%final ()
     call evt_trivial%final ()
     call process_instance%final ()
     call process%final ()
     call lib%final ()
     call model_hadrons%final ()
     deallocate (model_hadrons)
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: shower_2"
 
   end subroutine shower_2
 
 @ %def shower_2
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Fixed Order NLO Events}
 This section deals with the generation of weighted event samples which
 take into account next-to-leading order corrections. An approach
 generating unweighted events is not possible here, because negative
 weights might occur due to subtraction. Note that the events produced
 this way are not physical in the sense that they will not keep
 NLO-accuracy when interfaced to a parton shower. They are rather
 useful for theoretical consistency checks and a fast estimate of
 NLO effects.\\
 We generate NLO events in the following way: First, the integration
 is carried out using the complete divergence-subtracted NLO matrix
 element. In the subsequent simulation, $N$-particle kinematics
 are generated using $\mathcal{B}+\mathcal{V}+\mathcal{C}$ as weight.
 After that, the program loops over all singular regions and for each
 of them generates an event with $N+1$-particle kinematics.
 The weight for those events corresponds to the real matrix
 element $\mathcal{R}^\alpha$ evaluated at the $\alpha$-region's
 emitter's phase space point, multiplied with $S_\alpha$.
 This procedure is implemented using the [[evt_nlo]] transform.
 
 <<[[evt_nlo.f90]]>>=
 <<File header>>
 
 module evt_nlo
 
 <<Use kinds>>
 <<Use strings>>
 <<Use debug>>
   use io_units, only: given_output_unit
   use constants
   use lorentz
   use diagnostics
   use physics_defs, only: NLO_REAL
   use sm_qcd
   use model_data
   use particles
   use instances, only: process_instance_t
   use pcm, only: pcm_nlo_t, pcm_instance_nlo_t
   use process_stacks
   use event_transforms
 
   use phs_fks, only: phs_fks_t, phs_fks_generator_t
   use phs_fks, only: phs_identifier_t, phs_point_set_t
   use resonances, only: resonance_contributors_t
   use fks_regions, only: region_data_t
 
 <<Standard module head>>
 
 <<Evt Nlo: public>>
 
 <<Evt Nlo: public parameters>>
 
 <<Evt Nlo: types>>
 
 contains
 
 <<Evt Nlo: procedures>>
 
 end module evt_nlo
 
 @ %def evt_nlo
 @
 <<Evt Nlo: types>>=
   type :: nlo_event_deps_t
      logical :: cm_frame = .true.
      type(phs_point_set_t) :: p_born_cms
      type(phs_point_set_t) :: p_born_lab
      type(phs_point_set_t) :: p_real_cms
      type(phs_point_set_t) :: p_real_lab
      type(resonance_contributors_t), dimension(:), allocatable :: contributors
      type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
      integer, dimension(:), allocatable :: alr_to_i_con
      integer :: n_phs = 0
   end type nlo_event_deps_t
 
 @ %def nlo_event_deps_t
 @ This event transformation is for the generation of fixed-order NLO events. It
 takes an event with Born kinematics and creates $N_\alpha + 1$ modified weighted events.
 The first one has Born kinematics and its weight is the sum of Born, Real and subtraction
 matrix elements. The other $N_\alpha$ events have a weight which is equal to the real matrix
 element, evaluated with the phase space corresponding to the emitter of the $\alpha$-region.
 All NLO event objects share the same event transformation. For this reason, we save the
 particle set of the current $\alpha$-region in the array [[particle_set_radiated]]. Otherwise
 it would be unretrievable if the usual particle set of the event object was used.@
 <<Evt Nlo: public parameters>>=
   integer, parameter, public :: EVT_NLO_UNDEFINED = 0
   integer, parameter, public :: EVT_NLO_SEPARATE_BORNLIKE = 1
   integer, parameter, public :: EVT_NLO_SEPARATE_REAL = 2
   integer, parameter, public :: EVT_NLO_COMBINED = 3
 <<Evt Nlo: public>>=
   public :: evt_nlo_t
 <<Evt Nlo: types>>=
   type, extends (evt_t) :: evt_nlo_t
     type(phs_fks_generator_t) :: phs_fks_generator
     real(default) :: sqme_rad = zero
     integer :: i_evaluation = 0
     integer :: weight_multiplier = 1
     type(particle_set_t), dimension(:), allocatable :: particle_set_radiated
     type(qcd_t) :: qcd
     type(nlo_event_deps_t) :: event_deps
     integer :: mode = EVT_NLO_UNDEFINED
     integer, dimension(:), allocatable :: &
        i_evaluation_to_i_phs, i_evaluation_to_emitter, &
        i_evaluation_to_i_term
     logical :: keep_failed_events = .false.
     integer :: selected_i_flv = 0
   contains
   <<Evt Nlo: evt nlo: TBP>>
   end type evt_nlo_t
 
 @ %def evt_nlo_t
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: write_name => evt_nlo_write_name
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_write_name (evt, unit)
     class(evt_nlo_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)") "Event transform: NLO"
   end subroutine evt_nlo_write_name
 
 @ %def evt_nlo_write_name
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: write => evt_nlo_write
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_write (evt, unit, verbose, more_verbose, testflag)
     class(evt_nlo_t), intent(in) :: evt
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose, more_verbose, testflag
   end subroutine evt_nlo_write
 
 @ %def evt_nlo_write
 @ Connects the event transform to the process. Here also the phase space
 is set up by making [[real_kinematics]] point to the corresponding
 object in the [[pcm_instance]].
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: connect => evt_nlo_connect
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_connect (evt, process_instance, model, process_stack)
     class(evt_nlo_t), intent(inout), target :: evt
     type(process_instance_t), intent(in), target :: process_instance
     class(model_data_t), intent(in), target :: model
     type(process_stack_t), intent(in), optional :: process_stack
     if (debug_on) call msg_debug (D_TRANSFORMS, "evt_nlo_connect")
     call evt%base_connect (process_instance, model, process_stack)
     select type (pcm => process_instance%pcm)
     class is (pcm_instance_nlo_t)
        select type (config => pcm%config)
        type is (pcm_nlo_t)
           call config%setup_phs_generator (pcm, evt%phs_fks_generator, &
                process_instance%get_sqrts ())
           call evt%set_i_evaluation_mappings (config%region_data, &
                pcm%real_kinematics%alr_to_i_phs)
        end select
     end select
     call evt%set_mode (process_instance)
     call evt%setup_general_event_kinematics (process_instance)
     if (evt%mode > EVT_NLO_SEPARATE_BORNLIKE) &
          call evt%setup_real_event_kinematics (process_instance)
     if (debug_on) call msg_debug2 (D_TRANSFORMS, "evt_nlo_connect: success")
   end subroutine evt_nlo_connect
 
 @ %def evt_nlo_connect
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: set_i_evaluation_mappings => evt_nlo_set_i_evaluation_mappings
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_set_i_evaluation_mappings (evt, reg_data, alr_to_i_phs)
     class(evt_nlo_t), intent(inout) :: evt
     type(region_data_t), intent(in) :: reg_data
     integer, intent(in), dimension(:) :: alr_to_i_phs
     integer :: n_phs, alr
     integer :: i_evaluation, i_phs, emitter
     logical :: checked
     type :: registered_triple_t
       integer, dimension(2) :: phs_em
       type(registered_triple_t), pointer :: next => null ()
     end type registered_triple_t
     type(registered_triple_t), allocatable, target :: check_list
     i_evaluation = 1
     n_phs = reg_data%n_phs
     evt%weight_multiplier = n_phs + 1
     allocate (evt%i_evaluation_to_i_phs (n_phs), source = 0)
     allocate (evt%i_evaluation_to_emitter (n_phs), source = -1)
     allocate (evt%i_evaluation_to_i_term (0 : n_phs), source = 0)
     do alr = 1, reg_data%n_regions
        i_phs = alr_to_i_phs (alr)
        emitter = reg_data%regions(alr)%emitter
        call search_check_list (checked)
        if (.not. checked) then
           evt%i_evaluation_to_i_phs (i_evaluation) = i_phs
           evt%i_evaluation_to_emitter (i_evaluation) = emitter
           i_evaluation = i_evaluation + 1
        end if
     end do
     call fill_i_evaluation_to_i_term ()
     if (.not. (all (evt%i_evaluation_to_i_phs > 0) &
        .and. all (evt%i_evaluation_to_emitter > -1))) then
        call msg_fatal ("evt_nlo: Inconsistent mappings!")
     else
        if (debug2_active (D_TRANSFORMS)) then
           print *, 'evt_nlo Mappings, i_evaluation -> '
           print *, 'i_phs: ', evt%i_evaluation_to_i_phs
           print *, 'emitter: ', evt%i_evaluation_to_emitter
        end if
     end if
   contains
     subroutine fill_i_evaluation_to_i_term ()
       integer :: i_term, i_evaluation, term_emitter
       !!! First find subtraction component
       i_evaluation = 1
       do i_term = 1, evt%process%get_n_terms ()
          if (evt%process_instance%term(i_term)%nlo_type /= NLO_REAL) cycle
          term_emitter = evt%process_instance%term(i_term)%k_term%emitter
          if (term_emitter < 0) then
             evt%i_evaluation_to_i_term (0) = i_term
          else if (evt%i_evaluation_to_emitter(i_evaluation) == term_emitter) then
             evt%i_evaluation_to_i_term (i_evaluation) = i_term
             i_evaluation = i_evaluation + 1
          end if
       end do
     end subroutine fill_i_evaluation_to_i_term
 
     subroutine search_check_list (found)
       logical, intent(out) :: found
       type(registered_triple_t), pointer :: current_triple => null ()
       if (allocated (check_list)) then
          current_triple => check_list
          do
             if (all (current_triple%phs_em == [i_phs, emitter])) then
                found = .true.
                exit
             end if
             if (.not. associated (current_triple%next)) then
                allocate (current_triple%next)
                current_triple%next%phs_em = [i_phs, emitter]
                found = .false.
                exit
             else
                current_triple => current_triple%next
             end if
          end do
       else
          allocate (check_list)
          check_list%phs_em = [i_phs, emitter]
          found = .false.
       end if
     end subroutine search_check_list
   end subroutine evt_nlo_set_i_evaluation_mappings
 
 @ %def evt_nlo_set_i_evaluation_mappings
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: get_i_phs => evt_nlo_get_i_phs
 <<Evt Nlo: procedures>>=
   function evt_nlo_get_i_phs (evt) result (i_phs)
     integer :: i_phs
     class(evt_nlo_t), intent(in) :: evt
     i_phs = evt%i_evaluation_to_i_phs (evt%i_evaluation)
   end function evt_nlo_get_i_phs
 
 @ %def evt_nlo_get_i_phs
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: get_emitter => evt_nlo_get_emitter
 <<Evt Nlo: procedures>>=
   function evt_nlo_get_emitter (evt) result (emitter)
     integer :: emitter
     class(evt_nlo_t), intent(in) :: evt
     emitter = evt%i_evaluation_to_emitter (evt%i_evaluation)
   end function evt_nlo_get_emitter
 
 @ %def evt_nlo_get_emitter
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: get_i_term => evt_nlo_get_i_term
 <<Evt Nlo: procedures>>=
   function evt_nlo_get_i_term (evt) result (i_term)
     integer :: i_term
     class(evt_nlo_t), intent(in) :: evt
     if (evt%mode >= EVT_NLO_SEPARATE_REAL) then
        i_term = evt%i_evaluation_to_i_term (evt%i_evaluation)
     else
        i_term = evt%process_instance%get_first_active_i_term ()
     end if
   end function evt_nlo_get_i_term
 
 @ %def evt_nlo_get_i_term
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: copy_previous_particle_set => evt_nlo_copy_previous_particle_set
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_copy_previous_particle_set (evt)
     class(evt_nlo_t), intent(inout) :: evt
     if (associated (evt%previous)) then
        evt%particle_set = evt%previous%particle_set
     else
        call msg_fatal ("evt_nlo requires one preceeding evt_trivial!")
     end if
   end subroutine evt_nlo_copy_previous_particle_set
 
 @ %def evt_nlo_copy_previous_particle_set
 @ The event transform has a variable which counts the number of times it
 has already been called for one generation point. If [[i_evaluation]] is
 zero, this means that [[evt_nlo_generate]] is called for the first time,
 so that the generation of an $N$-particle event is required.  In all
 other cases, emission events are generated.\\
 Note that for the first event, the computed weights are added to
 [[probability]], which at this point is equal to $\mathcal{B} +
 \mathcal{V}$, whereas for all other runs [[probability]] is replaced.
 To keep $<\sum{w_i}>=N\times\sigma$ as it is for weighted LO
 events, we have to multiply by $N_{\rm{phs}} + 1$ since the cross section
 is distributed over the real and Born subevents.
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: generate_weighted => evt_nlo_generate_weighted
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_generate_weighted (evt, probability)
     class(evt_nlo_t), intent(inout) :: evt
     real(default), intent(inout) :: probability
     real(default) :: weight
     call print_debug_info ()
     if (evt%mode > EVT_NLO_SEPARATE_BORNLIKE) then
        if (evt%i_evaluation == 0) then
           call evt%reset_phs_identifiers ()
           call evt%evaluate_real_kinematics ()
           weight = evt%compute_subtraction_weights ()
           if (evt%mode == EVT_NLO_SEPARATE_REAL) then
              probability = weight
           else
              probability = probability + weight
           end if
        else
           call evt%compute_real ()
           probability = evt%sqme_rad
        end if
        if (debug_on) call msg_debug2 (D_TRANSFORMS, "event weight multiplier:", evt%weight_multiplier)
        probability = probability * evt%weight_multiplier
     end if
     if (debug_on) call msg_debug (D_TRANSFORMS, "probability (after)", probability)
     evt%particle_set_exists = .true.
   contains
     function status_code_to_string (mode) result (smode)
       type(string_t) :: smode
       integer, intent(in) :: mode
       select case (mode)
       case (EVT_NLO_UNDEFINED)
          smode = var_str ("Undefined")
       case (EVT_NLO_SEPARATE_BORNLIKE)
          smode = var_str ("Born-like")
       case (EVT_NLO_SEPARATE_REAL)
          smode = var_str ("Real")
       case (EVT_NLO_COMBINED)
          smode = var_str ("Combined")
       end select
     end function status_code_to_string
 
     subroutine print_debug_info ()
        if (debug_on) call msg_debug (D_TRANSFORMS, "evt_nlo_generate_weighted")
        if (debug_on) call msg_debug (D_TRANSFORMS, char ("mode: " // status_code_to_string (evt%mode)))
        if (debug_on) call msg_debug (D_TRANSFORMS, "probability (before)", probability)
        if (debug_on) call msg_debug (D_TRANSFORMS, "evt%i_evaluation", evt%i_evaluation)
        if (debug2_active (D_TRANSFORMS)) then
           if (evt%mode > EVT_NLO_SEPARATE_BORNLIKE) then
              if (evt%i_evaluation == 0) then
                 print *, 'Evaluate subtraction component'
              else
                 print *, 'Evaluate radiation component'
              end if
           end if
        end if
     end subroutine print_debug_info
   end subroutine evt_nlo_generate_weighted
 
 @ %def evt_nlo_generate_weighted
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: reset_phs_identifiers => evt_nlo_reset_phs_identifiers
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_reset_phs_identifiers (evt)
      class(evt_nlo_t), intent(inout) :: evt
      evt%event_deps%phs_identifiers%evaluated = .false.
   end subroutine evt_nlo_reset_phs_identifiers
 
 @ %def evt_nlo_reset_phs_identifiers
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: make_particle_set => evt_nlo_make_particle_set
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_make_particle_set &
        (evt, factorization_mode, keep_correlations, r)
     class(evt_nlo_t), intent(inout) :: evt
     integer, intent(in) :: factorization_mode
     logical, intent(in) :: keep_correlations
     real(default), dimension(:), intent(in), optional :: r
     if (evt%mode >= EVT_NLO_SEPARATE_BORNLIKE) then
        select type (config => evt%process_instance%pcm%config)
        type is (pcm_nlo_t)
           if (evt%i_evaluation > 0) then
              call make_factorized_particle_set (evt, factorization_mode, &
                   keep_correlations, r, evt%get_i_term (), &
                   config%qn_real(:, evt%selected_i_flv))
           else
              call make_factorized_particle_set (evt, factorization_mode, &
                   keep_correlations, r, evt%get_i_term (), &
                   config%qn_born(:, evt%selected_i_flv))
           end if
        end select
     else
        call make_factorized_particle_set (evt, factorization_mode, &
             keep_correlations, r)
     end if
   end subroutine evt_nlo_make_particle_set
 
 @ %def evt_nlo_make_particle_set
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: keep_and_boost_born_particle_set => &
        evt_nlo_keep_and_boost_born_particle_set
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_keep_and_boost_born_particle_set (evt, i_event)
     class(evt_nlo_t), intent(inout) :: evt
     integer, intent(in) :: i_event
     evt%particle_set_radiated(i_event) = evt%particle_set
     if (evt%event_deps%cm_frame) then
        evt%event_deps%p_born_cms%phs_point(1) = &
           evt%particle_set%get_in_and_out_momenta ()
        evt%event_deps%p_born_lab%phs_point(1) = &
           evt%boost_to_lab (evt%event_deps%p_born_cms%phs_point(1))
        call evt%particle_set_radiated(i_event)%replace_incoming_momenta &
           (evt%event_deps%p_born_lab%phs_point(1)%p)
        call evt%particle_set_radiated(i_event)%replace_outgoing_momenta &
           (evt%event_deps%p_born_lab%phs_point(1)%p)
     end if
   end subroutine evt_nlo_keep_and_boost_born_particle_set
 
 @ %def evt_nlo_keep_and_boost_born_particle_set
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: evaluate_real_kinematics => evt_nlo_evaluate_real_kinematics
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_evaluate_real_kinematics (evt)
     class(evt_nlo_t), intent(inout) :: evt
     integer :: alr, i_phs, i_con, emitter
     real(default), dimension(3) :: x_rad
     logical :: use_contributors
     integer :: i_term
 
     select type (pcm => evt%process_instance%pcm)
     class is (pcm_instance_nlo_t)
        x_rad = pcm%real_kinematics%x_rad
        associate (event_deps => evt%event_deps)
           i_term = evt%get_i_term ()
           event_deps%p_born_lab%phs_point(1) = &
                evt%process_instance%term(i_term)%connected%matrix%get_momenta ()
           event_deps%p_born_cms%phs_point(1) &
                = evt%boost_to_cms (event_deps%p_born_lab%phs_point(1))
           call evt%phs_fks_generator%set_sqrts_hat &
                (event_deps%p_born_cms%get_energy (1, 1))
           use_contributors = allocated (event_deps%contributors)
           do alr = 1, pcm%get_n_regions ()
              i_phs = pcm%real_kinematics%alr_to_i_phs(alr)
              if (event_deps%phs_identifiers(i_phs)%evaluated) cycle
              emitter = event_deps%phs_identifiers(i_phs)%emitter
              associate (generator => evt%phs_fks_generator)
                 if (emitter <= evt%process%get_n_in ()) then
                    call generator%prepare_generation (x_rad, i_phs, emitter, &
                         event_deps%p_born_cms%phs_point(1)%p, event_deps%phs_identifiers)
                    call generator%generate_isr (i_phs, &
                         event_deps%p_born_lab%phs_point(1)%p, &
                         event_deps%p_real_lab%phs_point(i_phs)%p)
                    event_deps%p_real_cms%phs_point(i_phs) &
                         = evt%boost_to_cms (event_deps%p_real_lab%phs_point(i_phs))
                 else
                    if (use_contributors) then
                       i_con = event_deps%alr_to_i_con(alr)
                       call generator%prepare_generation (x_rad, i_phs, emitter, &
                            event_deps%p_born_cms%phs_point(1)%p, &
                            event_deps%phs_identifiers, event_deps%contributors, i_con)
                       call generator%generate_fsr (emitter, i_phs, i_con, &
                            event_deps%p_born_cms%phs_point(1)%p, &
                            event_deps%p_real_cms%phs_point(i_phs)%p)
                    else
                       call generator%prepare_generation (x_rad, i_phs, emitter, &
                            event_deps%p_born_cms%phs_point(1)%p, event_deps%phs_identifiers)
                       call generator%generate_fsr (emitter, i_phs, &
                            event_deps%p_born_cms%phs_point(1)%p, &
                            event_deps%p_real_cms%phs_point(i_phs)%p)
                    end if
                    event_deps%p_real_lab%phs_point(i_phs) &
                         = evt%boost_to_lab (event_deps%p_real_cms%phs_point(i_phs))
                 end if
              end associate
              call pcm%set_momenta (event_deps%p_born_lab%phs_point(1)%p, &
                   event_deps%p_real_lab%phs_point(i_phs)%p, i_phs)
              call pcm%set_momenta (event_deps%p_born_cms%phs_point(1)%p, &
                   event_deps%p_real_cms%phs_point(i_phs)%p, i_phs, cms = .true.)
              event_deps%phs_identifiers(i_phs)%evaluated = .true.
           end do
        end associate
     end select
   end subroutine evt_nlo_evaluate_real_kinematics
 
 @ %def evt_nlo_evaluate_real_kinematics
 @ This routine calls the evaluation of the singular regions only for the
 subtraction terms.
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: compute_subtraction_weights => evt_nlo_compute_subtraction_weights
 <<Evt Nlo: procedures>>=
   function evt_nlo_compute_subtraction_weights (evt) result (weight)
     class(evt_nlo_t), intent(inout) :: evt
     real(default) :: weight
     integer :: i_phs, i_term
     if (debug_on) call msg_debug (D_TRANSFORMS, "evt_nlo_compute_subtraction_weights")
     weight = zero
     select type (pcm => evt%process_instance%pcm)
     class is (pcm_instance_nlo_t)
        associate (event_deps => evt%event_deps)
           i_phs = 1; i_term = evt%i_evaluation_to_i_term(0)
           call evt%process_instance%compute_sqme_rad (i_term, i_phs, .true.)
           weight = weight + evt%process_instance%get_sqme (i_term)
        end associate
     end select
   end function evt_nlo_compute_subtraction_weights
 
 @ %def evt_nlo_compute_subtraction_weights
 @ This routine calls the evaluation of the singular regions only for
 emission matrix elements.
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: compute_real => evt_nlo_compute_real
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_compute_real (evt)
     class(evt_nlo_t), intent(inout) :: evt
     integer :: i_phs, i_term
     if (debug_on) call msg_debug (D_TRANSFORMS, "evt_nlo_compute_real")
     i_phs = evt%get_i_phs ()
     i_term = evt%i_evaluation_to_i_term (evt%i_evaluation)
     select type (pcm => evt%process_instance%pcm)
     class is (pcm_instance_nlo_t)
        associate (event_deps => evt%event_deps)
           call evt%process_instance%compute_sqme_rad (i_term, i_phs, .false.)
           evt%sqme_rad = evt%process_instance%get_sqme (i_term)
        end associate
     end select
   end subroutine evt_nlo_compute_real
 
 @ %def evt_nlo_compute_real
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: boost_to_cms => evt_nlo_boost_to_cms
 <<Evt Nlo: procedures>>=
   function evt_nlo_boost_to_cms (evt, p_lab) result (p_cms)
     type(phs_point_t), intent(in) :: p_lab
     class(evt_nlo_t), intent(in) :: evt
     type(phs_point_t) :: p_cms
     type(lorentz_transformation_t) :: lt_lab_to_cms
     integer :: i_boost
     if (evt%event_deps%cm_frame) then
        lt_lab_to_cms = identity
     else
        if (evt%mode == EVT_NLO_COMBINED) then
           i_boost = 1
        else
           i_boost = evt%process_instance%select_i_term ()
        end if
        lt_lab_to_cms = evt%process_instance%get_boost_to_cms (i_boost)
     end if
     p_cms = lt_lab_to_cms * p_lab
   end function evt_nlo_boost_to_cms
 
 @ %def evt_nlo_boost_to_cms
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: boost_to_lab => evt_nlo_boost_to_lab
 <<Evt Nlo: procedures>>=
   function evt_nlo_boost_to_lab (evt, p_cms) result (p_lab)
     type(phs_point_t) :: p_lab
     class(evt_nlo_t), intent(in) :: evt
     type(phs_point_t), intent(in) :: p_cms
     type(lorentz_transformation_t) :: lt_cms_to_lab
     integer :: i_boost
     if (.not. evt%event_deps%cm_frame) then
        lt_cms_to_lab = identity
     else
        if (evt%mode == EVT_NLO_COMBINED) then
           i_boost = 1
        else
           i_boost = evt%process_instance%select_i_term ()
        end if
        lt_cms_to_lab = evt%process_instance%get_boost_to_lab (i_boost)
     end if
     p_lab = lt_cms_to_lab * p_cms
   end function evt_nlo_boost_to_lab
 
 @ %def evt_nlo_boost_to_lab
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: setup_general_event_kinematics => evt_nlo_setup_general_event_kinematics
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_setup_general_event_kinematics (evt, process_instance)
     class(evt_nlo_t), intent(inout) :: evt
     type(process_instance_t), intent(in) :: process_instance
     integer :: n_born
     associate (event_deps => evt%event_deps)
        event_deps%cm_frame = process_instance%is_cm_frame (1)
        select type (pcm => process_instance%pcm)
        type is (pcm_instance_nlo_t)
           n_born = pcm%get_n_born ()
        end select
        call event_deps%p_born_cms%init (n_born, 1)
        call event_deps%p_born_lab%init (n_born, 1)
     end associate
   end subroutine evt_nlo_setup_general_event_kinematics
 
 @ %def evt_nlo_setup_general_event_kinematics
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: setup_real_event_kinematics => evt_nlo_setup_real_event_kinematics
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_setup_real_event_kinematics (evt, process_instance)
     class(evt_nlo_t), intent(inout) :: evt
     type(process_instance_t), intent(in) :: process_instance
     integer :: n_real, n_phs
     integer :: i_real
     associate (event_deps => evt%event_deps)
        select type (pcm => process_instance%pcm)
        class is (pcm_instance_nlo_t)
           n_real = pcm%get_n_real ()
        end select
        i_real = evt%process%get_first_real_term ()
        select type (phs => process_instance%term(i_real)%k_term%phs)
        type is (phs_fks_t)
           event_deps%phs_identifiers = phs%phs_identifiers
        end select
        n_phs = size (event_deps%phs_identifiers)
        call event_deps%p_real_cms%init (n_real, n_phs)
        call event_deps%p_real_lab%init (n_real, n_phs)
        select type (pcm => process_instance%pcm)
        type is (pcm_instance_nlo_t)
           select type (config => pcm%config)
           type is (pcm_nlo_t)
              if (allocated (config%region_data%alr_contributors)) then
                 allocate (event_deps%contributors (size (config%region_data%alr_contributors)))
                 event_deps%contributors = config%region_data%alr_contributors
              end if
              if (allocated (config%region_data%alr_to_i_contributor)) then
                 allocate (event_deps%alr_to_i_con &
                    (size (config%region_data%alr_to_i_contributor)))
                 event_deps%alr_to_i_con = config%region_data%alr_to_i_contributor
              end if
           end select
        end select
     end associate
   end subroutine evt_nlo_setup_real_event_kinematics
 
 @ %def evt_nlo_setup_real_event_kinematics
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: set_mode => evt_nlo_set_mode
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_set_mode (evt, process_instance)
     class(evt_nlo_t), intent(inout) :: evt
     type(process_instance_t), intent(in) :: process_instance
     integer :: i_real
     select type (pcm => process_instance%pcm)
     type is (pcm_instance_nlo_t)
        select type (config => pcm%config)
        type is (pcm_nlo_t)
           if (config%settings%combined_integration) then
              evt%mode = EVT_NLO_COMBINED
           else
              i_real = evt%process%get_first_real_component ()
              if (i_real == evt%process%extract_active_component_mci ()) then
                 evt%mode = EVT_NLO_SEPARATE_REAL
              else
                 evt%mode = EVT_NLO_SEPARATE_BORNLIKE
              end if
           end if
        end select
     end select
   end subroutine evt_nlo_set_mode
 
 @ %def evt_nlo_set_mode
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: is_valid_event => evt_nlo_is_valid_event
 <<Evt Nlo: procedures>>=
   function evt_nlo_is_valid_event (evt, i_term) result (valid)
     logical :: valid
     class(evt_nlo_t), intent(in) :: evt
     integer, intent(in) :: i_term
     valid = evt%process_instance%term(i_term)%passed
   end function evt_nlo_is_valid_event
 
 @ %def evt_nlo_is_valid_event
 @
 <<Evt Nlo: evt nlo: TBP>>=
   procedure :: prepare_new_event => evt_nlo_prepare_new_event
 <<Evt Nlo: procedures>>=
   subroutine evt_nlo_prepare_new_event (evt, i_mci, i_term)
     class(evt_nlo_t), intent(inout) :: evt
     integer, intent(in) :: i_mci, i_term
     real(default) :: s, x
     real(default) :: sqme_total
     real(default), dimension(:), allocatable :: sqme_flv
     integer :: i
     call evt%reset ()
     if (evt%i_evaluation > 0) return
     call evt%rng%generate (x)
     sqme_total = zero
     allocate (sqme_flv (evt%process_instance%term(1)%config%data%n_flv))
     sqme_flv = zero
     do i = 1, size (evt%process_instance%term)
        associate (term => evt%process_instance%term(i))
           sqme_total = sqme_total + real (sum ( &
                term%connected%matrix%get_matrix_element ()))
           sqme_flv = sqme_flv + real (term%connected%matrix%get_matrix_element ())
        end associate
     end do
     !!! Need absolute values to take into account negative weights
     x = x * abs (sqme_total)
     s = zero
     do i = 1, size (sqme_flv)
        s = s + abs (sqme_flv (i))
        if (s > x) then
           evt%selected_i_flv = i
           exit
        end if
     end do
     if (debug2_active (D_TRANSFORMS)) then
        call msg_print_color ("Selected i_flv: ", COL_GREEN)
        print *, evt%selected_i_flv
     end if
   end subroutine evt_nlo_prepare_new_event
 
 @ %def evt_nlo_prepare_new_event
 @
 \section{Complete Events}
 
 This module combines hard processes with decay chains, shower, and
 hadronization (not implemented yet) to complete events.  It also
 manages the input and output of event records in various formats.
 <<[[events.f90]]>>=
 <<File header>>
 
 module events
 
 <<Use kinds>>
 <<Use strings>>
 <<Use debug>>
   use constants, only: one
   use io_units
   use format_utils, only: pac_fmt, write_separator
   use format_defs, only: FMT_12, FMT_19
   use numeric_utils
   use diagnostics
   use variables
   use expr_base
   use model_data
   use state_matrices, only: FM_IGNORE_HELICITY, &
        FM_SELECT_HELICITY, FM_FACTOR_HELICITY, FM_CORRELATED_HELICITY
   use particles
   use subevt_expr
   use rng_base
   use process, only: process_t
   use instances, only: process_instance_t
   use pcm, only: pcm_instance_nlo_t
   use process_stacks
   use event_base
   use event_transforms
   use decays
   use evt_nlo
 
 <<Standard module head>>
 
 <<Events: public>>
 
 <<Events: types>>
 
 <<Events: interfaces>>
 
 contains
 
 <<Events: procedures>>
 
 end module events
 @ %def events
 @
 \subsection{Event configuration}
 The parameters govern the transformation of an event to a particle set.
 
 The [[safety_factor]] reduces the acceptance probability for
 unweighting.  If greater than one, excess events become less likely,
 but the reweighting efficiency also drops.
 
 The [[sigma]] and [[n]] values, if nontrivial, allow for reweighting
 the events according to the requested [[norm_mode]].
 
 Various [[parse_node_t]] objects are taken from the SINDARIN input.
 They encode expressions that apply to the current event.  The
 workspaces for evaluating those expressions are set up in the
 [[event_expr_t]] objects.  Note that these are really pointers,
 so the actual nodes are not stored inside the event object.
 <<Events: types>>=
   type :: event_config_t
      logical :: unweighted = .false.
      integer :: norm_mode = NORM_UNDEFINED
      integer :: factorization_mode = FM_IGNORE_HELICITY
      logical :: keep_correlations = .false.
      logical :: colorize_subevt = .false.
      real(default) :: sigma = 1
      integer :: n = 1
      real(default) :: safety_factor = 1
      class(expr_factory_t), allocatable :: ef_selection
      class(expr_factory_t), allocatable :: ef_reweight
      class(expr_factory_t), allocatable :: ef_analysis
    contains
    <<Events: event config: TBP>>
   end type event_config_t
 
 @ %def event_config_t
 @ Output.
 <<Events: event config: TBP>>=
   procedure :: write => event_config_write
 <<Events: procedures>>=
   subroutine event_config_write (object, unit, show_expressions)
     class(event_config_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: show_expressions
     integer :: u
     u = given_output_unit (unit)
     write (u, "(3x,A,L1)")  "Unweighted         = ", object%unweighted
     write (u, "(3x,A,A)")   "Normalization      = ", &
          char (event_normalization_string (object%norm_mode))
     write (u, "(3x,A)", advance="no")  "Helicity handling  = "
     select case (object%factorization_mode)
     case (FM_IGNORE_HELICITY)
        write (u, "(A)")  "drop"
     case (FM_SELECT_HELICITY)
        write (u, "(A)")  "select"
     case (FM_FACTOR_HELICITY)
        write (u, "(A)")  "factorize"
     end select
     write (u, "(3x,A,L1)")  "Keep correlations  = ", object%keep_correlations
     if (object%colorize_subevt) then
        write (u, "(3x,A,L1)")  "Colorize subevent  = ", object%colorize_subevt
     end if
     if (.not. nearly_equal (object%safety_factor, one)) then
        write (u, "(3x,A," // FMT_12 // ")")  &
             "Safety factor      = ", object%safety_factor
     end if
     if (present (show_expressions)) then
        if (show_expressions) then
           if (allocated (object%ef_selection)) then
              call write_separator (u)
              write (u, "(3x,A)") "Event selection expression:"
              call object%ef_selection%write (u)
           end if
           if (allocated (object%ef_reweight)) then
              call write_separator (u)
              write (u, "(3x,A)") "Event reweighting expression:"
              call object%ef_reweight%write (u)
           end if
           if (allocated (object%ef_analysis)) then
              call write_separator (u)
              write (u, "(3x,A)") "Analysis expression:"
              call object%ef_analysis%write (u)
           end if
        end if
     end if
   end subroutine event_config_write
 
 @ %def event_config_write
 @
 \subsection{The event type}
 This is the concrete implementation of the [[generic_event_t]] core
 that is defined above in the [[event_base]] module.  The core manages
 the main (dressed) particle set pointer and the current values for
 weights and sqme.  The implementation adds configuration data,
 expressions, process references, and event transforms.
 
 Each event refers to a single elementary process.  This process may be
 dressed by a shower, a decay chain etc.  We maintain pointers to a
 process instance.
 
 A list of event transforms (class [[evt_t]]) transform the connected
 interactions of the process instance into the final particle set.  In
 this list, the first transform is always the trivial one, which just
 factorizes the process instance.  Subsequent transforms may apply
 decays, etc.  The [[particle_set]] pointer identifies the particle set
 that we want to be analyzed and returned by the event, usually the
 last one.
 
 Squared matrix element and weight values: when reading events from
 file, the [[ref]] value is the number in the file, while the [[prc]]
 value is the number that we calculate from the momenta in the file,
 possibly with different parameters.  When generating events the first
 time, or if we do not recalculate, the numbers should coincide.
 Furthermore, the array of [[alt]] values is copied from an array of
 alternative event records.  These values should represent calculated
 values.
 
 The [[sqme]] and [[weight]] values mirror corresponding values in the
 [[expr]] subobject.  The idea is that when generating or reading
 events, the event record is filled first, then the [[expr]] object
 acquires copies.  These copies are used for writing events and as targets
 for pointer variables in the analysis expression.
 
 All data that involve user-provided expressions (selection, reweighting,
 analysis) are handled by the [[expr]] subobject.  In particular, evaluating
 the event-selection expression sets the [[passed]] flag.  Furthermore,
 the [[expr]] subobject collects data that can be used in the analysis
 and should be written to file, including copies of [[sqme]] and [[weight]].
 <<Events: public>>=
   public :: event_t
 <<Events: types>>=
   type, extends (generic_event_t) :: event_t
      type(event_config_t) :: config
      type(process_t), pointer :: process => null ()
      type(process_instance_t), pointer :: instance => null ()
      class(rng_t), allocatable :: rng
      integer :: selected_i_mci = 0
      integer :: selected_i_term = 0
      integer :: selected_channel = 0
      logical :: is_complete = .false.
      class(evt_t), pointer :: transform_first => null ()
      class(evt_t), pointer :: transform_last => null ()
      type(event_expr_t) :: expr
      logical :: selection_evaluated = .false.
      logical :: passed = .false.
      real(default), allocatable :: alpha_qcd_forced
      real(default), allocatable :: scale_forced
      real(default) :: reweight = 1
      logical :: analysis_flag = .false.
      integer :: i_event = 0
    contains
    <<Events: event: TBP>>
   end type event_t
 
 @ %def event_t
 @
 <<Events: event: TBP>>=
   procedure :: clone => event_clone
 <<Events: procedures>>=
   subroutine event_clone (event, event_new)
     class(event_t), intent(in), target :: event
     class(event_t), intent(out), target:: event_new
     type(string_t) :: id
     integer :: num_id
     event_new%config = event%config
     event_new%process => event%process
     event_new%instance => event%instance
     if (allocated (event%rng)) &
          allocate(event_new%rng, source=event%rng)
     event_new%selected_i_mci = event%selected_i_mci
     event_new%selected_i_term = event%selected_i_term
     event_new%selected_channel = event%selected_channel
     event_new%is_complete = event%is_complete
     event_new%transform_first => event%transform_first
     event_new%transform_last => event%transform_last
     event_new%selection_evaluated = event%selection_evaluated
     event_new%passed = event%passed
     if (allocated (event%alpha_qcd_forced)) &
          allocate(event_new%alpha_qcd_forced, source=event%alpha_qcd_forced)
     if (allocated (event%scale_forced)) &
          allocate(event_new%scale_forced, source=event%scale_forced)
     event_new%reweight = event%reweight
     event_new%analysis_flag = event%analysis_flag
     event_new%i_event = event%i_event
     id = event_new%process%get_id ()
     if (id /= "")  call event_new%expr%set_process_id (id)
     num_id = event_new%process%get_num_id ()
     if (num_id /= 0)  call event_new%expr%set_process_num_id (num_id)
     call event_new%expr%setup_vars (event_new%process%get_sqrts ())
     call event_new%expr%link_var_list (event_new%process%get_var_list_ptr ())
   end subroutine event_clone
 
 @ %def event_clone
 @ Finalizer: the list of event transforms is deleted iteratively.
 <<Events: event: TBP>>=
   procedure :: final => event_final
 <<Events: procedures>>=
   subroutine event_final (object)
     class(event_t), intent(inout) :: object
     class(evt_t), pointer :: evt
     if (allocated (object%rng))  call object%rng%final ()
     call object%expr%final ()
     do while (associated (object%transform_first))
        evt => object%transform_first
        object%transform_first => evt%next
        call evt%final ()
        deallocate (evt)
     end do
   end subroutine event_final
 
 @ %def event_final
 @ Output.
 
 The event index is written in the header, it should coincide with the
 [[event_index]] variable that can be used in selection and analysis.
 
 Particle set: this is a pointer to one of the event transforms, so it
 should suffice to print the latter.
 <<Events: event: TBP>>=
   procedure :: write => event_write
 <<Events: procedures>>=
   subroutine event_write (object, unit, show_process, show_transforms, &
        show_decay, verbose, testflag)
     class(event_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: show_process, show_transforms, show_decay
     logical, intent(in), optional :: verbose
     logical, intent(in), optional :: testflag
     logical :: prc, trans, dec, verb
     class(evt_t), pointer :: evt
     character(len=7) :: fmt
     integer :: u, i
     call pac_fmt (fmt, FMT_19, FMT_12, testflag)
     u = given_output_unit (unit)
     prc = .true.;  if (present (show_process))  prc = show_process
     trans = .true.;  if (present (show_transforms))  trans = show_transforms
     dec = .true.;  if (present (show_decay))  dec = show_decay
     verb = .false.;  if (present (verbose))  verb = verbose
     call write_separator (u, 2)
     write (u, "(1x,A)", advance="no")  "Event"
     if (object%has_index ()) then
        write (u, "(1x,'#',I0)", advance="no")  object%get_index ()
     end if
     if (object%is_complete) then
        write (u, *)
     else
        write (u, "(1x,A)")  "[incomplete]"
     end if
     call write_separator (u)
     call object%config%write (u)
     if (object%sqme_ref_is_known () .or. object%weight_ref_is_known ()) then
        call write_separator (u)
     end if
     if (object%sqme_ref_is_known ()) then
        write (u, "(3x,A," // fmt // ")") &
             "Squared matrix el. (ref) = ", object%get_sqme_ref ()
        if (object%sqme_alt_is_known ()) then
           do i = 1, object%get_n_alt ()
              write (u, "(5x,A," // fmt // ",1x,I0)")  &
                   "alternate sqme   = ", object%get_sqme_alt(i), i
           end do
        end if
     end if
     if (object%sqme_prc_is_known ()) &
        write (u, "(3x,A," // fmt // ")") &
             "Squared matrix el. (prc) = ", object%get_sqme_prc ()
 
     if (object%weight_ref_is_known ()) then
        write (u, "(3x,A," // fmt // ")") &
             "Event weight (ref)       = ", object%get_weight_ref ()
        if (object%weight_alt_is_known ()) then
           do i = 1, object%get_n_alt ()
              write (u, "(5x,A," // fmt // ",1x,I0)")  &
                   "alternate weight      = ", object%get_weight_alt(i), i
           end do
        end if
     end if
     if (object%weight_prc_is_known ()) &
        write (u, "(3x,A," // fmt // ")") &
             "Event weight (prc)       = ", object%get_weight_prc ()
 
     if (object%selected_i_mci /= 0) then
        call write_separator (u)
        write (u, "(3x,A,I0)")  "Selected MCI group = ", object%selected_i_mci
        write (u, "(3x,A,I0)")  "Selected term      = ", object%selected_i_term
        write (u, "(3x,A,I0)")  "Selected channel   = ", object%selected_channel
     end if
     if (object%selection_evaluated) then
        call write_separator (u)
        write (u, "(3x,A,L1)")  "Passed selection   = ", object%passed
        if (object%passed) then
           write (u, "(3x,A," // fmt // ")") &
                "Reweighting factor = ", object%reweight
           write (u, "(3x,A,L1)") &
                "Analysis flag      = ", object%analysis_flag
        end if
     end if
     if (associated (object%instance)) then
        if (prc) then
           if (verb) then
              call object%instance%write (u, testflag)
           else
              call object%instance%write_header (u)
           end if
        end if
        if (trans) then
           evt => object%transform_first
           do while (associated (evt))
              select type (evt)
              type is (evt_decay_t)
                 call evt%write (u, verbose = dec, more_verbose = verb, &
                      testflag = testflag)
              class default
                 call evt%write (u, verbose = verb, testflag = testflag)
              end select
              call write_separator (u, 2)
              evt => evt%next
           end do
        else
           call write_separator (u, 2)
        end if
        if (object%expr%subevt_filled) then
           call object%expr%write (u, pacified = testflag)
           call write_separator (u, 2)
        end if
     else
        call write_separator (u, 2)
        write (u, "(1x,A)")  "Process instance: [undefined]"
        call write_separator (u, 2)
     end if
   end subroutine event_write
 
 @ %def event_write
 @
 \subsection{Initialization}
 Initialize: set configuration parameters, using a variable list.  We
 do not call this [[init]], because this method name will be used by a type
 extension.
 
 The default normalization is [[NORM_SIGMA]], since the default
 generation mode is weighted.
 
 For unweighted events, we may want to a apply a safety factor to event
 rejection.  (By default, this factor is unity and can be ignored.)
 
 We also allocate the trivial event transform, which is always the
 first one.
 <<Events: event: TBP>>=
   procedure :: basic_init => event_init
 <<Events: procedures>>=
   subroutine event_init (event, var_list, n_alt)
     class(event_t), intent(out) :: event
     type(var_list_t), intent(in), optional :: var_list
     integer, intent(in), optional :: n_alt
     type(string_t) :: norm_string, mode_string
     logical :: polarized_events
     if (present (n_alt)) then
        call event%base_init (n_alt)
        call event%expr%init (n_alt)
     else
        call event%base_init (0)
     end if
     if (present (var_list)) then
        event%config%unweighted = var_list%get_lval (&
             var_str ("?unweighted"))
        norm_string = var_list%get_sval (&
             var_str ("$sample_normalization"))
        event%config%norm_mode = &
             event_normalization_mode (norm_string, event%config%unweighted)
        polarized_events = &
             var_list%get_lval (var_str ("?polarized_events"))
        if (polarized_events) then
           mode_string = &
                var_list%get_sval (var_str ("$polarization_mode"))
           select case (char (mode_string))
           case ("ignore")
              event%config%factorization_mode = FM_IGNORE_HELICITY
           case ("helicity")
              event%config%factorization_mode = FM_SELECT_HELICITY
           case ("factorized")
              event%config%factorization_mode = FM_FACTOR_HELICITY
           case ("correlated")
              event%config%factorization_mode = FM_CORRELATED_HELICITY
           case default
              call msg_fatal ("Polarization mode " &
                   // char (mode_string) // " is undefined")
           end select
        else
           event%config%factorization_mode = FM_IGNORE_HELICITY
        end if
        event%config%colorize_subevt = &
             var_list%get_lval (var_str ("?colorize_subevt"))
        if (event%config%unweighted) then
           event%config%safety_factor = var_list%get_rval (&
                var_str ("safety_factor"))
        end if
     else
        event%config%norm_mode = NORM_SIGMA
     end if
     allocate (evt_trivial_t :: event%transform_first)
     event%transform_last => event%transform_first
   end subroutine event_init
 
 @ %def event_init
 @ Set the [[sigma]] and [[n]] values in the configuration record that
 determine non-standard event normalizations.  If these numbers are not
 set explicitly, the default value for both is unity, and event
 renormalization has no effect.
 <<Events: event: TBP>>=
   procedure :: set_sigma => event_set_sigma
   procedure :: set_n => event_set_n
 <<Events: procedures>>=
   elemental subroutine event_set_sigma (event, sigma)
     class(event_t), intent(inout) :: event
     real(default), intent(in) :: sigma
     event%config%sigma = sigma
   end subroutine event_set_sigma
 
   elemental subroutine event_set_n (event, n)
     class(event_t), intent(inout) :: event
     integer, intent(in) :: n
     event%config%n = n
   end subroutine event_set_n
 
 @ %def event_set_n
 @ Append an event transform (decays, etc.).  The transform is not yet
 connected to a process.  The transform is then considered to belong to
 the event object, and will be finalized together with it.  The
 original pointer is removed.
 
 We can assume that the trivial transform is already present in the
 event object, at least.
 <<Events: event: TBP>>=
   procedure :: import_transform => event_import_transform
 <<Events: procedures>>=
   subroutine event_import_transform (event, evt)
     class(event_t), intent(inout) :: event
     class(evt_t), intent(inout), pointer :: evt
     event%transform_last%next => evt
     evt%previous => event%transform_last
     event%transform_last => evt
     evt => null ()
   end subroutine event_import_transform
 
 @ %def event_import_transform
 @
 We link the event to an existing process instance.  This
 includes the variable list, which is linked to the process variable
 list.  Note that this is not necessarily identical to the variable
 list used for event initialization.
 
 The variable list will contain pointers to [[event]] subobjects, therefore the
 [[target]] attribute.
 
 Once we have a process connected, we can use it to obtain an event
 generator instance.
 
 The model and process stack may be needed by event transforms.  The
 current model setting may be different from the model in the process
 (regarding unstable particles, etc.).  The process stack can be used
 for assigning extra processes that we need for the event transforms.
 <<Events: event: TBP>>=
   procedure :: connect => event_connect
 <<Events: procedures>>=
   subroutine event_connect (event, process_instance, model, process_stack)
     class(event_t), intent(inout), target :: event
     type(process_instance_t), intent(in), target :: process_instance
     class(model_data_t), intent(in), target :: model
     type(process_stack_t), intent(in), optional :: process_stack
     type(string_t) :: id
     integer :: num_id
     class(evt_t), pointer :: evt
     event%process => process_instance%process
     event%instance => process_instance
     id = event%process%get_id ()
     if (id /= "")  call event%expr%set_process_id (id)
     num_id = event%process%get_num_id ()
     if (num_id /= 0)  call event%expr%set_process_num_id (num_id)
     call event%expr%setup_vars (event%process%get_sqrts ())
     call event%expr%link_var_list (event%process%get_var_list_ptr ())
     call event%process%make_rng (event%rng)
     evt => event%transform_first
     do while (associated (evt))
        call evt%connect (process_instance, model, process_stack)
        evt => evt%next
     end do
   end subroutine event_connect
 
 @ %def event_connect
 @ Set the parse nodes for the associated expressions, individually.  The
 parse-node pointers may be null.
 <<Events: event: TBP>>=
   procedure :: set_selection => event_set_selection
   procedure :: set_reweight => event_set_reweight
   procedure :: set_analysis => event_set_analysis
 <<Events: procedures>>=
   subroutine event_set_selection (event, ef_selection)
     class(event_t), intent(inout) :: event
     class(expr_factory_t), intent(in) :: ef_selection
     allocate (event%config%ef_selection, source = ef_selection)
   end subroutine event_set_selection
 
   subroutine event_set_reweight (event, ef_reweight)
     class(event_t), intent(inout) :: event
     class(expr_factory_t), intent(in) :: ef_reweight
     allocate (event%config%ef_reweight, source = ef_reweight)
   end subroutine event_set_reweight
 
   subroutine event_set_analysis (event, ef_analysis)
     class(event_t), intent(inout) :: event
     class(expr_factory_t), intent(in) :: ef_analysis
     allocate (event%config%ef_analysis, source = ef_analysis)
   end subroutine event_set_analysis
 
 @ %def event_set_selection
 @ %def event_set_reweight
 @ %def event_set_analysis
 @ Create evaluation trees from the parse trees.  The [[target]] attribute is
 required because the expressions contain pointers to event subobjects.
 <<Events: event: TBP>>=
   procedure :: setup_expressions => event_setup_expressions
 <<Events: procedures>>=
   subroutine event_setup_expressions (event)
     class(event_t), intent(inout), target :: event
     call event%expr%setup_selection (event%config%ef_selection)
     call event%expr%setup_analysis (event%config%ef_analysis)
     call event%expr%setup_reweight (event%config%ef_reweight)
     call event%expr%colorize (event%config%colorize_subevt)
   end subroutine event_setup_expressions
 
 @ %def event_setup_expressions
 @
 \subsection{Evaluation}
 To fill the [[particle_set]], i.e., the event record proper, we have
 to apply all event transforms in order.  The last transform should
 fill its associated particle set, factorizing the state matrix
 according to the current settings.  There are several parameters
 in the event configuration that control this.
 
 We always fill the particle set for the first transform (the hard
 process) and the last transform, if different from the first (the
 fully dressed process).
 
 Each event transform is an event generator of its own.  We choose to
 generate an \emph{unweighted} event for each of them, even if the master
 event is assumed to be weighted.  Thus, the overall event weight is
 the one of the hard process only.  (There may be more options in future
 extensions.)
 
 We can generate the two random numbers that the factorization needs.
 For testing purpose, we allow for providing them explicitly, as an option.
 <<Events: event: TBP>>=
   procedure :: evaluate_transforms => event_evaluate_transforms
 <<Events: procedures>>=
   subroutine event_evaluate_transforms (event, r)
     class(event_t), intent(inout) :: event
     real(default), dimension(:), intent(in), optional :: r
     class(evt_t), pointer :: evt
     real(default) :: sigma_over_sqme
     integer :: i_term
     logical :: failed_but_keep
     failed_but_keep = .false.
     if (debug_on) call msg_debug (D_TRANSFORMS, "event_evaluate_transforms")
     call event%discard_particle_set ()
     call event%check ()
     if (event%instance%is_complete_event ()) then
        i_term = event%instance%select_i_term ()
        event%selected_i_term = i_term
        evt => event%transform_first
        do while (associated (evt))
           call evt%prepare_new_event &
                (event%selected_i_mci, event%selected_i_term)
           evt => evt%next
        end do
        evt => event%transform_first
        if (debug_on) call msg_debug (D_TRANSFORMS, "Before event transformations")
        if (debug_on) call msg_debug (D_TRANSFORMS, "event%weight_prc", event%weight_prc)
        if (debug_on) call msg_debug (D_TRANSFORMS, "event%sqme_prc", event%sqme_prc)
        do while (associated (evt))
           call print_transform_name_if_debug ()
           if (evt%only_weighted_events) then
              select type (evt)
              type is (evt_nlo_t)
                 failed_but_keep = .not. evt%is_valid_event (i_term) .and. evt%keep_failed_events
                 if (.not. evt%is_valid_event (i_term) .and. .not. failed_but_keep) &
                    return
              end select
              if (abs (event%weight_prc) > 0._default) then
                 sigma_over_sqme = event%weight_prc / event%sqme_prc
                 call evt%generate_weighted (event%sqme_prc)
                 event%weight_prc = sigma_over_sqme * event%sqme_prc
              else
                 if (.not. failed_but_keep) exit
              end if
           else
              call evt%generate_unweighted ()
           end if
           if (signal_is_pending ())  return
           call evt%make_particle_set (event%config%factorization_mode, &
                event%config%keep_correlations)
           if (signal_is_pending ())  return
           if (.not. evt%particle_set_exists) exit
           evt => evt%next
        end do
        evt => event%transform_last
        if ((associated (evt) .and. evt%particle_set_exists) .or. failed_but_keep) then
           if (event%is_nlo ()) then
              select type (evt)
              type is (evt_nlo_t)
                 if (evt%i_evaluation > 0) then
                    evt%particle_set_radiated (event%i_event + 1) = evt%particle_set
                 else
                    call evt%keep_and_boost_born_particle_set (event%i_event + 1)
                 end if
                 evt%i_evaluation = evt%i_evaluation + 1
                 call event%link_particle_set &
                    (evt%particle_set_radiated(event%i_event + 1))
              end select
           else
              call event%link_particle_set (evt%particle_set)
           end if
        end if
        if (debug_on) call msg_debug (D_TRANSFORMS, "After event transformations")
        if (debug_on) call msg_debug (D_TRANSFORMS, "event%weight_prc", event%weight_prc)
        if (debug_on) call msg_debug (D_TRANSFORMS, "event%sqme_prc", event%sqme_prc)
        if (debug_on) call msg_debug (D_TRANSFORMS, "evt%particle_set_exists", evt%particle_set_exists)
     end if
   contains
     subroutine print_transform_name_if_debug ()
        if (debug_active (D_TRANSFORMS)) then
           print *, 'Current event transform: '
           call evt%write_name ()
        end if
     end subroutine print_transform_name_if_debug
   end subroutine event_evaluate_transforms
 
 @ %def event_evaluate_transforms
 @ Set / increment the event index for the current event.  There is no
 condition for this to happen.  The event index is actually stored in
 the subevent expression, because this allows us to access it in
 subevent expressions as a variable.
 <<Events: event: TBP>>=
   procedure :: set_index => event_set_index
   procedure :: increment_index => event_increment_index
 <<Events: procedures>>=
   subroutine event_set_index (event, index)
     class(event_t), intent(inout) :: event
     integer, intent(in) :: index
     call event%expr%set_event_index (index)
   end subroutine event_set_index
   
   subroutine event_increment_index (event, offset)
     class(event_t), intent(inout) :: event
     integer, intent(in), optional :: offset
     call event%expr%increment_event_index (offset)
   end subroutine event_increment_index
   
 @ %def event_set_index
 @ %def event_increment_index
 @
 Evaluate the event-related expressions, given a valid
 [[particle_set]].  If [[update_sqme]] is set, we use the process
 instance for the [[sqme_prc]] value.  The [[sqme_ref]] value is
 always taken from the event record.
 <<Events: event: TBP>>=
   procedure :: evaluate_expressions => event_evaluate_expressions
 <<Events: procedures>>=
   subroutine event_evaluate_expressions (event)
     class(event_t), intent(inout) :: event
     if (event%has_valid_particle_set ()) then
        call event%expr%fill_subevt (event%get_particle_set_ptr ())
     end if
     if (event%weight_ref_is_known ()) then
        call event%expr%set (weight_ref = event%get_weight_ref ())
     end if
     if (event%weight_prc_is_known ()) then
        call event%expr%set (weight_prc = event%get_weight_prc ())
     end if
     if (event%excess_prc_is_known ()) then
        call event%expr%set (excess_prc = event%get_excess_prc ())
     end if
     if (event%sqme_ref_is_known ()) then
        call event%expr%set (sqme_ref = event%get_sqme_ref ())
     end if
     if (event%sqme_prc_is_known ()) then
        call event%expr%set (sqme_prc = event%get_sqme_prc ())
     end if
     if (event%has_valid_particle_set ()) then
        call event%expr%evaluate &
             (event%passed, event%reweight, event%analysis_flag)
        event%selection_evaluated = .true.
     end if
   end subroutine event_evaluate_expressions
 
 @ %def event_evaluate_expressions
 @ Report the result of the [[selection]] evaluation.
 <<Events: event: TBP>>=
   procedure :: passed_selection => event_passed_selection
 <<Events: procedures>>=
   function event_passed_selection (event) result (flag)
     class(event_t), intent(in) :: event
     logical :: flag
     flag = event%passed
   end function event_passed_selection
 
 @ %def event_passed_selection
 @ Set alternate sqme and weight arrays.  This should be merged with
 the previous routine, if the expressions are allowed to refer to these
 values.
 <<Events: event: TBP>>=
   procedure :: store_alt_values => event_store_alt_values
 <<Events: procedures>>=
   subroutine event_store_alt_values (event)
     class(event_t), intent(inout) :: event
     if (event%weight_alt_is_known ()) then
        call event%expr%set (weight_alt = event%get_weight_alt ())
     end if
     if (event%sqme_alt_is_known ()) then
        call event%expr%set (sqme_alt = event%get_sqme_alt ())
     end if
   end subroutine event_store_alt_values
 
 @ %def event_store_alt_values
 @
 <<Events: event: TBP>>=
   procedure :: is_nlo => event_is_nlo
 <<Events: procedures>>=
   function event_is_nlo (event) result (is_nlo)
     logical :: is_nlo
     class(event_t), intent(in) :: event
     if (associated (event%instance)) then
        select type (pcm => event%instance%pcm)
        type is (pcm_instance_nlo_t)
           is_nlo = pcm%is_fixed_order_nlo_events ()
        class default
           is_nlo = .false.
        end select
     else
        is_nlo = .false.
     end if
   end function event_is_nlo
 
 @ %def event_is_nlo
 @
 \subsection{Reset to empty state}
 Applying this, current event contents are marked as incomplete but
 are not deleted.  In particular, the initialization is kept.  The
 event index is also kept, this can be reset separately.
 <<Events: event: TBP>>=
   procedure :: reset_contents => event_reset_contents
   procedure :: reset_index => event_reset_index
 <<Events: procedures>>=
   subroutine event_reset_contents (event)
     class(event_t), intent(inout) :: event
     class(evt_t), pointer :: evt
     call event%base_reset_contents ()
     event%selected_i_mci = 0
     event%selected_i_term = 0
     event%selected_channel = 0
     event%is_complete = .false.
     call event%expr%reset_contents ()
     event%selection_evaluated = .false.
     event%passed = .false.
     event%analysis_flag = .false.
     if (associated (event%instance)) then
        call event%instance%reset (reset_mci = .true.)
     end if
     if (allocated (event%alpha_qcd_forced))  deallocate (event%alpha_qcd_forced)
     if (allocated (event%scale_forced))  deallocate (event%scale_forced)
     evt => event%transform_first
     do while (associated (evt))
        call evt%reset ()
        evt => evt%next
     end do
   end subroutine event_reset_contents
 
   subroutine event_reset_index (event)
     class(event_t), intent(inout) :: event
     call event%expr%reset_event_index ()
   end subroutine event_reset_index
 
 @ %def event_reset_contents
 @ %def event_reset_index
 @
 \subsection{Squared Matrix Element and Weight}
 Transfer the result of the process instance calculation to the
 event record header.
 <<Events: event: TBP>>=
   procedure :: import_instance_results => event_import_instance_results
 <<Events: procedures>>=
   subroutine event_import_instance_results (event)
     class(event_t), intent(inout) :: event
     if (associated (event%instance)) then
        if (event%instance%has_evaluated_trace ()) then
           call event%set ( &
                sqme_prc = event%instance%get_sqme (), &
                weight_prc = event%instance%get_weight (), &
                excess_prc = event%instance%get_excess (), &
                n_dropped = event%instance%get_n_dropped () &
                )
        end if
     end if
   end subroutine event_import_instance_results
 
 @ %def event_import_instance_results
 @ Duplicate the instance result / the reference result in the event
 record.
 <<Events: event: TBP>>=
   procedure :: accept_sqme_ref => event_accept_sqme_ref
   procedure :: accept_sqme_prc => event_accept_sqme_prc
   procedure :: accept_weight_ref => event_accept_weight_ref
   procedure :: accept_weight_prc => event_accept_weight_prc
 <<Events: procedures>>=
   subroutine event_accept_sqme_ref (event)
     class(event_t), intent(inout) :: event
     if (event%sqme_ref_is_known ()) then
        call event%set (sqme_prc = event%get_sqme_ref ())
     end if
   end subroutine event_accept_sqme_ref
 
   subroutine event_accept_sqme_prc (event)
     class(event_t), intent(inout) :: event
     if (event%sqme_prc_is_known ()) then
        call event%set (sqme_ref = event%get_sqme_prc ())
     end if
   end subroutine event_accept_sqme_prc
 
   subroutine event_accept_weight_ref (event)
     class(event_t), intent(inout) :: event
     if (event%weight_ref_is_known ()) then
        call event%set (weight_prc = event%get_weight_ref ())
     end if
   end subroutine event_accept_weight_ref
 
   subroutine event_accept_weight_prc (event)
     class(event_t), intent(inout) :: event
     if (event%weight_prc_is_known ()) then
        call event%set (weight_ref = event%get_weight_prc ())
     end if
   end subroutine event_accept_weight_prc
 
 @ %def event_accept_sqme_ref
 @ %def event_accept_sqme_prc
 @ %def event_accept_weight_ref
 @ %def event_accept_weight_prc
 @ Update the weight normalization, just after generation.  Unweighted
 and weighted events are generated with a different default
 normalization.  The intended normalization is stored in the
 configuration record.
 <<Events: event: TBP>>=
   procedure :: update_normalization => event_update_normalization
 <<Events: procedures>>=
   subroutine event_update_normalization (event, mode_ref)
     class(event_t), intent(inout) :: event
     integer, intent(in), optional :: mode_ref
     integer :: mode_old
     real(default) :: weight, excess
     if (present (mode_ref)) then
        mode_old = mode_ref
     else if (event%config%unweighted) then
        mode_old = NORM_UNIT
     else
        mode_old = NORM_SIGMA
     end if
     weight = event%get_weight_prc ()
     call event_normalization_update (weight, &
          event%config%sigma, event%config%n, &
          mode_new = event%config%norm_mode, &
          mode_old = mode_old)
     call event%set_weight_prc (weight)
     excess = event%get_excess_prc ()
     call event_normalization_update (excess, &
          event%config%sigma, event%config%n, &
          mode_new = event%config%norm_mode, &
          mode_old = mode_old)
     call event%set_excess_prc (excess)
   end subroutine event_update_normalization
 
 @ %def event_update_normalization
 @
 The event is complete if it has a particle set plus valid entries for
 the sqme and weight values.
 <<Events: event: TBP>>=
   procedure :: check => event_check
 <<Events: procedures>>=
   subroutine event_check (event)
     class(event_t), intent(inout) :: event
     event%is_complete = event%has_valid_particle_set () &
          .and. event%sqme_ref_is_known () &
          .and. event%sqme_prc_is_known () &
          .and. event%weight_ref_is_known () &
          .and. event%weight_prc_is_known ()
     if (event%get_n_alt () /= 0) then
        event%is_complete = event%is_complete &
             .and. event%sqme_alt_is_known () &
             .and. event%weight_alt_is_known ()
     end if
   end subroutine event_check
 
 @ %def event_check
 @
 @
 \subsection{Generation}
 Assuming that we have a valid process associated to the event, we
 generate an event.  We complete the event data, then factorize the
 spin density matrix and transfer it to the particle set.
 
 When done, we retrieve squared matrix element and weight.  In case of
 explicit generation, the reference values coincide with the process
 values, so we [[accept]] the latter.
 
 The explicit random number argument [[r]] should be generated by a
 random-number generator.  It is taken for the factorization algorithm,
 bypassing the event-specific random-number generator.  This is useful
 for deterministic testing.
 <<Events: event: TBP>>=
   procedure :: generate => event_generate
 <<Events: procedures>>=
   subroutine event_generate (event, i_mci, r, i_nlo)
     class(event_t), intent(inout) :: event
     integer, intent(in) :: i_mci
     real(default), dimension(:), intent(in), optional :: r
     integer, intent(in), optional :: i_nlo
     logical :: generate_new
     generate_new = .true.
     if (present (i_nlo)) generate_new = (i_nlo == 1)
     if (generate_new) call event%reset_contents ()
     event%selected_i_mci = i_mci
     if (event%config%unweighted) then
        call event%instance%generate_unweighted_event (i_mci)
        if (signal_is_pending ()) return
        call event%instance%evaluate_event_data ()
        call event%instance%normalize_weight ()
     else
        if (generate_new) &
           call event%instance%generate_weighted_event (i_mci)
        if (signal_is_pending ()) return
        call event%instance%evaluate_event_data ()
     end if
     event%selected_channel = event%instance%get_channel ()
     call event%import_instance_results ()
     call event%accept_sqme_prc ()
     call event%update_normalization ()
     call event%accept_weight_prc ()
     call event%evaluate_transforms (r)
     if (signal_is_pending ())  return
     call event%check ()
   end subroutine event_generate
 
 @ %def event_generate
 @ Get a copy of the particle set belonging to the hard process.
 <<Events: event: TBP>>=
   procedure :: get_hard_particle_set => event_get_hard_particle_set
 <<Events: procedures>>=
   subroutine event_get_hard_particle_set (event, pset)
     class(event_t), intent(in) :: event
     type(particle_set_t), intent(out) :: pset
     class(evt_t), pointer :: evt
     evt => event%transform_first
     pset = evt%particle_set
   end subroutine event_get_hard_particle_set
 
 @ %def event_get_hard_particle_set
 @
 \subsection{Recovering an event}
 Select MC group, term, and integration channel.
 <<Events: event: TBP>>=
   procedure :: select => event_select
 <<Events: procedures>>=
   subroutine event_select (event, i_mci, i_term, channel)
     class(event_t), intent(inout) :: event
     integer, intent(in) :: i_mci, i_term, channel
     if (associated (event%instance)) then
        event%selected_i_mci = i_mci
        event%selected_i_term = i_term
        event%selected_channel = channel
     else
        event%selected_i_mci = 0
        event%selected_i_term = 0
        event%selected_channel = 0
     end if
   end subroutine event_select
 
 @ %def event_select
 @
 Copy a particle set into the event record.
 
 We deliberately use the first (the trivial) transform for this, i.e.,
 the hard process.  The event reader may either read in the transformed
 event separately, or apply all event
 transforms to the hard particle set to (re)generate a fully dressed
 event.
 
 Since this makes all subsequent event transforms invalid, we call
 [[reset]] on them.
 <<Events: event: TBP>>=
   procedure :: set_hard_particle_set => event_set_hard_particle_set
 <<Events: procedures>>=
   subroutine event_set_hard_particle_set (event, particle_set)
     class(event_t), intent(inout) :: event
     type(particle_set_t), intent(in) :: particle_set
     class(evt_t), pointer :: evt
     evt => event%transform_first
     call evt%set_particle_set (particle_set, &
          event%selected_i_mci, event%selected_i_term)
     call event%link_particle_set (evt%particle_set)
     evt => evt%next
     do while (associated (evt))
        call evt%reset ()
        evt => evt%next
     end do
   end subroutine event_set_hard_particle_set
 
 @ %def event_set_hard_particle_set
 @
 Set the $\alpha_s$ value that should be used in a recalculation.  This should
 be called only if we explicitly want to override the QCD setting of the
 process core.
 <<Events: event: TBP>>=
   procedure :: set_alpha_qcd_forced => event_set_alpha_qcd_forced
 <<Events: procedures>>=
   subroutine event_set_alpha_qcd_forced (event, alpha_qcd)
     class(event_t), intent(inout) :: event
     real(default), intent(in) :: alpha_qcd
     if (allocated (event%alpha_qcd_forced)) then
        event%alpha_qcd_forced = alpha_qcd
     else
        allocate (event%alpha_qcd_forced, source = alpha_qcd)
     end if
   end subroutine event_set_alpha_qcd_forced
 
 @ %def event_set_alpha_qcd_forced
 @
 Analogously, for the common scale.  This forces also renormalization and
 factorization scale.
 <<Events: event: TBP>>=
   procedure :: set_scale_forced => event_set_scale_forced
 <<Events: procedures>>=
   subroutine event_set_scale_forced (event, scale)
     class(event_t), intent(inout) :: event
     real(default), intent(in) :: scale
     if (allocated (event%scale_forced)) then
        event%scale_forced = scale
     else
        allocate (event%scale_forced, source = scale)
     end if
   end subroutine event_set_scale_forced
 
 @ %def event_set_scale_forced
 @
 Here we try to recover an event from the [[particle_set]] subobject
 and recalculate the structure functions and matrix elements.  We
 have the appropriate [[process]] object and an initialized
 [[process_instance]] at hand, so beam and configuration data are
 known.  From the [[particle_set]], we get the momenta.
 
 The quantum-number information may be incomplete, e.g., helicity
 information may be partial or absent.  We recover the event just from
 the momentum configuration.
 
 We do not transfer the matrix element from the process instance to the
 event record, as we do when generating an event.  The event record may
 contain the matrix element as read from file, and the current
 calculation may use different parameters.  We thus can compare old and
 new values.
 
 The event [[weight]] may also be known already.  If yes, we pass it to the
 [[evaluate_event_data]] procedure.  It should already be normalized.  If we
 have an [[weight_factor]] value, we obtain the event weight by multiplying the
 computed [[sqme]] by this factor.  Otherwise, we make use of the MCI setup
 (which should be valid then) to compute the event weight, and we should
 normalize the result just as when generating events.
 
 Evaluating event expressions must also be done separately.
 
 If [[recover_phs]] is set (and false), do not attempt any phase-space
 calculation, including MCI evaluation.  Useful if we need only matrix elements.
 <<Events: event: TBP>>=
   procedure :: recalculate => event_recalculate
 <<Events: procedures>>=
   subroutine event_recalculate &
        (event, update_sqme, weight_factor, recover_beams, recover_phs)
     class(event_t), intent(inout) :: event
     logical, intent(in) :: update_sqme
     real(default), intent(in), optional :: weight_factor
     logical, intent(in), optional :: recover_beams
     logical, intent(in), optional :: recover_phs
     type(particle_set_t), pointer :: particle_set
     integer :: i_mci, i_term, channel
     logical :: rec_phs_mci
     rec_phs_mci = .true.;  if (present (recover_phs))  rec_phs_mci = recover_phs
     if (event%has_valid_particle_set ()) then
        particle_set => event%get_particle_set_ptr ()
        i_mci = event%selected_i_mci
        i_term = event%selected_i_term
        channel = event%selected_channel
        if (i_mci == 0 .or. i_term == 0 .or. channel == 0) then
           call msg_bug ("Event: recalculate: undefined selection parameters")
        end if
        call event%instance%choose_mci (i_mci)
        call event%instance%set_trace (particle_set, i_term, recover_beams)
        if (allocated (event%alpha_qcd_forced)) then
           call event%instance%set_alpha_qcd_forced &
                (i_term, event%alpha_qcd_forced)
        end if
        call event%instance%recover (channel, i_term, &
             update_sqme, rec_phs_mci, event%scale_forced)
        if (signal_is_pending ())  return
        if (update_sqme .and. present (weight_factor)) then
           call event%instance%evaluate_event_data &
                (weight = event%instance%get_sqme () * weight_factor)
        else if (event%weight_ref_is_known ()) then
           call event%instance%evaluate_event_data &
                (weight = event%get_weight_ref ())
        else if (rec_phs_mci) then
           call event%instance%recover_event ()
           if (signal_is_pending ())  return
           call event%instance%evaluate_event_data ()
           if (event%config%unweighted) then
              call event%instance%normalize_weight ()
           end if
        end if
        if (signal_is_pending ())  return
        if (update_sqme) then
           call event%import_instance_results ()
        else
           call event%accept_sqme_ref ()
           call event%accept_weight_ref ()
        end if
     else
        call msg_bug ("Event: can't recalculate, particle set is undefined")
     end if
   end subroutine event_recalculate
 
 @ %def event_recalculate
 @
 \subsection{Access content}
 Pointer to the associated process object (the associated model).
 <<Events: event: TBP>>=
   procedure :: get_process_ptr => event_get_process_ptr
   procedure :: get_process_instance_ptr => event_get_process_instance_ptr
   procedure :: get_model_ptr => event_get_model_ptr
 <<Events: procedures>>=
   function event_get_process_ptr (event) result (ptr)
     class(event_t), intent(in) :: event
     type(process_t), pointer :: ptr
     ptr => event%process
   end function event_get_process_ptr
 
   function event_get_process_instance_ptr (event) result (ptr)
     class(event_t), intent(in) :: event
     type(process_instance_t), pointer :: ptr
     ptr => event%instance
   end function event_get_process_instance_ptr
 
   function event_get_model_ptr (event) result (model)
     class(event_t), intent(in) :: event
     class(model_data_t), pointer :: model
     if (associated (event%process)) then
        model => event%process%get_model_ptr ()
     else
        model => null ()
     end if
   end function event_get_model_ptr
 
 @ %def event_get_process_ptr
 @ %def event_get_process_instance_ptr
 @ %def event_get_model_ptr
 @ Return the current values of indices: the MCI group of components, the term
 index (different terms corresponding, potentially, to different effective
 kinematics), and the MC integration channel.  The [[i_mci]] call is delegated
 to the current process instance.
 <<Events: event: TBP>>=
   procedure :: get_i_mci => event_get_i_mci
   procedure :: get_i_term => event_get_i_term
   procedure :: get_channel => event_get_channel
 <<Events: procedures>>=
   function event_get_i_mci (event) result (i_mci)
     class(event_t), intent(in) :: event
     integer :: i_mci
     i_mci = event%selected_i_mci
   end function event_get_i_mci
 
   function event_get_i_term (event) result (i_term)
     class(event_t), intent(in) :: event
     integer :: i_term
     i_term = event%selected_i_term
   end function event_get_i_term
 
   function event_get_channel (event) result (channel)
     class(event_t), intent(in) :: event
     integer :: channel
     channel = event%selected_channel
   end function event_get_channel
 
 @ %def event_get_i_mci
 @ %def event_get_i_term
 @ %def event_get_channel
 @ This flag tells us whether the event consists just of a hard process
 (i.e., holds at most the first, trivial transform), or is a dressed
 events with additional transforms.
 <<Events: event: TBP>>=
   procedure :: has_transform => event_has_transform
 <<Events: procedures>>=
   function event_has_transform (event) result (flag)
     class(event_t), intent(in) :: event
     logical :: flag
     if (associated (event%transform_first)) then
        flag = associated (event%transform_first%next)
     else
        flag = .false.
     end if
   end function event_has_transform
 
 @ %def event_has_transform
 @ Return the currently selected normalization mode, or alternate
 normalization mode.
 <<Events: event: TBP>>=
   procedure :: get_norm_mode => event_get_norm_mode
 <<Events: procedures>>=
   elemental function event_get_norm_mode (event) result (norm_mode)
     class(event_t), intent(in) :: event
     integer :: norm_mode
     norm_mode = event%config%norm_mode
   end function event_get_norm_mode
 
 @ %def event_get_norm_mode
 @ Return the kinematical weight, defined as the ratio of event weight
 and squared matrix element.
 <<Events: event: TBP>>=
   procedure :: get_kinematical_weight => event_get_kinematical_weight
 <<Events: procedures>>=
   function event_get_kinematical_weight (event) result (f)
     class(event_t), intent(in) :: event
     real(default) :: f
     if (event%sqme_ref_is_known () .and. event%weight_ref_is_known () &
          .and. abs (event%get_sqme_ref ()) > 0) then
        f = event%get_weight_ref () / event%get_sqme_ref ()
     else
        f = 0
     end if
   end function event_get_kinematical_weight
 
 @ %def event_get_kinematical_weight
 @ Return data used by external event formats.
 <<Events: event: TBP>>=
   procedure :: has_index => event_has_index 
   procedure :: get_index => event_get_index 
   procedure :: get_fac_scale => event_get_fac_scale
   procedure :: get_alpha_s => event_get_alpha_s
   procedure :: get_sqrts => event_get_sqrts
   procedure :: get_polarization => event_get_polarization
   procedure :: get_beam_file => event_get_beam_file
   procedure :: get_process_name => event_get_process_name
 <<Events: procedures>>=
   function event_has_index (event) result (flag)
     class(event_t), intent(in) :: event
     logical :: flag
     flag = event%expr%has_event_index ()
   end function event_has_index
 
   function event_get_index (event) result (index)
     class(event_t), intent(in) :: event
     integer :: index
     index = event%expr%get_event_index ()
   end function event_get_index
 
   function event_get_fac_scale (event) result (fac_scale)
     class(event_t), intent(in) :: event
     real(default) :: fac_scale
     fac_scale = event%instance%get_fac_scale (event%selected_i_term)
   end function event_get_fac_scale
 
   function event_get_alpha_s (event) result (alpha_s)
     class(event_t), intent(in) :: event
     real(default) :: alpha_s
     alpha_s = event%instance%get_alpha_s (event%selected_i_term)
   end function event_get_alpha_s
 
   function event_get_sqrts (event) result (sqrts)
     class(event_t), intent(in) :: event
     real(default) :: sqrts
     sqrts = event%instance%get_sqrts ()
   end function event_get_sqrts
 
   function event_get_polarization (event) result (pol)
     class(event_t), intent(in) :: event
     real(default), dimension(2) :: pol
     pol = event%instance%get_polarization ()
   end function event_get_polarization
 
   function event_get_beam_file (event) result (file)
     class(event_t), intent(in) :: event
     type(string_t) :: file
     file = event%instance%get_beam_file ()
   end function event_get_beam_file
 
   function event_get_process_name (event) result (name)
     class(event_t), intent(in) :: event
     type(string_t) :: name
     name = event%instance%get_process_name ()
   end function event_get_process_name
 
 @ %def event_get_index
 @ %def event_get_fac_scale
 @ %def event_get_alpha_s
 @ %def event_get_sqrts
 @ %def event_get_polarization
 @ %def event_get_beam_file
 @ %def event_get_process_name
 @ Return the actual number of calls, as stored in the process instance.
 <<Events: event: TBP>>=
   procedure :: get_actual_calls_total => event_get_actual_calls_total
 <<Events: procedures>>=
   elemental function event_get_actual_calls_total (event) result (n)
     class(event_t), intent(in) :: event
     integer :: n
     if (associated (event%instance)) then
        n = event%instance%get_actual_calls_total ()
     else
        n = 0
     end if
   end function event_get_actual_calls_total
 
 @ %def event_get_actual_calls_total
 @
 Eliminate numerical noise in the [[subevt]] expression and in the event
 transforms (which includes associated process instances).
 <<Events: public>>=
   public :: pacify
 <<Events: interfaces>>=
   interface pacify
      module procedure pacify_event
   end interface pacify
 <<Events: procedures>>=
   subroutine pacify_event (event)
     class(event_t), intent(inout) :: event
     class(evt_t), pointer :: evt
     call event%pacify_particle_set ()
     if (event%expr%subevt_filled)  call pacify (event%expr)
     evt => event%transform_first
     do while (associated (evt))
        select type (evt)
        type is (evt_decay_t);  call pacify (evt)
        end select
        evt => evt%next
     end do
   end subroutine pacify_event
 
 @ %def pacify
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[events_ut.f90]]>>=
 <<File header>>
 
 module events_ut
   use unit_tests
   use events_uti
 
 <<Standard module head>>
 
 <<Events: public test>>
 
 contains
 
 <<Events: test driver>>
 
 end module events_ut
 @ %def events_ut
 @
 <<[[events_uti.f90]]>>=
 <<File header>>
 
 module events_uti
 
 <<Use kinds>>
 <<Use strings>>
   use os_interface
   use model_data
   use particles
   use process_libraries
   use process_stacks
   use event_transforms
   use decays
   use decays_ut, only: prepare_testbed
 
   use process, only: process_t
   use instances, only: process_instance_t
 
   use events
 
 <<Standard module head>>
 
 <<Events: test declarations>>
 
 contains
 
 <<Events: tests>>
 
 end module events_uti
 
 @ %def events_uti
 @ API: driver for the unit tests below.
 <<Events: public test>>=
   public :: events_test
 <<Events: test driver>>=
   subroutine events_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Events: execute tests>>
   end subroutine events_test
 
 @ %def events_test
 @
 \subsubsection{Empty event record}
 <<Events: execute tests>>=
   call test (events_1, "events_1", &
        "empty event record", &
        u, results)
 <<Events: test declarations>>=
   public :: events_1
 <<Events: tests>>=
   subroutine events_1 (u)
     integer, intent(in) :: u
     type(event_t), target :: event
 
     write (u, "(A)")  "* Test output: events_1"
     write (u, "(A)")  "*   Purpose: display an empty event object"
     write (u, "(A)")
 
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: events_1"
 
   end subroutine events_1
 
 @ %def events_1
 @
 \subsubsection{Simple event}
 <<Events: execute tests>>=
   call test (events_2, "events_2", &
        "generate event", &
        u, results)
 <<Events: test declarations>>=
   public :: events_2
 <<Events: tests>>=
   subroutine events_2 (u)
     use processes_ut, only: prepare_test_process, cleanup_test_process
     integer, intent(in) :: u
     type(event_t), allocatable, target :: event
     type(process_t), allocatable, target :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(model_data_t), target :: model
 
     write (u, "(A)")  "* Test output: events_2"
     write (u, "(A)")  "*   Purpose: generate and display an event"
     write (u, "(A)")
 
     call model%init_test ()
 
     write (u, "(A)")  "* Generate test process event"
 
     allocate (process)
     allocate (process_instance)
     call prepare_test_process (process, process_instance, model)
     call process_instance%setup_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize event object"
 
     allocate (event)
     call event%basic_init ()
     call event%connect (process_instance, process%get_model_ptr ())
 
     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"
     write (u, "(A)")
 
     call event%generate (1, [0.4_default, 0.4_default])
     call event%increment_index ()
     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 model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: events_2"
 
   end subroutine events_2
 
 @ %def events_2
 @
 \subsubsection{Recovering an event}
 Generate an event and store the particle set.  Then reset the event
 record, recall the particle set, and recover the event from that.
 <<Events: execute tests>>=
   call test (events_4, "events_4", &
        "recover event", &
        u, results)
 <<Events: test declarations>>=
   public :: events_4
 <<Events: tests>>=
   subroutine events_4 (u)
     use processes_ut, only: prepare_test_process, cleanup_test_process
     integer, intent(in) :: u
     type(event_t), allocatable, target :: event
     type(process_t), allocatable, target :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(process_t), allocatable, target :: process2
     type(process_instance_t), allocatable, target :: process2_instance
     type(particle_set_t) :: particle_set
     type(model_data_t), target :: model
 
     write (u, "(A)")  "* Test output: events_4"
     write (u, "(A)")  "*   Purpose: generate and recover an event"
     write (u, "(A)")
 
     call model%init_test ()
 
     write (u, "(A)")  "* Generate test process event and save particle set"
     write (u, "(A)")
 
     allocate (process)
     allocate (process_instance)
     call prepare_test_process (process, process_instance, model)
     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 ()
     call event%write (u)
 
     particle_set = event%get_particle_set_ptr ()
     ! NB: 'particle_set' contains pointers to the model within 'process'
 
     call event%final ()
     deallocate (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover event from particle set"
     write (u, "(A)")
 
     allocate (process2)
     allocate (process2_instance)
     call prepare_test_process (process2, process2_instance, model)
     call process2_instance%setup_event_data ()
 
     allocate (event)
     call event%basic_init ()
     call event%connect (process2_instance, process2%get_model_ptr ())
 
     call event%select (1, 1, 1)
     call event%set_hard_particle_set (particle_set)
     call event%recalculate (update_sqme = .true.)
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Transfer sqme and evaluate expressions"
     write (u, "(A)")
 
     call event%accept_sqme_prc ()
     call event%accept_weight_prc ()
     call event%check ()
     call event%set_index (1)
     call event%evaluate_expressions ()
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset contents"
     write (u, "(A)")
 
     call event%reset_contents ()
     call event%reset_index ()
     event%transform_first%particle_set_exists = .false.
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call particle_set%final ()
 
     call event%final ()
     deallocate (event)
 
     call cleanup_test_process (process2, process2_instance)
     deallocate (process2_instance)
     deallocate (process2)
 
     call cleanup_test_process (process, process_instance)
     deallocate (process_instance)
     deallocate (process)
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: events_4"
 
   end subroutine events_4
 
 @ %def events_4
 @
 \subsubsection{Partially Recovering an event}
 Generate an event and store the particle set.  Then reset the event
 record, recall the particle set, and recover the event as far as possible
 without recomputing the squared matrix element.
 <<Events: execute tests>>=
   call test (events_5, "events_5", &
        "partially recover event", &
        u, results)
 <<Events: test declarations>>=
   public :: events_5
 <<Events: tests>>=
   subroutine events_5 (u)
     use processes_ut, only: prepare_test_process, cleanup_test_process
     integer, intent(in) :: u
     type(event_t), allocatable, target :: event
     type(process_t), allocatable, target :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(process_t), allocatable, target :: process2
     type(process_instance_t), allocatable, target :: process2_instance
     type(particle_set_t) :: particle_set
     real(default) :: sqme, weight
     type(model_data_t), target :: model
 
     write (u, "(A)")  "* Test output: events_5"
     write (u, "(A)")  "*   Purpose: generate and recover an event"
     write (u, "(A)")
 
     call model%init_test ()
 
     write (u, "(A)")  "* Generate test process event and save particle set"
     write (u, "(A)")
 
     allocate (process)
     allocate (process_instance)
     call prepare_test_process (process, process_instance, model)
     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 ()
     call event%write (u)
 
     particle_set = event%get_particle_set_ptr ()
     sqme = event%get_sqme_ref ()
     weight = event%get_weight_ref ()
 
     call event%final ()
     deallocate (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover event from particle set"
     write (u, "(A)")
 
     allocate (process2)
     allocate (process2_instance)
     call prepare_test_process (process2, process2_instance, model)
     call process2_instance%setup_event_data ()
 
     allocate (event)
     call event%basic_init ()
     call event%connect (process2_instance, process2%get_model_ptr ())
 
     call event%select (1, 1, 1)
     call event%set_hard_particle_set (particle_set)
     call event%recalculate (update_sqme = .false.)
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Manually set sqme and evaluate expressions"
     write (u, "(A)")
 
     call event%set (sqme_ref = sqme, weight_ref = weight)
     call event%accept_sqme_ref ()
     call event%accept_weight_ref ()
     call event%set_index (1)
     call event%evaluate_expressions ()
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call particle_set%final ()
 
     call event%final ()
     deallocate (event)
 
     call cleanup_test_process (process2, process2_instance)
     deallocate (process2_instance)
     deallocate (process2)
 
     call cleanup_test_process (process, process_instance)
     deallocate (process_instance)
     deallocate (process)
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: events_5"
 
   end subroutine events_5
 
 @ %def events_5
 @
 \subsubsection{Decays}
 Generate an event with subsequent decays.
 <<Events: execute tests>>=
   call test (events_6, "events_6", &
        "decays", &
        u, results)
 <<Events: test declarations>>=
   public :: events_6
 <<Events: tests>>=
   subroutine events_6 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     class(model_data_t), pointer :: model
     type(string_t) :: prefix, procname1, procname2
     type(process_library_t), target :: lib
     type(process_stack_t) :: process_stack
     class(evt_t), pointer :: evt_decay
     type(event_t), allocatable, target :: event
     type(process_t), pointer :: process
     type(process_instance_t), allocatable, target :: process_instance
 
     write (u, "(A)")  "* Test output: events_6"
     write (u, "(A)")  "*   Purpose: generate an event with subsequent decays"
     write (u, "(A)")
 
     write (u, "(A)")  "* Generate test process and decay"
     write (u, "(A)")
 
     call os_data%init ()
 
     prefix = "events_6"
     procname1 = prefix // "_p"
     procname2 = prefix // "_d"
     call prepare_testbed &
          (lib, process_stack, prefix, os_data, &
          scattering=.true., decay=.true.)
 
     write (u, "(A)")  "* Initialize decay process"
 
     process => process_stack%get_process_ptr (procname1)
     model => process%get_model_ptr ()
     call model%set_unstable (25, [procname2])
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%setup_event_data ()
     call process_instance%init_simulation (1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize event transform: decay"
 
     allocate (evt_decay_t :: evt_decay)
     call evt_decay%connect (process_instance, model, process_stack)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize event object"
     write (u, "(A)")
 
     allocate (event)
     call event%basic_init ()
     call event%connect (process_instance, model)
     call event%import_transform (evt_decay)
 
     call event%write (u, show_decay = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate event"
     write (u, "(A)")
 
     call event%generate (1, [0.4_default, 0.4_default])
     call event%increment_index ()
     call event%evaluate_expressions ()
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call event%final ()
     deallocate (event)
 
     call process_instance%final ()
     deallocate (process_instance)
 
     call process_stack%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: events_6"
 
   end subroutine events_6
 
 @ %def events_6
 @
 \subsubsection{Decays}
 Generate a decay event with varying options.
 <<Events: execute tests>>=
   call test (events_7, "events_7", &
        "decay options", &
        u, results)
 <<Events: test declarations>>=
   public :: events_7
 <<Events: tests>>=
   subroutine events_7 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     class(model_data_t), pointer :: model
     type(string_t) :: prefix, procname2
     type(process_library_t), target :: lib
     type(process_stack_t) :: process_stack
     type(process_t), pointer :: process
     type(process_instance_t), allocatable, target :: process_instance
 
     write (u, "(A)")  "* Test output: events_7"
     write (u, "(A)")  "*   Purpose: check decay options"
     write (u, "(A)")
 
     write (u, "(A)")  "* Prepare test process"
     write (u, "(A)")
 
     call os_data%init ()
 
     prefix = "events_7"
     procname2 = prefix // "_d"
     call prepare_testbed &
          (lib, process_stack, prefix, os_data, &
          scattering=.false., decay=.true.)
 
     write (u, "(A)")  "* Generate decay event, default options"
     write (u, "(A)")
 
     process => process_stack%get_process_ptr (procname2)
     model => process%get_model_ptr ()
     call model%set_unstable (25, [procname2])
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%setup_event_data (model)
     call process_instance%init_simulation (1)
 
     call process_instance%generate_weighted_event (1)
     call process_instance%write (u)
 
     call process_instance%final ()
     deallocate (process_instance)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate decay event, helicity-diagonal decay"
     write (u, "(A)")
 
     process => process_stack%get_process_ptr (procname2)
     model => process%get_model_ptr ()
     call model%set_unstable (25, [procname2], diagonal = .true.)
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%setup_event_data (model)
     call process_instance%init_simulation (1)
 
     call process_instance%generate_weighted_event (1)
     call process_instance%write (u)
 
     call process_instance%final ()
     deallocate (process_instance)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate decay event, isotropic decay, &
          &polarized final state"
     write (u, "(A)")
 
     process => process_stack%get_process_ptr (procname2)
     model => process%get_model_ptr ()
     call model%set_unstable (25, [procname2], isotropic = .true.)
     call model%set_polarized (6)
     call model%set_polarized (-6)
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%setup_event_data (model)
     call process_instance%init_simulation (1)
 
     call process_instance%generate_weighted_event (1)
     call process_instance%write (u)
 
     call process_instance%final ()
     deallocate (process_instance)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call process_stack%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: events_7"
 
   end subroutine events_7
 
 @ %def events_7
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Raw Event I/O}
 The raw format is for internal use only.  All data are stored
 unformatted, so they can be efficiently be re-read on the same
 machine, but not necessarily on another machine.
 
 This module explicitly depends on the [[events]] module which provides the
 concrete implementation of [[event_base]].  The other I/O formats
 access only the methods that are defined in [[event_base]].
 <<[[eio_raw.f90]]>>=
 <<File header>>
 
 module eio_raw
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use diagnostics
   use model_data
   use particles
   use event_base
   use eio_data
   use eio_base
   use events
 
 <<Standard module head>>
 
 <<EIO raw: public>>
 
 <<EIO raw: parameters>>
 
 <<EIO raw: types>>
 
 contains
 
 <<EIO raw: procedures>>
 
 end module eio_raw
 @ %def eio_raw
 @
 \subsection{File Format Version}
 This is the current default file version.
 <<EIO raw: parameters>>=
   integer, parameter :: CURRENT_FILE_VERSION = 2
 
 @ %def CURRENT_FILE_VERSION
 @ The user may change this number; this should force some
 compatibility mode for reading and writing.  In any case, the file
 version stored in a event file that we read has to match the expected
 file version.
 
 History of version numbers:
 \begin{enumerate}
 \item
   Format for WHIZARD 2.2.0 to 2.2.3.  No version number stored in the raw file.
 \item
   Format from 2.2.4 on.  File contains version number.  The file
   contains the transformed particle set (if applicable) after the
   hard-process particle set.
 \end{enumerate}
 @
 \subsection{Type}
 Note the file version number.  The default may be reset during
 initialization, which should enforce some compatibility mode.
 <<EIO raw: public>>=
   public :: eio_raw_t
 <<EIO raw: types>>=
   type, extends (eio_t) :: eio_raw_t
      logical :: reading = .false.
      logical :: writing = .false.
      integer :: unit = 0
      integer :: norm_mode = NORM_UNDEFINED
      real(default) :: sigma = 1
      integer :: n = 1
      integer :: n_alt = 0
      logical :: check = .false.
      logical :: use_alphas_from_file = .false.
      logical :: use_scale_from_file = .false.
      integer :: file_version = CURRENT_FILE_VERSION
    contains
    <<EIO raw: eio raw: TBP>>
   end type eio_raw_t
 
 @ %def eio_raw_t
 @ Output.  This is not the actual event format, but a readable account
 of the current object status.
 <<EIO raw: eio raw: TBP>>=
   procedure :: write => eio_raw_write
 <<EIO raw: procedures>>=
   subroutine eio_raw_write (object, unit)
     class(eio_raw_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Raw event stream:"
     write (u, "(3x,A,L1)")  "Check MD5 sum     = ", object%check
     if (object%n_alt > 0) then
        write (u, "(3x,A,I0)")  "Alternate weights = ", object%n_alt
     end if
     write (u, "(3x,A,L1)")    "Alpha_s from file = ", &
          object%use_alphas_from_file
     write (u, "(3x,A,L1)")    "Scale from file   = ", &
          object%use_scale_from_file
     if (object%reading) then
        write (u, "(3x,A,A)")  "Reading from file = ", char (object%filename)
     else if (object%writing) then
        write (u, "(3x,A,A)")  "Writing to file   = ", char (object%filename)
     else
        write (u, "(3x,A)")  "[closed]"
     end if
   end subroutine eio_raw_write
 
 @ %def eio_raw_write
 @ Finalizer: close any open file.
 <<EIO raw: eio raw: TBP>>=
   procedure :: final => eio_raw_final
 <<EIO raw: procedures>>=
   subroutine eio_raw_final (object)
     class(eio_raw_t), intent(inout) :: object
     if (object%reading .or. object%writing) then
        write (msg_buffer, "(A,A,A)")  "Events: closing raw file '", &
             char (object%filename), "'"
        call msg_message ()
        close (object%unit)
        object%reading = .false.
        object%writing = .false.
     end if
   end subroutine eio_raw_final
 
 @ %def eio_raw_final
 @ Set the [[check]] flag which determines whether we compare checksums on input.
 <<EIO raw: eio raw: TBP>>=
   procedure :: set_parameters => eio_raw_set_parameters
 <<EIO raw: procedures>>=
   subroutine eio_raw_set_parameters (eio, check, use_alphas_from_file, &
        use_scale_from_file, version_string, extension)
     class(eio_raw_t), intent(inout) :: eio
     logical, intent(in), optional :: check, use_alphas_from_file, &
          use_scale_from_file
     type(string_t), intent(in), optional :: version_string
     type(string_t), intent(in), optional :: extension
     if (present (check))  eio%check = check
     if (present (use_alphas_from_file))  eio%use_alphas_from_file = &
          use_alphas_from_file
     if (present (use_scale_from_file))  eio%use_scale_from_file = &
          use_scale_from_file
     if (present (version_string)) then
        select case (char (version_string))
        case ("", "2.2.4")
           eio%file_version = CURRENT_FILE_VERSION
        case ("2.2")
           eio%file_version = 1
        case default
           call msg_fatal ("Raw event I/O: unsupported version '" &
                // char (version_string) // "'")
           eio%file_version = 0
        end select
     end if
     if (present (extension)) then
        eio%extension = extension
     else
        eio%extension = "evx"
     end if
   end subroutine eio_raw_set_parameters
 
 @ %def eio_raw_set_parameters
 @ Initialize event writing.
 <<EIO raw: eio raw: TBP>>=
   procedure :: init_out => eio_raw_init_out
 <<EIO raw: procedures>>=
   subroutine eio_raw_init_out (eio, sample, data, success, extension)
     class(eio_raw_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     type(string_t), intent(in), optional :: extension
     character(32) :: md5sum_prc, md5sum_cfg
     character(32), dimension(:), allocatable :: md5sum_alt
     integer :: i
     if (present (extension)) then
        eio%extension  = extension
     else
        eio%extension = "evx"
     end if
     eio%filename = sample // "." // eio%extension
     eio%unit = free_unit ()
     write (msg_buffer, "(A,A,A)")  "Events: writing to raw file '", &
          char (eio%filename), "'"
     call msg_message ()
     eio%writing = .true.
     if (present (data)) then
        md5sum_prc = data%md5sum_prc
        md5sum_cfg = data%md5sum_cfg
        eio%norm_mode = data%norm_mode
        eio%sigma = data%total_cross_section
        eio%n = data%n_evt
        eio%n_alt = data%n_alt
        if (eio%n_alt > 0) then
           !!! !!! !!! Workaround for gfortran 5.0 ICE
           allocate (md5sum_alt (data%n_alt))
           md5sum_alt = data%md5sum_alt
           !!! allocate (md5sum_alt (data%n_alt), source = data%md5sum_alt)
        end if
     else
        md5sum_prc = ""
        md5sum_cfg = ""
     end if
     open (eio%unit, file = char (eio%filename), form = "unformatted", &
          action = "write", status = "replace")
     select case (eio%file_version)
     case (2:);  write (eio%unit)  eio%file_version
     end select
     write (eio%unit)  md5sum_prc
     write (eio%unit)  md5sum_cfg
     write (eio%unit)  eio%norm_mode
     write (eio%unit)  eio%n_alt
     if (allocated (md5sum_alt)) then
        do i = 1, eio%n_alt
           write (eio%unit)  md5sum_alt(i)
        end do
     end if
     if (present (success))  success = .true.
   end subroutine eio_raw_init_out
 
 @ %def eio_raw_init_out
 @ Initialize event reading.
 <<EIO raw: eio raw: TBP>>=
   procedure :: init_in => eio_raw_init_in
 <<EIO raw: procedures>>=
   subroutine eio_raw_init_in (eio, sample, data, success, extension)
     class(eio_raw_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     type(string_t), intent(in), optional :: extension
     character(32) :: md5sum_prc, md5sum_cfg
     character(32), dimension(:), allocatable :: md5sum_alt
     integer :: i, file_version
     if (present (success))  success = .true.
     if (present (extension)) then
        eio%extension = extension
     else
        eio%extension = "evx"
     end if
     eio%filename = sample // "." // eio%extension
     eio%unit = free_unit ()
     if (present (data)) then
        eio%sigma = data%total_cross_section
        eio%n = data%n_evt
     end if
     write (msg_buffer, "(A,A,A)")  "Events: reading from raw file '", &
          char (eio%filename), "'"
     call msg_message ()
     eio%reading = .true.
     open (eio%unit, file = char (eio%filename), form = "unformatted", &
          action = "read", status = "old")
     select case (eio%file_version)
     case (2:);  read (eio%unit)  file_version
     case default;  file_version = 1
     end select
     if (file_version /= eio%file_version) then
        call msg_error ("Reading event file: raw-file version mismatch.")
        if (present (success))  success = .false.
        return
     else if (file_version /= CURRENT_FILE_VERSION) then
        call msg_warning ("Reading event file: compatibility mode.")
     end if
     read (eio%unit)  md5sum_prc
     read (eio%unit)  md5sum_cfg
     read (eio%unit)  eio%norm_mode
     read (eio%unit)  eio%n_alt
     if (present (data)) then
        if (eio%n_alt /= data%n_alt) then
           if (present (success))  success = .false.
           return
        end if
     end if
     allocate (md5sum_alt (eio%n_alt))
     do i = 1, eio%n_alt
        read (eio%unit)  md5sum_alt(i)
     end do
     if (present (success)) then
        if (present (data)) then
           if (eio%check) then
              if (data%md5sum_prc /= "") then
                 success = success .and. md5sum_prc == data%md5sum_prc
              end if
              if (data%md5sum_cfg /= "") then
                 success = success .and. md5sum_cfg == data%md5sum_cfg
              end if
              do i = 1, eio%n_alt
                 if (data%md5sum_alt(i) /= "") then
                    success = success .and. md5sum_alt(i) == data%md5sum_alt(i)
                 end if
              end do
           else
              call msg_warning ("Reading event file: MD5 sum check disabled")
           end if
        end if
     end if
   end subroutine eio_raw_init_in
 
 @ %def eio_raw_init_in
 @ Switch from input to output: reopen the file for reading.
 <<EIO raw: eio raw: TBP>>=
   procedure :: switch_inout => eio_raw_switch_inout
 <<EIO raw: procedures>>=
   subroutine eio_raw_switch_inout (eio, success)
     class(eio_raw_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     write (msg_buffer, "(A,A,A)")  "Events: appending to raw file '", &
          char (eio%filename), "'"
     call msg_message ()
     close (eio%unit, status = "keep")
     eio%reading = .false.
     open (eio%unit, file = char (eio%filename), form = "unformatted", &
          action = "write", position = "append", status = "old")
     eio%writing = .true.
     if (present (success))  success = .true.
   end subroutine eio_raw_switch_inout
 
 @ %def eio_raw_switch_inout
 @ Output an event.  Write first the event indices, then weight and
 squared matrix element, then the particle set.
 
 We always write the particle set of the hard process.  (Note: this
 should be reconsidered.)  We do make a physical copy.
 
 On output, we write the [[prc]] values for weight and sqme, since
 these are the values just computed.  On input, we store the values as
 [[ref]] values.  The caller can then decide whether to recompute
 values and thus obtain distinct [[prc]] values, or just accept them.
 
 The [[passed]] flag is not written.  This allow us to apply different
 selection criteria upon rereading.
 <<EIO raw: eio raw: TBP>>=
   procedure :: output => eio_raw_output
 <<EIO raw: procedures>>=
   subroutine eio_raw_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_raw_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     logical, intent(in), optional :: reading, passed, pacify
     integer, intent(in) :: i_prc
     type(particle_set_t), pointer :: pset
     integer :: i
     if (eio%writing) then
        if (event%has_valid_particle_set ()) then
           select type (event)
           type is (event_t)
              write (eio%unit)  i_prc
              write (eio%unit)  event%get_index ()
              write (eio%unit)  event%get_i_mci ()
              write (eio%unit)  event%get_i_term ()
              write (eio%unit)  event%get_channel ()
              write (eio%unit)  event%expr%weight_prc
              write (eio%unit)  event%expr%excess_prc
              write (eio%unit)  event%get_n_dropped ()
              write (eio%unit)  event%expr%sqme_prc
              do i = 1, eio%n_alt
                 write (eio%unit)  event%expr%weight_alt(i)
                 write (eio%unit)  event%expr%sqme_alt(i)
              end do
              allocate (pset)
              call event%get_hard_particle_set (pset)
              call pset%write_raw (eio%unit)
              call pset%final ()
              deallocate (pset)
              select case (eio%file_version)
              case (2:)
                 if (event%has_transform ()) then
                    write (eio%unit)  .true.
                    pset => event%get_particle_set_ptr ()
                    call pset%write_raw (eio%unit)
                 else
                    write (eio%unit)  .false.
                 end if
              end select
           class default
              call msg_bug ("Event: write raw: defined only for full event_t")
           end select
        else
           call msg_bug ("Event: write raw: particle set is undefined")
        end if
     else
        call eio%write ()
        call msg_fatal ("Raw event file is not open for writing")
     end if
   end subroutine eio_raw_output
 
 @ %def eio_raw_output
 @ Input an event.
 
 Note: the particle set is physically copied.  If there is a
 performance issue, we might choose to pointer-assign it instead, with
 a different version of [[event%set_hard_particle_set]].
 <<EIO raw: eio raw: TBP>>=
   procedure :: input_i_prc => eio_raw_input_i_prc
   procedure :: input_event => eio_raw_input_event
 <<EIO raw: procedures>>=
   subroutine eio_raw_input_i_prc (eio, i_prc, iostat)
     class(eio_raw_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     if (eio%reading) then
        read (eio%unit, iostat = iostat)  i_prc
     else
        call eio%write ()
        call msg_fatal ("Raw event file is not open for reading")
     end if
   end subroutine eio_raw_input_i_prc
 
   subroutine eio_raw_input_event (eio, event, iostat)
     class(eio_raw_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     integer :: event_index, i_mci, i_term, channel, i
     real(default) :: weight, excess, sqme
     integer :: n_dropped
     real(default), dimension(:), allocatable :: weight_alt, sqme_alt
     logical :: has_transform
     type(particle_set_t), pointer :: pset
     class(model_data_t), pointer :: model
     if (eio%reading) then
        select type (event)
        type is (event_t)
           read (eio%unit, iostat = iostat)  event_index
           if (iostat /= 0)  return
           read (eio%unit, iostat = iostat)  i_mci
           if (iostat /= 0)  return
           read (eio%unit, iostat = iostat)  i_term
           if (iostat /= 0)  return
           read (eio%unit, iostat = iostat)  channel
           if (iostat /= 0)  return
           read (eio%unit, iostat = iostat)  weight
           if (iostat /= 0)  return
           read (eio%unit, iostat = iostat)  excess
           if (iostat /= 0)  return
           read (eio%unit, iostat = iostat)  n_dropped
           if (iostat /= 0)  return
           read (eio%unit, iostat = iostat)  sqme
           if (iostat /= 0)  return
           call event%reset_contents ()
           call event%set_index (event_index)
           call event%select (i_mci, i_term, channel)
           if (eio%norm_mode /= NORM_UNDEFINED) then
              call event_normalization_update (weight, &
                   eio%sigma, eio%n, event%get_norm_mode (), eio%norm_mode)
              call event_normalization_update (excess, &
                   eio%sigma, eio%n, event%get_norm_mode (), eio%norm_mode)
           end if
           call event%set (sqme_ref = sqme, weight_ref = weight, &
                excess_prc = excess, &
                n_dropped = n_dropped)
           if (eio%n_alt /= 0) then
              allocate (sqme_alt (eio%n_alt), weight_alt (eio%n_alt))
              do i = 1, eio%n_alt
                 read (eio%unit, iostat = iostat)  weight_alt(i)
                 if (iostat /= 0)  return
                 read (eio%unit, iostat = iostat)  sqme_alt(i)
                 if (iostat /= 0)  return
              end do
              call event%set (sqme_alt = sqme_alt, weight_alt = weight_alt)
           end if
           model => null ()
           if (associated (event%process)) then
              model => event%process%get_model_ptr ()
           end if
           allocate (pset)
           call pset%read_raw (eio%unit, iostat)
           if (iostat /= 0)  return
           if (associated (model))  call pset%set_model (model)
           call event%set_hard_particle_set (pset)
           if (eio%use_alphas_from_file .or. eio%use_scale_from_file) then
              call event%recalculate (update_sqme = .true.)
           end if
           call pset%final ()
           deallocate (pset)
           select case (eio%file_version)
           case (2:)
              read (eio%unit, iostat = iostat)  has_transform
              if (iostat /= 0)  return
              if (has_transform) then
                 allocate (pset)
                 call pset%read_raw (eio%unit, iostat)
                 if (iostat /= 0)  return
                 if (associated (model)) &
                      call pset%set_model (model)
                 call event%link_particle_set (pset)
              end if
           end select
        class default
           call msg_bug ("Event: read raw: defined only for full event_t")
        end select
     else
        call eio%write ()
        call msg_fatal ("Raw event file is not open for reading")
     end if
   end subroutine eio_raw_input_event
 
 @ %def eio_raw_input_i_prc
 @ %def eio_raw_input_event
 @
 <<EIO raw: eio raw: TBP>>=
   procedure :: skip => eio_raw_skip
 <<EIO raw: procedures>>=
   subroutine eio_raw_skip (eio, iostat)
     class(eio_raw_t), intent(inout) :: eio
     integer, intent(out) :: iostat
     if (eio%reading) then
        read (eio%unit, iostat = iostat)
     else
        call eio%write ()
        call msg_fatal ("Raw event file is not open for reading")
     end if
   end subroutine eio_raw_skip
 
 @ %def eio_raw_skip
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_raw_ut.f90]]>>=
 <<File header>>
 
 module eio_raw_ut
   use unit_tests
   use eio_raw_uti
 
 <<Standard module head>>
 
 <<EIO raw: public test>>
 
 contains
 
 <<EIO raw: test driver>>
 
 end module eio_raw_ut
 @ %def eio_raw_ut
 @
 <<[[eio_raw_uti.f90]]>>=
 <<File header>>
 
 module eio_raw_uti
 
 <<Use kinds>>
 <<Use strings>>
   use model_data
   use variables
   use events
   use eio_data
   use eio_base
 
   use eio_raw
 
   use process, only: process_t
   use instances, only: process_instance_t
 
 <<Standard module head>>
 
 <<EIO raw: test declarations>>
 
 contains
 
 <<EIO raw: tests>>
 
 end module eio_raw_uti
 
 @ %def eio_raw_uti
 @ API: driver for the unit tests below.
 <<EIO raw: public test>>=
   public :: eio_raw_test
 <<EIO raw: test driver>>=
   subroutine eio_raw_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO raw: execute tests>>
   end subroutine eio_raw_test
 
 @ %def eio_raw_test
 @
 \subsubsection{Test I/O methods}
 We test the implementation of all I/O methods.
 <<EIO raw: execute tests>>=
   call test (eio_raw_1, "eio_raw_1", &
        "read and write event contents", &
        u, results)
 <<EIO raw: test declarations>>=
   public :: eio_raw_1
 <<EIO raw: tests>>=
   subroutine eio_raw_1 (u)
     use processes_ut, only: prepare_test_process, cleanup_test_process
     integer, intent(in) :: u
     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
     class(eio_t), allocatable :: eio
     integer :: i_prc, iostat
     type(string_t) :: sample
 
     write (u, "(A)")  "* Test output: eio_raw_1"
     write (u, "(A)")  "*   Purpose: generate and read/write an event"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call model%init_test ()
 
     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 ())
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_raw_1"
 
     allocate (eio_raw_t :: eio)
 
     call eio%init_out (sample)
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
     call event%write (u)
     write (u, "(A)")
 
     call eio%output (event, i_prc = 42)
     call eio%write (u)
     call eio%final ()
 
     call event%final ()
     deallocate (event)
     call process_instance%final ()
     deallocate (process_instance)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read the event"
     write (u, "(A)")
 
     call eio%init_in (sample)
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%setup_event_data ()
     allocate (event)
     call event%basic_init ()
     call event%connect (process_instance, process%get_model_ptr ())
 
     call eio%input_i_prc (i_prc, iostat)
     if (iostat /= 0)  write (u, "(A,I0)")  "I/O error (i_prc):", iostat
     call eio%input_event (event, iostat)
     if (iostat /= 0)  write (u, "(A,I0)")  "I/O error (event):", iostat
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(1x,A,I0)")  "i_prc = ", i_prc
     write (u, "(A)")
     call event%write (u)
     write (u, "(A)")
     write (u, "(A)")  "* Generate and append another event"
     write (u, "(A)")
 
     call eio%switch_inout ()
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
     call event%write (u)
     write (u, "(A)")
 
     call eio%output (event, i_prc = 5)
     call eio%write (u)
     call eio%final ()
 
     call event%final ()
     deallocate (event)
     call process_instance%final ()
     deallocate (process_instance)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read both events"
     write (u, "(A)")
 
     call eio%init_in (sample)
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%setup_event_data ()
     allocate (event)
     call event%basic_init ()
     call event%connect (process_instance, process%get_model_ptr ())
 
     call eio%input_i_prc (i_prc, iostat)
     if (iostat /= 0)  write (u, "(A,I0)")  "I/O error (i_prc/1):", iostat
     call eio%input_event (event, iostat)
     if (iostat /= 0)  write (u, "(A,I0)")  "I/O error (event/1):", iostat
     call eio%input_i_prc (i_prc, iostat)
     if (iostat /= 0)  write (u, "(A,I0)")  "I/O error (i_prc/2):", iostat
     call eio%input_event (event, iostat)
     if (iostat /= 0)  write (u, "(A,I0)")  "I/O error (event/2):", iostat
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(1x,A,I0)")  "i_prc = ", i_prc
     write (u, "(A)")
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
     deallocate (eio)
 
     call event%final ()
     deallocate (event)
 
     call cleanup_test_process (process, process_instance)
     deallocate (process_instance)
     deallocate (process)
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_raw_1"
 
   end subroutine eio_raw_1
 
 @ %def eio_raw_1
 @
 \subsubsection{Test I/O methods}
 We test the implementation of all I/O methods.
 <<EIO raw: execute tests>>=
   call test (eio_raw_2, "eio_raw_2", &
        "handle multiple weights", &
        u, results)
 <<EIO raw: test declarations>>=
   public :: eio_raw_2
 <<EIO raw: tests>>=
   subroutine eio_raw_2 (u)
     use processes_ut, only: prepare_test_process, cleanup_test_process
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(var_list_t) :: var_list
     type(event_t), allocatable, target :: event
     type(process_t), allocatable, target :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     integer :: i_prc, iostat
     type(string_t) :: sample
 
     write (u, "(A)")  "* Test output: eio_raw_2"
     write (u, "(A)")  "*   Purpose: generate and read/write an event"
     write (u, "(A)")  "*            with multiple weights"
     write (u, "(A)")
 
     call model%init_test ()
 
     write (u, "(A)")  "* Initialize test process"
 
     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 ()
 
     call data%init (n_proc = 1, n_alt = 2)
 
     call var_list_append_log (var_list, var_str ("?unweighted"), .false., &
          intrinsic = .true.)
     call var_list_append_string (var_list, var_str ("$sample_normalization"), &
          var_str ("auto"), intrinsic = .true.)
     call var_list_append_real (var_list, var_str ("safety_factor"), &
          1._default, intrinsic = .true.)
 
     allocate (event)
     call event%basic_init (var_list, n_alt = 2)
     call event%connect (process_instance, process%get_model_ptr ())
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_raw_2"
 
     allocate (eio_raw_t :: eio)
 
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
     call event%set (sqme_alt = [2._default, 3._default])
     call event%set (weight_alt = &
          [2 * event%get_weight_ref (), 3 * event%get_weight_ref ()])
     call event%store_alt_values ()
     call event%check ()
 
     call event%write (u)
     write (u, "(A)")
 
     call eio%output (event, i_prc = 42)
     call eio%write (u)
     call eio%final ()
 
     call event%final ()
     deallocate (event)
     call process_instance%final ()
     deallocate (process_instance)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read the event"
     write (u, "(A)")
 
     call eio%init_in (sample, data)
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%setup_event_data ()
     allocate (event)
     call event%basic_init (var_list, n_alt = 2)
     call event%connect (process_instance, process%get_model_ptr ())
 
     call eio%input_i_prc (i_prc, iostat)
     if (iostat /= 0)  write (u, "(A,I0)")  "I/O error (i_prc):", iostat
     call eio%input_event (event, iostat)
     if (iostat /= 0)  write (u, "(A,I0)")  "I/O error (event):", iostat
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(1x,A,I0)")  "i_prc = ", i_prc
     write (u, "(A)")
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
     deallocate (eio)
 
     call event%final ()
     deallocate (event)
 
     call cleanup_test_process (process, process_instance)
     deallocate (process_instance)
     deallocate (process)
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_raw_2"
 
   end subroutine eio_raw_2
 
 @ %def eio_raw_2
 @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Dispatch}
 An event transform is responsible for dressing a partonic event.
 Since event transforms are not mutually exclusive but are
 concatenated, we provide individual dispatchers for each of them.
 
 <<[[dispatch_transforms.f90]]>>=
 <<File header>>
 
 module dispatch_transforms
 
 <<Use kinds>>
 <<Use strings>>
   use process
   use variables
   use system_defs, only: LF
   use system_dependencies, only: LHAPDF6_AVAILABLE
   use sf_lhapdf, only: lhapdf_initialize
   use diagnostics
   use models
   use os_interface
   use beam_structures
   use resonances, only: resonance_history_set_t
   use instances, only: process_instance_t, process_instance_hook_t
 
   use event_base, only: event_callback_t, event_callback_nop_t
   use eio_base
   use eio_raw
   use eio_checkpoints
   use eio_callback
   use eio_lhef
   use eio_hepmc
   use eio_lcio
   use eio_stdhep
   use eio_ascii
   use eio_weights
   use eio_dump
 
   use event_transforms
   use resonance_insertion
   use isr_epa_handler
   use decays
   use shower_base
   use shower_core
   use shower
   use shower_pythia6
   use shower_pythia8
   use hadrons
   use mlm_matching
   use powheg_matching
   use ckkw_matching
   use tauola_interface !NODEP!
   use evt_nlo
 
 <<Standard module head>>
 
 <<Dispatch transforms: public>>
 
 contains
 
 <<Dispatch transforms: procedures>>
 
 end module dispatch_transforms
 @ %def dispatch_transforms
 @
 <<Dispatch transforms: public>>=
   public :: dispatch_evt_nlo
 <<Dispatch transforms: procedures>>=
   subroutine dispatch_evt_nlo (evt, keep_failed_events)
     class(evt_t), intent(out), pointer :: evt
     logical, intent(in) :: keep_failed_events
     call msg_message ("Simulate: activating fixed-order NLO events")
     allocate (evt_nlo_t :: evt)
     evt%only_weighted_events = .true.
     select type (evt)
     type is (evt_nlo_t)
        evt%i_evaluation = 0
        evt%keep_failed_events = keep_failed_events
     end select
   end subroutine dispatch_evt_nlo
 
 @ %def dispatch_evt_nlo
 @
 <<Dispatch transforms: public>>=
   public :: dispatch_evt_resonance
 <<Dispatch transforms: procedures>>=
   subroutine dispatch_evt_resonance (evt, var_list, res_history_set, libname)
     class(evt_t), intent(out), pointer :: evt
     type(var_list_t), intent(in) :: var_list
     type(resonance_history_set_t), dimension(:), intent(in) :: res_history_set
     type(string_t), intent(in) :: libname
     logical :: resonance_history
     resonance_history = var_list%get_lval (var_str ("?resonance_history"))
     if (resonance_history) then
        allocate (evt_resonance_t :: evt)
        call msg_message ("Simulate: activating resonance insertion")
        select type (evt)
        type is (evt_resonance_t)
           call evt%set_resonance_data (res_history_set)
           call evt%set_library (libname)
        end select
     else
        evt => null ()
     end if
   end subroutine dispatch_evt_resonance
 
 @ %def dispatch_evt_resonance
 @ Initialize the ISR/EPA handler, depending on active settings.
 
 The activation is independent for both handlers, since only one may be
 needed at a time.  However, if both handlers are active, the current
 implementation requires the handler modes of ISR and EPA to coincide.
 <<Dispatch transforms: public>>=
   public :: dispatch_evt_isr_epa_handler
 <<Dispatch transforms: procedures>>=
   subroutine dispatch_evt_isr_epa_handler (evt, var_list)
     class(evt_t), intent(out), pointer :: evt
     type(var_list_t), intent(in) :: var_list
     logical :: isr_recoil
     logical :: epa_recoil
     logical :: isr_handler_active
     logical :: epa_handler_active
     type(string_t) :: isr_handler_mode
     type(string_t) :: epa_handler_mode
     real(default) :: sqrts
     real(default) :: isr_q_max
     real(default) :: epa_q_max
     real(default) :: isr_mass
     real(default) :: epa_mass
     isr_handler_active = var_list%get_lval (var_str ("?isr_handler"))
     if (isr_handler_active) then
        call msg_message ("Simulate: activating ISR handler")
        isr_recoil = var_list%get_lval (var_str ("?isr_recoil"))
        isr_handler_mode = var_list%get_sval (var_str ("$isr_handler_mode"))
        if (isr_recoil) then
           call msg_fatal ("Simulate: ISR handler is incompatible &
                &with ?isr_recoil=true")
        end if
     end if
     epa_handler_active = var_list%get_lval (var_str ("?epa_handler"))
     if (epa_handler_active) then
        call msg_message ("Simulate: activating EPA handler")
        epa_recoil = var_list%get_lval (var_str ("?epa_recoil"))
        epa_handler_mode = var_list%get_sval (var_str ("$epa_handler_mode"))
        if (epa_recoil) then
           call msg_fatal ("Simulate: EPA handler is incompatible &
                &with ?epa_recoil=true")
        end if
     end if
     if (isr_handler_active .and. epa_handler_active) then
        if (isr_handler_mode /= epa_handler_mode) then
           call msg_fatal ("Simulate: ISR/EPA handler: modes must coincide")
        end if
     end if
     if (isr_handler_active .or. epa_handler_active) then
        allocate (evt_isr_epa_t :: evt)
        select type (evt)
        type is (evt_isr_epa_t)
           if (isr_handler_active) then
              call evt%set_mode_string (isr_handler_mode)
           else
              call evt%set_mode_string (epa_handler_mode)
           end if
           sqrts = var_list%get_rval (var_str ("sqrts"))
           if (isr_handler_active) then
              isr_q_max = var_list%get_rval (var_str ("isr_q_max"))
              isr_mass = var_list%get_rval (var_str ("isr_mass"))
              call evt%set_data_isr (sqrts, isr_q_max, isr_mass)
           end if
           if (epa_handler_active) then
              epa_q_max = var_list%get_rval (var_str ("epa_q_max"))
              epa_mass = var_list%get_rval (var_str ("epa_mass"))
              call evt%set_data_epa (sqrts, epa_q_max, epa_mass)
           end if
           call msg_message ("Simulate: ISR/EPA handler mode: " &
                // char (evt%get_mode_string ()))
        end select
     else
        evt => null ()
     end if
   end subroutine dispatch_evt_isr_epa_handler
 
 @ %def dispatch_evt_isr_epa_handler
 @
 <<Dispatch transforms: public>>=
   public :: dispatch_evt_decay
 <<Dispatch transforms: procedures>>=
   subroutine dispatch_evt_decay (evt, var_list)
     class(evt_t), intent(out), pointer :: evt
     type(var_list_t), intent(in), target :: var_list
     logical :: allow_decays
     allow_decays = var_list%get_lval (var_str ("?allow_decays"))
     if (allow_decays) then
        allocate (evt_decay_t :: evt)
        call msg_message ("Simulate: activating decays")
        select type (evt)
        type is (evt_decay_t)
           call evt%set_var_list (var_list)
        end select
     else
        evt => null ()
     end if
   end subroutine dispatch_evt_decay
 
 @ %def dispatch_evt_decay
 @
 <<Dispatch transforms: public>>=
   public :: dispatch_evt_shower
 <<Dispatch transforms: procedures>>=
   subroutine dispatch_evt_shower (evt, var_list, model, fallback_model, &
        os_data, beam_structure, process)
     class(evt_t), intent(out), pointer :: evt
     type(var_list_t), intent(in) :: var_list
     type(model_t), pointer, intent(in) :: model, fallback_model
     type(os_data_t), intent(in) :: os_data
     type(beam_structure_t), intent(in) :: beam_structure
     type(process_t), intent(in), optional :: process
     type(string_t) :: lhapdf_file, lhapdf_dir, process_name
     integer :: lhapdf_member
     type(shower_settings_t) :: settings
     type(taudec_settings_t) :: taudec_settings
     call msg_message ("Simulate: activating parton shower")
     allocate (evt_shower_t :: evt)
     call settings%init (var_list)
     if (associated (model)) then
        call taudec_settings%init (var_list, model)
     else
        call taudec_settings%init (var_list, fallback_model)
     end if
     if (present (process)) then
        process_name = process%get_id ()
     else
        process_name = 'dispatch_testing'
     end if
     select type (evt)
     type is (evt_shower_t)
        call evt%init (fallback_model, os_data)
        lhapdf_member = &
             var_list%get_ival (var_str ("lhapdf_member"))
        if (LHAPDF6_AVAILABLE) then
           lhapdf_dir = &
                var_list%get_sval (var_str ("$lhapdf_dir"))
           lhapdf_file = &
                var_list%get_sval (var_str ("$lhapdf_file"))
           call lhapdf_initialize &
                (1, lhapdf_dir, lhapdf_file, lhapdf_member, evt%pdf_data%pdf)
        end if
        if (present (process))  call evt%pdf_data%setup ("Shower", &
             beam_structure, lhapdf_member, process%get_pdf_set ())
        select case (settings%method)
        case (PS_WHIZARD)
           allocate (shower_t :: evt%shower)
        case (PS_PYTHIA6)
           allocate (shower_pythia6_t :: evt%shower)
        case (PS_PYTHIA8)
           allocate (shower_pythia8_t :: evt%shower)
        case default
           call msg_fatal ('Shower: Method ' // &
             char (var_list%get_sval (var_str ("$shower_method"))) // &
             'not implemented!')
        end select
        call evt%shower%init (settings, taudec_settings, evt%pdf_data, os_data)
     end select
     call dispatch_matching (evt, settings, var_list, process_name)
   end subroutine dispatch_evt_shower
 
 @ %def dispatch_evt_shower
 @
 <<Dispatch transforms: public>>=
   public :: dispatch_evt_shower_hook
 <<Dispatch transforms: procedures>>=
   subroutine dispatch_evt_shower_hook (hook, var_list, process_instance)
     class(process_instance_hook_t), pointer, intent(out) :: hook
     type(var_list_t), intent(in) :: var_list
     class(process_instance_t), intent(in), target :: process_instance
     if (var_list%get_lval (var_str ('?powheg_matching'))) then
        call msg_message ("Integration hook: add POWHEG hook")
        allocate (powheg_matching_hook_t :: hook)
        call hook%init (var_list, process_instance)
     else
        hook => null ()
     end if
   end subroutine dispatch_evt_shower_hook
 
 @ %def dispatch_evt_shower_hook
 @
 <<Dispatch transforms: public>>=
   public :: dispatch_matching
 <<Dispatch transforms: procedures>>=
   subroutine dispatch_matching (evt, settings, var_list, process_name)
     class(evt_t), intent(inout) :: evt
     type(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: process_name
     type(shower_settings_t), intent(in) :: settings
     select type (evt)
     type is (evt_shower_t)
        if (settings%mlm_matching .and. settings%ckkw_matching) then
           call msg_fatal ("Both MLM and CKKW matching activated," // &
                LF // "     aborting simulation")
        end if
        if (settings%powheg_matching) then
           call msg_message ("Simulate: applying POWHEG matching")
           allocate (powheg_matching_t :: evt%matching)
        end if
        if (settings%mlm_matching) then
           call msg_message ("Simulate: applying MLM matching")
           allocate (mlm_matching_t :: evt%matching)
        end if
        if (settings%ckkw_matching) then
           call msg_warning ("Simulate: CKKW(-L) matching not yet supported")
           allocate (ckkw_matching_t :: evt%matching)
        end if
        if (allocated (evt%matching)) &
             call evt%matching%init (var_list, process_name)
     end select
   end subroutine dispatch_matching
 
 @ %def dispatch_matching
 @
 <<Dispatch transforms: public>>=
   public :: dispatch_evt_hadrons
 <<Dispatch transforms: procedures>>=
   subroutine dispatch_evt_hadrons (evt, var_list, fallback_model)
     class(evt_t), intent(out), pointer :: evt
     type(var_list_t), intent(in) :: var_list
     type(model_t), pointer, intent(in) :: fallback_model
     type(shower_settings_t) :: shower_settings
     type(hadron_settings_t) :: hadron_settings
     allocate (evt_hadrons_t :: evt)
     call msg_message ("Simulate: activating hadronization")
     call shower_settings%init (var_list)
     call hadron_settings%init (var_list)
     select type (evt)
     type is (evt_hadrons_t)
        call evt%init (fallback_model)
        select case (hadron_settings%method)
        case (HADRONS_WHIZARD)
           allocate (hadrons_hadrons_t :: evt%hadrons)
        case (HADRONS_PYTHIA6)
           allocate (hadrons_pythia6_t :: evt%hadrons)
        case (HADRONS_PYTHIA8)
           allocate (hadrons_pythia8_t :: evt%hadrons)
        case default
           call msg_fatal ('Hadronization: Method ' // &
             char (var_list%get_sval (var_str ("hadronization_method"))) // &
             'not implemented!')
        end select
        call evt%hadrons%init &
             (shower_settings, hadron_settings, fallback_model)
     end select
   end subroutine dispatch_evt_hadrons
 
 @ %def dispatch_evt_hadrons
 @ We cannot put this in the [[events]] subdir due to [[eio_raw_t]],
 which is defined here.
 <<Dispatch transforms: public>>=
   public :: dispatch_eio
 <<Dispatch transforms: procedures>>=
   subroutine dispatch_eio (eio, method, var_list, fallback_model, &
          event_callback)
     class(eio_t), allocatable, intent(inout) :: eio
     type(string_t), intent(in) :: method
     type(var_list_t), intent(in) :: var_list
     type(model_t), target, intent(in) :: fallback_model
     class(event_callback_t), allocatable, intent(in) :: event_callback
     logical :: check, keep_beams, keep_remnants, recover_beams
     logical :: use_alphas_from_file, use_scale_from_file
     logical :: write_sqme_prc, write_sqme_ref, write_sqme_alt
     logical :: output_cross_section, ensure_order
     type(string_t) :: lhef_version, lhef_extension, raw_version
     type(string_t) :: extension_default, debug_extension, dump_extension, &
          extension_hepmc, &
          extension_lha, extension_hepevt, extension_ascii_short, &
          extension_ascii_long, extension_athena, extension_mokka, &
          extension_stdhep, extension_stdhep_up, extension_stdhep_ev4, &
          extension_raw, extension_hepevt_verb, extension_lha_verb, &
          extension_lcio
     integer :: checkpoint
+    integer :: lcio_run_id
     logical :: show_process, show_transforms, show_decay, verbose, pacified
     logical :: dump_weights, dump_compressed, dump_summary, dump_screen
-    logical :: hepmc2_mode
+    logical :: hepmc2_mode, proc_as_run_id
     keep_beams = &
          var_list%get_lval (var_str ("?keep_beams"))
     keep_remnants = &
          var_list%get_lval (var_str ("?keep_remnants"))
     ensure_order = &
          var_list%get_lval (var_str ("?hepevt_ensure_order"))
     recover_beams = &
          var_list%get_lval (var_str ("?recover_beams"))
     use_alphas_from_file = &
          var_list%get_lval (var_str ("?use_alphas_from_file"))
     use_scale_from_file = &
          var_list%get_lval (var_str ("?use_scale_from_file"))
     select case (char (method))
     case ("raw")
        allocate (eio_raw_t :: eio)
        select type (eio)
        type is (eio_raw_t)
           check = &
                var_list%get_lval (var_str ("?check_event_file"))
           raw_version = &
                var_list%get_sval (var_str ("$event_file_version"))
           extension_raw = &
                var_list%get_sval (var_str ("$extension_raw"))
           call eio%set_parameters (check, use_alphas_from_file, &
                use_scale_from_file, raw_version, extension_raw)
        end select
     case ("checkpoint")
        allocate (eio_checkpoints_t :: eio)
        select type (eio)
        type is (eio_checkpoints_t)
           checkpoint = &
                var_list%get_ival (var_str ("checkpoint"))
           pacified = &
                var_list%get_lval (var_str ("?pacify"))
           call eio%set_parameters (checkpoint, blank = pacified)
        end select
     case ("callback")
        allocate (eio_callback_t :: eio)
        select type (eio)
        type is (eio_callback_t)
           checkpoint = &
                var_list%get_ival (var_str ("event_callback_interval"))
           if (allocated (event_callback)) then
              call eio%set_parameters (event_callback, checkpoint)
           else
              call eio%set_parameters (event_callback_nop_t (), 0)
           end if
        end select
     case ("lhef")
        allocate (eio_lhef_t :: eio)
        select type (eio)
        type is (eio_lhef_t)
           lhef_version = &
                var_list%get_sval (var_str ("$lhef_version"))
           lhef_extension = &
                var_list%get_sval (var_str ("$lhef_extension"))
           write_sqme_prc = &
                var_list%get_lval (var_str ("?lhef_write_sqme_prc"))
           write_sqme_ref = &
                var_list%get_lval (var_str ("?lhef_write_sqme_ref"))
           write_sqme_alt = &
                var_list%get_lval (var_str ("?lhef_write_sqme_alt"))
           call eio%set_parameters ( &
                keep_beams, keep_remnants, recover_beams, &
                use_alphas_from_file, use_scale_from_file, &
                char (lhef_version), lhef_extension, &
                write_sqme_ref, write_sqme_prc, write_sqme_alt)
        end select
     case ("hepmc")
        allocate (eio_hepmc_t :: eio)
        select type (eio)
        type is (eio_hepmc_t)
           output_cross_section = &
                var_list%get_lval (var_str ("?hepmc_output_cross_section"))
           extension_hepmc = &
                var_list%get_sval (var_str ("$extension_hepmc"))
           hepmc2_mode = &
                var_list%get_lval (var_str ("?hepmc3_hepmc2mode"))
           call eio%set_parameters (recover_beams, &
                use_alphas_from_file, use_scale_from_file, &
                extension_hepmc, output_cross_section, &
                hepmc2_mode = hepmc2_mode)
        end select
     case ("lcio")
        allocate (eio_lcio_t :: eio)
        select type (eio)
        type is (eio_lcio_t)
           extension_lcio = &
                var_list%get_sval (var_str ("$extension_lcio"))
+          proc_as_run_id = &
+               var_list%get_lval (var_str ("?proc_as_run_id"))
+          lcio_run_id = &
+               var_list%get_ival (var_str ("lcio_run_id"))
           call eio%set_parameters (recover_beams, &
                use_alphas_from_file, use_scale_from_file, &
-               extension_lcio)
+               extension_lcio, proc_as_run_id = proc_as_run_id, &
+               lcio_run_id = lcio_run_id)
        end select
     case ("stdhep")
        allocate (eio_stdhep_hepevt_t :: eio)
        select type (eio)
        type is (eio_stdhep_hepevt_t)
           extension_stdhep = &
                var_list%get_sval (var_str ("$extension_stdhep"))
           call eio%set_parameters &
                (keep_beams, keep_remnants, ensure_order, recover_beams, &
                 use_alphas_from_file, use_scale_from_file, extension_stdhep)
        end select
     case ("stdhep_up")
        allocate (eio_stdhep_hepeup_t :: eio)
        select type (eio)
        type is (eio_stdhep_hepeup_t)
           extension_stdhep_up = &
                var_list%get_sval (var_str ("$extension_stdhep_up"))
           call eio%set_parameters (keep_beams, keep_remnants, ensure_order, &
                recover_beams, use_alphas_from_file, &
                use_scale_from_file, extension_stdhep_up)
        end select
     case ("stdhep_ev4")
        allocate (eio_stdhep_hepev4_t :: eio)
        select type (eio)
        type is (eio_stdhep_hepev4_t)
           extension_stdhep_ev4 = &
                var_list%get_sval (var_str ("$extension_stdhep_ev4"))
           call eio%set_parameters &
                (keep_beams, keep_remnants, ensure_order, recover_beams, &
                 use_alphas_from_file, use_scale_from_file, extension_stdhep_ev4)
        end select
     case ("ascii")
        allocate (eio_ascii_ascii_t :: eio)
        select type (eio)
        type is (eio_ascii_ascii_t)
           extension_default = &
                var_list%get_sval (var_str ("$extension_default"))
           call eio%set_parameters &
                (keep_beams, keep_remnants, ensure_order, extension_default)
        end select
     case ("athena")
        allocate (eio_ascii_athena_t :: eio)
        select type (eio)
        type is (eio_ascii_athena_t)
           extension_athena = &
                var_list%get_sval (var_str ("$extension_athena"))
           call eio%set_parameters &
                (keep_beams, keep_remnants, ensure_order, extension_athena)
        end select
     case ("debug")
        allocate (eio_ascii_debug_t :: eio)
        select type (eio)
        type is (eio_ascii_debug_t)
           debug_extension = &
                var_list%get_sval (var_str ("$debug_extension"))
           show_process = &
                var_list%get_lval (var_str ("?debug_process"))
           show_transforms = &
                var_list%get_lval (var_str ("?debug_transforms"))
           show_decay = &
                var_list%get_lval (var_str ("?debug_decay"))
           verbose = &
                var_list%get_lval (var_str ("?debug_verbose"))
           call eio%set_parameters ( &
                extension = debug_extension, &
                show_process = show_process, &
                show_transforms = show_transforms, &
                show_decay = show_decay, &
                verbose = verbose)
        end select
     case ("dump")
        allocate (eio_dump_t :: eio)
        select type (eio)
        type is (eio_dump_t)
           dump_extension = &
                var_list%get_sval (var_str ("$dump_extension"))
           pacified = &
                var_list%get_lval (var_str ("?pacify"))
           dump_weights = &
                var_list%get_lval (var_str ("?dump_weights"))
           dump_compressed = &
                var_list%get_lval (var_str ("?dump_compressed"))
           dump_summary = &
                var_list%get_lval (var_str ("?dump_summary"))
           dump_screen = &
                var_list%get_lval (var_str ("?dump_screen"))
           call eio%set_parameters ( &
                extension = dump_extension, &
                pacify = pacified, &
                weights = dump_weights, &
                compressed = dump_compressed, &
                summary = dump_summary, &
                screen = dump_screen)
        end select
     case ("hepevt")
        allocate (eio_ascii_hepevt_t :: eio)
        select type (eio)
        type is (eio_ascii_hepevt_t)
           extension_hepevt = &
                var_list%get_sval (var_str ("$extension_hepevt"))
           call eio%set_parameters &
                (keep_beams, keep_remnants, ensure_order, extension_hepevt)
        end select
     case ("hepevt_verb")
        allocate (eio_ascii_hepevt_verb_t :: eio)
        select type (eio)
        type is (eio_ascii_hepevt_verb_t)
           extension_hepevt_verb = &
                var_list%get_sval (var_str ("$extension_hepevt_verb"))
           call eio%set_parameters &
                (keep_beams, keep_remnants, ensure_order, extension_hepevt_verb)
        end select
     case ("lha")
        allocate (eio_ascii_lha_t :: eio)
        select type (eio)
        type is (eio_ascii_lha_t)
           extension_lha = &
                var_list%get_sval (var_str ("$extension_lha"))
           call eio%set_parameters &
                (keep_beams, keep_remnants, ensure_order, extension_lha)
        end select
     case ("lha_verb")
        allocate (eio_ascii_lha_verb_t :: eio)
        select type (eio)
        type is (eio_ascii_lha_verb_t)
           extension_lha_verb = var_list%get_sval ( &
                var_str ("$extension_lha_verb"))
           call eio%set_parameters &
                (keep_beams, keep_remnants, ensure_order, extension_lha_verb)
        end select
     case ("long")
        allocate (eio_ascii_long_t :: eio)
        select type (eio)
        type is (eio_ascii_long_t)
           extension_ascii_long = &
                var_list%get_sval (var_str ("$extension_ascii_long"))
           call eio%set_parameters &
                (keep_beams, keep_remnants, ensure_order, extension_ascii_long)
        end select
     case ("mokka")
        allocate (eio_ascii_mokka_t :: eio)
        select type (eio)
        type is (eio_ascii_mokka_t)
           extension_mokka = &
                var_list%get_sval (var_str ("$extension_mokka"))
           call eio%set_parameters &
                (keep_beams, keep_remnants, ensure_order, extension_mokka)
        end select
     case ("short")
        allocate (eio_ascii_short_t :: eio)
        select type (eio)
        type is (eio_ascii_short_t)
           extension_ascii_short = &
                var_list%get_sval (var_str ("$extension_ascii_short"))
           call eio%set_parameters &
                (keep_beams, keep_remnants, ensure_order, extension_ascii_short)
        end select
     case ("weight_stream")
        allocate (eio_weights_t :: eio)
        select type (eio)
        type is (eio_weights_t)
           pacified = &
                var_list%get_lval (var_str ("?pacify"))
           call eio%set_parameters (pacify = pacified)
        end select
     case default
        call msg_fatal ("Event I/O method '" // char (method) &
             // "' not implemented")
     end select
     call eio%set_fallback_model (fallback_model)
   end subroutine dispatch_eio
 
 @ %def dispatch_eio
 @
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[dispatch_transforms_ut.f90]]>>=
 <<File header>>
 
 module dispatch_transforms_ut
   use unit_tests
   use dispatch_transforms_uti
 
 <<Standard module head>>
 
 <<Dispatch transforms: public test>>
 
 contains
 
 <<Dispatch transforms: test driver>>
 
 end module dispatch_transforms_ut
 @ %def dispatch_transforms_ut
 @
 <<[[dispatch_transforms_uti.f90]]>>=
 <<File header>>
 
 module dispatch_transforms_uti
 
 <<Use kinds>>
 <<Use strings>>
   use format_utils, only: write_separator
   use variables
   use event_base, only: event_callback_t
   use models, only: model_t, model_list_t
   use models, only: syntax_model_file_init, syntax_model_file_final
   use resonances, only: resonance_history_set_t
   use beam_structures, only: beam_structure_t
   use eio_base, only: eio_t
   use os_interface, only: os_data_t
   use event_transforms, only: evt_t
   use dispatch_transforms
 
 <<Standard module head>>
 
 <<Dispatch transforms: test declarations>>
 
 contains
 
 <<Dispatch transforms: tests>>
 
 end module dispatch_transforms_uti
 @ %def dispatch_transforms_uti
 @ API: driver for the unit tests below.
 <<Dispatch transforms: public test>>=
   public ::dispatch_transforms_test
 <<Dispatch transforms: test driver>>=
   subroutine dispatch_transforms_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Dispatch transforms: execute tests>>
   end subroutine dispatch_transforms_test
 
 @  %def dispatch_transforms_test
 @
 \subsubsection{Event I/O}
 <<Dispatch transforms: execute tests>>=
   call test (dispatch_transforms_1, "dispatch_transforms_1", &
        "event I/O", &
        u, results)
 <<Dispatch transforms: test declarations>>=
   public :: dispatch_transforms_1
 <<Dispatch transforms: tests>>=
   subroutine dispatch_transforms_1 (u)
     integer, intent(in) :: u
     type(var_list_t) :: var_list
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(os_data_t) :: os_data
     class(event_callback_t), allocatable :: event_callback
     class(eio_t), allocatable :: eio
 
     write (u, "(A)")  "* Test output: dispatch_transforms_1"
     write (u, "(A)")  "*   Purpose: allocate an event I/O (eio) stream"
     write (u, "(A)")
 
     call var_list%init_defaults (0)
     call os_data%init ()
     call syntax_model_file_init ()
     call model_list%read_model (var_str ("SM_hadrons"), &
          var_str ("SM_hadrons.mdl"), os_data, model)
 
     write (u, "(A)")  "* Allocate as raw"
     write (u, "(A)")
 
     call dispatch_eio (eio, var_str ("raw"), var_list, &
          model, event_callback)
 
     call eio%write (u)
 
     call eio%final ()
     deallocate (eio)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate as checkpoints:"
     write (u, "(A)")
 
     call dispatch_eio (eio, var_str ("checkpoint"), var_list, &
          model, event_callback)
 
     call eio%write (u)
 
     call eio%final ()
     deallocate (eio)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate as LHEF:"
     write (u, "(A)")
 
     call var_list%set_string (var_str ("$lhef_extension"), &
          var_str ("lhe_custom"), is_known = .true.)
     call dispatch_eio (eio, var_str ("lhef"), var_list, &
          model, event_callback)
 
     call eio%write (u)
 
     call eio%final ()
     deallocate (eio)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate as HepMC:"
     write (u, "(A)")
 
     call dispatch_eio (eio, var_str ("hepmc"), var_list, &
          model, event_callback)
 
     call eio%write (u)
 
     call eio%final ()
     deallocate (eio)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate as weight_stream"
     write (u, "(A)")
 
     call dispatch_eio (eio, var_str ("weight_stream"), var_list, &
          model, event_callback)
 
     call eio%write (u)
 
     call eio%final ()
     deallocate (eio)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate as debug format"
     write (u, "(A)")
 
     call var_list%set_log (var_str ("?debug_verbose"), &
          .false., is_known = .true.)
     call dispatch_eio (eio, var_str ("debug"), var_list, &
          model, event_callback)
 
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
     call var_list%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_transforms_1"
 
   end subroutine dispatch_transforms_1
 
 @ %def dispatch_transforms_1
 @
 \subsubsection{Event transforms}
 This test dispatches [[evt]] (event transform) objects.
 <<Dispatch transforms: execute tests>>=
   call test (dispatch_transforms_2, "dispatch_transforms_2", &
        "event transforms", &
        u, results)
 <<Dispatch transforms: test declarations>>=
   public :: dispatch_transforms_2
 <<Dispatch transforms: tests>>=
   subroutine dispatch_transforms_2 (u)
     integer, intent(in) :: u
     type(var_list_t), target :: var_list
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     type(os_data_t) :: os_data
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(beam_structure_t) :: beam_structure
     class(evt_t), pointer :: evt
 
     write (u, "(A)")  "* Test output: dispatch_transforms_2"
     write (u, "(A)")  "*   Purpose: configure event transform"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call var_list%init_defaults (0)
     call os_data%init ()
     call model_list%read_model (var_str ("SM_hadrons"), &
          var_str ("SM_hadrons.mdl"), os_data, model)
 
     write (u, "(A)")  "* Resonance insertion"
     write (u, "(A)")
 
     call var_list%set_log (var_str ("?resonance_history"), .true., &
          is_known = .true.)
     call dispatch_evt_resonance (evt, var_list, &
          res_history_set, &
          var_str ("foo_R"))
     call evt%write (u, verbose = .true., more_verbose = .true.)
 
     call evt%final ()
     deallocate (evt)
 
     write (u, "(A)")
     write (u, "(A)")  "* ISR handler"
     write (u, "(A)")
 
     call var_list%set_log (var_str ("?isr_handler"), .true., &
          is_known = .true.)
     call var_list%set_log (var_str ("?epa_handler"), .false., &
          is_known = .true.)
     call var_list%set_string (var_str ("$isr_handler_mode"), &
          var_str ("recoil"), &
          is_known = .true.)
     call var_list%set_real (var_str ("sqrts"), 100._default, &
          is_known = .true.)
     call var_list%set_real (var_str ("isr_mass"), 511.e-6_default, &
          is_known = .true.)
     call dispatch_evt_isr_epa_handler (evt, var_list)
     call evt%write (u, verbose = .true., more_verbose = .true.)
 
     call evt%final ()
     deallocate (evt)
 
     write (u, "(A)")
     write (u, "(A)")  "* EPA handler"
     write (u, "(A)")
 
     call var_list%set_log (var_str ("?isr_handler"), .false., &
          is_known = .true.)
     call var_list%set_log (var_str ("?epa_handler"), .true., &
          is_known = .true.)
     call var_list%set_string (var_str ("$epa_handler_mode"), &
          var_str ("recoil"), &
          is_known = .true.)
     call var_list%set_real (var_str ("sqrts"), 100._default, &
          is_known = .true.)
     call var_list%set_real (var_str ("epa_mass"), 511.e-6_default, &
          is_known = .true.)
     call dispatch_evt_isr_epa_handler (evt, var_list)
     call evt%write (u, verbose = .true., more_verbose = .true.)
 
     call evt%final ()
     deallocate (evt)
 
     write (u, "(A)")
     write (u, "(A)")  "* Partonic decays"
     write (u, "(A)")
 
     call dispatch_evt_decay (evt, var_list)
     call evt%write (u, verbose = .true., more_verbose = .true.)
 
     call evt%final ()
     deallocate (evt)
 
     write (u, "(A)")
     write (u, "(A)")  "* Shower"
     write (u, "(A)")
 
     call var_list%set_log (var_str ("?allow_shower"), .true., &
          is_known = .true.)
     call var_list%set_string (var_str ("$shower_method"), &
          var_str ("WHIZARD"), is_known = .true.)
     call dispatch_evt_shower (evt, var_list, model, &
          model, os_data, beam_structure)
     call evt%write (u)
     call write_separator (u, 2)
 
     call evt%final ()
     deallocate (evt)
 
     call var_list%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_transforms_2"
 
   end subroutine dispatch_transforms_2
 
 @ %def dispatch_transforms_2
Index: trunk/src/events/events.nw
===================================================================
--- trunk/src/events/events.nw	(revision 8384)
+++ trunk/src/events/events.nw	(revision 8385)
@@ -1,16986 +1,17006 @@
 %% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
 % WHIZARD code as NOWEB source: event handling objects
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Generic Event Handling}
 \includemodulegraph{events}
 
 Event records allow the MC to communicate with the outside world.  The
 event record should exhibit the observable contents of a physical
 event.  We should be able to read and write events.  The actual
 implementation of the event need not be defined yet, for that purpose.
 
 We have the following basic modules:
 \begin{description}
 \item[event\_base]
   Abstract base type for event records.  The base type contains a
   reference to a [[particle_set_t]] object as the event core, and it
   holds some data that we should always expect, such as the squared
   matrix element and event weight.
 \item[eio\_data]
   Transparent container for the metadata of an event sample.
 \item[eio\_base]
   Abstract base type for event-record input and output.  The
   implementations of this base type represent specific event I/O
   formats.
 \end{description}
 
 These are the implementation modules:
 \begin{description}
 \item[eio\_checkpoints]
   Auxiliary output format.  The only purpose is to provide screen
   diagnostics during event output.
 \item[eio\_callback]
   Auxiliary output format.  The only purpose is to execute a callback
   procedure, so we have a hook for external access during event output.
 \item[eio\_weights]
   Print some event summary data, no details.  The main use if for
   testing purposes.
 \item[eio\_dump]
   Dump the contents of WHIZARD's [[particle_set]] internal record,
   using the [[write]] method of that record as-is.  The main use if for
   testing purposes.
 \item[hep\_common]
   Implements traditional HEP common blocks that are (still) used by
   some of the event I/O formats below.
 \item[hepmc\_interface]
   Access particle objects of the HepMC package.  Functional only if this
   package is linked. The interface is working both for HepMC2 and HepMC3.
 \item[lcio\_interface]
   Access objects of the LCIO package.  Functional only if this
   package is linked.
 \item[hep\_events]
   Interface between the event record and the common blocks.
 \item[eio\_ascii]
   Collection of event output formats that write ASCII files.
 \item[eio\_lhef]
   LHEF for input and output.
 \item[eio\_stdhep]
   Support for the StdHEP format (binary, machine-independent).
 \item[eio\_hepmc]
   Support for the HepMC format (C++).
 \item[eio\_lcio]
   Support for the LCIO format (C++).
 \end{description}
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Generic Event Handling}
 We introduce events first in form of an abstract type, together with
 some utilities.  Abstract events can be used by other modules, in
 particular event I/O, without introducing an explicit dependency on
 the event implementation.
 <<[[event_base.f90]]>>=
 <<File header>>
 
 module event_base
 
 <<Use kinds>>
   use kinds, only: i64
 <<Use strings>>
   use io_units
   use string_utils, only: lower_case
   use diagnostics
   use model_data
   use particles
 
 <<Standard module head>>
 
 <<Event base: public>>
 
 <<Event base: parameters>>
 
 <<Event base: types>>
 
 <<Event base: interfaces>>
 
 contains
 
 <<Event base: procedures>>
 
 end module event_base
 @ %def event_base
 @
 \subsection{generic event type}
 <<Event base: public>>=
   public :: generic_event_t
 <<Event base: types>>=
   type, abstract :: generic_event_t
      !private
      logical :: particle_set_is_valid = .false.
      type(particle_set_t), pointer :: particle_set => null ()
      logical :: sqme_ref_known = .false.
      real(default) :: sqme_ref = 0
      logical :: sqme_prc_known = .false.
      real(default) :: sqme_prc = 0
      logical :: weight_ref_known = .false.
      real(default) :: weight_ref = 0
      logical :: weight_prc_known = .false.
      real(default) :: weight_prc = 0
      logical :: excess_prc_known = .false.
      real(default) :: excess_prc = 0
      logical :: n_dropped_known = .false.
      integer :: n_dropped = 0
      integer :: n_alt = 0
      logical :: sqme_alt_known = .false.
      real(default), dimension(:), allocatable :: sqme_alt
      logical :: weight_alt_known = .false.
      real(default), dimension(:), allocatable :: weight_alt
    contains
    <<Event base: generic event: TBP>>
   end type generic_event_t
 
 @ %def generic_event_t
 @
 \subsection{Initialization}
 This determines the number of alternate weights and sqme values.
 <<Event base: generic event: TBP>>=
   procedure :: base_init => generic_event_init
 <<Event base: procedures>>=
   subroutine generic_event_init (event, n_alt)
     class(generic_event_t), intent(out) :: event
     integer, intent(in) :: n_alt
     event%n_alt = n_alt
     allocate (event%sqme_alt (n_alt))
     allocate (event%weight_alt (n_alt))
   end subroutine generic_event_init
 
 @ %def generic_event_init
 @
 \subsection{Access particle set}
 The particle set is the core of the event.  We allow access to it via
 a pointer, and we maintain the information whether the particle set
 is valid, i.e., has been filled with meaningful data.
 <<Event base: generic event: TBP>>=
   procedure :: has_valid_particle_set => generic_event_has_valid_particle_set
   procedure :: accept_particle_set => generic_event_accept_particle_set
   procedure :: discard_particle_set => generic_event_discard_particle_set
 <<Event base: procedures>>=
   function generic_event_has_valid_particle_set (event) result (flag)
     class(generic_event_t), intent(in) :: event
     logical :: flag
     flag = event%particle_set_is_valid
   end function generic_event_has_valid_particle_set
 
   subroutine generic_event_accept_particle_set (event)
     class(generic_event_t), intent(inout) :: event
     event%particle_set_is_valid = .true.
   end subroutine generic_event_accept_particle_set
 
   subroutine generic_event_discard_particle_set (event)
     class(generic_event_t), intent(inout) :: event
     event%particle_set_is_valid = .false.
   end subroutine generic_event_discard_particle_set
 
 @ %def generic_event_has_valid_particle_set
 @ %def generic_event_accept_particle_set
 @ %def generic_event_discard_particle_set
 @
 These procedures deal with the particle set directly.  Return the pointer:
 <<Event base: generic event: TBP>>=
   procedure :: get_particle_set_ptr => generic_event_get_particle_set_ptr
 <<Event base: procedures>>=
   function generic_event_get_particle_set_ptr (event) result (ptr)
     class(generic_event_t), intent(in) :: event
     type(particle_set_t), pointer :: ptr
     ptr => event%particle_set
   end function generic_event_get_particle_set_ptr
 
 @ %def generic_event_get_particle_set_ptr
 @
 Let it point to some existing particle set:
 <<Event base: generic event: TBP>>=
   procedure :: link_particle_set => generic_event_link_particle_set
 <<Event base: procedures>>=
   subroutine generic_event_link_particle_set (event, particle_set)
     class(generic_event_t), intent(inout) :: event
     type(particle_set_t), intent(in), target :: particle_set
     event%particle_set => particle_set
     call event%accept_particle_set ()
   end subroutine generic_event_link_particle_set
 
 @ %def generic_event_link_particle_set
 @
 \subsection{Access sqme and weight}
 There are several incarnations: the current value, a reference value,
 alternate values.
 <<Event base: generic event: TBP>>=
   procedure :: sqme_prc_is_known => generic_event_sqme_prc_is_known
   procedure :: sqme_ref_is_known => generic_event_sqme_ref_is_known
   procedure :: sqme_alt_is_known => generic_event_sqme_alt_is_known
   procedure :: weight_prc_is_known => generic_event_weight_prc_is_known
   procedure :: weight_ref_is_known => generic_event_weight_ref_is_known
   procedure :: weight_alt_is_known => generic_event_weight_alt_is_known
   procedure :: excess_prc_is_known => generic_event_excess_prc_is_known
 <<Event base: procedures>>=
   function generic_event_sqme_prc_is_known (event) result (flag)
     class(generic_event_t), intent(in) :: event
     logical :: flag
     flag = event%sqme_prc_known
   end function generic_event_sqme_prc_is_known
 
   function generic_event_sqme_ref_is_known (event) result (flag)
     class(generic_event_t), intent(in) :: event
     logical :: flag
     flag = event%sqme_ref_known
   end function generic_event_sqme_ref_is_known
 
   function generic_event_sqme_alt_is_known (event) result (flag)
     class(generic_event_t), intent(in) :: event
     logical :: flag
     flag = event%sqme_alt_known
   end function generic_event_sqme_alt_is_known
 
   function generic_event_weight_prc_is_known (event) result (flag)
     class(generic_event_t), intent(in) :: event
     logical :: flag
     flag = event%weight_prc_known
   end function generic_event_weight_prc_is_known
 
   function generic_event_weight_ref_is_known (event) result (flag)
     class(generic_event_t), intent(in) :: event
     logical :: flag
     flag = event%weight_ref_known
   end function generic_event_weight_ref_is_known
 
   function generic_event_weight_alt_is_known (event) result (flag)
     class(generic_event_t), intent(in) :: event
     logical :: flag
     flag = event%weight_alt_known
   end function generic_event_weight_alt_is_known
 
   function generic_event_excess_prc_is_known (event) result (flag)
     class(generic_event_t), intent(in) :: event
     logical :: flag
     flag = event%excess_prc_known
   end function generic_event_excess_prc_is_known
 
 @ %def generic_event_sqme_prc_is_known
 @ %def generic_event_sqme_ref_is_known
 @ %def generic_event_sqme_alt_is_known
 @ %def generic_event_weight_prc_is_known
 @ %def generic_event_weight_ref_is_known
 @ %def generic_event_weight_alt_is_known
 @ %def generic_event_excess_prc_is_known
 @
 <<Event base: generic event: TBP>>=
   procedure :: get_n_alt => generic_event_get_n_alt
 <<Event base: procedures>>=
   function generic_event_get_n_alt (event) result (n)
     class(generic_event_t), intent(in) :: event
     integer :: n
     n = event%n_alt
   end function generic_event_get_n_alt
 
 @ %def generic_event_get_n_alt
 @
 <<Event base: generic event: TBP>>=
   procedure :: get_sqme_prc => generic_event_get_sqme_prc
   procedure :: get_sqme_ref => generic_event_get_sqme_ref
   generic :: get_sqme_alt => &
        generic_event_get_sqme_alt_0, generic_event_get_sqme_alt_1
   procedure :: generic_event_get_sqme_alt_0
   procedure :: generic_event_get_sqme_alt_1
   procedure :: get_weight_prc => generic_event_get_weight_prc
   procedure :: get_weight_ref => generic_event_get_weight_ref
   generic :: get_weight_alt => &
        generic_event_get_weight_alt_0, generic_event_get_weight_alt_1
   procedure :: generic_event_get_weight_alt_0
   procedure :: generic_event_get_weight_alt_1
   procedure :: get_n_dropped => generic_event_get_n_dropped
   procedure :: get_excess_prc => generic_event_get_excess_prc
 <<Event base: procedures>>=
   function generic_event_get_sqme_prc (event) result (sqme)
     class(generic_event_t), intent(in) :: event
     real(default) :: sqme
     if (event%sqme_prc_known) then
        sqme = event%sqme_prc
     else
        sqme = 0
     end if
   end function generic_event_get_sqme_prc
 
   function generic_event_get_sqme_ref (event) result (sqme)
     class(generic_event_t), intent(in) :: event
     real(default) :: sqme
     if (event%sqme_ref_known) then
        sqme = event%sqme_ref
     else
        sqme = 0
     end if
   end function generic_event_get_sqme_ref
 
   function generic_event_get_sqme_alt_0 (event, i) result (sqme)
     class(generic_event_t), intent(in) :: event
     integer, intent(in) :: i
     real(default) :: sqme
     if (event%sqme_alt_known) then
        sqme = event%sqme_alt(i)
     else
        sqme = 0
     end if
   end function generic_event_get_sqme_alt_0
 
   function generic_event_get_sqme_alt_1 (event) result (sqme)
     class(generic_event_t), intent(in) :: event
     real(default), dimension(event%n_alt) :: sqme
     sqme = event%sqme_alt
   end function generic_event_get_sqme_alt_1
 
   function generic_event_get_weight_prc (event) result (weight)
     class(generic_event_t), intent(in) :: event
     real(default) :: weight
     if (event%weight_prc_known) then
        weight = event%weight_prc
     else
        weight = 0
     end if
   end function generic_event_get_weight_prc
 
   function generic_event_get_weight_ref (event) result (weight)
     class(generic_event_t), intent(in) :: event
     real(default) :: weight
     if (event%weight_ref_known) then
        weight = event%weight_ref
     else
        weight = 0
     end if
   end function generic_event_get_weight_ref
 
   function generic_event_get_weight_alt_0 (event, i) result (weight)
     class(generic_event_t), intent(in) :: event
     integer, intent(in) :: i
     real(default) :: weight
     if (event%weight_alt_known) then
        weight = event%weight_alt(i)
     else
        weight = 0
     end if
   end function generic_event_get_weight_alt_0
 
   function generic_event_get_weight_alt_1 (event) result (weight)
     class(generic_event_t), intent(in) :: event
     real(default), dimension(event%n_alt) :: weight
     weight = event%weight_alt
   end function generic_event_get_weight_alt_1
 
   function generic_event_get_excess_prc (event) result (excess)
     class(generic_event_t), intent(in) :: event
     real(default) :: excess
     if (event%excess_prc_known) then
        excess = event%excess_prc
     else
        excess = 0
     end if
   end function generic_event_get_excess_prc
 
   function generic_event_get_n_dropped (event) result (n_dropped)
     class(generic_event_t), intent(in) :: event
     integer :: n_dropped
     if (event%n_dropped_known) then
        n_dropped = event%n_dropped
     else
        n_dropped = 0
     end if
   end function generic_event_get_n_dropped
 
 @ %def generic_event_get_sqme_prc
 @ %def generic_event_get_sqme_ref
 @ %def generic_event_get_sqme_alt
 @ %def generic_event_get_weight_prc
 @ %def generic_event_get_weight_ref
 @ %def generic_event_get_weight_alt
 @ %def generic_event_get_n_dropped
 @ %def generic_event_get_excess_prc
 @
 <<Event base: generic event: TBP>>=
   procedure :: set_sqme_prc => generic_event_set_sqme_prc
   procedure :: set_sqme_ref => generic_event_set_sqme_ref
   procedure :: set_sqme_alt => generic_event_set_sqme_alt
   procedure :: set_weight_prc => generic_event_set_weight_prc
   procedure :: set_weight_ref => generic_event_set_weight_ref
   procedure :: set_weight_alt => generic_event_set_weight_alt
   procedure :: set_excess_prc => generic_event_set_excess_prc
   procedure :: set_n_dropped => generic_event_set_n_dropped
 <<Event base: procedures>>=
   subroutine generic_event_set_sqme_prc (event, sqme)
     class(generic_event_t), intent(inout) :: event
     real(default), intent(in) :: sqme
     event%sqme_prc = sqme
     event%sqme_prc_known = .true.
   end subroutine generic_event_set_sqme_prc
 
   subroutine generic_event_set_sqme_ref (event, sqme)
     class(generic_event_t), intent(inout) :: event
     real(default), intent(in) :: sqme
     event%sqme_ref = sqme
     event%sqme_ref_known = .true.
   end subroutine generic_event_set_sqme_ref
 
   subroutine generic_event_set_sqme_alt (event, sqme)
     class(generic_event_t), intent(inout) :: event
     real(default), dimension(:), intent(in) :: sqme
     event%sqme_alt = sqme
     event%sqme_alt_known = .true.
   end subroutine generic_event_set_sqme_alt
 
   subroutine generic_event_set_weight_prc (event, weight)
     class(generic_event_t), intent(inout) :: event
     real(default), intent(in) :: weight
     event%weight_prc = weight
     event%weight_prc_known = .true.
   end subroutine generic_event_set_weight_prc
 
   subroutine generic_event_set_weight_ref (event, weight)
     class(generic_event_t), intent(inout) :: event
     real(default), intent(in) :: weight
     event%weight_ref = weight
     event%weight_ref_known = .true.
   end subroutine generic_event_set_weight_ref
 
   subroutine generic_event_set_weight_alt (event, weight)
     class(generic_event_t), intent(inout) :: event
     real(default), dimension(:), intent(in) :: weight
     event%weight_alt = weight
     event%weight_alt_known = .true.
   end subroutine generic_event_set_weight_alt
 
   subroutine generic_event_set_excess_prc (event, excess)
     class(generic_event_t), intent(inout) :: event
     real(default), intent(in) :: excess
     event%excess_prc = excess
     event%excess_prc_known = .true.
   end subroutine generic_event_set_excess_prc
   
   subroutine generic_event_set_n_dropped (event, n_dropped)
     class(generic_event_t), intent(inout) :: event
     integer, intent(in) :: n_dropped
     event%n_dropped = n_dropped
     event%n_dropped_known = .true.
   end subroutine generic_event_set_n_dropped
 
 @ %def generic_event_set_sqme_prc
 @ %def generic_event_set_sqme_ref
 @ %def generic_event_set_sqme_alt
 @ %def generic_event_set_weight_prc
 @ %def generic_event_set_weight_ref
 @ %def generic_event_set_weight_alt
 @ %def generic_event_set_n_dropped
 @
 Set the appropriate entry directly.
 <<Event base: generic event: TBP>>=
   procedure :: set => generic_event_set
 <<Event base: procedures>>=
   subroutine generic_event_set (event, &
        weight_ref, weight_prc, weight_alt, &
        excess_prc, n_dropped, &
        sqme_ref, sqme_prc, sqme_alt)
     class(generic_event_t), intent(inout) :: event
     real(default), intent(in), optional :: weight_ref, weight_prc
     real(default), intent(in), optional :: sqme_ref, sqme_prc
     real(default), dimension(:), intent(in), optional :: sqme_alt, weight_alt
     real(default), intent(in), optional :: excess_prc
     integer, intent(in), optional :: n_dropped
     if (present (sqme_prc)) then
        call event%set_sqme_prc (sqme_prc)
     end if
     if (present (sqme_ref)) then
        call event%set_sqme_ref (sqme_ref)
     end if
     if (present (sqme_alt)) then
        call event%set_sqme_alt (sqme_alt)
     end if
     if (present (weight_prc)) then
        call event%set_weight_prc (weight_prc)
     end if
     if (present (weight_ref)) then
        call event%set_weight_ref (weight_ref)
     end if
     if (present (weight_alt)) then
        call event%set_weight_alt (weight_alt)
     end if
     if (present (excess_prc)) then
        call event%set_excess_prc (excess_prc)
     end if
     if (present (n_dropped)) then
        call event%set_n_dropped (n_dropped)
     end if
   end subroutine generic_event_set
 
 @ %def generic_event_set
 @
 \subsection{Pure Virtual Methods}
 These procedures can only implemented in the concrete implementation.
 
 Output (verbose, depending on parameters).
 <<Event base: generic event: TBP>>=
   procedure (generic_event_write), deferred :: write
 <<Event base: interfaces>>=
   abstract interface
      subroutine generic_event_write (object, unit, &
           show_process, show_transforms, &
           show_decay, verbose, testflag)
        import
        class(generic_event_t), intent(in) :: object
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: show_process
        logical, intent(in), optional :: show_transforms
        logical, intent(in), optional :: show_decay
        logical, intent(in), optional :: verbose
        logical, intent(in), optional :: testflag
      end subroutine generic_event_write
   end interface
 
 @ %def generic_event_write
 @
 Generate an event, based on a selector index [[i_mci]], and optionally on an
 extra set of random numbers [[r]].  For the main bunch of random numbers that
 the generator needs, the event object should contain its own generator.
 <<Event base: generic event: TBP>>=
   procedure (generic_event_generate), deferred :: generate
 <<Event base: interfaces>>=
   abstract interface
      subroutine generic_event_generate (event, i_mci, r, i_nlo)
        import
        class(generic_event_t), intent(inout) :: event
        integer, intent(in) :: i_mci
        real(default), dimension(:), intent(in), optional :: r
        integer, intent(in), optional :: i_nlo
      end subroutine generic_event_generate
   end interface
 
 @ %def event_generate
 @
 Alternative : inject a particle set that is supposed to represent the hard
 process.
 How this determines the event, is dependent on the event structure,
 therefore this is a deferred method.
 <<Event base: generic event: TBP>>=
   procedure (generic_event_set_hard_particle_set), deferred :: &
        set_hard_particle_set
 <<Event base: interfaces>>=
   abstract interface
      subroutine generic_event_set_hard_particle_set (event, particle_set)
        import
        class(generic_event_t), intent(inout) :: event
        type(particle_set_t), intent(in) :: particle_set
      end subroutine generic_event_set_hard_particle_set
   end interface
 
 @ %def generic_event_set_hard_particle_set
 @ Event index handlers.
 <<Event base: generic event: TBP>>=
   procedure (generic_event_set_index), deferred :: set_index
   procedure (generic_event_handler), deferred :: reset_index
   procedure (generic_event_increment_index), deferred :: increment_index
 @ 
 <<Event base: interfaces>>=
   abstract interface
      subroutine generic_event_set_index (event, index)
        import
        class(generic_event_t), intent(inout) :: event
        integer, intent(in) :: index
      end subroutine generic_event_set_index
   end interface
 
   abstract interface
      subroutine generic_event_handler (event)
        import
        class(generic_event_t), intent(inout) :: event
      end subroutine generic_event_handler
   end interface
 
   abstract interface
      subroutine generic_event_increment_index (event, offset)
        import
        class(generic_event_t), intent(inout) :: event
        integer, intent(in), optional :: offset
      end subroutine generic_event_increment_index
   end interface
 
 @ %def generic_event_set_index
 @ %def generic_event_increment_index
 @ %def generic_event_handler
 @ Evaluate any expressions associated with the event.  No argument needed.
 <<Event base: generic event: TBP>>=
   procedure (generic_event_handler), deferred :: evaluate_expressions
 @
 Select internal parameters
 <<Event base: generic event: TBP>>=
   procedure (generic_event_select), deferred :: select
 <<Event base: interfaces>>=
   abstract interface
      subroutine generic_event_select (event,  i_mci, i_term, channel)
        import
        class(generic_event_t), intent(inout) :: event
        integer, intent(in) :: i_mci, i_term, channel
      end subroutine generic_event_select
   end interface
 
 @ %def generic_event_select
 @ Return a pointer to the model for the currently active process.
 <<Event base: generic event: TBP>>=
   procedure (generic_event_get_model_ptr), deferred :: get_model_ptr
 <<Event base: interfaces>>=
   abstract interface
      function generic_event_get_model_ptr (event) result (model)
        import
        class(generic_event_t), intent(in) :: event
        class(model_data_t), pointer :: model
      end function generic_event_get_model_ptr
   end interface
 
 @ %def generic_event_get_model_ptr
 @ Return data used by external event formats.
 <<Event base: generic event: TBP>>=
   procedure (generic_event_has_index), deferred :: has_index
   procedure (generic_event_get_index), deferred :: get_index
   procedure (generic_event_get_fac_scale), deferred :: get_fac_scale
   procedure (generic_event_get_alpha_s), deferred :: get_alpha_s
   procedure (generic_event_get_sqrts), deferred :: get_sqrts
   procedure (generic_event_get_polarization), deferred :: get_polarization
   procedure (generic_event_get_beam_file), deferred :: get_beam_file
   procedure (generic_event_get_process_name), deferred :: &
        get_process_name
 <<Event base: interfaces>>=
   abstract interface
      function generic_event_has_index (event) result (flag)
        import
        class(generic_event_t), intent(in) :: event
        logical :: flag
      end function generic_event_has_index
   end interface
 
   abstract interface
      function generic_event_get_index (event) result (index)
        import
        class(generic_event_t), intent(in) :: event
        integer :: index
      end function generic_event_get_index
   end interface
 
   abstract interface
      function generic_event_get_fac_scale (event) result (fac_scale)
        import
        class(generic_event_t), intent(in) :: event
        real(default) :: fac_scale
      end function generic_event_get_fac_scale
   end interface
 
   abstract interface
      function generic_event_get_alpha_s (event) result (alpha_s)
        import
        class(generic_event_t), intent(in) :: event
        real(default) :: alpha_s
      end function generic_event_get_alpha_s
   end interface
 
   abstract interface
      function generic_event_get_sqrts (event) result (sqrts)
        import
        class(generic_event_t), intent(in) :: event
        real(default) :: sqrts
      end function generic_event_get_sqrts
   end interface
 
   abstract interface
      function generic_event_get_polarization (event) result (pol)
        import
        class(generic_event_t), intent(in) :: event
        real(default), dimension(2) :: pol
      end function generic_event_get_polarization
   end interface
 
   abstract interface
      function generic_event_get_beam_file (event) result (file)
        import
        class(generic_event_t), intent(in) :: event
        type(string_t) :: file
      end function generic_event_get_beam_file
   end interface
 
   abstract interface
      function generic_event_get_process_name (event) result (name)
        import
        class(generic_event_t), intent(in) :: event
        type(string_t) :: name
      end function generic_event_get_process_name
   end interface
 
 @ %def generic_event_get_index
 @ %def generic_event_get_fac_scale
 @ %def generic_event_get_alpha_s
 @ %def generic_event_get_sqrts
 @ %def generic_event_get_polarization
 @ %def generic_event_get_beam_file
 @ %def generic_event_get_process_name
 @ Set data used by external event formats.
 <<Event base: generic event: TBP>>=
   procedure (generic_event_set_alpha_qcd_forced), deferred :: &
        set_alpha_qcd_forced
   procedure (generic_event_set_scale_forced), deferred :: &
        set_scale_forced
 <<Event base: interfaces>>=
   abstract interface
      subroutine generic_event_set_alpha_qcd_forced (event, alpha_qcd)
        import
        class(generic_event_t), intent(inout) :: event
        real(default), intent(in) :: alpha_qcd
      end subroutine generic_event_set_alpha_qcd_forced
   end interface
 
   abstract interface
      subroutine generic_event_set_scale_forced (event, scale)
        import
        class(generic_event_t), intent(inout) :: event
        real(default), intent(in) :: scale
      end subroutine generic_event_set_scale_forced
   end interface
 
 @ %def generic_event_set_alpha_qcd_forced
 @ %def generic_event_set_scale_forced
 @
 \subsection{Utilities}
 Applying this, current event contents are marked as incomplete but
 are not deleted.  In particular, the initialization is kept.
 <<Event base: generic event: TBP>>=
   procedure :: reset_contents => generic_event_reset_contents
   procedure :: base_reset_contents => generic_event_reset_contents
 <<Event base: procedures>>=
   subroutine generic_event_reset_contents (event)
     class(generic_event_t), intent(inout) :: event
     call event%discard_particle_set ()
     event%sqme_ref_known = .false.
     event%sqme_prc_known = .false.
     event%sqme_alt_known = .false.
     event%weight_ref_known = .false.
     event%weight_prc_known = .false.
     event%weight_alt_known = .false.
     event%excess_prc_known = .false.
   end subroutine generic_event_reset_contents
 
 @ %def generic_event_reset_contents
 @ Pacify particle set.
 <<Event base: generic event: TBP>>=
   procedure :: pacify_particle_set => generic_event_pacify_particle_set
 <<Event base: procedures>>=
   subroutine generic_event_pacify_particle_set (event)
     class(generic_event_t), intent(inout) :: event
     if (event%has_valid_particle_set ())  call pacify (event%particle_set)
   end subroutine generic_event_pacify_particle_set
 
 @ %def generic_event_pacify_particle_set
 @
 \subsection{Event normalization}
 The parameters for event normalization.  For unweighted events,
 [[NORM_UNIT]] is intended as default, while for weighted events, it is
 [[NORM_SIGMA]].
 
 Note: the unit test for this is in [[eio_data_2]] below.
 <<Event base: parameters>>=
   integer, parameter, public :: NORM_UNDEFINED = 0
   integer, parameter, public :: NORM_UNIT = 1
   integer, parameter, public :: NORM_N_EVT = 2
   integer, parameter, public :: NORM_SIGMA = 3
   integer, parameter, public :: NORM_S_N = 4
 
 @ %def NORM_UNDEFINED NORM_UNIT NORM_N_EVT NORM_SIGMA NORM_S_N
 @ These functions translate between the user representation and the
 internal one.
 <<Event base: public>>=
   public :: event_normalization_mode
   public :: event_normalization_string
 <<Event base: procedures>>=
   function event_normalization_mode (string, unweighted) result (mode)
     integer :: mode
     type(string_t), intent(in) :: string
     logical, intent(in) :: unweighted
     select case (lower_case (char (string)))
     case ("auto")
        if (unweighted) then
           mode = NORM_UNIT
        else
           mode = NORM_SIGMA
        end if
     case ("1")
        mode = NORM_UNIT
     case ("1/n")
        mode = NORM_N_EVT
     case ("sigma")
        mode = NORM_SIGMA
     case ("sigma/n")
        mode = NORM_S_N
     case default
        call msg_fatal ("Event normalization: unknown value '" &
             // char (string) // "'")
     end select
   end function event_normalization_mode
 
   function event_normalization_string (norm_mode) result (string)
     integer, intent(in) :: norm_mode
     type(string_t) :: string
     select case (norm_mode)
     case (NORM_UNDEFINED); string = "[undefined]"
     case (NORM_UNIT);      string = "'1'"
     case (NORM_N_EVT);     string = "'1/n'"
     case (NORM_SIGMA);     string = "'sigma'"
     case (NORM_S_N);       string = "'sigma/n'"
     case default;          string = "???"
     end select
   end function event_normalization_string
 
 @ %def event_normalization_mode
 @ %def event_normalization_string
 @ We place this here as a generic helper, so we can update event
 weights whenever we need, not just in connection with an event sample
 data object.
 <<Event base: public>>=
   public :: event_normalization_update
 <<Event base: procedures>>=
   subroutine event_normalization_update (weight, sigma, n, mode_new, mode_old)
     real(default), intent(inout) :: weight
     real(default), intent(in) :: sigma
     integer, intent(in) :: n
     integer, intent(in) :: mode_new, mode_old
     if (mode_new /= mode_old) then
        if (sigma > 0 .and. n > 0) then
           weight = weight / factor (mode_old) * factor (mode_new)
        else
           call msg_fatal ("Event normalization update: null sample")
        end if
     end if
   contains
     function factor (mode)
       real(default) :: factor
       integer, intent(in) :: mode
       select case (mode)
       case (NORM_UNIT);   factor = 1._default
       case (NORM_N_EVT);  factor = 1._default / n
       case (NORM_SIGMA);  factor = sigma
       case (NORM_S_N);    factor = sigma / n
       case default
          call msg_fatal ("Event normalization update: undefined mode")
       end select
     end function factor
   end subroutine event_normalization_update
 
 @ %def event_normalization_update
 @
 \subsection{Callback container}
 This derived type contains a callback procedure that can
 be executed during event I/O.  The callback procedure is given the
 event object (with class [[generic_event]]) and an event index.
 
 This is a simple wrapper.  The object is abstract, so the the actual
 procedure is introduced by overriding the deferred one.  We use the
 PASS attribute, so we may supplement runtime data in the callback object
 if desired.
 <<Event base: public>>=
   public :: event_callback_t
 <<Event base: types>>=
   type, abstract :: event_callback_t
      private
    contains
      procedure(event_callback_write), deferred :: write
      procedure(event_callback_proc), deferred :: proc
   end type event_callback_t
 
 @ %def event_callback_t
 @ Identify the callback procedure in output
 <<Event base: interfaces>>=
   abstract interface
      subroutine event_callback_write (event_callback, unit)
        import
        class(event_callback_t), intent(in) :: event_callback
        integer, intent(in), optional :: unit
      end subroutine event_callback_write
   end interface
 
 @ %def event_callback_write
 @ This is the procedure interface.
 <<Event base: interfaces>>=
   abstract interface
      subroutine event_callback_proc (event_callback, i, event)
        import
        class(event_callback_t), intent(in) :: event_callback
        integer(i64), intent(in) :: i
        class(generic_event_t), intent(in) :: event
      end subroutine event_callback_proc
   end interface
 
 @ %def event_callback_proc
 @ A dummy implementation for testing and fallback.
 <<Event base: public>>=
   public :: event_callback_nop_t
 <<Event base: types>>=
   type, extends (event_callback_t) :: event_callback_nop_t
      private
    contains
      procedure :: write => event_callback_nop_write
      procedure :: proc => event_callback_nop
   end type event_callback_nop_t
 
 @ %def event_callback_t
 <<Event base: procedures>>=
   subroutine event_callback_nop_write (event_callback, unit)
     class(event_callback_nop_t), intent(in) :: event_callback
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "NOP"
   end subroutine event_callback_nop_write
 
   subroutine event_callback_nop (event_callback, i, event)
     class(event_callback_nop_t), intent(in) :: event_callback
     integer(i64), intent(in) :: i
     class(generic_event_t), intent(in) :: event
   end subroutine event_callback_nop
 
 @ %def event_callback_nop_write
 @ %def event_callback_nop
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Event Sample Data}
 We define a simple and transparent container for (meta)data that are
 associated with an event sample.
 <<[[eio_data.f90]]>>=
 <<File header>>
 
 module eio_data
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use numeric_utils
   use diagnostics
 
   use event_base
 
 <<Standard module head>>
 
 <<EIO data: public>>
 
 <<EIO data: types>>
 
 contains
 
 <<EIO data: procedures>>
 
 end module eio_data
 @ %def eio_data
 @
 \subsection{Event Sample Data}
 These are data that apply to an event sample as a whole.  They are
 given in an easily portable form (no fancy structure) and are used for
 initializing event formats.
 
 There are two MD5 sums here.  [[md5sum_proc]] depends only on the
 definition of the contributing processes.  A sample with matching
 checksum can be rescanned with modified model parameters, beam
 structure etc, to recalculate observables.  [[md5sum_config]] includes
 all relevant data.  Rescanning a sample with matching checksum will
 produce identical observables.  (A third checksum might be added which
 depends on the event sample itself.  This is not needed, so far.)
 
 If alternate weights are part of the event sample ([[n_alt]] nonzero),
 there is a configuration MD5 sum for each of them.
 <<EIO data: public>>=
   public :: event_sample_data_t
 <<EIO data: types>>=
   type :: event_sample_data_t
      character(32) :: md5sum_prc = ""
      character(32) :: md5sum_cfg = ""
      logical :: unweighted = .true.
      logical :: negative_weights = .false.
      integer :: norm_mode = NORM_UNDEFINED
      integer :: n_beam = 0
      integer, dimension(2) :: pdg_beam = 0
      real(default), dimension(2) :: energy_beam = 0
      integer :: n_proc = 0
      integer :: n_evt = 0
      integer :: nlo_multiplier = 1
      integer :: split_n_evt = 0
      integer :: split_n_kbytes = 0
      integer :: split_index = 0
      real(default) :: total_cross_section = 0
      integer, dimension(:), allocatable :: proc_num_id
      integer :: n_alt = 0
      character(32), dimension(:), allocatable :: md5sum_alt
      real(default), dimension(:), allocatable :: cross_section
      real(default), dimension(:), allocatable :: error
    contains
    <<EIO data: event sample data: TBP>>
   end type event_sample_data_t
 
 @ %def event_sample_data_t
 @ Initialize: allocate for the number of processes
 <<EIO data: event sample data: TBP>>=
   procedure :: init => event_sample_data_init
 <<EIO data: procedures>>=
   subroutine event_sample_data_init (data, n_proc, n_alt)
     class(event_sample_data_t), intent(out) :: data
     integer, intent(in) :: n_proc
     integer, intent(in), optional :: n_alt
     data%n_proc = n_proc
     allocate (data%proc_num_id (n_proc), source = 0)
     allocate (data%cross_section (n_proc), source = 0._default)
     allocate (data%error (n_proc), source = 0._default)
     if (present (n_alt)) then
        data%n_alt = n_alt
        allocate (data%md5sum_alt (n_alt))
        data%md5sum_alt = ""
     end if
   end subroutine event_sample_data_init
 
 @ %def event_sample_data_init
 @ Output.
 <<EIO data: event sample data: TBP>>=
   procedure :: write => event_sample_data_write
 <<EIO data: procedures>>=
   subroutine event_sample_data_write (data, unit)
     class(event_sample_data_t), intent(in) :: data
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event sample properties:"
     write (u, "(3x,A,A,A)")  "MD5 sum (proc)   = '", data%md5sum_prc, "'"
     write (u, "(3x,A,A,A)")  "MD5 sum (config) = '", data%md5sum_cfg, "'"
     write (u, "(3x,A,L1)")  "unweighted       = ", data%unweighted
     write (u, "(3x,A,L1)")  "negative weights = ", data%negative_weights
     write (u, "(3x,A,A)")   "normalization    = ", &
          char (event_normalization_string (data%norm_mode))
     write (u, "(3x,A,I0)")  "number of beams  = ", data%n_beam
     write (u, "(5x,A,2(1x,I19))")  "PDG    = ", &
          data%pdg_beam(:data%n_beam)
     write (u, "(5x,A,2(1x,ES19.12))")  "Energy = ", &
          data%energy_beam(:data%n_beam)
     if (data%n_evt > 0) then
        write (u, "(3x,A,I0)")  "number of events = ", data%n_evt
     end if
     if (.not. vanishes (data%total_cross_section)) then
        write (u, "(3x,A,ES19.12)")  "total cross sec. = ", &
             data%total_cross_section
     end if
     write (u, "(3x,A,I0)")  "num of processes = ", data%n_proc
     do i = 1, data%n_proc
        write (u, "(3x,A,I0)")  "Process #", data%proc_num_id (i)
        select case (data%n_beam)
        case (1)
           write (u, "(5x,A,ES19.12)")  "Width = ", data%cross_section(i)
        case (2)
           write (u, "(5x,A,ES19.12)")  "CSec  = ", data%cross_section(i)
        end select
        write (u, "(5x,A,ES19.12)")  "Error = ", data%error(i)
     end do
     if (data%n_alt > 0) then
        write (u, "(3x,A,I0)")  "num of alt wgt   = ", data%n_alt
        do i = 1, data%n_alt
           write (u, "(5x,A,A,A,1x,I0)")  "MD5 sum (cfg)  = '", &
                data%md5sum_alt(i), "'", i
        end do
     end if
   end subroutine event_sample_data_write
 
 @ %def event_sample_data_write
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_data_ut.f90]]>>=
 <<File header>>
 
 module eio_data_ut
   use unit_tests
   use eio_data_uti
 
 <<Standard module head>>
 
 <<EIO data: public test>>
 
 contains
 
 <<EIO data: test driver>>
 
 end module eio_data_ut
 @ %def eio_data_ut
 @
 <<[[eio_data_uti.f90]]>>=
 <<File header>>
 
 module eio_data_uti
 
 <<Use kinds>>
 <<Use strings>>
   use event_base
 
   use eio_data
 
 <<Standard module head>>
 
 <<EIO data: test declarations>>
 
 contains
 
 <<EIO data: tests>>
 
 end module eio_data_uti
 @ %def eio_data_ut
 @ API: driver for the unit tests below.
 <<EIO data: public test>>=
   public :: eio_data_test
 <<EIO data: test driver>>=
   subroutine eio_data_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO data: execute tests>>
   end subroutine eio_data_test
 
 @ %def eio_data_test
 @
 \subsubsection{Event Sample Data}
 Print the contents of a sample data block.
 <<EIO data: execute tests>>=
   call test (eio_data_1, "eio_data_1", &
        "event sample data", &
        u, results)
 <<EIO data: test declarations>>=
   public :: eio_data_1
 <<EIO data: tests>>=
   subroutine eio_data_1 (u)
     integer, intent(in) :: u
     type(event_sample_data_t) :: data
 
     write (u, "(A)")  "* Test output: eio_data_1"
     write (u, "(A)")  "*   Purpose:  display event sample data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Decay process, one component"
     write (u, "(A)")
 
     call data%init (1, 1)
     data%n_beam = 1
     data%pdg_beam(1) = 25
     data%energy_beam(1) = 125
 
     data%norm_mode = NORM_UNIT
 
     data%proc_num_id = [42]
     data%cross_section = [1.23e-4_default]
     data%error = 5e-6_default
 
     data%md5sum_prc = "abcdefghijklmnopabcdefghijklmnop"
     data%md5sum_cfg = "12345678901234561234567890123456"
     data%md5sum_alt(1) = "uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu"
 
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Scattering process, two components"
     write (u, "(A)")
 
     call data%init (2)
     data%n_beam = 2
     data%pdg_beam = [2212, -2212]
     data%energy_beam = [8._default, 10._default]
 
     data%norm_mode = NORM_SIGMA
 
     data%proc_num_id = [12, 34]
     data%cross_section = [100._default, 88._default]
     data%error = [1._default, 0.1_default]
 
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_data_1"
 
   end subroutine eio_data_1
 
 @ %def eio_data_1
 @
 \subsubsection{Event Normalization}
 Check the functions for translating modes and updating weights.
 <<EIO data: execute tests>>=
   call test (eio_data_2, "eio_data_2", &
        "event normalization", &
        u, results)
 <<EIO data: test declarations>>=
   public :: eio_data_2
 <<EIO data: tests>>=
   subroutine eio_data_2 (u)
     integer, intent(in) :: u
     type(string_t) :: s
     logical :: unweighted
     real(default) :: w, w0, sigma
     integer :: n
 
     write (u, "(A)")  "* Test output: eio_data_2"
     write (u, "(A)")  "*   Purpose:  handle event normalization"
     write (u, "(A)")
 
     write (u, "(A)")  "* Normalization strings"
     write (u, "(A)")
 
     s = "auto"
     unweighted = .true.
     write (u, "(1x,A,1x,L1,1x,A)")  char (s), unweighted, &
          char (event_normalization_string &
          (event_normalization_mode (s, unweighted)))
     s = "AUTO"
     unweighted = .false.
     write (u, "(1x,A,1x,L1,1x,A)")  char (s), unweighted, &
          char (event_normalization_string &
          (event_normalization_mode (s, unweighted)))
 
     unweighted = .true.
 
     s = "1"
     write (u, "(2(1x,A))") char (s), char (event_normalization_string &
          (event_normalization_mode (s, unweighted)))
     s = "1/n"
     write (u, "(2(1x,A))") char (s), char (event_normalization_string &
          (event_normalization_mode (s, unweighted)))
     s = "Sigma"
     write (u, "(2(1x,A))") char (s), char (event_normalization_string &
          (event_normalization_mode (s, unweighted)))
     s = "sigma/N"
     write (u, "(2(1x,A))") char (s), char (event_normalization_string &
          (event_normalization_mode (s, unweighted)))
 
     write (u, "(A)")
     write (u, "(A)")  "* Normalization update"
     write (u, "(A)")
 
     sigma = 5
     n = 2
 
     w0 = 1
 
     w = w0
     call event_normalization_update (w, sigma, n, NORM_UNIT, NORM_UNIT)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_N_EVT, NORM_UNIT)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_SIGMA, NORM_UNIT)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_S_N, NORM_UNIT)
     write (u, "(2(F6.3))")  w0, w
 
     write (u, *)
 
     w0 = 0.5
 
     w = w0
     call event_normalization_update (w, sigma, n, NORM_UNIT, NORM_N_EVT)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_N_EVT, NORM_N_EVT)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_SIGMA, NORM_N_EVT)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_S_N, NORM_N_EVT)
     write (u, "(2(F6.3))")  w0, w
 
     write (u, *)
 
     w0 = 5.0
 
     w = w0
     call event_normalization_update (w, sigma, n, NORM_UNIT, NORM_SIGMA)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_N_EVT, NORM_SIGMA)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_SIGMA, NORM_SIGMA)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_S_N, NORM_SIGMA)
     write (u, "(2(F6.3))")  w0, w
 
     write (u, *)
 
     w0 = 2.5
 
     w = w0
     call event_normalization_update (w, sigma, n, NORM_UNIT, NORM_S_N)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_N_EVT, NORM_S_N)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_SIGMA, NORM_S_N)
     write (u, "(2(F6.3))")  w0, w
     w = w0
     call event_normalization_update (w, sigma, n, NORM_S_N, NORM_S_N)
     write (u, "(2(F6.3))")  w0, w
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_data_2"
 
   end subroutine eio_data_2
 
 @ %def eio_data_2
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Abstract I/O Handler}
 
 This module defines an abstract object for event I/O and the
 associated methods.
 
 There are [[output]] and [[input]] methods which
 write or read a single event from/to the I/O stream, respectively.
 The I/O stream itself may be a file, a common block, or an externally
 linked structure, depending on the concrete implementation.
 
 A [[write]] method prints the current content of the
 implementation-dependent event record in human-readable form.
 
 The [[init_in]]/[[init_out]] and [[final]] prepare
 and finalize the I/O stream, respectively.  There is also a
 [[switch_inout]] method which turns an input stream into an output
 stream where events can be appended.
 
 Optionally, output files can be split in chunks of well-defined size.  The
 [[split_out]] method takes care of this.
 <<[[eio_base.f90]]>>=
 <<File header>>
 
 module eio_base
 
   use kinds, only: i64
 <<Use strings>>
   use io_units
   use diagnostics
   use model_data
   use event_base
   use eio_data
 
 <<Standard module head>>
 
 <<EIO base: public>>
 
 <<EIO base: types>>
 
 <<EIO base: interfaces>>
 
 contains
 
 <<EIO base: procedures>>
 
 end module eio_base
 @ %def eio_base
 @
 \subsection{Type}
 We can assume that most implementations will need the file extension as a
 fixed string and, if they support file splitting, the current file index.
 
 The fallback model is useful for implementations that are able to read
 unknown files which may contain hadrons etc., not in the current
 hard-interaction model.
 <<EIO base: public>>=
   public :: eio_t
 <<EIO base: types>>=
   type, abstract :: eio_t
      type(string_t) :: sample
      type(string_t) :: extension
      type(string_t) :: filename
      logical :: has_file = .false.
      logical :: split = .false.
      integer :: split_n_evt = 0
      integer :: split_n_kbytes = 0
      integer :: split_index = 0
      integer :: split_count = 0
      class(model_data_t), pointer :: fallback_model => null ()
    contains
    <<EIO base: eio: TBP>>
   end type eio_t
 
 @ %def eio_t
 @ Write to screen.  If possible, this should display the contents of the
 current event, i.e., the last one that was written or read.
 <<EIO base: eio: TBP>>=
   procedure (eio_write), deferred :: write
 <<EIO base: interfaces>>=
   abstract interface
      subroutine eio_write (object, unit)
        import
        class(eio_t), intent(in) :: object
        integer, intent(in), optional :: unit
      end subroutine eio_write
   end interface
 
 @ %def eio_write
 @ Finalize.  This should write/read footer data and close input/output
 channels.
 <<EIO base: eio: TBP>>=
   procedure (eio_final), deferred :: final
 <<EIO base: interfaces>>=
   abstract interface
      subroutine eio_final (object)
        import
        class(eio_t), intent(inout) :: object
      end subroutine eio_final
   end interface
 
 @ %def eio_final
 @ Determine splitting parameters from the event sample data.
 <<EIO base: eio: TBP>>=
   procedure :: set_splitting => eio_set_splitting
 <<EIO base: procedures>>=
   subroutine eio_set_splitting (eio, data)
     class(eio_t), intent(inout) :: eio
     type(event_sample_data_t), intent(in) :: data
     eio%split = data%split_n_evt > 0 .or. data%split_n_kbytes > 0
     if (eio%split) then
        eio%split_n_evt = data%split_n_evt
        eio%split_n_kbytes = data%split_n_kbytes
        eio%split_index = data%split_index
        eio%split_count = 0
     end if
   end subroutine eio_set_splitting
 
 @ %def eio_set_splitting
 @ Update the byte count and check if it has increased.  We use integer
 division to determine the number of [[n_kbytes]] blocks that are in
 the event file.
 <<EIO base: eio: TBP>>=
   procedure :: update_split_count => eio_update_split_count
 <<EIO base: procedures>>=
   subroutine eio_update_split_count (eio, increased)
     class(eio_t), intent(inout) :: eio
     logical, intent(out) :: increased
     integer :: split_count_old
     if (eio%split_n_kbytes > 0) then
        split_count_old = eio%split_count
        eio%split_count = eio%file_size_kbytes () / eio%split_n_kbytes
        increased = eio%split_count > split_count_old
     end if
   end subroutine eio_update_split_count
 
 @ %def eio_update_split_count
 @ Generate a filename, taking a possible split index into account.
 <<EIO base: eio: TBP>>=
   procedure :: set_filename => eio_set_filename
 <<EIO base: procedures>>=
   subroutine eio_set_filename (eio)
     class(eio_t), intent(inout) :: eio
     character(32) :: buffer
     if (eio%split) then
        write (buffer, "(I0,'.')")  eio%split_index
        eio%filename = eio%sample // "." // trim (buffer) // eio%extension
        eio%has_file = .true.
     else
        eio%filename = eio%sample // "." // eio%extension
        eio%has_file = .true.
     end if
   end subroutine eio_set_filename
 
 @ %def eio_set_filename
 @ Set the fallback model.
 <<EIO base: eio: TBP>>=
   procedure :: set_fallback_model => eio_set_fallback_model
 <<EIO base: procedures>>=
   subroutine eio_set_fallback_model (eio, model)
     class(eio_t), intent(inout) :: eio
     class(model_data_t), intent(in), target :: model
     eio%fallback_model => model
   end subroutine eio_set_fallback_model
 
 @ %def eio_set_fallback_model
 @ Initialize for output.  We provide process names.  This should
 open an event file if appropriate and write header data.  Some methods
 may require event sample data.
 <<EIO base: eio: TBP>>=
   procedure (eio_init_out), deferred :: init_out
 <<EIO base: interfaces>>=
   abstract interface
      subroutine eio_init_out (eio, sample, data, success, extension)
        import
        class(eio_t), intent(inout) :: eio
        type(string_t), intent(in) :: sample
        type(event_sample_data_t), intent(in), optional :: data
        logical, intent(out), optional :: success
        type(string_t), intent(in), optional :: extension
      end subroutine eio_init_out
   end interface
 
 @ %def eio_init_out
 @ Initialize for input.  We provide process names.  This should open an event
 file if appropriate and read header data.  The [[md5sum]] can be used to check
 the integrity of the configuration, it it provides a checksum to compare with.
 In case the extension has changed the extension is also given as an argument.
 
 The [[data]] argument is [[intent(inout)]]: we may read part of it and
 keep other parts and/or check them against the data in the file.
 <<EIO base: eio: TBP>>=
   procedure (eio_init_in), deferred :: init_in
 <<EIO base: interfaces>>=
   abstract interface
      subroutine eio_init_in (eio, sample, data, success, extension)
        import
        class(eio_t), intent(inout) :: eio
        type(string_t), intent(in) :: sample
        type(event_sample_data_t), intent(inout), optional :: data
        logical, intent(out), optional :: success
        type(string_t), intent(in), optional :: extension
      end subroutine eio_init_in
   end interface
 
 @ %def eio_init_in
 @ Re-initialize for output.  This should change the status of any event file
 from input to output and position it for appending new events.
 <<EIO base: eio: TBP>>=
   procedure (eio_switch_inout), deferred :: switch_inout
 <<EIO base: interfaces>>=
   abstract interface
      subroutine eio_switch_inout (eio, success)
        import
        class(eio_t), intent(inout) :: eio
        logical, intent(out), optional :: success
      end subroutine eio_switch_inout
   end interface
 
 @ %def eio_switch_inout
 @ This is similar: split the output, i.e., close the current file and open a
 new one.  The default implementation does nothing.  For the feature to work,
 an implementation must override this.
 <<EIO base: eio: TBP>>=
   procedure :: split_out => eio_split_out
 <<EIO base: procedures>>=
   subroutine eio_split_out (eio)
     class(eio_t), intent(inout) :: eio
   end subroutine eio_split_out
 
 @ %def eio_split_out
 @ Determine the file size in kilobytes.  More exactly, determine the
 size in units of 1024 storage units, as returned by the INQUIRE statement.
 
 The implementation returns zero if there is no file.  The
 [[has_file]] flag is set by the [[set_filename]] method, so we can be
 confident that the [[inquire]] call is meaningful.  If this algorithm
 doesn't apply for a particular format, we still can override the
 procedure.
 <<EIO base: eio: TBP>>=
   procedure :: file_size_kbytes => eio_file_size_kbytes
 <<EIO base: procedures>>=
   function eio_file_size_kbytes (eio) result (kbytes)
     class(eio_t), intent(in) :: eio
     integer :: kbytes
     integer(i64) :: bytes
     if (eio%has_file) then
        inquire (file = char (eio%filename), size = bytes)
        if (bytes > 0) then
           kbytes = bytes / 1024
        else
           kbytes = 0
        end if
     else
        kbytes = 0
     end if
   end function eio_file_size_kbytes
 
 @ %def eio_file_size_kbytes
 @ Output an event.  All data can be taken from the [[event]] record.
 The index [[i_prc]] identifies the process among the processes that
 are contained in the current sample.  The [[reading]] flag, if present,
 indicates that the event was read from file, not generated.
 
 The [[passed]] flag tells us that this event has passed the selection
 criteria.  Depending on the event format, we may choose to skip events
 that have not passed.
 <<EIO base: eio: TBP>>=
   procedure (eio_output), deferred :: output
 <<EIO base: interfaces>>=
   abstract interface
      subroutine eio_output (eio, event, i_prc, reading, passed, pacify)
        import
        class(eio_t), intent(inout) :: eio
        class(generic_event_t), intent(in), target :: event
        integer, intent(in) :: i_prc
        logical, intent(in), optional :: reading, passed, pacify
      end subroutine eio_output
   end interface
 
 @ %def eio_output
 @ Input an event.  This should fill all event data that cannot be inferred
 from the associated process.
 
 The input is broken down into two parts.  First we read the [[i_prc]]
 index.  So we know which process to expect in the subsequent event.
 If we have reached end of file, we also will know.
 Then, we read the event itself.
 
 The parameter [[iostat]] is supposed to be set as the Fortran standard
 requires, negative for EOF and positive for error.
 <<EIO base: eio: TBP>>=
   procedure (eio_input_i_prc), deferred :: input_i_prc
   procedure (eio_input_event), deferred :: input_event
 <<EIO base: interfaces>>=
   abstract interface
      subroutine eio_input_i_prc (eio, i_prc, iostat)
        import
        class(eio_t), intent(inout) :: eio
        integer, intent(out) :: i_prc
        integer, intent(out) :: iostat
      end subroutine eio_input_i_prc
   end interface
 
   abstract interface
      subroutine eio_input_event (eio, event, iostat)
        import
        class(eio_t), intent(inout) :: eio
        class(generic_event_t), intent(inout), target :: event
        integer, intent(out) :: iostat
      end subroutine eio_input_event
   end interface
 
 @ %def eio_input
 @
 <<EIO base: eio: TBP>>=
   procedure (eio_skip), deferred :: skip
 <<EIO base: interfaces>>=
   abstract interface
      subroutine eio_skip (eio, iostat)
        import
        class(eio_t), intent(inout) :: eio
        integer, intent(out) :: iostat
      end subroutine eio_skip
   end interface
 
 @ %def eio_skip
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_base_ut.f90]]>>=
 <<File header>>
 
 module eio_base_ut
   use unit_tests
   use eio_base_uti
 
 <<Standard module head>>
 
 <<EIO base: public test>>
 
 <<EIO base: public test auxiliary>>
 
 contains
 
 <<EIO base: test driver>>
 
 end module eio_base_ut
 @ %def eio_base_ut
 @
 <<[[eio_base_uti.f90]]>>=
 <<File header>>
 
 module eio_base_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use lorentz
   use model_data
   use particles
   use event_base
   use eio_data
 
   use eio_base
 
 <<Standard module head>>
 
 <<EIO base: public test auxiliary>>
 
 <<EIO base: test declarations>>
 
 <<EIO base: test types>>
 
 <<EIO base: test variables>>
 
 contains
 
 <<EIO base: tests>>
 
 <<EIO base: test auxiliary>>
 
 end module eio_base_uti
 @ %def eio_base_ut
 @ API: driver for the unit tests below.
 <<EIO base: public test>>=
   public :: eio_base_test
 <<EIO base: test driver>>=
   subroutine eio_base_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO base: execute tests>>
   end subroutine eio_base_test
 
 @ %def eio_base_test
 @ The caller has to provide procedures that prepare and cleanup the test
 environment.  They depend on modules that are not available here.
 <<EIO base: test types>>=
   abstract interface
      subroutine eio_prepare_event (event, unweighted, n_alt)
        import
        class(generic_event_t), intent(inout), pointer :: event
        logical, intent(in), optional :: unweighted
        integer, intent(in), optional :: n_alt
      end subroutine eio_prepare_event
   end interface
 
   abstract interface
      subroutine eio_cleanup_event (event)
        import
        class(generic_event_t), intent(inout), pointer :: event
      end subroutine eio_cleanup_event
   end interface
 
 @ We store pointers to the test-environment handlers as module variables.
 This allows us to call them from the test routines themselves, which don't
 allow for extra arguments.
 <<EIO base: public test auxiliary>>=
   public :: eio_prepare_test, eio_cleanup_test
 <<EIO base: test types>>=
   procedure(eio_prepare_event), pointer :: eio_prepare_test => null ()
   procedure(eio_cleanup_event), pointer :: eio_cleanup_test => null ()
 
 @ %def eio_prepare_test eio_cleanup_test
 @ Similarly, for the fallback (hadron) model that some eio tests require:
 <<EIO base: test types>>=
   abstract interface
      subroutine eio_prepare_model (model)
        import
        class(model_data_t), intent(inout), pointer :: model
      end subroutine eio_prepare_model
   end interface
 
   abstract interface
      subroutine eio_cleanup_model (model)
        import
        class(model_data_t), intent(inout), target :: model
      end subroutine eio_cleanup_model
   end interface
 
 <<EIO base: public test auxiliary>>=
   public :: eio_prepare_fallback_model, eio_cleanup_fallback_model
 <<EIO base: test variables>>=
   procedure(eio_prepare_model), pointer :: eio_prepare_fallback_model => null ()
   procedure(eio_cleanup_model), pointer :: eio_cleanup_fallback_model => null ()
 
 @ %def eio_prepare_fallback_model eio_cleanup_fallback_model
 @
 \subsubsection{Test type for event I/O}
 The contents simulate the contents of an external file.  We have the
 [[sample]] string as the file name and the array of momenta
 [[event_p]] as the list of events.  The
 second index is the event index.  The [[event_i]] component is the pointer
 to the current event, [[event_n]] is the total number of stored events.
 <<EIO base: test types>>=
   type, extends (eio_t) :: eio_test_t
      integer :: event_n = 0
      integer :: event_i = 0
      integer :: i_prc = 0
      type(vector4_t), dimension(:,:), allocatable :: event_p
    contains
    <<EIO base: eio test: TBP>>
   end type eio_test_t
 
 @ %def eio_test_t
 @ Write to screen.  Pretend that this is an actual event format.
 <<EIO base: eio test: TBP>>=
   procedure :: write => eio_test_write
 <<EIO base: test auxiliary>>=
   subroutine eio_test_write (object, unit)
     class(eio_test_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Test event stream"
     if (object%event_i /= 0) then
        write (u, "(1x,A,I0,A)")  "Event #", object%event_i, ":"
        do i = 1, size (object%event_p, 1)
           call vector4_write (object%event_p(i, object%event_i), u)
        end do
     end if
   end subroutine eio_test_write
 
 @ %def eio_test_write
 @ Finalizer.  For the test case, we just reset the event count,
 but keep the stored ``events''.  For the real implementations, the events
 would be stored on an external medium, so we would delete the object
 contents.
 <<EIO base: eio test: TBP>>=
   procedure :: final => eio_test_final
 <<EIO base: test auxiliary>>=
   subroutine eio_test_final (object)
     class(eio_test_t), intent(inout) :: object
     object%event_i = 0
   end subroutine eio_test_final
 
 @ %def eio_test_final
 @ Initialization: We store the process IDs and the energy from the beam-data
 object.  We also allocate the momenta (i.e., the simulated event record) for a
 fixed maximum size of 10 events, 2 momenta each.  There is only a single
 process.
 <<EIO base: eio test: TBP>>=
   procedure :: init_out => eio_test_init_out
 <<EIO base: test auxiliary>>=
   subroutine eio_test_init_out (eio, sample, data, success, extension)
     class(eio_test_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     type(string_t), intent(in), optional :: extension
     eio%sample = sample
     eio%event_n = 0
     eio%event_i = 0
     allocate (eio%event_p (2, 10))
     if (present (success))  success = .true.
   end subroutine eio_test_init_out
 
 @ %def eio_test_init_out
 @ Initialization for input.  Nothing to do for the test type.
 <<EIO base: eio test: TBP>>=
   procedure :: init_in => eio_test_init_in
 <<EIO base: test auxiliary>>=
   subroutine eio_test_init_in (eio, sample, data, success, extension)
     class(eio_test_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     type(string_t), intent(in), optional :: extension
     if (present (success))  success = .true.
   end subroutine eio_test_init_in
 
 @ %def eio_test_init_in
 @ Switch from output to input.  Again, nothing to do for the test type.
 <<EIO base: eio test: TBP>>=
   procedure :: switch_inout => eio_test_switch_inout
 <<EIO base: test auxiliary>>=
   subroutine eio_test_switch_inout (eio, success)
     class(eio_test_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     if (present (success))  success = .true.
   end subroutine eio_test_switch_inout
 
 @ %def eio_test_switch_inout
 @ Output.  Increment the event counter and store the momenta of the current
 event.
 <<EIO base: eio test: TBP>>=
   procedure :: output => eio_test_output
 <<EIO base: test auxiliary>>=
   subroutine eio_test_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_test_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     logical, intent(in), optional :: reading, passed, pacify
     integer, intent(in) :: i_prc
     type(particle_set_t), pointer :: pset
     type(particle_t) :: prt
     eio%event_n = eio%event_n + 1
     eio%event_i = eio%event_n
     eio%i_prc = i_prc
     pset => event%get_particle_set_ptr ()
     prt = pset%get_particle (3)
     eio%event_p(1, eio%event_i) = prt%get_momentum ()
     prt = pset%get_particle (4)
     eio%event_p(2, eio%event_i) = prt%get_momentum ()
   end subroutine eio_test_output
 
 @ %def eio_test_output
 @ Input.  Increment the event counter and retrieve the momenta of the current
 event.  For the test case, we do not actually modify the current event.
 <<EIO base: eio test: TBP>>=
   procedure :: input_i_prc => eio_test_input_i_prc
   procedure :: input_event => eio_test_input_event
 <<EIO base: test auxiliary>>=
   subroutine eio_test_input_i_prc (eio, i_prc, iostat)
     class(eio_test_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     i_prc = eio%i_prc
     iostat = 0
   end subroutine eio_test_input_i_prc
 
   subroutine eio_test_input_event (eio, event, iostat)
     class(eio_test_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     eio%event_i = eio%event_i + 1
     iostat = 0
   end subroutine eio_test_input_event
 
 @ %def eio_test_input_i_prc
 @ %def eio_test_input_event
 @
 <<EIO base: eio test: TBP>>=
   procedure :: skip => eio_test_skip
 <<EIO base: test auxiliary>>=
   subroutine eio_test_skip (eio, iostat)
     class(eio_test_t), intent(inout) :: eio
     integer, intent(out) :: iostat
     iostat = 0
   end subroutine eio_test_skip
 
 @ %def eio_test_skip
 @
 \subsubsection{Test I/O methods}
 <<EIO base: execute tests>>=
   call test (eio_base_1, "eio_base_1", &
        "read and write event contents", &
        u, results)
 <<EIO base: test declarations>>=
   public :: eio_base_1
 <<EIO base: tests>>=
   subroutine eio_base_1 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     class(eio_t), allocatable :: eio
     integer :: i_prc,  iostat
     type(string_t) :: sample
 
     write (u, "(A)")  "* Test output: eio_base_1"
     write (u, "(A)")  "*   Purpose: generate and read/write an event"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_test1"
 
     allocate (eio_test_t :: eio)
 
     call eio%init_out (sample)
     call event%generate (1, [0._default, 0._default])
     call eio%output (event, 42)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read the event"
     write (u, "(A)")
 
     call eio%init_in (sample)
     call eio%input_i_prc (i_prc, iostat)
     call eio%input_event (event, iostat)
     call eio%write (u)
     write (u, "(A)")
     write (u, "(1x,A,I0)")  "i = ", i_prc
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and append another event"
     write (u, "(A)")
 
     call eio%switch_inout ()
     call event%generate (1, [0._default, 0._default])
     call eio%output (event, 5)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read both events"
     write (u, "(A)")
 
     call eio%init_in (sample)
     call eio%input_i_prc (i_prc, iostat)
     call eio%input_event (event, iostat)
     call eio%input_i_prc (i_prc, iostat)
     call eio%input_event (event, iostat)
     call eio%write (u)
     write (u, "(A)")
     write (u, "(1x,A,I0)")  "i = ", i_prc
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
     deallocate (eio)
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_base_1"
 
   end subroutine eio_base_1
 
 @ %def eio_base_1
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Direct Event Access}
 As a convenient application of the base type, we construct an event
 handler that allows us of setting and retrieving events just in the
 same way as an file I/O format, but directly dealing with particle
 data and momenta.  This is an input and output format, but we do not
 care about counting events.
 <<[[eio_direct.f90]]>>=
 <<File header>>
 
 module eio_direct
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use diagnostics
   use cputime
   use lorentz, only: vector4_t
   use particles, only: particle_set_t
   use model_data, only: model_data_t
   use event_base
   use eio_data
   use eio_base
 
 <<Standard module head>>
 
 <<EIO direct: public>>
 
 <<EIO direct: types>>
 
 contains
 
 <<EIO direct: procedures>>
 
 end module eio_direct
 @ %def eio_direct
 @
 \subsection{Type}
 <<EIO direct: public>>=
   public :: eio_direct_t
 <<EIO direct: types>>=
   type, extends (eio_t) :: eio_direct_t
      private
      logical :: i_evt_set = .false.
      integer :: i_evt = 0
      integer :: i_prc = 0
      integer :: i_mci = 0
      integer :: i_term = 0
      integer :: channel = 0
      logical :: passed_set = .false.
      logical :: passed = .true.
      type(particle_set_t) :: pset
    contains
    <<EIO direct: eio direct: TBP>>
   end type eio_direct_t
 
 @ %def eio_direct_t
 @
 \subsection{Common Methods}
 Output.
 <<EIO direct: eio direct: TBP>>=
   procedure :: write => eio_direct_write
 <<EIO direct: procedures>>=
   subroutine eio_direct_write (object, unit)
     class(eio_direct_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event direct access:"
     if (object%i_evt_set) then
        write (u, "(3x,A,1x,I0)")  "i_evt =", object%i_evt
     else
        write (u, "(3x,A)")  "i_evt = [undefined]"
     end if
     write (u, "(3x,A,1x,I0)")  "i_prc =", object%i_prc
     write (u, "(3x,A,1x,I0)")  "i_mci =", object%i_prc
     write (u, "(3x,A,1x,I0)")  "i_term =", object%i_prc
     write (u, "(3x,A,1x,I0)")  "channel =", object%i_prc
     if (object%passed_set) then
        write (u, "(3x,A,1x,L1)")  "passed =", object%passed
     else
        write (u, "(3x,A)")  "passed = [N/A]"
     end if
     call object%pset%write (u)
   end subroutine eio_direct_write
 
 @ %def eio_direct_write
 @ Finalizer: trivial.
 <<EIO direct: eio direct: TBP>>=
   procedure :: final => eio_direct_final
 <<EIO direct: procedures>>=
   subroutine eio_direct_final (object)
     class(eio_direct_t), intent(inout) :: object
     call object%pset%final ()
   end subroutine eio_direct_final
 
 @ %def eio_direct_final
 @ Initialize for input and/or output, both are identical
 <<EIO direct: eio direct: TBP>>=
   procedure :: init_out => eio_direct_init_out
 <<EIO direct: procedures>>=
   subroutine eio_direct_init_out (eio, sample, data, success, extension)
     class(eio_direct_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     if (present (success))  success = .true.
   end subroutine eio_direct_init_out
 
 @ %def eio_direct_init_out
 @ 
 <<EIO direct: eio direct: TBP>>=
   procedure :: init_in => eio_direct_init_in
 <<EIO direct: procedures>>=
   subroutine eio_direct_init_in (eio, sample, data, success, extension)
     class(eio_direct_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     if (present (success))  success = .true.
   end subroutine eio_direct_init_in
 
 @ %def eio_direct_init_in
 @ Switch from input to output: no-op
 <<EIO direct: eio direct: TBP>>=
   procedure :: switch_inout => eio_direct_switch_inout
 <<EIO direct: procedures>>=
   subroutine eio_direct_switch_inout (eio, success)
     class(eio_direct_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     if (present (success))  success = .true.
   end subroutine eio_direct_switch_inout
 
 @ %def eio_direct_switch_inout
 @ Output: transfer event contents from the [[event]] object to the
 [[eio]] object.  Note that finalization of the particle set is not
 (yet) automatic.
 <<EIO direct: eio direct: TBP>>=
   procedure :: output => eio_direct_output
 <<EIO direct: procedures>>=
   subroutine eio_direct_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_direct_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     integer, intent(in) :: i_prc
     logical, intent(in), optional :: reading, passed, pacify
     type(particle_set_t), pointer :: pset_ptr
     call eio%pset%final ()
     if (event%has_index ()) then
        call eio%set_event_index (event%get_index ())
     else
        call eio%reset_event_index ()
     end if
     if (present (passed)) then
        eio%passed = passed
        eio%passed_set = .true.
     else
        eio%passed_set = .false.
     end if
     pset_ptr => event%get_particle_set_ptr ()
     if (associated (pset_ptr)) then
        eio%i_prc = i_prc
        eio%pset = pset_ptr
     end if
   end subroutine eio_direct_output
 
 @ %def eio_direct_output
 @ Input: transfer event contents from the [[eio]] object to the
 [[event]] object.  The [[i_prc]] parameter has been stored inside the
 [[eio]] record before.
 <<EIO direct: eio direct: TBP>>=
   procedure :: input_i_prc => eio_direct_input_i_prc
   procedure :: input_event => eio_direct_input_event
 <<EIO direct: procedures>>=
   subroutine eio_direct_input_i_prc (eio, i_prc, iostat)
     class(eio_direct_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     i_prc = eio%i_prc
     iostat = 0
   end subroutine eio_direct_input_i_prc
 
   subroutine eio_direct_input_event (eio, event, iostat)
     class(eio_direct_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     call event%select (eio%i_mci, eio%i_term, eio%channel)
     if (eio%has_event_index ()) then
        call event%set_index (eio%get_event_index ())
     else
        call event%reset_index ()
     end if
     call event%set_hard_particle_set (eio%pset)
   end subroutine eio_direct_input_event
 
 @ %def eio_direct_input_i_prc
 @ %def eio_direct_input_event
 @ No-op.
 <<EIO direct: eio direct: TBP>>=
   procedure :: skip => eio_direct_skip
 <<EIO direct: procedures>>=
   subroutine eio_direct_skip (eio, iostat)
     class(eio_direct_t), intent(inout) :: eio
     integer, intent(out) :: iostat
     iostat = 0
   end subroutine eio_direct_skip
 
 @ %def eio_direct_skip
 @
 \subsection{Retrieve individual contents}
 <<EIO direct: eio direct: TBP>>=
   procedure :: has_event_index => eio_direct_has_event_index
   procedure :: get_event_index => eio_direct_get_event_index
   procedure :: passed_known => eio_direct_passed_known
   procedure :: has_passed => eio_direct_has_passed
   procedure :: get_n_in => eio_direct_get_n_in
   procedure :: get_n_out => eio_direct_get_n_out
   procedure :: get_n_tot => eio_direct_get_n_tot
 <<EIO direct: procedures>>=
   function eio_direct_has_event_index (eio) result (flag)
     class(eio_direct_t), intent(in) :: eio
     logical :: flag
     flag = eio%i_evt_set
   end function eio_direct_has_event_index
 
   function eio_direct_get_event_index (eio) result (index)
     class(eio_direct_t), intent(in) :: eio
     integer :: index
     if (eio%has_event_index ()) then
        index = eio%i_evt
     else
        index = 0
     end if
   end function eio_direct_get_event_index
 
   function eio_direct_passed_known (eio) result (flag)
     class(eio_direct_t), intent(in) :: eio
     logical :: flag
     flag = eio%passed_set
   end function eio_direct_passed_known
 
   function eio_direct_has_passed (eio) result (flag)
     class(eio_direct_t), intent(in) :: eio
     logical :: flag
     if (eio%passed_known ()) then
        flag = eio%passed
     else
        flag = .true.
     end if
   end function eio_direct_has_passed
 
   function eio_direct_get_n_in (eio) result (n_in)
     class(eio_direct_t), intent(in) :: eio
     integer :: n_in
     n_in = eio%pset%get_n_in ()
   end function eio_direct_get_n_in
 
   function eio_direct_get_n_out (eio) result (n_out)
     class(eio_direct_t), intent(in) :: eio
     integer :: n_out
     n_out = eio%pset%get_n_out ()
   end function eio_direct_get_n_out
 
   function eio_direct_get_n_tot (eio) result (n_tot)
     class(eio_direct_t), intent(in) :: eio
     integer :: n_tot
     n_tot = eio%pset%get_n_tot ()
   end function eio_direct_get_n_tot
 
 @ %def eio_direct_has_event_index
 @ %def eio_direct_get_event_index
 @ %def eio_direct_passed_known
 @ %def eio_direct_has_passed
 @ %def eio_direct_get_n_in
 @ %def eio_direct_get_n_out
 @ %def eio_direct_get_n_tot
 @ All momenta as a single allocatable array.
 <<EIO direct: eio direct: TBP>>=
   procedure :: get_momentum_array => eio_direct_get_momentum_array
 <<EIO direct: procedures>>=
   subroutine eio_direct_get_momentum_array (eio, p)
     class(eio_direct_t), intent(in) :: eio
     type(vector4_t), dimension(:), allocatable, intent(out) :: p
     integer :: n
     n = eio%get_n_tot ()
     allocate (p (n))
     p(:) = eio%pset%get_momenta ()
   end subroutine eio_direct_get_momentum_array
 
 @ %def eio_direct_get_momentum_array
 @
 \subsection{Manual access}
 Build the contained particle set from scratch.
 <<EIO direct: eio direct: TBP>>=
   procedure :: init_direct => eio_direct_init_direct
 <<EIO direct: procedures>>=
   subroutine eio_direct_init_direct &
        (eio, n_beam, n_in, n_rem, n_vir, n_out, pdg, model)
     class(eio_direct_t), intent(out) :: eio
     integer, intent(in) :: n_beam
     integer, intent(in) :: n_in
     integer, intent(in) :: n_rem
     integer, intent(in) :: n_vir
     integer, intent(in) :: n_out
     integer, dimension(:), intent(in) :: pdg
     class(model_data_t), intent(in), target :: model
     call eio%pset%init_direct (n_beam, n_in, n_rem, n_vir, n_out, pdg, model)
   end subroutine eio_direct_init_direct
 
 @ %def eio_direct_init_direct
 @ Set/reset the event index, which is optional.
 <<EIO direct: eio direct: TBP>>=
   procedure :: set_event_index => eio_direct_set_event_index
   procedure :: reset_event_index => eio_direct_reset_event_index
 <<EIO direct: procedures>>=
   subroutine eio_direct_set_event_index (eio, index)
     class(eio_direct_t), intent(inout) :: eio
     integer, intent(in) :: index
     eio%i_evt = index
     eio%i_evt_set = .true.
   end subroutine eio_direct_set_event_index
   
   subroutine eio_direct_reset_event_index (eio)
     class(eio_direct_t), intent(inout) :: eio
     eio%i_evt_set = .false.
   end subroutine eio_direct_reset_event_index
   
 @ %def eio_direct_set_event_index
 @ %def eio_direct_reset_event_index
 @ Set the selection indices.  This is supposed to select the [[i_prc]],
 [[i_mci]], [[i_term]], and [[channel]]
 entries of the event where the momentum set has to be stored, respectively.
 The selection indices determine the process, MCI set, calculation term, and
 phase-space channel is to be used for recalculation.  The index values must
 not be zero, even if the do not apply.
 <<EIO direct: eio direct: TBP>>=
   procedure :: set_selection_indices => eio_direct_set_selection_indices
 <<EIO direct: procedures>>=
   subroutine eio_direct_set_selection_indices &
        (eio, i_prc, i_mci, i_term, channel)
     class(eio_direct_t), intent(inout) :: eio
     integer, intent(in) :: i_prc
     integer, intent(in) :: i_mci
     integer, intent(in) :: i_term
     integer, intent(in) :: channel
     eio%i_prc = i_prc
     eio%i_mci = i_mci
     eio%i_term = i_term
     eio%channel = channel
   end subroutine eio_direct_set_selection_indices
 
 @ %def eio_direct_set_i_prc
 @ Set momentum (or momenta -- elemental).
 <<EIO direct: eio direct: TBP>>=
   generic :: set_momentum => set_momentum_single
   generic :: set_momentum => set_momentum_all
   procedure :: set_momentum_single => eio_direct_set_momentum_single
   procedure :: set_momentum_all => eio_direct_set_momentum_all
 <<EIO direct: procedures>>=
   subroutine eio_direct_set_momentum_single (eio, i, p, p2, on_shell)
     class(eio_direct_t), intent(inout) :: eio
     integer, intent(in) :: i
     type(vector4_t), intent(in) :: p
     real(default), intent(in), optional :: p2
     logical, intent(in), optional :: on_shell
     call eio%pset%set_momentum (i, p, p2, on_shell)
   end subroutine eio_direct_set_momentum_single
 
   subroutine eio_direct_set_momentum_all (eio, p, p2, on_shell)
     class(eio_direct_t), intent(inout) :: eio
     type(vector4_t), dimension(:), intent(in) :: p
     real(default), dimension(:), intent(in), optional :: p2
     logical, intent(in), optional :: on_shell
     call eio%pset%set_momentum (p, p2, on_shell)
   end subroutine eio_direct_set_momentum_all
 
 @ %def eio_direct_set_momentum
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_direct_ut.f90]]>>=
 <<File header>>
 
 module eio_direct_ut
   use unit_tests
   use eio_direct_uti
 
 <<Standard module head>>
 
 <<EIO direct: public test>>
 
 contains
 
 <<EIO direct: test driver>>
 
 end module eio_direct_ut
 @ %def eio_direct_ut
 @
 <<[[eio_direct_uti.f90]]>>=
 <<File header>>
 
 module eio_direct_uti
 
 <<Use kinds>>
 <<Use strings>>
   use lorentz, only: vector4_t
   use model_data, only: model_data_t
   use event_base
   use eio_data
   use eio_base
 
   use eio_direct
 
   use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
 
 <<Standard module head>>
 
 <<EIO direct: test declarations>>
 
 contains
 
 <<EIO direct: tests>>
 
 end module eio_direct_uti
 @ %def eio_direct_ut
 @ API: driver for the unit tests below.
 <<EIO direct: public test>>=
   public :: eio_direct_test
 <<EIO direct: test driver>>=
   subroutine eio_direct_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO direct: execute tests>>
   end subroutine eio_direct_test
 
 @ %def eio_direct_test
 @
 \subsubsection{Test I/O methods}
 We test the implementation of all I/O methods.
 <<EIO direct: execute tests>>=
   call test (eio_direct_1, "eio_direct_1", &
        "read and write event contents", &
        u, results)
 <<EIO direct: test declarations>>=
   public :: eio_direct_1
 <<EIO direct: tests>>=
   subroutine eio_direct_1 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     class(eio_t), allocatable :: eio
     type(event_sample_data_t) :: data
     type(string_t) :: sample
     type(vector4_t), dimension(:), allocatable :: p
     class(model_data_t), pointer :: model
     integer :: i, n_events, iostat, i_prc
 
     write (u, "(A)")  "* Test output: eio_direct_1"
     write (u, "(A)")  "*   Purpose: generate and read/write an event"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initial state"
     write (u, "(A)")
 
     allocate (eio_direct_t :: eio)
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract an empty event"
     write (u, "(A)")
 
     call eio%output (event, 1)
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Retrieve contents"
     write (u, "(A)")
 
     select type (eio)
     class is (eio_direct_t)
        if (eio%has_event_index ())  write (u, "(A,1x,I0)")  "index =", eio%get_event_index ()
        if (eio%passed_known ())  write (u, "(A,1x,L1)")  "passed =", eio%has_passed ()
        write (u, "(A,1x,I0)")  "n_in =", eio%get_n_in ()
        write (u, "(A,1x,I0)")  "n_out =", eio%get_n_out ()
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and extract an event"
     write (u, "(A)")
 
     call event%generate (1, [0._default, 0._default])
     call event%set_index (42)
     model => event%get_model_ptr ()
 
     sample = ""
     call eio%init_out (sample)
     call eio%output (event, 1, passed = .true.)
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Retrieve contents"
     write (u, "(A)")
 
     select type (eio)
     class is (eio_direct_t)
        if (eio%has_event_index ())  write (u, "(A,1x,I0)")  "index =", eio%get_event_index ()
        if (eio%passed_known ())  write (u, "(A,1x,L1)")  "passed =", eio%has_passed ()
        write (u, "(A,1x,I0)")  "n_in =", eio%get_n_in ()
        write (u, "(A,1x,I0)")  "n_out =", eio%get_n_out ()
     end select
 
     select type (eio)
     class is (eio_direct_t)
        call eio%get_momentum_array (p)
        if (allocated (p)) then
           write (u, "(A)")  "p[3] ="
           call p(3)%write (u)
        end if
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-create an eio event record: initialization"
     write (u, "(A)")
 
     call eio%final ()
 
     select type (eio)
     class is (eio_direct_t)
        call eio%init_direct ( &
             n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 2, &
             pdg = [25, 25, 25, 25], model = model)
        call eio%set_event_index (42)
        call eio%set_selection_indices (1, 1, 1, 1)
        call eio%write (u)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-create an eio event record: &
          &set momenta, interchanged"
     write (u, "(A)")
 
     select type (eio)
     class is (eio_direct_t)
        call eio%set_momentum (p([1,2,4,3]), on_shell=.true.)
        call eio%write (u)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* 'read' i_prc"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
     write (u, "(1x,A,1x,I0)")  "i_prc =", i_prc
     write (u, "(1x,A,1x,I0)")  "iostat =", iostat
 
     write (u, "(A)")
     write (u, "(A)")  "* 'read' (fill) event"
     write (u, "(A)")
 
     call eio%input_event (event, iostat)
     write (u, "(1x,A,1x,I0)")  "iostat =", iostat
     write (u, "(A)")
 
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
     deallocate (eio)
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_direct_1"
 
   end subroutine eio_direct_1
 
 @ %def eio_direct_1
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Event Generation Checkpoints}
 This is an output-only format.  Its only use is to write screen
 messages every $n$ events, to inform the user about progress.
 <<[[eio_checkpoints.f90]]>>=
 <<File header>>
 
 module eio_checkpoints
 
 <<Use strings>>
   use io_units
   use diagnostics
   use cputime
   use event_base
   use eio_data
   use eio_base
 
 <<Standard module head>>
 
 <<EIO checkpoints: public>>
 
 <<EIO checkpoints: parameters>>
 
 <<EIO checkpoints: types>>
 
 contains
 
 <<EIO checkpoints: procedures>>
 
 end module eio_checkpoints
 @ %def eio_checkpoints
 @
 \subsection{Type}
 <<EIO checkpoints: public>>=
   public :: eio_checkpoints_t
 <<EIO checkpoints: types>>=
   type, extends (eio_t) :: eio_checkpoints_t
      logical :: active = .false.
      logical :: running = .false.
      integer :: val = 0
      integer :: n_events = 0
      integer :: n_read = 0
      integer :: i_evt = 0
      logical :: blank = .false.
      type(timer_t) :: timer
    contains
    <<EIO checkpoints: eio checkpoints: TBP>>
   end type eio_checkpoints_t
 
 @ %def eio_checkpoints_t
 @
 \subsection{Specific Methods}
 Set parameters that are specifically used for checkpointing.
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: set_parameters => eio_checkpoints_set_parameters
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_set_parameters (eio, checkpoint, blank)
     class(eio_checkpoints_t), intent(inout) :: eio
     integer, intent(in) :: checkpoint
     logical, intent(in), optional :: blank
     eio%val = checkpoint
     if (present (blank))  eio%blank = blank
   end subroutine eio_checkpoints_set_parameters
 
 @ %def eio_checkpoints_set_parameters
 @
 \subsection{Common Methods}
 Output.  This is not the actual event format, but a readable account
 of the current status.
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: write => eio_checkpoints_write
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_write (object, unit)
     class(eio_checkpoints_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     if (object%active) then
        write (u, "(1x,A)")  "Event-sample checkpoints:  active"
        write (u, "(3x,A,I0)")  "interval  = ", object%val
        write (u, "(3x,A,I0)")  "n_events  = ", object%n_events
        write (u, "(3x,A,I0)")  "n_read    = ", object%n_read
        write (u, "(3x,A,I0)")  "n_current = ", object%i_evt
        write (u, "(3x,A,L1)")  "blanking  = ", object%blank
        call object%timer%write (u)
     else
        write (u, "(1x,A)")  "Event-sample checkpoints:  off"
     end if
   end subroutine eio_checkpoints_write
 
 @ %def eio_checkpoints_write
 @ Finalizer: trivial.
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: final => eio_checkpoints_final
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_final (object)
     class(eio_checkpoints_t), intent(inout) :: object
     object%active = .false.
   end subroutine eio_checkpoints_final
 
 @ %def eio_checkpoints_final
 @ Activate checkpointing for event generation or writing.
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: init_out => eio_checkpoints_init_out
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_init_out (eio, sample, data, success, extension)
     class(eio_checkpoints_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     if (present (data)) then
        if (eio%val > 0) then
           eio%active = .true.
           eio%i_evt = 0
           eio%n_read = 0
           eio%n_events = data%n_evt * data%nlo_multiplier
        end if
     end if
     if (present (success))  success = .true.
   end subroutine eio_checkpoints_init_out
 
 @ %def eio_checkpoints_init_out
 @ No checkpointing for event reading.
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: init_in => eio_checkpoints_init_in
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_init_in (eio, sample, data, success, extension)
     class(eio_checkpoints_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     call msg_bug ("Event checkpoints: event input not supported")
     if (present (success))  success = .false.
   end subroutine eio_checkpoints_init_in
 
 @ %def eio_checkpoints_init_in
 @ Switch from input to output: also not supported.
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: switch_inout => eio_checkpoints_switch_inout
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_switch_inout (eio, success)
     class(eio_checkpoints_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     call msg_bug ("Event checkpoints: in-out switch not supported")
     if (present (success))  success = .false.
   end subroutine eio_checkpoints_switch_inout
 
 @ %def eio_checkpoints_switch_inout
 @ Checkpoints: display progress for the current event, if applicable.
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: output => eio_checkpoints_output
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_checkpoints_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     integer, intent(in) :: i_prc
     logical, intent(in), optional :: reading, passed, pacify
     logical :: rd
     rd = .false.;  if (present (reading))  rd = reading
     if (eio%active) then
        if (.not. eio%running)  call eio%startup ()
        if (eio%running) then
           eio%i_evt = eio%i_evt + 1
           if (rd) then
              eio%n_read = eio%n_read + 1
           else if (mod (eio%i_evt, eio%val) == 0) then
              call eio%message (eio%blank)
           end if
           if (eio%i_evt == eio%n_events)  call eio%shutdown ()
        end if
     end if
   end subroutine eio_checkpoints_output
 
 @ %def eio_checkpoints_output
 @ When the first event is called, we have to initialize the screen output.
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: startup => eio_checkpoints_startup
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_startup (eio)
     class(eio_checkpoints_t), intent(inout) :: eio
     if (eio%active .and. eio%i_evt < eio%n_events) then
        call msg_message ("")
        call msg_message (checkpoint_bar)
        call msg_message (checkpoint_head)
        call msg_message (checkpoint_bar)
        write (msg_buffer, checkpoint_fmt) 0., 0, eio%n_events - eio%i_evt, "???"
        call msg_message ()
        eio%running = .true.
        call eio%timer%start ()
     end if
   end subroutine eio_checkpoints_startup
 
 @ %def eio_checkpoints_startup
 @ This message is printed at every checkpoint.
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: message => eio_checkpoints_message
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_message (eio, testflag)
     class(eio_checkpoints_t), intent(inout) :: eio
     logical, intent(in), optional :: testflag
     real :: t
     type(time_t) :: time_remaining
     type(string_t) :: time_string
     call eio%timer%stop ()
     t = eio%timer
     call eio%timer%restart ()
     time_remaining = &
          nint (t / (eio%i_evt - eio%n_read) * (eio%n_events - eio%i_evt))
     time_string = time_remaining%to_string_ms (blank = testflag)
     write (msg_buffer, checkpoint_fmt) &
          100 * (eio%i_evt - eio%n_read) / real (eio%n_events - eio%n_read), &
          eio%i_evt - eio%n_read, &
          eio%n_events - eio%i_evt, &
          char (time_string)
     call msg_message ()
   end subroutine eio_checkpoints_message
 
 @ %def eio_checkpoints_message
 @ When the last event is called, wrap up.
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: shutdown => eio_checkpoints_shutdown
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_shutdown (eio)
     class(eio_checkpoints_t), intent(inout) :: eio
     if (mod (eio%i_evt, eio%val) /= 0) then
        write (msg_buffer, checkpoint_fmt) &
             100., eio%i_evt - eio%n_read, 0, "0m:00s"
        call msg_message ()
     end if
     call msg_message (checkpoint_bar)
     call msg_message ("")
     eio%running = .false.
   end subroutine eio_checkpoints_shutdown
 
 @ %def eio_checkpoints_shutdown
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: input_i_prc => eio_checkpoints_input_i_prc
   procedure :: input_event => eio_checkpoints_input_event
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_input_i_prc (eio, i_prc, iostat)
     class(eio_checkpoints_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     call msg_bug ("Event checkpoints: event input not supported")
     i_prc = 0
     iostat = 1
   end subroutine eio_checkpoints_input_i_prc
 
   subroutine eio_checkpoints_input_event (eio, event, iostat)
     class(eio_checkpoints_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     call msg_bug ("Event checkpoints: event input not supported")
     iostat = 1
   end subroutine eio_checkpoints_input_event
 
 @ %def eio_checkpoints_input_i_prc
 @ %def eio_checkpoints_input_event
 @
 <<EIO checkpoints: eio checkpoints: TBP>>=
   procedure :: skip => eio_checkpoints_skip
 <<EIO checkpoints: procedures>>=
   subroutine eio_checkpoints_skip (eio, iostat)
     class(eio_checkpoints_t), intent(inout) :: eio
     integer, intent(out) :: iostat
     iostat = 0
   end subroutine eio_checkpoints_skip
 
 @ %def eio_checkpoints_skip
 @
 \subsection{Message header}
 <<EIO checkpoints: parameters>>=
   character(*), parameter :: &
      checkpoint_head = "| % complete | events generated | events remaining &
      &| time remaining"
   character(*), parameter :: &
      checkpoint_bar  = "|==================================================&
      &=================|"
   character(*), parameter :: &
      checkpoint_fmt  = "('   ',F5.1,T16,I9,T35,I9,T58,A)"
 @ %def checkpoint_head
 @ %def checkpoint_bar
 @ %def checkpoint_fmt
 @ %def checkpointing_t
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_checkpoints_ut.f90]]>>=
 <<File header>>
 
 module eio_checkpoints_ut
   use unit_tests
   use eio_checkpoints_uti
 
 <<Standard module head>>
 
 <<EIO checkpoints: public test>>
 
 contains
 
 <<EIO checkpoints: test driver>>
 
 end module eio_checkpoints_ut
 @ %def eio_checkpoints_ut
 @
 <<[[eio_checkpoints_uti.f90]]>>=
 <<File header>>
 
 module eio_checkpoints_uti
 
 <<Use kinds>>
 <<Use strings>>
   use event_base
   use eio_data
   use eio_base
 
   use eio_checkpoints
 
   use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
 
 <<Standard module head>>
 
 <<EIO checkpoints: test declarations>>
 
 contains
 
 <<EIO checkpoints: tests>>
 
 end module eio_checkpoints_uti
 @ %def eio_checkpoints_ut
 @ API: driver for the unit tests below.
 <<EIO checkpoints: public test>>=
   public :: eio_checkpoints_test
 <<EIO checkpoints: test driver>>=
   subroutine eio_checkpoints_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO checkpoints: execute tests>>
   end subroutine eio_checkpoints_test
 
 @ %def eio_checkpoints_test
 @
 \subsubsection{Test I/O methods}
 We test the implementation of all I/O methods.
 <<EIO checkpoints: execute tests>>=
   call test (eio_checkpoints_1, "eio_checkpoints_1", &
        "read and write event contents", &
        u, results)
 <<EIO checkpoints: test declarations>>=
   public :: eio_checkpoints_1
 <<EIO checkpoints: tests>>=
   subroutine eio_checkpoints_1 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     class(eio_t), allocatable :: eio
     type(event_sample_data_t) :: data
     type(string_t) :: sample
     integer :: i, n_events
 
     write (u, "(A)")  "* Test output: eio_checkpoints_1"
     write (u, "(A)")  "*   Purpose: generate a number of events &
          &with screen output"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate events"
     write (u, "(A)")
 
     sample = "eio_checkpoints_1"
 
     allocate (eio_checkpoints_t :: eio)
 
     n_events = 10
     call data%init (1, 0)
     data%n_evt = n_events
 
     select type (eio)
     type is (eio_checkpoints_t)
        call eio%set_parameters (checkpoint = 4)
     end select
 
     call eio%init_out (sample, data)
 
     do i = 1, n_events
        call event%generate (1, [0._default, 0._default])
        call eio%output (event, i_prc = 0)
     end do
 
     write (u, "(A)")  "* Checkpointing status"
     write (u, "(A)")
 
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_checkpoints_1"
 
   end subroutine eio_checkpoints_1
 
 @ %def eio_checkpoints_1
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Event Generation Callback}
 This is an output-only format.  Its only use is to write screen
 messages every $n$ events, to inform the user about progress.
 <<[[eio_callback.f90]]>>=
 <<File header>>
 
 module eio_callback
 
   use kinds, only: i64
 <<Use strings>>
   use io_units
   use diagnostics
   use cputime
   use event_base
   use eio_data
   use eio_base
 
 <<Standard module head>>
 
 <<EIO callback: public>>
 
 <<EIO callback: types>>
 
 contains
 
 <<EIO callback: procedures>>
 
 end module eio_callback
 @ %def eio_callback
 @
 \subsection{Type}
 <<EIO callback: public>>=
   public :: eio_callback_t
 <<EIO callback: types>>=
   type, extends (eio_t) :: eio_callback_t
      class(event_callback_t), allocatable :: callback
      integer(i64) :: i_evt = 0
      integer :: i_interval = 0
      integer :: n_interval = 0
 !      type(timer_t) :: timer
    contains
    <<EIO callback: eio callback: TBP>>
   end type eio_callback_t
 
 @ %def eio_callback_t
 @
 \subsection{Specific Methods}
 Set parameters that are specifically used for callback: the procedure
 and the number of events to wait until the procedure is called (again).
 <<EIO callback: eio callback: TBP>>=
   procedure :: set_parameters => eio_callback_set_parameters
 <<EIO callback: procedures>>=
   subroutine eio_callback_set_parameters (eio, callback, count_interval)
     class(eio_callback_t), intent(inout) :: eio
     class(event_callback_t), intent(in) :: callback
     integer, intent(in) :: count_interval
     allocate (eio%callback, source = callback)
     eio%n_interval = count_interval
   end subroutine eio_callback_set_parameters
 
 @ %def eio_callback_set_parameters
 @
 \subsection{Common Methods}
 Output.  This is not the actual event format, but a readable account
 of the current status.
 <<EIO callback: eio callback: TBP>>=
   procedure :: write => eio_callback_write
 <<EIO callback: procedures>>=
   subroutine eio_callback_write (object, unit)
     class(eio_callback_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event-sample callback:"
     write (u, "(3x,A,I0)")  "interval  = ", object%n_interval
     write (u, "(3x,A,I0)")  "evt count = ", object%i_evt
 !        call object%timer%write (u)
   end subroutine eio_callback_write
 
 @ %def eio_callback_write
 @ Finalizer: trivial.
 <<EIO callback: eio callback: TBP>>=
   procedure :: final => eio_callback_final
 <<EIO callback: procedures>>=
   subroutine eio_callback_final (object)
     class(eio_callback_t), intent(inout) :: object
   end subroutine eio_callback_final
 
 @ %def eio_callback_final
 @ Activate checkpointing for event generation or writing.
 <<EIO callback: eio callback: TBP>>=
   procedure :: init_out => eio_callback_init_out
 <<EIO callback: procedures>>=
   subroutine eio_callback_init_out (eio, sample, data, success, extension)
     class(eio_callback_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     eio%i_evt = 0
     eiO%i_interval = 0
     if (present (success))  success = .true.
   end subroutine eio_callback_init_out
 
 @ %def eio_callback_init_out
 @ No callback for event reading.
 <<EIO callback: eio callback: TBP>>=
   procedure :: init_in => eio_callback_init_in
 <<EIO callback: procedures>>=
   subroutine eio_callback_init_in (eio, sample, data, success, extension)
     class(eio_callback_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     call msg_bug ("Event callback: event input not supported")
     if (present (success))  success = .false.
   end subroutine eio_callback_init_in
 
 @ %def eio_callback_init_in
 @ Switch from input to output: also not supported.
 <<EIO callback: eio callback: TBP>>=
   procedure :: switch_inout => eio_callback_switch_inout
 <<EIO callback: procedures>>=
   subroutine eio_callback_switch_inout (eio, success)
     class(eio_callback_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     call msg_bug ("Event callback: in-out switch not supported")
     if (present (success))  success = .false.
   end subroutine eio_callback_switch_inout
 
 @ %def eio_callback_switch_inout
 @ The actual callback.  First increment counters, then call the
 procedure if the counter hits the interval.
 <<EIO callback: eio callback: TBP>>=
   procedure :: output => eio_callback_output
 <<EIO callback: procedures>>=
   subroutine eio_callback_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_callback_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     integer, intent(in) :: i_prc
     logical, intent(in), optional :: reading, passed, pacify
     eio%i_evt = eio%i_evt + 1
     if (eio%n_interval > 0) then
        eio%i_interval = eio%i_interval + 1
        if (eio%i_interval >= eio%n_interval) then
           call eio%callback%proc (eio%i_evt, event)
           eio%i_interval = 0
        end if
     end if
   end subroutine eio_callback_output
 
 @ %def eio_callback_output
 @ No input.
 <<EIO callback: eio callback: TBP>>=
   procedure :: input_i_prc => eio_callback_input_i_prc
   procedure :: input_event => eio_callback_input_event
 <<EIO callback: procedures>>=
   subroutine eio_callback_input_i_prc (eio, i_prc, iostat)
     class(eio_callback_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     call msg_bug ("Event callback: event input not supported")
     i_prc = 0
     iostat = 1
   end subroutine eio_callback_input_i_prc
 
   subroutine eio_callback_input_event (eio, event, iostat)
     class(eio_callback_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     call msg_bug ("Event callback: event input not supported")
     iostat = 1
   end subroutine eio_callback_input_event
 
 @ %def eio_callback_input_i_prc
 @ %def eio_callback_input_event
 @
 <<EIO callback: eio callback: TBP>>=
   procedure :: skip => eio_callback_skip
 <<EIO callback: procedures>>=
   subroutine eio_callback_skip (eio, iostat)
     class(eio_callback_t), intent(inout) :: eio
     integer, intent(out) :: iostat
     iostat = 0
   end subroutine eio_callback_skip
 
 @ %def eio_callback_skip
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Event Weight Output}
 This is an output-only format.  For each event, we print the indices
 that identify process, process part (MCI group), and term.  As
 numerical information we print the squared matrix element (trace) and
 the event weight.
 <<[[eio_weights.f90]]>>=
 <<File header>>
 
 module eio_weights
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use diagnostics
   use event_base
   use eio_data
   use eio_base
 
 <<Standard module head>>
 
 <<EIO weights: public>>
 
 <<EIO weights: types>>
 
 contains
 
 <<EIO weights: procedures>>
 
 end module eio_weights
 @ %def eio_weights
 @
 \subsection{Type}
 <<EIO weights: public>>=
   public :: eio_weights_t
 <<EIO weights: types>>=
   type, extends (eio_t) :: eio_weights_t
      logical :: writing = .false.
      integer :: unit = 0
      logical :: pacify = .false.
    contains
    <<EIO weights: eio weights: TBP>>
   end type eio_weights_t
 
 @ %def eio_weights_t
 @
 \subsection{Specific Methods}
 Set pacify flags.
 <<EIO weights: eio weights: TBP>>=
   procedure :: set_parameters => eio_weights_set_parameters
 <<EIO weights: procedures>>=
   subroutine eio_weights_set_parameters (eio, pacify)
     class(eio_weights_t), intent(inout) :: eio
     logical, intent(in), optional :: pacify
     if (present (pacify))  eio%pacify = pacify
     eio%extension = "weights.dat"
   end subroutine eio_weights_set_parameters
 
 @ %def eio_weights_set_parameters
 @
 \subsection{Common Methods}
 @ Output.  This is not the actual event format, but a readable account
 of the current object status.
 <<EIO weights: eio weights: TBP>>=
   procedure :: write => eio_weights_write
 <<EIO weights: procedures>>=
   subroutine eio_weights_write (object, unit)
     class(eio_weights_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Weight stream:"
     if (object%writing) then
        write (u, "(3x,A,A)")  "Writing to file   = ", char (object%filename)
        write (u, "(3x,A,L1)") "Reduced I/O prec. = ", object%pacify
     else
        write (u, "(3x,A)")  "[closed]"
     end if
   end subroutine eio_weights_write
 
 @ %def eio_weights_write
 @ Finalizer: close any open file.
 <<EIO weights: eio weights: TBP>>=
   procedure :: final => eio_weights_final
 <<EIO weights: procedures>>=
   subroutine eio_weights_final (object)
     class(eio_weights_t), intent(inout) :: object
     if (object%writing) then
        write (msg_buffer, "(A,A,A)")  "Events: closing weight stream file '", &
             char (object%filename), "'"
        call msg_message ()
        close (object%unit)
        object%writing = .false.
     end if
   end subroutine eio_weights_final
 
 @ %def eio_weights_final
 @ Initialize event writing.
 <<EIO weights: eio weights: TBP>>=
   procedure :: init_out => eio_weights_init_out
 <<EIO weights: procedures>>=
   subroutine eio_weights_init_out (eio, sample, data, success, extension)
     class(eio_weights_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     if (present(extension)) then
        eio%extension = extension
     else
        eio%extension = "weights.dat"
     end if
     eio%filename = sample // "." // eio%extension
     eio%unit = free_unit ()
     write (msg_buffer, "(A,A,A)")  "Events: writing to weight stream file '", &
          char (eio%filename), "'"
     call msg_message ()
     eio%writing = .true.
     open (eio%unit, file = char (eio%filename), &
          action = "write", status = "replace")
     if (present (success))  success = .true.
   end subroutine eio_weights_init_out
 
 @ %def eio_weights_init_out
 @ Initialize event reading.
 <<EIO weights: eio weights: TBP>>=
   procedure :: init_in => eio_weights_init_in
 <<EIO weights: procedures>>=
   subroutine eio_weights_init_in (eio, sample, data, success, extension)
     class(eio_weights_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     call msg_bug ("Weight stream: event input not supported")
     if (present (success))  success = .false.
   end subroutine eio_weights_init_in
 
 @ %def eio_weights_init_in
 @ Switch from input to output: reopen the file for reading.
 <<EIO weights: eio weights: TBP>>=
   procedure :: switch_inout => eio_weights_switch_inout
 <<EIO weights: procedures>>=
   subroutine eio_weights_switch_inout (eio, success)
     class(eio_weights_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     call msg_bug ("Weight stream: in-out switch not supported")
     if (present (success))  success = .false.
   end subroutine eio_weights_switch_inout
 
 @ %def eio_weights_switch_inout
 @ Output an event.  Write first the event indices, then weight and two
 values of the squared matrix element: [[sqme_ref]] is the value stored
 in the event record, and [[sqme_prc]] is the one stored in the process
 instance.  (They can differ: when recalculating, the former is read
 from file and the latter is the result of the new calculation.)
 
 For the alternative entries, the [[sqme]] value is always obtained by
 a new calculation, and thus qualifies as [[sqme_prc]].
 
 Don't write the file if the [[passed]] flag is set and false.
 <<EIO weights: eio weights: TBP>>=
   procedure :: output => eio_weights_output
 <<EIO weights: procedures>>=
   subroutine eio_weights_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_weights_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     integer, intent(in) :: i_prc
     logical, intent(in), optional :: reading, passed, pacify
     integer :: n_alt, i
     real(default) :: weight, sqme_ref, sqme_prc
     logical :: evt_pacify, evt_passed
     evt_pacify = eio%pacify;  if (present (pacify))  evt_pacify = pacify
     evt_passed = .true.;  if (present (passed))  evt_passed = passed
     if (eio%writing) then
        if (evt_passed) then
           weight = event%get_weight_prc ()
           sqme_ref = event%get_sqme_ref ()
           sqme_prc = event%get_sqme_prc ()
           n_alt = event%get_n_alt ()
 1         format (I0,3(1x,ES17.10),3(1x,I0))
 2         format (I0,3(1x,ES15.8),3(1x,I0))
           if (evt_pacify) then
              write (eio%unit, 2)  0, weight, sqme_prc, sqme_ref, &
                   i_prc
           else
              write (eio%unit, 1)  0, weight, sqme_prc, sqme_ref, &
                   i_prc
           end if
           do i = 1, n_alt
              weight = event%get_weight_alt(i)
              sqme_prc = event%get_sqme_alt(i)
              if (evt_pacify) then
                 write (eio%unit, 2)  i, weight, sqme_prc
              else
                 write (eio%unit, 1)  i, weight, sqme_prc
              end if
           end do
        end if
     else
        call eio%write ()
        call msg_fatal ("Weight stream file is not open for writing")
     end if
   end subroutine eio_weights_output
 
 @ %def eio_weights_output
 @ Input an event.
 <<EIO weights: eio weights: TBP>>=
   procedure :: input_i_prc => eio_weights_input_i_prc
   procedure :: input_event => eio_weights_input_event
 <<EIO weights: procedures>>=
   subroutine eio_weights_input_i_prc (eio, i_prc, iostat)
     class(eio_weights_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     call msg_bug ("Weight stream: event input not supported")
     i_prc = 0
     iostat = 1
   end subroutine eio_weights_input_i_prc
 
   subroutine eio_weights_input_event (eio, event, iostat)
     class(eio_weights_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     call msg_bug ("Weight stream: event input not supported")
     iostat = 1
   end subroutine eio_weights_input_event
 
 @ %def eio_weights_input_i_prc
 @ %def eio_weights_input_event
 @
 <<EIO weights: eio weights: TBP>>=
   procedure :: skip => eio_weights_skip
 <<EIO weights: procedures>>=
   subroutine eio_weights_skip (eio, iostat)
     class(eio_weights_t), intent(inout) :: eio
     integer, intent(out) :: iostat
     iostat = 0
   end subroutine eio_weights_skip
 
 @ %def eio_weights_skip
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_weights_ut.f90]]>>=
 <<File header>>
 
 module eio_weights_ut
   use unit_tests
   use eio_weights_uti
 
 <<Standard module head>>
 
 <<EIO weights: public test>>
 
 contains
 
 <<EIO weights: test driver>>
 
 end module eio_weights_ut
 @ %def eio_weights_ut
 @
 <<[[eio_weights_uti.f90]]>>=
 <<File header>>
 
 module eio_weights_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use event_base
   use eio_data
   use eio_base
 
   use eio_weights
 
   use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
 
 <<Standard module head>>
 
 <<EIO weights: test declarations>>
 
 contains
 
 <<EIO weights: tests>>
 
 end module eio_weights_uti
 @ %def eio_weights_ut
 @ API: driver for the unit tests below.
 <<EIO weights: public test>>=
   public :: eio_weights_test
 <<EIO weights: test driver>>=
   subroutine eio_weights_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO weights: execute tests>>
   end subroutine eio_weights_test
 
 @ %def eio_weights_test
 @
 \subsubsection{Simple event}
 We test the implementation of all I/O methods.
 <<EIO weights: execute tests>>=
   call test (eio_weights_1, "eio_weights_1", &
        "read and write event contents", &
        u, results)
 <<EIO weights: test declarations>>=
   public :: eio_weights_1
 <<EIO weights: tests>>=
   subroutine eio_weights_1 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_weights_1"
     write (u, "(A)")  "*   Purpose: generate an event and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_weights_1"
 
     allocate (eio_weights_t :: eio)
 
     call eio%init_out (sample)
     call event%generate (1, [0._default, 0._default])
 
     call eio%output (event, i_prc = 42)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents: &
          &(weight, sqme(evt), sqme(prc), i_prc)"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = "eio_weights_1.weights.dat", &
          action = "read", status = "old")
     read (u_file, "(A)")  buffer
     write (u, "(A)") trim (buffer)
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_weights_1"
   end subroutine eio_weights_1
 
 @ %def eio_weights_1
 @
 \subsubsection{Multiple weights}
 Event with several weight entries set.
 <<EIO weights: execute tests>>=
   call test (eio_weights_2, "eio_weights_2", &
        "multiple weights", &
        u, results)
 <<EIO weights: test declarations>>=
   public :: eio_weights_2
 <<EIO weights: tests>>=
   subroutine eio_weights_2 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, i
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_weights_2"
     write (u, "(A)")  "*   Purpose: generate an event and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false., n_alt = 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_weights_2"
 
     allocate (eio_weights_t :: eio)
 
     call eio%init_out (sample)
     select type (eio)
     type is (eio_weights_t)
        call eio%set_parameters (pacify = .true.)
     end select
     call event%generate (1, [0._default, 0._default])
     call event%set (sqme_alt = [2._default, 3._default])
     call event%set (weight_alt = &
          [2 * event%get_weight_prc (), 3 * event%get_weight_prc ()])
 
     call eio%output (event, i_prc = 42)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents: &
          &(weight, sqme(evt), sqme(prc), i_prc)"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = "eio_weights_2.weights.dat", &
          action = "read", status = "old")
     do i = 1, 3
        read (u_file, "(A)")  buffer
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_weights_2"
 
   end subroutine eio_weights_2
 
 @ %def eio_weights_2
 @
 \subsubsection{Multiple events}
 Events with [[passed]] flag switched on/off.
 <<EIO weights: execute tests>>=
   call test (eio_weights_3, "eio_weights_3", &
        "check passed-flag", &
        u, results)
 <<EIO weights: test declarations>>=
   public :: eio_weights_3
 <<EIO weights: tests>>=
   subroutine eio_weights_3 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_weights_3"
     write (u, "(A)")  "*   Purpose: generate three events and write to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write events"
     write (u, "(A)")
 
     sample = "eio_weights_3"
 
     allocate (eio_weights_t :: eio)
     select type (eio)
     type is (eio_weights_t)
        call eio%set_parameters (pacify = .true.)
     end select
 
     call eio%init_out (sample)
 
     call event%generate (1, [0._default, 0._default])
     call eio%output (event, i_prc = 1)
 
     call event%generate (1, [0.1_default, 0._default])
     call eio%output (event, i_prc = 1, passed = .false.)
 
     call event%generate (1, [0.2_default, 0._default])
     call eio%output (event, i_prc = 1, passed = .true.)
 
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents: &
          &(weight, sqme(evt), sqme(prc), i_prc), should be just two entries"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = "eio_weights_3.weights.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 eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_weights_3"
   end subroutine eio_weights_3
 
 @ %def eio_weights_3
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Event Dump Output}
 This is an output-only format.  We simply dump the contents of the
 [[particle_set]], using the [[write]] method of that type.  The
 event-format options are the options of that procedure.
 <<[[eio_dump.f90]]>>=
 <<File header>>
 
 module eio_dump
 
   use, intrinsic :: iso_fortran_env, only: output_unit
 
   use kinds, only: i64
 <<Use strings>>
   use format_utils, only: write_separator
   use format_utils, only: pac_fmt
   use format_defs, only: FMT_16, FMT_19
   use io_units
   use diagnostics
   use event_base
   use eio_data
   use eio_base
 
 <<Standard module head>>
 
 <<EIO dump: public>>
 
 <<EIO dump: types>>
 
 contains
 
 <<EIO dump: procedures>>
 
 end module eio_dump
 @ %def eio_dump
 @
 \subsection{Type}
 <<EIO dump: public>>=
   public :: eio_dump_t
 <<EIO dump: types>>=
   type, extends (eio_t) :: eio_dump_t
      integer(i64) :: count = 0
      integer :: unit = 0
      logical :: writing = .false.
      logical :: screen = .false.
      logical :: pacify = .false.
      logical :: weights = .false.
      logical :: compressed = .false.
      logical :: summary = .false.
    contains
    <<EIO dump: eio dump: TBP>>
   end type eio_dump_t
 
 @ %def eio_dump_t
 @
 \subsection{Specific Methods}
 Set control parameters.  We may provide a [[unit]] for input or output; this
 will be taken if the sample file name is empty.  In that case, the unit is
 assumed to be open and will be kept open; no messages will be issued.
 <<EIO dump: eio dump: TBP>>=
   procedure :: set_parameters => eio_dump_set_parameters
 <<EIO dump: procedures>>=
   subroutine eio_dump_set_parameters (eio, extension, &
        pacify, weights, compressed, summary, screen, unit)
     class(eio_dump_t), intent(inout) :: eio
     type(string_t), intent(in), optional :: extension
     logical, intent(in), optional :: pacify
     logical, intent(in), optional :: weights
     logical, intent(in), optional :: compressed
     logical, intent(in), optional :: summary
     logical, intent(in), optional :: screen
     integer, intent(in), optional :: unit
     if (present (pacify))  eio%pacify = pacify
     if (present (weights))  eio%weights = weights
     if (present (compressed))  eio%compressed = compressed
     if (present (summary))  eio%summary = summary
     if (present (screen))  eio%screen = screen
     if (present (unit))  eio%unit = unit
     eio%extension = "pset.dat"
     if (present (extension))  eio%extension = extension
   end subroutine eio_dump_set_parameters
 
 @ %def eio_dump_set_parameters
 @
 \subsection{Common Methods}
 @ Output.  This is not the actual event format, but a readable account
 of the current object status.
 <<EIO dump: eio dump: TBP>>=
   procedure :: write => eio_dump_write
 <<EIO dump: procedures>>=
   subroutine eio_dump_write (object, unit)
     class(eio_dump_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Dump event stream:"
     if (object%writing) then
        write (u, "(3x,A,L1)") "Screen output     = ", object%screen
        write (u, "(3x,A,A,A)")  "Writing to file   = '", char (object%filename), "'"
        write (u, "(3x,A,L1)") "Reduced I/O prec. = ", object%pacify
        write (u, "(3x,A,L1)") "Show weights/sqme = ", object%weights
        write (u, "(3x,A,L1)") "Compressed        = ", object%compressed
        write (u, "(3x,A,L1)") "Summary           = ", object%summary
     else
        write (u, "(3x,A)")  "[closed]"
     end if
   end subroutine eio_dump_write
 
 @ %def eio_dump_write
 @ Finalizer: close any open file.
 <<EIO dump: eio dump: TBP>>=
   procedure :: final => eio_dump_final
 <<EIO dump: procedures>>=
   subroutine eio_dump_final (object)
     class(eio_dump_t), intent(inout) :: object
     if (object%screen) then
        write (msg_buffer, "(A,A,A)")  "Events: display complete"
        call msg_message ()
        object%screen = .false.
     end if
     if (object%writing) then
        if (object%filename /= "") then
           write (msg_buffer, "(A,A,A)")  "Events: closing event dump file '", &
                char (object%filename), "'"
           call msg_message ()
           close (object%unit)
        end if
        object%writing = .false.
     end if
   end subroutine eio_dump_final
 
 @ %def eio_dump_final
 @ Initialize event writing.
 <<EIO dump: eio dump: TBP>>=
   procedure :: init_out => eio_dump_init_out
 <<EIO dump: procedures>>=
   subroutine eio_dump_init_out (eio, sample, data, success, extension)
     class(eio_dump_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     if (present(extension)) then
        eio%extension = extension
     else
        eio%extension = "pset.dat"
     end if
     if (sample == "" .and. eio%unit /= 0) then
        eio%filename = ""
        eio%writing = .true.
     else if (sample /= "") then
        eio%filename = sample // "." // eio%extension
        eio%unit = free_unit ()
        write (msg_buffer, "(A,A,A)")  "Events: writing to event dump file '", &
             char (eio%filename), "'"
        call msg_message ()
        eio%writing = .true.
        open (eio%unit, file = char (eio%filename), &
             action = "write", status = "replace")
     end if
     if (eio%screen) then
        write (msg_buffer, "(A,A,A)")  "Events: display on standard output"
        call msg_message ()
     end if
     eio%count = 0
     if (present (success))  success = .true.
   end subroutine eio_dump_init_out
 
 @ %def eio_dump_init_out
 @ Initialize event reading.
 <<EIO dump: eio dump: TBP>>=
   procedure :: init_in => eio_dump_init_in
 <<EIO dump: procedures>>=
   subroutine eio_dump_init_in (eio, sample, data, success, extension)
     class(eio_dump_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     call msg_bug ("Event dump: event input not supported")
     if (present (success))  success = .false.
   end subroutine eio_dump_init_in
 
 @ %def eio_dump_init_in
 @ Switch from input to output: reopen the file for reading.
 <<EIO dump: eio dump: TBP>>=
   procedure :: switch_inout => eio_dump_switch_inout
 <<EIO dump: procedures>>=
   subroutine eio_dump_switch_inout (eio, success)
     class(eio_dump_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     call msg_bug ("Event dump: in-out switch not supported")
     if (present (success))  success = .false.
   end subroutine eio_dump_switch_inout
 
 @ %def eio_dump_switch_inout
 @ Output an event.  Delegate the output call to the [[write]] method
 of the current particle set, if valid.  Output both to file (if defined)
 and to screen (if requested).
 <<EIO dump: eio dump: TBP>>=
   procedure :: output => eio_dump_output
 <<EIO dump: procedures>>=
   subroutine eio_dump_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_dump_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     integer, intent(in) :: i_prc
     logical, intent(in), optional :: reading, passed, pacify
     character(len=7) :: fmt
     eio%count = eio%count + 1
     if (present (pacify)) then
        call pac_fmt (fmt, FMT_19, FMT_16, pacify)
     else
        call pac_fmt (fmt, FMT_19, FMT_16, eio%pacify)
     end if
     if (eio%writing)  call dump (eio%unit)
     if (eio%screen) then
        call dump (output_unit)
        if (logfile_unit () > 0)  call dump (logfile_unit ())
     end if
   contains
     subroutine dump (u)
       integer, intent(in) :: u
       integer :: i
       call write_separator (u, 2)
       write (u, "(1x,A,I0)", advance="no")  "Event"
       if (event%has_index ()) then
          write (u, "(1x,'#',I0)")  event%get_index ()
       else
          write (u, *)
       end if
       call write_separator (u, 2)
       write (u, "(1x,A,1x,I0)")  "count  =", eio%count
       if (present (passed)) then
          write (u, "(1x,A,1x,L1)")  "passed =", passed
       else
          write (u, "(1x,A)")  "passed = [N/A]"
       end if
       write (u, "(1x,A,1x,I0)")  "prc id =", i_prc
       if (eio%weights) then
          call write_separator (u)
          if (event%sqme_ref_known) then
             write (u, "(1x,A," // fmt // ")")  "sqme (ref)   = ", &
                  event%sqme_ref
          else
             write (u, "(1x,A)")  "sqme (ref)    = [undefined]"
          end if
          if (event%sqme_prc_known) then
             write (u, "(1x,A," // fmt // ")")  "sqme (prc)   = ", &
                  event%sqme_prc
          else
             write (u, "(1x,A)")  "sqme (prc)    = [undefined]"
          end if
          if (event%weight_ref_known) then
             write (u, "(1x,A," // fmt // ")")  "weight (ref) = ", &
                  event%weight_ref
          else
             write (u, "(1x,A)")  "weight (ref) = [undefined]"
          end if
          if (event%weight_prc_known) then
             write (u, "(1x,A," // fmt // ")")  "weight (prc) = ", &
                  event%weight_prc
          else
             write (u, "(1x,A)")  "weight (prc) = [undefined]"
          end if
          if (event%excess_prc_known) then
             write (u, "(1x,A," // fmt // ")")  "excess (prc) = ", &
                  event%excess_prc
          else
             write (u, "(1x,A)")  "excess (prc) = [undefined]"
          end if
          do i = 1, event%n_alt
             if (event%sqme_ref_known) then
                write (u, "(1x,A,I0,A," // fmt // ")")  "sqme (", i, ")     = ",&
                     event%sqme_prc
             else
                write (u, "(1x,A,I0,A)")  "sqme (", i, ")    = [undefined]"
             end if
             if (event%weight_prc_known) then
                write (u, "(1x,A,I0,A," // fmt // ")")  "weight (", i, ")   = ",&
                     event%weight_prc
             else
                write (u, "(1x,A,I0,A)")  "weight (", i, ")   = [undefined]"
             end if
          end do
       end if
       call write_separator (u)
       if (event%particle_set_is_valid) then
          call event%particle_set%write (unit = u, &
               summary = eio%summary, compressed = eio%compressed, &
               testflag = eio%pacify)
       else
          write (u, "(1x,A)")  "Particle set: [invalid]"
       end if
     end subroutine dump
   end subroutine eio_dump_output
 
 @ %def eio_dump_output
 @ Input an event.
 <<EIO dump: eio dump: TBP>>=
   procedure :: input_i_prc => eio_dump_input_i_prc
   procedure :: input_event => eio_dump_input_event
 <<EIO dump: procedures>>=
   subroutine eio_dump_input_i_prc (eio, i_prc, iostat)
     class(eio_dump_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     call msg_bug ("Dump stream: event input not supported")
     i_prc = 0
     iostat = 1
   end subroutine eio_dump_input_i_prc
 
   subroutine eio_dump_input_event (eio, event, iostat)
     class(eio_dump_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     call msg_bug ("Dump stream: event input not supported")
     iostat = 1
   end subroutine eio_dump_input_event
 
 @ %def eio_dump_input_i_prc
 @ %def eio_dump_input_event
 @
 <<EIO dump: eio dump: TBP>>=
   procedure :: skip => eio_dump_skip
 <<EIO dump: procedures>>=
   subroutine eio_dump_skip (eio, iostat)
     class(eio_dump_t), intent(inout) :: eio
     integer, intent(out) :: iostat
     iostat = 0
   end subroutine eio_dump_skip
 
 @ %def eio_dump_skip
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_dump_ut.f90]]>>=
 <<File header>>
 
 module eio_dump_ut
   use unit_tests
   use eio_dump_uti
 
 <<Standard module head>>
 
 <<EIO dump: public test>>
 
 contains
 
 <<EIO dump: test driver>>
 
 end module eio_dump_ut
 @ %def eio_dump_ut
 @
 <<[[eio_dump_uti.f90]]>>=
 <<File header>>
 
 module eio_dump_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use event_base
   use eio_data
   use eio_base
 
   use eio_dump
 
   use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
 
 <<Standard module head>>
 
 <<EIO dump: test declarations>>
 
 contains
 
 <<EIO dump: tests>>
 
 end module eio_dump_uti
 @ %def eio_dump_ut
 @ API: driver for the unit tests below.
 <<EIO dump: public test>>=
   public :: eio_dump_test
 <<EIO dump: test driver>>=
   subroutine eio_dump_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO dump: execute tests>>
   end subroutine eio_dump_test
 
 @ %def eio_dump_test
 @
 \subsubsection{Test I/O methods}
 We test the implementation of all I/O methods.
 <<EIO dump: execute tests>>=
   call test (eio_dump_1, "eio_dump_1", &
        "write event contents", &
        u, results)
 <<EIO dump: test declarations>>=
   public :: eio_dump_1
 <<EIO dump: tests>>=
   subroutine eio_dump_1 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     class(eio_t), allocatable :: eio
     integer :: i_prc
     integer :: u_file
 
     write (u, "(A)")  "* Test output: eio_dump_1"
     write (u, "(A)")  "*   Purpose: generate events and write essentials to output"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write three events (two passed)"
     write (u, "(A)")
 
     allocate (eio_dump_t :: eio)
     select type (eio)
     type is (eio_dump_t)
        call eio%set_parameters (unit = u, weights = .true., pacify = .true.)
     end select
 
     i_prc = 42
     
     call eio%init_out (var_str (""))
 
     call event%generate (1, [0._default, 0._default])
     call eio%output (event, i_prc = i_prc)
 
     call event%generate (1, [0.1_default, 0._default])
     call event%set_index (99)
     call eio%output (event, i_prc = i_prc, passed = .false.)
 
     call event%generate (1, [0.2_default, 0._default])
     call event%increment_index ()
     call eio%output (event, i_prc = i_prc, passed = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of eio_dump object"
     write (u, "(A)")
 
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     select type (eio)
     type is (eio_dump_t)
        eio%writing = .false.
     end select
     call eio%final ()
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_dump_1"
   end subroutine eio_dump_1
 
 @ %def eio_dump_1
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{ASCII File Formats}
 Here, we implement several ASCII file formats. It is possible to
 switch between them using flags.
 <<[[eio_ascii.f90]]>>=
 <<File header>>
 
 module eio_ascii
 
 <<Use strings>>
   use io_units
   use diagnostics
   use event_base
   use eio_data
   use eio_base
   use hep_common
   use hep_events
 
 <<Standard module head>>
 
 <<EIO ascii: public>>
 
 <<EIO ascii: types>>
 
 contains
 
 <<EIO ascii: procedures>>
 
 end module eio_ascii
 @ %def eio_ascii
 @
 \subsection{Type}
 <<EIO ascii: public>>=
   public :: eio_ascii_t
 <<EIO ascii: types>>=
   type, abstract, extends (eio_t) :: eio_ascii_t
      logical :: writing = .false.
      integer :: unit = 0
      logical :: keep_beams = .false.
      logical :: keep_remnants = .true.
      logical :: ensure_order = .false.
    contains
    <<EIO ascii: eio ascii: TBP>>
   end type eio_ascii_t
 
 @ %def eio_ascii_t
 @
 <<EIO ascii: public>>=
   public :: eio_ascii_ascii_t
 <<EIO ascii: types>>=
   type, extends (eio_ascii_t) :: eio_ascii_ascii_t
   end type eio_ascii_ascii_t
 
 @ %def eio_ascii_ascii_t
 @
 <<EIO ascii: public>>=
   public :: eio_ascii_athena_t
 <<EIO ascii: types>>=
   type, extends (eio_ascii_t) :: eio_ascii_athena_t
   end type eio_ascii_athena_t
 
 @ %def eio_ascii_athena_t
 @ The debug format has a few options that can be controlled by
 Sindarin variables.
 <<EIO ascii: public>>=
   public :: eio_ascii_debug_t
 <<EIO ascii: types>>=
   type, extends (eio_ascii_t) :: eio_ascii_debug_t
      logical :: show_process = .true.
      logical :: show_transforms = .true.
      logical :: show_decay = .true.
      logical :: verbose = .true.
   end type eio_ascii_debug_t
 
 @ %def eio_ascii_debug_t
 @
 <<EIO ascii: public>>=
   public :: eio_ascii_hepevt_t
 <<EIO ascii: types>>=
   type, extends (eio_ascii_t) :: eio_ascii_hepevt_t
   end type eio_ascii_hepevt_t
 
 @ %def eio_ascii_hepevt_t
 @
 <<EIO ascii: public>>=
   public :: eio_ascii_hepevt_verb_t
 <<EIO ascii: types>>=
   type, extends (eio_ascii_t) :: eio_ascii_hepevt_verb_t
   end type eio_ascii_hepevt_verb_t
 
 @ %def eio_ascii_hepevt_verb_t
 @
 <<EIO ascii: public>>=
   public :: eio_ascii_lha_t
 <<EIO ascii: types>>=
   type, extends (eio_ascii_t) :: eio_ascii_lha_t
   end type eio_ascii_lha_t
 
 @ %def eio_ascii_lha_t
 @
 <<EIO ascii: public>>=
   public :: eio_ascii_lha_verb_t
 <<EIO ascii: types>>=
   type, extends (eio_ascii_t) :: eio_ascii_lha_verb_t
   end type eio_ascii_lha_verb_t
 
 @ %def eio_ascii_lha_verb_t
 @
 <<EIO ascii: public>>=
   public :: eio_ascii_long_t
 <<EIO ascii: types>>=
   type, extends (eio_ascii_t) :: eio_ascii_long_t
   end type eio_ascii_long_t
 
 @ %def eio_ascii_long_t
 @
 <<EIO ascii: public>>=
   public :: eio_ascii_mokka_t
 <<EIO ascii: types>>=
   type, extends (eio_ascii_t) :: eio_ascii_mokka_t
   end type eio_ascii_mokka_t
 
 @ %def eio_ascii_mokka_t
 @
 <<EIO ascii: public>>=
   public :: eio_ascii_short_t
 <<EIO ascii: types>>=
   type, extends (eio_ascii_t) :: eio_ascii_short_t
   end type eio_ascii_short_t
 
 @ %def eio_ascii_short_t
 @
 \subsection{Specific Methods}
 Set parameters that are specifically used with ASCII file formats.  In
 particular, this is the file extension.
 <<EIO ascii: eio ascii: TBP>>=
   procedure :: set_parameters => eio_ascii_set_parameters
 <<EIO ascii: procedures>>=
   subroutine eio_ascii_set_parameters (eio, &
        keep_beams, keep_remnants, ensure_order, extension, &
        show_process, show_transforms, show_decay, verbose)
     class(eio_ascii_t), intent(inout) :: eio
     logical, intent(in), optional :: keep_beams
     logical, intent(in), optional :: keep_remnants
     logical, intent(in), optional :: ensure_order
     type(string_t), intent(in), optional :: extension
     logical, intent(in), optional :: show_process, show_transforms, show_decay
     logical, intent(in), optional :: verbose
     if (present (keep_beams))  eio%keep_beams = keep_beams
     if (present (keep_remnants))  eio%keep_remnants = keep_remnants
     if (present (ensure_order))  eio%ensure_order = ensure_order
     if (present (extension)) then
        eio%extension = extension
     else
        select type (eio)
        type is (eio_ascii_ascii_t)
           eio%extension = "evt"
        type is (eio_ascii_athena_t)
           eio%extension = "athena.evt"
        type is (eio_ascii_debug_t)
           eio%extension = "debug"
        type is (eio_ascii_hepevt_t)
           eio%extension = "hepevt"
        type is (eio_ascii_hepevt_verb_t)
           eio%extension = "hepevt.verb"
        type is (eio_ascii_lha_t)
           eio%extension = "lha"
        type is (eio_ascii_lha_verb_t)
           eio%extension = "lha.verb"
        type is (eio_ascii_long_t)
           eio%extension = "long.evt"
        type is (eio_ascii_mokka_t)
           eio%extension = "mokka.evt"
        type is (eio_ascii_short_t)
           eio%extension = "short.evt"
        end select
     end if
     select type (eio)
     type is (eio_ascii_debug_t)
        if (present (show_process))  eio%show_process = show_process
        if (present (show_transforms))  eio%show_transforms = show_transforms
        if (present (show_decay))  eio%show_decay = show_decay
        if (present (verbose))  eio%verbose = verbose
     end select
   end subroutine eio_ascii_set_parameters
 
 @ %def eio_ascii_set_parameters
 @
 \subsection{Common Methods}
 Output.  This is not the actual event format, but a readable account
 of the current object status.
 <<EIO ascii: eio ascii: TBP>>=
   procedure :: write => eio_ascii_write
 <<EIO ascii: procedures>>=
   subroutine eio_ascii_write (object, unit)
     class(eio_ascii_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     select type (object)
     type is (eio_ascii_ascii_t)
        write (u, "(1x,A)")  "ASCII event stream (default format):"
     type is (eio_ascii_athena_t)
        write (u, "(1x,A)")  "ASCII event stream (ATHENA format):"
     type is (eio_ascii_debug_t)
        write (u, "(1x,A)")  "ASCII event stream (Debugging format):"
     type is (eio_ascii_hepevt_t)
        write (u, "(1x,A)")  "ASCII event stream (HEPEVT format):"
     type is (eio_ascii_hepevt_verb_t)
        write (u, "(1x,A)")  "ASCII event stream (verbose HEPEVT format):"
     type is (eio_ascii_lha_t)
        write (u, "(1x,A)")  "ASCII event stream (LHA format):"
     type is (eio_ascii_lha_verb_t)
        write (u, "(1x,A)")  "ASCII event stream (verbose LHA format):"
     type is (eio_ascii_long_t)
        write (u, "(1x,A)")  "ASCII event stream (long format):"
     type is (eio_ascii_mokka_t)
        write (u, "(1x,A)")  "ASCII event stream (MOKKA format):"
     type is (eio_ascii_short_t)
        write (u, "(1x,A)")  "ASCII event stream (short format):"
     end select
     if (object%writing) then
        write (u, "(3x,A,A)")  "Writing to file   = ", char (object%filename)
     else
        write (u, "(3x,A)")  "[closed]"
     end if
     write (u, "(3x,A,L1)")    "Keep beams        = ", object%keep_beams
     write (u, "(3x,A,L1)")    "Keep remnants     = ", object%keep_remnants
     select type (object)
     type is (eio_ascii_debug_t)
        write (u, "(3x,A,L1)")    "Show process      = ", object%show_process
        write (u, "(3x,A,L1)")    "Show transforms   = ", object%show_transforms
        write (u, "(3x,A,L1)")    "Show decay tree   = ", object%show_decay
        write (u, "(3x,A,L1)")    "Verbose output    = ", object%verbose
     end select
   end subroutine eio_ascii_write
 
 @ %def eio_ascii_write
 @ Finalizer: close any open file.
 <<EIO ascii: eio ascii: TBP>>=
   procedure :: final => eio_ascii_final
 <<EIO ascii: procedures>>=
   subroutine eio_ascii_final (object)
     class(eio_ascii_t), intent(inout) :: object
     if (object%writing) then
        write (msg_buffer, "(A,A,A)")  "Events: closing ASCII file '", &
             char (object%filename), "'"
        call msg_message ()
        close (object%unit)
        object%writing = .false.
     end if
   end subroutine eio_ascii_final
 
 @ %def eio_ascii_final
 @ Initialize event writing.
 
 Check weight normalization.  This applies to all ASCII-type files that
 use the HEPRUP common block.  We can't allow normalization conventions
 that are not covered by the HEPRUP definition.
 <<EIO ascii: eio ascii: TBP>>=
   procedure :: init_out => eio_ascii_init_out
 <<EIO ascii: procedures>>=
   subroutine eio_ascii_init_out (eio, sample, data, success, extension)
     class(eio_ascii_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     integer :: i
     if (.not. present (data)) &
          call msg_bug ("ASCII initialization: missing data")
     if (data%n_beam /= 2) &
          call msg_fatal ("ASCII: defined for scattering processes only")
     eio%sample = sample
     call eio%check_normalization (data)
     call eio%set_splitting (data)
     call eio%set_filename ()
     eio%unit = free_unit ()
     write (msg_buffer, "(A,A,A)")  "Events: writing to ASCII file '", &
          char (eio%filename), "'"
     call msg_message ()
     eio%writing = .true.
     open (eio%unit, file = char (eio%filename), &
          action = "write", status = "replace")
     select type (eio)
     type is (eio_ascii_lha_t)
        call heprup_init &
             (data%pdg_beam, &
             data%energy_beam, &
             n_processes = data%n_proc, &
             unweighted = data%unweighted, &
             negative_weights = data%negative_weights)
        do i = 1, data%n_proc
           call heprup_set_process_parameters (i = i, &
                process_id = data%proc_num_id(i), &
                cross_section = data%cross_section(i), &
                error = data%error(i))
        end do
        call heprup_write_ascii (eio%unit)
     type is (eio_ascii_lha_verb_t)
        call heprup_init &
             (data%pdg_beam, &
             data%energy_beam, &
             n_processes = data%n_proc, &
             unweighted = data%unweighted, &
             negative_weights = data%negative_weights)
        do i = 1, data%n_proc
           call heprup_set_process_parameters (i = i, &
                process_id = data%proc_num_id(i), &
                cross_section = data%cross_section(i), &
                error = data%error(i))
        end do
        call heprup_write_verbose (eio%unit)
     end select
     if (present (success))  success = .true.
   end subroutine eio_ascii_init_out
 
 @ %def eio_ascii_init_out
 @ Some event properties do not go well with some output formats.  In
 particular, many formats require unweighted events.
 <<EIO ascii: eio ascii: TBP>>=
   procedure :: check_normalization => eio_ascii_check_normalization
 <<EIO ascii: procedures>>=
   subroutine eio_ascii_check_normalization (eio, data)
     class(eio_ascii_t), intent(in) :: eio
     type(event_sample_data_t), intent(in) :: data
     if (data%unweighted) then
     else
        select type (eio)
        type is (eio_ascii_athena_t);  call msg_fatal &
             ("Event output (Athena format): events must be unweighted.")
        type is (eio_ascii_hepevt_t);  call msg_fatal &
             ("Event output (HEPEVT format): events must be unweighted.")
        type is (eio_ascii_hepevt_verb_t);  call msg_fatal &
             ("Event output (HEPEVT format): events must be unweighted.")
        end select
        select case (data%norm_mode)
        case (NORM_SIGMA)
        case default
           select type (eio)
           type is (eio_ascii_lha_t)
              call msg_fatal &
                   ("Event output (LHA): normalization for weighted events &
                   &must be 'sigma'")
           type is (eio_ascii_lha_verb_t)
              call msg_fatal &
                   ("Event output (LHA): normalization for weighted events &
                   &must be 'sigma'")
           end select
        end select
     end if
   end subroutine eio_ascii_check_normalization
 
 @ %def check_normalization
 @ Initialize event reading.
 <<EIO ascii: eio ascii: TBP>>=
   procedure :: init_in => eio_ascii_init_in
 <<EIO ascii: procedures>>=
   subroutine eio_ascii_init_in (eio, sample, data, success, extension)
     class(eio_ascii_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     call msg_bug ("ASCII: event input not supported")
     if (present (success))  success = .false.
   end subroutine eio_ascii_init_in
 
 @ %def eio_ascii_init_in
 @ Switch from input to output: reopen the file for reading.
 <<EIO ascii: eio ascii: TBP>>=
   procedure :: switch_inout => eio_ascii_switch_inout
 <<EIO ascii: procedures>>=
   subroutine eio_ascii_switch_inout (eio, success)
     class(eio_ascii_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     call msg_bug ("ASCII: in-out switch not supported")
     if (present (success))  success = .false.
   end subroutine eio_ascii_switch_inout
 
 @ %def eio_ascii_switch_inout
 @ Split event file: increment the counter, close the current file, open a new
 one.  If the file needs a header, repeat it for the new file.  (We assume that
 the common block contents are still intact.)
 <<EIO ascii: eio ascii: TBP>>=
   procedure :: split_out => eio_ascii_split_out
 <<EIO ascii: procedures>>=
   subroutine eio_ascii_split_out (eio)
     class(eio_ascii_t), intent(inout) :: eio
     if (eio%split) then
        eio%split_index = eio%split_index + 1
        call eio%set_filename ()
        write (msg_buffer, "(A,A,A)")  "Events: writing to ASCII file '", &
             char (eio%filename), "'"
        call msg_message ()
        close (eio%unit)
        open (eio%unit, file = char (eio%filename), &
             action = "write", status = "replace")
        select type (eio)
        type is (eio_ascii_lha_t)
           call heprup_write_ascii (eio%unit)
        type is (eio_ascii_lha_verb_t)
           call heprup_write_verbose (eio%unit)
        end select
     end if
   end subroutine eio_ascii_split_out
 
 @ %def eio_ascii_split_out
 @ Output an event.  Write first the event indices, then weight and
 squared matrix element, then the particle set.
 
 Events that did not pass the selection are skipped.  The exceptions are
 the [[ascii]] and [[debug]] formats.  These are the formats that
 contain the [[passed]] flag in their output, and should be most useful
 for debugging purposes.
 <<EIO ascii: eio ascii: TBP>>=
   procedure :: output => eio_ascii_output
 <<EIO ascii: procedures>>=
   subroutine eio_ascii_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_ascii_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     integer, intent(in) :: i_prc
     logical, intent(in), optional :: reading, passed, pacify
     if (present (passed)) then
        if (.not. passed) then
           select type (eio)
           type is (eio_ascii_debug_t)
           type is (eio_ascii_ascii_t)
           class default
              return
           end select
        end if
     end if
     if (eio%writing) then
        select type (eio)
        type is (eio_ascii_lha_t)
           call hepeup_from_event (event, &
                process_index = i_prc, &
                keep_beams = eio%keep_beams, &
                keep_remnants = eio%keep_remnants)
           call hepeup_write_lha (eio%unit)
        type is (eio_ascii_lha_verb_t)
           call hepeup_from_event (event, &
                process_index = i_prc, &
                keep_beams = eio%keep_beams, &
                keep_remnants = eio%keep_remnants)
           call hepeup_write_verbose (eio%unit)
        type is (eio_ascii_ascii_t)
           call event%write (eio%unit, &
                show_process = .false., &
                show_transforms = .false., &
                show_decay = .false., &
                verbose = .false., testflag = pacify)
        type is (eio_ascii_athena_t)
           call hepevt_from_event (event, &
                keep_beams = eio%keep_beams, &
                keep_remnants = eio%keep_remnants, &
                ensure_order = eio%ensure_order)
           call hepevt_write_athena (eio%unit)
        type is (eio_ascii_debug_t)
           call event%write (eio%unit, &
                show_process = eio%show_process, &
                show_transforms = eio%show_transforms, &
                show_decay = eio%show_decay, &
                verbose = eio%verbose, &
                testflag = pacify)
        type is (eio_ascii_hepevt_t)
           call hepevt_from_event (event, &
                keep_beams = eio%keep_beams, &
                keep_remnants = eio%keep_remnants, &
                ensure_order = eio%ensure_order)
           call hepevt_write_hepevt (eio%unit)
        type is (eio_ascii_hepevt_verb_t)
           call hepevt_from_event (event, &
                keep_beams = eio%keep_beams, &
                keep_remnants = eio%keep_remnants, &
                ensure_order = eio%ensure_order)
           call hepevt_write_verbose (eio%unit)
        type is (eio_ascii_long_t)
           call hepevt_from_event (event, &
                keep_beams = eio%keep_beams, &
                keep_remnants = eio%keep_remnants, &
                ensure_order = eio%ensure_order)
           call hepevt_write_ascii (eio%unit, .true.)
        type is (eio_ascii_mokka_t)
           call hepevt_from_event (event, &
                keep_beams = eio%keep_beams, &
                keep_remnants = eio%keep_remnants, &
                ensure_order = eio%ensure_order)
           call hepevt_write_mokka (eio%unit)
        type is (eio_ascii_short_t)
           call hepevt_from_event (event, &
                keep_beams = eio%keep_beams, &
                keep_remnants = eio%keep_remnants, &
                ensure_order = eio%ensure_order)
           call hepevt_write_ascii (eio%unit, .false.)
        end select
     else
        call eio%write ()
        call msg_fatal ("ASCII file is not open for writing")
     end if
   end subroutine eio_ascii_output
 
 @ %def eio_ascii_output
 @ Input an event.
 <<EIO ascii: eio ascii: TBP>>=
   procedure :: input_i_prc => eio_ascii_input_i_prc
   procedure :: input_event => eio_ascii_input_event
 <<EIO ascii: procedures>>=
   subroutine eio_ascii_input_i_prc (eio, i_prc, iostat)
     class(eio_ascii_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     call msg_bug ("ASCII: event input not supported")
     i_prc = 0
     iostat = 1
   end subroutine eio_ascii_input_i_prc
 
   subroutine eio_ascii_input_event (eio, event, iostat)
     class(eio_ascii_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     call msg_bug ("ASCII: event input not supported")
     iostat = 1
   end subroutine eio_ascii_input_event
 
 @ %def eio_ascii_input_i_prc
 @ %def eio_ascii_input_event
 @
 <<EIO ascii: eio ascii: TBP>>=
   procedure :: skip => eio_ascii_skip
 <<EIO ascii: procedures>>=
   subroutine eio_ascii_skip (eio, iostat)
      class(eio_ascii_t), intent(inout) :: eio
      integer, intent(out) :: iostat
      iostat = 0
   end subroutine eio_ascii_skip
 
 @ %def eio_asciii_skip
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_ascii_ut.f90]]>>=
 <<File header>>
 
 module eio_ascii_ut
   use unit_tests
   use eio_ascii_uti
 
 <<Standard module head>>
 
 <<EIO ascii: public test>>
 
 contains
 
 <<EIO ascii: test driver>>
 
 end module eio_ascii_ut
 @ %def eio_ascii_ut
 @
 <<[[eio_ascii_uti.f90]]>>=
 <<File header>>
 
 module eio_ascii_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use lorentz
   use model_data
   use event_base
   use particles
   use eio_data
   use eio_base
 
   use eio_ascii
 
   use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
 
 <<Standard module head>>
 
 <<EIO ascii: test declarations>>
 
 contains
 
 <<EIO ascii: tests>>
 
 end module eio_ascii_uti
 @ %def eio_ascii_uti
 @ API: driver for the unit tests below.
 <<EIO ascii: public test>>=
   public :: eio_ascii_test
 <<EIO ascii: test driver>>=
   subroutine eio_ascii_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO ascii: execute tests>>
   end subroutine eio_ascii_test
 
 @ %def eio_ascii_test
 @
 \subsubsection{Test I/O methods}
 We test the implementation of all I/O methods, method [[ascii]]:
 <<EIO ascii: execute tests>>=
   call test (eio_ascii_1, "eio_ascii_1", &
        "read and write event contents, format [ascii]", &
        u, results)
 <<EIO ascii: test declarations>>=
   public :: eio_ascii_1
 <<EIO ascii: tests>>=
   subroutine eio_ascii_1 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_ascii_1"
     write (u, "(A)")  "*   Purpose: generate an event in ASCII ascii format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_ascii_1"
 
     allocate (eio_ascii_ascii_t :: eio)
 
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%set_index (42)
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".evt"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_ascii_ascii_t :: eio)
 
     select type (eio)
     type is (eio_ascii_ascii_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_ascii_1"
 
   end subroutine eio_ascii_1
 
 @ %def eio_ascii_1
 @
 We test the implementation of all I/O methods, method [[athena]]:
 <<EIO ascii: execute tests>>=
   call test (eio_ascii_2, "eio_ascii_2", &
        "read and write event contents, format [athena]", &
        u, results)
 <<EIO ascii: test declarations>>=
   public :: eio_ascii_2
 <<EIO ascii: tests>>=
   subroutine eio_ascii_2 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_ascii_2"
     write (u, "(A)")  "*   Purpose: generate an event in ASCII athena format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_ascii_2"
 
     allocate (eio_ascii_athena_t :: eio)
 
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%set_index (42)
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char(sample // ".athena.evt"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_ascii_athena_t :: eio)
 
     select type (eio)
     type is (eio_ascii_athena_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_ascii_2"
 
   end subroutine eio_ascii_2
 
 @ %def eio_ascii_2
 @
 We test the implementation of all I/O methods, method [[debug]]:
 <<EIO ascii: execute tests>>=
   call test (eio_ascii_3, "eio_ascii_3", &
        "read and write event contents, format [debug]", &
        u, results)
 <<EIO ascii: test declarations>>=
   public :: eio_ascii_3
 <<EIO ascii: tests>>=
   subroutine eio_ascii_3 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_ascii_3"
     write (u, "(A)")  "*   Purpose: generate an event in ASCII debug format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_ascii_3"
 
     allocate (eio_ascii_debug_t :: eio)
 
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".debug"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_ascii_debug_t :: eio)
 
     select type (eio)
     type is (eio_ascii_debug_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_ascii_3"
 
   end subroutine eio_ascii_3
 
 @ %def eio_ascii_3
 @
 We test the implementation of all I/O methods, method [[hepevt]]:
 <<EIO ascii: execute tests>>=
   call test (eio_ascii_4, "eio_ascii_4", &
        "read and write event contents, format [hepevt]", &
        u, results)
 <<EIO ascii: test declarations>>=
   public :: eio_ascii_4
 <<EIO ascii: tests>>=
   subroutine eio_ascii_4 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_ascii_4"
     write (u, "(A)")  "*   Purpose: generate an event in ASCII hepevt format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_ascii_4"
 
     allocate (eio_ascii_hepevt_t :: eio)
 
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".hepevt"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_ascii_hepevt_t :: eio)
 
     select type (eio)
     type is (eio_ascii_hepevt_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_ascii_4"
 
   end subroutine eio_ascii_4
 
 @ %def eio_ascii_4
 @
 We test the implementation of all I/O methods, method [[lha]] (old LHA):
 <<EIO ascii: execute tests>>=
   call test (eio_ascii_5, "eio_ascii_5", &
        "read and write event contents, format [lha]", &
        u, results)
 <<EIO ascii: test declarations>>=
   public :: eio_ascii_5
 <<EIO ascii: tests>>=
   subroutine eio_ascii_5 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_ascii_5"
     write (u, "(A)")  "*   Purpose: generate an event in ASCII LHA format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_ascii_5"
 
     allocate (eio_ascii_lha_t :: eio)
 
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".lha"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_ascii_lha_t :: eio)
 
     select type (eio)
     type is (eio_ascii_lha_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_ascii_5"
 
   end subroutine eio_ascii_5
 
 @ %def eio_ascii_5
 @
 We test the implementation of all I/O methods, method [[long]]:
 <<EIO ascii: execute tests>>=
   call test (eio_ascii_6, "eio_ascii_6", &
        "read and write event contents, format [long]", &
        u, results)
 <<EIO ascii: test declarations>>=
   public :: eio_ascii_6
 <<EIO ascii: tests>>=
   subroutine eio_ascii_6 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_ascii_6"
     write (u, "(A)")  "*   Purpose: generate an event in ASCII long format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_ascii_6"
 
     allocate (eio_ascii_long_t :: eio)
 
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".long.evt"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_ascii_long_t :: eio)
 
     select type (eio)
     type is (eio_ascii_long_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_ascii_6"
 
   end subroutine eio_ascii_6
 
 @ %def eio_ascii_6
 @
 We test the implementation of all I/O methods, method [[mokka]]:
 <<EIO ascii: execute tests>>=
   call test (eio_ascii_7, "eio_ascii_7", &
        "read and write event contents, format [mokka]", &
        u, results)
 <<EIO ascii: test declarations>>=
   public :: eio_ascii_7
 <<EIO ascii: tests>>=
   subroutine eio_ascii_7 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_ascii_7"
     write (u, "(A)")  "*   Purpose: generate an event in ASCII mokka format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_ascii_7"
 
     allocate (eio_ascii_mokka_t :: eio)
 
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".mokka.evt"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_ascii_mokka_t :: eio)
 
     select type (eio)
     type is (eio_ascii_mokka_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_ascii_7"
 
   end subroutine eio_ascii_7
 
 @ %def eio_ascii_7
 @
 We test the implementation of all I/O methods, method [[short]]:
 <<EIO ascii: execute tests>>=
   call test (eio_ascii_8, "eio_ascii_8", &
        "read and write event contents, format [short]", &
        u, results)
 <<EIO ascii: test declarations>>=
   public :: eio_ascii_8
 <<EIO ascii: tests>>=
   subroutine eio_ascii_8 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_ascii_8"
     write (u, "(A)")  "*   Purpose: generate an event in ASCII short format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_ascii_8"
 
     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)
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".short.evt"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_ascii_short_t :: eio)
 
     select type (eio)
     type is (eio_ascii_short_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_ascii_8"
 
   end subroutine eio_ascii_8
 
 @ %def eio_ascii_8
 @
 We test the implementation of all I/O methods, method [[lha]]  (old
 LHA) in verbose version:
 <<EIO ascii: execute tests>>=
   call test (eio_ascii_9, "eio_ascii_9", &
        "read and write event contents, format [lha_verb]", &
        u, results)
 <<EIO ascii: test declarations>>=
   public :: eio_ascii_9
 <<EIO ascii: tests>>=
   subroutine eio_ascii_9 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_ascii_9"
     write (u, "(A)")  "*   Purpose: generate an event in ASCII LHA verbose format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_ascii_9"
 
     allocate (eio_ascii_lha_verb_t :: eio)
 
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".lha.verb"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_ascii_lha_verb_t :: eio)
 
     select type (eio)
     type is (eio_ascii_lha_verb_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_ascii_9"
 
   end subroutine eio_ascii_9
 
 @ %def eio_ascii_9
 @
 We test the implementation of all I/O methods, method [[hepevt_verb]]:
 <<EIO ascii: execute tests>>=
   call test (eio_ascii_10, "eio_ascii_10", &
        "read and write event contents, format [hepevt_verb]", &
        u, results)
 <<EIO ascii: test declarations>>=
   public :: eio_ascii_10
 <<EIO ascii: tests>>=
   subroutine eio_ascii_10 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_ascii_10"
     write (u, "(A)")  "*   Purpose: generate an event in ASCII hepevt verbose format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_ascii_10"
 
     allocate (eio_ascii_hepevt_verb_t :: eio)
 
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".hepevt.verb"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_ascii_hepevt_verb_t :: eio)
 
     select type (eio)
     type is (eio_ascii_hepevt_verb_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_ascii_10"
 
   end subroutine eio_ascii_10
 
 @ %def eio_ascii_10
 @
 We test the implementation of all I/O methods, method [[mokka]]:
 <<EIO ascii: execute tests>>=
   call test (eio_ascii_11, "eio_ascii_11", &
        "read and write event contents, format [mokka], tiny value", &
        u, results)
 <<EIO ascii: test declarations>>=
   public :: eio_ascii_11
 <<EIO ascii: tests>>=
   subroutine eio_ascii_11 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(particle_set_t), pointer :: pset
     type(vector4_t) :: pnew
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(128) :: buffer
     real(default), parameter :: tval = 1.e-111_default
 
     write (u, "(A)")  "* Test output: eio_ascii_11"
     write (u, "(A)")  "*   Purpose: generate an event in ASCII mokka format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")  "*      with low-value cutoff"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_ascii_11"
 
     allocate (eio_ascii_mokka_t :: eio)
 
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%increment_index ()
     call event%evaluate_expressions ()
 
     ! Manipulate values in the event record
     pset => event%get_particle_set_ptr ()
     call pset%set_momentum (3, &
          vector4_moving (-tval, vector3_moving  ([-tval, -tval, -tval])), &
          -tval**2)
     call pset%set_momentum (4, &
          vector4_moving (tval, vector3_moving  ([tval, tval, tval])), &
          tval**2)
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".mokka.evt"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_ascii_11"
 
   end subroutine eio_ascii_11
 
 @ %def eio_ascii_11
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{HEP Common Blocks}
 
 Long ago, to transfer data between programs one had to set up a common
 block and link both programs as libraries to the main executable.  The
 HEP community standardizes several of those common blocks.
 
 The modern way of data exchange uses data files with standard
 formats.  However, the LHEF standard data format derives from a common
 block (actually, two).
 
 \whizard\ used to support those common blocks, and LHEF was
 implemented via writing/reading blocks.  We still keep this
 convention, but intend to eliminate common blocks (or any other static
 storage) from the workflow in the future.  This will gain flexibility
 towards concurrent running of program images.
 
 We encapsulate everything here in a module.  The module holds the
 variables which are part of the common block.  To access the common
 block variables, we just have to [[use]] this module.  (They are
 nevertheless in the common block, since external software may access
 it in this way.)
 
 Note: This code is taken essentially unchanged from \whizard\ 2.1 and
 does not (yet) provide unit tests.
 <<[[hep_common.f90]]>>=
 <<File header>>
 
 module hep_common
 
 <<Use kinds>>
   use kinds, only: double
   use constants
 <<Use strings>>
 <<Use debug>>
   use io_units
   use diagnostics
   use numeric_utils
   use format_utils, only: refmt_tiny
   use physics_defs, only: HADRON_REMNANT
   use physics_defs, only: HADRON_REMNANT_SINGLET
   use physics_defs, only: HADRON_REMNANT_TRIPLET
   use physics_defs, only: HADRON_REMNANT_OCTET
   use xml
   use lorentz
   use flavors
   use colors
   use polarizations
   use model_data
   use particles
   use subevents, only: PRT_BEAM, PRT_INCOMING, PRT_OUTGOING
   use subevents, only: PRT_UNDEFINED
   use subevents, only: PRT_VIRTUAL, PRT_RESONANT, PRT_BEAM_REMNANT
 
 <<Standard module head>>
 
 <<HEP common: public>>
 
 <<HEP common: interfaces>>
 
 <<HEP common: parameters>>
 
 <<HEP common: variables>>
 
 <<HEP common: common blocks>>
 
 contains
 
 <<HEP common: procedures>>
 
 end module hep_common
 @ %def hep_common
 @
 \subsection{Event characteristics}
 The maximal number of particles in an event record.
 <<HEP common: parameters>>=
   integer, parameter, public :: MAXNUP = 500
 @ %def MAXNUP
 @ The number of particles in this event.
 <<HEP common: variables>>=
   integer, public :: NUP
 @ %def NUP
 @ The process ID for this event.
 <<HEP common: variables>>=
   integer, public :: IDPRUP
 @ %def IDPRUP
 @ The weight of this event ($\pm 1$ for unweighted events).
 <<HEP common: variables>>=
   double precision, public :: XWGTUP
 @ %def XWGTUP
 @ The factorization scale that is used for PDF calculation ($-1$ if
 undefined).
 <<HEP common: variables>>=
   double precision, public :: SCALUP
 @ %def SCALUP
 @ The QED and QCD couplings $\alpha$ used for this event ($-1$ if
 undefined).
 <<HEP common: variables>>=
   double precision, public :: AQEDUP
   double precision, public :: AQCDUP
 @ %def AQEDUP AQCDUP
 @
 
 \subsection{Particle characteristics}
 The PDG code:
 <<HEP common: variables>>=
   integer, dimension(MAXNUP), public :: IDUP
 @ %def IDUP
 @ The status code.  Incoming: $-1$, outgoing: $+1$.  Intermediate
 t-channel propagator: $-2$ (currently not used by WHIZARD).
 Intermediate resonance whose mass should be preserved: $2$.
 Intermediate resonance for documentation: $3$ (currently not used).
 Beam particles: $-9$.
 <<HEP common: variables>>=
   integer, dimension(MAXNUP), public :: ISTUP
 @ %def ISTUP
 @ Index of first and last mother.
 <<HEP common: variables>>=
   integer, dimension(2,MAXNUP), public :: MOTHUP
 @ %def MOTHUP
 @ Color line index of the color and anticolor entry for the particle.
 The standard recommends using large numbers; we start from MAXNUP+1.
 <<HEP common: variables>>=
   integer, dimension(2,MAXNUP), public :: ICOLUP
 @ %def ICOLUP
 @ Momentum, energy, and invariant mass: $(p_x,p_y,p_z,E,M)$.  For
 space-like particles, $M$ is the negative square root of the absolute
 value of the invariant mass.
 <<HEP common: variables>>=
   double precision, dimension(5,MAXNUP), public :: PUP
 @ %def PUP
 @ Invariant lifetime (distance) from production to decay in mm.
 <<HEP common: variables>>=
   double precision, dimension(MAXNUP), public :: VTIMUP
 @ %def VTIMUP
 @ Cosine of the angle between the spin-vector and a particle and the
 3-momentum of its mother, given in the lab frame.  If
 undefined/unpolarized: $9$.
 <<HEP common: variables>>=
   double precision, dimension(MAXNUP), public :: SPINUP
 @ %def SPINUP
 @
 \subsection{The HEPRUP common block}
 This common block is filled once per run.
 
 \subsubsection{Run characteristics}
 The maximal number of different processes.
 <<HEP common: parameters>>=
   integer, parameter, public :: MAXPUP = 100
 @ %def MAXPUP
 @ The beam PDG codes.
 <<HEP common: variables>>=
   integer, dimension(2), public :: IDBMUP
 @ %def IDBMUP
 @ The beam energies in GeV.
 <<HEP common: variables>>=
   double precision, dimension(2), public :: EBMUP
 @ %def EBMUP
 @ The PDF group and set for the two beams.  (Undefined: use $-1$;
 LHAPDF: use group = $0$).
 <<HEP common: variables>>=
   integer, dimension(2), public :: PDFGUP
   integer, dimension(2), public :: PDFSUP
 @ %def PDFGUP PDFSUP
 @ The (re)weighting model.  1: events are weighted, the shower
 generator (SHG) selects processes according to the maximum weight (in
 pb) and unweights events.  2: events are weighted, the SHG selects
 processes according to their cross section (in pb) and unweights
 events.  3: events are unweighted and simply run through the SHG.  4:
 events are weighted, and the SHG keeps the weight.  Negative numbers:
 negative weights are allowed (and are reweighted to $\pm 1$ by the
 SHG, if allowed).
 
 \whizard\ only supports modes 3 and 4, as the SHG is not given control
 over process selection.  This is consistent with writing events to
 file, for offline showering.
 <<HEP common: variables>>=
   integer, public :: IDWTUP
 @ %def IDWTUP
 @ The number of different processes.
 <<HEP common: variables>>=
   integer, public :: NPRUP
 @ %def NPRUP
 @
 \subsubsection{Process characteristics}
 Cross section and error in pb.  (Cross section is needed only for
 $[[IDWTUP]] = 2$, so here both values are given for informational
 purposes only.)
 <<HEP common: variables>>=
   double precision, dimension(MAXPUP), public :: XSECUP
   double precision, dimension(MAXPUP), public :: XERRUP
 @ %def XSECUP XERRUP
 @ Maximum weight, i.e., the maximum value that [[XWGTUP]] can take.
 Also unused for the supported weighting models. It is $\pm 1$ for
 unweighted events.
 <<HEP common: variables>>=
   double precision, dimension(MAXPUP), public :: XMAXUP
 @ %def XMAXUP
 @ Internal ID of the selected process, matches [[IDPRUP]] below.
 <<HEP common: variables>>=
   integer, dimension(MAXPUP), public :: LPRUP
 @ %def LPRUP
 @
 \subsubsection{The common block}
 <<HEP common: common blocks>>=
   common /HEPRUP/ &
        IDBMUP, EBMUP, PDFGUP, PDFSUP, IDWTUP, NPRUP, &
        XSECUP, XERRUP, XMAXUP, LPRUP
   save /HEPRUP/
 
 @ %def HEPRUP
 @ Fill the run characteristics of the common block.  The
 initialization sets the beam properties, number of processes, and
 weighting model.
 <<HEP common: public>>=
   public :: heprup_init
 <<HEP common: procedures>>=
   subroutine heprup_init &
        (beam_pdg, beam_energy, n_processes, unweighted, negative_weights)
     integer, dimension(2), intent(in) :: beam_pdg
     real(default), dimension(2), intent(in) :: beam_energy
     integer, intent(in) :: n_processes
     logical, intent(in) :: unweighted
     logical, intent(in) :: negative_weights
     IDBMUP = beam_pdg
     EBMUP = beam_energy
     PDFGUP = -1
     PDFSUP = -1
     if (unweighted) then
        IDWTUP = 3
     else
        IDWTUP = 4
     end if
     if (negative_weights)  IDWTUP = - IDWTUP
     NPRUP = n_processes
   end subroutine heprup_init
 
 @ %def heprup_init
 The HEPRUP (event) common block is needed for the interface to the shower.
 Filling of it is triggered by some output file formats.  If these are not
 present, the common block is filled with some dummy information. Be generous
 with the number of processes in HEPRUP so that PYTHIA only rarely needs to be
 reinitialized in case events with higher process ids are generated.
 <<HEP common: public>>=
   public :: assure_heprup
 <<HEP common: procedures>>=
   subroutine assure_heprup (pset)
     type(particle_set_t), intent(in) :: pset
     integer :: i, num_id
     integer, parameter :: min_processes = 10
     num_id = 1
     if (LPRUP (num_id) /= 0)  return
     call heprup_init ( &
          [pset%prt(1)%get_pdg (), pset%prt(2)%get_pdg ()] , &
          [pset%prt(1)%p%p(0), pset%prt(2)%p%p(0)], &
          num_id, .false., .false.)
     do i = 1, (num_id / min_processes + 1) * min_processes
        call heprup_set_process_parameters (i = i, process_id = &
             i, cross_section = 1._default, error = 1._default)
     end do
   end subroutine assure_heprup
 
 @ %def assure_heprup
 @ Read in the LHE file opened in unit [[u]] and add the final
 particles to the [[particle_set]], the outgoing particles of the existing
 [[particle_set]] are compared to the particles that are read in. When
 they are equal in flavor and momenta, they are erased and their
 mother-daughter relations are transferred to the existing particles.
 <<HEP common: public>>=
   public :: combine_lhef_with_particle_set
 <<HEP common: procedures>>=
   subroutine combine_lhef_with_particle_set &
        (particle_set, u, model_in, model_hadrons)
     type(particle_set_t), intent(inout) :: particle_set
     integer, intent(in) :: u
     class(model_data_t), intent(in), target :: model_in
     class(model_data_t), intent(in), target :: model_hadrons
     type(flavor_t) :: flv
     type(color_t) :: col
     class(model_data_t), pointer :: model
     type(particle_t), dimension(:), allocatable :: prt_tmp, prt
     integer :: i, j
     type(vector4_t) :: mom, d_mom
     integer, PARAMETER :: MAXLEN=200
     character(len=maxlen) :: string
     integer :: ibeg, n_tot, n_entries
     integer, dimension(:), allocatable :: relations, mothers, tbd
     INTEGER :: NUP,IDPRUP,IDUP,ISTUP
     real(kind=double) :: XWGTUP,SCALUP,AQEDUP,AQCDUP,VTIMUP,SPINUP
     integer :: MOTHUP(1:2), ICOLUP(1:2)
     real(kind=double) :: PUP(1:5)
     real(kind=default) :: pup_dum(1:5)
     character(len=5) :: buffer
     character(len=6) :: strfmt
     logical :: not_found
     logical :: debug_lhef = .false.
     STRFMT='(A000)'
     WRITE (STRFMT(3:5),'(I3)') MAXLEN
 
     if (debug_lhef)  call particle_set%write ()
 
     rewind (u)
 
     do
        read (u,*, END=501, ERR=502) STRING
        IBEG = 0
        do
           if (signal_is_pending ()) return
           IBEG = IBEG + 1
           ! Allow indentation.
           IF (STRING (IBEG:IBEG) .EQ. ' ' .and. IBEG < MAXLEN-6) cycle
           exit
        end do
        IF (string(IBEG:IBEG+6) /= '<event>' .and. &
             string(IBEG:IBEG+6) /= '<event ') cycle
        exit
     end do
     !!! Read first line of event info -> number of entries
     read (u, *, END=503, ERR=504) NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP
     n_tot = particle_set%get_n_tot ()
     allocate (prt_tmp (1:n_tot+NUP))
     allocate (relations (1:NUP), mothers (1:NUP), tbd(1:NUP))
     do i = 1, n_tot
        if (signal_is_pending ()) return
        prt_tmp (i) = particle_set%get_particle (i)
     end do
     !!! transfer particles from lhef to particle_set
     !!!...Read NUP subsequent lines with information on each particle.
     n_entries = 1
     mothers = 0
     relations = 0
     PARTICLE_LOOP: do I = 1, NUP
        read (u,*, END=200, ERR=505) IDUP, ISTUP, MOTHUP(1), MOTHUP(2), &
             ICOLUP(1), ICOLUP(2), (PUP (J),J=1,5), VTIMUP, SPINUP
        if (model_in%test_field (IDUP)) then
           model => model_in
        else if (model_hadrons%test_field (IDUP)) then
           model => model_hadrons
        else
           write (buffer, "(I5)") IDUP
           call msg_error ("Parton " // buffer // &
                " found neither in given model file nor in SM_hadrons")
           return
        end if
        if (debug_lhef) then
           print *, "IDUP, ISTUP, MOTHUP, PUP = ", IDUP, ISTUP, MOTHUP(1), &
 	     MOTHUP(2), PUP
        end if
        call flv%init (IDUP, model)
        if (IABS(IDUP) == 2212 .or. IABS(IDUP) == 2112) then
           ! PYTHIA sometimes sets color indices for protons and neutrons (?)
           ICOLUP (1) = 0
           ICOLUP (2) = 0
        end if
        call col%init_col_acl (ICOLUP (1), ICOLUP (2))
        !!! Settings for unpolarized particles
        ! particle_set%prt (oldsize+i)%hel = ??
        ! particle_set%prt (oldsize+i)%pol = ??
        if (MOTHUP(1) /= 0) then
           mothers(i) = MOTHUP(1)
        end if
        pup_dum = PUP
        if (pup_dum(4) < 1E-10_default)  cycle
        mom = vector4_moving (pup_dum (4), &
             vector3_moving ([pup_dum (1), pup_dum (2), pup_dum (3)]))
        not_found = .true.
        SCAN_PARTICLES: do j = 1, n_tot
           d_mom = prt_tmp(j)%get_momentum ()
           if (all (nearly_equal &
                (mom%p, d_mom%p, abs_smallness = 1.E-4_default)) .and. &
                 (prt_tmp(j)%get_pdg () == IDUP)) then
              if (.not. prt_tmp(j)%get_status () == PRT_BEAM .or. &
                   .not. prt_tmp(j)%get_status () == PRT_BEAM_REMNANT) &
                   relations(i) = j
                   not_found = .false.
           end if
        end do SCAN_PARTICLES
        if (not_found) then
           if (debug_lhef) &
              print *, "Not found: adding particle"
           call prt_tmp(n_tot+n_entries)%set_flavor (flv)
           call prt_tmp(n_tot+n_entries)%set_color (col)
           call prt_tmp(n_tot+n_entries)%set_momentum (mom)
           if (MOTHUP(1) /= 0) then
              if (relations(MOTHUP(1)) /= 0) then
                 call prt_tmp(n_tot+n_entries)%set_parents &
                      ([relations(MOTHUP(1))])
                 call prt_tmp(relations(MOTHUP(1)))%add_child (n_tot+n_entries)
                 if (prt_tmp(relations(MOTHUP(1)))%get_status () &
                      == PRT_OUTGOING) &
                      call prt_tmp(relations(MOTHUP(1)))%reset_status &
                      (PRT_VIRTUAL)
              end if
           end if
           call prt_tmp(n_tot+n_entries)%set_status (PRT_OUTGOING)
           if (debug_lhef) call prt_tmp(n_tot+n_entries)%write ()
           n_entries = n_entries + 1
        end if
     end do PARTICLE_LOOP
     do i = 1, n_tot
        if (prt_tmp(i)%get_status () == PRT_OUTGOING .and. &
            prt_tmp(i)%get_n_children () /= 0) then
                 call prt_tmp(i)%reset_status (PRT_VIRTUAL)
        end if
     end do
 
     allocate (prt (1:n_tot+n_entries-1))
     prt = prt_tmp (1:n_tot+n_entries-1)
     ! transfer to particle_set
     call particle_set%replace (prt)
     deallocate (prt, prt_tmp)
 
     if (debug_lhef) then
        call particle_set%write ()
        print *, "combine_lhef_with_particle_set"
        ! stop
     end if
 
 200 continue
     return
 
 501 write(*,*) "READING LHEF failed 501"
     return
 502 write(*,*) "READING LHEF failed 502"
     return
 503 write(*,*) "READING LHEF failed 503"
     return
 504 write(*,*) "READING LHEF failed 504"
     return
 505 write(*,*) "READING LHEF failed 505"
     return
   end subroutine combine_lhef_with_particle_set
 
 @ %def combine_lhef_with_particle_set
 @
 <<HEP common: public>>=
   public :: w2p_write_lhef_event
 <<HEP common: procedures>>=
   subroutine w2p_write_lhef_event (unit)
     integer, intent(in) :: unit
     type(xml_tag_t), allocatable :: tag_lhef, tag_head, tag_init, &
          tag_event, tag_gen_n, tag_gen_v
     if (debug_on) call msg_debug (D_EVENTS, "w2p_write_lhef_event")
     allocate (tag_lhef, tag_head, tag_init, tag_event, &
          tag_gen_n, tag_gen_v)
     call tag_lhef%init (var_str ("LesHouchesEvents"), &
          [xml_attribute (var_str ("version"), var_str ("1.0"))], .true.)
     call tag_head%init (var_str ("header"), .true.)
     call tag_init%init (var_str ("init"), .true.)
     call tag_event%init (var_str ("event"), .true.)
     call tag_gen_n%init (var_str ("generator_name"), .true.)
     call tag_gen_v%init (var_str ("generator_version"), .true.)
     call tag_lhef%write (unit); write (unit, *)
     call tag_head%write (unit); write (unit, *)
     write (unit, "(2x)", advance = "no")
     call tag_gen_n%write (var_str ("WHIZARD"), unit)
     write (unit, *)
     write (unit, "(2x)", advance = "no")
     call tag_gen_v%write (var_str ("<<Version>>"), unit)
     write (unit, *)
     call tag_head%close (unit); write (unit, *)
     call tag_init%write (unit); write (unit, *)
     call heprup_write_lhef (unit)
     call tag_init%close (unit); write (unit, *)
     call tag_event%write (unit); write (unit, *)
     call hepeup_write_lhef (unit)
     call tag_event%close (unit); write (unit, *)
     call tag_lhef%close (unit); write (unit, *)
     deallocate (tag_lhef, tag_head, tag_init, tag_event, &
          tag_gen_n, tag_gen_v)
   end subroutine w2p_write_lhef_event
 
 @ %def w2p_write_lhef_event
 @ Extract parameters from the common block.  We leave it to the caller
 to specify which parameters it actually needs.
 
 [[PDFGUP]] and [[PDFSUP]] are not extracted.  [[IDWTUP=1,2]] are not
 supported by \whizard, but correspond to weighted events.
 <<HEP common: public>>=
   public :: heprup_get_run_parameters
 <<HEP common: procedures>>=
   subroutine heprup_get_run_parameters &
        (beam_pdg, beam_energy, n_processes, unweighted, negative_weights)
     integer, dimension(2), intent(out), optional :: beam_pdg
     real(default), dimension(2), intent(out), optional :: beam_energy
     integer, intent(out), optional :: n_processes
     logical, intent(out), optional :: unweighted
     logical, intent(out), optional :: negative_weights
     if (present (beam_pdg))  beam_pdg = IDBMUP
     if (present (beam_energy))  beam_energy = EBMUP
     if (present (n_processes))  n_processes = NPRUP
     if (present (unweighted)) then
        select case (abs (IDWTUP))
        case (3)
           unweighted = .true.
        case (4)
           unweighted = .false.
        case (1,2)  !!! not supported by WHIZARD
           unweighted = .false.
        case default
           call msg_fatal ("HEPRUP: unsupported IDWTUP value")
        end select
     end if
     if (present (negative_weights)) then
        negative_weights = IDWTUP < 0
     end if
   end subroutine heprup_get_run_parameters
 
 @ %def heprup_get_run_parameters
 @ Specify PDF set info.  Since we support only LHAPDF, the group entry
 is zero.
 <<HEP common: public>>=
   public :: heprup_set_lhapdf_id
 <<HEP common: procedures>>=
   subroutine heprup_set_lhapdf_id (i_beam, pdf_id)
     integer, intent(in) :: i_beam, pdf_id
     PDFGUP(i_beam) = 0
     PDFSUP(i_beam) = pdf_id
   end subroutine heprup_set_lhapdf_id
 
 @ %def heprup_set_lhapdf_id
 @ Fill the characteristics for a particular process.  Only the process
 ID is mandatory.  Note that \whizard\ computes cross sections in fb,
 so we have to rescale to pb.  The maximum weight is meaningless for
 unweighted events.
 <<HEP common: public>>=
   public :: heprup_set_process_parameters
 <<HEP common: procedures>>=
   subroutine heprup_set_process_parameters &
        (i, process_id, cross_section, error, max_weight)
     integer, intent(in) :: i, process_id
     real(default), intent(in), optional :: cross_section, error, max_weight
     real(default), parameter :: pb_per_fb = 1.e-3_default
     LPRUP(i) = process_id
     if (present (cross_section)) then
        XSECUP(i) = cross_section * pb_per_fb
     else
        XSECUP(i) = 0
     end if
     if (present (error)) then
        XERRUP(i) = error * pb_per_fb
     else
        XERRUP(i) = 0
     end if
     select case (IDWTUP)
     case (3);  XMAXUP(i) = 1
     case (4)
        if (present (max_weight)) then
           XMAXUP(i) = max_weight * pb_per_fb
        else
           XMAXUP(i) = 0
        end if
     end select
   end subroutine heprup_set_process_parameters
 
 @ %def heprup_set_process_parameters
 @ Extract the process parameters, as far as needed.
 <<HEP common: public>>=
   public :: heprup_get_process_parameters
 <<HEP common: procedures>>=
   subroutine heprup_get_process_parameters  &
        (i, process_id, cross_section, error, max_weight)
     integer, intent(in) :: i
     integer, intent(out), optional :: process_id
     real(default), intent(out), optional :: cross_section, error, max_weight
     real(default), parameter :: pb_per_fb = 1.e-3_default
     if (present (process_id))  process_id = LPRUP(i)
     if (present (cross_section)) then
        cross_section = XSECUP(i) / pb_per_fb
     end if
     if (present (error)) then
        error = XERRUP(i) / pb_per_fb
     end if
     if (present (max_weight)) then
        select case (IDWTUP)
        case (3)
           max_weight = 1
        case (4)
           max_weight = XMAXUP(i) / pb_per_fb
        case (1,2)   !!! not supported by WHIZARD
           max_weight = 0
        case default
           call msg_fatal ("HEPRUP: unsupported IDWTUP value")
        end select
     end if
   end subroutine heprup_get_process_parameters
 
 @ %def heprup_get_process_parameters
 @
 \subsection{Run parameter output (verbose)}
 This is a verbose output of the HEPRUP block.
 <<HEP common: public>>=
   public :: heprup_write_verbose
 <<HEP common: procedures>>=
   subroutine heprup_write_verbose (unit)
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(A)")  "HEPRUP Common Block"
     write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)")  "IDBMUP", IDBMUP, &
          "PDG code of beams"
     write (u, "(3x,A6,' = ',G12.5,1x,G12.5,8x,A)")  "EBMUP ", EBMUP, &
          "Energy of beams in GeV"
     write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)")  "PDFGUP", PDFGUP, &
          "PDF author group [-1 = undefined]"
     write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)")  "PDFSUP", PDFSUP, &
          "PDF set ID       [-1 = undefined]"
     write (u, "(3x,A6,' = ',I9,3x,1x,9x,3x,8x,A)")  "IDWTUP", IDWTUP, &
          "LHA code for event weight mode"
     write (u, "(3x,A6,' = ',I9,3x,1x,9x,3x,8x,A)")  "NPRUP ", NPRUP, &
          "Number of user subprocesses"
     do i = 1, NPRUP
        write (u, "(1x,A,I0)")  "Subprocess #", i
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "XSECUP", XSECUP(i), &
             "Cross section in pb"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "XERRUP", XERRUP(i), &
             "Cross section error in pb"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "XMAXUP", XMAXUP(i), &
             "Maximum event weight (cf. IDWTUP)"
        write (u, "(3x,A6,' = ',I9,3x,1x,12x,8x,A)")  "LPRUP ", LPRUP(i), &
             "Subprocess ID"
     end do
   end subroutine heprup_write_verbose
 
 @ %def heprup_write_verbose
 @
 \subsection{Run parameter output (other formats)}
 This routine writes the initialization block according to the LHEF
 standard.  It uses the current contents of the HEPRUP block.
 <<HEP common: public>>=
   public :: heprup_write_lhef
 <<HEP common: procedures>>=
   subroutine heprup_write_lhef (unit)
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(2(1x,I0),2(1x,ES17.10),6(1x,I0))") &
          IDBMUP, EBMUP, PDFGUP, PDFSUP, IDWTUP, NPRUP
     do i = 1, NPRUP
        write (u, "(3(1x,ES17.10),1x,I0)") &
             XSECUP(i), XERRUP(i), XMAXUP(i), LPRUP(i)
     end do
   end subroutine heprup_write_lhef
 
 @ %def heprup_write_lhef
 @
 This routine is a complete dummy at the moment. It uses the current
 contents of the HEPRUP block. At the end, it should depend on certain
 input flags for the different ASCII event formats.
 <<HEP common: public>>=
   public :: heprup_write_ascii
 <<HEP common: procedures>>=
   subroutine heprup_write_ascii (unit)
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(2(1x,I0),2(1x,ES17.10),6(1x,I0))") &
          IDBMUP, EBMUP, PDFGUP, PDFSUP, IDWTUP, NPRUP
     do i = 1, NPRUP
        write (u, "(3(1x,ES17.10),1x,I0)") &
             XSECUP(i), XERRUP(i), XMAXUP(i), LPRUP(i)
     end do
   end subroutine heprup_write_ascii
 
 @ %def heprup_write_ascii
 @
 \subsubsection{Run parameter input (LHEF)}
 In a LHEF file, the parameters are written in correct order on
 separate lines, but we should not count on the precise format.
 List-directed input should just work.
 <<HEP common: public>>=
   public :: heprup_read_lhef
 <<HEP common: procedures>>=
   subroutine heprup_read_lhef (u)
     integer, intent(in) :: u
     integer :: i
     read (u, *) &
          IDBMUP, EBMUP, PDFGUP, PDFSUP, IDWTUP, NPRUP
     do i = 1, NPRUP
        read (u, *) &
             XSECUP(i), XERRUP(i), XMAXUP(i), LPRUP(i)
     end do
   end subroutine heprup_read_lhef
 
 @ %def heprup_read_lhef
 @
 \subsection{The HEPEUP common block}
 <<HEP common: common blocks>>=
   common /HEPEUP/ &
        NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP, &
        IDUP, ISTUP, MOTHUP, ICOLUP, PUP, VTIMUP, SPINUP
   save /HEPEUP/
 
 @ %def HEPEUP
 @
 \subsubsection{Initialization}
 Fill the event characteristics of the common block.  The
 initialization sets only the number of particles and initializes the
 rest with default values.  The other routine sets the optional
 parameters.
 <<HEP common: public>>=
   public :: hepeup_init
   public :: hepeup_set_event_parameters
 <<HEP common: procedures>>=
   subroutine hepeup_init (n_tot)
     integer, intent(in) :: n_tot
     NUP = n_tot
     IDPRUP = 0
     XWGTUP = 1
     SCALUP = -1
     AQEDUP = -1
     AQCDUP = -1
   end subroutine hepeup_init
 
   subroutine hepeup_set_event_parameters &
        (proc_id, weight, scale, alpha_qed, alpha_qcd)
     integer, intent(in), optional :: proc_id
     real(default), intent(in), optional :: weight, scale, alpha_qed, alpha_qcd
     if (present (proc_id))   IDPRUP = proc_id
     if (present (weight))    XWGTUP = weight
     if (present (scale))     SCALUP = scale
     if (present (alpha_qed)) AQEDUP = alpha_qed
     if (present (alpha_qcd)) AQCDUP = alpha_qcd
   end subroutine hepeup_set_event_parameters
 
 @ %def hepeup_init hepeup_set_event_parameters
 @ Extract event information.  The caller determines the parameters.
 <<HEP common: public>>=
   public :: hepeup_get_event_parameters
 <<HEP common: procedures>>=
   subroutine hepeup_get_event_parameters &
        (proc_id, weight, scale, alpha_qed, alpha_qcd)
     integer, intent(out), optional :: proc_id
     real(default), intent(out), optional :: weight, scale, alpha_qed, alpha_qcd
     if (present (proc_id))   proc_id   = IDPRUP
     if (present (weight))    weight    = XWGTUP
     if (present (scale))     scale     = SCALUP
     if (present (alpha_qed)) alpha_qed = AQEDUP
     if (present (alpha_qcd)) alpha_qcd = AQCDUP
   end subroutine hepeup_get_event_parameters
 
 @ %def hepeup_get_event_parameters
 @
 \subsubsection{Particle data}
 Below we need the particle status codes which are actually defined
 in the [[subevents]] module.
 
 Set the entry for a specific particle.  All parameters are set with
 the exception of lifetime and spin, where default values are stored.
 <<HEP common: public>>=
   public :: hepeup_set_particle
 <<HEP common: procedures>>=
   subroutine hepeup_set_particle (i, pdg, status, parent, col, p, m2)
     integer, intent(in) :: i
     integer, intent(in) :: pdg, status
     integer, dimension(:), intent(in) :: parent
     type(vector4_t), intent(in) :: p
     integer, dimension(2), intent(in) :: col
     real(default), intent(in) :: m2
     if (i > MAXNUP) then
        call msg_error (arr=[ &
             var_str ("Too many particles in HEPEUP common block. " // &
                             "If this happened "), &
             var_str ("during event output, your events will be " // &
                             "invalid; please consider "), &
             var_str ("switching to a modern event format like HEPMC. " // &
                             "If you are not "), &
             var_str ("using an old, HEPEUP based format and " // &
                             "nevertheless get this error,"), &
             var_str ("please notify the WHIZARD developers,") ])
        return
     end if
     IDUP(i) = pdg
     select case (status)
     case (PRT_BEAM);         ISTUP(i) = -9
     case (PRT_INCOMING);     ISTUP(i) = -1
     case (PRT_BEAM_REMNANT); ISTUP(i) =  3
     case (PRT_OUTGOING);     ISTUP(i) =  1
     case (PRT_RESONANT);     ISTUP(i) =  2
     case (PRT_VIRTUAL);      ISTUP(i) =  3
     case default;            ISTUP(i) =  0
     end select
     select case (size (parent))
     case (0);      MOTHUP(:,i) = 0
     case (1);      MOTHUP(1,i) = parent(1); MOTHUP(2,i) = 0
     case default;  MOTHUP(:,i) = [ parent(1), parent(size (parent)) ]
     end select
     if (col(1) > 0) then
        ICOLUP(1,i) = 500 + col(1)
     else
        ICOLUP(1,i) = 0
     end if
     if (col(2) > 0) then
        ICOLUP(2,i) = 500 + col(2)
     else
        ICOLUP(2,i) = 0
     end if
     PUP(1:3,i) = refmt_tiny (vector3_get_components (space_part (p)))
     PUP(4,i) = refmt_tiny (energy (p))
     PUP(5,i) = refmt_tiny (sign (sqrt (abs (m2)), m2))
     VTIMUP(i) = 0
     SPINUP(i) = 9
   end subroutine hepeup_set_particle
 
 @ %def hepeup_set_particle
 @ Set the lifetime, actually $c\tau$ measured im mm, where $\tau$ is
 the invariant lifetime.
 <<HEP common: public>>=
   public :: hepeup_set_particle_lifetime
 <<HEP common: procedures>>=
   subroutine hepeup_set_particle_lifetime (i, lifetime)
     integer, intent(in) :: i
     real(default), intent(in) :: lifetime
     VTIMUP(i) = lifetime
   end subroutine hepeup_set_particle_lifetime
 
 @ %def hepeup_set_particle_lifetime
 @ Set the particle spin entry.  We need the cosine of the angle of the
 spin axis with respect to the three-momentum of the parent particle.
 
 If the particle has a full polarization density matrix given, we need
 the particle momentum and polarization as well as the mother-particle
 momentum.  The polarization is transformed into a spin vector (which
 is sensible only for spin-1/2 or massless particles), which then is
 transformed into the lab frame (by a rotation of the 3-axis to the
 particle momentum axis).  Finally, we compute the scalar product of
 this vector with the mother-particle three-momentum.
 
 This puts severe restrictions on the applicability of this definition,
 and Lorentz invariance is lost.  Unfortunately, the Les Houches Accord
 requires this computation.
 <<HEP common: public>>=
   public :: hepeup_set_particle_spin
 <<HEP common: interfaces>>=
   interface hepeup_set_particle_spin
      module procedure hepeup_set_particle_spin_pol
   end interface
 <<HEP common: procedures>>=
   subroutine hepeup_set_particle_spin_pol (i, p, pol, p_mother)
     integer, intent(in) :: i
     type(vector4_t), intent(in) :: p
     type(polarization_t), intent(in) :: pol
     type(vector4_t), intent(in) :: p_mother
     type(vector3_t) :: s3, p3
     type(vector4_t) :: s4
     s3 = vector3_moving (pol%get_axis ())
     p3 = space_part (p)
     s4 = rotation_to_2nd (3, p3) * vector4_moving (0._default, s3)
     SPINUP(i) = enclosed_angle_ct (s4, p_mother)
   end subroutine hepeup_set_particle_spin_pol
 
 @ %def hepeup_set_particle_spin
 @
 Extract particle data.  The caller decides which ones to retrieve.
 
 Status codes: beam remnants share the status code with virtual particles.
 However, for the purpose of WHIZARD we should identify them.  We
 use the PDG code for this.
 <<HEP common: public>>=
   public :: hepeup_get_particle
 <<HEP common: procedures>>=
   subroutine hepeup_get_particle (i, pdg, status, parent, col, p, m2)
     integer, intent(in) :: i
     integer, intent(out), optional :: pdg, status
     integer, dimension(:), intent(out), optional :: parent
     type(vector4_t), intent(out), optional :: p
     integer, dimension(2), intent(out), optional :: col
     real(default), dimension(5,MAXNUP) :: pup_def
     real(default), intent(out), optional :: m2
     if (present (pdg))  pdg = IDUP(i)
     if (present (status)) then
        select case (ISTUP(i))
        case (-9);  status = PRT_BEAM
        case (-1);  status = PRT_INCOMING
        case (1);   status = PRT_OUTGOING
        case (2);   status = PRT_RESONANT
        case (3);
           select case (abs (IDUP(i)))
           case (HADRON_REMNANT, HADRON_REMNANT_SINGLET, &
                HADRON_REMNANT_TRIPLET, HADRON_REMNANT_OCTET)
              status = PRT_BEAM_REMNANT
           case default
              status = PRT_VIRTUAL
           end select
        case default
           status = PRT_UNDEFINED
        end select
     end if
     if (present (parent)) then
        select case (size (parent))
        case (0)
        case (1);    parent(1) = MOTHUP(1,i)
        case (2);    parent = MOTHUP(:,i)
        end select
     end if
     if (present (col)) then
        col = ICOLUP(:,i)
     end if
     if (present (p)) then
        pup_def = PUP
        p = vector4_moving (pup_def(4,i), vector3_moving (pup_def(1:3,i)))
     end if
     if (present (m2)) then
        m2 = sign (PUP(5,i) ** 2, PUP(5,i))
     end if
   end subroutine hepeup_get_particle
 
 @ %def hepeup_get_particle
 @
 \subsection{The HEPEVT and HEPEV4 common block}
 
 For the LEP Monte Carlos, a standard common block has been proposed
 in AKV89.  We strongly recommend its use.  (The description is an
 abbreviated transcription of AKV89, Vol. 3, pp. 327-330).
 
 [[NMXHEP]] is the maximum number of entries:
 <<HEP common: variables>>=
   integer, parameter :: NMXHEP = 4000
 
 @ %def NMXHEP
 @ [[NEVHEP]] is normally the event number, but may take special
 values as follows:
 
    0   the program does not keep track of event numbers.
   -1   a special initialization record.
   -2   a special final record.
 <<HEP common: variables>>=
   integer :: NEVHEP
 
 @ %def NEVHEP
 @  [[NHEP]] holds the number of entries for this event.
 <<HEP common: variables>>=
   integer, public :: NHEP
 
 @ %def NHEP
 @ The entry [[ISTHEP(N)]] gives the status code for the [[N]]th entry,
 with the following semantics:
    0       a null entry.
    1       an existing entry, which has not decayed or fragmented.
    2       a decayed or fragmented entry, which is retained for
            event history information.
    3       documentation line.
    4- 10   reserved for future standards.
   11-200   at the disposal of each model builder.
  201-      at the disposal of users.
 <<HEP common: variables>>=
   integer, dimension(NMXHEP), public :: ISTHEP
 
 @ %def ISTHEP
 @
 The Particle Data Group has proposed standard particle codes,
 which are to be stored in [[IDHEP(N)]].
 <<HEP common: variables>>=
   integer, dimension(NMXHEP), public :: IDHEP
 
 @ %def IDHEP
 @ [[JMOHEP(1,N)]] points to the mother of the [[N]]th entry, if any.
 It is set to zero for initial entries.
 [[JMOHEP(2,N)]] points to the second mother, if any.
 <<HEP common: variables>>=
   integer, dimension(2, NMXHEP), public :: JMOHEP
 
 @ %def JMOHEP
 @ [[JDAHEP(1,N)]] and [[JDAHEP(2,N)]] point to the first and last daughter
 of the [[N]]th entry, if any.  These are zero for entries which have not
 yet decayed.  The other daughters are stored in between these two.
 <<HEP common: variables>>=
   integer, dimension(2, NMXHEP), public :: JDAHEP
 
 @ %def JDAHEP
 @ In [[PHEP]] we store the momentum of the particle, more specifically
 this means that [[PHEP(1,N)]], [[PHEP(2,N)]], and [[PHEP(3,N)]] contain the
 momentum in the $x$, $y$, and $z$ direction (as defined by the machine
 people), measured in GeV/c.  [[PHEP(4,N)]] contains the energy in GeV
 and [[PHEP(5,N)]] the mass in GeV$/c^2$.  The latter may be negative for
 spacelike partons.
 <<HEP common: variables>>=
   double precision, dimension(5, NMXHEP), public :: PHEP
 
 @ %def PHEP
 @ Finally [[VHEP]] is the place to store the position of the production
 vertex.  [[VHEP(1,N)]], [[VHEP(2,N)]], and [[VHEP(3,N)]] contain the $x$, $y$,
 and $z$ coordinate (as defined by the machine people), measured in mm.
 [[VHEP(4,N)]] contains the production time in mm/c.
 <<HEP common: variables>>=
   double precision, dimension(4, NMXHEP) :: VHEP
 
 @ %def VHEP
 @ As an amendment to the proposed standard common block HEPEVT, we
 also have a polarisation common block HEPSPN, as described in
 AKV89.  [[SHEP(1,N)]], [[SHEP(2,N)]], and [[SHEP(3,N)]] give the $x$, $y$, and $z$
 component of the spinvector $s$ of a fermion in the fermions restframe.
 
 Furthermore, we add the polarization of the corresponding outgoing
 particles:
 <<HEP common: variables>>=
   integer, dimension(NMXHEP) :: hepevt_pol
 
 @ %def hepevt_pol
 @
 By this variable the identity of the current process is given, defined
 via the LPRUP codes.
 <<HEP common: variables>>=
   integer, public :: idruplh
 
 @ %def idruplh
 This is the event weight, i.e. the cross section divided by the total
 number of generated events for the output of the parton shower programs.
 <<HEP common: variables>>=
   double precision, public :: eventweightlh
 
 @ %def eventweightlh
 @ There are the values for the electromagnetic and the strong coupling
 constants, $\alpha_{em}$ and $\alpha_s$.
 <<HEP common: variables>>=
   double precision, public :: alphaqedlh, alphaqcdlh
 
 @ %def alphaqedlh, alphaqcdlh
 @ This is the squared scale $Q$ of the event.
 <<HEP common: variables>>=
   double precision, dimension(10), public :: scalelh
 
 @ %def scalelh
 @ Finally, these variables contain the spin information and the
 color/anticolor flow of the particles.
 <<HEP common: variables>>=
   double precision, dimension (3,NMXHEP), public :: spinlh
   integer, dimension (2,NMXHEP), public :: icolorflowlh
 
 @ %def spinlh icolorflowlh
 By convention, [[SHEP(4,N)]] is always 1. All this is taken from StdHep
 4.06 manual and written using Fortran90 conventions.
 <<HEP common: common blocks>>=
   common /HEPEVT/ &
        NEVHEP, NHEP, ISTHEP, IDHEP, &
        JMOHEP, JDAHEP, PHEP, VHEP
   save /HEPEVT/
 
 @ %def HEPEVT
 @ Here we store HEPEVT parameters of the WHIZARD 1 realization which
 are not part of the HEPEVT common block.
 <<HEP common: variables>>=
   integer :: hepevt_n_out, hepevt_n_remnants
 
 @ %def hepevt_n_out, hepevt_n_remnants
 @
 <<HEP common: variables>>=
   double precision :: hepevt_weight, hepevt_function_value
   double precision :: hepevt_function_ratio
 
 @ %def hepevt_weight hepevt_function_value
 @ The HEPEV4 common block is an extension of the HEPEVT common block
 to allow for partonic colored events, including especially the color
 flow etc.
 <<HEP common: common blocks>>=
   common /HEPEV4/ &
        eventweightlh, alphaqedlh, alphaqcdlh, scalelh, &
        spinlh, icolorflowlh, idruplh
   save /HEPEV4/
 
 @ %def HEPEV4
 @ Filling HEPEVT: If the event count is not provided, set [[NEVHEP]]
 to zero.  If the event count is [[-1]] or [[-2]], the record
 corresponds to initialization and finalization, and the event is
 irrelevant.
 
 Note that the event count may be larger than $2^{31}$ (2 GEvents).  In
 that case, cut off the upper bits since [[NEVHEP]] is probably limited
 to default integer.
 
 For the HEPEV4 common block, it is unclear why the [[scalelh]] variable
 is 10-dimensional. We choose to only set the first value of the array.
 <<HEP common: public>>=
   public :: hepevt_init
   public :: hepevt_set_event_parameters
 <<HEP common: procedures>>=
   subroutine hepevt_init (n_tot, n_out)
     integer, intent(in) :: n_tot, n_out
     NHEP              = n_tot
     NEVHEP            = 0
     idruplh           = 0
     hepevt_n_out      = n_out
     hepevt_n_remnants = 0
     hepevt_weight     = 1
     eventweightlh     = 1
     hepevt_function_value = 0
     hepevt_function_ratio = 1
     alphaqcdlh        = -1
     alphaqedlh        = -1
     scalelh           = -1
   end subroutine hepevt_init
 
   subroutine hepevt_set_event_parameters &
        (proc_id, weight, function_value, function_ratio, &
        alpha_qcd, alpha_qed, scale, i_evt)
     integer, intent(in), optional :: proc_id
     integer, intent(in), optional :: i_evt
     real(default), intent(in), optional :: weight, function_value, &
        function_ratio, alpha_qcd, alpha_qed, scale
     if (present (proc_id))  idruplh = proc_id
     if (present (i_evt))  NEVHEP = i_evt
     if (present (weight)) then
        hepevt_weight = weight
        eventweightlh = weight
     end if
     if (present (function_value)) hepevt_function_value = &
          function_value
     if (present (function_ratio)) hepevt_function_ratio = &
          function_ratio
     if (present (alpha_qcd))  alphaqcdlh = alpha_qcd
     if (present (alpha_qed))  alphaqedlh = alpha_qed
     if (present (scale))  scalelh(1) = scale
     if (present (i_evt))  NEVHEP = i_evt
   end subroutine hepevt_set_event_parameters
 
 @ %def hepevt_init hepevt_set_event_parameters
 @ Set the entry for a specific particle.  All parameters are set with
 the exception of lifetime and spin, where default values are stored.
 <<HEP common: public>>=
   public :: hepevt_set_particle
 <<HEP common: procedures>>=
   subroutine hepevt_set_particle &
        (i, pdg, status, parent, child, p, m2, hel, vtx, &
        col, pol_status, pol, fill_hepev4)
     integer, intent(in) :: i
     integer, intent(in) :: pdg, status
     integer, dimension(:), intent(in) :: parent
     integer, dimension(:), intent(in) :: child
     logical, intent(in), optional :: fill_hepev4
     type(vector4_t), intent(in) :: p
     real(default), intent(in) :: m2
     integer, dimension(2), intent(in) :: col
     integer, intent(in) :: pol_status
     integer, intent(in) :: hel
     type(polarization_t), intent(in), optional :: pol
     type(vector4_t), intent(in) :: vtx
     logical :: hepev4
     hepev4 = .false.; if (present (fill_hepev4))  hepev4 = fill_hepev4
     IDHEP(i) = pdg
     select case (status)
       case (PRT_BEAM);      ISTHEP(i) = 2
       case (PRT_INCOMING);  ISTHEP(i) = 2
       case (PRT_OUTGOING);  ISTHEP(i) = 1
       case (PRT_VIRTUAL);   ISTHEP(i) = 2
       case (PRT_RESONANT);  ISTHEP(i) = 2
       case default;         ISTHEP(i) = 0
     end select
     select case (size (parent))
     case (0);      JMOHEP(:,i) = 0
     case (1);      JMOHEP(1,i) = parent(1); JMOHEP(2,i) = 0
     case default;  JMOHEP(:,i) = [ parent(1), parent(size (parent)) ]
     end select
     select case (size (child))
     case (0);      JDAHEP(:,i) = 0
     case (1);      JDAHEP(:,i) = child(1)
     case default;  JDAHEP(:,i) = [ child(1), child(size (child)) ]
     end select
     PHEP(1:3,i) = refmt_tiny (vector3_get_components (space_part (p)))
     PHEP(4,i) = refmt_tiny (energy (p))
     PHEP(5,i) = refmt_tiny (sign (sqrt (abs (m2)), m2))
     VHEP(1:3,i) = vtx%p(1:3)
     VHEP(4,i) = vtx%p(0)
     hepevt_pol(i) = hel
     if (hepev4) then
        if (col(1) > 0) then
           icolorflowlh(1,i) = 500 + col(1)
        else
           icolorflowlh(1,i) = 0
        end if
        if (col(2) > 0) then
           icolorflowlh(2,i) = 500 + col(2)
        else
           icolorflowlh(2,i) = 0
        end if
        if (present (pol) .and. &
             pol_status == PRT_GENERIC_POLARIZATION) then
           if (pol%is_polarized ()) &
              spinlh(:,i) = pol%get_axis ()
        else
           spinlh(:,i) = zero
           spinlh(3,i) = hel
        end if
     end if
   end subroutine hepevt_set_particle
 
 @ %def hepevt_set_particle
 @
 \subsection{Event output}
 This is a verbose output of the HEPEVT block.
 <<HEP common: public>>=
   public :: hepevt_write_verbose
 <<HEP common: procedures>>=
   subroutine hepevt_write_verbose (unit)
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(A)")  "HEPEVT Common Block"
     write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)")  "NEVHEP", NEVHEP, &
          "Event number"
     write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)")  "NHEP  ", NHEP, &
          "Number of particles in event"
     do i = 1, NHEP
        write (u, "(1x,A,I0)")  "Particle #", i
        write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)", advance="no") &
             "ISTHEP", ISTHEP(i), "Status code: "
        select case (ISTHEP(i))
        case ( 0);  write (u, "(A)")  "null entry"
        case ( 1);  write (u, "(A)")  "outgoing"
        case ( 2);  write (u, "(A)")  "decayed"
        case ( 3);  write (u, "(A)")  "documentation"
        case (4:10);  write (u, "(A)")  "[unspecified]"
        case (11:200);  write (u, "(A)")  "[model-specific]"
        case (201:);  write (u, "(A)")  "[user-defined]"
        case default;  write (u, "(A)")  "[undefined]"
        end select
        write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)")  "IDHEP ", IDHEP(i), &
             "PDG code of particle"
        write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)")  "JMOHEP", JMOHEP(:,i), &
             "Index of first/second mother"
        write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)")  "JDAHEP", JDAHEP(:,i), &
             "Index of first/last daughter"
        write (u, "(3x,A6,' = ',ES12.5,1x,ES12.5,8x,A)")  "PHEP12", &
             PHEP(1:2,i), "Transversal momentum (x/y) in GeV"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "PHEP3 ", PHEP(3,i), &
             "Longitudinal momentum (z) in GeV"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "PHEP4 ", PHEP(4,i), &
             "Energy in GeV"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "PHEP5 ", PHEP(5,i), &
             "Invariant mass in GeV"
        write (u, "(3x,A6,' = ',ES12.5,1x,ES12.5,8x,A)")  "VHEP12", VHEP(1:2,i), &
             "Transversal displacement (xy) in mm"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "VHEP3 ", VHEP(3,i), &
             "Longitudinal displacement (z) in mm"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "VHEP4 ", VHEP(4,i), &
             "Production time in mm"
     end do
   end subroutine hepevt_write_verbose
 
 @ %def hepevt_write_verbose
 @
 This is a verbose output of the HEPEUP block.
 <<HEP common: public>>=
   public :: hepeup_write_verbose
 <<HEP common: procedures>>=
   subroutine hepeup_write_verbose (unit)
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(A)")  "HEPEUP Common Block"
     write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)")  "NUP   ", NUP, &
          "Number of particles in event"
     write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)")  "IDPRUP", IDPRUP, &
          "Subprocess ID"
     write (u, "(3x,A6,' = ',ES12.5,1x,20x,A)")  "XWGTUP", XWGTUP, &
          "Event weight"
     write (u, "(3x,A6,' = ',ES12.5,1x,20x,A)")  "SCALUP", SCALUP, &
          "Event energy scale in GeV"
     write (u, "(3x,A6,' = ',ES12.5,1x,20x,A)")  "AQEDUP", AQEDUP, &
          "QED coupling [-1 = undefined]"
     write (u, "(3x,A6,' = ',ES12.5,1x,20x,A)")  "AQCDUP", AQCDUP, &
          "QCD coupling [-1 = undefined]"
     do i = 1, NUP
        write (u, "(1x,A,I0)")  "Particle #", i
        write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)")  "IDUP  ", IDUP(i), &
             "PDG code of particle"
        write (u, "(3x,A6,' = ',I9,3x,1x,20x,A)", advance="no") &
             "ISTUP ", ISTUP(i), "Status code: "
        select case (ISTUP(i))
        case (-1);  write (u, "(A)")  "incoming"
        case ( 1);  write (u, "(A)")  "outgoing"
        case (-2);  write (u, "(A)")  "spacelike"
        case ( 2);  write (u, "(A)")  "resonance"
        case ( 3);  write (u, "(A)")  "resonance (doc)"
        case (-9);  write (u, "(A)")  "beam"
        case default;  write (u, "(A)")  "[undefined]"
        end select
        write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)")  "MOTHUP", MOTHUP(:,i), &
             "Index of first/last mother"
        write (u, "(3x,A6,' = ',I9,3x,1x,I9,3x,8x,A)")  "ICOLUP", ICOLUP(:,i), &
             "Color/anticolor flow index"
        write (u, "(3x,A6,' = ',ES12.5,1x,ES12.5,8x,A)")  "PUP1/2", PUP(1:2,i), &
             "Transversal momentum (x/y) in GeV"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "PUP3  ", PUP(3,i), &
             "Longitudinal momentum (z) in GeV"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "PUP4  ", PUP(4,i), &
             "Energy in GeV"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "PUP5  ", PUP(5,i), &
             "Invariant mass in GeV"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "VTIMUP", VTIMUP(i), &
             "Invariant lifetime in mm"
        write (u, "(3x,A6,' = ',ES12.5,1x,12x,8x,A)")  "SPINUP", SPINUP(i), &
             "cos(spin angle) [9 = undefined]"
     end do
   end subroutine hepeup_write_verbose
 
 @ %def hepeup_write_verbose
 @
 \subsection{Event output in various formats}
 This routine writes event output according to the LHEF standard.  It
 uses the current contents of the HEPEUP block.
 <<HEP common: public>>=
   public :: hepeup_write_lhef
   public :: hepeup_write_lha
 <<HEP common: procedures>>=
   subroutine hepeup_write_lhef (unit)
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     if (debug_on) call msg_debug (D_EVENTS, "hepeup_write_lhef")
     if (debug_on) call msg_debug2 (D_EVENTS, "ID IST MOTH ICOL P VTIM SPIN")
     write (u, "(2(1x,I0),4(1x,ES17.10))") &
          NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP
     do i = 1, NUP
        write (u, "(6(1x,I0),7(1x,ES17.10))") &
             IDUP(i), ISTUP(i), MOTHUP(:,i), ICOLUP(:,i), &
             PUP(:,i), VTIMUP(i), SPINUP(i)
        if (debug2_active (D_EVENTS)) then
           write (msg_buffer, "(6(1x,I0),7(1x,ES17.10))") &
                IDUP(i), ISTUP(i), MOTHUP(:,i), ICOLUP(:,i), &
                PUP(:,i), VTIMUP(i), SPINUP(i)
           call msg_message ()
        end if
     end do
   end subroutine hepeup_write_lhef
 
   subroutine hepeup_write_lha (unit)
     integer, intent(in), optional :: unit
     integer :: u, i
     integer, dimension(MAXNUP) :: spin_up
     spin_up = int(SPINUP)
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(2(1x,I5),1x,ES17.10,3(1x,ES13.6))") &
          NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP
     write (u, "(500(1x,I5))") IDUP(:NUP)
     write (u, "(500(1x,I5))") MOTHUP(1,:NUP)
     write (u, "(500(1x,I5))") MOTHUP(2,:NUP)
     write (u, "(500(1x,I5))") ICOLUP(1,:NUP)
     write (u, "(500(1x,I5))") ICOLUP(2,:NUP)
     write (u, "(500(1x,I5))") ISTUP(:NUP)
     write (u, "(500(1x,I5))") spin_up(:NUP)
     do i = 1, NUP
             write (u, "(1x,I5,4(1x,ES17.10))") i, PUP([ 4,1,2,3 ], i)
     end do
 
   end subroutine hepeup_write_lha
 
 @ %def hepeup_write_lhef hepeup_write_lha
 @ This routine writes event output according to the HEPEVT standard.  It
 uses the current contents of the HEPEVT block and some additional
 parameters according to the standard in WHIZARD 1. For the long ASCII
 format, the value of the sample function (i.e. the product of squared
 matrix element, structure functions and phase space factor is printed out).
 The option of reweighting matrix elements with respect to some
 reference cross section is not implemented in WHIZARD 2 for this event
 format, therefore the second entry in the long ASCII format (the
 function ratio) is always one. The ATHENA format is an implementation
 of the HEPEVT format that is readable by the ATLAS ATHENA software
 framework. It is very similar to the WHIZARD 1 HEPEVT format, except
 that it contains an event counter, a particle counter inside the
 event, and has the HEPEVT [[ISTHEP]] status before the PDG code. The
 MOKKA format is a special ASCII format  that contains the information
 to be parsed to the MOKKA LC fast simulation software.
 <<HEP common: public>>=
   public :: hepevt_write_hepevt
   public :: hepevt_write_ascii
   public :: hepevt_write_athena
   public :: hepevt_write_mokka
 <<HEP common: procedures>>=
   subroutine hepevt_write_hepevt (unit)
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(3(1x,I0),(1x,ES17.10))") &
          NHEP, hepevt_n_out, hepevt_n_remnants, hepevt_weight
     do i = 1, NHEP
        write (u, "(7(1x,I0))") &
             ISTHEP(i), IDHEP(i), JMOHEP(:,i), JDAHEP(:,i), hepevt_pol(i)
        write (u, "(5(1x,ES17.10))") PHEP(:,i)
        write (u, "(5(1x,ES17.10))") VHEP(:,i), 0.d0
     end do
   end subroutine hepevt_write_hepevt
 
   subroutine hepevt_write_ascii (unit, long)
     integer, intent(in), optional :: unit
     logical, intent(in) :: long
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(3(1x,I0),(1x,ES17.10))") &
          NHEP, hepevt_n_out, hepevt_n_remnants, hepevt_weight
     do i = 1, NHEP
        if (ISTHEP(i) /= 1)  cycle
        write (u, "(2(1x,I0))") IDHEP(i), hepevt_pol(i)
        write (u, "(5(1x,ES17.10))") PHEP(:,i)
     end do
     if (long) then
        write (u, "(2(1x,ES17.10))") &
             hepevt_function_value, hepevt_function_ratio
     end if
   end subroutine hepevt_write_ascii
 
   subroutine hepevt_write_athena (unit)
     integer, intent(in), optional :: unit
     integer :: u, i, num_event
     num_event = 0
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(2(1x,I0))") NEVHEP, NHEP
     do i = 1, NHEP
        write (u, "(7(1x,I0))") &
             i, ISTHEP(i), IDHEP(i), JMOHEP(:,i), JDAHEP(:,i)
        write (u, "(5(1x,ES17.10))") PHEP(:,i)
        write (u, "(5(1x,ES17.10))") VHEP(1:4,i)
     end do
   end subroutine hepevt_write_athena
 
   subroutine hepevt_write_mokka (unit)
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(3(1x,I0),(1x,ES17.10))") &
          NHEP, hepevt_n_out, hepevt_n_remnants, hepevt_weight
     do i = 1, NHEP
        write (u, "(4(1x,I0),4(1x,ES17.10))") &
             ISTHEP(i), IDHEP(i), JDAHEP(1,i), JDAHEP(2,i), &
             PHEP(1:3,i), PHEP(5,i)
     end do
   end subroutine hepevt_write_mokka
 
 @ %def hepevt_write_hepevt hepevt_write_ascii
 @ %def hepevt_write_athena
 @
 \subsection{Event input in various formats}
 This routine writes event output according to the LHEF standard.  It
 uses the current contents of the HEPEUP block.
 <<HEP common: public>>=
   public :: hepeup_read_lhef
 <<HEP common: procedures>>=
   subroutine hepeup_read_lhef (u)
     integer, intent(in) :: u
     integer :: i
     read (u, *) &
          NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP
     do i = 1, NUP
        read (u, *) &
             IDUP(i), ISTUP(i), MOTHUP(:,i), ICOLUP(:,i), &
             PUP(:,i), VTIMUP(i), SPINUP(i)
     end do
   end subroutine hepeup_read_lhef
 
 @ %def hepeup_read_lhef
 @
 \subsection{Data Transfer: particle sets}
 The \whizard\ format for handling particle data in events is
 [[particle_set_t]].  We have to interface this to the common blocks.
 
 We first create a new particle set that contains only the particles
 that are supported by the LHEF format.  These are: beam, incoming,
 resonant, outgoing.  We drop particles with unknown, virtual or
 beam-remnant status.
 
 From this set we fill the common block.  Event information such as
 process ID and weight is not transferred here; this has to be done by
 the caller.  The spin information is set only if the particle has a
 unique mother, and if its polarization is fully defined.
 
 We use this routine also to hand over information to Pythia which lets
 Tauola access SPINUP. Tauola expects in SPINUP the helicity and not the
 LHA convention. We switch to this mode with [[tauola_convention]].
 <<HEP common: public>>=
   public :: hepeup_from_particle_set
 <<HEP common: procedures>>=
   subroutine hepeup_from_particle_set (pset_in, &
      keep_beams, keep_remnants, tauola_convention)
     type(particle_set_t), intent(in) :: pset_in
     type(particle_set_t), target :: pset
     logical, intent(in), optional :: keep_beams
     logical, intent(in), optional :: keep_remnants
     logical, intent(in), optional :: tauola_convention
     integer :: i, n_parents, status, n_tot
     integer, dimension(1) :: i_mother
     logical :: kr, tc
     kr = .true.;  if (present (keep_remnants))  kr = keep_remnants
     tc = .false.;  if (present (tauola_convention))  tc = tauola_convention
     call pset_in%filter_particles (pset, real_parents = .true. , &
        keep_beams = keep_beams, keep_virtuals = .false.)
     n_tot = pset%get_n_tot ()
     call hepeup_init (n_tot)
     do i = 1, n_tot
        associate (prt => pset%prt(i))
          status = prt%get_status ()
          if (kr .and. status == PRT_BEAM_REMNANT &
                 .and. prt%get_n_children () == 0) &
               status = PRT_OUTGOING
          call hepeup_set_particle (i, &
               prt%get_pdg (), &
               status, &
               prt%get_parents (), &
               prt%get_color (), &
               prt%get_momentum (), &
               prt%get_p2 ())
          n_parents = prt%get_n_parents ()
          call hepeup_set_particle_lifetime (i, &
               prt%get_lifetime ())
          if (.not. tc) then
             if (n_parents == 1) then
                i_mother = prt%get_parents ()
                select case (prt%get_polarization_status ())
                case (PRT_GENERIC_POLARIZATION)
                   call hepeup_set_particle_spin (i, &
                        prt%get_momentum (), &
                        prt%get_polarization (), &
                        pset%prt(i_mother(1))%get_momentum ())
                end select
             end if
          else
             select case (prt%get_polarization_status ())
             case (PRT_DEFINITE_HELICITY)
               SPINUP(i) = prt%get_helicity()
             end select
          end if
        end associate
     end do
   end subroutine hepeup_from_particle_set
 
 @ %def hepeup_from_particle_set
 @ Input.  The particle set should be allocated properly, but we
 replace the particle contents.
 
 If there are no beam particles in the event, we try to reconstruct beam
 particles and beam remnants.  We assume for simplicity that the beam
 particles, if any, are the first two particles.  If they are absent, the first
 two particles should be the incoming partons.
 <<HEP common: public>>=
   public :: hepeup_to_particle_set
 <<HEP common: procedures>>=
   subroutine hepeup_to_particle_set &
        (particle_set, recover_beams, model, alt_model)
     type(particle_set_t), intent(inout), target :: particle_set
     logical, intent(in), optional :: recover_beams
     class(model_data_t), intent(in), target :: model, alt_model
     type(particle_t), dimension(:), allocatable :: prt
     integer, dimension(2) :: parent
     integer, dimension(:), allocatable :: child
     integer :: i, j, k, pdg, status
     type(flavor_t) :: flv
     type(color_t) :: col
     integer, dimension(2) :: c
     type(vector4_t) :: p
     real(default) :: p2
     logical :: reconstruct
     integer :: off
     if (present (recover_beams)) then
        reconstruct = recover_beams .and. .not. all (ISTUP(1:2) == PRT_BEAM)
     else
        reconstruct = .false.
     end if
     if (reconstruct) then
        off = 4
     else
        off = 0
     end if
     allocate (prt (NUP + off), child (NUP + off))
     do i = 1, NUP
        k = i + off
        call hepeup_get_particle (i, pdg, status, col = c, p = p, m2 = p2)
        call flv%init (pdg, model, alt_model)
        call prt(k)%set_flavor (flv)
        call prt(k)%reset_status (status)
        call col%init (c)
        call prt(k)%set_color (col)
        call prt(k)%set_momentum (p, p2)
        where (MOTHUP(:,i) /= 0)
           parent = MOTHUP(:,i) + off
        elsewhere
           parent = 0
        end where
        call prt(k)%set_parents (parent)
        child = [(j, j = 1 + off, NUP + off)]
        where (MOTHUP(1,:NUP) /= i .and. MOTHUP(2,:NUP) /= i)  child = 0
        call prt(k)%set_children (child)
     end do
     if (reconstruct) then
        do k = 1, 2
           call prt(k)%reset_status (PRT_BEAM)
           call prt(k)%set_children ([k+2,k+4])
        end do
        do k = 3, 4
           call prt(k)%reset_status (PRT_BEAM_REMNANT)
           call prt(k)%set_parents ([k-2])
        end do
        do k = 5, 6
           call prt(k)%set_parents ([k-4])
        end do
     end if
     call particle_set%replace (prt)
   end subroutine hepeup_to_particle_set
 
 @ %def hepeup_to_particle_set
 @
 The HEPEVT common block is quite similar, but does contain less
 information, e.g. no color flows (it was LEP time). The spin
 information is set only if the particle has a unique mother, and if
 its polarization is fully defined.
 <<HEP common: public>>=
   public :: hepevt_from_particle_set
 <<HEP common: procedures>>=
   subroutine hepevt_from_particle_set &
        (particle_set, keep_beams, keep_remnants, ensure_order, fill_hepev4)
     type(particle_set_t), intent(in) :: particle_set
     type(particle_set_t), target :: pset_hepevt, pset_tmp
     logical, intent(in), optional :: keep_beams
     logical, intent(in), optional :: keep_remnants
     logical, intent(in), optional :: ensure_order
     logical, intent(in), optional :: fill_hepev4
     integer :: i, status, n_tot
     logical :: activate_remnants, ensure
     activate_remnants = .true.
     if (present (keep_remnants))  activate_remnants = keep_remnants
     ensure = .false.
     if (present (ensure_order))  ensure = ensure_order
     call particle_set%filter_particles (pset_tmp, real_parents = .true., &
        keep_virtuals = .false., keep_beams = keep_beams)
     if (ensure) then
        call pset_tmp%to_hepevt_form (pset_hepevt)
     else
        pset_hepevt = pset_tmp
     end if
     n_tot = pset_hepevt%get_n_tot ()
     call hepevt_init (n_tot, pset_hepevt%get_n_out ())
     do i = 1, n_tot
        associate (prt => pset_hepevt%prt(i))
          status = prt%get_status ()
          if (activate_remnants &
               .and. status == PRT_BEAM_REMNANT &
               .and. prt%get_n_children () == 0) &
               status = PRT_OUTGOING
          select case (prt%get_polarization_status ())
          case (PRT_GENERIC_POLARIZATION)
             call hepevt_set_particle (i, &
                  prt%get_pdg (), status, &
                  prt%get_parents (), &
                  prt%get_children (), &
                  prt%get_momentum (), &
                  prt%get_p2 (), &
                  prt%get_helicity (), &
                  prt%get_vertex (), &
                  prt%get_color (), &
                  prt%get_polarization_status (), &
                  pol = prt%get_polarization (), &
                  fill_hepev4 = fill_hepev4)
          case default
             call hepevt_set_particle (i, &
                  prt%get_pdg (), status, &
                  prt%get_parents (), &
                  prt%get_children (), &
                  prt%get_momentum (), &
                  prt%get_p2 (), &
                  prt%get_helicity (), &
                  prt%get_vertex (), &
                  prt%get_color (), &
                  prt%get_polarization_status (), &
                  fill_hepev4 = fill_hepev4)
          end select
        end associate
     end do
     call pset_hepevt%final ()
   end subroutine hepevt_from_particle_set
 
 @ %def hepevt_from_particle_set
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{HepMC events}
 This section provides the interface to the HepMC C++ library for handling
 Monte-Carlo events.
 
 Each C++ class of HepMC that we use is mirrored by a Fortran type,
 which contains as its only component the C pointer to the C++ object.
 
 Each C++ method of HepMC that we use has a C wrapper function.  This
 function takes a pointer to the host object as its first argument.
 Further arguments are either C pointers, or in the case of simple
 types (integer, real), interoperable C/Fortran objects.
 
 The C wrapper functions have explicit interfaces in the Fortran
 module.  They are called by Fortran wrapper procedures.  These are
 treated as methods of the corresponding Fortran type.
 <<[[hepmc_interface.f90]]>>=
 <<File header>>
 
 module hepmc_interface
 
   use, intrinsic :: iso_c_binding !NODEP!
 
 <<Use kinds>>
 <<Use strings>>
   use constants, only: PI
   use system_dependencies, only: HEPMC2_AVAILABLE
   use system_dependencies, only: HEPMC3_AVAILABLE
   use diagnostics
   use lorentz
   use flavors
   use colors
   use helicities
   use polarizations
 
 <<Standard module head>>
 
 <<HepMC interface: public>>
 
 <<HepMC interface: types>>
 
 <<HepMC interface: parameters>>
 
 <<HepMC interface: interfaces>>
 
 contains
 
 <<HepMC interface: procedures>>
 
 end module hepmc_interface
 @ %def hepmc_interface
 @
 \subsection{Interface check}
 This function can be called in order to verify that we are using the
 actual HepMC library, and not the dummy version.
 <<HepMC interface: interfaces>>=
   interface
      logical(c_bool) function hepmc_available () bind(C)
        import
      end function hepmc_available
   end interface
 <<HepMC interface: public>>=
   public :: hepmc_is_available
 <<HepMC interface: procedures>>=
   function hepmc_is_available () result (flag)
     logical :: flag
     flag = hepmc_available ()
   end function hepmc_is_available
 
 @ %def hepmc_is_available
 @
 \subsection{FourVector}
 The C version of four-vectors is often transferred by value, and the
 associated procedures are all inlined.  The wrapper needs to transfer
 by reference, so we create FourVector objects on the heap which have
 to be deleted explicitly.  The input is a [[vector4_t]] or
 [[vector3_t]] object from the [[lorentz]] module.
 <<HepMC interface: public>>=
   public :: hepmc_four_vector_t
 <<HepMC interface: types>>=
   type :: hepmc_four_vector_t
      private
      type(c_ptr) :: obj
   end type hepmc_four_vector_t
 
 @ %def hepmc_four_vector_t
 @ In the C constructor, the zero-component (fourth argument) is
 optional; if missing, it is set to zero.  The Fortran version has
 initializer form and takes either a three-vector or a four-vector.
 A further version extracts the four-vector from a HepMC particle
 object.
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function new_four_vector_xyz (x, y, z) bind(C)
        import
        real(c_double), value :: x, y, z
      end function new_four_vector_xyz
   end interface
   interface
      type(c_ptr) function new_four_vector_xyzt (x, y, z, t) bind(C)
        import
        real(c_double), value :: x, y, z, t
      end function new_four_vector_xyzt
   end interface
 @ %def new_four_vector_xyz new_four_vector_xyzt
 <<HepMC interface: public>>=
   public :: hepmc_four_vector_init
 <<HepMC interface: interfaces>>=
   interface hepmc_four_vector_init
      module procedure hepmc_four_vector_init_v4
      module procedure hepmc_four_vector_init_v3
      module procedure hepmc_four_vector_init_hepmc_prt
   end interface
 <<HepMC interface: procedures>>=
   subroutine hepmc_four_vector_init_v4 (pp, p)
     type(hepmc_four_vector_t), intent(out) :: pp
     type(vector4_t), intent(in) :: p
     real(default), dimension(0:3) :: pa
     pa = vector4_get_components (p)
     pp%obj = new_four_vector_xyzt &
          (real (pa(1), c_double), &
           real (pa(2), c_double), &
           real (pa(3), c_double), &
           real (pa(0), c_double))
   end subroutine hepmc_four_vector_init_v4
 
   subroutine hepmc_four_vector_init_v3 (pp, p)
     type(hepmc_four_vector_t), intent(out) :: pp
     type(vector3_t), intent(in) :: p
     real(default), dimension(3) :: pa
     pa = vector3_get_components (p)
     pp%obj = new_four_vector_xyz &
          (real (pa(1), c_double), &
           real (pa(2), c_double), &
           real (pa(3), c_double))
   end subroutine hepmc_four_vector_init_v3
 
   subroutine hepmc_four_vector_init_hepmc_prt (pp, prt)
     type(hepmc_four_vector_t), intent(out) :: pp
     type(hepmc_particle_t), intent(in) :: prt
     pp%obj = gen_particle_momentum (prt%obj)
   end subroutine hepmc_four_vector_init_hepmc_prt
 
 @ %def hepmc_four_vector_init
 @ Here, the destructor is explicitly needed.
 <<HepMC interface: interfaces>>=
   interface
      subroutine four_vector_delete (p_obj) bind(C)
        import
        type(c_ptr), value :: p_obj
      end subroutine four_vector_delete
   end interface
 @ %def four_vector_delete
 <<HepMC interface: public>>=
   public :: hepmc_four_vector_final
 <<HepMC interface: procedures>>=
   subroutine hepmc_four_vector_final (p)
     type(hepmc_four_vector_t), intent(inout) :: p
     call four_vector_delete (p%obj)
   end subroutine hepmc_four_vector_final
 
 @ %def hepmc_four_vector_final
 @ Convert to a Lorentz vector.
 <<HepMC interface: interfaces>>=
   interface
      function four_vector_px (p_obj) result (px) bind(C)
        import
        real(c_double) :: px
        type(c_ptr), value :: p_obj
      end function four_vector_px
   end interface
   interface
      function four_vector_py (p_obj) result (py) bind(C)
        import
        real(c_double) :: py
        type(c_ptr), value :: p_obj
      end function four_vector_py
   end interface
   interface
      function four_vector_pz (p_obj) result (pz) bind(C)
        import
        real(c_double) :: pz
        type(c_ptr), value :: p_obj
      end function four_vector_pz
   end interface
   interface
      function four_vector_e (p_obj) result (e) bind(C)
        import
        real(c_double) :: e
        type(c_ptr), value :: p_obj
      end function four_vector_e
   end interface
 @ %def four_vector_px four_vector_py four_vector_pz four_vector_e
 <<HepMC interface: public>>=
   public :: hepmc_four_vector_to_vector4
 <<HepMC interface: procedures>>=
   subroutine hepmc_four_vector_to_vector4 (pp, p)
     type(hepmc_four_vector_t), intent(in) :: pp
     type(vector4_t), intent(out) :: p
     real(default) :: E
     real(default), dimension(3) :: p3
     E = four_vector_e (pp%obj)
     p3(1) = four_vector_px (pp%obj)
     p3(2) = four_vector_py (pp%obj)
     p3(3) = four_vector_pz (pp%obj)
     p = vector4_moving (E, vector3_moving (p3))
   end subroutine hepmc_four_vector_to_vector4
 
 @ %def hepmc_four_vector_to_vector4
 @
 \subsection{Polarization}
 Polarization objects are temporarily used for assigning particle
 polarization.  We add a flag [[polarized]].  If this is false, the
 polarization is not set and should not be transferred to
 [[hepmc_particle]] objects.
 <<HepMC interface: public>>=
   public :: hepmc_polarization_t
 <<HepMC interface: types>>=
   type :: hepmc_polarization_t
      private
      logical :: polarized = .false.
      type(c_ptr) :: obj
   end type hepmc_polarization_t
 
 @ %def hepmc_polarization_t
 @ Constructor.  The C wrapper takes polar and azimuthal angle as
 arguments.  The Fortran version allows for either a complete
 polarization density matrix, or for a definite (diagonal) helicity.
 
 \emph{HepMC does not allow to specify the degree of polarization,
   therefore we have to map it to either 0 or 1.  We choose 0 for
   polarization less than $0.5$ and 1 for polarization greater than
   $0.5$.  Even this simplification works only for spin-1/2 and for
   massless particles; massive vector bosons cannot be treated this
   way.  In particular, zero helicity is always translated as
   unpolarized.}
 
 \emph{For massive vector bosons, we arbitrarily choose the convention
   that the longitudinal (zero) helicity state is mapped to the theta
   angle $\pi/2$.  This works under the condition that helicity is
   projected onto one of the basis states.}
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function new_polarization (theta, phi) bind(C)
        import
        real(c_double), value :: theta, phi
      end function new_polarization
   end interface
 @ %def new_polarization
 <<HepMC interface: public>>=
   public :: hepmc_polarization_init
 <<HepMC interface: interfaces>>=
   interface hepmc_polarization_init
      module procedure hepmc_polarization_init_pol
      module procedure hepmc_polarization_init_hel
      module procedure hepmc_polarization_init_int
   end interface
 <<HepMC interface: procedures>>=
   subroutine hepmc_polarization_init_pol (hpol, pol)
     type(hepmc_polarization_t), intent(out) :: hpol
     type(polarization_t), intent(in) :: pol
     real(default) :: r, theta, phi
     if (pol%is_polarized ()) then
        call pol%to_angles (r, theta, phi)
        if (r >= 0.5) then
           hpol%polarized = .true.
           hpol%obj = new_polarization &
                (real (theta, c_double), real (phi, c_double))
        end if
     end if
   end subroutine hepmc_polarization_init_pol
 
   subroutine hepmc_polarization_init_hel (hpol, hel)
     type(hepmc_polarization_t), intent(out) :: hpol
     type(helicity_t), intent(in) :: hel
     integer, dimension(2) :: h
     if (hel%is_defined ()) then
        h = hel%to_pair ()
        select case (h(1))
        case (1:)
           hpol%polarized = .true.
           hpol%obj = new_polarization (0._c_double, 0._c_double)
        case (:-1)
           hpol%polarized = .true.
           hpol%obj = new_polarization (real (pi, c_double), 0._c_double)
        case (0)
           hpol%polarized = .true.
           hpol%obj = new_polarization (real (pi/2, c_double), 0._c_double)
        end select
     end if
   end subroutine hepmc_polarization_init_hel
 
   subroutine hepmc_polarization_init_int (hpol, hel)
     type(hepmc_polarization_t), intent(out) :: hpol
     integer, intent(in) :: hel
     select case (hel)
     case (1:)
        hpol%polarized = .true.
        hpol%obj = new_polarization (0._c_double, 0._c_double)
     case (:-1)
        hpol%polarized = .true.
        hpol%obj = new_polarization (real (pi, c_double), 0._c_double)
     case (0)
        hpol%polarized = .true.
        hpol%obj = new_polarization (real (pi/2, c_double), 0._c_double)
     end select
   end subroutine hepmc_polarization_init_int
 
 @ %def hepmc_polarization_init
 @ Destructor.  The C object is deallocated only if the [[polarized]]
 flag is set.
 <<HepMC interface: interfaces>>=
   interface
      subroutine polarization_delete (pol_obj) bind(C)
        import
        type(c_ptr), value :: pol_obj
      end subroutine polarization_delete
   end interface
 @ %def polarization_delete
 <<HepMC interface: public>>=
   public :: hepmc_polarization_final
 <<HepMC interface: procedures>>=
   subroutine hepmc_polarization_final (hpol)
     type(hepmc_polarization_t), intent(inout) :: hpol
     if (hpol%polarized)  call polarization_delete (hpol%obj)
   end subroutine hepmc_polarization_final
 
 @ %def hepmc_polarization_final
 @ Recover polarization from HepMC polarization object (with the
 abovementioned deficiencies).
 <<HepMC interface: interfaces>>=
   interface
      function polarization_theta (pol_obj) result (theta) bind(C)
        import
        real(c_double) :: theta
        type(c_ptr), value :: pol_obj
      end function polarization_theta
   end interface
   interface
      function polarization_phi (pol_obj) result (phi) bind(C)
        import
        real(c_double) :: phi
        type(c_ptr), value :: pol_obj
      end function polarization_phi
   end interface
 @ %def polarization_theta polarization_phi
 <<HepMC interface: public>>=
   public :: hepmc_polarization_to_pol
 <<HepMC interface: procedures>>=
   subroutine hepmc_polarization_to_pol (hpol, flv, pol)
     type(hepmc_polarization_t), intent(in) :: hpol
     type(flavor_t), intent(in) :: flv
     type(polarization_t), intent(out) :: pol
     real(default) :: theta, phi
     theta = polarization_theta (hpol%obj)
     phi = polarization_phi (hpol%obj)
     call pol%init_angles (flv, 1._default, theta, phi)
   end subroutine hepmc_polarization_to_pol
 
 @ %def hepmc_polarization_to_pol
 @ Recover helicity.  Here, $\phi$ is ignored and only the sign of
 $\cos\theta$ is relevant, mapped to positive/negative helicity.
 <<HepMC interface: public>>=
   public :: hepmc_polarization_to_hel
 <<HepMC interface: procedures>>=
   subroutine hepmc_polarization_to_hel (hpol, flv, hel)
     type(hepmc_polarization_t), intent(in) :: hpol
     type(flavor_t), intent(in) :: flv
     type(helicity_t), intent(out) :: hel
     real(default) :: theta
     integer :: hmax
     theta = polarization_theta (hpol%obj)
     hmax = flv%get_spin_type () / 2
     call hel%init (sign (hmax, nint (cos (theta))))
   end subroutine hepmc_polarization_to_hel
 
 @ %def hepmc_polarization_to_hel
 @
 \subsection{GenParticle}
 Particle objects have the obvious meaning.
 <<HepMC interface: public>>=
   public :: hepmc_particle_t
 <<HepMC interface: types>>=
   type :: hepmc_particle_t
      private
      type(c_ptr) :: obj
   end type hepmc_particle_t
 
 @ %def hepmc_particle_t
 @ Constructor.  The C version takes a FourVector object, which in the
 Fortran wrapper is created on the fly from a [[vector4]] Lorentz
 vector.
 
 No destructor is needed as long as all particles are entered into
 vertex containers.
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function new_gen_particle (prt_obj, pdg_id, status) bind(C)
        import
        type(c_ptr), value :: prt_obj
        integer(c_int), value :: pdg_id, status
      end function new_gen_particle
   end interface
 @ %def new_gen_particle
 <<HepMC interface: public>>=
   public :: hepmc_particle_init
 <<HepMC interface: procedures>>=
   subroutine hepmc_particle_init (prt, p, pdg, status)
     type(hepmc_particle_t), intent(out) :: prt
     type(vector4_t), intent(in) :: p
     integer, intent(in) :: pdg, status
     type(hepmc_four_vector_t) :: pp
     call hepmc_four_vector_init (pp, p)
     prt%obj = new_gen_particle (pp%obj, int (pdg, c_int), int (status, c_int))
     call hepmc_four_vector_final (pp)
   end subroutine hepmc_particle_init
 
 @ %def hepmc_particle_init
 @ Set the particle color flow.
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_particle_set_flow (prt_obj, code_index, code) bind(C)
        import
        type(c_ptr), value :: prt_obj
        integer(c_int), value :: code_index, code
      end subroutine gen_particle_set_flow
   end interface
 @ %def gen_particle_set_flow
 @ Set the particle color.  Either from a [[color_t]] object or
 directly from a pair of integers.
 <<HepMC interface: interfaces>>=
   interface hepmc_particle_set_color
      module procedure hepmc_particle_set_color_col
      module procedure hepmc_particle_set_color_int
   end interface hepmc_particle_set_color
 <<HepMC interface: public>>=
   public :: hepmc_particle_set_color
 <<HepMC interface: procedures>>=
   subroutine hepmc_particle_set_color_col (prt, col)
     type(hepmc_particle_t), intent(inout) :: prt
     type(color_t), intent(in) :: col
     integer(c_int) :: c
     c = col%get_col ()
     if (c /= 0)  call gen_particle_set_flow (prt%obj, 1_c_int, c)
     c = col%get_acl ()
     if (c /= 0)  call gen_particle_set_flow (prt%obj, 2_c_int, c)
   end subroutine hepmc_particle_set_color_col
 
   subroutine hepmc_particle_set_color_int (prt, col)
     type(hepmc_particle_t), intent(inout) :: prt
     integer, dimension(2), intent(in) :: col
     integer(c_int) :: c
     c = col(1)
     if (c /= 0)  call gen_particle_set_flow (prt%obj, 1_c_int, c)
     c = col(2)
     if (c /= 0)  call gen_particle_set_flow (prt%obj, 2_c_int, c)
   end subroutine hepmc_particle_set_color_int
 
 @ %def hepmc_particle_set_color
 @ Set the particle polarization.  For the restrictions on particle
 polarization in HepMC, see above [[hepmc_polarization_init]].
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_particle_set_polarization (prt_obj, pol_obj) bind(C)
        import
        type(c_ptr), value :: prt_obj, pol_obj
      end subroutine gen_particle_set_polarization
   end interface
 @ %def gen_particle_set_polarization
 <<HepMC interface: public>>=
   public :: hepmc_particle_set_polarization
 <<HepMC interface: interfaces>>=
   interface hepmc_particle_set_polarization
      module procedure hepmc_particle_set_polarization_pol
      module procedure hepmc_particle_set_polarization_hel
      module procedure hepmc_particle_set_polarization_int
   end interface
 <<HepMC interface: procedures>>=
   subroutine hepmc_particle_set_polarization_pol (prt, pol)
     type(hepmc_particle_t), intent(inout) :: prt
     type(polarization_t), intent(in) :: pol
     type(hepmc_polarization_t) :: hpol
     call hepmc_polarization_init (hpol, pol)
     if (hpol%polarized)  call gen_particle_set_polarization (prt%obj, hpol%obj)
     call hepmc_polarization_final (hpol)
   end subroutine hepmc_particle_set_polarization_pol
 
   subroutine hepmc_particle_set_polarization_hel (prt, hel)
     type(hepmc_particle_t), intent(inout) :: prt
     type(helicity_t), intent(in) :: hel
     type(hepmc_polarization_t) :: hpol
     call hepmc_polarization_init (hpol, hel)
     if (hpol%polarized)  call gen_particle_set_polarization (prt%obj, hpol%obj)
     call hepmc_polarization_final (hpol)
   end subroutine hepmc_particle_set_polarization_hel
 
   subroutine hepmc_particle_set_polarization_int (prt, hel)
     type(hepmc_particle_t), intent(inout) :: prt
     integer, intent(in) :: hel
     type(hepmc_polarization_t) :: hpol
     call hepmc_polarization_init (hpol, hel)
     if (hpol%polarized)  call gen_particle_set_polarization (prt%obj, hpol%obj)
     call hepmc_polarization_final (hpol)
   end subroutine hepmc_particle_set_polarization_int
 
 @ %def hepmc_particle_set_polarization
 @ Return the HepMC barcode (unique integer ID) of the particle.
 <<HepMC interface: interfaces>>=
   interface
      function gen_particle_barcode (prt_obj) result (barcode) bind(C)
        import
        integer(c_int) :: barcode
        type(c_ptr), value :: prt_obj
      end function gen_particle_barcode
   end interface
 @ %def gen_particle_barcode
 <<HepMC interface: public>>=
   public :: hepmc_particle_get_barcode
 <<HepMC interface: procedures>>=
   function hepmc_particle_get_barcode (prt) result (barcode)
     integer :: barcode
     type(hepmc_particle_t), intent(in) :: prt
     barcode = gen_particle_barcode (prt%obj)
   end function hepmc_particle_get_barcode
 
 @ %def hepmc_particle_get_barcode
 @ Return the four-vector component of the particle object as a [[vector4_t]] Lorentz vector.
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function gen_particle_momentum (prt_obj) bind(C)
        import
        type(c_ptr), value :: prt_obj
      end function gen_particle_momentum
   end interface
 @ %def gen_particle_momentum
 <<HepMC interface: public>>=
   public :: hepmc_particle_get_momentum
 <<HepMC interface: procedures>>=
   function hepmc_particle_get_momentum (prt) result (p)
     type(vector4_t) :: p
     type(hepmc_particle_t), intent(in) :: prt
     type(hepmc_four_vector_t) :: pp
     call hepmc_four_vector_init (pp, prt)
     call hepmc_four_vector_to_vector4 (pp, p)
     call hepmc_four_vector_final (pp)
   end function hepmc_particle_get_momentum
 
 @ %def hepmc_particle_get_momentum
 @ Return the invariant mass squared of the particle object.  HepMC
 stores the signed invariant mass (no squaring).
 <<HepMC interface: interfaces>>=
   interface
      function gen_particle_generated_mass (prt_obj) result (mass) bind(C)
        import
        real(c_double) :: mass
        type(c_ptr), value :: prt_obj
      end function gen_particle_generated_mass
   end interface
 @ %def gen_particle_generated_mass
 <<HepMC interface: public>>=
   public :: hepmc_particle_get_mass_squared
 <<HepMC interface: procedures>>=
   function hepmc_particle_get_mass_squared (prt) result (m2)
     real(default) :: m2
     type(hepmc_particle_t), intent(in) :: prt
     real(default) :: m
     m = gen_particle_generated_mass (prt%obj)
     m2 = sign (m**2, m)
   end function hepmc_particle_get_mass_squared
 
 @ %def hepmc_particle_get_mass_squared
 @ Return the PDG ID:
 <<HepMC interface: interfaces>>=
   interface
      function gen_particle_pdg_id (prt_obj) result (pdg_id) bind(C)
        import
        integer(c_int) :: pdg_id
        type(c_ptr), value :: prt_obj
      end function gen_particle_pdg_id
   end interface
 @ %def gen_particle_pdg_id
 <<HepMC interface: public>>=
   public :: hepmc_particle_get_pdg
 <<HepMC interface: procedures>>=
   function hepmc_particle_get_pdg (prt) result (pdg)
     integer :: pdg
     type(hepmc_particle_t), intent(in) :: prt
     pdg = gen_particle_pdg_id (prt%obj)
   end function hepmc_particle_get_pdg
 
 @ %def hepmc_particle_get_pdg
 @ Return the status code:
 <<HepMC interface: interfaces>>=
   interface
      function gen_particle_status (prt_obj) result (status) bind(C)
        import
        integer(c_int) :: status
        type(c_ptr), value :: prt_obj
      end function gen_particle_status
   end interface
 @ %def gen_particle_status
 <<HepMC interface: public>>=
   public :: hepmc_particle_get_status
 <<HepMC interface: procedures>>=
   function hepmc_particle_get_status (prt) result (status)
     integer :: status
     type(hepmc_particle_t), intent(in) :: prt
     status = gen_particle_status (prt%obj)
   end function hepmc_particle_get_status
 
 @ %def hepmc_particle_get_status
 <<HepMC interface: interfaces>>=
   interface
      function gen_particle_is_beam (prt_obj) result (is_beam) bind(C)
        import
        logical(c_bool) :: is_beam
        type(c_ptr), value :: prt_obj
      end function gen_particle_is_beam
   end interface
 @ %def gen_particle_is_beam
 @ Determine whether a particle is a beam particle.
 <<HepMC interface: public>>=
   public :: hepmc_particle_is_beam
 <<HepMC interface: procedures>>=
   function hepmc_particle_is_beam (prt) result (is_beam)
     logical :: is_beam
     type(hepmc_particle_t), intent(in) :: prt
     is_beam = gen_particle_is_beam (prt%obj)
   end function hepmc_particle_is_beam
 
 @ %def hepmc_particle_is_beam
 @ Return the production/decay vertex (as a pointer, no finalization
 necessary).
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function gen_particle_production_vertex (prt_obj) bind(C)
        import
        type(c_ptr), value :: prt_obj
      end function gen_particle_production_vertex
   end interface
   interface
      type(c_ptr) function gen_particle_end_vertex (prt_obj) bind(C)
        import
        type(c_ptr), value :: prt_obj
      end function gen_particle_end_vertex
   end interface
 @ %def gen_particle_production_vertex gen_particle_end_vertex
 <<HepMC interface: public>>=
   public :: hepmc_particle_get_production_vertex
   public :: hepmc_particle_get_decay_vertex
 <<HepMC interface: procedures>>=
   function hepmc_particle_get_production_vertex (prt) result (v)
     type(hepmc_vertex_t) :: v
     type(hepmc_particle_t), intent(in) :: prt
     v%obj = gen_particle_production_vertex (prt%obj)
   end function hepmc_particle_get_production_vertex
 
   function hepmc_particle_get_decay_vertex (prt) result (v)
     type(hepmc_vertex_t) :: v
     type(hepmc_particle_t), intent(in) :: prt
     v%obj = gen_particle_end_vertex (prt%obj)
   end function hepmc_particle_get_decay_vertex
 
 @ %def hepmc_particle_get_production_vertex hepmc_particle_get_decay_vertex
 @ Convenience function: Return the array of parent particles for a
 given HepMC particle.  The contents are HepMC barcodes that still have
 to be mapped to the particle indices.
 <<HepMC interface: public>>=
   public :: hepmc_particle_get_parent_barcodes
   public :: hepmc_particle_get_child_barcodes
 <<HepMC interface: procedures>>=
   function hepmc_particle_get_parent_barcodes (prt) result (parent_barcode)
     type(hepmc_particle_t), intent(in) :: prt
     integer, dimension(:), allocatable :: parent_barcode
     type(hepmc_vertex_t) :: v
     type(hepmc_vertex_particle_in_iterator_t) :: it
     integer :: i
     v = hepmc_particle_get_production_vertex (prt)
     if (hepmc_vertex_is_valid (v)) then
        allocate (parent_barcode (hepmc_vertex_get_n_in (v)))
        if (size (parent_barcode) /= 0) then
           if (HEPMC2_AVAILABLE) then
              call hepmc_vertex_particle_in_iterator_init (it, v)
              do i = 1, size (parent_barcode)
                 parent_barcode(i) = hepmc_particle_get_barcode &
                      (hepmc_vertex_particle_in_iterator_get (it))
                 call hepmc_vertex_particle_in_iterator_advance (it)
              end do
              call hepmc_vertex_particle_in_iterator_final (it)
           else if (HEPMC3_AVAILABLE) then
              do i = 1, size (parent_barcode)
                 parent_barcode(i) = hepmc_particle_get_barcode &
                      (hepmc_vertex_get_nth_particle_in (v, i))
              end do
           end if
        end if
     else
        allocate (parent_barcode (0))
     end if
   end function hepmc_particle_get_parent_barcodes
 
   function hepmc_particle_get_child_barcodes (prt) result (child_barcode)
     type(hepmc_particle_t), intent(in) :: prt
     integer, dimension(:), allocatable :: child_barcode
     type(hepmc_vertex_t) :: v
     type(hepmc_vertex_particle_out_iterator_t) :: it
     integer :: i
     v = hepmc_particle_get_decay_vertex (prt)
     if (hepmc_vertex_is_valid (v)) then
        allocate (child_barcode (hepmc_vertex_get_n_out (v)))
        if (size (child_barcode) /= 0) then
           if (HEPMC2_AVAILABLE) then
              call hepmc_vertex_particle_out_iterator_init (it, v)
              do i = 1, size (child_barcode)
                 child_barcode(i) = hepmc_particle_get_barcode &
                      (hepmc_vertex_particle_out_iterator_get (it))
                 call hepmc_vertex_particle_out_iterator_advance (it)
              end do
              call hepmc_vertex_particle_out_iterator_final (it)
           else if (HEPMC3_AVAILABLE) then
              do i = 1, size (child_barcode)
                 child_barcode(i) = hepmc_particle_get_barcode &
                      (hepmc_vertex_get_nth_particle_out (v, i))
              end do
           end if
        end if
     else
        allocate (child_barcode (0))
     end if
   end function hepmc_particle_get_child_barcodes
 
 @ %def hepmc_particle_get_parent_barcodes hepmc_particle_get_child_barcodes
 @ Return the polarization (assuming that the particle is completely
 polarized).  Note that the generated polarization object needs finalization.
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function gen_particle_polarization (prt_obj) bind(C)
        import
        type(c_ptr), value :: prt_obj
      end function gen_particle_polarization
   end interface
 @ %def gen_particle_polarization
 <<HepMC interface: public>>=
   public :: hepmc_particle_get_polarization
 <<HepMC interface: procedures>>=
   function hepmc_particle_get_polarization (prt) result (pol)
     type(hepmc_polarization_t) :: pol
     type(hepmc_particle_t), intent(in) :: prt
     pol%obj = gen_particle_polarization (prt%obj)
   end function hepmc_particle_get_polarization
 
 @ %def hepmc_particle_get_polarization
 @ Return the particle color as a two-dimensional array (color, anticolor).
 <<HepMC interface: interfaces>>=
   interface
      function gen_particle_flow (prt_obj, code_index) result (code) bind(C)
        import
        integer(c_int) :: code
        type(c_ptr), value :: prt_obj
        integer(c_int), value :: code_index
      end function gen_particle_flow
   end interface
 @ %def gen_particle_flow
 <<HepMC interface: public>>=
   public :: hepmc_particle_get_color
 <<HepMC interface: procedures>>=
   function hepmc_particle_get_color (prt) result (col)
     integer, dimension(2) :: col
     type(hepmc_particle_t), intent(in) :: prt
     col(1) = gen_particle_flow (prt%obj, 1)
     col(2) = - gen_particle_flow (prt%obj, 2)
   end function hepmc_particle_get_color
 
 @ %def hepmc_particle_get_color
 @
 <<HepMC interface: interfaces>>=
   interface
      function gen_vertex_pos_x (v_obj) result (x) bind(C)
        import
        type(c_ptr), value :: v_obj
        real(c_double) :: x
      end function gen_vertex_pos_x
   end interface
   interface
      function gen_vertex_pos_y (v_obj) result (y) bind(C)
        import
        type(c_ptr), value :: v_obj
        real(c_double) :: y
      end function gen_vertex_pos_y
   end interface
   interface
      function gen_vertex_pos_z (v_obj) result (z) bind(C)
        import
        type(c_ptr), value :: v_obj
        real(c_double) :: z
      end function gen_vertex_pos_z
   end interface
   interface
      function gen_vertex_time (v_obj) result (t) bind(C)
        import
        type(c_ptr), value :: v_obj
        real(c_double) :: t
      end function gen_vertex_time
   end interface
 @
 <<HepMC interface: public>>=
   public :: hepmc_vertex_to_vertex
 <<HepMC interface: procedures>>=
   function hepmc_vertex_to_vertex (vtx) result (v)
     type(hepmc_vertex_t), intent(in) :: vtx
     type(vector4_t) :: v
     real(default) :: t, vx, vy, vz
     if (hepmc_vertex_is_valid (vtx)) then
        t = gen_vertex_time (vtx%obj)
        vx = gen_vertex_pos_x (vtx%obj)
        vy = gen_vertex_pos_y (vtx%obj)
        vz = gen_vertex_pos_z (vtx%obj)
        v = vector4_moving (t, &
             vector3_moving ([vx, vy, vz]))
     end if
   end function hepmc_vertex_to_vertex
 
 @ %def hepmc_vertex_to_vertex
 @
 \subsection{GenVertex}
 Vertices are made of particles (incoming and outgoing).
 <<HepMC interface: public>>=
   public :: hepmc_vertex_t
 <<HepMC interface: types>>=
   type :: hepmc_vertex_t
      private
      type(c_ptr) :: obj
   end type hepmc_vertex_t
 
 @ %def hepmc_vertex_t
 @ Constructor.  Two versions, one plain, one with the position in
 space and time (measured in mm) as argument.  The Fortran version has
 initializer form, and the vertex position is an optional argument.
 
 A destructor is unnecessary as long as all vertices are entered into
 an event container.
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function new_gen_vertex () bind(C)
        import
      end function new_gen_vertex
   end interface
   interface
      type(c_ptr) function new_gen_vertex_pos (prt_obj) bind(C)
        import
        type(c_ptr), value :: prt_obj
      end function new_gen_vertex_pos
   end interface
 @ %def new_gen_vertex new_gen_vertex_pos
 <<HepMC interface: public>>=
   public :: hepmc_vertex_init
 <<HepMC interface: procedures>>=
   subroutine hepmc_vertex_init (v, x)
     type(hepmc_vertex_t), intent(out) :: v
     type(vector4_t), intent(in), optional :: x
     type(hepmc_four_vector_t) :: pos
     if (present (x)) then
        call hepmc_four_vector_init (pos, x)
        v%obj = new_gen_vertex_pos (pos%obj)
        call hepmc_four_vector_final (pos)
     else
        v%obj = new_gen_vertex ()
     end if
   end subroutine hepmc_vertex_init
 
 @ %def hepmc_vertex_init
 @ Return true if the vertex pointer is non-null:
 <<HepMC interface: interfaces>>=
   interface
      function gen_vertex_is_valid (v_obj) result (flag) bind(C)
        import
        logical(c_bool) :: flag
        type(c_ptr), value :: v_obj
      end function gen_vertex_is_valid
   end interface
 @ %def gen_vertex_is_valid
 <<HepMC interface: public>>=
   public :: hepmc_vertex_is_valid
 <<HepMC interface: procedures>>=
   function hepmc_vertex_is_valid (v) result (flag)
     logical :: flag
     type(hepmc_vertex_t), intent(in) :: v
     flag = gen_vertex_is_valid (v%obj)
   end function hepmc_vertex_is_valid
 
 @ %def hepmc_vertex_is_valid
 @ Add a particle to a vertex, incoming or outgoing.
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_vertex_add_particle_in (v_obj, prt_obj) bind(C)
        import
        type(c_ptr), value :: v_obj, prt_obj
      end subroutine gen_vertex_add_particle_in
   end interface
   interface
      subroutine gen_vertex_add_particle_out (v_obj, prt_obj) bind(C)
        import
        type(c_ptr), value :: v_obj, prt_obj
      end subroutine gen_vertex_add_particle_out
   end interface
 <<HepMC interface: public>>=
   public :: hepmc_vertex_add_particle_in
   public :: hepmc_vertex_add_particle_out
 @ %def gen_vertex_add_particle_in gen_vertex_add_particle_out
 <<HepMC interface: procedures>>=
   subroutine hepmc_vertex_add_particle_in (v, prt)
     type(hepmc_vertex_t), intent(inout) :: v
     type(hepmc_particle_t), intent(in) :: prt
     call gen_vertex_add_particle_in (v%obj, prt%obj)
   end subroutine hepmc_vertex_add_particle_in
 
   subroutine hepmc_vertex_add_particle_out (v, prt)
     type(hepmc_vertex_t), intent(inout) :: v
     type(hepmc_particle_t), intent(in) :: prt
     call gen_vertex_add_particle_out (v%obj, prt%obj)
   end subroutine hepmc_vertex_add_particle_out
 
 @ %def hepmc_vertex_add_particle_in hepmc_vertex_add_particle_out
 @ Return the number of incoming/outgoing particles.
 <<HepMC interface: interfaces>>=
   interface
      function gen_vertex_particles_in_size (v_obj) result (size) bind(C)
        import
        integer(c_int) :: size
        type(c_ptr), value :: v_obj
      end function gen_vertex_particles_in_size
   end interface
   interface
      function gen_vertex_particles_out_size (v_obj) result (size) bind(C)
        import
        integer(c_int) :: size
        type(c_ptr), value :: v_obj
      end function gen_vertex_particles_out_size
   end interface  
   interface
      function gen_particle_get_n_parents (p_obj) result (size) bind(C)
        import
        integer(c_int) :: size
        type(c_ptr), value :: p_obj
      end function gen_particle_get_n_parents
   end interface
   interface
      function gen_particle_get_n_children (p_obj) result (size) bind(C)
        import
        integer(c_int) :: size
        type(c_ptr), value :: p_obj
      end function gen_particle_get_n_children
   end interface
 @ %def gen_vertex_particles_in_size gen_vertex_particles_out_size
 @ %def gen_particle_get_n_parents get_particle_get_n_children
 <<HepMC interface: public>>=
   public :: hepmc_vertex_get_n_in
   public :: hepmc_vertex_get_n_out
   public :: hepmc_particle_get_parents
   public :: hepmc_particle_get_children
 <<HepMC interface: procedures>>=
   function hepmc_vertex_get_n_in (v) result (n_in)
     integer :: n_in
     type(hepmc_vertex_t), intent(in) :: v
     n_in = gen_vertex_particles_in_size (v%obj)
   end function hepmc_vertex_get_n_in
 
   function hepmc_vertex_get_n_out (v) result (n_out)
     integer :: n_out
     type(hepmc_vertex_t), intent(in) :: v
     n_out = gen_vertex_particles_out_size (v%obj)
   end function hepmc_vertex_get_n_out
   
   function hepmc_particle_get_parents (p) result (n_p)
     integer :: n_p
     type(hepmc_particle_t), intent(in) :: p
     n_p = gen_particle_get_n_parents (p%obj)
   end function hepmc_particle_get_parents
 
   function hepmc_particle_get_children (p) result (n_ch)
     integer :: n_ch
     type(hepmc_particle_t), intent(in) :: p
     n_ch = gen_particle_get_n_children (p%obj)
   end function hepmc_particle_get_children
 
 @ %def hepmc_vertex_n_in hepmc_vertex_n_out
 @ %def hepmc_particle_get_parents hepmc_particle_get_children
 @ Return the number of parents/children.
 <<HepMC interface: public>>=
   public :: hepmc_particle_get_n_parents
   public :: hepmc_particle_get_n_children
 <<HepMC interface: procedures>>=
   function hepmc_particle_get_n_parents (prt) result (n_parents)
     integer :: n_parents
     type(hepmc_particle_t), intent(in) :: prt
     type(hepmc_vertex_t) :: v
     if (HEPMC2_AVAILABLE) then
        v = hepmc_particle_get_production_vertex (prt)
        if (hepmc_vertex_is_valid (v)) then
           n_parents = hepmc_vertex_get_n_in (v)
        else
           n_parents = 0
        end if
     else if (HEPMC3_AVAILABLE) then
        n_parents = hepmc_particle_get_parents (prt)
     end if
   end function hepmc_particle_get_n_parents
 
   function hepmc_particle_get_n_children (prt) result (n_children)
     integer :: n_children
     type(hepmc_particle_t), intent(in) :: prt
     type(hepmc_vertex_t) :: v
     if (HEPMC2_AVAILABLE) then
        v = hepmc_particle_get_decay_vertex (prt)
        if (hepmc_vertex_is_valid (v)) then
           n_children = hepmc_vertex_get_n_out (v)
        else
           n_children = 0
        end if
     else if (HEPMC3_AVAILABLE) then
        n_children = hepmc_particle_get_children (prt)
     end if
   end function hepmc_particle_get_n_children
 
 @ %def hepmc_particle_get_n_parents
 @ %def hepmc_particle_get_n_children
 \subsection{Vertex-particle-in iterator}
 This iterator iterates over all incoming particles in an vertex.  We store a
 pointer to the vertex in addition to the iterator.  This allows for
 simple end checking.
 
 The iterator is actually a constant iterator; it can only read.
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_in_iterator_t
 <<HepMC interface: types>>=
   type :: hepmc_vertex_particle_in_iterator_t
      private
      type(c_ptr) :: obj
      type(c_ptr) :: v_obj
   end type hepmc_vertex_particle_in_iterator_t
 
 @ %def hepmc_vertex_particle_in_iterator_t
 @ Constructor.  The iterator is initialized at the first particle in
 the vertex.
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function &
           new_vertex_particles_in_const_iterator (v_obj) bind(C)
        import
        type(c_ptr), value :: v_obj
      end function new_vertex_particles_in_const_iterator
   end interface
 @ %def new_vertex_particles_in_const_iterator
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_in_iterator_init
 <<HepMC interface: procedures>>=
   subroutine hepmc_vertex_particle_in_iterator_init (it, v)
     type(hepmc_vertex_particle_in_iterator_t), intent(out) :: it
     type(hepmc_vertex_t), intent(in) :: v
     it%obj = new_vertex_particles_in_const_iterator (v%obj)
     it%v_obj = v%obj
   end subroutine hepmc_vertex_particle_in_iterator_init
 
 @ %def hepmc_vertex_particle_in_iterator_init
 @ Destructor.  Necessary because the iterator is allocated on the
 heap.
 <<HepMC interface: interfaces>>=
   interface
      subroutine vertex_particles_in_const_iterator_delete (it_obj) bind(C)
        import
        type(c_ptr), value :: it_obj
      end subroutine vertex_particles_in_const_iterator_delete
   end interface
 @ %def vertex_particles_in_const_iterator_delete
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_in_iterator_final
 <<HepMC interface: procedures>>=
   subroutine hepmc_vertex_particle_in_iterator_final (it)
     type(hepmc_vertex_particle_in_iterator_t), intent(inout) :: it
     call vertex_particles_in_const_iterator_delete (it%obj)
   end subroutine hepmc_vertex_particle_in_iterator_final
 
 @ %def hepmc_vertex_particle_in_iterator_final
 @ Increment
 <<HepMC interface: interfaces>>=
   interface
      subroutine vertex_particles_in_const_iterator_advance (it_obj) bind(C)
        import
        type(c_ptr), value :: it_obj
      end subroutine vertex_particles_in_const_iterator_advance
   end interface
 @ %def vertex_particles_in_const_iterator_advance
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_in_iterator_advance
 <<HepMC interface: procedures>>=
   subroutine hepmc_vertex_particle_in_iterator_advance (it)
     type(hepmc_vertex_particle_in_iterator_t), intent(inout) :: it
     call vertex_particles_in_const_iterator_advance (it%obj)
   end subroutine hepmc_vertex_particle_in_iterator_advance
 
 @ %def hepmc_vertex_particle_in_iterator_advance
 @ Reset to the beginning
 <<HepMC interface: interfaces>>=
   interface
      subroutine vertex_particles_in_const_iterator_reset &
           (it_obj, v_obj) bind(C)
        import
        type(c_ptr), value :: it_obj, v_obj
      end subroutine vertex_particles_in_const_iterator_reset
   end interface
 @ %def vertex_particles_in_const_iterator_reset
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_in_iterator_reset
 <<HepMC interface: procedures>>=
   subroutine hepmc_vertex_particle_in_iterator_reset (it)
     type(hepmc_vertex_particle_in_iterator_t), intent(inout) :: it
     call vertex_particles_in_const_iterator_reset (it%obj, it%v_obj)
   end subroutine hepmc_vertex_particle_in_iterator_reset
 
 @ %def hepmc_vertex_particle_in_iterator_reset
 @ Test: return true as long as we are not past the end.
 <<HepMC interface: interfaces>>=
   interface
      function vertex_particles_in_const_iterator_is_valid &
           (it_obj, v_obj) result (flag) bind(C)
        import
        logical(c_bool) :: flag
        type(c_ptr), value :: it_obj, v_obj
      end function vertex_particles_in_const_iterator_is_valid
   end interface
 @ %def vertex_particles_in_const_iterator_is_valid
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_in_iterator_is_valid
 <<HepMC interface: procedures>>=
   function hepmc_vertex_particle_in_iterator_is_valid (it) result (flag)
     logical :: flag
     type(hepmc_vertex_particle_in_iterator_t), intent(in) :: it
     flag = vertex_particles_in_const_iterator_is_valid (it%obj, it%v_obj)
   end function hepmc_vertex_particle_in_iterator_is_valid
 
 @ %def hepmc_vertex_particle_in_iterator_is_valid
 @ Return the particle pointed to by the iterator.  (The particle
 object should not be finalized, since it contains merely a pointer to
 the particle which is owned by the vertex.)
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function &
           vertex_particles_in_const_iterator_get (it_obj) bind(C)
        import
        type(c_ptr), value :: it_obj
      end function vertex_particles_in_const_iterator_get
   end interface
 @ %def vertex_particles_in_const_iterator_get
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_in_iterator_get
 <<HepMC interface: procedures>>=
   function hepmc_vertex_particle_in_iterator_get (it) result (prt)
     type(hepmc_particle_t) :: prt
     type(hepmc_vertex_particle_in_iterator_t), intent(in) :: it
     prt%obj = vertex_particles_in_const_iterator_get (it%obj)
   end function hepmc_vertex_particle_in_iterator_get
 
 @ %def hepmc_vertex_particle_in_iterator_get
 @
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function vertex_get_nth_particle_in (vtx_obj, n) bind(C)
        import
        type(c_ptr), value :: vtx_obj
        integer(c_int), value :: n
      end function vertex_get_nth_particle_in
   end interface
   interface
      type(c_ptr) function vertex_get_nth_particle_out (vtx_obj, n) bind(C)
        import
        type(c_ptr), value :: vtx_obj
        integer(c_int), value :: n
      end function vertex_get_nth_particle_out
   end interface
 @ %def vertex_get_nth_particle_in
 <<HepMC interface: public>>=
   public :: hepmc_vertex_get_nth_particle_in
   public :: hepmc_vertex_get_nth_particle_out
 <<HepMC interface: procedures>>=
   function hepmc_vertex_get_nth_particle_in (vtx, n) result (prt)
     type(hepmc_particle_t) :: prt
     type(hepmc_vertex_t), intent(in) :: vtx
     integer, intent(in) :: n
     integer(c_int) :: nth
     nth = n
     prt%obj = vertex_get_nth_particle_in (vtx%obj, nth)
   end function hepmc_vertex_get_nth_particle_in
 
   function hepmc_vertex_get_nth_particle_out (vtx, n) result (prt)
     type(hepmc_particle_t) :: prt
     type(hepmc_vertex_t), intent(in) :: vtx
     integer, intent(in) :: n
     integer(c_int) :: nth
     nth = n
     prt%obj = vertex_get_nth_particle_out (vtx%obj, nth)
   end function hepmc_vertex_get_nth_particle_out
 
 @ %def hepmc_vertex_get_nth_particle_in
 @ %def hepmc_vertex_get_nth_particle_out
 @
 \subsection{Vertex-particle-out iterator}
 This iterator iterates over all incoming particles in an vertex.  We store a
 pointer to the vertex in addition to the iterator.  This allows for
 simple end checking.
 
 The iterator is actually a constant iterator; it can only read.
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_out_iterator_t
 <<HepMC interface: types>>=
   type :: hepmc_vertex_particle_out_iterator_t
      private
      type(c_ptr) :: obj
      type(c_ptr) :: v_obj
   end type hepmc_vertex_particle_out_iterator_t
 
 @ %def hepmc_vertex_particle_out_iterator_t
 @ Constructor.  The iterator is initialized at the first particle in
 the vertex.
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function &
           new_vertex_particles_out_const_iterator (v_obj) bind(C)
        import
        type(c_ptr), value :: v_obj
      end function new_vertex_particles_out_const_iterator
   end interface
 @ %def new_vertex_particles_out_const_iterator
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_out_iterator_init
 <<HepMC interface: procedures>>=
   subroutine hepmc_vertex_particle_out_iterator_init (it, v)
     type(hepmc_vertex_particle_out_iterator_t), intent(out) :: it
     type(hepmc_vertex_t), intent(in) :: v
     it%obj = new_vertex_particles_out_const_iterator (v%obj)
     it%v_obj = v%obj
   end subroutine hepmc_vertex_particle_out_iterator_init
 
 @ %def hepmc_vertex_particle_out_iterator_init
 @ Destructor.  Necessary because the iterator is allocated on the
 heap.
 <<HepMC interface: interfaces>>=
   interface
      subroutine vertex_particles_out_const_iterator_delete (it_obj) bind(C)
        import
        type(c_ptr), value :: it_obj
      end subroutine vertex_particles_out_const_iterator_delete
   end interface
 @ %def vertex_particles_out_const_iterator_delete
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_out_iterator_final
 <<HepMC interface: procedures>>=
   subroutine hepmc_vertex_particle_out_iterator_final (it)
     type(hepmc_vertex_particle_out_iterator_t), intent(inout) :: it
     call vertex_particles_out_const_iterator_delete (it%obj)
   end subroutine hepmc_vertex_particle_out_iterator_final
 
 @ %def hepmc_vertex_particle_out_iterator_final
 @ Increment
 <<HepMC interface: interfaces>>=
   interface
      subroutine vertex_particles_out_const_iterator_advance (it_obj) bind(C)
        import
        type(c_ptr), value :: it_obj
      end subroutine vertex_particles_out_const_iterator_advance
   end interface
 @ %def vertex_particles_out_const_iterator_advance
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_out_iterator_advance
 <<HepMC interface: procedures>>=
   subroutine hepmc_vertex_particle_out_iterator_advance (it)
     type(hepmc_vertex_particle_out_iterator_t), intent(inout) :: it
     call vertex_particles_out_const_iterator_advance (it%obj)
   end subroutine hepmc_vertex_particle_out_iterator_advance
 
 @ %def hepmc_vertex_particle_out_iterator_advance
 @ Reset to the beginning
 <<HepMC interface: interfaces>>=
   interface
      subroutine vertex_particles_out_const_iterator_reset &
           (it_obj, v_obj) bind(C)
        import
        type(c_ptr), value :: it_obj, v_obj
      end subroutine vertex_particles_out_const_iterator_reset
   end interface
 @ %def vertex_particles_out_const_iterator_reset
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_out_iterator_reset
 <<HepMC interface: procedures>>=
   subroutine hepmc_vertex_particle_out_iterator_reset (it)
     type(hepmc_vertex_particle_out_iterator_t), intent(inout) :: it
     call vertex_particles_out_const_iterator_reset (it%obj, it%v_obj)
   end subroutine hepmc_vertex_particle_out_iterator_reset
 
 @ %def hepmc_vertex_particle_out_iterator_reset
 @ Test: return true as long as we are not past the end.
 <<HepMC interface: interfaces>>=
   interface
      function vertex_particles_out_const_iterator_is_valid &
           (it_obj, v_obj) result (flag) bind(C)
        import
        logical(c_bool) :: flag
        type(c_ptr), value :: it_obj, v_obj
      end function vertex_particles_out_const_iterator_is_valid
   end interface
 @ %def vertex_particles_out_const_iterator_is_valid
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_out_iterator_is_valid
 <<HepMC interface: procedures>>=
   function hepmc_vertex_particle_out_iterator_is_valid (it) result (flag)
     logical :: flag
     type(hepmc_vertex_particle_out_iterator_t), intent(in) :: it
     flag = vertex_particles_out_const_iterator_is_valid (it%obj, it%v_obj)
   end function hepmc_vertex_particle_out_iterator_is_valid
 
 @ %def hepmc_vertex_particle_out_iterator_is_valid
 @ Return the particle pointed to by the iterator.  (The particle
 object should not be finalized, since it contains merely a pointer to
 the particle which is owned by the vertex.)
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function &
           vertex_particles_out_const_iterator_get (it_obj) bind(C)
        import
        type(c_ptr), value :: it_obj
      end function vertex_particles_out_const_iterator_get
   end interface
 @ %def vertex_particles_out_const_iterator_get
 <<HepMC interface: public>>=
   public :: hepmc_vertex_particle_out_iterator_get
 <<HepMC interface: procedures>>=
   function hepmc_vertex_particle_out_iterator_get (it) result (prt)
     type(hepmc_particle_t) :: prt
     type(hepmc_vertex_particle_out_iterator_t), intent(in) :: it
     prt%obj = vertex_particles_out_const_iterator_get (it%obj)
   end function hepmc_vertex_particle_out_iterator_get
 
 @ %def hepmc_vertex_particle_out_iterator_get
 @
 \subsection{GenEvent}
 The main object of HepMC is a GenEvent.  The object is filled by
 GenVertex objects, which in turn contain GenParticle objects.
 <<HepMC interface: public>>=
   public :: hepmc_event_t
 <<HepMC interface: types>>=
   type :: hepmc_event_t
      private
      type(c_ptr) :: obj
   end type hepmc_event_t
 
 @ %def hepmc_event_t
 @ Constructor.  Arguments are process ID (integer) and event ID
 (integer).
 
 The Fortran version has initializer form.
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function new_gen_event (proc_id, event_id) bind(C)
        import
        integer(c_int), value :: proc_id, event_id
      end function new_gen_event
   end interface
 @ %def new_gen_event
 <<HepMC interface: public>>=
   public :: hepmc_event_init
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_init (evt, proc_id, event_id)
     type(hepmc_event_t), intent(out) :: evt
     integer, intent(in), optional :: proc_id, event_id
     integer(c_int) :: pid, eid
     pid = 0;  if (present (proc_id))  pid = proc_id
     eid = 0;  if (present (event_id)) eid = event_id
     evt%obj = new_gen_event (pid, eid)
   end subroutine hepmc_event_init
 
 @ %def hepmc_event_init
 @ Destructor.
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_event_delete (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end subroutine gen_event_delete
   end interface
 @ %def gen_event_delete
 <<HepMC interface: public>>=
   public :: hepmc_event_final
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_final (evt)
     type(hepmc_event_t), intent(inout) :: evt
     call gen_event_delete (evt%obj)
   end subroutine hepmc_event_final
 
 @ %def hepmc_event_final
 @ Screen output.  Printing to file is possible in principle (using a
 C++ output channel), by allowing an argument.  Printing to an open
 Fortran unit is obviously not possible.
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_event_print (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end subroutine gen_event_print
   end interface
 @ %def gen_event_print
 <<HepMC interface: public>>=
   public :: hepmc_event_print
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_print (evt)
     type(hepmc_event_t), intent(in) :: evt
     call gen_event_print (evt%obj)
   end subroutine hepmc_event_print
 
 @ %def hepmc_event_print
 @ Get the event number.
 <<HepMC interface: interfaces>>=
   interface
      integer(c_int) function gen_event_event_number (evt_obj) bind(C)
        use iso_c_binding !NODEP!
        type(c_ptr), value :: evt_obj
      end function gen_event_event_number
   end interface
 @ %def gen_event_event_number
 <<HepMC interface: public>>=
   public :: hepmc_event_get_event_index
 <<HepMC interface: procedures>>=
   function hepmc_event_get_event_index (evt) result (i_proc)
     integer :: i_proc
     type(hepmc_event_t), intent(in) :: evt
     i_proc = gen_event_event_number (evt%obj)
   end function hepmc_event_get_event_index
 
 @ %def hepmc_event_get_event_index
 <<HepMC interface: interfaces>>=
   interface
      integer(c_int) function gen_event_get_n_particles &
           (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end function gen_event_get_n_particles
   end interface
     interface
      integer(c_int) function gen_event_get_n_beams &
           (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end function gen_event_get_n_beams
   end interface
 @ %def gen_event_get_n_particles gen_event_get_n_beams
 <<HepMC interface: public>>=
   public :: hepmc_event_get_n_particles
   public :: hepmc_event_get_n_beams
 <<HepMC interface: procedures>>=
   function hepmc_event_get_n_particles (evt) result (n_tot)
     integer :: n_tot
     type(hepmc_event_t), intent(in) :: evt
     n_tot = gen_event_get_n_particles (evt%obj)
   end function hepmc_event_get_n_particles
 
   function hepmc_event_get_n_beams (evt) result (n_tot)
     integer :: n_tot
     type(hepmc_event_t), intent(in) :: evt
     n_tot = gen_event_get_n_beams (evt%obj)
   end function hepmc_event_get_n_beams
 
 @ %def hepmc_event_get_n_particles
 @ %def hepmc_event_get_n_beams
 @ Set the numeric signal process ID
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_event_set_signal_process_id (evt_obj, proc_id) bind(C)
        import
        type(c_ptr), value :: evt_obj
        integer(c_int), value :: proc_id
      end subroutine gen_event_set_signal_process_id
   end interface
 @ %def gen_event_set_signal_process_id
 <<HepMC interface: public>>=
   public :: hepmc_event_set_process_id
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_set_process_id (evt, proc)
     type(hepmc_event_t), intent(in) :: evt
     integer, intent(in) :: proc
     integer(c_int) :: i_proc
     i_proc = proc
     call gen_event_set_signal_process_id (evt%obj, i_proc)
   end subroutine hepmc_event_set_process_id
 
 @ %def hepmc_event_set_process_id
 @ Get the numeric signal process ID
 <<HepMC interface: interfaces>>=
   interface
      integer(c_int) function gen_event_signal_process_id (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end function gen_event_signal_process_id
   end interface
 @ %def gen_event_signal_process_id
 <<HepMC interface: public>>=
   public :: hepmc_event_get_process_id
 <<HepMC interface: procedures>>=
   function hepmc_event_get_process_id (evt) result (i_proc)
     integer :: i_proc
     type(hepmc_event_t), intent(in) :: evt
     i_proc = gen_event_signal_process_id (evt%obj)
   end function hepmc_event_get_process_id
 
 @ %def hepmc_event_get_process_id
 @ Set the event energy scale
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_event_set_event_scale (evt_obj, scale) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: scale
      end subroutine gen_event_set_event_scale
   end interface
 @ %def gen_event_set_event_scale
 <<HepMC interface: public>>=
   public :: hepmc_event_set_scale
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_set_scale (evt, scale)
     type(hepmc_event_t), intent(in) :: evt
     real(default), intent(in) :: scale
     real(c_double) :: cscale
     cscale = scale
     call gen_event_set_event_scale (evt%obj, cscale)
   end subroutine hepmc_event_set_scale
 
 @ %def hepmc_event_set_scale
 @ Get the event energy scale
 <<HepMC interface: interfaces>>=
   interface
      real(c_double) function gen_event_event_scale (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end function gen_event_event_scale
   end interface
 @ %def gen_event_event_scale
 <<HepMC interface: public>>=
   public :: hepmc_event_get_scale
 <<HepMC interface: procedures>>=
   function hepmc_event_get_scale (evt) result (scale)
     real(default) :: scale
     type(hepmc_event_t), intent(in) :: evt
     scale = gen_event_event_scale (evt%obj)
   end function hepmc_event_get_scale
 
 @ %def hepmc_event_set_scale
 @ Set the value of $\alpha_{\rm QCD}$.
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_event_set_alpha_qcd (evt_obj, a) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: a
      end subroutine gen_event_set_alpha_qcd
   end interface
 @ %def gen_event_set_alpha_qcd
 <<HepMC interface: public>>=
   public :: hepmc_event_set_alpha_qcd
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_set_alpha_qcd (evt, alpha)
     type(hepmc_event_t), intent(in) :: evt
     real(default), intent(in) :: alpha
     real(c_double) :: a
     a = alpha
     call gen_event_set_alpha_qcd (evt%obj, a)
   end subroutine hepmc_event_set_alpha_qcd
 
 @ %def hepmc_event_set_alpha_qcd
 @ Get the value of $\alpha_{\rm QCD}$.
 <<HepMC interface: interfaces>>=
   interface
      real(c_double) function gen_event_alpha_qcd (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end function gen_event_alpha_qcd
   end interface
 @ %def gen_event_get_alpha_qcd
 <<HepMC interface: public>>=
   public :: hepmc_event_get_alpha_qcd
 <<HepMC interface: procedures>>=
   function hepmc_event_get_alpha_qcd (evt) result (alpha)
     real(default) :: alpha
     type(hepmc_event_t), intent(in) :: evt
     alpha = gen_event_alpha_qcd (evt%obj)
   end function hepmc_event_get_alpha_qcd
 
 @ %def hepmc_event_get_alpha_qcd
 @ Set the value of $\alpha_{\rm QED}$.
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_event_set_alpha_qed (evt_obj, a) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: a
      end subroutine gen_event_set_alpha_qed
   end interface
 @ %def gen_event_set_alpha_qed
 <<HepMC interface: public>>=
   public :: hepmc_event_set_alpha_qed
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_set_alpha_qed (evt, alpha)
     type(hepmc_event_t), intent(in) :: evt
     real(default), intent(in) :: alpha
     real(c_double) :: a
     a = alpha
     call gen_event_set_alpha_qed (evt%obj, a)
   end subroutine hepmc_event_set_alpha_qed
 
 @ %def hepmc_event_set_alpha_qed
 @ Get the value of $\alpha_{\rm QED}$.
 <<HepMC interface: interfaces>>=
   interface
      real(c_double) function gen_event_alpha_qed (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end function gen_event_alpha_qed
   end interface
 @ %def gen_event_get_alpha_qed
 <<HepMC interface: public>>=
   public :: hepmc_event_get_alpha_qed
 <<HepMC interface: procedures>>=
   function hepmc_event_get_alpha_qed (evt) result (alpha)
     real(default) :: alpha
     type(hepmc_event_t), intent(in) :: evt
     alpha = gen_event_alpha_qed (evt%obj)
   end function hepmc_event_get_alpha_qed
 
 @ %def hepmc_event_get_alpha_qed
 @ Clear a weight value to the end of the weight container.
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_event_clear_weights (evt_obj) bind(C)
        use iso_c_binding !NODEP!
        type(c_ptr), value :: evt_obj
      end subroutine gen_event_clear_weights
   end interface
 @ %def gen_event_set_alpha_qed
 @ The HepMC weights are measured in pb.
 <<HepMC interface: parameters>>=
   real(default), parameter :: pb_per_fb = 1.e-3_default
 @ %def pb_per_fb
 @
 <<HepMC interface: public>>=
   public :: hepmc_event_clear_weights
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_clear_weights (evt)
     type(hepmc_event_t), intent(in) :: evt
     call gen_event_clear_weights (evt%obj)
   end subroutine hepmc_event_clear_weights
 
 @ %def hepmc_event_clear_weights
 @ Add a weight value to the end of the weight container.
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_event_add_weight (evt_obj, w) bind(C)
        use iso_c_binding !NODEP!
        type(c_ptr), value :: evt_obj
        real(c_double), value :: w
      end subroutine gen_event_add_weight
   end interface
 @ %def gen_event_add_weight
 @
 <<HepMC interface: public>>=
   public :: hepmc_event_add_weight
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_add_weight (evt, weight)
     type(hepmc_event_t), intent(in) :: evt
     real(default), intent(in) :: weight
     real(c_double) :: w
     w = weight * pb_per_fb
     call gen_event_add_weight (evt%obj, w)
   end subroutine hepmc_event_add_weight
 
 @ %def hepmc_event_add_weight
 @ Get the size of the weight container (the number of valid elements).
 <<HepMC interface: interfaces>>=
   interface
      integer(c_int) function gen_event_weights_size (evt_obj) bind(C)
        use iso_c_binding !NODEP!
        type(c_ptr), value :: evt_obj
      end function gen_event_weights_size
   end interface
 @ %def gen_event_get_weight
 <<HepMC interface: public>>=
   public :: hepmc_event_get_weights_size
 <<HepMC interface: procedures>>=
   function hepmc_event_get_weights_size (evt) result (n)
     integer :: n
     type(hepmc_event_t), intent(in) :: evt
     n = gen_event_weights_size (evt%obj)
   end function hepmc_event_get_weights_size
 
 @ %def hepmc_event_get_weights_size
 @ Get the value of the weight with index [[i]].  (Count from 1, while C counts
 from zero.)
 <<HepMC interface: interfaces>>=
   interface
      real(c_double) function gen_event_weight (evt_obj, i) bind(C)
        use iso_c_binding !NODEP!
        type(c_ptr), value :: evt_obj
        integer(c_int), value :: i
      end function gen_event_weight
   end interface
 @ %def gen_event_get_weight
 <<HepMC interface: public>>=
   public :: hepmc_event_get_weight
 <<HepMC interface: procedures>>=
   function hepmc_event_get_weight (evt, index) result (weight)
     real(default) :: weight
     type(hepmc_event_t), intent(in) :: evt
     integer, intent(in) :: index
     integer(c_int) :: i
     i = index - 1
     weight = gen_event_weight (evt%obj, i) / pb_per_fb
   end function hepmc_event_get_weight
 
 @ %def hepmc_event_get_weight
 @ Add a vertex to the event container.
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_event_add_vertex (evt_obj, v_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
        type(c_ptr), value :: v_obj
      end subroutine gen_event_add_vertex
   end interface
 @ %def gen_event_add_vertex
 <<HepMC interface: public>>=
   public :: hepmc_event_add_vertex
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_add_vertex (evt, v)
     type(hepmc_event_t), intent(inout) :: evt
     type(hepmc_vertex_t), intent(in) :: v
     call gen_event_add_vertex (evt%obj, v%obj)
   end subroutine hepmc_event_add_vertex
 
 @ %def hepmc_event_add_vertex
 @ Mark a particular vertex as the signal process (hard interaction).
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_event_set_signal_process_vertex (evt_obj, v_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
        type(c_ptr), value :: v_obj
      end subroutine gen_event_set_signal_process_vertex
   end interface
 @ %def gen_event_set_signal_process_vertex
 <<HepMC interface: public>>=
   public :: hepmc_event_set_signal_process_vertex
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_set_signal_process_vertex (evt, v)
     type(hepmc_event_t), intent(inout) :: evt
     type(hepmc_vertex_t), intent(in) :: v
     call gen_event_set_signal_process_vertex (evt%obj, v%obj)
   end subroutine hepmc_event_set_signal_process_vertex
 
 @ %def hepmc_event_set_signal_process_vertex
 @ Return the the signal process (hard interaction).
 <<HepMC interface: interfaces>>=
   interface
      function gen_event_get_signal_process_vertex (evt_obj) &
           result (v_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
        type(c_ptr) :: v_obj
      end function gen_event_get_signal_process_vertex
   end interface
 @ %def gen_event_get_signal_process_vertex
 <<HepMC interface: public>>=
   public :: hepmc_event_get_signal_process_vertex
 <<HepMC interface: procedures>>=
   function hepmc_event_get_signal_process_vertex (evt) result (v)
     type(hepmc_event_t), intent(in) :: evt
     type(hepmc_vertex_t) :: v
     v%obj = gen_event_get_signal_process_vertex (evt%obj)
   end function hepmc_event_get_signal_process_vertex
 
 @ %def hepmc_event_get_signal_process_vertex
 @ Set the beam particles explicitly.
 <<HepMC interface: public>>=
   public :: hepmc_event_set_beam_particles
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_set_beam_particles (evt, prt1, prt2)
     type(hepmc_event_t), intent(inout) :: evt
     type(hepmc_particle_t), intent(in) :: prt1, prt2
     logical(c_bool) :: flag
     flag = gen_event_set_beam_particles (evt%obj, prt1%obj, prt2%obj)
   end subroutine hepmc_event_set_beam_particles
 
 @ %def hepmc_event_set_beam_particles
 @ The C function returns a boolean which we do not use.
 <<HepMC interface: interfaces>>=
   interface
      logical(c_bool) function gen_event_set_beam_particles &
           (evt_obj, prt1_obj, prt2_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj, prt1_obj, prt2_obj
      end function gen_event_set_beam_particles
   end interface
 
 @ %def gen_event_set_beam_particles
 @ Set the cross section and error explicitly.  Note that HepMC uses
 pb, while WHIZARD uses fb.
 <<HepMC interface: public>>=
   public :: hepmc_event_set_cross_section
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_set_cross_section (evt, xsec, xsec_err)
     type(hepmc_event_t), intent(inout) :: evt
     real(default), intent(in) :: xsec, xsec_err
     call gen_event_set_cross_section &
          (evt%obj, &
          real (xsec * 1e-3_default, c_double), &
          real (xsec_err * 1e-3_default, c_double))
   end subroutine hepmc_event_set_cross_section
 
 @ %def hepmc_event_set_cross_section
 @ The C function returns a boolean which we do not use.
 <<HepMC interface: interfaces>>=
   interface
      subroutine gen_event_set_cross_section (evt_obj, xs, xs_err) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: xs, xs_err
      end subroutine gen_event_set_cross_section
   end interface
 
 @ %def gen_event_set_cross_section
 @
 \subsection{Event-particle iterator}
 This iterator iterates over all particles in an event.  We store a
 pointer to the event in addition to the iterator.  This allows for
 simple end checking.
 
 The iterator is actually a constant iterator; it can only read.
 <<HepMC interface: public>>=
   public :: hepmc_event_particle_iterator_t
 <<HepMC interface: types>>=
   type :: hepmc_event_particle_iterator_t
      private
      type(c_ptr) :: obj
      type(c_ptr) :: evt_obj
   end type hepmc_event_particle_iterator_t
 
 @ %def hepmc_event_particle_iterator_t
 @ Constructor.  The iterator is initialized at the first particle in
 the event.
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function new_event_particle_const_iterator (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end function new_event_particle_const_iterator
   end interface
 @ %def new_event_particle_const_iterator
 <<HepMC interface: public>>=
   public :: hepmc_event_particle_iterator_init
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_particle_iterator_init (it, evt)
     type(hepmc_event_particle_iterator_t), intent(out) :: it
     type(hepmc_event_t), intent(in) :: evt
     it%obj = new_event_particle_const_iterator (evt%obj)
     it%evt_obj = evt%obj
   end subroutine hepmc_event_particle_iterator_init
 
 @ %def hepmc_event_particle_iterator_init
 @ Destructor.  Necessary because the iterator is allocated on the
 heap.
 <<HepMC interface: interfaces>>=
   interface
      subroutine event_particle_const_iterator_delete (it_obj) bind(C)
        import
        type(c_ptr), value :: it_obj
      end subroutine event_particle_const_iterator_delete
   end interface
 @ %def event_particle_const_iterator_delete
 <<HepMC interface: public>>=
   public :: hepmc_event_particle_iterator_final
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_particle_iterator_final (it)
     type(hepmc_event_particle_iterator_t), intent(inout) :: it
     call event_particle_const_iterator_delete (it%obj)
   end subroutine hepmc_event_particle_iterator_final
 
 @ %def hepmc_event_particle_iterator_final
 @ Increment
 <<HepMC interface: interfaces>>=
   interface
      subroutine event_particle_const_iterator_advance (it_obj) bind(C)
        import
        type(c_ptr), value :: it_obj
      end subroutine event_particle_const_iterator_advance
   end interface
 @ %def event_particle_const_iterator_advance
 <<HepMC interface: public>>=
   public :: hepmc_event_particle_iterator_advance
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_particle_iterator_advance (it)
     type(hepmc_event_particle_iterator_t), intent(inout) :: it
     call event_particle_const_iterator_advance (it%obj)
   end subroutine hepmc_event_particle_iterator_advance
 
 @ %def hepmc_event_particle_iterator_advance
 @ Reset to the beginning
 <<HepMC interface: interfaces>>=
   interface
      subroutine event_particle_const_iterator_reset (it_obj, evt_obj) bind(C)
        import
        type(c_ptr), value :: it_obj, evt_obj
      end subroutine event_particle_const_iterator_reset
   end interface
 @ %def event_particle_const_iterator_reset
 <<HepMC interface: public>>=
   public :: hepmc_event_particle_iterator_reset
 <<HepMC interface: procedures>>=
   subroutine hepmc_event_particle_iterator_reset (it)
     type(hepmc_event_particle_iterator_t), intent(inout) :: it
     call event_particle_const_iterator_reset (it%obj, it%evt_obj)
   end subroutine hepmc_event_particle_iterator_reset
 
 @ %def hepmc_event_particle_iterator_reset
 @ Test: return true as long as we are not past the end.
 <<HepMC interface: interfaces>>=
   interface
      function event_particle_const_iterator_is_valid &
           (it_obj, evt_obj) result (flag) bind(C)
        import
        logical(c_bool) :: flag
        type(c_ptr), value :: it_obj, evt_obj
      end function event_particle_const_iterator_is_valid
   end interface
 @ %def event_particle_const_iterator_is_valid
 <<HepMC interface: public>>=
   public :: hepmc_event_particle_iterator_is_valid
 <<HepMC interface: procedures>>=
   function hepmc_event_particle_iterator_is_valid (it) result (flag)
     logical :: flag
     type(hepmc_event_particle_iterator_t), intent(in) :: it
     flag = event_particle_const_iterator_is_valid (it%obj, it%evt_obj)
   end function hepmc_event_particle_iterator_is_valid
 
 @ %def hepmc_event_particle_iterator_is_valid
 @ Return the particle pointed to by the iterator.  (The particle
 object should not be finalized, since it contains merely a pointer to
 the particle which is owned by the vertex.)
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function event_particle_const_iterator_get (it_obj) bind(C)
        import
        type(c_ptr), value :: it_obj
      end function event_particle_const_iterator_get
   end interface
 @ %def event_particle_const_iterator_get
 <<HepMC interface: public>>=
   public :: hepmc_event_particle_iterator_get
 <<HepMC interface: procedures>>=
   function hepmc_event_particle_iterator_get (it) result (prt)
     type(hepmc_particle_t) :: prt
     type(hepmc_event_particle_iterator_t), intent(in) :: it
     prt%obj = event_particle_const_iterator_get (it%obj)
   end function hepmc_event_particle_iterator_get
 
 @ %def hepmc_event_particle_iterator_get
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function gen_event_get_nth_particle (evt_obj, n) bind(C)
        import
        type(c_ptr), value :: evt_obj
        integer(c_int), value :: n
      end function gen_event_get_nth_particle
   end interface
     interface
      integer(c_int) function gen_event_get_nth_beam (evt_obj, n) bind(C)
        import
        type(c_ptr), value :: evt_obj
        integer(c_int), value :: n
      end function gen_event_get_nth_beam
   end interface
 @ %def gen_event_get_nth_particle
 @ %def gen_event_get_nth_beam
 <<HepMC interface: public>>=
   public :: hepmc_event_get_nth_particle
   public :: hepmc_event_get_nth_beam
 <<HepMC interface: procedures>>=
   function hepmc_event_get_nth_particle (evt, n) result (prt)
     type(hepmc_particle_t) :: prt
     type(hepmc_event_t), intent(in) :: evt
     integer, intent(in) :: n
     integer :: n_tot
     integer(c_int) :: nth
     nth = n
     n_tot = gen_event_get_n_particles (evt%obj)
     if (n > n_tot .or. n < 1) then
        prt%obj = c_null_ptr
        call msg_error ("HepMC interface called for wrong particle ID.")       
     else
        prt%obj = gen_event_get_nth_particle (evt%obj, nth)
     end if
   end function hepmc_event_get_nth_particle
 
   function hepmc_event_get_nth_beam (evt, n) result (beam_barcode)
     integer :: beam_barcode
     type(hepmc_event_t), intent(in) :: evt
     integer, intent(in) :: n
     integer(c_int) :: bc
     bc = gen_event_get_nth_beam (evt%obj, n)
     beam_barcode = bc
   end function hepmc_event_get_nth_beam
 
 @ %def hepmc_event_get_nth_particle
 @ %def hepmc_event_get_nth_beam
 @
 \subsection{I/O streams}
 There is a specific I/O stream type for handling the output of
 GenEvent objects (i.e., Monte Carlo event samples) to file.  Opening
 the file is done by the constructor, closing by the destructor.
 <<HepMC interface: public>>=
   public :: hepmc_iostream_t
 <<HepMC interface: types>>=
   type :: hepmc_iostream_t
      private
      type(c_ptr) :: obj
   end type hepmc_iostream_t
 
 @ %def hepmc_iostream_t
 @ Constructor for an output stream associated to a file.
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function new_io_gen_event_out (filename) bind(C)
        import
        character(c_char), dimension(*), intent(in) :: filename
      end function new_io_gen_event_out
   end interface
   interface
      type(c_ptr) function new_io_gen_event_out_hepmc2 (filename) bind(C)
        import
        character(c_char), dimension(*), intent(in) :: filename
      end function new_io_gen_event_out_hepmc2
   end interface
 @ %def new_io_gen_event_out new_io_gen_event_out_hepmc2
 <<HepMC interface: public>>=
   public :: hepmc_iostream_open_out
 <<HepMC interface: procedures>>=
   subroutine hepmc_iostream_open_out (iostream, filename, hepmc2)
     type(hepmc_iostream_t), intent(out) :: iostream
     type(string_t), intent(in) :: filename
     logical, intent(in), optional :: hepmc2
     logical :: hepmc2_mode
     hepmc2_mode = .false.
     if (present (hepmc2))  hepmc2_mode = hepmc2
     if (hepmc2_mode) then
        iostream%obj = &
             new_io_gen_event_out_hepmc2 (char (filename) // c_null_char)
     else
        iostream%obj = &
             new_io_gen_event_out (char (filename) // c_null_char)
     end if
   end subroutine hepmc_iostream_open_out
 
 @ %def hepmc_iostream_open_out
 @ Constructor for an input stream associated to a file.
 <<HepMC interface: interfaces>>=
   interface
      type(c_ptr) function new_io_gen_event_in (filename) bind(C)
        import
        character(c_char), dimension(*), intent(in) :: filename
      end function new_io_gen_event_in
   end interface
   interface
      type(c_ptr) function new_io_gen_event_in_hepmc2 (filename) bind(C)
        import
        character(c_char), dimension(*), intent(in) :: filename
      end function new_io_gen_event_in_hepmc2
   end interface
 @ %def new_io_gen_event_in new_io_gen_event_in_hepmc
 <<HepMC interface: public>>=
   public :: hepmc_iostream_open_in
 <<HepMC interface: procedures>>=
   subroutine hepmc_iostream_open_in (iostream, filename, hepmc2)
     type(hepmc_iostream_t), intent(out) :: iostream
     type(string_t), intent(in) :: filename
     logical, intent(in), optional :: hepmc2
     logical :: hepmc2_mode
     hepmc2_mode = .false.
     if (present (hepmc2))  hepmc2_mode = hepmc2
     if (hepmc2_mode) then
        iostream%obj = &
             new_io_gen_event_in_hepmc2 (char (filename) // c_null_char)
     else
        iostream%obj = &
             new_io_gen_event_in (char (filename) // c_null_char)
     end if
   end subroutine hepmc_iostream_open_in
 
 @ %def hepmc_iostream_open_in
 @ Destructor:
 <<HepMC interface: interfaces>>=
   interface
      subroutine io_gen_event_delete (io_obj) bind(C)
        import
        type(c_ptr), value :: io_obj
      end subroutine io_gen_event_delete
   end interface
   interface
      subroutine io_gen_event_delete_hepmc2 (io_obj) bind(C)
        import
        type(c_ptr), value :: io_obj
      end subroutine io_gen_event_delete_hepmc2
   end interface  
 @ %def io_gen_event_delete io_gen_event_delete
 <<HepMC interface: public>>=
   public :: hepmc_iostream_close
 <<HepMC interface: procedures>>=
   subroutine hepmc_iostream_close (iostream, hepmc2)
     type(hepmc_iostream_t), intent(inout) :: iostream
     logical, intent(in), optional :: hepmc2
     logical :: hepmc2_mode
     hepmc2_mode = .false.
     if (present (hepmc2))  hepmc2_mode = hepmc2
     if (hepmc2_mode) then
        call io_gen_event_delete_hepmc2 (iostream%obj)
     else
        call io_gen_event_delete (iostream%obj)
     end if
   end subroutine hepmc_iostream_close
 
 @ %def hepmc_iostream_close
 @ Write a single event to the I/O stream.
 <<HepMC interface: interfaces>>=
   interface
      subroutine io_gen_event_write_event (io_obj, evt_obj) bind(C)
        import
        type(c_ptr), value :: io_obj, evt_obj
      end subroutine io_gen_event_write_event
   end interface
   interface
      subroutine io_gen_event_write_event_hepmc2 (io_obj, evt_obj) bind(C)
        import
        type(c_ptr), value :: io_obj, evt_obj
      end subroutine io_gen_event_write_event_hepmc2  
   end interface
 @ %def io_gen_event_write_event io_gen_event_write_event_hepmc2
 <<HepMC interface: public>>=
   public :: hepmc_iostream_write_event
 <<HepMC interface: procedures>>=
   subroutine hepmc_iostream_write_event (iostream, evt, hepmc2)
     type(hepmc_iostream_t), intent(inout) :: iostream
     type(hepmc_event_t), intent(in) :: evt
     logical, intent(in), optional :: hepmc2
     logical :: hepmc2_mode
     hepmc2_mode = .false.
     if (present (hepmc2))  hepmc2_mode = hepmc2
     if (hepmc2_mode) then
        call io_gen_event_write_event_hepmc2 (iostream%obj, evt%obj)
     else
        call io_gen_event_write_event (iostream%obj, evt%obj)
     end if
   end subroutine hepmc_iostream_write_event
 
 @ %def hepmc_iostream_write_event
 @ Read a single event from the I/O stream.  Return true if successful.
 <<HepMC interface: interfaces>>=
   interface
      logical(c_bool) function io_gen_event_read_event (io_obj, evt_obj) bind(C)
        import
        type(c_ptr), value :: io_obj, evt_obj
      end function io_gen_event_read_event
   end interface
   interface
      logical(c_bool) function io_gen_event_read_event_hepmc2 (io_obj, evt_obj) bind(C)
        import
        type(c_ptr), value :: io_obj, evt_obj
      end function io_gen_event_read_event_hepmc2
   end interface
 @ %def io_gen_event_read_event io_gen_event_read_event_hepmc2
 <<HepMC interface: public>>=
   public :: hepmc_iostream_read_event
 <<HepMC interface: procedures>>=
   subroutine hepmc_iostream_read_event (iostream, evt, ok, hepmc2)
     type(hepmc_iostream_t), intent(inout) :: iostream
     type(hepmc_event_t), intent(inout) :: evt
     logical, intent(out) :: ok
     logical, intent(in), optional :: hepmc2
     logical :: hepmc2_mode
     hepmc2_mode = .false.
     if (present (hepmc2))  hepmc2_mode = hepmc2
     if (hepmc2_mode) then
        ok = io_gen_event_read_event_hepmc2 (iostream%obj, evt%obj)
     else
        ok = io_gen_event_read_event (iostream%obj, evt%obj)
     end if
   end subroutine hepmc_iostream_read_event
 
 @ %def hepmc_iostream_read_event
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[hepmc_interface_ut.f90]]>>=
 <<File header>>
 
 module hepmc_interface_ut
   use unit_tests
   use system_dependencies, only: HEPMC2_AVAILABLE
   use system_dependencies, only: HEPMC3_AVAILABLE
   use hepmc_interface_uti
 
 <<Standard module head>>
 
 <<HepMC interface: public test>>
 
 contains
 
 <<HepMC interface: test driver>>
 
 end module hepmc_interface_ut
 @ %def hepmc_interface_ut
 @
 <<[[hepmc_interface_uti.f90]]>>=
 <<File header>>
 
 module hepmc_interface_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use lorentz
   use flavors
   use colors
   use polarizations
 
   use hepmc_interface
 
 <<Standard module head>>
 
 <<HepMC interface: test declarations>>
 
 contains
 
 <<HepMC interface: tests>>
 
 end module hepmc_interface_uti
 @ %def hepmc_interface_ut
 @ API: driver for the unit tests below.
 <<HepMC interface: public test>>=
   public :: hepmc_interface_test
 <<HepMC interface: test driver>>=
   subroutine hepmc_interface_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<HepMC interface: execute tests>>
   end subroutine hepmc_interface_test
 
 @  %def hepmc_test
 @
 This test example is an abridged version from the build-from-scratch
 example in the HepMC distribution.  We create two vertices for $p\to
 q$ PDF splitting, then a vertex for a $qq\to W^-g$ hard-interaction
 process, and finally a vertex for $W^-\to qq$ decay.  The setup is for
 LHC kinematics.
 
 Extending the original example, we set color flow for the incoming
 quarks and polarization for the outgoing photon.  For the latter, we
 have to define a particle-data object for the photon, so a flavor
 object can be correctly initialized.
 <<HepMC interface: execute tests>>=
   if (HEPMC2_AVAILABLE) then
      call test (hepmc_interface_1, "hepmc2_interface_1", &
           "check HepMC2 interface", &
           u, results)
   else if (HEPMC3_AVAILABLE) then
      call test (hepmc_interface_1, "hepmc3_interface_1", &
           "check HepMC3 interface", &
           u, results)
   end if
 <<HepMC interface: test declarations>>=
   public :: hepmc_interface_1
 <<HepMC interface: tests>>=
   subroutine hepmc_interface_1 (u)
     use physics_defs, only: VECTOR
     use model_data, only: field_data_t
     integer, intent(in) :: u
     integer :: u_file, iostat
     type(hepmc_event_t) :: evt
     type(hepmc_vertex_t) :: v1, v2, v3, v4
     type(hepmc_particle_t) :: prt1, prt2, prt3, prt4, prt5, prt6, prt7, prt8
     type(hepmc_iostream_t) :: iostream
     type(flavor_t) :: flv
     type(color_t) :: col
     type(polarization_t) :: pol
     type(field_data_t), target :: photon_data
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: HepMC interface"
     write (u, "(A)")  "*   Purpose: test HepMC interface"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     ! Initialize a photon flavor object and some polarization
     call photon_data%init (var_str ("PHOTON"), 22)
     call photon_data%set (spin_type=VECTOR)
     call photon_data%freeze ()
     call flv%init (photon_data)
     call pol%init_angles &
          (flv, 0.6_default, 1._default, 0.5_default)
 
     ! Event initialization
     call hepmc_event_init (evt, 20, 1)
 
     write (u, "(A)")  "* p -> q splitting"
     write (u, "(A)")
 
     ! $p\to q$ splittings
     call hepmc_vertex_init (v1)
     call hepmc_event_add_vertex (evt, v1)
     call hepmc_vertex_init (v2)
     call hepmc_event_add_vertex (evt, v2)
     call particle_init (prt1, &
          0._default, 0._default, 7000._default, 7000._default, &
          2212, 3)
     call hepmc_vertex_add_particle_in (v1, prt1)
     call particle_init (prt2, &
          0._default, 0._default,-7000._default, 7000._default, &
          2212, 3)
     call hepmc_vertex_add_particle_in (v2, prt2)
     call particle_init (prt3, &
          .750_default, -1.569_default, 32.191_default, 32.238_default, &
          1, 3)
     call color_init_from_array (col, [501])
     call hepmc_particle_set_color (prt3, col)
     call hepmc_vertex_add_particle_out (v1, prt3)
     call particle_init (prt4, &
          -3.047_default, -19._default, -54.629_default, 57.920_default, &
          -2, 3)
     call color_init_from_array (col, [-501])
     call hepmc_particle_set_color (prt4, col)
     call hepmc_vertex_add_particle_out (v2, prt4)
 
     write (u, "(A)")  "* Hard interaction"
     write (u, "(A)")
 
     ! Hard interaction
     call hepmc_vertex_init (v3)
     call hepmc_event_add_vertex (evt, v3)
     call hepmc_vertex_add_particle_in (v3, prt3)
     call hepmc_vertex_add_particle_in (v3, prt4)
     call particle_init (prt6, &
          -3.813_default, 0.113_default, -1.833_default, 4.233_default, &
          22, 1)
     call hepmc_particle_set_polarization (prt6, pol)
     call hepmc_vertex_add_particle_out (v3, prt6)
     call particle_init (prt5, &
          1.517_default, -20.68_default, -20.605_default, 85.925_default, &
          -24, 3)
     call hepmc_vertex_add_particle_out (v3, prt5)
     call hepmc_event_set_signal_process_vertex (evt, v3)
 
     ! $W^-$ decay
     call vertex_init_pos (v4, &
          0.12_default, -0.3_default, 0.05_default, 0.004_default)
     call hepmc_event_add_vertex (evt, v4)
     call hepmc_vertex_add_particle_in (v4, prt5)
     call particle_init (prt7, &
          -2.445_default, 28.816_default, 6.082_default, 29.552_default, &
          1, 1)
     call hepmc_vertex_add_particle_out (v4, prt7)
     call particle_init (prt8, &
          3.962_default, -49.498_default, -26.687_default, 56.373_default, &
          -2, 1)
     call hepmc_vertex_add_particle_out (v4, prt8)
 
     ! Event output
     call hepmc_event_print (evt)
     write (u, "(A)")  "Writing to file 'hepmc_test.hepmc'"
     write (u, "(A)")
 
     call hepmc_iostream_open_out (iostream , var_str ("hepmc_test.hepmc"))
     call hepmc_iostream_write_event (iostream, evt)
     call hepmc_iostream_close (iostream)
 
     write (u, "(A)")  "Writing completed"
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = "hepmc_test.hepmc", &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:14) == "HepMC::Version")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
     write (u, "(A)")
 
     ! Wrapup
     ! call pol%final ()
     call hepmc_event_final (evt)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: hepmc_interface_1"
 
   contains
 
     subroutine vertex_init_pos (v, x, y, z, t)
       type(hepmc_vertex_t), intent(out) :: v
       real(default), intent(in) :: x, y, z, t
       type(vector4_t) :: xx
       xx = vector4_moving (t, vector3_moving ([x, y, z]))
       call hepmc_vertex_init (v, xx)
     end subroutine vertex_init_pos
 
     subroutine particle_init (prt, px, py, pz, E, pdg, status)
       type(hepmc_particle_t), intent(out) :: prt
       real(default), intent(in) :: px, py, pz, E
       integer, intent(in) :: pdg, status
       type(vector4_t) :: p
       p = vector4_moving (E, vector3_moving ([px, py, pz]))
       call hepmc_particle_init (prt, p, pdg, status)
     end subroutine particle_init
 
   end subroutine hepmc_interface_1
 
 @ %def hepmc_interface_1
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{LCIO events}
 This section provides the interface to the LCIO C++ library for handling
 Monte-Carlo events.
 
 Each C++ class of LCIO that we use is mirrored by a Fortran type,
 which contains as its only component the C pointer to the C++ object.
 
 Each C++ method of LCIO that we use has a C wrapper function.  This
 function takes a pointer to the host object as its first argument.
 Further arguments are either C pointers, or in the case of simple
 types (integer, real), interoperable C/Fortran objects.
 
 The C wrapper functions have explicit interfaces in the Fortran
 module.  They are called by Fortran wrapper procedures.  These are
 treated as methods of the corresponding Fortran type.
 <<[[lcio_interface.f90]]>>=
 <<File header>>
 
 module lcio_interface
 
   use, intrinsic :: iso_c_binding !NODEP!
 
 <<Use kinds>>
 <<Use strings>>
   use constants, only: PI
   use physics_defs, only: ns_per_mm
   use diagnostics
   use lorentz
   use flavors
   use colors
   use helicities
   use polarizations
 
 <<Standard module head>>
 
 <<LCIO interface: public>>
 
 <<LCIO interface: types>>
 
 <<LCIO interface: interfaces>>
 
 contains
 
 <<LCIO interface: procedures>>
 
 end module lcio_interface
 @ %def lcio_interface
 @
 \subsection{Interface check}
 This function can be called in order to verify that we are using the
 actual LCIO library, and not the dummy version.
 <<LCIO interface: interfaces>>=
   interface
      logical(c_bool) function lcio_available () bind(C)
        import
      end function lcio_available
   end interface
 <<LCIO interface: public>>=
   public :: lcio_is_available
 <<LCIO interface: procedures>>=
   function lcio_is_available () result (flag)
     logical :: flag
     flag = lcio_available ()
   end function lcio_is_available
 
 @ %def lcio_is_available
 @
 \subsection{LCIO Run Header}
 This is a type for the run header of the LCIO file.
 <<LCIO interface: public>>=
   public :: lcio_run_header_t
 <<LCIO interface: types>>=
   type :: lcio_run_header_t
      private
      type(c_ptr) :: obj
   end type lcio_run_header_t
 
 @ %def lcio_run_header_t
 The Fortran version has initializer form.
 <<LCIO interface: interfaces>>=
   interface
      type(c_ptr) function new_lcio_run_header (proc_id) bind(C)
        import
        integer(c_int), value :: proc_id
      end function new_lcio_run_header
   end interface
 @ %def new_lcio_run_header
 <<LCIO interface: interfaces>>=
   interface
      subroutine run_header_set_simstring &
           (runhdr_obj, simstring) bind(C)
        import
        type(c_ptr), value :: runhdr_obj
        character(c_char), dimension(*), intent(in) :: simstring
      end subroutine run_header_set_simstring
   end interface
 @ %def run_header_set_simstring
 <<LCIO interface: public>>=
   public :: lcio_run_header_init
 <<LCIO interface: procedures>>=
   subroutine lcio_run_header_init (runhdr, proc_id, run_id)
     type(lcio_run_header_t), intent(out) :: runhdr
     integer, intent(in), optional :: proc_id, run_id
     integer(c_int) :: rid
     rid = 0; if (present (run_id))  rid = run_id
     runhdr%obj = new_lcio_run_header (rid)
     call run_header_set_simstring (runhdr%obj, &
          "WHIZARD version:" // "<<Version>>")
   end subroutine lcio_run_header_init
 
 @ %def lcio_run_header_init
 @
 <<LCIO interface: interfaces>>=
   interface
      subroutine write_run_header (lcwrt_obj, runhdr_obj) bind(C)
        import
        type(c_ptr), value :: lcwrt_obj
        type(c_ptr), value :: runhdr_obj
      end subroutine write_run_header
   end interface
 @ %def write_run_header
 <<LCIO interface: public>>=
   public :: lcio_run_header_write
 <<LCIO interface: procedures>>=
   subroutine lcio_run_header_write (wrt, hdr)
     type(lcio_writer_t), intent(inout) :: wrt
     type(lcio_run_header_t), intent(inout) :: hdr
     call write_run_header (wrt%obj, hdr%obj)
   end subroutine lcio_run_header_write
 
 @ %def lcio_run_header_write
 @
 \subsection{LCIO Event and LC Collection}
 The main object of LCIO is a LCEventImpl.  The object is filled by
 MCParticle objects, which are set as LCCollection.
 <<LCIO interface: public>>=
   public :: lccollection_t
 <<LCIO interface: types>>=
   type :: lccollection_t
      private
      type(c_ptr) :: obj
   end type lccollection_t
 
 @ %def lccollection_t
 @ Initializer.
 <<LCIO interface: interfaces>>=
   interface
      type(c_ptr) function new_lccollection () bind(C)
        import
      end function new_lccollection
   end interface
 @ %def new_lccollection
 <<LCIO interface: public>>=
   public :: lcio_event_t
 <<LCIO interface: types>>=
   type :: lcio_event_t
      private
      type(c_ptr) :: obj
      type(lccollection_t) :: lccoll
   end type lcio_event_t
 
 @ %def lcio_event_t
 @ Constructor.  Arguments are process ID (integer) and event ID
 (integer).
 
 The Fortran version has initializer form.
 <<LCIO interface: interfaces>>=
   interface
      type(c_ptr) function new_lcio_event (proc_id, event_id, run_id) bind(C)
        import
        integer(c_int), value :: proc_id, event_id, run_id
      end function new_lcio_event
   end interface
 @ %def new_lcio_event
 @
 <<LCIO interface: public>>=
   public :: lcio_event_init
 <<LCIO interface: procedures>>=
   subroutine lcio_event_init (evt, proc_id, event_id, run_id)
     type(lcio_event_t), intent(out) :: evt
     integer, intent(in), optional :: proc_id, event_id, run_id
     integer(c_int) :: pid, eid, rid
     pid = 0;  if (present (proc_id))  pid = proc_id
     eid = 0;  if (present (event_id)) eid = event_id
     rid = 0;  if (present (run_id))   rid = run_id
     evt%obj = new_lcio_event (pid, eid, rid)
     evt%lccoll%obj = new_lccollection ()
   end subroutine lcio_event_init
 
 @ %def lcio_event_init
 @ Destructor.
 <<LCIO interface: interfaces>>=
   interface
      subroutine lcio_event_delete (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end subroutine lcio_event_delete
   end interface
 @ %def lcio_event_delete
 @ Show event on screen.
 <<LCIO interface: interfaces>>=
   interface
      subroutine dump_lcio_event (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end subroutine dump_lcio_event
   end interface
 @ %def dump_lcio_event
 <<LCIO interface: public>>=
   public :: show_lcio_event
 <<LCIO interface: procedures>>=
   subroutine show_lcio_event (evt)
     type(lcio_event_t), intent(in) :: evt
     if (c_associated (evt%obj)) then
        call dump_lcio_event (evt%obj)
     else
        call msg_error ("LCIO event is not allocated.")
     end if
   end subroutine show_lcio_event
 
 @ %def show_lcio_event
 @ Put a single event to file.
 <<LCIO interface: interfaces>>=
   interface
      subroutine lcio_event_to_file (evt_obj, filename) bind(C)
        import
        type(c_ptr), value :: evt_obj
        character(c_char), dimension(*), intent(in) :: filename
      end subroutine lcio_event_to_file
   end interface
 @ %def lcio_event_to_file
 <<LCIO interface: public>>=
   public :: write_lcio_event
 <<LCIO interface: procedures>>=
   subroutine write_lcio_event (evt, filename)
     type(lcio_event_t), intent(in) :: evt
     type(string_t), intent(in) :: filename
     call lcio_event_to_file (evt%obj, char (filename) // c_null_char)
   end subroutine write_lcio_event
 
 @ %def write_lcio_event
 @
 <<LCIO interface: public>>=
   public :: lcio_event_final
 <<LCIO interface: procedures>>=
   subroutine lcio_event_final (evt)
     type(lcio_event_t), intent(inout) :: evt
     call lcio_event_delete (evt%obj)
   end subroutine lcio_event_final
 
 @ %def lcio_event_final
 @
 <<LCIO interface: interfaces>>=
   interface
      subroutine lcio_set_weight (evt_obj, weight) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: weight
      end subroutine lcio_set_weight
   end interface
   interface
      subroutine lcio_set_alpha_qcd (evt_obj, alphas) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: alphas
      end subroutine lcio_set_alpha_qcd
   end interface
   interface
      subroutine lcio_set_scale (evt_obj, scale) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: scale
      end subroutine lcio_set_scale
   end interface
   interface
      subroutine lcio_set_sqrts (evt_obj, sqrts) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: sqrts
      end subroutine lcio_set_sqrts
   end interface
   interface
      subroutine lcio_set_xsec (evt_obj, xsec, xsec_err) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: xsec, xsec_err
      end subroutine lcio_set_xsec
   end interface
   interface
      subroutine lcio_set_beam (evt_obj, pdg, beam) bind(C)
        import
        type(c_ptr), value :: evt_obj
        integer(c_int), value :: pdg, beam
      end subroutine lcio_set_beam
   end interface
   interface
      subroutine lcio_set_pol (evt_obj, pol1, pol2) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: pol1, pol2
      end subroutine lcio_set_pol
   end interface
   interface
      subroutine lcio_set_beam_file (evt_obj, file) bind(C)
        import
        type(c_ptr), value :: evt_obj
        character(len=1, kind=c_char), dimension(*), intent(in) :: file
      end subroutine lcio_set_beam_file
   end interface
   interface
      subroutine lcio_set_process_name (evt_obj, name) bind(C)
        import
        type(c_ptr), value :: evt_obj
        character(len=1, kind=c_char), dimension(*), intent(in) :: name
      end subroutine lcio_set_process_name
   end interface
   interface
      subroutine lcio_set_sqme (evt_obj, sqme) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: sqme
      end subroutine lcio_set_sqme
   end interface
   interface
      subroutine lcio_set_alt_sqme (evt_obj, sqme, index) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: sqme
        integer(c_int), value :: index
      end subroutine lcio_set_alt_sqme
   end interface
   interface
      subroutine lcio_set_alt_weight (evt_obj, weight, index) bind(C)
        import
        type(c_ptr), value :: evt_obj
        real(c_double), value :: weight
        integer(c_int), value :: index
      end subroutine lcio_set_alt_weight
   end interface
 @ %def lcio_set_weight lcio_set_alpha_qcd lcio_set_scale lcio_set_sqrts
 @ %def lcio_set_xsec lcio_set_beam lcio_set_pol
 @ %def lcio_set_beam_file lcio_set_process_name
 @ %def lcio_set_sqme lcio_set_alt_sqme lcio_set_alt_weight
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_weight
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_weight (evt, weight)
     type(lcio_event_t), intent(inout) :: evt
     real(default), intent(in) :: weight
     call lcio_set_weight (evt%obj, real (weight, c_double))
   end subroutine lcio_event_set_weight
 
 @ %def lcio_event_set_weight
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_alpha_qcd
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_alpha_qcd (evt, alphas)
     type(lcio_event_t), intent(inout) :: evt
     real(default), intent(in) :: alphas
     call lcio_set_alpha_qcd (evt%obj, real (alphas, c_double))
   end subroutine lcio_event_set_alpha_qcd
 
 @ %def lcio_event_set_alpha_qcd
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_scale
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_scale (evt, scale)
     type(lcio_event_t), intent(inout) :: evt
     real(default), intent(in) :: scale
     call lcio_set_scale (evt%obj, real (scale, c_double))
   end subroutine lcio_event_set_scale
 
 @ %def lcio_event_set_scale
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_sqrts
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_sqrts (evt, sqrts)
     type(lcio_event_t), intent(inout) :: evt
     real(default), intent(in) :: sqrts
     call lcio_set_sqrts (evt%obj, real (sqrts, c_double))
   end subroutine lcio_event_set_sqrts
 
 @ %def lcio_event_set_sqrts
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_xsec
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_xsec (evt, xsec, xsec_err)
     type(lcio_event_t), intent(inout) :: evt
     real(default), intent(in) :: xsec, xsec_err
     call lcio_set_xsec (evt%obj, &
          real (xsec, c_double), real (xsec_err, c_double))
   end subroutine lcio_event_set_xsec
 
 @ %def lcio_event_set_xsec
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_beam
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_beam (evt, pdg, beam)
     type(lcio_event_t), intent(inout) :: evt
     integer, intent(in) :: pdg, beam
     call lcio_set_beam (evt%obj, &
          int (pdg, c_int), int (beam, c_int))
   end subroutine lcio_event_set_beam
 
 @ %def lcio_event_set_beam
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_polarization
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_polarization (evt, pol)
     type(lcio_event_t), intent(inout) :: evt
     real(default), intent(in), dimension(2) :: pol
     call lcio_set_pol (evt%obj, &
          real (pol(1), c_double), real (pol(2), c_double))
   end subroutine lcio_event_set_polarization
 
 @ %def lcio_event_set_polarization
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_beam_file
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_beam_file (evt, file)
     type(lcio_event_t), intent(inout) :: evt
     type(string_t), intent(in) :: file
     call lcio_set_beam_file (evt%obj, &
          char (file) // c_null_char)
   end subroutine lcio_event_set_beam_file
 
 @ %def lcio_event_set_beam_file
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_process_name
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_process_name (evt, name)
     type(lcio_event_t), intent(inout) :: evt
     type(string_t), intent(in) :: name
     call lcio_set_process_name (evt%obj, &
          char (name) // c_null_char)
   end subroutine lcio_event_set_process_name
 
 @ %def lcio_event_set_process_name
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_alt_sqme
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_alt_sqme (evt, sqme, index)
     type(lcio_event_t), intent(inout) :: evt
     real(default), intent(in) :: sqme
     integer, intent(in) :: index
     call lcio_set_alt_sqme (evt%obj, real (sqme, c_double), &
          int (index, c_int))
   end subroutine lcio_event_set_alt_sqme
 
 @ %def lcio_event_set_alt_sqme
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_sqme
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_sqme (evt, sqme)
     type(lcio_event_t), intent(inout) :: evt
     real(default), intent(in) :: sqme
     call lcio_set_sqme (evt%obj, real (sqme, c_double))
   end subroutine lcio_event_set_sqme
 
 @ %def lcio_event_set_sqme
 @
 <<LCIO interface: public>>=
   public :: lcio_event_set_alt_weight
 <<LCIO interface: procedures>>=
   subroutine lcio_event_set_alt_weight (evt, weight, index)
     type(lcio_event_t), intent(inout) :: evt
     real(default), intent(in) :: weight
     integer, intent(in) :: index
     call lcio_set_alt_weight (evt%obj, real (weight, c_double), &
          int (index, c_int))
   end subroutine lcio_event_set_alt_weight
 
 @ %def lcio_event_set_alt_weight
 @
 <<LCIO interface: interfaces>>=
   interface
      subroutine lcio_event_add_collection &
           (evt_obj, lccoll_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj, lccoll_obj
      end subroutine lcio_event_add_collection
   end interface
 @ %def lcio_event_add_collection
 <<LCIO interface: public>>=
   public :: lcio_event_add_coll
 <<LCIO interface: procedures>>=
   subroutine lcio_event_add_coll (evt)
     type(lcio_event_t), intent(inout) :: evt
     call lcio_event_add_collection (evt%obj, &
          evt%lccoll%obj)
   end subroutine lcio_event_add_coll
 
 @ %def lcio_event_add_coll
 @
 \subsection{LCIO Particle}
 Particle objects have the obvious meaning.
 <<LCIO interface: public>>=
   public :: lcio_particle_t
 <<LCIO interface: types>>=
   type :: lcio_particle_t
      private
      type(c_ptr) :: obj
   end type lcio_particle_t
 
 @ %def lcio_particle_t
 @ Constructor.
 <<LCIO interface: interfaces>>=
   interface
      type(c_ptr) function new_lcio_particle &
           (px, py, pz, pdg_id, mass, charge, status) bind(C)
        import
        integer(c_int), value :: pdg_id, status
        real(c_double), value :: px, py, pz, mass, charge
      end function new_lcio_particle
   end interface
 @ %def new_lcio_particle
 @
 <<LCIO interface: interfaces>>=
   interface
      subroutine add_particle_to_collection &
           (prt_obj, lccoll_obj) bind(C)
        import
        type(c_ptr), value :: prt_obj, lccoll_obj
      end subroutine add_particle_to_collection
   end interface
 @ %def add_particle_to_collection
 <<LCIO interface: public>>=
   public :: lcio_particle_add_to_evt_coll
 <<LCIO interface: procedures>>=
   subroutine lcio_particle_add_to_evt_coll &
        (lprt, evt)
     type(lcio_particle_t), intent(in) :: lprt
     type(lcio_event_t), intent(inout) :: evt
     call add_particle_to_collection (lprt%obj, evt%lccoll%obj)
   end subroutine lcio_particle_add_to_evt_coll
 
 @ %def lcio_particle_to_collection
 @
 <<LCIO interface: public>>=
   public :: lcio_particle_init
 <<LCIO interface: procedures>>=
   subroutine lcio_particle_init (prt, p, pdg, charge, status)
     type(lcio_particle_t), intent(out) :: prt
     type(vector4_t), intent(in) :: p
     real(default), intent(in) :: charge
     real(default) :: mass
     real(default) :: px, py, pz
     integer, intent(in) :: pdg, status
     px = vector4_get_component (p, 1)
     py = vector4_get_component (p, 2)
     pz = vector4_get_component (p, 3)
     mass = p**1
     prt%obj = new_lcio_particle (real (px, c_double), real (py, c_double), &
          real (pz, c_double), int (pdg, c_int), &
          real (mass, c_double), real (charge, c_double), int (status, c_int))
   end subroutine lcio_particle_init
 
 @ %def lcio_particle_init
 @ Set the particle color flow.
 <<LCIO interface: interfaces>>=
   interface
      subroutine lcio_set_color_flow (prt_obj, col1, col2) bind(C)
        import
        type(c_ptr), value :: prt_obj
        integer(c_int), value :: col1, col2
      end subroutine lcio_set_color_flow
   end interface
 @ %def lcio_set_color_flow
 @ Set the particle color.  Either from a [[color_t]] object or
 directly from a pair of integers.
 <<LCIO interface: interfaces>>=
   interface lcio_particle_set_color
      module procedure lcio_particle_set_color_col
      module procedure lcio_particle_set_color_int
   end interface lcio_particle_set_color
 <<LCIO interface: public>>=
   public :: lcio_particle_set_color
 <<LCIO interface: procedures>>=
   subroutine lcio_particle_set_color_col (prt, col)
     type(lcio_particle_t), intent(inout) :: prt
     type(color_t), intent(in) :: col
     integer(c_int), dimension(2) :: c
     c(1) = col%get_col ()
     c(2) = col%get_acl ()
     if (c(1) /= 0 .or. c(2) /= 0)  then
        call lcio_set_color_flow (prt%obj, c(1), c(2))
     end  if
   end subroutine lcio_particle_set_color_col
 
   subroutine lcio_particle_set_color_int (prt, col)
     type(lcio_particle_t), intent(inout) :: prt
     integer, dimension(2), intent(in) :: col
     integer(c_int), dimension(2) :: c
     c = col
     if (c(1) /= 0 .or. c(2) /= 0) then
        call lcio_set_color_flow (prt%obj, c(1), c(2))
     end if
   end subroutine lcio_particle_set_color_int
 
 @ %def lcio_particle_set_color
 @ Return the particle color as a two-dimensional array (color, anticolor).
 <<LCIO interface: interfaces>>=
   interface
      integer(c_int) function lcio_particle_flow (prt_obj, col_index) bind(C)
        use iso_c_binding !NODEP!
        type(c_ptr), value :: prt_obj
        integer(c_int), value :: col_index
      end function lcio_particle_flow
   end interface
 @ %def lcio_particle_flow
 <<LCIO interface: public>>=
   public :: lcio_particle_get_flow
 <<LCIO interface: procedures>>=
   function lcio_particle_get_flow (prt) result (col)
     integer, dimension(2) :: col
     type(lcio_particle_t), intent(in) :: prt
     col(1) = lcio_particle_flow (prt%obj, 0_c_int)
     col(2) = - lcio_particle_flow (prt%obj, 1_c_int)
   end function lcio_particle_get_flow
 
 @ %def lcio_particle_get_flow
 @ Return the four-momentum of a LCIO particle.
 <<LCIO interface: interfaces>>=
   interface
      real(c_double) function lcio_three_momentum (prt_obj, p_index) bind(C)
        use iso_c_binding !NODEP!
        type(c_ptr), value :: prt_obj
        integer(c_int), value :: p_index
      end function lcio_three_momentum
   end interface
 @ %def lcio_three_momentum
 <<LCIO interface: interfaces>>=
   interface
      real(c_double) function lcio_energy (prt_obj) bind(C)
        import
        type(c_ptr), intent(in), value :: prt_obj
      end function lcio_energy
   end interface
 @ %def lcio_energy
 <<LCIO interface: public>>=
   public :: lcio_particle_get_momentum
 <<LCIO interface: procedures>>=
   function lcio_particle_get_momentum (prt) result (p)
     type(vector4_t) :: p
     type(lcio_particle_t), intent(in) :: prt
     real(default) :: E, px, py, pz
     E = lcio_energy (prt%obj)
     px = lcio_three_momentum (prt%obj, 0_c_int)
     py = lcio_three_momentum (prt%obj, 1_c_int)
     pz = lcio_three_momentum (prt%obj, 2_c_int)
     p = vector4_moving ( E, vector3_moving ([ px, py, pz ]))
   end function lcio_particle_get_momentum
 
 @ %def lcio_particle_get_momentum
 @ Return the invariant mass squared of the particle object.  LCIO
 stores the signed invariant mass (no squaring).
 <<LCIO interface: interfaces>>=
   interface
      function lcio_mass (prt_obj) result (mass) bind(C)
        import
        real(c_double) :: mass
        type(c_ptr), value :: prt_obj
      end function lcio_mass
   end interface
 @ %def lcio_mass
 <<LCIO interface: public>>=
   public :: lcio_particle_get_mass_squared
 <<LCIO interface: procedures>>=
   function lcio_particle_get_mass_squared (prt) result (m2)
     real(default) :: m2
     type(lcio_particle_t), intent(in) :: prt
     real(default) :: m
     m = lcio_mass (prt%obj)
     m2 = sign (m**2, m)
   end function lcio_particle_get_mass_squared
 
 @ %def lcio_particle_get_mass_squared
 @ Return vertex and production time of a LCIO particle.
 <<LCIO interface: interfaces>>=
   interface
      real(c_double) function lcio_vtx_x (prt) bind(C)
        import
        type(c_ptr), value :: prt
      end function lcio_vtx_x
   end interface
   interface
      real(c_double) function lcio_vtx_y (prt) bind(C)
        import
        type(c_ptr), value :: prt
      end function lcio_vtx_y
   end interface
   interface
      real(c_double) function lcio_vtx_z (prt) bind(C)
        import
        type(c_ptr), value :: prt
      end function lcio_vtx_z
   end interface
   interface
      real(c_float) function lcio_prt_time (prt) bind(C)
        import
        type(c_ptr), value :: prt
      end function lcio_prt_time
   end interface
 @
 @
 (Decay) times in LCIO are in nanoseconds, so they need to get
 converted to mm for the internal format.
 <<LCIO interface: public>>=
   public :: lcio_particle_get_vertex
   public :: lcio_particle_get_time
 <<LCIO interface: procedures>>=
   function lcio_particle_get_vertex (prt) result (vtx)
     type(vector3_t) :: vtx
     type(lcio_particle_t), intent(in) :: prt
     real(default) :: vx, vy, vz
     vx = lcio_vtx_x (prt%obj)
     vy = lcio_vtx_y (prt%obj)
     vz = lcio_vtx_z (prt%obj)
     vtx = vector3_moving ([vx, vy, vz])
   end function lcio_particle_get_vertex
 
   function lcio_particle_get_time (prt) result (time)
     real(default) :: time
     type(lcio_particle_t), intent(in) :: prt
     time = lcio_prt_time (prt%obj)
     time = time / ns_per_mm
   end function lcio_particle_get_time
 
 @ %def lcio_particle_get_vertex lcio_particle_get_time
 @
 \subsection{Polarization}
 For polarization there is a three-component float entry foreseen in the LCIO
 format. Completely generic density matrices can in principle be attached to
 events as float vectors added to [[LCCollection]] of the [[LCEvent]]. This is
 not yet implemented currently. Here, we restrict ourselves to the same
 implementation as in HepMC format: we use two entries as the polarization
 angles, while the first entry gives the degree of polarization (something
 not specified in the HepMC format).
 \emph{For massive vector bosons, we arbitrarily choose the convention
   that the longitudinal (zero) helicity state is mapped to the theta
   angle $\pi/2$.  This works under the condition that helicity is
   projected onto one of the basis states.}
 
 <<LCIO interface: interfaces>>=
   interface
      subroutine lcio_particle_set_spin (prt_obj, s1, s2, s3) bind(C)
        import
        type(c_ptr), value :: prt_obj
        real(c_double), value :: s1, s2, s3
      end subroutine lcio_particle_set_spin
   end interface
 @ %def lcio_particle_set_spin
 @
 <<LCIO interface: public>>=
   public :: lcio_polarization_init
 <<LCIO interface: interfaces>>=
   interface lcio_polarization_init
      module procedure lcio_polarization_init_pol
      module procedure lcio_polarization_init_hel
      module procedure lcio_polarization_init_int
   end interface
 <<LCIO interface: procedures>>=
   subroutine lcio_polarization_init_pol (prt, pol)
     type(lcio_particle_t), intent(inout) :: prt
     type(polarization_t), intent(in) :: pol
     real(default) :: r, theta, phi
     if (pol%is_polarized ()) then
        call pol%to_angles (r, theta, phi)
        call lcio_particle_set_spin (prt%obj, &
             real(r, c_double), real (theta, c_double), real (phi, c_double))
     end if
   end subroutine lcio_polarization_init_pol
 
   subroutine lcio_polarization_init_hel (prt, hel)
     type(lcio_particle_t), intent(inout) :: prt
     type(helicity_t), intent(in) :: hel
     integer, dimension(2) :: h
     if (hel%is_defined ()) then
        h = hel%to_pair ()
        select case (h(1))
        case (1:)
           call lcio_particle_set_spin (prt%obj, 1._c_double, &
                0._c_double, 0._c_double)
        case (:-1)
           call lcio_particle_set_spin (prt%obj, 1._c_double, &
                real (pi, c_double), 0._c_double)
        case (0)
           call lcio_particle_set_spin (prt%obj, 1._c_double, &
                real (pi/2, c_double), 0._c_double)
        end select
     end if
   end subroutine lcio_polarization_init_hel
 
   subroutine lcio_polarization_init_int (prt, hel)
     type(lcio_particle_t), intent(inout) :: prt
     integer, intent(in) :: hel
     call lcio_particle_set_spin (prt%obj, 0._c_double, &
          0._c_double, real (hel, c_double))
   end subroutine lcio_polarization_init_int
 
 @ %def lcio_polarization_init
 @ Recover polarization from LCIO particle (with the
 abovementioned deficiencies).
 <<LCIO interface: interfaces>>=
   interface
      function lcio_polarization_degree (prt_obj) result (degree) bind(C)
        import
        real(c_double) :: degree
        type(c_ptr), value :: prt_obj
      end function lcio_polarization_degree
   end interface
   interface
      function lcio_polarization_theta (prt_obj) result (theta) bind(C)
        import
        real(c_double) :: theta
        type(c_ptr), value :: prt_obj
      end function lcio_polarization_theta
   end interface
   interface
      function lcio_polarization_phi (prt_obj) result (phi) bind(C)
        import
        real(c_double) :: phi
        type(c_ptr), value :: prt_obj
      end function lcio_polarization_phi
   end interface
 @ %def lcio_polarization_degree lcio_polarization_theta lcio_polarization_phi
 <<LCIO interface: public>>=
   public :: lcio_particle_to_pol
 <<LCIO interface: procedures>>=
   subroutine lcio_particle_to_pol (prt, flv, pol)
     type(lcio_particle_t), intent(in) :: prt
     type(flavor_t), intent(in) :: flv
     type(polarization_t), intent(out) :: pol
     real(default) :: degree, theta, phi
     degree = lcio_polarization_degree (prt%obj)
     theta = lcio_polarization_theta (prt%obj)
     phi = lcio_polarization_phi (prt%obj)
     call pol%init_angles (flv, degree, theta, phi)
   end subroutine lcio_particle_to_pol
 
 @ %def lcio_polarization_to_pol
 @ Recover helicity.  Here, $\phi$ and [[degree]] is ignored and only the sign of
 $\cos\theta$ is relevant, mapped to positive/negative helicity.
 <<LCIO interface: public>>=
   public :: lcio_particle_to_hel
 <<LCIO interface: procedures>>=
   subroutine lcio_particle_to_hel (prt, flv, hel)
     type(lcio_particle_t), intent(in) :: prt
     type(flavor_t), intent(in) :: flv
     type(helicity_t), intent(out) :: hel
     real(default) :: theta
     integer :: hmax
     theta = lcio_polarization_theta (prt%obj)
     hmax = flv%get_spin_type () / 2
     call hel%init (sign (hmax, nint (cos (theta))))
   end subroutine lcio_particle_to_hel
 
 @ %def lcio_particle_to_hel
 @ Set the vertex of a particle.
 <<LCIO interface: interfaces>>=
   interface
      subroutine lcio_particle_set_vertex (prt_obj, vx, vy, vz) bind(C)
        import
        type(c_ptr), value :: prt_obj
        real(c_double), value :: vx, vy, vz
      end subroutine lcio_particle_set_vertex
   end interface
   interface
      subroutine lcio_particle_set_time (prt_obj, t) bind(C)
        import
        type(c_ptr), value :: prt_obj
        real(c_float), value :: t
      end subroutine lcio_particle_set_time
   end interface
 
 @ %def lcio_particle_set_vertex lcio_particle_set_time
 @
 <<LCIO interface: public>>=
   public :: lcio_particle_set_vtx
 <<LCIO interface: procedures>>=
   subroutine lcio_particle_set_vtx (prt, vtx)
     type(lcio_particle_t), intent(inout) :: prt
     type(vector3_t), intent(in) :: vtx
     call lcio_particle_set_vertex (prt%obj, real(vtx%p(1), c_double), &
          real(vtx%p(2), c_double), real(vtx%p(3), c_double))
   end subroutine lcio_particle_set_vtx
 
 @ %def lcio_particle_set_vtx
 @
 Times in LCIO are in nanoseconds, not in mm, so need to be converted.
 <<LCIO interface: public>>=
   public :: lcio_particle_set_t
 <<LCIO interface: procedures>>=
   subroutine lcio_particle_set_t (prt, t)
     type(lcio_particle_t), intent(inout) :: prt
     real(default), intent(in) :: t
     real(default) :: ns_from_t_mm
     ns_from_t_mm = ns_per_mm * t
     call lcio_particle_set_time (prt%obj, real(ns_from_t_mm, c_float))
   end subroutine lcio_particle_set_t
 
 @ %def lcio_particle_set_t
 @
 <<LCIO interface: interfaces>>=
   interface
      subroutine lcio_particle_add_parent (prt_obj1, prt_obj2) bind(C)
        import
        type(c_ptr), value :: prt_obj1, prt_obj2
      end subroutine lcio_particle_add_parent
   end interface
 @ %def lcio_particle_add_parent
 <<LCIO interface: public>>=
   public :: lcio_particle_set_parent
 <<LCIO interface: procedures>>=
   subroutine lcio_particle_set_parent (daughter, parent)
     type(lcio_particle_t), intent(inout) :: daughter, parent
     call lcio_particle_add_parent (daughter%obj, parent%obj)
   end subroutine lcio_particle_set_parent
 
 @ %def lcio_particle_set_parent
 @
 <<LCIO interface: interfaces>>=
   interface
      integer(c_int) function lcio_particle_get_generator_status &
           (prt_obj) bind(C)
        import
        type(c_ptr), value :: prt_obj
      end function lcio_particle_get_generator_status
   end interface
 @ %def lcio_particle_get_generator_status
 <<LCIO interface: public>>=
   public :: lcio_particle_get_status
 <<LCIO interface: procedures>>=
   function lcio_particle_get_status (lptr) result (status)
     integer :: status
     type(lcio_particle_t), intent(in) :: lptr
     status = lcio_particle_get_generator_status (lptr%obj)
   end function lcio_particle_get_status
 
 @ %def lcio_particle_get_status
 @ Getting the PDG code.
 <<LCIO interface: interfaces>>=
   interface
      integer(c_int) function lcio_particle_get_pdg_code (prt_obj) bind(C)
        import
        type(c_ptr), value :: prt_obj
      end function lcio_particle_get_pdg_code
   end interface
 @ %def lcio_particle_get_pdg_code
 @
 <<LCIO interface: public>>=
   public :: lcio_particle_get_pdg
 <<LCIO interface: procedures>>=
   function lcio_particle_get_pdg (lptr) result (pdg)
     integer :: pdg
     type(lcio_particle_t), intent(in) :: lptr
     pdg = lcio_particle_get_pdg_code (lptr%obj)
   end function lcio_particle_get_pdg
 
 @ %def lcio_particle_get_pdg
 @ Obtaining the number of parents and daughters of an LCIO particle.
 <<LCIO interface: interfaces>>=
   interface
      integer(c_int) function lcio_n_parents (prt_obj) bind(C)
        import
        type(c_ptr), value :: prt_obj
      end function lcio_n_parents
   end interface
 @ %def lcio_n_parents
 @
 <<LCIO interface: interfaces>>=
   interface
      integer(c_int) function lcio_n_daughters (prt_obj) bind(C)
        import
        type(c_ptr), value :: prt_obj
      end function lcio_n_daughters
   end interface
 @ %def lcio_n_daughters
 @
 <<LCIO interface: public>>=
   public :: lcio_particle_get_n_parents
 <<LCIO interface: procedures>>=
   function lcio_particle_get_n_parents (lptr) result (n_parents)
     integer :: n_parents
     type(lcio_particle_t), intent(in) :: lptr
     n_parents = lcio_n_parents (lptr%obj)
   end function lcio_particle_get_n_parents
 
 @ %def lcio_particle_get_n_parents
 @
 <<LCIO interface: public>>=
   public :: lcio_particle_get_n_children
 <<LCIO interface: procedures>>=
   function lcio_particle_get_n_children (lptr) result (n_children)
     integer :: n_children
     type(lcio_particle_t), intent(in) :: lptr
     n_children = lcio_n_daughters (lptr%obj)
   end function lcio_particle_get_n_children
 
 @ %def lcio_particle_get_n_children
 @ This provides access from the LCIO event [[lcio_event_t]] to the array entries
 of the parent and daughter arrays of the LCIO particles.
 <<LCIO interface: interfaces>>=
   interface
      integer(c_int) function lcio_event_parent_k &
           (evt_obj, num_part, k_parent) bind (C)
        use iso_c_binding !NODEP!
        type(c_ptr), value :: evt_obj
        integer(c_int), value :: num_part, k_parent
      end function lcio_event_parent_k
   end interface
 @ %def lcio_event_parent_k
 <<LCIO interface: interfaces>>=
   interface
      integer(c_int) function lcio_event_daughter_k &
           (evt_obj, num_part, k_daughter) bind (C)
        use iso_c_binding !NODEP!
        type(c_ptr), value :: evt_obj
        integer(c_int), value :: num_part, k_daughter
      end function lcio_event_daughter_k
   end interface
 @ %def lcio_event_daughter_k
 @
 <<LCIO interface: public>>=
   public :: lcio_get_n_parents
 <<LCIO interface: procedures>>=
   function lcio_get_n_parents (evt, num_part, k_parent) result (index_parent)
     type(lcio_event_t), intent(in) :: evt
     integer, intent(in) :: num_part, k_parent
     integer :: index_parent
     index_parent = lcio_event_parent_k (evt%obj, int (num_part, c_int), &
          int (k_parent, c_int))
   end function lcio_get_n_parents
 
 @ %def lcio_get_n_parents
 @
 <<LCIO interface: public>>=
   public :: lcio_get_n_children
 <<LCIO interface: procedures>>=
   function lcio_get_n_children (evt, num_part, k_daughter) result (index_daughter)
     type(lcio_event_t), intent(in) :: evt
     integer, intent(in) :: num_part, k_daughter
     integer :: index_daughter
     index_daughter = lcio_event_daughter_k (evt%obj, int (num_part, c_int), &
          int (k_daughter, c_int))
   end function lcio_get_n_children
 
 @ %def lcio_get_n_children
 @
 \subsection{LCIO Writer type}
 There is a specific LCIO Writer type for handling the output of
 LCEventImpl objects (i.e., Monte Carlo event samples) to file.  Opening
 the file is done by the constructor, closing by the destructor.
 <<LCIO interface: public>>=
   public :: lcio_writer_t
 <<LCIO interface: types>>=
   type :: lcio_writer_t
      private
      type(c_ptr) :: obj
   end type lcio_writer_t
 
 @ %def lcio_writer_t
 @ Constructor for an output associated to a file.
 <<LCIO interface: interfaces>>=
   interface
      type(c_ptr) function open_lcio_writer_new (filename, complevel) bind(C)
        import
        character(c_char), dimension(*), intent(in) :: filename
        integer(c_int), intent(in) :: complevel
      end function open_lcio_writer_new
   end interface
 @ %def open_lcio_writer_now
 <<LCIO interface: public>>=
   public :: lcio_writer_open_out
 <<LCIO interface: procedures>>=
   subroutine lcio_writer_open_out (lcio_writer, filename)
     type(lcio_writer_t), intent(out) :: lcio_writer
     type(string_t), intent(in) :: filename
     lcio_writer%obj = open_lcio_writer_new (char (filename) // &
          c_null_char, 9_c_int)
   end subroutine lcio_writer_open_out
 
 @ %def lcio_writer_open_out
 @ Destructor:
 <<LCIO interface: interfaces>>=
   interface
      subroutine lcio_writer_delete (io_obj) bind(C)
        import
        type(c_ptr), value :: io_obj
      end subroutine lcio_writer_delete
   end interface
 @ %def lcio_writer_delete
 <<LCIO interface: public>>=
   public :: lcio_writer_close
 <<LCIO interface: procedures>>=
   subroutine lcio_writer_close (lciowriter)
     type(lcio_writer_t), intent(inout) :: lciowriter
     call lcio_writer_delete (lciowriter%obj)
   end subroutine lcio_writer_close
 
 @ %def lcio_writer_close
 @ Write a single event to the LCIO writer.
 <<LCIO interface: interfaces>>=
   interface
      subroutine lcio_write_event (io_obj, evt_obj) bind(C)
        import
        type(c_ptr), value :: io_obj, evt_obj
      end subroutine lcio_write_event
   end interface
 @ %def lcio_write_event
 <<LCIO interface: public>>=
   public :: lcio_event_write
 <<LCIO interface: procedures>>=
   subroutine lcio_event_write (wrt, evt)
     type(lcio_writer_t), intent(inout) :: wrt
     type(lcio_event_t), intent(in) :: evt
     call lcio_write_event (wrt%obj, evt%obj)
   end subroutine lcio_event_write
 
 @ %def lcio_event_write
 @
 \subsection{LCIO Reader type}
 There is a specific LCIO Reader type for handling the input of
 LCEventImpl objects (i.e., Monte Carlo event samples) from file.  Opening
 the file is done by the constructor, closing by the destructor.
 <<LCIO interface: public>>=
   public :: lcio_reader_t
 <<LCIO interface: types>>=
   type :: lcio_reader_t
      private
      type(c_ptr) :: obj
   end type lcio_reader_t
 
 @ %def lcio_reader_t
 @ Constructor for an output associated to a file.
 <<LCIO interface: interfaces>>=
   interface
      type(c_ptr) function open_lcio_reader (filename) bind(C)
        import
        character(c_char), dimension(*), intent(in) :: filename
      end function open_lcio_reader
   end interface
 @ %def open_lcio_reader
 <<LCIO interface: public>>=
   public :: lcio_open_file
 <<LCIO interface: procedures>>=
   subroutine lcio_open_file (lcio_reader, filename)
     type(lcio_reader_t), intent(out) :: lcio_reader
     type(string_t), intent(in) :: filename
     lcio_reader%obj = open_lcio_reader (char (filename) // c_null_char)
   end subroutine lcio_open_file
 
 @ %def lcio_open_file
 @ Destructor:
 <<LCIO interface: interfaces>>=
   interface
      subroutine lcio_reader_delete (io_obj) bind(C)
        import
        type(c_ptr), value :: io_obj
      end subroutine lcio_reader_delete
   end interface
 @ %def lcio_reader_delete
 <<LCIO interface: public>>=
   public :: lcio_reader_close
 <<LCIO interface: procedures>>=
   subroutine lcio_reader_close (lcioreader)
     type(lcio_reader_t), intent(inout) :: lcioreader
     call lcio_reader_delete (lcioreader%obj)
   end subroutine lcio_reader_close
 
 @ %def lcio_reader_close
 @
 @ Read a single event from the event file.  Return true if successful.
 <<LCIO interface: interfaces>>=
   interface
      type(c_ptr) function read_lcio_event (io_obj) bind(C)
        import
        type(c_ptr), value :: io_obj
      end function read_lcio_event
   end interface
 @ %def read_lcio_event
 <<LCIO interface: public>>=
   public :: lcio_read_event
 <<LCIO interface: procedures>>=
   subroutine lcio_read_event (lcrdr, evt, ok)
     type(lcio_reader_t), intent(inout) :: lcrdr
     type(lcio_event_t), intent(out) :: evt
     logical, intent(out) :: ok
     evt%obj = read_lcio_event (lcrdr%obj)
     ok = c_associated (evt%obj)
   end subroutine lcio_read_event
 
 @ %def lcio_read_event
 @ Get the event index.
 <<LCIO interface: interfaces>>=
   interface
      integer(c_int) function lcio_event_get_event_number (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end function lcio_event_get_event_number
   end interface
 
 @ %def lcio_event_get_event_number
 <<LCIO interface: public>>=
   public :: lcio_event_get_event_index
 <<LCIO interface: procedures>>=
   function lcio_event_get_event_index (evt) result (i_evt)
     integer :: i_evt
     type(lcio_event_t), intent(in) :: evt
     i_evt = lcio_event_get_event_number (evt%obj)
   end function lcio_event_get_event_index
 
 @ %def lcio_event_get_event_index
 @ Extract the process ID. This is stored (at the moment abusively) in the
 RUN ID as well as in an additional event parameter.
 <<LCIO interface: interfaces>>=
   interface
      integer(c_int) function lcio_event_signal_process_id (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end function lcio_event_signal_process_id
   end interface
 @ %def lcio_event_signal_process_id
 <<LCIO interface: public>>=
   public :: lcio_event_get_process_id
 <<LCIO interface: procedures>>=
   function lcio_event_get_process_id (evt) result (i_proc)
     integer :: i_proc
     type(lcio_event_t), intent(in) :: evt
     i_proc = lcio_event_signal_process_id (evt%obj)
   end function lcio_event_get_process_id
 
 @ %def lcio_event_get_process_id
 @ Number of particles in an LCIO event.
 <<LCIO interface: interfaces>>=
   interface
      integer(c_int) function lcio_event_get_n_particles (evt_obj) bind(C)
        import
        type(c_ptr), value :: evt_obj
      end function lcio_event_get_n_particles
   end interface
 @ %def lcio_event_get_n_particles
 <<LCIO interface:>>=
 @
 <<LCIO interface: public>>=
   public :: lcio_event_get_n_tot
 <<LCIO interface: procedures>>=
   function lcio_event_get_n_tot (evt) result (n_tot)
     integer :: n_tot
     type(lcio_event_t), intent(in) :: evt
     n_tot = lcio_event_get_n_particles (evt%obj)
   end function lcio_event_get_n_tot
 
 @ %def lcio_event_get_n_tot
 @ Extracting $\alpha_s$ and the scale.
 <<LCIO interface: interfaces>>=
   interface
      function lcio_event_get_alpha_qcd (evt_obj) result (as) bind(C)
        import
        real(c_double) :: as
        type(c_ptr), value :: evt_obj
      end function lcio_event_get_alpha_qcd
   end interface
   interface
      function lcio_event_get_scale (evt_obj) result (scale) bind(C)
        import
        real(c_double) :: scale
        type(c_ptr), value :: evt_obj
      end function lcio_event_get_scale
   end interface
 @ %def lcio_event_get_alpha_qcd lcio_event_get_scale
 @
 <<LCIO interface: public>>=
   public :: lcio_event_get_alphas
 <<LCIO interface: procedures>>=
   function lcio_event_get_alphas (evt) result (as)
     type(lcio_event_t), intent(in) :: evt
     real(default) :: as
     as = lcio_event_get_alpha_qcd (evt%obj)
   end function lcio_event_get_alphas
 
 @ %def lcio_event_get_alphas
 @
 <<LCIO interface: public>>=
   public :: lcio_event_get_scaleval
 <<LCIO interface: procedures>>=
   function lcio_event_get_scaleval (evt) result (scale)
     type(lcio_event_t), intent(in) :: evt
     real(default) :: scale
     scale = lcio_event_get_scale (evt%obj)
   end function lcio_event_get_scaleval
 
 @ %def lcio_event_get_scaleval
 @ Extracting particles by index from an LCIO event.
 <<LCIO interface: interfaces>>=
   interface
      type(c_ptr) function lcio_event_particle_k (evt_obj, k) bind(C)
        import
        type(c_ptr), value :: evt_obj
        integer(c_int), value :: k
      end function lcio_event_particle_k
   end interface
 @ %def lcio_event_particle_k
 @
 <<LCIO interface: public>>=
   public :: lcio_event_get_particle
 <<LCIO interface: procedures>>=
   function lcio_event_get_particle (evt, n) result (prt)
     type(lcio_event_t), intent(in) :: evt
     integer, intent(in) :: n
     type(lcio_particle_t) :: prt
     prt%obj = lcio_event_particle_k (evt%obj, int (n, c_int))
   end function lcio_event_get_particle
 @ %def lcio_event_get_particle
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[lcio_interface_ut.f90]]>>=
 <<File header>>
 
 module lcio_interface_ut
   use unit_tests
   use lcio_interface_uti
 
 <<Standard module head>>
 
 <<LCIO interface: public test>>
 
 contains
 
 <<LCIO interface: test driver>>
 
 end module lcio_interface_ut
 @ %def lcio_interface_ut
 @
 <<[[lcio_interface_uti.f90]]>>=
 <<File header>>
 
 module lcio_interface_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use lorentz
   use flavors
   use colors
   use polarizations
 
   use lcio_interface
 
 <<Standard module head>>
 
 <<LCIO interface: test declarations>>
 
 contains
 
 <<LCIO interface: tests>>
 
 end module lcio_interface_uti
 @ %def lcio_interface_ut
 @ API: driver for the unit tests below.
 <<LCIO interface: public test>>=
   public :: lcio_interface_test
 <<LCIO interface: test driver>>=
   subroutine lcio_interface_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<LCIO interface: execute tests>>
   end subroutine lcio_interface_test
 
 @  %def lcio_interface_test
 @
 <<LCIO interface: execute tests>>=
   call test (lcio_interface_1, "lcio_interface_1", &
        "check LCIO interface", &
        u, results)
 <<LCIO interface: test declarations>>=
   public :: lcio_interface_1
 <<LCIO interface: tests>>=
   subroutine lcio_interface_1 (u)
     use physics_defs, only: VECTOR
     use model_data, only: field_data_t
     integer, intent(in) :: u
     integer :: u_file, iostat
     type(lcio_event_t) :: evt
     type(lcio_particle_t) :: prt1, prt2, prt3, prt4, prt5, prt6, prt7, prt8
     type(flavor_t) :: flv
     type(color_t) :: col
     type(polarization_t) :: pol
     type(field_data_t), target :: photon_data
     character(220) :: buffer
 
     write (u, "(A)")  "* Test output: LCIO interface"
     write (u, "(A)")  "*   Purpose: test LCIO interface"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     ! Initialize a photon flavor object and some polarization
     call photon_data%init (var_str ("PHOTON"), 22)
     call photon_data%set (spin_type=VECTOR)
     call photon_data%freeze ()
     call flv%init (photon_data)
     call pol%init_angles &
          (flv, 0.6_default, 1._default, 0.5_default)
 
     ! Event initialization
     call lcio_event_init (evt, 20, 1, 42)
 
     write (u, "(A)")  "* p -> q splitting"
     write (u, "(A)")
 
     ! $p\to q$ splittings
     call particle_init (prt1, &
          0._default, 0._default, 7000._default, 7000._default, &
          2212, 1._default, 3)
     call particle_init (prt2, &
          0._default, 0._default,-7000._default, 7000._default, &
          2212, 1._default, 3)
     call particle_init (prt3, &
           .750_default, -1.569_default, 32.191_default, 32.238_default, &
           1, -1._default/3._default, 3)
     call color_init_from_array (col, [501])
     call lcio_particle_set_color (prt3, col)
     call lcio_particle_set_parent (prt3, prt1)
     call lcio_particle_set_parent (prt3, prt2)
     call particle_init (prt4, &
          -3.047_default, -19._default, -54.629_default, 57.920_default, &
          -2, -2._default/3._default, 3)
     call color_init_from_array (col, [-501])
     call lcio_particle_set_color (prt4, col)
     call lcio_particle_set_parent (prt4, prt1)
     call lcio_particle_set_parent (prt4, prt2)
 
     write (u, "(A)")  "* Hard interaction"
     write (u, "(A)")
 
     ! Hard interaction
     call particle_init (prt6, &
          -3.813_default, 0.113_default, -1.833_default, 4.233_default, &
          22, 0._default, 1)
     call lcio_polarization_init (prt6, pol)
     call particle_init (prt5, &
          1.517_default, -20.68_default, -20.605_default, 85.925_default, &
          -24, -1._default, 3)
     call lcio_particle_set_parent (prt5, prt3)
     call lcio_particle_set_parent (prt5, prt4)
     call lcio_particle_set_parent (prt6, prt3)
     call lcio_particle_set_parent (prt6, prt4)
 
     ! $W^-$ decay
     call particle_init (prt7, &
          -2.445_default, 28.816_default, 6.082_default, 29.552_default, &
          1, -1._default/3._default, 1)
     call particle_init (prt8, &
          3.962_default, -49.498_default, -26.687_default, 56.373_default, &
          -2, -2._default/3._default, 1)
     call lcio_particle_set_t (prt7, 0.12_default)
     call lcio_particle_set_t (prt8, 0.12_default)
     call lcio_particle_set_vtx &
          (prt7, vector3_moving ([-0.3_default, 0.05_default, 0.004_default]))
     call lcio_particle_set_vtx &
          (prt8, vector3_moving ([-0.3_default, 0.05_default, 0.004_default]))
     call lcio_particle_set_parent (prt7, prt5)
     call lcio_particle_set_parent (prt8, prt5)
     call lcio_particle_add_to_evt_coll (prt1, evt)
     call lcio_particle_add_to_evt_coll (prt2, evt)
     call lcio_particle_add_to_evt_coll (prt3, evt)
     call lcio_particle_add_to_evt_coll (prt4, evt)
     call lcio_particle_add_to_evt_coll (prt5, evt)
     call lcio_particle_add_to_evt_coll (prt6, evt)
     call lcio_particle_add_to_evt_coll (prt7, evt)
     call lcio_particle_add_to_evt_coll (prt8, evt)
     call lcio_event_add_coll (evt)
 
     ! Event output
     write (u, "(A)")  "Writing in ASCII form to file 'lcio_test.slcio'"
     write (u, "(A)")
 
     call write_lcio_event (evt, var_str ("lcio_test.slcio"))
 
     write (u, "(A)")  "Writing completed"
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = "lcio_test.slcio", &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (trim (buffer) == "")  cycle
        if (buffer(1:12) == " - timestamp")  buffer = "[...]"
        if (buffer(1:6) == " date:")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
     write (u, "(A)")
 
     ! Wrapup
     ! call pol%final ()
     call lcio_event_final (evt)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: lcio_interface_1"
 
   contains
 
     subroutine particle_init &
          (prt, px, py, pz, E, pdg, charge, status)
       type(lcio_particle_t), intent(out) :: prt
       real(default), intent(in) :: px, py, pz, E, charge
       integer, intent(in) :: pdg, status
       type(vector4_t) :: p
       p = vector4_moving (E, vector3_moving ([px, py, pz]))
       call lcio_particle_init (prt, p, pdg, charge, status)
     end subroutine particle_init
 
   end subroutine lcio_interface_1
 
 @ %def lcio_interface_1
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{HEP Common and Events}
 
 This is a separate module that manages data exchange between the common blocks
 and [[event_t]] objects. We separate this from the previous module in order
 to avoid a circular module dependency. It also contains the functions
 necessary for communication between [[hepmc_event_t]] and
 [[event_t]] or [[lcio_event_t]] and [[event_t]] as well as
 [[particle_set_t]] and [[particle_t]] objects.
 <<[[hep_events.f90]]>>=
 <<File header>>
 
 module hep_events
 
 <<Use kinds>>
 <<Use strings>>
   use system_dependencies, only: HEPMC2_AVAILABLE
   use system_dependencies, only: HEPMC3_AVAILABLE
   use diagnostics
   use lorentz
   use numeric_utils
   use flavors
   use colors
   use helicities
   use polarizations
   use model_data
   use subevents, only: PRT_BEAM, PRT_INCOMING, PRT_OUTGOING
   use subevents, only: PRT_UNDEFINED
   use subevents, only: PRT_VIRTUAL, PRT_RESONANT, PRT_BEAM_REMNANT
   use particles
   use hep_common
   use hepmc_interface
   use lcio_interface
   use event_base
 
 <<Standard module head>>
 
 <<HEP events: public>>
 
 contains
 
 <<HEP events: procedures>>
 
 end module hep_events
 @ %def hep_events
 @
 \subsection{Data Transfer: events}
 Fill the HEPEUP block, given a \whizard\ event object.
 <<HEP events: public>>=
   public :: hepeup_from_event
 <<HEP events: procedures>>=
   subroutine hepeup_from_event &
        (event, keep_beams, keep_remnants, process_index)
     class(generic_event_t), intent(in), target :: event
     logical, intent(in), optional :: keep_beams
     logical, intent(in), optional :: keep_remnants
     integer, intent(in), optional :: process_index
     type(particle_set_t), pointer :: particle_set
     real(default) :: scale, alpha_qcd
     if (event%has_valid_particle_set ()) then
        particle_set => event%get_particle_set_ptr ()
        call hepeup_from_particle_set (particle_set, keep_beams, keep_remnants)
        if (present (process_index)) then
           call hepeup_set_event_parameters (proc_id = process_index)
        end if
        scale = event%get_fac_scale ()
        if (.not. vanishes (scale)) then
           call hepeup_set_event_parameters (scale = scale)
        end if
        alpha_qcd = event%get_alpha_s ()
        if (.not. vanishes (alpha_qcd)) then
           call hepeup_set_event_parameters (alpha_qcd = alpha_qcd)
        end if
        if (event%weight_prc_is_known ()) then
           call hepeup_set_event_parameters (weight = event%get_weight_prc ())
        end if
     else
        call msg_bug ("HEPEUP: event incomplete")
     end if
   end subroutine hepeup_from_event
 
 @ %def hepeup_from_event
 @ Reverse.
 
 Note: The current implementation sets the particle set of the hard
 process and is therefore not useful if the event on file is dressed.
 This should be reconsidered.
 
 Note: setting of scale or alpha is not yet supported by the
 [[event_t]] object.  Ticket \#628.
 <<HEP events: public>>=
   public :: hepeup_to_event
 <<HEP events: procedures>>=
   subroutine hepeup_to_event &
        (event, fallback_model, process_index, recover_beams, &
        use_alpha_s, use_scale)
     class(generic_event_t), intent(inout), target :: event
     class(model_data_t), intent(in), target :: fallback_model
     integer, intent(out), optional :: process_index
     logical, intent(in), optional :: recover_beams
     logical, intent(in), optional :: use_alpha_s
     logical, intent(in), optional :: use_scale
     class(model_data_t), pointer :: model
     real(default) :: weight, scale, alpha_qcd
     type(particle_set_t) :: particle_set
     model => event%get_model_ptr ()
     call hepeup_to_particle_set &
          (particle_set, recover_beams, model, fallback_model)
     call event%set_hard_particle_set (particle_set)
     call particle_set%final ()
     if (present (process_index)) then
        call hepeup_get_event_parameters (proc_id = process_index)
     end if
     call hepeup_get_event_parameters (weight = weight, &
          scale = scale, alpha_qcd = alpha_qcd)
     call event%set_weight_ref (weight)
     if (present (use_alpha_s)) then
        if (use_alpha_s .and. alpha_qcd > 0) &
             call event%set_alpha_qcd_forced (alpha_qcd)
     end if
     if (present (use_scale)) then
        if (use_scale .and. scale > 0) &
             call event%set_scale_forced (scale)
     end if
   end subroutine hepeup_to_event
 
 @ %def hepeup_to_event
 @ Fill the HEPEVT (event) common block.
 
 The [[i_evt]] argument overrides the index stored in the [[event]] object.
 <<HEP events: public>>=
   public :: hepevt_from_event
 <<HEP events: procedures>>=
   subroutine hepevt_from_event  &
          (event, process_index, i_evt, keep_beams, keep_remnants, &
           ensure_order, fill_hepev4)
     class(generic_event_t), intent(in), target :: event
     integer, intent(in), optional :: i_evt, process_index
     logical, intent(in), optional :: keep_beams
     logical, intent(in), optional :: keep_remnants
     logical, intent(in), optional :: ensure_order
     logical, intent(in), optional :: fill_hepev4
     type(particle_set_t), pointer :: particle_set
     real(default) :: alpha_qcd, scale
     if (event%has_valid_particle_set ()) then
        particle_set => event%get_particle_set_ptr ()
        call hepevt_from_particle_set (particle_set, keep_beams, &
             keep_remnants, ensure_order, fill_hepev4)
        if (present (process_index)) then
           call hepevt_set_event_parameters (proc_id = process_index)
        end if
        if (event%weight_prc_is_known ()) then
           call hepevt_set_event_parameters (weight = event%get_weight_prc ())
        end if
        if (event%sqme_prc_is_known ()) then
           call hepevt_set_event_parameters &
                (function_value = event%get_sqme_prc ())
        end if
        scale = event%get_fac_scale ()
        if (.not. vanishes (scale)) then
           call hepevt_set_event_parameters (scale = scale)
        end if
        alpha_qcd = event%get_alpha_s ()
        if (.not. vanishes (alpha_qcd)) then
           call hepevt_set_event_parameters (alpha_qcd = alpha_qcd)
        end if
        if (present (i_evt)) then
           call hepevt_set_event_parameters (i_evt = i_evt)
        else if (event%has_index ()) then
           call hepevt_set_event_parameters (i_evt = event%get_index ())
        else
           call hepevt_set_event_parameters (i_evt = 0)
        end if
     else
        call msg_bug ("HEPEVT: event incomplete")
     end if
   end subroutine hepevt_from_event
 
 @ %def hepevt_from_event
 @
 \subsubsection{HepMC format}
 The master output function fills a HepMC GenEvent object that is
 already initialized, but has no vertices in it.
 
 We first set up the vertex lists and enter the vertices into the HepMC
 event.  Then, we assign first all incoming particles and then all
 outgoing particles to their associated vertices.  Particles which have
 neither parent nor children entries (this should not happen) are
 dropped.
 
 Finally, we insert the beam particles.  If there are none, use the incoming
 particles instead.
 @ Transform a particle into a [[hepmc_particle]] object, including
 color and polarization.  The HepMC status is equivalent to the HEPEVT
 status, in particular: 0 = null entry, 1 = physical particle, 2 =
 decayed/fragmented SM hadron, tau or muon, 3 = other unphysical particle
 entry, 4 = incoming particles, 11 = intermediate resonance such as squarks.
 The use of 11 for intermediate resonances is as done by HERWIG, see
 http://herwig.hepforge.org/trac/wiki/FaQs.
 <<HEP events: procedures>>=
   subroutine particle_to_hepmc (prt, hprt)
     type(particle_t), intent(in) :: prt
     type(hepmc_particle_t), intent(out) :: hprt
     integer :: hepmc_status
     select case (prt%get_status ())
     case (PRT_UNDEFINED)
        hepmc_status = 0
     case (PRT_OUTGOING)
        hepmc_status = 1
     case (PRT_BEAM)
        hepmc_status = 4
     case (PRT_RESONANT)
        if (abs(prt%get_pdg()) == 13 .or. &
             abs(prt%get_pdg()) == 15) then
           hepmc_status = 2
        else
           hepmc_status = 11
        end if
     case default
        hepmc_status = 3
     end select
     call hepmc_particle_init (hprt, &
          prt%get_momentum (), prt%get_pdg (), &
          hepmc_status)
     if (HEPMC2_AVAILABLE) then
        call hepmc_particle_set_color (hprt, prt%get_color ())
        select case (prt%get_polarization_status ())
        case (PRT_DEFINITE_HELICITY)
           call hepmc_particle_set_polarization (hprt, &
                prt%get_helicity ())
        case (PRT_GENERIC_POLARIZATION)
           call hepmc_particle_set_polarization (hprt, &
                prt%get_polarization ())
        end select
     end if
   end subroutine particle_to_hepmc
 
 @ %def particle_to_hepmc
 @ For HepMC3, a HepMC particle needs first to be attached to a vertex
 and an event before non-intrinsic particle properties (color flow and
 helicity) could be set.
 <<HEP events: public>>=
   public :: hepmc_event_from_particle_set
 <<HEP events: procedures>>=
   subroutine hepmc_event_from_particle_set &
          (evt, particle_set, cross_section, error)
     type(hepmc_event_t), intent(inout) :: evt
     type(particle_set_t), intent(in) :: particle_set
     real(default), intent(in), optional :: cross_section, error
     type(hepmc_vertex_t), dimension(:), allocatable :: v
     type(hepmc_particle_t), dimension(:), allocatable :: hprt
     type(hepmc_particle_t), dimension(2) :: hbeam
     type(vector4_t), dimension(:), allocatable :: vtx
     logical, dimension(:), allocatable :: is_beam
     integer, dimension(:), allocatable :: v_from, v_to
     integer :: n_vertices, n_tot, i
     n_tot = particle_set%get_n_tot ()
     allocate (v_from (n_tot), v_to (n_tot))
     call particle_set%assign_vertices (v_from, v_to, n_vertices)
     allocate (hprt (n_tot))
     allocate (vtx (n_vertices))
     vtx = vector4_null
     do i = 1, n_tot
        if (v_to(i) /= 0 .or. v_from(i) /= 0) then
           call particle_to_hepmc (particle_set%prt(i), hprt(i))
           if (v_to(i) /= 0) then
              vtx(v_to(i)) = particle_set%prt(i)%get_vertex ()
           end if
        end if
     end do
     if (present (cross_section) .and. present(error)) &
        call hepmc_event_set_cross_section (evt, cross_section, error)
     allocate (v (n_vertices))
     do i = 1, n_vertices
        call hepmc_vertex_init (v(i), vtx(i))
        call hepmc_event_add_vertex (evt, v(i))
     end do
     allocate (is_beam (n_tot))
     is_beam = particle_set%prt(1:n_tot)%get_status () == PRT_BEAM
     if (.not. any (is_beam)) then
        is_beam = particle_set%prt(1:n_tot)%get_status () == PRT_INCOMING
     end if
     if (count (is_beam) == 2) then
        hbeam = pack (hprt, is_beam)
        call hepmc_event_set_beam_particles (evt, hbeam(1), hbeam(2))
     end if
     do i = 1, n_tot
        if (v_to(i) /= 0) then
           call hepmc_vertex_add_particle_in (v(v_to(i)), hprt(i))
        end if
     end do
     do i = 1, n_tot
        if (v_from(i) /= 0) then
           call hepmc_vertex_add_particle_out (v(v_from(i)), hprt(i))
        end if
     end do
     FIND_SIGNAL_PROCESS: do i = 1, n_tot
        if (particle_set%prt(i)%get_status () == PRT_INCOMING) then
           call hepmc_event_set_signal_process_vertex (evt, v(v_to(i)))
           exit FIND_SIGNAL_PROCESS
        end if
     end do FIND_SIGNAL_PROCESS
     if (HEPMC3_AVAILABLE) then
        do i = 1, n_tot
           call hepmc_particle_set_color (hprt(i), &
                particle_set%prt(i)%get_color ())
           select case (particle_set%prt(i)%get_polarization_status ())
           case (PRT_DEFINITE_HELICITY)
              call hepmc_particle_set_polarization (hprt(i), &
                   particle_set%prt(i)%get_helicity ())
           case (PRT_GENERIC_POLARIZATION)
              call hepmc_particle_set_polarization (hprt(i), &
                   particle_set%prt(i)%get_polarization ())
           end select
        end do
     end if
   end subroutine hepmc_event_from_particle_set
 
 @ %def hepmc_event_from_particle_set
 @ Initialize a particle from a HepMC particle object.  The model is
 necessary for making a fully qualified flavor component.  We have the
 additional flag [[polarized]] which tells whether the polarization
 information should be interpreted or ignored, and the lookup array of
 barcodes.  Note that the lookup array is searched linearly, a possible
 bottleneck for large particle arrays.  If necessary, the barcode array
 could be replaced by a hash table.
 <<HEP events: procedures>>=
   subroutine particle_from_hepmc_particle &
        (prt, hprt, model, fallback_model, polarization, barcode)
     type(particle_t), intent(out) :: prt
     type(hepmc_particle_t), intent(in) :: hprt
     type(model_data_t), intent(in), target :: model
     type(model_data_t), intent(in), target :: fallback_model
     type(hepmc_vertex_t) :: vtx
     integer, intent(in) :: polarization
     integer, dimension(:), intent(in) :: barcode
     type(hepmc_polarization_t) :: hpol
     type(flavor_t) :: flv
     type(color_t) :: col
     type(helicity_t) :: hel
     type(polarization_t) :: pol
     type(vector4_t) :: vertex
     integer :: n_parents, n_children
     integer, dimension(:), allocatable :: &
          parent_barcode, child_barcode, parent, child
     integer :: i
     select case (hepmc_particle_get_status (hprt))
     case (1);  call prt%set_status (PRT_OUTGOING)
     case (2);  call prt%set_status (PRT_RESONANT)
     case (3);  call prt%set_status (PRT_VIRTUAL)
     end select
     if (hepmc_particle_is_beam (hprt)) call prt%set_status (PRT_BEAM)
     call flv%init (hepmc_particle_get_pdg (hprt), model, fallback_model)
     call col%init (hepmc_particle_get_color (hprt))
     call prt%set_flavor (flv)
     call prt%set_color (col)
     call prt%set_polarization (polarization)
     select case (polarization)
     case (PRT_DEFINITE_HELICITY)
        hpol = hepmc_particle_get_polarization (hprt)
        call hepmc_polarization_to_hel (hpol, prt%get_flv (), hel)
        call prt%set_helicity (hel)
        call hepmc_polarization_final (hpol)
     case (PRT_GENERIC_POLARIZATION)
        hpol = hepmc_particle_get_polarization (hprt)
        call hepmc_polarization_to_pol (hpol, prt%get_flv (), pol)
        call prt%set_pol (pol)
        call hepmc_polarization_final (hpol)
     end select
     call prt%set_momentum (hepmc_particle_get_momentum (hprt), &
          hepmc_particle_get_mass_squared (hprt))
     n_parents  = hepmc_particle_get_n_parents  (hprt)
     n_children = hepmc_particle_get_n_children (hprt)
     if (HEPMC2_AVAILABLE) then
        allocate (parent_barcode (n_parents),  parent (n_parents))
        allocate (child_barcode  (n_children), child  (n_children))
        parent_barcode = hepmc_particle_get_parent_barcodes (hprt)
        child_barcode  = hepmc_particle_get_child_barcodes  (hprt)
        do i = 1, size (barcode)
           where (parent_barcode == barcode(i))  parent = i
           where (child_barcode  == barcode(i))  child  = i
        end do
        call prt%set_parents (parent)
        call prt%set_children (child)
     else if (HEPMC3_AVAILABLE) then
        allocate (parent_barcode (n_parents),  parent (n_parents))
        allocate (child_barcode  (n_children), child  (n_children))
        parent_barcode = hepmc_particle_get_parent_barcodes (hprt)
        child_barcode  = hepmc_particle_get_child_barcodes  (hprt)
        do i = 1, size (barcode)
           where (parent_barcode == barcode(i))  parent = i
           where (child_barcode  == barcode(i))  child  = i
        end do
        call prt%set_parents (parent)
        call prt%set_children (child)
     end if
     if (prt%get_status () == PRT_VIRTUAL .and. n_parents == 0) &
          call prt%set_status (PRT_INCOMING)
     if (HEPMC2_AVAILABLE) then
        vtx = hepmc_particle_get_decay_vertex (hprt)
        if (hepmc_vertex_is_valid (vtx)) then
           vertex = hepmc_vertex_to_vertex (vtx)
           if (vertex /= vector4_null)  call prt%set_vertex (vertex)
        end if
     end if
   end subroutine particle_from_hepmc_particle
 
 @ %def particle_from_hepmc_particle
 @ If a particle set is initialized from a HepMC event record, we have
 to specify the treatment of polarization (unpolarized or density
 matrix) which is common to all particles.  Correlated polarization
 information is not available.
 
 There is some complication in reconstructing incoming particles and
 beam remnants.  First of all, they all will be tagged as virtual.  We
 then define an incoming particle as
 <<HEP events: public>>=
   public :: hepmc_event_to_particle_set
 <<HEP events: procedures>>=
   subroutine hepmc_event_to_particle_set &
        (particle_set, evt, model, fallback_model, polarization)
     type(particle_set_t), intent(inout), target :: particle_set
     type(hepmc_event_t), intent(in) :: evt
     class(model_data_t), intent(in), target :: model, fallback_model
     integer, intent(in) :: polarization
     type(hepmc_event_particle_iterator_t) :: it
     type(hepmc_vertex_t) :: v
     type(hepmc_vertex_particle_in_iterator_t) :: v_it
     type(hepmc_particle_t) :: prt
     integer, dimension(:), allocatable :: barcode, n_parents
     integer :: n_tot, n_beam, i, bc
     n_tot = hepmc_event_get_n_particles(evt)
     allocate (barcode (n_tot))    
     if (HEPMC2_AVAILABLE) then
        call hepmc_event_particle_iterator_init (it, evt)
        do i = 1, n_tot
           barcode(i) = hepmc_particle_get_barcode &
                (hepmc_event_particle_iterator_get (it))
           call hepmc_event_particle_iterator_advance (it)
        end do
        allocate (particle_set%prt (n_tot))
        call hepmc_event_particle_iterator_reset (it)
        do i = 1, n_tot
           prt = hepmc_event_particle_iterator_get (it)
           call particle_from_hepmc_particle (particle_set%prt(i), &
                prt, model, fallback_model, polarization, barcode)
           call hepmc_event_particle_iterator_advance (it)
        end do
        call hepmc_event_particle_iterator_final (it)
        v = hepmc_event_get_signal_process_vertex (evt)
        if (hepmc_vertex_is_valid (v)) then
           call hepmc_vertex_particle_in_iterator_init (v_it, v)
           do while (hepmc_vertex_particle_in_iterator_is_valid (v_it))
              prt = hepmc_vertex_particle_in_iterator_get (v_it)
              bc = hepmc_particle_get_barcode &
                   (hepmc_vertex_particle_in_iterator_get (v_it))
              do i = 1, size(barcode)
                 if (bc == barcode(i))  &
                      call particle_set%prt(i)%set_status (PRT_INCOMING)
              end do
              call hepmc_vertex_particle_in_iterator_advance (v_it)
           end do
           call hepmc_vertex_particle_in_iterator_final (v_it)
        end if
     else if (HEPMC3_AVAILABLE) then
        allocate (particle_set%prt (n_tot))
        do i = 1, n_tot
           barcode(i) = hepmc_particle_get_barcode &
                (hepmc_event_get_nth_particle (evt, i))
        end do
        do i = 1, n_tot
           prt = hepmc_event_get_nth_particle (evt, i)
           call particle_from_hepmc_particle (particle_set%prt(i), &
                prt, model, fallback_model, polarization, barcode)
        end do
     end if
     do i = 1, n_tot
        if (particle_set%prt(i)%get_status () == PRT_VIRTUAL &
             .and. particle_set%prt(i)%get_n_children () == 0) &
             call particle_set%prt(i)%set_status (PRT_OUTGOING)
     end do
     if (HEPMC3_AVAILABLE) then
        n_beam = hepmc_event_get_n_beams (evt)
        do i = 1, n_beam
           bc = hepmc_event_get_nth_beam (evt, i)
           if (.not. particle_set%prt(bc)%get_status () == PRT_INCOMING) &
                call particle_set%prt(bc)%set_status (PRT_BEAM)
        end do
        do i = 1, n_tot
           if (particle_set%prt(i)%get_status () == PRT_VIRTUAL) then
              n_parents = particle_set%prt(i)%get_parents ()
              if (all &
                   (particle_set%prt(n_parents)%get_status () == PRT_BEAM)) then
                 call particle_set%prt(i)%set_status (PRT_INCOMING)
              end if
           end if
        end do
     end if
     particle_set%n_tot = n_tot
     particle_set%n_beam  = &
          count (particle_set%prt%get_status () == PRT_BEAM)
     particle_set%n_in  = &
          count (particle_set%prt%get_status () == PRT_INCOMING)
     particle_set%n_out = &
          count (particle_set%prt%get_status () == PRT_OUTGOING)
     particle_set%n_vir = &
          particle_set%n_tot - particle_set%n_in - particle_set%n_out
   end subroutine hepmc_event_to_particle_set
 
 @ %def hepmc_event_to_particle_set
 @ Fill a WHIZARD event from a HepMC event record.  In HepMC the weights
 are in a weight container.  If the size of this container is larger than
 one, it is ambiguous to assign the event a specific weight.  For now we
 only allow to read in unweighted events.
 <<HEP events: public>>=
   public :: hepmc_to_event
 <<HEP events: procedures>>=
   subroutine hepmc_to_event &
        (event, hepmc_event, fallback_model, process_index, &
        recover_beams, use_alpha_s, use_scale)
     class(generic_event_t), intent(inout), target :: event
     type(hepmc_event_t), intent(inout) :: hepmc_event
     class(model_data_t), intent(in), target :: fallback_model
     integer, intent(out), optional :: process_index
     logical, intent(in), optional :: recover_beams
     logical, intent(in), optional :: use_alpha_s
     logical, intent(in), optional :: use_scale
     class(model_data_t), pointer :: model
     real(default) :: scale, alpha_qcd
     type(particle_set_t) :: particle_set
     model => event%get_model_ptr ()
     call event%set_index (hepmc_event_get_event_index (hepmc_event))
     call hepmc_event_to_particle_set (particle_set, &
          hepmc_event, model, fallback_model, PRT_DEFINITE_HELICITY)
     call event%set_hard_particle_set (particle_set)
     call particle_set%final ()
     call event%set_weight_ref (1._default)
     alpha_qcd = hepmc_event_get_alpha_qcd (hepmc_event)
     scale = hepmc_event_get_scale (hepmc_event)
     if (present (use_alpha_s)) then
        if (use_alpha_s .and. alpha_qcd > 0) &
             call event%set_alpha_qcd_forced (alpha_qcd)
     end if
     if (present (use_scale)) then
        if (use_scale .and. scale > 0) &
             call event%set_scale_forced (scale)
     end if
   end subroutine hepmc_to_event
 
 @ %def hepmc_to_event
 @
 \subsubsection{LCIO event format}
 The master output function fills a LCIO event object that is
 already initialized, but has no particles in it.
 
 In contrast to HepMC in LCIO there are no vertices (except for tracker
 and other detector specifications). So we assign first all incoming
 particles and then all outgoing particles to LCIO particle types.
 Particles which have neither parent nor children entries (this
 should not happen) are dropped. Finally, we insert the beam particles.
 If there are none, use the incoming particles instead.
 
 Transform a particle into a [[lcio_particle]] object, including
 color and polarization.  The LCIO status is equivalent to the HepMC
 status, in particular: 0 = null entry, 1 = physical particle, 2 =
 decayed/fragmented SM hadron, tau or muon, 3 = other unphysical particle
 entry, 4 = incoming particles, 11 = intermediate resonance such as squarks.
 The use of 11 for intermediate resonances is as done by HERWIG, see
 http://herwig.hepforge.org/trac/wiki/FaQs.
 
 A beam-remnant particle (e.g., ISR photon) that has no children is
 tagged as outgoing, otherwise unphysical.
 <<HEP events: public>>=
   public :: particle_to_lcio
 <<HEP events: procedures>>=
   subroutine particle_to_lcio (prt, lprt)
     type(particle_t), intent(in) :: prt
     type(lcio_particle_t), intent(out) :: lprt
     integer :: lcio_status
     type(vector4_t) :: vtx
     select case (prt%get_status ())
     case (PRT_UNDEFINED)
        lcio_status = 0
     case (PRT_OUTGOING)
        lcio_status = 1
     case (PRT_BEAM_REMNANT)
        if (prt%get_n_children () == 0) then
           lcio_status = 1
        else
           lcio_status = 3
        end if
     case (PRT_BEAM)
        lcio_status = 4
     case (PRT_RESONANT)
        lcio_status = 2
     case default
        lcio_status = 3
     end select
     call lcio_particle_init (lprt, &
          prt%get_momentum (), &
          prt%get_pdg (), &
          prt%flv%get_charge (), &
          lcio_status)
     call lcio_particle_set_color (lprt, prt%get_color ())
     vtx = prt%get_vertex ()
     call lcio_particle_set_vtx (lprt, space_part (vtx))
     call lcio_particle_set_t (lprt, vtx%p(0))
     select case (prt%get_polarization_status ())
     case (PRT_DEFINITE_HELICITY)
        call lcio_polarization_init (lprt, prt%get_helicity ())
     case (PRT_GENERIC_POLARIZATION)
        call lcio_polarization_init (lprt, prt%get_polarization ())
     end select
   end subroutine particle_to_lcio
 
 @ %def particle_to_lcio
 @
 @ Initialize a particle from a LCIO particle object.  The model is
 necessary for making a fully qualified flavor component.
 <<HEP events: public>>=
   public :: particle_from_lcio_particle
 <<HEP events: procedures>>=
   subroutine particle_from_lcio_particle &
      (prt, lprt, model, daughters, parents, polarization)
     type(particle_t), intent(out) :: prt
     type(lcio_particle_t), intent(in) :: lprt
     type(model_data_t), intent(in), target :: model
     integer, dimension(:), intent(in) :: daughters, parents
     type(vector4_t) :: vtx4
     type(flavor_t) :: flv
     type(color_t) :: col
     type(helicity_t) :: hel
     type(polarization_t) :: pol
     integer, intent(in) :: polarization
     select case (lcio_particle_get_status (lprt))
     case (1);  call prt%set_status (PRT_OUTGOING)
     case (2);  call prt%set_status (PRT_RESONANT)
     case (3)
        select case (size (parents))
        case (0)
           call prt%set_status (PRT_INCOMING)
        case default
           call prt%set_status (PRT_VIRTUAL)
        end select
     case (4);  call prt%set_status (PRT_BEAM)
     end select
     call flv%init (lcio_particle_get_pdg (lprt), model)
     call col%init (lcio_particle_get_flow (lprt))
     if (flv%is_beam_remnant ())  call prt%set_status (PRT_BEAM_REMNANT)
     call prt%set_flavor (flv)
     call prt%set_color (col)
     call prt%set_polarization (polarization)
     select case (polarization)
     case (PRT_DEFINITE_HELICITY)
        call lcio_particle_to_hel (lprt, prt%get_flv (), hel)
        call prt%set_helicity (hel)
     case (PRT_GENERIC_POLARIZATION)
        call lcio_particle_to_pol (lprt, prt%get_flv (), pol)
        call prt%set_pol (pol)
     end select
     call prt%set_momentum (lcio_particle_get_momentum (lprt), &
          lcio_particle_get_mass_squared (lprt))
     call prt%set_parents (parents)
     call prt%set_children (daughters)
     vtx4 = vector4_moving (lcio_particle_get_time (lprt), &
          lcio_particle_get_vertex (lprt))
     if (vtx4 /= vector4_null)  call prt%set_vertex (vtx4)
   end subroutine particle_from_lcio_particle
 
 @ %def particle_from_lcio_particle
 @
 <<HEP events: public>>=
   public :: lcio_event_from_particle_set
 <<HEP events: procedures>>=
   subroutine lcio_event_from_particle_set (evt, particle_set)
     type(lcio_event_t), intent(inout) :: evt
     type(particle_set_t), intent(in) :: particle_set
     type(lcio_particle_t), dimension(:), allocatable :: lprt
     type(particle_set_t), target :: pset_filtered
     integer, dimension(:), allocatable :: parent
     integer :: n_tot, i, j, n_beam, n_parents, type, beam_count
 
     call particle_set%filter_particles ( pset_filtered, real_parents = .true. , &
         keep_beams = .true. , keep_virtuals = .false.)
     n_tot = pset_filtered%n_tot
     n_beam = count (pset_filtered%prt%get_status () == PRT_BEAM)
     if (n_beam == 0) then
        type = PRT_INCOMING
     else
        type = PRT_BEAM
     end if
     beam_count = 0
     allocate (lprt (n_tot))
     do i = 1, n_tot
        call particle_to_lcio (pset_filtered%prt(i), lprt(i))
        n_parents = pset_filtered%prt(i)%get_n_parents ()
        if (n_parents /= 0) then
           allocate (parent (n_parents))
           parent = pset_filtered%prt(i)%get_parents ()
           do j = 1, n_parents
              call lcio_particle_set_parent  (lprt(i), lprt(parent(j)))
           end do
           deallocate (parent)
        end if
        if (pset_filtered%prt(i)%get_status () == type) then
           beam_count = beam_count + 1
           call lcio_event_set_beam &
                (evt, pset_filtered%prt(i)%get_pdg (), beam_count)
        end if
        call lcio_particle_add_to_evt_coll (lprt(i), evt)
     end do
     call lcio_event_add_coll (evt)
   end subroutine lcio_event_from_particle_set
 
 @ %def lcio_event_from_particle_set
 @ If a particle set is initialized from a LCIO event record, we have
 to specify the treatment of polarization (unpolarized or density
 matrix) which is common to all particles.  Correlated polarization
 information is not available.
 <<HEP events: public>>=
   public :: lcio_event_to_particle_set
 <<HEP events: procedures>>=
   subroutine lcio_event_to_particle_set &
        (particle_set, evt, model, fallback_model, polarization)
     type(particle_set_t), intent(inout), target :: particle_set
     type(lcio_event_t), intent(in) :: evt
     class(model_data_t), intent(in), target :: model, fallback_model
     integer, intent(in) :: polarization
     type(lcio_particle_t) :: prt
     integer, dimension(:), allocatable :: parents, daughters
     integer :: n_tot, i, j, n_parents, n_children
     n_tot = lcio_event_get_n_tot (evt)
     allocate (particle_set%prt (n_tot))
     do i = 1, n_tot
        prt = lcio_event_get_particle (evt, i-1)
        n_parents = lcio_particle_get_n_parents (prt)
        n_children = lcio_particle_get_n_children (prt)
        allocate (daughters (n_children))
        allocate (parents (n_parents))
        if (n_children > 0) then
           do j = 1, n_children
              daughters(j) = lcio_get_n_children (evt,i,j)
           end do
        end if
        if (n_parents > 0) then
           do j = 1, n_parents
              parents(j) = lcio_get_n_parents (evt,i,j)
           end do
        end if
        call particle_from_lcio_particle (particle_set%prt(i), prt, model, &
             daughters, parents, polarization)
        deallocate (daughters, parents)
     end do
     do i = 1, n_tot
        if (particle_set%prt(i)%get_status () == PRT_VIRTUAL) then
           CHECK_BEAM: do j = 1, particle_set%prt(i)%get_n_parents ()
              if (particle_set%prt(j)%get_status () == PRT_BEAM) &
                   call particle_set%prt(i)%set_status (PRT_INCOMING)
              exit CHECK_BEAM
           end do CHECK_BEAM
        end if
     end do
     particle_set%n_tot = n_tot
     particle_set%n_beam  = &
          count (particle_set%prt%get_status () == PRT_BEAM)
     particle_set%n_in  = &
          count (particle_set%prt%get_status () == PRT_INCOMING)
     particle_set%n_out = &
          count (particle_set%prt%get_status () == PRT_OUTGOING)
     particle_set%n_vir = &
          particle_set%n_tot - particle_set%n_in - particle_set%n_out
   end subroutine lcio_event_to_particle_set
 
 @ %def lcio_event_to_particle_set
 @
 <<HEP events: public>>=
   public :: lcio_to_event
 <<HEP events: procedures>>=
   subroutine lcio_to_event &
        (event, lcio_event, fallback_model, process_index, recover_beams, &
        use_alpha_s, use_scale)
     class(generic_event_t), intent(inout), target :: event
     type(lcio_event_t), intent(inout) :: lcio_event
     class(model_data_t), intent(in), target :: fallback_model
     integer, intent(out), optional :: process_index
     logical, intent(in), optional :: recover_beams
     logical, intent(in), optional :: use_alpha_s
     logical, intent(in), optional :: use_scale
     class(model_data_t), pointer :: model
     real(default) :: scale, alpha_qcd
     type(particle_set_t) :: particle_set
     model => event%get_model_ptr ()
 
     call lcio_event_to_particle_set (particle_set, &
          lcio_event, model, fallback_model, PRT_DEFINITE_HELICITY)
     call event%set_hard_particle_set (particle_set)
     call particle_set%final ()
     call event%set_weight_ref (1._default)
     alpha_qcd = lcio_event_get_alphas (lcio_event)
     scale = lcio_event_get_scaleval (lcio_event)
     if (present (use_alpha_s)) then
        if (use_alpha_s .and. alpha_qcd > 0) &
             call event%set_alpha_qcd_forced (alpha_qcd)
     end if
     if (present (use_scale)) then
        if (use_scale .and. scale > 0) &
             call event%set_scale_forced (scale)
     end if
   end subroutine lcio_to_event
 
 @ %def lcio_to_event
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[hep_events_ut.f90]]>>=
 <<File header>>
 
 module hep_events_ut
   use unit_tests
   use hepmc_interface, only: HEPMC_IS_AVAILABLE
   use system_dependencies, only: HEPMC2_AVAILABLE
   use hep_events_uti
 
 <<Standard module head>>
 
 <<HEP events: public test>>
 
 contains
 
 <<HEP events: test driver>>
 
 end module hep_events_ut
 @ %def hep_events_ut
 @
 <<[[hep_events_uti.f90]]>>=
 <<File header>>
 
 module hep_events_uti
 
 <<Use kinds>>
 <<Use strings>>
   use lorentz
   use flavors
   use colors
   use helicities
   use quantum_numbers
   use state_matrices, only: FM_SELECT_HELICITY, FM_FACTOR_HELICITY
   use interactions
   use evaluators
   use model_data
   use particles
   use subevents
   use hepmc_interface
 
   use hep_events
 
 <<Standard module head>>
 
 <<HEP events: test declarations>>
 
 contains
 
 <<HEP events: tests>>
 
 end module hep_events_uti
 @ %def hep_events_ut
 @ API: driver for the unit tests below.
 <<HEP events: public test>>=
   public :: hep_events_test
 <<HEP events: test driver>>=
   subroutine hep_events_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<HEP events: execute tests>>
   end subroutine hep_events_test
 
 @  %def particles_test
 @ If [[HepMC]] is available, check the routines via [[HepMC]].
 
 Set up a chain of production and decay and factorize the result into
 particles.  The process is $d\bar d \to Z \to q\bar q$.
 <<HEP events: execute tests>>=
   if (hepmc_is_available ()) then
      call test (hep_events_1, "hep_events_1", &
           "check HepMC event routines", &
           u, results)
   end if
 <<HEP events: test declarations>>=
   public :: hep_events_1
 <<HEP events: tests>>=
   subroutine hep_events_1 (u)
     use os_interface
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t), dimension(3) :: flv
     type(color_t), dimension(3) :: col
     type(helicity_t), dimension(3) :: hel
     type(quantum_numbers_t), dimension(3) :: qn
     type(vector4_t), dimension(3) :: p
     type(interaction_t), target :: int1, int2
     type(quantum_numbers_mask_t) :: qn_mask_conn
     type(evaluator_t), target :: eval
     type(interaction_t), pointer :: int
     type(particle_set_t) :: particle_set1, particle_set2
     type(hepmc_event_t) :: hepmc_event
     type(hepmc_iostream_t) :: iostream
     real(default) :: cross_section, error, weight
     logical :: ok
 
     write (u, "(A)")  "* Test output: HEP events"
     write (u, "(A)")  "*   Purpose: test HepMC event routines"
     write (u, "(A)")
 
     write (u, "(A)")  "* Reading model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Initializing production process"
 
     call int1%basic_init (2, 0, 1, set_relations=.true.)
     call flv%init ([1, -1, 23], model)
     call col%init_col_acl ([0, 0, 0], [0, 0, 0])
     call hel(3)%init ( 1, 1)
     call qn%init (flv, col, hel)
     call int1%add_state (qn, value=(0.25_default, 0._default))
     call hel(3)%init ( 1,-1)
     call qn%init (flv, col, hel)
     call int1%add_state (qn, value=(0._default, 0.25_default))
     call hel(3)%init (-1, 1)
     call qn%init (flv, col, hel)
     call int1%add_state (qn, value=(0._default,-0.25_default))
     call hel(3)%init (-1,-1)
     call qn%init (flv, col, hel)
     call int1%add_state (qn, value=(0.25_default, 0._default))
     call hel(3)%init ( 0, 0)
     call qn%init (flv, col, hel)
     call int1%add_state (qn, value=(0.5_default, 0._default))
     call int1%freeze ()
     p(1) = vector4_moving (45._default, 45._default, 3)
     p(2) = vector4_moving (45._default,-45._default, 3)
     p(3) = p(1) + p(2)
     call int1%set_momenta (p)
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup decay process"
 
     call int2%basic_init (1, 0, 2, set_relations=.true.)
     call flv%init ([23, 1, -1], model)
     call col%init_col_acl ([0, 501, 0], [0, 0, 501])
     call hel%init ([1, 1, 1], [1, 1, 1])
     call qn%init (flv, col, hel)
     call int2%add_state (qn, value=(1._default, 0._default))
     call hel%init ([1, 1, 1], [-1,-1,-1])
     call qn%init (flv, col, hel)
     call int2%add_state (qn, value=(0._default, 0.1_default))
     call hel%init ([-1,-1,-1], [1, 1, 1])
     call qn%init (flv, col, hel)
     call int2%add_state (qn, value=(0._default,-0.1_default))
     call hel%init ([-1,-1,-1], [-1,-1,-1])
     call qn%init (flv, col, hel)
     call int2%add_state (qn, value=(1._default, 0._default))
     call hel%init ([0, 1,-1], [0, 1,-1])
     call qn%init (flv, col, hel)
     call int2%add_state (qn, value=(4._default, 0._default))
     call hel%init ([0,-1, 1], [0, 1,-1])
     call qn%init (flv, col, hel)
     call int2%add_state (qn, value=(2._default, 0._default))
     call hel%init ([0, 1,-1], [0,-1, 1])
     call qn%init (flv, col, hel)
     call int2%add_state (qn, value=(2._default, 0._default))
     call hel%init ([0,-1, 1], [0,-1, 1])
     call qn%init (flv, col, hel)
     call int2%add_state (qn, value=(4._default, 0._default))
     call flv%init ([23, 2, -2], model)
     call hel%init ([0, 1,-1], [0, 1,-1])
     call qn%init (flv, col, hel)
     call int2%add_state (qn, value=(0.5_default, 0._default))
     call hel%init ([0,-1, 1], [0,-1, 1])
     call qn%init (flv, col, hel)
     call int2%add_state (qn, value=(0.5_default, 0._default))
     call int2%freeze ()
     p(2) = vector4_moving (45._default, 45._default, 2)
     p(3) = vector4_moving (45._default,-45._default, 2)
     call int2%set_momenta (p)
     call int2%set_source_link (1, int1, 3)
     call int1%basic_write (u)
     call int2%basic_write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Concatenate production and decay"
 
     call eval%init_product (int1, int2, qn_mask_conn, &
          connections_are_resonant=.true.)
     call eval%receive_momenta ()
     call eval%evaluate ()
     call eval%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Factorize as subevent (complete, polarized)"
     write (u, "(A)")
 
     int => eval%interaction_t
     call particle_set1%init &
          (ok, int, int, FM_FACTOR_HELICITY, &
           [0.2_default, 0.2_default], .false., .true.)
     call particle_set1%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Factorize as subevent (in/out only, selected helicity)"
     write (u, "(A)")
 
     int => eval%interaction_t
     call particle_set2%init &
          (ok, int, int, FM_SELECT_HELICITY, &
           [0.9_default, 0.9_default], .false., .false.)
     call particle_set2%write (u)
     call particle_set2%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Factorize as subevent (complete, selected helicity)"
     write (u, "(A)")
 
     int => eval%interaction_t
     call particle_set2%init &
          (ok, int, int, FM_SELECT_HELICITY, &
           [0.7_default, 0.7_default], .false., .true.)
     call particle_set2%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Transfer particle_set to HepMC, print, and output to"
     write (u, "(A)")  "        hep_events.hepmc.dat"
     write (u, "(A)")
 
     cross_section = 42.0_default
     error = 17.0_default
     weight = 1.0_default
     call hepmc_event_init (hepmc_event, 11, 127)
     call hepmc_event_from_particle_set (hepmc_event, particle_set2, &
          cross_section, error)
     call hepmc_event_add_weight (hepmc_event, weight)
     call hepmc_event_print (hepmc_event)
     call hepmc_iostream_open_out &
          (iostream , var_str ("hep_events.hepmc.dat"))
     call hepmc_iostream_write_event (iostream, hepmc_event)
     call hepmc_iostream_close (iostream)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recover from HepMC file"
     write (u, "(A)")
 
     call particle_set2%final ()
     call hepmc_event_final (hepmc_event)
     call hepmc_event_init (hepmc_event)
     call hepmc_iostream_open_in &
          (iostream , var_str ("hep_events.hepmc.dat"))
     call hepmc_iostream_read_event (iostream, hepmc_event, ok=ok)
     call hepmc_iostream_close (iostream)
     call hepmc_event_to_particle_set (particle_set2, &
          hepmc_event, model, model, PRT_DEFINITE_HELICITY)
     call particle_set2%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call particle_set1%final ()
     call particle_set2%final ()
     call eval%final ()
     call int1%final ()
     call int2%final ()
     call hepmc_event_final (hepmc_event)
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: hep_events_1"
 
   end subroutine hep_events_1
 
 @
 @ %def hep_events_1
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{LHEF Input/Output}
 The LHEF event record is standardized.  It is an ASCII format.  We try
 our best at using it for both input and output.
 <<[[eio_lhef.f90]]>>=
 <<File header>>
 
 module eio_lhef
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use string_utils
   use numeric_utils
   use diagnostics
   use os_interface
   use xml
   use event_base
   use eio_data
   use eio_base
   use hep_common
   use hep_events
 
 <<Standard module head>>
 
 <<EIO LHEF: public>>
 
 <<EIO LHEF: types>>
 
 contains
 
 <<EIO LHEF: procedures>>
 
 end module eio_lhef
 @ %def eio_lhef
 @
 \subsection{Type}
 With sufficient confidence that it will always be three characters, we
 can store the version string with a default value.
 <<EIO LHEF: public>>=
   public :: eio_lhef_t
 <<EIO LHEF: types>>=
   type, extends (eio_t) :: eio_lhef_t
      logical :: writing = .false.
      logical :: reading = .false.
      integer :: unit = 0
      type(event_sample_data_t) :: data
      type(cstream_t) :: cstream
      character(3) :: version = "1.0"
      logical :: keep_beams = .false.
      logical :: keep_remnants = .true.
      logical :: keep_virtuals = .false.
      logical :: recover_beams = .true.
      logical :: unweighted = .true.
      logical :: write_sqme_ref = .false.
      logical :: write_sqme_prc = .false.
      logical :: write_sqme_alt = .false.
      logical :: use_alphas_from_file = .false.
      logical :: use_scale_from_file = .false.
      integer :: n_alt = 0
      integer, dimension(:), allocatable :: proc_num_id
      integer :: i_weight_sqme = 0
      type(xml_tag_t) :: tag_lhef, tag_head, tag_init, tag_event
      type(xml_tag_t), allocatable :: tag_gen_n, tag_gen_v
      type(xml_tag_t), allocatable :: tag_generator, tag_xsecinfo
      type(xml_tag_t), allocatable :: tag_sqme_ref, tag_sqme_prc
      type(xml_tag_t), dimension(:), allocatable :: tag_sqme_alt, tag_wgts_alt
      type(xml_tag_t), allocatable :: tag_weight, tag_weightinfo, tag_weights
    contains
    <<EIO LHEF: eio lhef: TBP>>
   end type eio_lhef_t
 
 @ %def eio_lhef_t
 @
 \subsection{Specific Methods}
 Set parameters that are specifically used with LHEF.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: set_parameters => eio_lhef_set_parameters
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_set_parameters (eio, &
        keep_beams, keep_remnants, recover_beams, &
        use_alphas_from_file, use_scale_from_file, &
        version, extension, write_sqme_ref, write_sqme_prc, write_sqme_alt)
     class(eio_lhef_t), intent(inout) :: eio
     logical, intent(in), optional :: keep_beams
     logical, intent(in), optional :: keep_remnants
     logical, intent(in), optional :: recover_beams
     logical, intent(in), optional :: use_alphas_from_file
     logical, intent(in), optional :: use_scale_from_file
     character(*), intent(in), optional :: version
     type(string_t), intent(in), optional :: extension
     logical, intent(in), optional :: write_sqme_ref
     logical, intent(in), optional :: write_sqme_prc
     logical, intent(in), optional :: write_sqme_alt
     if (present (keep_beams))  eio%keep_beams = keep_beams
     if (present (keep_remnants))  eio%keep_remnants = keep_remnants
     if (present (recover_beams))  eio%recover_beams = recover_beams
     if (present (use_alphas_from_file)) &
          eio%use_alphas_from_file = use_alphas_from_file
     if (present (use_scale_from_file)) &
          eio%use_scale_from_file = use_scale_from_file
     if (present (version)) then
        select case (version)
        case ("1.0", "2.0", "3.0")
           eio%version = version
        case default
           call msg_error ("LHEF version " // version &
                // " is not supported.  Inserting 2.0")
           eio%version = "2.0"
        end select
     end if
     if (present (extension)) then
        eio%extension = extension
     else
        eio%extension = "lhe"
     end if
     if (present (write_sqme_ref))  eio%write_sqme_ref = write_sqme_ref
     if (present (write_sqme_prc))  eio%write_sqme_prc = write_sqme_prc
     if (present (write_sqme_alt))  eio%write_sqme_alt = write_sqme_alt
   end subroutine eio_lhef_set_parameters
 
 @ %def eio_lhef_set_parameters
 @
 \subsection{Common Methods}
 Output.  This is not the actual event format, but a readable account
 of the current object status.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: write => eio_lhef_write
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_write (object, unit)
     class(eio_lhef_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "LHEF event stream:"
     if (object%writing) then
        write (u, "(3x,A,A)")  "Writing to file   = ", char (object%filename)
     else if (object%reading) then
        write (u, "(3x,A,A)")  "Reading from file = ", char (object%filename)
     else
        write (u, "(3x,A)")  "[closed]"
     end if
     write (u, "(3x,A,L1)")    "Keep beams        = ", object%keep_beams
     write (u, "(3x,A,L1)")    "Keep remnants     = ", object%keep_remnants
     write (u, "(3x,A,L1)")    "Recover beams     = ", object%recover_beams
     write (u, "(3x,A,L1)")    "Alpha_s from file = ", &
          object%use_alphas_from_file
     write (u, "(3x,A,L1)")    "Scale from file   = ", &
          object%use_scale_from_file
     write (u, "(3x,A,A)")     "Version           = ", object%version
     write (u, "(3x,A,A,A)")     "File extension    = '", &
          char (object%extension), "'"
     if (allocated (object%proc_num_id)) then
        write (u, "(3x,A)")  "Numerical process IDs:"
        do i = 1, size (object%proc_num_id)
           write (u, "(5x,I0,': ',I0)")  i, object%proc_num_id(i)
        end do
     end if
   end subroutine eio_lhef_write
 
 @ %def eio_lhef_write
 @ Finalizer: close any open file.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: final => eio_lhef_final
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_final (object)
     class(eio_lhef_t), intent(inout) :: object
     if (allocated (object%proc_num_id))  deallocate (object%proc_num_id)
     if (object%writing) then
        write (msg_buffer, "(A,A,A)")  "Events: closing LHEF file '", &
             char (object%filename), "'"
        call msg_message ()
        call object%write_footer ()
        close (object%unit)
        object%writing = .false.
     else if (object%reading) then
        write (msg_buffer, "(A,A,A)")  "Events: closing LHEF file '", &
             char (object%filename), "'"
        call msg_message ()
        call object%cstream%final ()
        close (object%unit)
        object%reading = .false.
     end if
   end subroutine eio_lhef_final
 
 @ %def eio_lhef_final
 @ Common initialization for input and output.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: common_init => eio_lhef_common_init
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_common_init (eio, sample, data, extension)
     class(eio_lhef_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     if (.not. present (data)) &
          call msg_bug ("LHEF initialization: missing data")
     eio%data = data
     if (data%n_beam /= 2) &
          call msg_fatal ("LHEF: defined for scattering processes only")
     eio%unweighted = data%unweighted
     if (eio%unweighted) then
        select case (data%norm_mode)
        case (NORM_UNIT)
        case default;  call msg_fatal &
             ("LHEF: normalization for unweighted events must be '1'")
        end select
     else
        select case (data%norm_mode)
        case (NORM_SIGMA)
        case default;  call msg_fatal &
             ("LHEF: normalization for weighted events must be 'sigma'")
        end select
     end if
     eio%n_alt = data%n_alt
     eio%sample = sample
     if (present (extension)) then
        eio%extension = extension
     end if
     call eio%set_filename ()
     eio%unit = free_unit ()
     call eio%init_tags (data)
     allocate (eio%proc_num_id (data%n_proc), source = data%proc_num_id)
   end subroutine eio_lhef_common_init
 
 @ %def eio_lhef_common_init
 @ Initialize the tag objects.  Some tags depend on the LHEF
 version.  In particular, the tags that in LHEF 2.0 identify
 individual weights by name in each event block, in LHEF 3.0 are
 replaced by info tags in the init block and a single \texttt{weights}
 tag in the event block.  The name attributes of those tags
 are specific for \whizard.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: init_tags => eio_lhef_init_tags
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_init_tags (eio, data)
     class(eio_lhef_t), intent(inout) :: eio
     type(event_sample_data_t), intent(in) :: data
     real(default), parameter :: pb_per_fb = 1.e-3_default
     integer :: i
     call eio%tag_lhef%init ( &
          var_str ("LesHouchesEvents"), &
          [xml_attribute (var_str ("version"), var_str (eio%version))], &
          .true.)
     call eio%tag_head%init ( &
          var_str ("header"), &
          .true.)
     call eio%tag_init%init ( &
          var_str ("init"), &
          .true.)
     call eio%tag_event%init (var_str ("event"), &
          .true.)
     select case (eio%version)
     case ("1.0")
        allocate (eio%tag_gen_n)
        call eio%tag_gen_n%init ( &
             var_str ("generator_name"), &
             .true.)
        allocate (eio%tag_gen_v)
        call eio%tag_gen_v%init ( &
             var_str ("generator_version"), &
             .true.)
     end select
     select case (eio%version)
     case ("2.0", "3.0")
        allocate (eio%tag_generator)
        call eio%tag_generator%init ( &
             var_str ("generator"), &
             [xml_attribute (var_str ("version"), var_str ("<<Version>>"))], &
             .true.)
        allocate (eio%tag_xsecinfo)
        call eio%tag_xsecinfo%init ( &
             var_str ("xsecinfo"), &
             [xml_attribute (var_str ("neve"), str (data%n_evt)), &
              xml_attribute (var_str ("totxsec"), &
                             str (data%total_cross_section * pb_per_fb))])
     end select
     select case (eio%version)
     case ("2.0")
        allocate (eio%tag_weight)
        call eio%tag_weight%init (var_str ("weight"), &
             [xml_attribute (var_str ("name"))])
        if (eio%write_sqme_ref) then
           allocate (eio%tag_sqme_ref)
           call eio%tag_sqme_ref%init (var_str ("weight"), &
                [xml_attribute (var_str ("name"), var_str ("sqme_ref"))], &
                .true.)
        end if
        if (eio%write_sqme_prc) then
           allocate (eio%tag_sqme_prc)
           call eio%tag_sqme_prc%init (var_str ("weight"), &
                [xml_attribute (var_str ("name"), var_str ("sqme_prc"))], &
                .true.)
        end if
        if (eio%n_alt > 0) then
           if (eio%write_sqme_alt) then
              allocate (eio%tag_sqme_alt (1))
              call eio%tag_sqme_alt(1)%init (var_str ("weight"), &
                   [xml_attribute (var_str ("name"), var_str ("sqme_alt"))], &
                   .true.)
           end if
           allocate (eio%tag_wgts_alt (1))
           call eio%tag_wgts_alt(1)%init (var_str ("weight"), &
                [xml_attribute (var_str ("name"), var_str ("wgts_alt"))], &
                .true.)
        end if
     case ("3.0")
        if (eio%write_sqme_ref) then
           allocate (eio%tag_sqme_ref)
           call eio%tag_sqme_ref%init (var_str ("weightinfo"), &
                [xml_attribute (var_str ("name"), var_str ("sqme_ref"))])
        end if
        if (eio%write_sqme_prc) then
           allocate (eio%tag_sqme_prc)
           call eio%tag_sqme_prc%init (var_str ("weightinfo"), &
                [xml_attribute (var_str ("name"), var_str ("sqme_prc"))])
        end if
        if (eio%n_alt > 0) then
           if (eio%write_sqme_alt) then
              allocate (eio%tag_sqme_alt (eio%n_alt))
              do i = 1, eio%n_alt
                 call eio%tag_sqme_alt(i)%init (var_str ("weightinfo"), &
                      [xml_attribute (var_str ("name"), &
                                      var_str ("sqme_alt") // str (i))])
              end do
           end if
           allocate (eio%tag_wgts_alt (eio%n_alt))
           do i = 1, eio%n_alt
              call eio%tag_wgts_alt(i)%init (var_str ("weightinfo"), &
                   [xml_attribute (var_str ("name"), &
                                   var_str ("wgts_alt") // str (i))])
           end do
        end if
        allocate (eio%tag_weightinfo)
        call eio%tag_weightinfo%init (var_str ("weightinfo"), &
             [xml_attribute (var_str ("name"))])
        allocate (eio%tag_weights)
        call eio%tag_weights%init (var_str ("weights"), .true.)
     end select
   end subroutine eio_lhef_init_tags
 
 @ %def eio_lhef_init_tags
 @ Initialize event writing.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: init_out => eio_lhef_init_out
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_init_out (eio, sample, data, success, extension)
     class(eio_lhef_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     integer :: u, i
     call eio%set_splitting (data)
     call eio%common_init (sample, data, extension)
     write (msg_buffer, "(A,A,A)")  "Events: writing to LHEF file '", &
          char (eio%filename), "'"
     call msg_message ()
     eio%writing = .true.
     u = eio%unit
     open (u, file = char (eio%filename), &
          action = "write", status = "replace")
     call eio%write_header ()
     call heprup_init &
          (data%pdg_beam, &
           data%energy_beam, &
           n_processes = data%n_proc, &
           unweighted = data%unweighted, &
           negative_weights = data%negative_weights)
     do i = 1, data%n_proc
        call heprup_set_process_parameters (i = i, &
             process_id = data%proc_num_id(i), &
             cross_section = data%cross_section(i), &
             error = data%error(i))
     end do
     call eio%tag_init%write (u);  write (u, *)
     call heprup_write_lhef (u)
     select case (eio%version)
     case ("2.0");  call eio%write_init_20 (data)
     case ("3.0");  call eio%write_init_30 (data)
     end select
     call eio%tag_init%close (u);  write (u, *)
     if (present (success))  success = .true.
   end subroutine eio_lhef_init_out
 
 @ %def eio_lhef_init_out
 @ Initialize event reading.  First read the LHEF tag and version, then
 read the header and skip over its contents, then read the init block.
 (We require the opening and closing tags of the init block to be placed
 on separate lines without extra stuff.)
 
 For input, we do not (yet?) support split event files.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: init_in => eio_lhef_init_in
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_init_in (eio, sample, data, success, extension)
     class(eio_lhef_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     logical :: exist, ok, closing
     type(event_sample_data_t) :: data_file
     type(string_t) :: string
     integer :: u
     eio%split = .false.
     call eio%common_init (sample, data, extension)
     write (msg_buffer, "(A,A,A)")  "Events: reading from LHEF file '", &
          char (eio%filename), "'"
     call msg_message ()
     inquire (file = char (eio%filename), exist = exist)
     if (.not. exist)  call msg_fatal ("Events: LHEF file not found.")
     eio%reading = .true.
     u = eio%unit
     open (u, file = char (eio%filename), &
          action = "read", status = "old")
     call eio%cstream%init (u)
     call eio%read_header ()
     call eio%tag_init%read (eio%cstream, ok)
     if (.not. ok)  call err_init
     select case (eio%version)
     case ("1.0");  call eio%read_init_10 (data_file)
        call eio%tag_init%read_content (eio%cstream, string, closing)
        if (string /= "" .or. .not. closing)  call err_init
     case ("2.0");  call eio%read_init_20 (data_file)
     case ("3.0");  call eio%read_init_30 (data_file)
     end select
     call eio%merge_data (data, data_file)
     if (present (success))  success = .true.
 
   contains
 
     subroutine err_init
       call msg_fatal ("LHEF: syntax error in init tag")
     end subroutine err_init
 
   end subroutine eio_lhef_init_in
 
 @ %def eio_lhef_init_in
 @ Merge event sample data: we can check the data in the file against
 our assumptions and set or reset parameters.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: merge_data => eio_merge_data
 <<EIO LHEF: procedures>>=
   subroutine eio_merge_data (eio, data, data_file)
     class(eio_lhef_t), intent(inout) :: eio
     type(event_sample_data_t), intent(inout) :: data
     type(event_sample_data_t), intent(in) :: data_file
     real, parameter :: tolerance = 1000 * epsilon (1._default)
     if (data%unweighted .neqv. data_file%unweighted)  call err_weights
     if (data%negative_weights .neqv. data_file%negative_weights) &
          call err_weights
     if (data%norm_mode /= data_file%norm_mode)  call err_norm
     if (data%n_beam /= data_file%n_beam)  call err_beams
     if (any (data%pdg_beam /= data_file%pdg_beam))  call err_beams
     if (any (abs ((data%energy_beam - data_file%energy_beam)) &
          > (data%energy_beam + data_file%energy_beam) * tolerance)) &
          call err_beams
     if (data%n_proc /= data_file%n_proc)  call err_proc
     if (any (data%proc_num_id /= data_file%proc_num_id))  call err_proc
     where (data%cross_section == 0)
        data%cross_section = data_file%cross_section
        data%error = data_file%error
     end where
     data%total_cross_section = sum (data%cross_section)
     if (data_file%n_evt > 0) then
        if (data%n_evt > 0 .and. data_file%n_evt /= data%n_evt)  call err_n_evt
        data%n_evt = data_file%n_evt
     end if
   contains
     subroutine err_weights
       call msg_fatal ("LHEF: mismatch in event weight properties")
     end subroutine err_weights
     subroutine err_norm
       call msg_fatal ("LHEF: mismatch in event normalization")
     end subroutine err_norm
     subroutine err_beams
       call msg_fatal ("LHEF: mismatch in beam properties")
     end subroutine err_beams
     subroutine err_proc
       call msg_fatal ("LHEF: mismatch in process definitions")
     end subroutine err_proc
     subroutine err_n_evt
       call msg_error ("LHEF: mismatch in specified number of events (ignored)")
     end subroutine err_n_evt
   end subroutine eio_merge_data
 
 @ %def eio_merge_data
 @ Switch from input to output: reopen the file for reading.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: switch_inout => eio_lhef_switch_inout
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_switch_inout (eio, success)
     class(eio_lhef_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     call msg_bug ("LHEF: in-out switch not supported")
     if (present (success))  success = .false.
   end subroutine eio_lhef_switch_inout
 
 @ %def eio_lhef_switch_inout
 @ Split event file: increment the counter, close the current file, open a new
 one.  If the file needs a header, repeat it for the new file.  (We assume that
 the common block contents are still intact.)
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: split_out => eio_lhef_split_out
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_split_out (eio)
     class(eio_lhef_t), intent(inout) :: eio
     integer :: u
     if (eio%split) then
        eio%split_index = eio%split_index + 1
        call eio%set_filename ()
        write (msg_buffer, "(A,A,A)")  "Events: writing to LHEF file '", &
             char (eio%filename), "'"
        call msg_message ()
        call eio%write_footer ()
        u = eio%unit
        close (u)
        open (u, file = char (eio%filename), &
             action = "write", status = "replace")
        call eio%write_header ()
        call eio%tag_init%write (u);  write (u, *)
        call heprup_write_lhef (u)
        select case (eio%version)
        case ("2.0");  call eio%write_init_20 (eio%data)
        case ("3.0");  call eio%write_init_30 (eio%data)
        end select
        call eio%tag_init%close (u);  write (u, *)
     end if
   end subroutine eio_lhef_split_out
 
 @ %def eio_lhef_split_out
 @ Output an event.  Write first the event indices, then weight and
 squared matrix element, then the particle set.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: output => eio_lhef_output
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_lhef_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     integer, intent(in) :: i_prc
     logical, intent(in), optional :: reading, passed, pacify
     integer :: u
     u = given_output_unit (eio%unit);  if (u < 0)  return
     if (present (passed)) then
        if (.not. passed)  return
     end if
     if (eio%writing) then
        call hepeup_from_event (event, &
             process_index = eio%proc_num_id (i_prc), &
             keep_beams = eio%keep_beams, &
             keep_remnants = eio%keep_remnants)
        write (u, '(A)') "<event>"
        call hepeup_write_lhef (eio%unit)
        select case (eio%version)
          case ("2.0");  call eio%write_event_20 (event)
          case ("3.0");  call eio%write_event_30 (event)
        end select
        write (u, '(A)') "</event>"
     else
        call eio%write ()
        call msg_fatal ("LHEF file is not open for writing")
     end if
   end subroutine eio_lhef_output
 
 @ %def eio_lhef_output
 @ Input an event.  Upon input of [[i_prc]], we can just read in the
 whole HEPEUP common block.  These data are known to come first.  The
 [[i_prc]] value can be deduced from the IDPRUP value by a table
 lookup.
 
 Reading the common block bypasses the [[cstream]] which accesses the
 input unit.  This is consistent with the LHEF specification.  After
 the common-block data have been swallowed, we can resume reading from
 stream.
 
 We don't catch actual I/O errors.  However, we return a negative value in
 [[iostat]] if we reached the terminating [[</LesHouchesEvents>]] tag.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: input_i_prc => eio_lhef_input_i_prc
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_input_i_prc (eio, i_prc, iostat)
     class(eio_lhef_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     integer :: i, proc_num_id
     type(string_t) :: s
     logical :: ok
     iostat = 0
     call eio%tag_lhef%read_content (eio%cstream, s, ok)
     if (ok) then
        if (s == "") then
           iostat = -1
        else
           call err_close
        end if
        return
     else
        call eio%cstream%revert_record (s)
     end if
     call eio%tag_event%read (eio%cstream, ok)
     if (.not. ok) then
        call err_evt1
        return
     end if
     call hepeup_read_lhef (eio%unit)
     call hepeup_get_event_parameters (proc_id = proc_num_id)
     i_prc = 0
     FIND_I_PRC: do i = 1, size (eio%proc_num_id)
        if (eio%proc_num_id(i) == proc_num_id) then
           i_prc = i
           exit FIND_I_PRC
        end if
     end do FIND_I_PRC
     if (i_prc == 0)  call err_index
   contains
     subroutine err_close
       call msg_error ("LHEF: reading events: syntax error in closing tag")
       iostat = 1
     end subroutine
     subroutine err_evt1
       call msg_error ("LHEF: reading events: invalid event tag, &
            &aborting read")
       iostat = 2
     end subroutine err_evt1
     subroutine err_index
       call msg_error ("LHEF: reading events: undefined process ID " &
            // char (str (proc_num_id)) // ", aborting read")
       iostat = 3
     end subroutine err_index
   end subroutine eio_lhef_input_i_prc
 
 @ %def eio_lhef_input_i_prc
 @ Since we have already read the event information from file, this
 input routine can transfer the common-block contents to the event
 record.  Also, we read any further information in the event record.
 
 Since LHEF doesn't give this information, we must assume that the MCI
 group, term, and channel can all be safely set to 1.  This works if
 there is only one MCI group and term.  The channel doesn't matter for
 the matrix element.
 
 The event index is incremented, as if the event was generated.  The
 LHEF format does not support event indices.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: input_event => eio_lhef_input_event
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_input_event (eio, event, iostat)
     class(eio_lhef_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     type(string_t) :: s
     logical :: closing
     iostat = 0
     call event%reset_contents ()
     call event%select (1, 1, 1)
     call hepeup_to_event (event, eio%fallback_model, &
          recover_beams = eio%recover_beams, &
          use_alpha_s = eio%use_alphas_from_file, &
          use_scale = eio%use_scale_from_file)
     select case (eio%version)
     case ("1.0")
        call eio%tag_event%read_content (eio%cstream, s, closing = closing)
        if (s /= "" .or. .not. closing)  call err_evt2
     case ("2.0");  call eio%read_event_20 (event)
     case ("3.0");  call eio%read_event_30 (event)
     end select
     call event%increment_index ()
   contains
     subroutine err_evt2
       call msg_error ("LHEF: reading events: syntax error in event record, &
            &aborting read")
       iostat = 2
     end subroutine err_evt2
 
   end subroutine eio_lhef_input_event
 
 @ %def eio_lhef_input_event
 @
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: skip => eio_lhef_skip
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_skip (eio, iostat)
     class(eio_lhef_t), intent(inout) :: eio
     integer, intent(out) :: iostat
     if (eio%reading) then
        read (eio%unit, iostat = iostat)
     else
        call eio%write ()
        call msg_fatal ("Raw event file is not open for reading")
     end if
   end subroutine eio_lhef_skip
 
 @ %def eio_lhef_skip
 @
 \subsection{Les Houches Event File: header/footer}
 These two routines write the header and footer for the Les Houches
 Event File format (LHEF).
 
 The current version writes no information except for the generator
 name and version (v.1.0 only).
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: write_header => eio_lhef_write_header
   procedure :: write_footer => eio_lhef_write_footer
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_write_header (eio)
     class(eio_lhef_t), intent(in) :: eio
     integer :: u
     u = given_output_unit (eio%unit);  if (u < 0)  return
     call eio%tag_lhef%write (u);  write (u, *)
     call eio%tag_head%write (u);  write (u, *)
     select case (eio%version)
     case ("1.0")
        write (u, "(2x)", advance = "no")
        call eio%tag_gen_n%write (var_str ("WHIZARD"), u)
        write (u, *)
        write (u, "(2x)", advance = "no")
        call eio%tag_gen_v%write (var_str ("<<Version>>"), u)
        write (u, *)
     end select
     call eio%tag_head%close (u);  write (u, *)
   end subroutine eio_lhef_write_header
 
   subroutine eio_lhef_write_footer (eio)
     class(eio_lhef_t), intent(in) :: eio
     integer :: u
     u = given_output_unit (eio%unit);  if (u < 0)  return
     call eio%tag_lhef%close (u)
   end subroutine eio_lhef_write_footer
 
 @ %def eio_lhef_write_header eio_lhef_write_footer
 @ Reading the header just means finding the tags and ignoring any
 contents.  When done, we should stand just after the header tag.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: read_header => eio_lhef_read_header
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_read_header (eio)
     class(eio_lhef_t), intent(inout) :: eio
     logical :: success, closing
     type(string_t) :: content
     call eio%tag_lhef%read (eio%cstream, success)
     if (.not. success .or. .not. eio%tag_lhef%has_content)  call err_lhef
     if (eio%tag_lhef%get_attribute (1) /= eio%version)  call err_version
     call eio%tag_head%read (eio%cstream, success)
     if (.not. success)  call err_header
     if (eio%tag_head%has_content) then
        SKIP_HEADER_CONTENT: do
           call eio%tag_head%read_content (eio%cstream, content, closing)
           if (closing)  exit SKIP_HEADER_CONTENT
        end do SKIP_HEADER_CONTENT
     end if
   contains
     subroutine err_lhef
       call msg_fatal ("LHEF: LesHouchesEvents tag absent or corrupted")
     end subroutine err_lhef
     subroutine err_header
       call msg_fatal ("LHEF: header tag absent or corrupted")
     end subroutine err_header
     subroutine err_version
        call msg_error ("LHEF: version mismatch: expected " &
             // eio%version // ", found " &
             // char (eio%tag_lhef%get_attribute (1)))
     end subroutine err_version
   end subroutine eio_lhef_read_header
 
 @ %def eio_lhef_read_header
 @
 \subsection{Version-Specific Code: 1.0}
 In version 1.0, the init tag contains just HEPRUP data.  While a
 [[cstream]] is connected to the input unit, we bypass it temporarily
 for the purpose of reading the HEPRUP contents.  This is consistent
 with the LHEF standard.
 
 This routine does not read the closing tag of the init block.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: read_init_10 => eio_lhef_read_init_10
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_read_init_10 (eio, data)
     class(eio_lhef_t), intent(in) :: eio
     type(event_sample_data_t), intent(out) :: data
     integer :: n_proc, i
     call heprup_read_lhef (eio%unit)
     call heprup_get_run_parameters (n_processes = n_proc)
     call data%init (n_proc)
     data%n_beam = 2
     call heprup_get_run_parameters ( &
          unweighted = data%unweighted, &
          negative_weights = data%negative_weights, &
          beam_pdg = data%pdg_beam, &
          beam_energy = data%energy_beam)
     if (data%unweighted) then
        data%norm_mode = NORM_UNIT
     else
        data%norm_mode = NORM_SIGMA
     end if
     do i = 1, n_proc
        call heprup_get_process_parameters (i, &
             process_id = data%proc_num_id(i), &
             cross_section = data%cross_section(i), &
             error = data%error(i))
     end do
   end subroutine eio_lhef_read_init_10
 
 @ %def eio_lhef_read_init_10
 @
 \subsection{Version-Specific Code: 2.0}
 This is the init information for the 2.0 format, after the HEPRUP
 data.  We have the following tags:
 \begin{itemize}
 \item \texttt{generator}  Generator name and version.
 \item \texttt{xsecinfo}  Cross section and weights data.  We have the
   total cross section and number of events (assuming that the event
   file is intact), but information on minimum and maximum weights is
   not available before the file is complete.  We just write the
   mandatory tags.  (Note that the default values of the other tags
   describe a uniform unit weight, but we can determine most values
   only after the sample is complete.)
 \item \texttt{cutsinfo}  This optional tag is too specific to represent the
   possibilities of WHIZARD, so we skip it.
 \item \texttt{procinfo}  This optional tag is useful for giving
   details of NLO calculations.  Skipped.
 \item \texttt{mergetype}  Optional, also not applicable.
 \end{itemize}
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: write_init_20 => eio_lhef_write_init_20
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_write_init_20 (eio, data)
     class(eio_lhef_t), intent(in) :: eio
     type(event_sample_data_t), intent(in) :: data
     integer :: u
     u = eio%unit
     call eio%tag_generator%write (u)
     write (u, "(A)", advance="no")  "WHIZARD"
     call eio%tag_generator%close (u);  write (u, *)
     call eio%tag_xsecinfo%write (u);  write (u, *)
   end subroutine eio_lhef_write_init_20
 
 @ %def eio_lhef_write_init_20
 @ When reading the init block, we first call the 1.0 routine that
 fills HEPRUP.  Then we consider the possible tags.  Only the
 \texttt{generator} and \texttt{xsecinfo} tags are of interest.  We
 skip everything else except for the closing tag.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: read_init_20 => eio_lhef_read_init_20
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_read_init_20 (eio, data)
     class(eio_lhef_t), intent(inout) :: eio
     type(event_sample_data_t), intent(out) :: data
     real(default), parameter :: pb_per_fb = 1.e-3_default
     type(string_t) :: content
     logical :: found, closing
     call eio_lhef_read_init_10 (eio, data)
     SCAN_INIT_TAGS: do
        call eio%tag_generator%read (eio%cstream, found)
        if (found) then
           if (.not. eio%tag_generator%has_content)  call err_generator
           call eio%tag_generator%read_content (eio%cstream, content, closing)
           call msg_message ("LHEF: Event file has been generated by " &
                // char (content) // " " &
                // char (eio%tag_generator%get_attribute (1)))
           cycle SCAN_INIT_TAGS
        end if
        call eio%tag_xsecinfo%read (eio%cstream, found)
        if (found) then
           if (eio%tag_xsecinfo%has_content)  call err_xsecinfo
           cycle SCAN_INIT_TAGS
        end if
        call eio%tag_init%read_content (eio%cstream, content, closing)
        if (closing) then
           if (content /= "")  call err_init
           exit SCAN_INIT_TAGS
        end if
     end do SCAN_INIT_TAGS
     data%n_evt = &
          read_ival (eio%tag_xsecinfo%get_attribute (1))
     data%total_cross_section = &
          read_rval (eio%tag_xsecinfo%get_attribute (2)) / pb_per_fb
   contains
     subroutine err_generator
       call msg_fatal ("LHEF: invalid generator tag")
     end subroutine err_generator
     subroutine err_xsecinfo
       call msg_fatal ("LHEF: invalid xsecinfo tag")
     end subroutine err_xsecinfo
     subroutine err_init
       call msg_fatal ("LHEF: syntax error after init tag")
     end subroutine err_init
   end subroutine eio_lhef_read_init_20
 
 @ %def eio_lhef_read_init_20
 @ This is additional event-specific information for the 2.0 format,
 after the HEPEUP data.  We can specify weights, starting from the
 master weight and adding alternative weights.  The alternative weights
 are collected in a common tag.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: write_event_20 => eio_lhef_write_event_20
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_write_event_20 (eio, event)
     class(eio_lhef_t), intent(in) :: eio
     class(generic_event_t), intent(in) :: event
     type(string_t) :: s
     integer :: i, u
     u = eio%unit
     if (eio%write_sqme_ref) then
        s = str (event%get_sqme_ref ())
        call eio%tag_sqme_ref%write (s, u);  write (u, *)
     end if
     if (eio%write_sqme_prc) then
        s = str (event%get_sqme_prc ())
        call eio%tag_sqme_prc%write (s, u);  write (u, *)
     end if
     if (eio%n_alt > 0) then
        if (eio%write_sqme_alt) then
           s = str (event%get_sqme_alt(1))
           do i = 2, eio%n_alt
              s = s // " " // str (event%get_sqme_alt(i));  write (u, *)
           end do
           call eio%tag_sqme_alt(1)%write (s, u)
        end if
        s = str (event%get_weight_alt(1))
        do i = 2, eio%n_alt
           s = s // " " // str (event%get_weight_alt(i));  write (u, *)
        end do
        call eio%tag_wgts_alt(1)%write (s, u)
     end if
   end subroutine eio_lhef_write_event_20
 
 @ %def eio_lhef_write_event_20
 @ Read extra event data.  If there is a weight entry labeled [[sqme_prc]], we
 take this as the squared matrix-element value (the new
 \emph{reference} value [[sqme_ref]]). Other tags, including
 tags written by the above writer, are skipped.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: read_event_20 => eio_lhef_read_event_20
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_read_event_20 (eio, event)
     class(eio_lhef_t), intent(inout) :: eio
     class(generic_event_t), intent(inout) :: event
     type(string_t) :: content
     logical :: found, closing
     SCAN_EVENT_TAGS: do
        call eio%tag_weight%read (eio%cstream, found)
        if (found) then
           if (.not. eio%tag_weight%has_content)  call err_weight
           call eio%tag_weight%read_content (eio%cstream, content, closing)
           if (.not. closing)  call err_weight
           if (eio%tag_weight%get_attribute (1) == "sqme_prc") then
              call event%set_sqme_ref (read_rval (content))
           end if
           cycle SCAN_EVENT_TAGS
        end if
        call eio%tag_event%read_content (eio%cstream, content, closing)
        if (closing) then
           if (content /= "")  call err_event
           exit SCAN_EVENT_TAGS
        end if
     end do SCAN_EVENT_TAGS
   contains
     subroutine err_weight
       call msg_fatal ("LHEF: invalid weight tag in event record")
     end subroutine err_weight
     subroutine err_event
       call msg_fatal ("LHEF: syntax error after event tag")
     end subroutine err_event
   end subroutine eio_lhef_read_event_20
 
 @ %def eio_lhef_read_event_20
 @
 \subsection{Version-Specific Code: 3.0}
 This is the init information for the 3.0 format, after the HEPRUP
 data.  We have the following tags:
 \begin{itemize}
 \item \texttt{generator}  Generator name and version.
 \item \texttt{xsecinfo}  Cross section and weights data.  We have the
   total cross section and number of events (assuming that the event
   file is intact), but information on minimum and maximum weights is
   not available before the file is complete.  We just write the
   mandatory tags.  (Note that the default values of the other tags
   describe a uniform unit weight, but we can determine most values
   only after the sample is complete.)
 \item \texttt{cutsinfo}  This optional tag is too specific to represent the
   possibilities of WHIZARD, so we skip it.
 \item \texttt{procinfo}  This optional tag is useful for giving
   details of NLO calculations.  Skipped.
 \item \texttt{weightinfo}  Determine the meaning of optional weights, whose
   values are given in the event record.
 \end{itemize}
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: write_init_30 => eio_lhef_write_init_30
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_write_init_30 (eio, data)
     class(eio_lhef_t), intent(in) :: eio
     type(event_sample_data_t), intent(in) :: data
     integer :: u, i
     u = given_output_unit (eio%unit)
     call eio%tag_generator%write (u)
     write (u, "(A)", advance="no")  "WHIZARD"
     call eiO%tag_generator%close (u);  write (u, *)
     call eio%tag_xsecinfo%write (u);  write (u, *)
     if (eio%write_sqme_ref) then
        call eio%tag_sqme_ref%write (u);  write (u, *)
     end if
     if (eio%write_sqme_prc) then
        call eio%tag_sqme_prc%write (u);  write (u, *)
     end if
     if (eio%write_sqme_alt) then
        do i = 1, eio%n_alt
           call eio%tag_sqme_alt(i)%write (u);  write (u, *)
        end do
     end if
     do i = 1, eio%n_alt
        call eio%tag_wgts_alt(i)%write (u);  write (u, *)
     end do
   end subroutine eio_lhef_write_init_30
 
 @ %def eio_lhef_write_init_30
 @ When reading the init block, we first call the 1.0 routine that
 fills HEPRUP.  Then we consider the possible tags.  Only the
 \texttt{generator} and \texttt{xsecinfo} tags are of interest.  We
 skip everything else except for the closing tag.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: read_init_30 => eio_lhef_read_init_30
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_read_init_30 (eio, data)
     class(eio_lhef_t), intent(inout) :: eio
     type(event_sample_data_t), intent(out) :: data
     real(default), parameter :: pb_per_fb = 1.e-3_default
     type(string_t) :: content
     logical :: found, closing
     integer :: n_weightinfo
     call eio_lhef_read_init_10 (eio, data)
     n_weightinfo = 0
     eio%i_weight_sqme = 0
     SCAN_INIT_TAGS: do
        call eio%tag_generator%read (eio%cstream, found)
        if (found) then
           if (.not. eio%tag_generator%has_content)  call err_generator
           call eio%tag_generator%read_content (eio%cstream, content, closing)
           call msg_message ("LHEF: Event file has been generated by " &
                // char (content) // " " &
                // char (eio%tag_generator%get_attribute (1)))
           cycle SCAN_INIT_TAGS
        end if
        call eio%tag_xsecinfo%read (eio%cstream, found)
        if (found) then
           if (eio%tag_xsecinfo%has_content)  call err_xsecinfo
           cycle SCAN_INIT_TAGS
        end if
        call eio%tag_weightinfo%read (eio%cstream, found)
        if (found) then
           if (eio%tag_weightinfo%has_content)  call err_xsecinfo
           n_weightinfo = n_weightinfo + 1
           if (eio%tag_weightinfo%get_attribute (1) == "sqme_prc") then
              eio%i_weight_sqme = n_weightinfo
           end if
           cycle SCAN_INIT_TAGS
        end if
        call eio%tag_init%read_content (eio%cstream, content, closing)
        if (closing) then
           if (content /= "")  call err_init
           exit SCAN_INIT_TAGS
        end if
     end do SCAN_INIT_TAGS
     data%n_evt = &
          read_ival (eio%tag_xsecinfo%get_attribute (1))
     data%total_cross_section = &
          read_rval (eio%tag_xsecinfo%get_attribute (2)) / pb_per_fb
   contains
     subroutine err_generator
       call msg_fatal ("LHEF: invalid generator tag")
     end subroutine err_generator
     subroutine err_xsecinfo
       call msg_fatal ("LHEF: invalid xsecinfo tag")
     end subroutine err_xsecinfo
     subroutine err_init
       call msg_fatal ("LHEF: syntax error after init tag")
     end subroutine err_init
   end subroutine eio_lhef_read_init_30
 
 @ %def eio_lhef_read_init_30
 @ This is additional event-specific information for the 3.0 format,
 after the HEPEUP data.  We can specify weights, starting from the
 master weight and adding alternative weights.  The weight tags are
 already allocated, so we just have to transfer the weight values to
 strings, assemble them and write them to file.  All weights are
 collected in a single tag.
 
 Note: If efficiency turns out to be an issue, we may revert to
 traditional character buffer writing.  However, we need to know the
 maximum length.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: write_event_30 => eio_lhef_write_event_30
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_write_event_30 (eio, event)
     class(eio_lhef_t), intent(in) :: eio
     class(generic_event_t), intent(in) :: event
     type(string_t) :: s
     integer :: u, i
     u = eio%unit
     s = ""
     if (eio%write_sqme_ref) then
        s = s // str (event%get_sqme_ref ()) // " "
     end if
     if (eio%write_sqme_prc) then
        s = s // str (event%get_sqme_prc ()) // " "
     end if
     if (eio%n_alt > 0) then
        if (eio%write_sqme_alt) then
           s = s // str (event%get_sqme_alt(1)) // " "
           do i = 2, eio%n_alt
              s = s // str (event%get_sqme_alt(i)) // " "
           end do
        end if
        s = s // str (event%get_weight_alt(1)) // " "
        do i = 2, eio%n_alt
           s = s // str (event%get_weight_alt(i)) // " "
        end do
     end if
     if (len_trim (s) > 0) then
        call eio%tag_weights%write (trim (s), u);  write (u, *)
     end if
   end subroutine eio_lhef_write_event_30
 
 @ %def eio_lhef_write_event_30
 @ Read extra event data.  If there is a [[weights]] tag and if there
 was a [[weightinfo]] entry labeled [[sqme_prc]], we extract the
 corresponding entry from the weights string and store this as the
 event's  squared matrix-element value.  Other tags, including
 tags written by the above writer, are skipped.
 <<EIO LHEF: eio lhef: TBP>>=
   procedure :: read_event_30 => eio_lhef_read_event_30
 <<EIO LHEF: procedures>>=
   subroutine eio_lhef_read_event_30 (eio, event)
     class(eio_lhef_t), intent(inout) :: eio
     class(generic_event_t), intent(inout) :: event
     type(string_t) :: content, string
     logical :: found, closing
     integer :: i
     SCAN_EVENT_TAGS: do
        call eio%tag_weights%read (eio%cstream, found)
        if (found) then
           if (.not. eio%tag_weights%has_content)  call err_weights
           call eio%tag_weights%read_content (eio%cstream, content, closing)
           if (.not. closing)  call err_weights
           if (eio%i_weight_sqme > 0) then
              SCAN_WEIGHTS: do i = 1, eio%i_weight_sqme
                 call split (content, string, " ")
                 content = adjustl (content)
                 if (i == eio%i_weight_sqme) then
                    call event%set_sqme_ref (read_rval (string))
                    exit SCAN_WEIGHTS
                 end if
              end do SCAN_WEIGHTS
           end if
           cycle SCAN_EVENT_TAGS
        end if
        call eio%tag_event%read_content (eio%cstream, content, closing)
        if (closing) then
           if (content /= "")  call err_event
           exit SCAN_EVENT_TAGS
        end if
     end do SCAN_EVENT_TAGS
   contains
     subroutine err_weights
       call msg_fatal ("LHEF: invalid weights tag in event record")
     end subroutine err_weights
     subroutine err_event
       call msg_fatal ("LHEF: syntax error after event tag")
     end subroutine err_event
   end subroutine eio_lhef_read_event_30
 
 @ %def eio_lhef_read_event_30
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_lhef_ut.f90]]>>=
 <<File header>>
 
 module eio_lhef_ut
   use unit_tests
   use eio_lhef_uti
 
 <<Standard module head>>
 
 <<EIO LHEF: public test>>
 
 contains
 
 <<EIO LHEF: test driver>>
 
 end module eio_lhef_ut
 @ %def eio_lhef_ut
 @
 <<[[eio_lhef_uti.f90]]>>=
 <<File header>>
 
 module eio_lhef_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use model_data
   use event_base
   use eio_data
   use eio_base
 
   use eio_lhef
 
   use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
   use eio_base_ut, only: eio_prepare_fallback_model, eio_cleanup_fallback_model
 
 <<Standard module head>>
 
 <<EIO LHEF: test declarations>>
 
 contains
 
 <<EIO LHEF: tests>>
 
 end module eio_lhef_uti
 @ %def eio_lhef_ut
 @ API: driver for the unit tests below.
 <<EIO LHEF: public test>>=
   public :: eio_lhef_test
 <<EIO LHEF: test driver>>=
   subroutine eio_lhef_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO LHEF: execute tests>>
   end subroutine eio_lhef_test
 
 @ %def eio_lhef_test
 @
 \subsubsection{Version 1.0 Output}
 We test the implementation of all I/O methods.  We start with output
 according to version 1.0.
 <<EIO LHEF: execute tests>>=
   call test (eio_lhef_1, "eio_lhef_1", &
        "write version 1.0", &
        u, results)
 <<EIO LHEF: test declarations>>=
   public :: eio_lhef_1
 <<EIO LHEF: tests>>=
   subroutine eio_lhef_1 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_lhef_1"
     write (u, "(A)")  "*   Purpose: generate an event and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%unweighted = .true.
     data%norm_mode = NORM_UNIT
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_lhef_1"
 
     allocate (eio_lhef_t :: eio)
     select type (eio)
     type is (eio_lhef_t)
        call eio%set_parameters ()
     end select
 
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // "." // eio%extension), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:21) == "  <generator_version>")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_lhef_t :: eio)
     select type (eio)
     type is (eio_lhef_t)
        call eio%set_parameters ()
     end select
 
     select type (eio)
     type is (eio_lhef_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_lhef_1"
 
   end subroutine eio_lhef_1
 
 @ %def eio_lhef_1
 @
 \subsubsection{Version 2.0 Output}
 Version 2.0 has added a lot of options to the LHEF format.  We
 implement some of them.
 <<EIO LHEF: execute tests>>=
   call test (eio_lhef_2, "eio_lhef_2", &
        "write version 2.0", &
        u, results)
 <<EIO LHEF: test declarations>>=
   public :: eio_lhef_2
 <<EIO LHEF: tests>>=
   subroutine eio_lhef_2 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_lhef_2"
     write (u, "(A)")  "*   Purpose: generate an event and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%unweighted = .false.
     data%norm_mode = NORM_SIGMA
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_lhef_2"
 
     allocate (eio_lhef_t :: eio)
     select type (eio)
     type is (eio_lhef_t)
        call eio%set_parameters (version = "2.0", write_sqme_prc = .true.)
     end select
 
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
 
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // "." // eio%extension), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:10) == "<generator")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_lhef_2"
 
   end subroutine eio_lhef_2
 
 @ %def eio_lhef_2
 @
 \subsubsection{Version 3.0 Output}
 Version 3.0 is an update which removes some tags (which we didn't use anyway)
 and suggests a new treatment of weights.
 <<EIO LHEF: execute tests>>=
   call test (eio_lhef_3, "eio_lhef_3", &
        "write version 3.0", &
        u, results)
 <<EIO LHEF: test declarations>>=
   public :: eio_lhef_3
 <<EIO LHEF: tests>>=
   subroutine eio_lhef_3 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: eio_lhef_3"
     write (u, "(A)")  "*   Purpose: generate an event and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%unweighted = .false.
     data%norm_mode = NORM_SIGMA
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_lhef_3"
 
     allocate (eio_lhef_t :: eio)
     select type (eio)
     type is (eio_lhef_t)
        call eio%set_parameters (version = "3.0", write_sqme_prc = .true.)
     end select
 
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
 
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents:"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".lhe"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (buffer(1:10) == "<generator")  buffer = "[...]"
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_lhef_3"
 
   end subroutine eio_lhef_3
 
 @ %def eio_lhef_3
 @
 \subsubsection{Version 1.0 Input}
 Check input of a version-1.0 conforming LHEF file.
 <<EIO LHEF: execute tests>>=
   call test (eio_lhef_4, "eio_lhef_4", &
        "read version 1.0", &
        u, results)
 <<EIO LHEF: test declarations>>=
   public :: eio_lhef_4
 <<EIO LHEF: tests>>=
   subroutine eio_lhef_4 (u)
     integer, intent(in) :: u
     class(model_data_t), pointer :: fallback_model
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat, i_prc
 
     write (u, "(A)")  "* Test output: eio_lhef_4"
     write (u, "(A)")  "*   Purpose: read a LHEF 1.0 file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Write a LHEF data file"
     write (u, "(A)")
 
     u_file = free_unit ()
     sample = "eio_lhef_4"
     open (u_file, file = char (sample // ".lhe"), &
          status = "replace", action = "readwrite")
 
     write (u_file, "(A)")  '<LesHouchesEvents version="1.0">'
     write (u_file, "(A)")  '<header>'
     write (u_file, "(A)")  '  <arbitrary_tag opt="foo">content</arbitrary_tag>'
     write (u_file, "(A)")  '  Text'
     write (u_file, "(A)")  '  <another_tag />'
     write (u_file, "(A)")  '</header>'
     write (u_file, "(A)")  '<init>'
     write (u_file, "(A)")  ' 25 25  5.0000000000E+02  5.0000000000E+02 &
          & -1 -1 -1 -1 3 1'
     write (u_file, "(A)")  '  1.0000000000E-01  1.0000000000E-03 &
          & 1.0000000000E+00 42'
     write (u_file, "(A)")  '</init>'
     write (u_file, "(A)")  '<event>'
     write (u_file, "(A)")  ' 4 42  3.0574068604E+08  1.0000000000E+03 &
          & -1.0000000000E+00 -1.0000000000E+00'
     write (u_file, "(A)")  ' 25 -1 0 0 0 0  0.0000000000E+00  0.0000000000E+00 &
          & 4.8412291828E+02  5.0000000000E+02  1.2500000000E+02 &
          & 0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  ' 25 -1 0 0 0 0  0.0000000000E+00  0.0000000000E+00 &
          &-4.8412291828E+02  5.0000000000E+02  1.2500000000E+02 &
          & 0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  ' 25 1 1 2 0 0 -1.4960220911E+02 -4.6042825611E+02 &
          & 0.0000000000E+00  5.0000000000E+02  1.2500000000E+02 &
          & 0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  ' 25 1 1 2 0 0  1.4960220911E+02  4.6042825611E+02 &
          & 0.0000000000E+00  5.0000000000E+02  1.2500000000E+02 &
          & 0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  '</event>'
     write (u_file, "(A)")  '</LesHouchesEvents>'
     close (u_file)
 
 
     write (u, "(A)")  "* Initialize test process"
     write (u, "(A)")
 
     allocate (fallback_model)
     call eio_prepare_fallback_model (fallback_model)
     call eio_prepare_test (event, unweighted = .false.)
 
     allocate (eio_lhef_t :: eio)
     select type (eio)
     type is (eio_lhef_t)
        call eio%set_parameters (recover_beams = .false.)
     end select
     call eio%set_fallback_model (fallback_model)
 
     call data%init (1)
     data%n_beam = 2
     data%unweighted = .true.
     data%norm_mode = NORM_UNIT
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     call data%write (u)
     write (u, *)
 
     write (u, "(A)")  "* Initialize and read header"
     write (u, "(A)")
 
     call eio%init_in (sample, data)
     call eio%write (u)
 
     write (u, *)
 
     select type (eio)
     type is (eio_lhef_t)
        call eio%tag_lhef%write (u);  write (u, *)
     end select
 
     write (u, *)
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read event"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
 
     select type (eio)
     type is (eio_lhef_t)
        write (u, "(A,I0,A,I0)")  "Found process #", i_prc, &
             " with ID = ", eio%proc_num_id(i_prc)
     end select
 
     call eio%input_event (event, iostat)
 
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read closing"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
     write (u, "(A,I0)")  "iostat = ", iostat
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
 
     call eio_cleanup_test (event)
     call eio_cleanup_fallback_model (fallback_model)
     deallocate (fallback_model)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_lhef_4"
 
   end subroutine eio_lhef_4
 
 @ %def eio_lhef_4
 @
 \subsubsection{Version 2.0 Input}
 Check input of a version-2.0 conforming LHEF file.
 <<EIO LHEF: execute tests>>=
   call test (eio_lhef_5, "eio_lhef_5", &
        "read version 2.0", &
        u, results)
 <<EIO LHEF: test declarations>>=
   public :: eio_lhef_5
 <<EIO LHEF: tests>>=
   subroutine eio_lhef_5 (u)
     integer, intent(in) :: u
     class(model_data_t), pointer :: fallback_model
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat, i_prc
 
     write (u, "(A)")  "* Test output: eio_lhef_5"
     write (u, "(A)")  "*   Purpose: read a LHEF 2.0 file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Write a LHEF data file"
     write (u, "(A)")
 
     u_file = free_unit ()
     sample = "eio_lhef_5"
     open (u_file, file = char (sample // ".lhe"), &
          status = "replace", action = "readwrite")
 
     write (u_file, "(A)")  '<LesHouchesEvents version="2.0">'
     write (u_file, "(A)")  '<header>'
     write (u_file, "(A)")  '</header>'
     write (u_file, "(A)")  '<init>'
     write (u_file, "(A)")  ' 25 25  5.0000000000E+02  5.0000000000E+02 &
          &-1 -1 -1 -1 4 1'
     write (u_file, "(A)")  '  1.0000000000E-01  1.0000000000E-03 &
          & 0.0000000000E+00 42'
     write (u_file, "(A)")  '<generator version="2.2.3">WHIZARD&
          &</generator>'
     write (u_file, "(A)")  '<xsecinfo neve="1" totxsec="1.0000000000E-01" />'
     write (u_file, "(A)")  '</init>'
     write (u_file, "(A)")  '<event>'
     write (u_file, "(A)")  ' 4 42  3.0574068604E+08  1.0000000000E+03 &
          &-1.0000000000E+00 -1.0000000000E+00'
     write (u_file, "(A)")  ' 25 -1 0 0 0 0  0.0000000000E+00 &
          & 0.0000000000E+00  4.8412291828E+02  5.0000000000E+02 &
          & 1.2500000000E+02  0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  ' 25 -1 0 0 0 0  0.0000000000E+00 &
          & 0.0000000000E+00 -4.8412291828E+02  5.0000000000E+02 &
          & 1.2500000000E+02  0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  ' 25 1 1 2 0 0 -1.4960220911E+02 &
          &-4.6042825611E+02  0.0000000000E+00  5.0000000000E+02 &
          & 1.2500000000E+02  0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  ' 25 1 1 2 0 0  1.4960220911E+02 &
          & 4.6042825611E+02  0.0000000000E+00  5.0000000000E+02 &
          & 1.2500000000E+02  0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  '<weight name="sqme_prc">1.0000000000E+00</weight>'
     write (u_file, "(A)")  '</event>'
     write (u_file, "(A)")  '</LesHouchesEvents>'
     close (u_file)
 
     write (u, "(A)")  "* Initialize test process"
     write (u, "(A)")
 
     allocate (fallback_model)
     call eio_prepare_fallback_model (fallback_model)
     call eio_prepare_test (event, unweighted = .false.)
 
     allocate (eio_lhef_t :: eio)
     select type (eio)
     type is (eio_lhef_t)
        call eio%set_parameters (version = "2.0", recover_beams = .false.)
     end select
     call eio%set_fallback_model (fallback_model)
 
     call data%init (1)
     data%unweighted = .false.
     data%norm_mode = NORM_SIGMA
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     call data%write (u)
     write (u, *)
 
     write (u, "(A)")  "* Initialize and read header"
     write (u, "(A)")
 
     call eio%init_in (sample, data)
     call eio%write (u)
 
     write (u, *)
 
     select type (eio)
     type is (eio_lhef_t)
        call eio%tag_lhef%write (u);  write (u, *)
     end select
 
     write (u, *)
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read event"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
 
     select type (eio)
     type is (eio_lhef_t)
        write (u, "(A,I0,A,I0)")  "Found process #", i_prc, &
             " with ID = ", eio%proc_num_id(i_prc)
     end select
 
     call eio%input_event (event, iostat)
 
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read closing"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
     write (u, "(A,I0)")  "iostat = ", iostat
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
 
     call eio_cleanup_test (event)
     call eio_cleanup_fallback_model (fallback_model)
     deallocate (fallback_model)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_lhef_5"
 
   end subroutine eio_lhef_5
 
 @ %def eio_lhef_5
 @
 \subsubsection{Version 3.0 Input}
 Check input of a version-3.0 conforming LHEF file.
 <<EIO LHEF: execute tests>>=
   call test (eio_lhef_6, "eio_lhef_6", &
        "read version 3.0", &
        u, results)
 <<EIO LHEF: test declarations>>=
   public :: eio_lhef_6
 <<EIO LHEF: tests>>=
   subroutine eio_lhef_6 (u)
     integer, intent(in) :: u
     class(model_data_t), pointer :: fallback_model
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat, i_prc
 
     write (u, "(A)")  "* Test output: eio_lhef_6"
     write (u, "(A)")  "*   Purpose: read a LHEF 3.0 file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Write a LHEF data file"
     write (u, "(A)")
 
     u_file = free_unit ()
     sample = "eio_lhef_6"
     open (u_file, file = char (sample // ".lhe"), &
          status = "replace", action = "readwrite")
 
     write (u_file, "(A)")  '<LesHouchesEvents version="3.0">'
     write (u_file, "(A)")  '<header>'
     write (u_file, "(A)")  '</header>'
     write (u_file, "(A)")  '<init>'
     write (u_file, "(A)")  ' 25 25  5.0000000000E+02  5.0000000000E+02 &
          &-1 -1 -1 -1 4 1'
     write (u_file, "(A)")  '  1.0000000000E-01  1.0000000000E-03 &
          & 0.0000000000E+00 42'
     write (u_file, "(A)")  '<generator version="2.2.3">WHIZARD&
          &</generator>'
     write (u_file, "(A)")  '<xsecinfo neve="1" totxsec="1.0000000000E-01" />'
     write (u_file, "(A)")  '<weightinfo name="sqme_prc" />'
     write (u_file, "(A)")  '</init>'
     write (u_file, "(A)")  '<event>'
     write (u_file, "(A)")  ' 4 42  3.0574068604E+08  1.0000000000E+03 &
          &-1.0000000000E+00 -1.0000000000E+00'
     write (u_file, "(A)")  ' 25 -1 0 0 0 0  0.0000000000E+00 &
          & 0.0000000000E+00  4.8412291828E+02  5.0000000000E+02 &
          & 1.2500000000E+02  0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  ' 25 -1 0 0 0 0  0.0000000000E+00 &
          & 0.0000000000E+00 -4.8412291828E+02  5.0000000000E+02 &
          & 1.2500000000E+02  0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  ' 25 1 1 2 0 0 -1.4960220911E+02 &
          &-4.6042825611E+02  0.0000000000E+00  5.0000000000E+02 &
          & 1.2500000000E+02  0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  ' 25 1 1 2 0 0  1.4960220911E+02 &
          & 4.6042825611E+02  0.0000000000E+00  5.0000000000E+02 &
          & 1.2500000000E+02  0.0000000000E+00  9.0000000000E+00'
     write (u_file, "(A)")  '<weights>1.0000000000E+00</weights>'
     write (u_file, "(A)")  '</event>'
     write (u_file, "(A)")  '</LesHouchesEvents>'
     close (u_file)
 
     write (u, "(A)")  "* Initialize test process"
     write (u, "(A)")
 
     allocate (fallback_model)
     call eio_prepare_fallback_model (fallback_model)
     call eio_prepare_test (event, unweighted = .false.)
 
     allocate (eio_lhef_t :: eio)
     select type (eio)
     type is (eio_lhef_t)
        call eio%set_parameters (version = "3.0", recover_beams = .false.)
     end select
     call eio%set_fallback_model (fallback_model)
 
     call data%init (1)
     data%unweighted = .false.
     data%norm_mode = NORM_SIGMA
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     call data%write (u)
     write (u, *)
 
     write (u, "(A)")  "* Initialize and read header"
     write (u, "(A)")
 
     call eio%init_in (sample, data)
     call eio%write (u)
 
     write (u, *)
 
     select type (eio)
     type is (eio_lhef_t)
        call eio%tag_lhef%write (u);  write (u, *)
     end select
 
     write (u, *)
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read event"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
 
     select type (eio)
     type is (eio_lhef_t)
        write (u, "(A,I0,A,I0)")  "Found process #", i_prc, &
             " with ID = ", eio%proc_num_id(i_prc)
     end select
 
     call eio%input_event (event, iostat)
 
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read closing"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
     write (u, "(A,I0)")  "iostat = ", iostat
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
 
     call eio_cleanup_test (event)
     call eio_cleanup_fallback_model (fallback_model)
     deallocate (fallback_model)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_lhef_6"
 
   end subroutine eio_lhef_6
 
 @ %def eio_lhef_6
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{STDHEP File Formats}
 Here, we implement the two existing STDHEP file formats, one based on the
 HEPRUP/HEPEUP common blocks, the other based on the HEPEVT common block.
 The second one is actually the standard STDHEP format.
 <<[[eio_stdhep.f90]]>>=
 <<File header>>
 
 module eio_stdhep
 
   use kinds, only: i32, i64
 <<Use strings>>
   use io_units
   use string_utils
   use diagnostics
   use event_base
   use hep_common
   use hep_events
   use eio_data
   use eio_base
 
 <<Standard module head>>
 
 <<EIO stdhep: public>>
 
 <<EIO stdhep: types>>
 
 <<EIO stdhep: variables>>
 
 contains
 
 <<EIO stdhep: procedures>>
 
 end module eio_stdhep
 @ %def eio_stdhep
 @
 \subsection{Type}
 <<EIO stdhep: public>>=
   public :: eio_stdhep_t
 <<EIO stdhep: types>>=
   type, abstract, extends (eio_t) :: eio_stdhep_t
      logical :: writing = .false.
      logical :: reading = .false.
      integer :: unit = 0
      logical :: keep_beams = .false.
      logical :: keep_remnants = .true.
      logical :: ensure_order = .false.
      logical :: recover_beams = .false.
      logical :: use_alphas_from_file = .false.
      logical :: use_scale_from_file = .false.
      integer, dimension(:), allocatable :: proc_num_id
      integer(i64) :: n_events_expected = 0
    contains
    <<EIO stdhep: eio stdhep: TBP>>
   end type eio_stdhep_t
 
 @ %def eio_stdhep_t
 @
 <<EIO stdhep: public>>=
   public :: eio_stdhep_hepevt_t
 <<EIO stdhep: types>>=
   type, extends (eio_stdhep_t) :: eio_stdhep_hepevt_t
   end type eio_stdhep_hepevt_t
 
 @ %def eio_stdhep_hepevt_t
 @
 <<EIO stdhep: public>>=
   public :: eio_stdhep_hepeup_t
 <<EIO stdhep: types>>=
   type, extends (eio_stdhep_t) :: eio_stdhep_hepeup_t
   end type eio_stdhep_hepeup_t
 
 @ %def eio_stdhep_hepeup_t
 @
 <<EIO stdhep: public>>=
   public :: eio_stdhep_hepev4_t
 <<EIO stdhep: types>>=
   type, extends (eio_stdhep_t) :: eio_stdhep_hepev4_t
   end type eio_stdhep_hepev4_t
 
 @ %def eio_stdhep_hepev4_t
 @
 \subsection{Specific Methods}
 Set parameters that are specifically used with STDHEP file formats.
 <<EIO stdhep: eio stdhep: TBP>>=
   procedure :: set_parameters => eio_stdhep_set_parameters
 <<EIO stdhep: procedures>>=
   subroutine eio_stdhep_set_parameters (eio, &
        keep_beams, keep_remnants, ensure_order, recover_beams, &
        use_alphas_from_file, use_scale_from_file, extension)
     class(eio_stdhep_t), intent(inout) :: eio
     logical, intent(in), optional :: keep_beams
     logical, intent(in), optional :: keep_remnants
     logical, intent(in), optional :: ensure_order
     logical, intent(in), optional :: recover_beams
     logical, intent(in), optional :: use_alphas_from_file
     logical, intent(in), optional :: use_scale_from_file
     type(string_t), intent(in), optional :: extension
     if (present (keep_beams))  eio%keep_beams = keep_beams
     if (present (keep_remnants))  eio%keep_remnants = keep_remnants
     if (present (ensure_order))  eio%ensure_order = ensure_order
     if (present (recover_beams))  eio%recover_beams = recover_beams
     if (present (use_alphas_from_file)) &
          eio%use_alphas_from_file = use_alphas_from_file
     if (present (use_scale_from_file))  &
          eio%use_scale_from_file = use_scale_from_file
     if (present (extension)) then
        eio%extension = extension
     else
        select type (eio)
        type is (eio_stdhep_hepevt_t)
           eio%extension = "hep"
        type is (eio_stdhep_hepev4_t)
           eio%extension = "ev4.hep"
        type is (eio_stdhep_hepeup_t)
           eio%extension = "up.hep"
        end select
     end if
   end subroutine eio_stdhep_set_parameters
 
 @ %def eio_ascii_stdhep_parameters
 @
 \subsection{Common Methods}
 Output.  This is not the actual event format, but a readable account
 of the current object status.
 <<EIO stdhep: eio stdhep: TBP>>=
   procedure :: write => eio_stdhep_write
 <<EIO stdhep: procedures>>=
   subroutine eio_stdhep_write (object, unit)
     class(eio_stdhep_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "STDHEP event stream:"
     if (object%writing) then
        write (u, "(3x,A,A)")  "Writing to file   = ", char (object%filename)
     else if (object%reading) then
        write (u, "(3x,A,A)")  "Reading from file = ", char (object%filename)
     else
        write (u, "(3x,A)")  "[closed]"
     end if
     write (u, "(3x,A,L1)")    "Keep beams        = ", object%keep_beams
     write (u, "(3x,A,L1)")    "Keep remnants     = ", object%keep_remnants
     write (u, "(3x,A,L1)")    "Recover beams     = ", object%recover_beams
     write (u, "(3x,A,L1)")    "Alpha_s from file = ", &
          object%use_alphas_from_file
     write (u, "(3x,A,L1)")    "Scale from file   = ", &
          object%use_scale_from_file
     if (allocated (object%proc_num_id)) then
        write (u, "(3x,A)")  "Numerical process IDs:"
        do i = 1, size (object%proc_num_id)
           write (u, "(5x,I0,': ',I0)")  i, object%proc_num_id(i)
        end do
     end if
   end subroutine eio_stdhep_write
 
 @ %def eio_stdhep_write
 @ Finalizer: close any open file.
 <<EIO stdhep: eio stdhep: TBP>>=
   procedure :: final => eio_stdhep_final
 <<EIO stdhep: procedures>>=
   subroutine eio_stdhep_final (object)
     class(eio_stdhep_t), intent(inout) :: object
     if (allocated (object%proc_num_id))  deallocate (object%proc_num_id)
     if (object%writing) then
        write (msg_buffer, "(A,A,A)")  "Events: closing STDHEP file '", &
             char (object%filename), "'"
        call msg_message ()
        call stdhep_write (200)
        call stdhep_end ()
        object%writing = .false.
     else if (object%reading) then
        write (msg_buffer, "(A,A,A)")  "Events: closing STDHEP file '", &
             char (object%filename), "'"
        call msg_message ()
        object%reading = .false.
     end if
   end subroutine eio_stdhep_final
 
 @ %def eio_stdhep_final
 @ Common initialization for input and output.
 <<EIO stdhep: eio stdhep: TBP>>=
   procedure :: common_init => eio_stdhep_common_init
 <<EIO stdhep: procedures>>=
   subroutine eio_stdhep_common_init (eio, sample, data, extension)
     class(eio_stdhep_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     if (.not. present (data)) &
          call msg_bug ("STDHEP initialization: missing data")
     if (data%n_beam /= 2) &
          call msg_fatal ("STDHEP: defined for scattering processes only")
     if (present (extension)) then
        eio%extension = extension
     end if
     eio%sample = sample
     call eio%set_filename ()
     eio%unit = free_unit ()
     allocate (eio%proc_num_id (data%n_proc), source = data%proc_num_id)
   end subroutine eio_stdhep_common_init
 
 @ %def eio_stdhep_common_init
 @ Split event file: increment the counter, close the current file, open a new
 one.  If the file needs a header, repeat it for the new file.  (We assume that
 the common block contents are still intact.)
 <<EIO stdhep: eio stdhep: TBP>>=
   procedure :: split_out => eio_stdhep_split_out
 <<EIO stdhep: procedures>>=
   subroutine eio_stdhep_split_out (eio)
     class(eio_stdhep_t), intent(inout) :: eio
     if (eio%split) then
        eio%split_index = eio%split_index + 1
        call eio%set_filename ()
        write (msg_buffer, "(A,A,A)")  "Events: writing to STDHEP file '", &
             char (eio%filename), "'"
        call msg_message ()
        call stdhep_write (200)
        call stdhep_end ()
        select type (eio)
        type is (eio_stdhep_hepeup_t)
           call stdhep_init_out (char (eio%filename), &
                "WHIZARD <<Version>>", eio%n_events_expected)
           call stdhep_write (100)
           call stdhep_write (STDHEP_HEPRUP)
        type is (eio_stdhep_hepevt_t)
           call stdhep_init_out (char (eio%filename), &
                "WHIZARD <<Version>>", eio%n_events_expected)
           call stdhep_write (100)
        type is (eio_stdhep_hepev4_t)
           call stdhep_init_out (char (eio%filename), &
                "WHIZARD <<Version>>", eio%n_events_expected)
           call stdhep_write (100)
        end select
     end if
   end subroutine eio_stdhep_split_out
 
 @ %def eio_stdhep_split_out
 @ Initialize event writing.
 <<EIO stdhep: eio stdhep: TBP>>=
   procedure :: init_out => eio_stdhep_init_out
 <<EIO stdhep: procedures>>=
   subroutine eio_stdhep_init_out (eio, sample, data, success, extension)
     class(eio_stdhep_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     integer :: i
     if (.not. present (data)) &
          call msg_bug ("STDHEP initialization: missing data")
     call eio%set_splitting (data)
     call eio%common_init (sample, data, extension)
     eio%n_events_expected = data%n_evt
     write (msg_buffer, "(A,A,A)")  "Events: writing to STDHEP file '", &
          char (eio%filename), "'"
     call msg_message ()
     eio%writing = .true.
     select type (eio)
     type is (eio_stdhep_hepeup_t)
        call heprup_init &
             (data%pdg_beam, &
             data%energy_beam, &
             n_processes = data%n_proc, &
             unweighted = data%unweighted, &
             negative_weights = data%negative_weights)
        do i = 1, data%n_proc
           call heprup_set_process_parameters (i = i, &
                process_id = data%proc_num_id(i), &
                cross_section = data%cross_section(i), &
                error = data%error(i))
        end do
        call stdhep_init_out (char (eio%filename), &
             "WHIZARD <<Version>>", eio%n_events_expected)
        call stdhep_write (100)
        call stdhep_write (STDHEP_HEPRUP)
     type is (eio_stdhep_hepevt_t)
        call stdhep_init_out (char (eio%filename), &
             "WHIZARD <<Version>>", eio%n_events_expected)
        call stdhep_write (100)
     type is (eio_stdhep_hepev4_t)
        call stdhep_init_out (char (eio%filename), &
             "WHIZARD <<Version>>", eio%n_events_expected)
        call stdhep_write (100)
     end select
     if (present (success))  success = .true.
   end subroutine eio_stdhep_init_out
 
 @ %def eio_stdhep_init_out
 @ Initialize event reading.
 <<EIO stdhep: eio stdhep: TBP>>=
   procedure :: init_in => eio_stdhep_init_in
 <<EIO stdhep: procedures>>=
   subroutine eio_stdhep_init_in (eio, sample, data, success, extension)
     class(eio_stdhep_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     integer :: ilbl, lok
     logical :: exist
     call eio%common_init (sample, data, extension)
     write (msg_buffer, "(A,A,A)")  "Events: reading from STDHEP file '", &
          char (eio%filename), "'"
     call msg_message ()
     inquire (file = char (eio%filename), exist = exist)
     if (.not. exist)  call msg_fatal ("Events: STDHEP file not found.")
     eio%reading = .true.
     call stdhep_init_in (char (eio%filename), eio%n_events_expected)
     call stdhep_read (ilbl, lok)
     if (lok /= 0) then
        call stdhep_end ()
        write (msg_buffer, "(A)")  "Events: STDHEP file appears to" // &
             " be empty."
        call msg_message ()
     end if
     if (ilbl == 100) then
        write (msg_buffer, "(A)")  "Events: reading in STDHEP events"
        call msg_message ()
     end if
     if (present (success))  success = .false.
   end subroutine eio_stdhep_init_in
 
 @ %def eio_stdhep_init_in
 @ Switch from input to output: reopen the file for reading.
 <<EIO stdhep: eio stdhep: TBP>>=
   procedure :: switch_inout => eio_stdhep_switch_inout
 <<EIO stdhep: procedures>>=
   subroutine eio_stdhep_switch_inout (eio, success)
     class(eio_stdhep_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     call msg_bug ("STDHEP: in-out switch not supported")
     if (present (success))  success = .false.
   end subroutine eio_stdhep_switch_inout
 
 @ %def eio_stdhep_switch_inout
 @ Output an event.  Write first the event indices, then weight and
 squared matrix element, then the particle set.
 <<EIO stdhep: eio stdhep: TBP>>=
   procedure :: output => eio_stdhep_output
 <<EIO stdhep: procedures>>=
   subroutine eio_stdhep_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_stdhep_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     integer, intent(in) :: i_prc
     logical, intent(in), optional :: reading, passed, pacify
     if (present (passed)) then
        if (.not. passed)  return
     end if
     if (eio%writing) then
        select type (eio)
        type is (eio_stdhep_hepeup_t)
           call hepeup_from_event (event, &
                process_index = eio%proc_num_id (i_prc), &
                keep_beams = eio%keep_beams, &
                keep_remnants = eio%keep_remnants)
           call stdhep_write (STDHEP_HEPEUP)
        type is (eio_stdhep_hepevt_t)
           call hepevt_from_event (event, &
                keep_beams = eio%keep_beams, &
                keep_remnants = eio%keep_remnants, &
                ensure_order = eio%ensure_order)
           call stdhep_write (STDHEP_HEPEVT)
        type is (eio_stdhep_hepev4_t)
           call hepevt_from_event (event, &
                process_index = eio%proc_num_id (i_prc), &
                keep_beams = eio%keep_beams, &
                keep_remnants = eio%keep_remnants, &
                ensure_order = eio%ensure_order, &
                fill_hepev4 = .true.)
           call stdhep_write (STDHEP_HEPEV4)
        end select
     else
        call eio%write ()
        call msg_fatal ("STDHEP file is not open for writing")
     end if
   end subroutine eio_stdhep_output
 
 @ %def eio_stdhep_output
 @ Input an event. We do not allow to read in STDHEP files written via
 the HEPEVT common block as there is no control on the process ID.
 This implies that the event index cannot be read; it is simply
 incremented to count the current event sample.
 <<EIO stdhep: eio stdhep: TBP>>=
   procedure :: input_i_prc => eio_stdhep_input_i_prc
   procedure :: input_event => eio_stdhep_input_event
 <<EIO stdhep: procedures>>=
   subroutine eio_stdhep_input_i_prc (eio, i_prc, iostat)
     class(eio_stdhep_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     integer :: i, ilbl, proc_num_id
     iostat = 0
     select type (eio)
     type is (eio_stdhep_hepevt_t)
        if (size (eio%proc_num_id) > 1) then
           call msg_fatal ("Events: only single processes allowed " // &
                "with the STDHEP HEPEVT format.")
        else
           proc_num_id = eio%proc_num_id (1)
           call stdhep_read (ilbl, lok)
        end if
     type is (eio_stdhep_hepev4_t)
        call stdhep_read (ilbl, lok)
        proc_num_id = idruplh
     type is (eio_stdhep_hepeup_t)
        call stdhep_read (ilbl, lok)
        if (lok /= 0)  call msg_error ("Events: STDHEP appears to be " // &
             "empty or corrupted.")
        if (ilbl == 12) then
           call stdhep_read (ilbl, lok)
        end if
        if (ilbl == 11) then
           proc_num_id = IDPRUP
        end if
     end select
     FIND_I_PRC: do i = 1, size (eio%proc_num_id)
        if (eio%proc_num_id(i) == proc_num_id) then
           i_prc = i
           exit FIND_I_PRC
        end if
     end do FIND_I_PRC
     if (i_prc == 0)  call err_index
   contains
     subroutine err_index
       call msg_error ("STDHEP: reading events: undefined process ID " &
            // char (str (proc_num_id)) // ", aborting read")
       iostat = 1
     end subroutine err_index
   end subroutine eio_stdhep_input_i_prc
 
   subroutine eio_stdhep_input_event (eio, event, iostat)
     class(eio_stdhep_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     iostat = 0
     call event%reset_contents ()
     call event%select (1, 1, 1)
     call hepeup_to_event (event, eio%fallback_model, &
          recover_beams = eio%recover_beams, &
          use_alpha_s = eio%use_alphas_from_file, &
          use_scale = eio%use_scale_from_file)
     call event%increment_index ()
   end subroutine eio_stdhep_input_event
 
 @ %def eio_stdhep_input_i_prc
 @ %def eio_stdhep_input_event
 <<EIO stdhep: eio stdhep: TBP>>=
   procedure :: skip => eio_stdhep_skip
 <<EIO stdhep: procedures>>=
   subroutine eio_stdhep_skip (eio, iostat)
     class(eio_stdhep_t), intent(inout) :: eio
     integer, intent(out) :: iostat
     if (eio%reading) then
        read (eio%unit, iostat = iostat)
     else
        call eio%write ()
        call msg_fatal ("Raw event file is not open for reading")
     end if
   end subroutine eio_stdhep_skip
 
 @ %def eio_stdhep_skip
 @ STDHEP speficic routines.
 <<EIO stdhep: public>>=
   public :: stdhep_init_out
   public :: stdhep_init_in
   public :: stdhep_write
   public :: stdhep_end
 <<EIO stdhep: procedures>>=
   subroutine stdhep_init_out (file, title, nevt)
     character(len=*), intent(in) :: file, title
     integer(i64), intent(in) :: nevt
     integer(i32) :: nevt32
     nevt32 = min (nevt, int (huge (1_i32), i64))
     call stdxwinit (file, title, nevt32, istr, lok)
   end subroutine stdhep_init_out
 
   subroutine stdhep_init_in (file, nevt)
     character(len=*), intent(in) :: file
     integer(i64), intent(out) :: nevt
     integer(i32) :: nevt32
     call stdxrinit (file, nevt32, istr, lok)
     if (lok /= 0)  call msg_fatal ("STDHEP: error in reading file '" // &
          file // "'.")
     nevt = int (nevt32, i64)
   end subroutine stdhep_init_in
 
   subroutine stdhep_write (ilbl)
     integer, intent(in) :: ilbl
     call stdxwrt (ilbl, istr, lok)
   end subroutine stdhep_write
 
   subroutine stdhep_read (ilbl, lok)
     integer, intent(out) :: ilbl, lok
     call stdxrd (ilbl, istr, lok)
     if (lok /= 0)  return
   end subroutine stdhep_read
 
   subroutine stdhep_end
     call stdxend (istr)
   end subroutine stdhep_end
 
 @  %def stdhep_init stdhep_read stdhep_write stdhep_end
 @
 \subsection{Variables}
 <<EIO stdhep: variables>>=
   integer, save :: istr, lok
   integer, parameter :: &
        STDHEP_HEPEVT = 1, STDHEP_HEPEV4 = 4, &
        STDHEP_HEPEUP = 11, STDHEP_HEPRUP = 12
 @
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_stdhep_ut.f90]]>>=
 <<File header>>
 
 module eio_stdhep_ut
   use unit_tests
   use eio_stdhep_uti
 
 <<Standard module head>>
 
 <<EIO stdhep: public test>>
 
 contains
 
 <<EIO stdhep: test driver>>
 
 end module eio_stdhep_ut
 @ %def eio_stdhep_ut
 @
 <<[[eio_stdhep_uti.f90]]>>=
 <<File header>>
 
 module eio_stdhep_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use model_data
   use event_base
   use eio_data
   use eio_base
   use xdr_wo_stdhep
 
   use eio_stdhep
 
   use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
   use eio_base_ut, only: eio_prepare_fallback_model, eio_cleanup_fallback_model
 
 <<Standard module head>>
 
 <<EIO stdhep: test declarations>>
 
 contains
 
 <<EIO stdhep: tests>>
 
 end module eio_stdhep_uti
 @ %def eio_stdhep_ut
 @ API: driver for the unit tests below.
 <<EIO stdhep: public test>>=
   public :: eio_stdhep_test
 <<EIO stdhep: test driver>>=
   subroutine eio_stdhep_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO stdhep: execute tests>>
   end subroutine eio_stdhep_test
 
 @ %def eio_stdhep_test
 @
 \subsubsection{Test I/O methods}
 We test the implementation of the STDHEP HEPEVT I/O method:
 <<EIO stdhep: execute tests>>=
   call test (eio_stdhep_1, "eio_stdhep_1", &
        "read and write event contents, format [stdhep]", &
        u, results)
 <<EIO stdhep: test declarations>>=
   public :: eio_stdhep_1
 <<EIO stdhep: tests>>=
   subroutine eio_stdhep_1 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(215) :: buffer
 
     write (u, "(A)")  "* Test output: eio_stdhep_1"
     write (u, "(A)")  "*   Purpose: generate an event in STDHEP HEPEVT format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_stdhep_1"
 
     allocate (eio_stdhep_hepevt_t :: eio)
     select type (eio)
     type is (eio_stdhep_hepevt_t)
        call eio%set_parameters ()
     end select
 
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%set_index (61)  ! not supported by reader, actually
     call event%evaluate_expressions ()
     call event%pacify_particle_set ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Write STDHEP file contents to ASCII file"
     write (u, "(A)")
 
     call write_stdhep_event &
          (sample // ".hep", var_str ("eio_stdhep_1.hep.out"), 1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read in ASCII contents of STDHEP file"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = "eio_stdhep_1.hep.out", &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (iostat /= 0)  exit
        if (trim (buffer) == "")  cycle
        if (buffer(1:18) == "    total blocks: ")  &
             buffer = "    total blocks: [...]"
        if (buffer(1:25) == "           title: WHIZARD")  &
             buffer = "           title: WHIZARD [version]"
        if (buffer(1:17) == "            date:")  &
             buffer = "            date: [...]"
        if (buffer(1:17) == "    closing date:")  &
             buffer = "    closing date: [...]"
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_stdhep_hepevt_t :: eio)
 
     select type (eio)
     type is (eio_stdhep_hepevt_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_stdhep_1"
 
   end subroutine eio_stdhep_1
 
 @ %def eio_stdhep_1
 @
 We test the implementation of the STDHEP HEPEUP I/O method:
 <<EIO stdhep: execute tests>>=
   call test (eio_stdhep_2, "eio_stdhep_2", &
        "read and write event contents, format [stdhep]", &
        u, results)
 <<EIO stdhep: test declarations>>=
   public :: eio_stdhep_2
 <<EIO stdhep: tests>>=
   subroutine eio_stdhep_2 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(model_data_t), pointer :: fallback_model
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(215) :: buffer
 
     write (u, "(A)")  "* Test output: eio_stdhep_2"
     write (u, "(A)")  "*   Purpose: generate an event in STDHEP HEPEUP format"
     write (u, "(A)")  "*      and write weight to file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     allocate (fallback_model)
     call eio_prepare_fallback_model (fallback_model)
     call eio_prepare_test (event, unweighted = .false.)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_stdhep_2"
 
     allocate (eio_stdhep_hepeup_t :: eio)
     select type (eio)
     type is (eio_stdhep_hepeup_t)
        call eio%set_parameters ()
     end select
     call eio%set_fallback_model (fallback_model)
 
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%set_index (62)  ! not supported by reader, actually
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Write STDHEP file contents to ASCII file"
     write (u, "(A)")
 
     call write_stdhep_event &
          (sample // ".up.hep", var_str ("eio_stdhep_2.hep.out"), 2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read in ASCII contents of STDHEP file"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = "eio_stdhep_2.hep.out", &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (iostat /= 0)  exit
        if (trim (buffer) == "")  cycle
        if (buffer(1:18) == "    total blocks: ")  &
             buffer = "    total blocks: [...]"
        if (buffer(1:25) == "           title: WHIZARD")  &
             buffer = "           title: WHIZARD [version]"
        if (buffer(1:17) == "            date:")  &
             buffer = "            date: [...]"
        if (buffer(1:17) == "    closing date:")  &
             buffer = "    closing date: [...]"
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_stdhep_hepeup_t :: eio)
 
     select type (eio)
     type is (eio_stdhep_hepeup_t)
        call eio%set_parameters (keep_beams = .true.)
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
     call eio_cleanup_fallback_model (fallback_model)
     deallocate (fallback_model)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_stdhep_2"
 
   end subroutine eio_stdhep_2
 
 @ %def eio_stdhep_2
 @
 Check input from a StdHep file, HEPEVT block.
 <<EIO stdhep: execute tests>>=
   call test (eio_stdhep_3, "eio_stdhep_3", &
        "read StdHep file, HEPEVT block", &
        u, results)
 <<EIO stdhep: test declarations>>=
   public :: eio_stdhep_3
 <<EIO stdhep: tests>>=
   subroutine eio_stdhep_3 (u)
     integer, intent(in) :: u
     class(model_data_t), pointer :: fallback_model
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: iostat, i_prc
 
     write (u, "(A)")  "* Test output: eio_stdhep_3"
     write (u, "(A)")  "*   Purpose: read a StdHep file, HEPEVT block"
     write (u, "(A)")
 
     write (u, "(A)")  "* Write a StdHep data file, HEPEVT block"
     write (u, "(A)")
 
     allocate (fallback_model)
     call eio_prepare_fallback_model (fallback_model)
     call eio_prepare_test (event)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_stdhep_3"
 
     allocate (eio_stdhep_hepevt_t :: eio)
     select type (eio)
     type is (eio_stdhep_hepevt_t)
        call eio%set_parameters ()
     end select
     call eio%set_fallback_model (fallback_model)
 
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%set_index (63)  ! not supported by reader, actually
     call event%evaluate_expressions ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     call eio_cleanup_test (event)
     call eio_cleanup_fallback_model (fallback_model)
     deallocate (eio)
     deallocate (fallback_model)
 
     write (u, "(A)")  "* Initialize test process"
     write (u, "(A)")
 
     allocate (fallback_model)
     call eio_prepare_fallback_model (fallback_model)
     call eio_prepare_test (event, unweighted = .false.)
 
     allocate (eio_stdhep_hepevt_t :: eio)
     select type (eio)
     type is (eio_stdhep_hepevt_t)
        call eio%set_parameters (recover_beams = .false.)
     end select
     call eio%set_fallback_model (fallback_model)
 
     call data%init (1)
     data%n_beam = 2
     data%unweighted = .true.
     data%norm_mode = NORM_UNIT
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     call data%write (u)
     write (u, *)
 
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     call eio%init_in (sample, data)
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read event"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
 
     select type (eio)
     type is (eio_stdhep_hepevt_t)
        write (u, "(A,I0,A,I0)")  "Found process #", i_prc, &
             " with ID = ", eio%proc_num_id(i_prc)
     end select
 
     call eio%input_event (event, iostat)
 
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read closing"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
     write (u, "(A,I0)")  "iostat = ", iostat
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
 
     call eio_cleanup_test (event)
     call eio_cleanup_fallback_model (fallback_model)
     deallocate (fallback_model)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_stdhep_3"
 
   end subroutine eio_stdhep_3
 
 @ %def eio_stdhep_3
 @
 Check input from a StdHep file, HEPEVT block.
 <<EIO stdhep: execute tests>>=
   call test (eio_stdhep_4, "eio_stdhep_4", &
        "read StdHep file, HEPRUP/HEPEUP block", &
        u, results)
 <<EIO stdhep: test declarations>>=
   public :: eio_stdhep_4
 <<EIO stdhep: tests>>=
   subroutine eio_stdhep_4 (u)
     integer, intent(in) :: u
     class(model_data_t), pointer :: fallback_model
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: iostat, i_prc
 
     write (u, "(A)")  "* Test output: eio_stdhep_3"
     write (u, "(A)")  "*   Purpose: read a StdHep file, HEPRUP/HEPEUP block"
     write (u, "(A)")
 
     write (u, "(A)")  "* Write a StdHep data file, HEPRUP/HEPEUP block"
     write (u, "(A)")
 
     allocate (fallback_model)
     call eio_prepare_fallback_model (fallback_model)
     call eio_prepare_test (event)
 
     call data%init (1)
     data%n_evt = 1
     data%n_beam = 2
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event, HEPEUP/HEPRUP"
     write (u, "(A)")
 
     sample = "eio_stdhep_4"
 
     allocate (eio_stdhep_hepeup_t :: eio)
     select type (eio)
     type is (eio_stdhep_hepeup_t)
        call eio%set_parameters ()
     end select
     call eio%set_fallback_model (fallback_model)
 
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%set_index (64)   ! not supported by reader, actually
     call event%evaluate_expressions ()
     call event%pacify_particle_set ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     call eio_cleanup_test (event)
     call eio_cleanup_fallback_model (fallback_model)
     deallocate (eio)
     deallocate (fallback_model)
 
     write (u, "(A)")  "* Initialize test process"
     write (u, "(A)")
 
     allocate (fallback_model)
     call eio_prepare_fallback_model (fallback_model)
     call eio_prepare_test (event, unweighted = .false.)
 
     allocate (eio_stdhep_hepeup_t :: eio)
     select type (eio)
     type is (eio_stdhep_hepeup_t)
        call eio%set_parameters (recover_beams = .false.)
     end select
     call eio%set_fallback_model (fallback_model)
 
     call data%init (1)
     data%n_beam = 2
     data%unweighted = .true.
     data%norm_mode = NORM_UNIT
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     call data%write (u)
     write (u, *)
 
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     call eio%init_in (sample, data)
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read event"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
 
     select type (eio)
     type is (eio_stdhep_hepeup_t)
        write (u, "(A,I0,A,I0)")  "Found process #", i_prc, &
             " with ID = ", eio%proc_num_id(i_prc)
     end select
 
     call eio%input_event (event, iostat)
 
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read closing"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
     write (u, "(A,I0)")  "iostat = ", iostat
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
 
     call eio_cleanup_test (event)
     call eio_cleanup_fallback_model (fallback_model)
     deallocate (fallback_model)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_stdhep_4"
 
   end subroutine eio_stdhep_4
 
 @ %def eio_stdhep_4
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{HepMC Output}
 The HepMC event record is standardized.  It is an ASCII format.  We try
 our best at using it for both input and output.
 <<[[eio_hepmc.f90]]>>=
 <<File header>>
 
 module eio_hepmc
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use string_utils
   use diagnostics
   use particles
   use model_data
   use event_base
   use hep_events
   use eio_data
   use eio_base
   use hepmc_interface
 
 <<Standard module head>>
 
 <<EIO HepMC: public>>
 
 <<EIO HepMC: types>>
 
 contains
 
 <<EIO HepMC: procedures>>
 
 end module eio_hepmc
 @ %def eio_hepmc
 @
 \subsection{Type}
 A type [[hepmc_event]] is introduced as container to store HepMC event
 data, particularly for splitting the reading into read out of the process
 index and the proper event data.
 
 Note: the [[keep_beams]] flag is not supported.  Beams will always
 be written.  Tools like \texttt{Rivet} can use the cross section
 information of a HepMC file for scaling plots.  As there is no header in
 HepMC and this is written for every event, we make it optional with
 [[output_cross_section]].
 <<EIO HepMC: public>>=
   public :: eio_hepmc_t
 <<EIO HepMC: types>>=
   type, extends (eio_t) :: eio_hepmc_t
      logical :: writing = .false.
      logical :: reading = .false.
      type(event_sample_data_t) :: data
      ! logical :: keep_beams = .false.
      logical :: recover_beams = .false.
      logical :: use_alphas_from_file = .false.
      logical :: use_scale_from_file = .false.
      logical :: output_cross_section = .false.
      logical :: hepmc2_mode = .false.
      type(hepmc_iostream_t) :: iostream
      type(hepmc_event_t) :: hepmc_event
      integer, dimension(:), allocatable :: proc_num_id
    contains
    <<EIO HepMC: eio hepmc: TBP>>
   end type eio_hepmc_t
 
 @ %def eio_hepmc_t
 @
 \subsection{Specific Methods}
 Set parameters that are specifically used with HepMC.
 <<EIO HepMC: eio hepmc: TBP>>=
   procedure :: set_parameters => eio_hepmc_set_parameters
 <<EIO HepMC: procedures>>=
   subroutine eio_hepmc_set_parameters &
        (eio, &
        recover_beams, use_alphas_from_file, use_scale_from_file, &
        extension, output_cross_section, hepmc2_mode)
     class(eio_hepmc_t), intent(inout) :: eio
     logical, intent(in), optional :: recover_beams
     logical, intent(in), optional :: use_alphas_from_file
     logical, intent(in), optional :: use_scale_from_file
     logical, intent(in), optional :: output_cross_section
     type(string_t), intent(in), optional :: extension
     logical, intent(in), optional :: hepmc2_mode
     if (present (recover_beams)) &
          eio%recover_beams = recover_beams
     if (present (use_alphas_from_file)) &
          eio%use_alphas_from_file = use_alphas_from_file
     if (present (use_scale_from_file)) &
          eio%use_scale_from_file = use_scale_from_file
     if (present (extension)) then
        eio%extension = extension
     else
        eio%extension = "hepmc"
     end if
     if (present (output_cross_section)) &
          eio%output_cross_section = output_cross_section
     if (present (hepmc2_mode)) &
          eio%hepmc2_mode = hepmc2_mode
   end subroutine eio_hepmc_set_parameters
 
 @ %def eio_hepmc_set_parameters
 @
 \subsection{Common Methods}
 Output.  This is not the actual event format, but a readable account
 of the current object status.
 <<EIO HepMC: eio hepmc: TBP>>=
   procedure :: write => eio_hepmc_write
 <<EIO HepMC: procedures>>=
   subroutine eio_hepmc_write (object, unit)
     class(eio_hepmc_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "HepMC event stream:"
     if (object%writing) then
        write (u, "(3x,A,A)")  "Writing to file   = ", char (object%filename)
     else if (object%reading) then
        write (u, "(3x,A,A)")  "Reading from file = ", char (object%filename)
     else
        write (u, "(3x,A)")  "[closed]"
     end if
     write (u, "(3x,A,L1)")    "Recover beams     = ", object%recover_beams
     write (u, "(3x,A,L1)")    "Alpha_s from file = ", &
          object%use_alphas_from_file
     write (u, "(3x,A,L1)")    "Scale from file   = ", &
          object%use_scale_from_file
     write (u, "(3x,A,A,A)")     "File extension    = '", &
          char (object%extension), "'"
     write (u, "(3x,A,L1)")    "HepMC2 compat.    = ", object%hepmc2_mode
     if (allocated (object%proc_num_id)) then
        write (u, "(3x,A)")  "Numerical process IDs:"
        do i = 1, size (object%proc_num_id)
           write (u, "(5x,I0,': ',I0)")  i, object%proc_num_id(i)
        end do
     end if
   end subroutine eio_hepmc_write
 
 @ %def eio_hepmc_write
 @ Finalizer: close any open file.
 <<EIO HepMC: eio hepmc: TBP>>=
   procedure :: final => eio_hepmc_final
 <<EIO HepMC: procedures>>=
   subroutine eio_hepmc_final (object)
     class(eio_hepmc_t), intent(inout) :: object
     if (allocated (object%proc_num_id))  deallocate (object%proc_num_id)
     if (object%writing) then
        write (msg_buffer, "(A,A,A)")  "Events: closing HepMC file '", &
             char (object%filename), "'"
        call msg_message ()
        call hepmc_iostream_close (object%iostream, object%hepmc2_mode)
        object%writing = .false.
     else if (object%reading) then
        write (msg_buffer, "(A,A,A)")  "Events: closing HepMC file '", &
             char (object%filename), "'"
        call msg_message ()
        call hepmc_iostream_close (object%iostream, object%hepmc2_mode)
        object%reading = .false.
     end if
   end subroutine eio_hepmc_final
 
 @ %def eio_hepmc_final
 @ Split event file: increment the counter, close the current file, open a new
 one.  If the file needs a header, repeat it for the new file.
 <<EIO HepMC: eio hepmc: TBP>>=
   procedure :: split_out => eio_hepmc_split_out
 <<EIO HepMC: procedures>>=
   subroutine eio_hepmc_split_out (eio)
     class(eio_hepmc_t), intent(inout) :: eio
     if (eio%split) then
        eio%split_index = eio%split_index + 1
        call eio%set_filename ()
        write (msg_buffer, "(A,A,A)")  "Events: writing to HepMC file '", &
             char (eio%filename), "'"
        call msg_message ()
        call hepmc_iostream_close (eio%iostream, eio%hepmc2_mode)
        call hepmc_iostream_open_out (eio%iostream, &
             eio%filename, eio%hepmc2_mode)
     end if
   end subroutine eio_hepmc_split_out
 
 @ %def eio_hepmc_split_out
 @ Common initialization for input and output.
 <<EIO HepMC: eio hepmc: TBP>>=
   procedure :: common_init => eio_hepmc_common_init
 <<EIO HepMC: procedures>>=
   subroutine eio_hepmc_common_init (eio, sample, data, extension)
     class(eio_hepmc_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     if (.not. present (data)) &
          call msg_bug ("HepMC initialization: missing data")
     eio%data = data
     if (data%n_beam /= 2) &
          call msg_fatal ("HepMC: defined for scattering processes only")
     ! We could relax this condition now with weighted hepmc events
     if (data%unweighted) then
        select case (data%norm_mode)
        case (NORM_UNIT)
        case default; call msg_fatal &
             ("HepMC: normalization for unweighted events must be '1'")
        end select
     end if
     eio%sample = sample
     if (present (extension)) then
        eio%extension = extension
     end if
     call eio%set_filename ()
     allocate (eio%proc_num_id (data%n_proc), source = data%proc_num_id)
   end subroutine eio_hepmc_common_init
 
 @ %def eio_hepmc_common_init
 @ Initialize event writing.
 <<EIO HepMC: eio hepmc: TBP>>=
   procedure :: init_out => eio_hepmc_init_out
 <<EIO HepMC: procedures>>=
   subroutine eio_hepmc_init_out (eio, sample, data, success, extension)
     class(eio_hepmc_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     call eio%set_splitting (data)
     call eio%common_init (sample, data, extension)
     write (msg_buffer, "(A,A,A)")  "Events: writing to HepMC file '", &
          char (eio%filename), "'"
     call msg_message ()
     eio%writing = .true.
     call hepmc_iostream_open_out (eio%iostream, &
          eio%filename, eio%hepmc2_mode)
     if (present (success))  success = .true.
   end subroutine eio_hepmc_init_out
 
 @ %def eio_hepmc_init_out
 @ Initialize event reading. For input, we do not (yet) support split
 event files.
 <<EIO HepMC: eio hepmc: TBP>>=
   procedure :: init_in => eio_hepmc_init_in
 <<EIO HepMC: procedures>>=
   subroutine eio_hepmc_init_in (eio, sample, data, success, extension)
     class(eio_hepmc_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     logical :: exist
     eio%split = .false.
     call eio%common_init (sample, data, extension)
     write (msg_buffer, "(A,A,A)")  "Events: reading from HepMC file '", &
          char (eio%filename), "'"
     call msg_message ()
     inquire (file = char (eio%filename), exist = exist)
     if (.not. exist)  call msg_fatal ("Events: HepMC file not found.")
     eio%reading = .true.
     call hepmc_iostream_open_in (eio%iostream, &
          eio%filename, eio%hepmc2_mode)
     if (present (success))  success = .true.
   end subroutine eio_hepmc_init_in
 
 @ %def eio_hepmc_init_in
 @ Switch from input to output: reopen the file for reading.
 <<EIO HepMC: eio hepmc: TBP>>=
   procedure :: switch_inout => eio_hepmc_switch_inout
 <<EIO HepMC: procedures>>=
   subroutine eio_hepmc_switch_inout (eio, success)
     class(eio_hepmc_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     call msg_bug ("HepMC: in-out switch not supported")
     if (present (success))  success = .false.
   end subroutine eio_hepmc_switch_inout
 
 @ %def eio_hepmc_switch_inout
 @ Output an event to the allocated HepMC output stream. For the
 moment, we set [[alpha_qed]] always to -1. There should be methods for
 the handling of $\alpha$ in [[me_methods]] in the same way as for
 $\alpha_s$.
 <<EIO HepMC: eio hepmc: TBP>>=
   procedure :: output => eio_hepmc_output
 <<EIO HepMC: procedures>>=
   subroutine eio_hepmc_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_hepmc_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     integer, intent(in) :: i_prc
     logical, intent(in), optional :: reading, passed, pacify
     type(particle_set_t), pointer :: pset_ptr
     if (present (passed)) then
        if (.not. passed)  return
     end if
     if (eio%writing) then
        pset_ptr => event%get_particle_set_ptr ()
        call hepmc_event_init (eio%hepmc_event, &
             proc_id = eio%proc_num_id(i_prc), &
             event_id = event%get_index ())
        if (eio%output_cross_section) then
           call hepmc_event_from_particle_set (eio%hepmc_event, pset_ptr, &
                eio%data%cross_section(i_prc), eio%data%error(i_prc))
        else
           call hepmc_event_from_particle_set (eio%hepmc_event, pset_ptr)
        end if
        call hepmc_event_set_scale (eio%hepmc_event, event%get_fac_scale ())
        call hepmc_event_set_alpha_qcd (eio%hepmc_event, event%get_alpha_s ())
        call hepmc_event_set_alpha_qed (eio%hepmc_event, -1._default)
        if (.not. eio%data%unweighted) &
           call hepmc_event_add_weight (eio%hepmc_event, event%weight_prc)
        call hepmc_iostream_write_event (eio%iostream, &
             eio%hepmc_event, eio%hepmc2_mode)
        call hepmc_event_final (eio%hepmc_event)
     else
        call eio%write ()
        call msg_fatal ("HepMC file is not open for writing")
     end if
   end subroutine eio_hepmc_output
 
 @ %def eio_hepmc_output
 @ Input an event.
 <<EIO HepMC: eio hepmc: TBP>>=
   procedure :: input_i_prc => eio_hepmc_input_i_prc
   procedure :: input_event => eio_hepmc_input_event
 <<EIO HepMC: procedures>>=
   subroutine eio_hepmc_input_i_prc (eio, i_prc, iostat)
     class(eio_hepmc_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     logical :: ok
     integer :: i, proc_num_id
     iostat = 0
     call hepmc_event_init (eio%hepmc_event)
     call hepmc_iostream_read_event (eio%iostream, &
          eio%hepmc_event, ok=ok, hepmc2=eio%hepmc2_mode)
     proc_num_id = hepmc_event_get_process_id (eio%hepmc_event)
     if (.not. ok) then
        iostat = -1
        return
     end if
     i_prc = 0
     FIND_I_PRC: do i = 1, size (eio%proc_num_id)
        if (eio%proc_num_id(i) == proc_num_id) then
           i_prc = i
           exit FIND_I_PRC
        end if
     end do FIND_I_PRC
     if (i_prc == 0)  call err_index
   contains
     subroutine err_index
       call msg_error ("HepMC: reading events: undefined process ID " &
            // char (str (proc_num_id)) // ", aborting read")
       iostat = 1
     end subroutine err_index
   end subroutine eio_hepmc_input_i_prc
 
   subroutine eio_hepmc_input_event (eio, event, iostat)
     class(eio_hepmc_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     iostat = 0
     call event%reset_contents ()
     call event%select (1, 1, 1)
     call hepmc_to_event (event, eio%hepmc_event, &
          eio%fallback_model, &
          recover_beams = eio%recover_beams, &
          use_alpha_s = eio%use_alphas_from_file, &
          use_scale = eio%use_scale_from_file)
     call hepmc_event_final (eio%hepmc_event)
   end subroutine eio_hepmc_input_event
 
 @ %def eio_hepmc_input_i_prc
 @ %def eio_hepmc_input_event
 @
 <<EIO HepMC: eio hepmc: TBP>>=
   procedure :: skip => eio_hepmc_skip
 <<EIO HepMC: procedures>>=
   subroutine eio_hepmc_skip (eio, iostat)
     class(eio_hepmc_t), intent(inout) :: eio
     integer, intent(out) :: iostat
     iostat = 0
   end subroutine eio_hepmc_skip
 
 @ %def eio_hepmc_skip
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_hepmc_ut.f90]]>>=
 <<File header>>
 
 module eio_hepmc_ut
   use unit_tests
   use system_dependencies, only: HEPMC2_AVAILABLE
   use system_dependencies, only: HEPMC3_AVAILABLE
   use eio_hepmc_uti
 
 <<Standard module head>>
 
 <<EIO HepMC: public test>>
 
 contains
 
 <<EIO HepMC: test driver>>
 
 end module eio_hepmc_ut
 @ %def eio_hepmc_ut
 @
 <<[[eio_hepmc_uti.f90]]>>=
 <<File header>>
 
 module eio_hepmc_uti
 
 <<Use kinds>>
 <<Use strings>>
   use system_dependencies, only: HEPMC2_AVAILABLE
   use system_dependencies, only: HEPMC3_AVAILABLE
   use io_units
   use diagnostics
   use model_data
   use event_base
   use eio_data
   use eio_base
 
   use eio_hepmc
 
   use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
   use eio_base_ut, only: eio_prepare_fallback_model, eio_cleanup_fallback_model
 
 <<Standard module head>>
 
 <<EIO HepMC: test declarations>>
 
 contains
 
 <<EIO HepMC: tests>>
 
 end module eio_hepmc_uti
 @ %def eio_hepmc_ut
 @ API: driver for the unit tests below.
 <<EIO HepMC: public test>>=
   public :: eio_hepmc_test
 <<EIO HepMC: test driver>>=
   subroutine eio_hepmc_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO HepMC: execute tests>>
   end subroutine eio_hepmc_test
 
 @ %def eio_hepmc_test
 @
 \subsubsection{Test I/O methods}
 We test the implementation of all I/O methods.
 <<EIO HepMC: execute tests>>=
   if (HEPMC2_AVAILABLE) then
      call test (eio_hepmc_1, "eio_hepmc2_1", &
           "write event contents", &
           u, results)
   else if (HEPMC3_AVAILABLE) then
      call test (eio_hepmc_1, "eio_hepmc3_1", &
           "write event contents", &
           u, results)
   end if
 <<EIO HepMC: test declarations>>=
   public :: eio_hepmc_1
 <<EIO HepMC: tests>>=
   subroutine eio_hepmc_1 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat
     character(116) :: buffer
 
     write (u, "(A)")  "* Test output: eio_hepmc_1"
     write (u, "(A)")  "*   Purpose: write a HepMC file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event, unweighted=.false.)
 
     call data%init (1)
     data%n_beam = 2
     data%unweighted = .true.
     data%norm_mode = NORM_UNIT
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_hepmc_1"
 
     allocate (eio_hepmc_t :: eio)
     select type (eio)
     type is (eio_hepmc_t)
        call eio%set_parameters ()
     end select
 
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%set_index (55)
 
     call eio%output (event, i_prc = 1)    
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* File contents (blanking out last two digits):"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = char (sample // ".hepmc"), &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (iostat /= 0)  exit
        if (trim (buffer) == "")  cycle
        if (buffer(1:14) == "HepMC::Version")  cycle
        if (HEPMC2_AVAILABLE) then
           if (buffer(1:10) == "P 10001 25") &
                call buffer_blanker (buffer, 32, 55, 78)
           if (buffer(1:10) == "P 10002 25") &
                call buffer_blanker (buffer, 33, 56, 79)
           if (buffer(1:10) == "P 10003 25") &
                call buffer_blanker (buffer, 29, 53, 78, 101)
           if (buffer(1:10) == "P 10004 25") &
                call buffer_blanker (buffer, 28, 51, 76, 99)
        else if (HEPMC3_AVAILABLE) then
           if (buffer(1:8) == "P 1 0 25") &
                call buffer_blanker (buffer, 26, 49, 72)
           if (buffer(1:8) == "P 2 0 25") &
                call buffer_blanker (buffer, 26, 49, 73)
           if (buffer(1:9) == "P 3 -1 25") &
                call buffer_blanker (buffer, 28, 52, 75)
           if (buffer(1:9) == "P 4 -1 25") &
                call buffer_blanker (buffer, 27, 50, 73)
        end if
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_hepmc_t :: eio)
 
     select type (eio)
     type is (eio_hepmc_t)
        call eio%set_parameters ()
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_hepmc_1"
 
   contains
 
     subroutine buffer_blanker (buf, pos1, pos2, pos3, pos4)
       character(len=*), intent(inout) :: buf
       integer, intent(in) :: pos1, pos2, pos3
       integer, intent(in), optional :: pos4
       type(string_t) :: line
       line = var_str (trim (buf))
       line = replace (line, pos1, "XX")
       line = replace (line, pos2, "XX")
       line = replace (line, pos3, "XX")
       if (present (pos4)) then
          line = replace (line, pos4, "XX")
       end if
       line = replace (line, "4999999999999", "5000000000000")
       buf = char (line)
     end subroutine buffer_blanker
 
   end subroutine eio_hepmc_1
 
 @ %def eio_hepmc_1
 @ Test also the reading of HepMC events.
 <<EIO HepMC: execute tests>>=
   if (HEPMC2_AVAILABLE) then
      call test (eio_hepmc_2, "eio_hepmc2_2", &
           "read event contents", &
           u, results)
   else if (HEPMC3_AVAILABLE) then
      call test (eio_hepmc_2, "eio_hepmc3_2", &
           "read event contents", &
           u, results)
   end if
 <<EIO HepMC: test declarations>>=
   public :: eio_hepmc_2
 <<EIO HepMC: tests>>=
   subroutine eio_hepmc_2 (u)
     integer, intent(in) :: u
     class(model_data_t), pointer :: fallback_model
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: u_file, iostat, i_prc
 
     write (u, "(A)")  "* Test output: eio_hepmc_2"
     write (u, "(A)")  "*   Purpose: read a HepMC event"
     write (u, "(A)")
 
     write (u, "(A)")  "* Write a HepMC data file"
     write (u, "(A)")
 
     u_file = free_unit ()
     sample = "eio_hepmc_2"
     open (u_file, file = char (sample // ".hepmc"), &
          status = "replace", action = "readwrite")
 
     if (HEPMC2_AVAILABLE) then
        write (u_file, "(A)")  "HepMC::Version 2.06.09"
        write (u_file, "(A)")  "HepMC::IO_GenEvent-START_EVENT_LISTING"
        write (u_file, "(A)")  "E 66 -1 -1.0000000000000000e+00 &
             &-1.0000000000000000e+00 &
             &-1.0000000000000000e+00 42 0 1 10001 10002 0 0"
        write (u_file, "(A)")  "U GEV MM"
        write (u_file, "(A)")  "V -1 0 0 0 0 0 2 2 0"
        write (u_file, "(A)")  "P 10001 25 0 0 4.8412291827592713e+02 &
             &5.0000000000000000e+02 &
             &1.2499999999999989e+02 3 0 0 -1 0"
        write (u_file, "(A)")  "P 10002 25 0 0 -4.8412291827592713e+02 &
             &5.0000000000000000e+02 &
             &1.2499999999999989e+02 3 0 0 -1 0"
        write (u_file, "(A)")  "P 10003 25 -1.4960220911365536e+02 &
             &-4.6042825611414656e+02 &
             &0 5.0000000000000000e+02 1.2500000000000000e+02 1 0 0 0 0"
        write (u_file, "(A)")  "P 10004 25 1.4960220911365536e+02 &
             &4.6042825611414656e+02 &
             &0 5.0000000000000000e+02 1.2500000000000000e+02 1 0 0 0 0"
        write (u_file, "(A)")  "HepMC::IO_GenEvent-END_EVENT_LISTING"
     else if (HEPMC3_AVAILABLE) then
        write (u_file, "(A)")  "HepMC::Version 3.01.01"
        write (u_file, "(A)")  "HepMC::Asciiv3-START_EVENT_LISTING"
        write (u_file, "(A)")  "E 55 1 4"
        write (u_file, "(A)")  "U GEV MM"
        write (u_file, "(A)")  "A 0 alphaQCD -1"
        write (u_file, "(A)")  "A 0 event_scale 1000"
        write (u_file, "(A)")  "A 0 signal_process_id 42"
        write (u_file, "(A)")  "P 1 0 25 0.0000000000000000e+00 &
             &0.0000000000000000e+00 4.8412291827592713e+02 &
             &5.0000000000000000e+02 1.2499999999999989e+02 3"
        write (u_file, "(A)")  "P 2 0 25 0.0000000000000000e+00 &
             &0.0000000000000000e+00 -4.8412291827592713e+02 &
             &5.0000000000000000e+02 1.2499999999999989e+02 3"
        write (u_file, "(A)")  "V -1 0 [1,2]"  
        write (u_file, "(A)")  "P 3 -1 25 -1.4960220911365536e+02 &
             &-4.6042825611414656e+02 0.0000000000000000e+00 &
             &5.0000000000000000e+02 1.2500000000000000e+02 1"
        write (u_file, "(A)")  "P 4 -1 25 1.4960220911365536e+02 &
             &4.6042825611414656e+02 0.0000000000000000e+00 &
             &5.0000000000000000e+02 1.2500000000000000e+02 1"
        write (u_file, "(A)")  "HepMC::Asciiv3-END_EVENT_LISTING"
     else
        call msg_fatal &
             ("Trying to execute eio_hepmc unit tests without a linked HepMC")
     end if
     close (u_file)
 
     write (u, "(A)")  "* Initialize test process"
     write (u, "(A)")
 
     allocate (fallback_model)
     call eio_prepare_fallback_model (fallback_model)
     call eio_prepare_test (event, unweighted=.false.)
 
     allocate (eio_hepmc_t :: eio)
     select type (eio)
     type is (eio_hepmc_t)
        call eio%set_parameters (recover_beams = .false.)
     end select
     call eio%set_fallback_model (fallback_model)
 
     call data%init (1)
     data%n_beam = 2
     data%unweighted = .true.
     data%norm_mode = NORM_UNIT
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     call eio%init_in (sample, data)
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read event"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
 
     select type (eio)
     type is (eio_hepmc_t)
        write (u, "(A,I0,A,I0)")  "Found process #", i_prc, &
             " with ID = ", eio%proc_num_id(i_prc)
     end select
     
     call eio%input_event (event, iostat)
 
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read closing"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
     write (u, "(A,I0)")  "iostat = ", iostat
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
 
     call eio_cleanup_test (event)
     call eio_cleanup_fallback_model (fallback_model)
     deallocate (fallback_model)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_hepmc_2"
 
   end subroutine eio_hepmc_2
 
 @ %def eio_hepmc_2
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{LCIO Output}
 The LCIO event record is standardized for the use with Linear $e^+e^-$
 colliders. It is a binary event format.  We try our best at using it
 for both input and output.
 <<[[eio_lcio.f90]]>>=
 <<File header>>
 
 module eio_lcio
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use string_utils
   use diagnostics
   use particles
   use event_base
   use hep_events
   use eio_data
   use eio_base
   use lcio_interface
 
 <<Standard module head>>
 
 <<EIO LCIO: public>>
 
 <<EIO LCIO: types>>
 
 contains
 
 <<EIO LCIO: procedures>>
 
 end module eio_lcio
 @ %def eio_lcio
 @
 \subsection{Type}
 A type [[lcio_event]] is introduced as container to store LCIO event
 data, particularly for splitting the reading into read out of the process
 index and the proper event data.
 
 Note: the [[keep_beams]] flag is not supported.
 <<EIO LCIO: public>>=
   public :: eio_lcio_t
 <<EIO LCIO: types>>=
   type, extends (eio_t) :: eio_lcio_t
      logical :: writing = .false.
      logical :: reading = .false.
      type(event_sample_data_t) :: data
      logical :: recover_beams = .false.
      logical :: use_alphas_from_file = .false.
      logical :: use_scale_from_file = .false.
+     logical :: proc_as_run_id = .true.
      integer :: n_alt = 0
+     integer :: lcio_run_id = 0
      type(lcio_writer_t) :: lcio_writer
      type(lcio_reader_t) :: lcio_reader
      type(lcio_run_header_t) :: lcio_run_hdr
      type(lcio_event_t) :: lcio_event
      integer, dimension(:), allocatable :: proc_num_id
    contains
    <<EIO LCIO: eio lcio: TBP>>
   end type eio_lcio_t
 
 @ %def eio_lcio_t
 @
 \subsection{Specific Methods}
 Set parameters that are specifically used with LCIO.
 <<EIO LCIO: eio lcio: TBP>>=
   procedure :: set_parameters => eio_lcio_set_parameters
 <<EIO LCIO: procedures>>=
   subroutine eio_lcio_set_parameters &
        (eio, recover_beams, use_alphas_from_file, use_scale_from_file, &
-       extension)
+       extension, proc_as_run_id, lcio_run_id)
     class(eio_lcio_t), intent(inout) :: eio
     logical, intent(in), optional :: recover_beams
     logical, intent(in), optional :: use_alphas_from_file
     logical, intent(in), optional :: use_scale_from_file
+    logical, intent(in), optional :: proc_as_run_id
+    integer, intent(in), optional :: lcio_run_id
     type(string_t), intent(in), optional :: extension
     if (present (recover_beams))  eio%recover_beams = recover_beams
     if (present (use_alphas_from_file)) &
          eio%use_alphas_from_file = use_alphas_from_file
     if (present (use_scale_from_file)) &
          eio%use_scale_from_file = use_scale_from_file
+    if (present (proc_as_run_id)) &
+         eio%proc_as_run_id = proc_as_run_id
+    if (present (lcio_run_id)) &
+         eio%lcio_run_id = lcio_run_id
     if (present (extension)) then
        eio%extension = extension
     else
        eio%extension = "slcio"
     end if
   end subroutine eio_lcio_set_parameters
 
 @ %def eio_lcio_set_parameters
 @
 \subsection{Common Methods}
 Output.  This is not the actual event format, but a readable account
 of the current object status.
 <<EIO LCIO: eio lcio: TBP>>=
   procedure :: write => eio_lcio_write
 <<EIO LCIO: procedures>>=
   subroutine eio_lcio_write (object, unit)
     class(eio_lcio_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "LCIO event stream:"
     if (object%writing) then
        write (u, "(3x,A,A)")  "Writing to file   = ", char (object%filename)
     else if (object%reading) then
        write (u, "(3x,A,A)")  "Reading from file = ", char (object%filename)
     else
        write (u, "(3x,A)")  "[closed]"
     end if
     write (u, "(3x,A,L1)")    "Recover beams     = ", object%recover_beams
     write (u, "(3x,A,L1)")    "Alpha_s from file = ", &
          object%use_alphas_from_file
     write (u, "(3x,A,L1)")    "Scale from file   = ", &
          object%use_scale_from_file
+    write (u, "(3x,A,L1)")    "Process as run ID = ", &
+         object%proc_as_run_id
+    write (u, "(3x,A,I0)")    "LCIO run ID       = ", &
+         object%lcio_run_id
     write (u, "(3x,A,A,A)")     "File extension    = '", &
          char (object%extension), "'"
     if (allocated (object%proc_num_id)) then
        write (u, "(3x,A)")  "Numerical process IDs:"
        do i = 1, size (object%proc_num_id)
           write (u, "(5x,I0,': ',I0)")  i, object%proc_num_id(i)
        end do
     end if
   end subroutine eio_lcio_write
 
 @ %def eio_lcio_write
 @ Finalizer: close any open file.
 <<EIO LCIO: eio lcio: TBP>>=
   procedure :: final => eio_lcio_final
 <<EIO LCIO: procedures>>=
   subroutine eio_lcio_final (object)
     class(eio_lcio_t), intent(inout) :: object
     if (allocated (object%proc_num_id))  deallocate (object%proc_num_id)
     if (object%writing) then
        write (msg_buffer, "(A,A,A)")  "Events: closing LCIO file '", &
             char (object%filename), "'"
        call msg_message ()
        call lcio_writer_close (object%lcio_writer)
        object%writing = .false.
     else if (object%reading) then
        write (msg_buffer, "(A,A,A)")  "Events: closing LCIO file '", &
             char (object%filename), "'"
        call msg_message ()
        call lcio_reader_close (object%lcio_reader)
        object%reading = .false.
     end if
   end subroutine eio_lcio_final
 
 @ %def eio_lcio_final
 @ Split event file: increment the counter, close the current file, open a new
 one.  If the file needs a header, repeat it for the new file.
 <<EIO LCIO: eio lcio: TBP>>=
   procedure :: split_out => eio_lcio_split_out
 <<EIO LCIO: procedures>>=
   subroutine eio_lcio_split_out (eio)
     class(eio_lcio_t), intent(inout) :: eio
     if (eio%split) then
        eio%split_index = eio%split_index + 1
        call eio%set_filename ()
        write (msg_buffer, "(A,A,A)")  "Events: writing to LCIO file '", &
             char (eio%filename), "'"
        call msg_message ()
        call lcio_writer_close (eio%lcio_writer)
        call lcio_writer_open_out (eio%lcio_writer, eio%filename)
     end if
   end subroutine eio_lcio_split_out
 
 @ %def eio_lcio_split_out
 @ Common initialization for input and output.
 <<EIO LCIO: eio lcio: TBP>>=
   procedure :: common_init => eio_lcio_common_init
 <<EIO LCIO: procedures>>=
   subroutine eio_lcio_common_init (eio, sample, data, extension)
     class(eio_lcio_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     if (.not. present (data)) &
          call msg_bug ("LCIO initialization: missing data")
     eio%data = data
     if (data%n_beam /= 2) &
          call msg_fatal ("LCIO: defined for scattering processes only")
     if (data%unweighted) then
        select case (data%norm_mode)
        case (NORM_UNIT)
        case default; call msg_fatal &
             ("LCIO: normalization for unweighted events must be '1'")
        end select
     else
        call msg_fatal ("LCIO: events must be unweighted")
     end if
     eio%n_alt = data%n_alt
     eio%sample = sample
     if (present (extension)) then
        eio%extension = extension
     end if
     call eio%set_filename ()
     allocate (eio%proc_num_id (data%n_proc), source = data%proc_num_id)
   end subroutine eio_lcio_common_init
 
 @ %def eio_lcio_common_init
 @ Initialize event writing.
 <<EIO LCIO: eio lcio: TBP>>=
   procedure :: init_out => eio_lcio_init_out
 <<EIO LCIO: procedures>>=
   subroutine eio_lcio_init_out (eio, sample, data, success, extension)
     class(eio_lcio_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(in), optional :: data
     logical, intent(out), optional :: success
     call eio%set_splitting (data)
     call eio%common_init (sample, data, extension)
     write (msg_buffer, "(A,A,A)")  "Events: writing to LCIO file '", &
          char (eio%filename), "'"
     call msg_message ()
     eio%writing = .true.
     call lcio_writer_open_out (eio%lcio_writer, eio%filename)
     call lcio_run_header_init (eio%lcio_run_hdr)
     call lcio_run_header_write (eio%lcio_writer, eio%lcio_run_hdr)
     if (present (success))  success = .true.
   end subroutine eio_lcio_init_out
 
 @ %def eio_lcio_init_out
 @ Initialize event reading. For input, we do not (yet) support split
 event files.
 <<EIO LCIO: eio lcio: TBP>>=
   procedure :: init_in => eio_lcio_init_in
 <<EIO LCIO: procedures>>=
   subroutine eio_lcio_init_in (eio, sample, data, success, extension)
     class(eio_lcio_t), intent(inout) :: eio
     type(string_t), intent(in) :: sample
     type(string_t), intent(in), optional :: extension
     type(event_sample_data_t), intent(inout), optional :: data
     logical, intent(out), optional :: success
     logical :: exist
     eio%split = .false.
     call eio%common_init (sample, data, extension)
     write (msg_buffer, "(A,A,A)")  "Events: reading from LCIO file '", &
          char (eio%filename), "'"
     call msg_message ()
     inquire (file = char (eio%filename), exist = exist)
     if (.not. exist)  call msg_fatal ("Events: LCIO file not found.")
     eio%reading = .true.
     call lcio_open_file (eio%lcio_reader, eio%filename)
     if (present (success))  success = .true.
   end subroutine eio_lcio_init_in
 
 @ %def eio_lcio_init_in
 @ Switch from input to output: reopen the file for reading.
 <<EIO LCIO: eio lcio: TBP>>=
   procedure :: switch_inout => eio_lcio_switch_inout
 <<EIO LCIO: procedures>>=
   subroutine eio_lcio_switch_inout (eio, success)
     class(eio_lcio_t), intent(inout) :: eio
     logical, intent(out), optional :: success
     call msg_bug ("LCIO: in-out switch not supported")
     if (present (success))  success = .false.
   end subroutine eio_lcio_switch_inout
 
 @ %def eio_lcio_switch_inout
 @ Output an event to the allocated LCIO writer.
 <<EIO LCIO: eio lcio: TBP>>=
   procedure :: output => eio_lcio_output
 <<EIO LCIO: procedures>>=
   subroutine eio_lcio_output (eio, event, i_prc, reading, passed, pacify)
     class(eio_lcio_t), intent(inout) :: eio
     class(generic_event_t), intent(in), target :: event
     integer, intent(in) :: i_prc
     logical, intent(in), optional :: reading, passed, pacify
     type(particle_set_t), pointer :: pset_ptr
     real(default) :: sqme_prc, weight
     integer :: i
     if (present (passed)) then
        if (.not. passed)  return
     end if
     if (eio%writing) then
        pset_ptr => event%get_particle_set_ptr ()
-       call lcio_event_init (eio%lcio_event, &
-             proc_id = eio%proc_num_id (i_prc), &
-             event_id = event%get_index ())
+       if (eio%proc_as_run_id) then
+          call lcio_event_init (eio%lcio_event, &
+               proc_id = eio%proc_num_id (i_prc), &
+               event_id = event%get_index (), &
+               run_id = eio%proc_num_id (i_prc))
+       else
+          call lcio_event_init (eio%lcio_event, &
+               proc_id = eio%proc_num_id (i_prc), &
+               event_id = event%get_index (), &
+               run_id = eio%lcio_run_id)
+       end if
        call lcio_event_from_particle_set (eio%lcio_event, pset_ptr)
        call lcio_event_set_weight (eio%lcio_event, event%weight_prc)
        call lcio_event_set_sqrts (eio%lcio_event, event%get_sqrts ())
        call lcio_event_set_sqme (eio%lcio_event, event%get_sqme_prc ())
        call lcio_event_set_scale (eio%lcio_event, event%get_fac_scale ())
        call lcio_event_set_alpha_qcd (eio%lcio_event, event%get_alpha_s ())
        call lcio_event_set_xsec (eio%lcio_event, eio%data%cross_section(i_prc), &
             eio%data%error(i_prc))
        call lcio_event_set_polarization (eio%lcio_event, &
             event%get_polarization ())
        call lcio_event_set_beam_file (eio%lcio_event, &
             event%get_beam_file ())
        call lcio_event_set_process_name (eio%lcio_event, &
             event%get_process_name ())
        do i = 1, eio%n_alt
           sqme_prc = event%get_sqme_alt(i)
           weight = event%get_weight_alt(i)
           call lcio_event_set_alt_sqme (eio%lcio_event, sqme_prc, i)
           call lcio_event_set_alt_weight (eio%lcio_event, weight, i)
        end do
        call lcio_event_write (eio%lcio_writer, eio%lcio_event)
        call lcio_event_final (eio%lcio_event)
     else
        call eio%write ()
        call msg_fatal ("LCIO file is not open for writing")
     end if
   end subroutine eio_lcio_output
 
 @ %def eio_lcio_output
 @ Input an event.
 <<EIO LCIO: eio lcio: TBP>>=
   procedure :: input_i_prc => eio_lcio_input_i_prc
   procedure :: input_event => eio_lcio_input_event
 <<EIO LCIO: procedures>>=
   subroutine eio_lcio_input_i_prc (eio, i_prc, iostat)
     class(eio_lcio_t), intent(inout) :: eio
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     logical :: ok
     integer :: i, proc_num_id
     iostat = 0
     call lcio_read_event (eio%lcio_reader, eio%lcio_event, ok)
     if (.not. ok) then
        iostat = -1
        return
     end if
     proc_num_id = lcio_event_get_process_id (eio%lcio_event)
     i_prc = 0
     FIND_I_PRC: do i = 1, size (eio%proc_num_id)
        if (eio%proc_num_id(i) == proc_num_id) then
           i_prc = i
           exit FIND_I_PRC
        end if
     end do FIND_I_PRC
     if (i_prc == 0)  call err_index
   contains
     subroutine err_index
       call msg_error ("LCIO: reading events: undefined process ID " &
            // char (str (proc_num_id)) // ", aborting read")
       iostat = 1
     end subroutine err_index
   end subroutine eio_lcio_input_i_prc
 
   subroutine eio_lcio_input_event (eio, event, iostat)
     class(eio_lcio_t), intent(inout) :: eio
     class(generic_event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     iostat = 0
     call event%reset_contents ()
     call event%select (1, 1, 1)
     call event%set_index (lcio_event_get_event_index (eio%lcio_event))
     call lcio_to_event (event, eio%lcio_event, eio%fallback_model, &
          recover_beams = eio%recover_beams, &
          use_alpha_s = eio%use_alphas_from_file, &
          use_scale = eio%use_scale_from_file)
     call lcio_event_final (eio%lcio_event)
   end subroutine eio_lcio_input_event
 
 @ %def eio_lcio_input_i_prc
 @ %def eio_lcio_input_event
 @
 <<EIO LCIO: eio lcio: TBP>>=
   procedure :: skip => eio_lcio_skip
 <<EIO LCIO: procedures>>=
   subroutine eio_lcio_skip (eio, iostat)
     class(eio_lcio_t), intent(inout) :: eio
     integer, intent(out) :: iostat
     iostat = 0
   end subroutine eio_lcio_skip
 
 @ %def eio_lcio_skip
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[eio_lcio_ut.f90]]>>=
 <<File header>>
 
 module eio_lcio_ut
   use unit_tests
   use eio_lcio_uti
 
 <<Standard module head>>
 
 <<EIO LCIO: public test>>
 
 contains
 
 <<EIO LCIO: test driver>>
 
 end module eio_lcio_ut
 @ %def eio_lcio_ut
 @
 <<[[eio_lcio_uti.f90]]>>=
 <<File header>>
 
 module eio_lcio_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use model_data
   use particles
   use event_base
   use eio_data
   use eio_base
   use hep_events
   use lcio_interface
 
   use eio_lcio
 
   use eio_base_ut, only: eio_prepare_test, eio_cleanup_test
   use eio_base_ut, only: eio_prepare_fallback_model, eio_cleanup_fallback_model
 
 <<Standard module head>>
 
 <<EIO LCIO: test declarations>>
 
 contains
 
 <<EIO LCIO: tests>>
 
 end module eio_lcio_uti
 @ %def eio_lcio_ut
 @ API: driver for the unit tests below.
 <<EIO LCIO: public test>>=
   public :: eio_lcio_test
 <<EIO LCIO: test driver>>=
   subroutine eio_lcio_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<EIO LCIO: execute tests>>
   end subroutine eio_lcio_test
 
 @ %def eio_lcio_test
 @
 \subsubsection{Test I/O methods}
 We test the implementation of all I/O methods.
 <<EIO LCIO: execute tests>>=
   call test (eio_lcio_1, "eio_lcio_1", &
        "write event contents", &
        u, results)
 <<EIO LCIO: test declarations>>=
   public :: eio_lcio_1
 <<EIO LCIO: tests>>=
   subroutine eio_lcio_1 (u)
     integer, intent(in) :: u
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(particle_set_t), pointer :: pset_ptr
     type(string_t) :: sample
     integer :: u_file, iostat
     character(215) :: buffer
 
     write (u, "(A)")  "* Test output: eio_lcio_1"
     write (u, "(A)")  "*   Purpose: write a LCIO file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     call eio_prepare_test (event)
 
     call data%init (1)
     data%n_beam = 2
     data%unweighted = .true.
     data%norm_mode = NORM_UNIT
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_lcio_1"
 
     allocate (eio_lcio_t :: eio)
     select type (eio)
     type is (eio_lcio_t)
        call eio%set_parameters ()
     end select
 
     call eio%init_out (sample, data)
 
     call event%generate (1, [0._default, 0._default])
     call event%set_index (77)
     call event%pacify_particle_set ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset data"
     write (u, "(A)")
 
     deallocate (eio)
     allocate (eio_lcio_t :: eio)
 
     select type (eio)
     type is (eio_lcio_t)
        call eio%set_parameters ()
     end select
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write LCIO file contents to ASCII file"
     write (u, "(A)")
 
     select type (eio)
     type is (eio_lcio_t)
        call lcio_event_init (eio%lcio_event, &
             proc_id = 42, &
             event_id = event%get_index ())
        pset_ptr => event%get_particle_set_ptr ()
        call lcio_event_from_particle_set &
             (eio%lcio_event,  pset_ptr)
        call write_lcio_event (eio%lcio_event, var_str ("test_file.slcio"))
        call lcio_event_final (eio%lcio_event)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Read in ASCII contents of LCIO file"
     write (u, "(A)")
 
     u_file = free_unit ()
     open (u_file, file = "test_file.slcio", &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (iostat /= 0)  exit
        if (trim (buffer) == "")  cycle
        if (buffer(1:12) == " - timestamp")  cycle
        if (buffer(1:6) == " date:")  cycle
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio_cleanup_test (event)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_lcio_1"
 
   end subroutine eio_lcio_1
 
 @ %def eio_lcio_1
 @ Test also the reading of LCIO events.
 <<EIO LCIO: execute tests>>=
   call test (eio_lcio_2, "eio_lcio_2", &
        "read event contents", &
        u, results)
 <<EIO LCIO: test declarations>>=
   public :: eio_lcio_2
 <<EIO LCIO: tests>>=
   subroutine eio_lcio_2 (u)
     integer, intent(in) :: u
     class(model_data_t), pointer :: fallback_model
     class(generic_event_t), pointer :: event
     type(event_sample_data_t) :: data
     class(eio_t), allocatable :: eio
     type(string_t) :: sample
     integer :: iostat, i_prc
 
     write (u, "(A)")  "* Test output: eio_lcio_2"
     write (u, "(A)")  "*   Purpose: read a LCIO event"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize test process"
 
     allocate (fallback_model)
     call eio_prepare_fallback_model (fallback_model)
     call eio_prepare_test (event)
 
     call data%init (1)
     data%n_beam = 2
     data%unweighted = .true.
     data%norm_mode = NORM_UNIT
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     data%cross_section(1) = 100
     data%error(1) = 1
     data%total_cross_section = sum (data%cross_section)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate and write an event"
     write (u, "(A)")
 
     sample = "eio_lcio_2"
 
     allocate (eio_lcio_t :: eio)
     select type (eio)
     type is (eio_lcio_t)
        call eio%set_parameters (recover_beams = .false.)
     end select
     call eio%set_fallback_model (fallback_model)
 
     call eio%init_out (sample, data)
     call event%generate (1, [0._default, 0._default])
     call event%set_index (88)
     call event%evaluate_expressions ()
     call event%pacify_particle_set ()
 
     call eio%output (event, i_prc = 1)
     call eio%write (u)
     call eio%final ()
     deallocate (eio)
 
     call event%reset_contents ()
     call event%reset_index ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     allocate (eio_lcio_t :: eio)
     select type (eio)
     type is (eio_lcio_t)
        call eio%set_parameters (recover_beams = .false.)
     end select
     call eio%set_fallback_model (fallback_model)
 
     call data%init (1)
     data%n_beam = 2
     data%unweighted = .true.
     data%norm_mode = NORM_UNIT
     data%pdg_beam = 25
     data%energy_beam = 500
     data%proc_num_id = [42]
     call data%write (u)
     write (u, *)
 
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     call eio%init_in (sample, data)
     call eio%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read event"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
 
     select type (eio)
     type is (eio_lcio_t)
        write (u, "(A,I0,A,I0)")  "Found process #", i_prc, &
             " with ID = ", eio%proc_num_id(i_prc)
     end select
 
     call eio%input_event (event, iostat)
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read closing"
     write (u, "(A)")
 
     call eio%input_i_prc (i_prc, iostat)
     write (u, "(A,I0)")  "iostat = ", iostat
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
 
     call eio_cleanup_test (event)
     call eio_cleanup_fallback_model (fallback_model)
     deallocate (fallback_model)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: eio_lcio_2"
 
   end subroutine eio_lcio_2
 
 @ %def eio_lcio_2
Index: trunk/src/variables/variables.nw
===================================================================
--- trunk/src/variables/variables.nw	(revision 8384)
+++ trunk/src/variables/variables.nw	(revision 8385)
@@ -1,6811 +1,6823 @@
 % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
 % WHIZARD code as NOWEB source: variables for processes
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Variables for Processes}
 \includemodulegraph{variables}
 
 This part introduces variables as user-controlled objects that
 influence the behavior of objects and calculations.  Variables contain
 objects of intrinsic type or of a type as introced above.
 \begin{description}
 \item[variables]
   Store values of various kind, used by expressions and accessed by
   the command interface.  This provides an implementation of the [[vars_t]]
   abstract type.
 \item[observables]
   Concrete implementation of observables (functions in the variable tree),
   applicable for \whizard.
   abstract type.
 \end{description}
 
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Variables: Implementation}
 The user interface deals with variables that are handled similarly to
 full-flegded programming languages.  The system will add a lot of
 predefined variables (model parameters, flags, etc.) that are
 accessible to the user by the same methods.
 
 Variables can be of various type: logical (boolean/flag), integer,
 real (default precision), subevents (used in cut expressions),
 arrays of PDG codes (aliases for particles), strings.  Furthermore, in
 cut expressions we have unary and binary observables, which are used
 like real parameters but behave like functions.
 <<[[variables.f90]]>>=
 <<File header>>
 
 module variables
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_utils, only: pac_fmt
   use format_defs, only: FMT_12, FMT_19
   use constants, only: eps0
   use os_interface, only: paths_t
   use physics_defs, only: LAMBDA_QCD_REF
   use system_dependencies
   use fastjet !NODEP!
   use diagnostics
   use pdg_arrays
   use subevents
 
   use var_base
 
 <<Standard module head>>
 
 <<Variables: public>>
 
 <<Variables: parameters>>
 
 <<Variables: types>>
 
 <<Variables: interfaces>>
 
 contains
 
 <<Variables: procedures>>
 
 end module variables
 @ %def variables
 @
 \subsection{Variable list entries}
 Variable (and constant) values can be of one of the following types:
 <<Variables: parameters>>=
   integer, parameter, public :: V_NONE = 0, V_LOG = 1, V_INT = 2, V_REAL = 3
   integer, parameter, public :: V_CMPLX = 4, V_SEV = 5, V_PDG = 6, V_STR = 7
   integer, parameter, public :: V_OBS1_INT = 11, V_OBS2_INT = 12
   integer, parameter, public :: V_OBS1_REAL = 21, V_OBS2_REAL = 22
   integer, parameter, public :: V_UOBS1_INT = 31, V_UOBS2_INT = 32
   integer, parameter, public :: V_UOBS1_REAL = 41, V_UOBS2_REAL = 42
 
 @ %def V_NONE V_LOG V_INT V_REAL V_CMPLX V_PRT V_SEV V_PDG
 @ %def V_OBS1_INT V_OBS2_INT V_OBS1_REAL V_OBS2_REAL
 @ %def V_UOBS1_INT V_UOBS2_INT V_UOBS1_REAL V_UOBS2_REAL
 @
 \subsubsection{The type}
 This is an entry in the variable list.  It can be of any type; in
 each case only one value is allocated.  It may be physically
 allocated upon creation, in which case [[is_allocated]] is true, or
 it may contain just a pointer to a value somewhere else, in which case
 [[is_allocated]] is false.
 
 The flag [[is_defined]] is set when the variable is given a value, even the
 undefined value.  (Therefore it is distinct from [[is_known]].)  This matters
 for variable declaration in the SINDARIN language.  The variable is set up in
 the compilation step and initially marked as defined, but after compilation
 all variables are set undefined.  Each variable becomes defined when it is
 explicitly set.  The difference matters in loops.
 
 [[is_locked]] means that it cannot be given a value using the interface
 routines [[var_list_set_XXX]] below.  It can only be initialized, or change
 automatically due to a side effect.
 
 [[is_copy]] means that this is a local copy of a global variable.  The copy
 has a pointer to the original, which can be used to restore a previous value.
 
 [[is_intrinsic]] means that this variable is defined by the program, not by
 the user.  Intrinsic variables cannot be (re)declared, but their values can be
 reset unless they are locked.  [[is_user_var]] means that the variable has
 been declared by the user.  It could be a new variable, or a local copy of an
 intrinsic variable.
 
 The flag [[is_known]] is a pointer which parallels the use of the
 value pointer.  For pointer variables, it is set if the value should point to
 a known value.  For ordinary variables, it should be true.
 
 The value is implemented as a set of alternative type-specific pointers.  This
 emulates polymorphism, and it allows for actual pointer variables.
 Observable-type variables have function pointers as values, so they behave
 like macros.  The functions make use of the particle objects accessible via
 the pointers [[prt1]] and [[prt2]].
 
 Finally, the [[next]] pointer indicates that we are making lists of
 variables.  A more efficient implementation might switch to hashes or
 similar; the current implementation has $O(N)$ lookup.
 <<Variables: public>>=
   public :: var_entry_t
 <<Variables: types>>=
   type :: var_entry_t
      private
      integer :: type = V_NONE
      type(string_t) :: name
      logical :: is_allocated = .false.
      logical :: is_defined = .false.
      logical :: is_locked = .false.
      logical :: is_intrinsic = .false.
      logical :: is_user_var = .false.
      logical, pointer :: is_known => null ()
      logical,           pointer :: lval => null ()
      integer,           pointer :: ival => null ()
      real(default),     pointer :: rval => null ()
      complex(default), pointer :: cval => null ()
      type(subevt_t),  pointer :: pval => null ()
      type(pdg_array_t), pointer :: aval => null ()
      type(string_t),    pointer :: sval => null ()
      procedure(obs_unary_int),   nopass, pointer :: obs1_int  => null ()
      procedure(obs_unary_real),  nopass, pointer :: obs1_real => null ()
      procedure(obs_binary_int),  nopass, pointer :: obs2_int  => null ()
      procedure(obs_binary_real), nopass, pointer :: obs2_real => null ()
      type(prt_t), pointer :: prt1 => null ()
      type(prt_t), pointer :: prt2 => null ()
      type(var_entry_t), pointer :: next => null ()
      type(var_entry_t), pointer :: previous => null ()
      type(string_t) :: description
   end type var_entry_t
 
 @ %def var_entry_t
 @
 \subsubsection{Interfaces for the observable functions}
 <<Variables: public>>=
   public :: obs_unary_int
   public :: obs_unary_real
   public :: obs_binary_int
   public :: obs_binary_real
 <<Variables: interfaces>>=
   abstract interface
      function obs_unary_int (prt1) result (ival)
        import
        integer :: ival
        type(prt_t), intent(in) :: prt1
      end function obs_unary_int
   end interface
   abstract interface
      function obs_unary_real (prt1) result (rval)
        import
        real(default) :: rval
        type(prt_t), intent(in) :: prt1
      end function obs_unary_real
   end interface
   abstract interface
      function obs_binary_int (prt1, prt2) result (ival)
        import
        integer :: ival
        type(prt_t), intent(in) :: prt1, prt2
      end function obs_binary_int
   end interface
   abstract interface
      function obs_binary_real (prt1, prt2) result (rval)
        import
        real(default) :: rval
        type(prt_t), intent(in) :: prt1, prt2
      end function obs_binary_real
   end interface
 
 @ %def obs_unary_int obs_unary_real obs_binary_real
 @
 \subsubsection{Initialization}
 Initialize an entry, optionally with a physical value.  We also
 allocate the [[is_known]] flag and set it if the value is set.
 <<Variables: public>>=
   public :: var_entry_init_int
 <<Variables: procedures>>=
   subroutine var_entry_init_log (var, name, lval, intrinsic, user)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     logical, intent(in), optional :: lval
     logical, intent(in), optional :: intrinsic, user
     var%name = name
     var%type = V_LOG
     allocate (var%lval, var%is_known)
     if (present (lval)) then
        var%lval = lval
        var%is_defined = .true.
        var%is_known = .true.
     else
        var%is_known = .false.
     end if
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     if (present (user))  var%is_user_var = user
     var%is_allocated = .true.
   end subroutine var_entry_init_log
 
   subroutine var_entry_init_int (var, name, ival, intrinsic, user)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     integer, intent(in), optional :: ival
     logical, intent(in), optional :: intrinsic, user
     var%name = name
     var%type = V_INT
     allocate (var%ival, var%is_known)
     if (present (ival)) then
        var%ival = ival
        var%is_defined = .true.
        var%is_known = .true.
     else
        var%is_known = .false.
     end if
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     if (present (user))  var%is_user_var = user
     var%is_allocated = .true.
   end subroutine var_entry_init_int
 
   subroutine var_entry_init_real (var, name, rval, intrinsic, user)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     real(default), intent(in), optional :: rval
     logical, intent(in), optional :: intrinsic, user
     var%name = name
     var%type = V_REAL
     allocate (var%rval, var%is_known)
     if (present (rval)) then
        var%rval = rval
        var%is_defined = .true.
        var%is_known = .true.
     else
        var%is_known = .false.
     end if
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     if (present (user))  var%is_user_var = user
     var%is_allocated = .true.
   end subroutine var_entry_init_real
 
   subroutine var_entry_init_cmplx (var, name, cval, intrinsic, user)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     complex(default), intent(in), optional :: cval
     logical, intent(in), optional :: intrinsic, user
     var%name = name
     var%type = V_CMPLX
     allocate (var%cval, var%is_known)
     if (present (cval)) then
        var%cval = cval
        var%is_defined = .true.
        var%is_known = .true.
     else
        var%is_known = .false.
     end if
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     if (present (user))  var%is_user_var = user
     var%is_allocated = .true.
   end subroutine var_entry_init_cmplx
 
   subroutine var_entry_init_subevt (var, name, pval, intrinsic, user)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     type(subevt_t), intent(in), optional :: pval
     logical, intent(in), optional :: intrinsic, user
     var%name = name
     var%type = V_SEV
     allocate (var%pval, var%is_known)
     if (present (pval)) then
        var%pval = pval
        var%is_defined = .true.
        var%is_known = .true.
     else
        var%is_known = .false.
     end if
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     if (present (user))  var%is_user_var = user
     var%is_allocated = .true.
   end subroutine var_entry_init_subevt
 
   subroutine var_entry_init_pdg_array (var, name, aval, intrinsic, user)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     type(pdg_array_t), intent(in), optional :: aval
     logical, intent(in), optional :: intrinsic, user
     var%name = name
     var%type = V_PDG
     allocate (var%aval, var%is_known)
     if (present (aval)) then
        var%aval = aval
        var%is_defined = .true.
        var%is_known = .true.
     else
        var%is_known = .false.
     end if
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     if (present (user))  var%is_user_var = user
     var%is_allocated = .true.
   end subroutine var_entry_init_pdg_array
 
   subroutine var_entry_init_string (var, name, sval, intrinsic, user)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: sval
     logical, intent(in), optional :: intrinsic, user
     var%name = name
     var%type = V_STR
     allocate (var%sval, var%is_known)
     if (present (sval)) then
        var%sval = sval
        var%is_defined = .true.
        var%is_known = .true.
     else
        var%is_known = .false.
     end if
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     if (present (user))  var%is_user_var = user
     var%is_allocated = .true.
   end subroutine var_entry_init_string
 
 @ %def var_entry_init_log
 @ %def var_entry_init_int
 @ %def var_entry_init_real
 @ %def var_entry_init_cmplx
 @ %def var_entry_init_subevt
 @ %def var_entry_init_pdg_array
 @ %def var_entry_init_string
 @ Initialize an entry with a pointer to the value and, for numeric/logical
 values, a pointer to the [[is_known]] flag.
 <<Variables: procedures>>=
   subroutine var_entry_init_log_ptr (var, name, lval, is_known, intrinsic)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     logical, intent(in), target :: lval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: intrinsic
     var%name = name
     var%type = V_LOG
     var%lval => lval
     var%is_known => is_known
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     var%is_defined = .true.
   end subroutine var_entry_init_log_ptr
 
   subroutine var_entry_init_int_ptr (var, name, ival, is_known, intrinsic)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     integer, intent(in), target :: ival
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: intrinsic
     var%name = name
     var%type = V_INT
     var%ival => ival
     var%is_known => is_known
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     var%is_defined = .true.
   end subroutine var_entry_init_int_ptr
 
   subroutine var_entry_init_real_ptr (var, name, rval, is_known, intrinsic)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     real(default), intent(in), target :: rval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: intrinsic
     var%name = name
     var%type = V_REAL
     var%rval => rval
     var%is_known => is_known
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     var%is_defined = .true.
   end subroutine var_entry_init_real_ptr
 
   subroutine var_entry_init_cmplx_ptr (var, name, cval, is_known, intrinsic)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     complex(default), intent(in), target :: cval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: intrinsic
     var%name = name
     var%type = V_CMPLX
     var%cval => cval
     var%is_known => is_known
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     var%is_defined = .true.
   end subroutine var_entry_init_cmplx_ptr
 
   subroutine var_entry_init_pdg_array_ptr (var, name, aval, is_known, intrinsic)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     type(pdg_array_t), intent(in), target :: aval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: intrinsic
     var%name = name
     var%type = V_PDG
     var%aval => aval
     var%is_known => is_known
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     var%is_defined = .true.
   end subroutine var_entry_init_pdg_array_ptr
 
   subroutine var_entry_init_subevt_ptr (var, name, pval, is_known, intrinsic)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     type(subevt_t), intent(in), target :: pval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: intrinsic
     var%name = name
     var%type = V_SEV
     var%pval => pval
     var%is_known => is_known
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     var%is_defined = .true.
   end subroutine var_entry_init_subevt_ptr
 
   subroutine var_entry_init_string_ptr (var, name, sval, is_known, intrinsic)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     type(string_t), intent(in), target :: sval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: intrinsic
     var%name = name
     var%type = V_STR
     var%sval => sval
     var%is_known => is_known
     if (present (intrinsic))  var%is_intrinsic = intrinsic
     var%is_defined = .true.
   end subroutine var_entry_init_string_ptr
 
 @ %def var_entry_init_log_ptr
 @ %def var_entry_init_int_ptr
 @ %def var_entry_init_real_ptr
 @ %def var_entry_init_cmplx_ptr
 @ %def var_entry_init_pdg_array_ptr
 @ %def var_entry_init_subevt_ptr
 @ %def var_entry_init_string_ptr
 @ Initialize an entry with an observable.  The procedure pointer is
 not yet set.
 <<Variables: procedures>>=
   subroutine var_entry_init_obs (var, name, type, prt1, prt2)
     type(var_entry_t), intent(out) :: var
     type(string_t), intent(in) :: name
     integer, intent(in) :: type
     type(prt_t), intent(in), target :: prt1
     type(prt_t), intent(in), optional, target :: prt2
     var%type = type
     var%name = name
     var%prt1 => prt1
     if (present (prt2))  var%prt2 => prt2
     var%is_intrinsic = .true.
     var%is_defined = .true.
   end subroutine var_entry_init_obs
 
 @ %def var_entry_init_obs
 @ Mark an entry as undefined it it is a user-defined variable object, so force
 re-initialization.
 <<Variables: procedures>>=
   subroutine var_entry_undefine (var)
     type(var_entry_t), intent(inout) :: var
     var%is_defined = .not. var%is_user_var
     var%is_known = var%is_defined .and. var%is_known
   end subroutine var_entry_undefine
 
 @ %def var_entry_undefine
 @ Clear an entry: mark it as unknown.
 <<Variables: procedures>>=
   subroutine var_entry_clear (var)
     type(var_entry_t), intent(inout) :: var
     var%is_known = .false.
   end subroutine var_entry_clear
 
 @ %def var_entry_clear
 @ Lock an entry: forbid resetting the entry after initialization.
 <<Variables: procedures>>=
   subroutine var_entry_lock (var, locked)
     type(var_entry_t), intent(inout) :: var
     logical, intent(in), optional :: locked
     if (present (locked)) then
        var%is_locked = locked
     else
        var%is_locked = .true.
     end if
   end subroutine var_entry_lock
 
 @ %def var_entry_lock
 @
 \subsubsection{Finalizer}
 <<Variables: procedures>>=
   subroutine var_entry_final (var)
     type(var_entry_t), intent(inout) :: var
     if (var%is_allocated) then
        select case (var%type)
        case (V_LOG); deallocate (var%lval)
        case (V_INT); deallocate (var%ival)
        case (V_REAL);deallocate (var%rval)
        case (V_CMPLX);deallocate (var%cval)
        case (V_SEV); deallocate (var%pval)
        case (V_PDG); deallocate (var%aval)
        case (V_STR); deallocate (var%sval)
        end select
        deallocate (var%is_known)
        var%is_allocated = .false.
        var%is_defined = .false.
     end if
   end subroutine var_entry_final
 
 @ %def var_entry_final
 @
 \subsubsection{Output}
 <<Variables: procedures>>=
   recursive subroutine var_entry_write (var, unit, model_name, &
        intrinsic, pacified, descriptions, ascii_output)
     type(var_entry_t), intent(in) :: var
     integer, intent(in), optional :: unit
     type(string_t), intent(in), optional :: model_name
     logical, intent(in), optional :: intrinsic
     logical, intent(in), optional :: pacified
     logical, intent(in), optional :: descriptions
     logical, intent(in), optional :: ascii_output
     type(string_t) :: col_string
     logical :: show_desc, ao
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     show_desc = .false.; if (present (descriptions))  show_desc = descriptions
     ao = .false.; if (present (ascii_output))  ao = ascii_output
     if (show_desc) then
        if (ao) then
           col_string = create_col_string (COL_BLUE)
           if (var%is_locked) then
              write (u, "(A)", advance="no") char (achar(27) // col_string) // &
                   char (var%name) // achar(27) // "[0m" //" fixed-value="
           else
              write (u, "(A)", advance="no") char (achar(27) // col_string) // &
                   char (var%name) // achar(27) // "[0m" //" default="
           end if
           col_string = create_col_string (COL_RED)
           write (u, "(A)", advance="no") char (achar(27) // col_string)
           call var_write_val (var, u, "no", pacified=.true.)
           write (u, "(A)") achar(27) // "[0m"
           write (u, "(A)")  char (var%description)
           return
        else
           write (u, "(A)")  "\item"
           write (u, "(A)", advance="no")  "\ttt{" // char ( &
                replace (replace (var%name, "_", "\_", every=.true.), "$", "\$" )) // &
                "} "
           if (var%is_known) then
              if (var%is_locked) then
                 write (u, "(A)", advance="no")  "\qquad (fixed value: \ttt{"
              else
                 write (u, "(A)", advance="no")  "\qquad (default: \ttt{"
              end if
              call var_write_val (var, u, "no", pacified=.true., escape_tex=.true.)
              write (u, "(A)", advance="no")  "})"
           end if
           write (u, "(A)") " \newline"
           write (u, "(A)") char (var%description)
           write (u, "(A)") "%%%%%"
           return
        end if
     end if
     if (present (intrinsic)) then
        if (var%is_intrinsic .neqv. intrinsic)  return
     end if
     if (.not. var%is_defined) then
        write (u, "(A,1x)", advance="no")  "[undefined]"
     end if
     if (.not. var%is_intrinsic) then
        write (u, "(A,1x)", advance="no")  "[user variable]"
     end if
     if (present (model_name)) then
        write (u, "(A,A)", advance="no")  char(model_name), "."
     end if
     write (u, "(A)", advance="no")  char (var%name)
     if (var%is_locked)  write (u, "(A)", advance="no")  "*"
     if (var%is_allocated) then
        write (u, "(A)", advance="no")  " = "
     else if (var%type /= V_NONE) then
        write (u, "(A)", advance="no")  " => "
     end if
     call var_write_val (var, u, "yes", pacified)
   end subroutine var_entry_write
 
 @ %def var_entry_write
 @
 <<Variables: procedures>>=
   subroutine var_write_val (var, u, advance, pacified, escape_tex)
     type(var_entry_t), intent(in) :: var
     integer, intent(in) :: u
     character(*), intent(in) :: advance
     logical, intent(in), optional :: pacified, escape_tex
     logical :: num_pac, et
     real(default) :: rval
     complex(default) :: cval
     character(len=7) :: fmt
     call pac_fmt (fmt, FMT_19, FMT_12, pacified)
     num_pac = .false.; if (present (pacified))  num_pac = pacified
     et = .false.; if (present (escape_tex))  et = escape_tex
     select case (var%type)
     case (V_NONE); write (u, '()', advance=advance)
     case (V_LOG)
        if (var%is_known) then
           if (var%lval) then
              write (u, "(A)", advance=advance)  "true"
           else
              write (u, "(A)", advance=advance)  "false"
           end if
        else
           write (u, "(A)", advance=advance)  "[unknown logical]"
        end if
     case (V_INT)
        if (var%is_known) then
           write (u, "(I0)", advance=advance)  var%ival
        else
           write (u, "(A)", advance=advance)  "[unknown integer]"
        end if
     case (V_REAL)
        if (var%is_known) then
           rval = var%rval
           if (num_pac) then
              call pacify (rval, 10 * eps0)
           end if
           write (u, "(" // fmt // ")", advance=advance)  rval
        else
           write (u, "(A)", advance=advance)  "[unknown real]"
        end if
     case (V_CMPLX)
        if (var%is_known) then
           cval = var%cval
           if (num_pac) then
              call pacify (cval, 10 * eps0)
           end if
           write (u, "('('," // fmt // ",','," // fmt // ",')')", advance=advance)  cval
        else
           write (u, "(A)", advance=advance)  "[unknown complex]"
        end if
     case (V_SEV)
        if (var%is_known) then
           call subevt_write (var%pval, u, prefix="       ", &
                pacified = pacified)
        else
           write (u, "(A)", advance=advance)  "[unknown subevent]"
        end if
     case (V_PDG)
        if (var%is_known) then
           call pdg_array_write (var%aval, u);  write (u, *)
        else
           write (u, "(A)", advance=advance)  "[unknown PDG array]"
        end if
     case (V_STR)
        if (var%is_known) then
           if (et) then
              write (u, "(A)", advance=advance)  '"' // char (replace ( &
                   replace (var%sval, "_", "\_", every=.true.), "$", "\$" )) // '"'
           else
              write (u, "(A)", advance=advance)  '"' // char (var%sval) // '"'
           end if
        else
           write (u, "(A)", advance=advance)  "[unknown string]"
        end if
     case (V_OBS1_INT);  write (u, "(A)", advance=advance) "[int] = unary observable"
     case (V_OBS2_INT);  write (u, "(A)", advance=advance) "[int] = binary observable"
     case (V_OBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary observable"
     case (V_OBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary observable"
     case (V_UOBS1_INT);  write (u, "(A)", advance=advance) "[int] = unary user observable"
     case (V_UOBS2_INT);  write (u, "(A)", advance=advance) "[int] = binary user observable"
     case (V_UOBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary user observable"
     case (V_UOBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary user observable"
     end select
   end subroutine var_write_val
 
 @ %def procedure
 @
 \subsubsection{Accessing contents}
 <<Variables: procedures>>=
   function var_entry_get_name (var) result (name)
     type(string_t) :: name
     type(var_entry_t), intent(in) :: var
     name = var%name
   end function var_entry_get_name
 
   function var_entry_get_type (var) result (type)
     integer :: type
     type(var_entry_t), intent(in) :: var
     type = var%type
   end function var_entry_get_type
 
 @ %def var_entry_get_name var_entry_get_type
 @ Return true if the variable is defined.  This the case if it is allocated
 and known, or if it is a pointer.
 <<Variables: procedures>>=
   function var_entry_is_defined (var) result (defined)
     logical :: defined
     type(var_entry_t), intent(in) :: var
     defined = var%is_defined
   end function var_entry_is_defined
 
 @ %def var_entry_is_defined
 @ Return true if the variable is locked.  If [[force]] is active,
 always return false.
 <<Variables: procedures>>=
   function var_entry_is_locked (var, force) result (locked)
     logical :: locked
     type(var_entry_t), intent(in) :: var
     logical, intent(in), optional :: force
     if (present (force)) then
        if (force) then
           locked = .false.;  return
        end if
     end if
     locked = var%is_locked
   end function var_entry_is_locked
 
 @ %def var_entry_is_locked
 @ Return true if the variable is intrinsic
 <<Variables: procedures>>=
   function var_entry_is_intrinsic (var) result (flag)
     logical :: flag
     type(var_entry_t), intent(in) :: var
     flag = var%is_intrinsic
   end function var_entry_is_intrinsic
 
 @ %def var_entry_is_intrinsic
 @ Return components
 <<Variables: procedures>>=
   function var_entry_is_known (var) result (flag)
     logical :: flag
     type(var_entry_t), intent(in) :: var
     flag = var%is_known
   end function var_entry_is_known
 
   function var_entry_get_lval (var) result (lval)
     logical :: lval
     type(var_entry_t), intent(in) :: var
     lval = var%lval
   end function var_entry_get_lval
 
   function var_entry_get_ival (var) result (ival)
     integer :: ival
     type(var_entry_t), intent(in) :: var
     ival = var%ival
   end function var_entry_get_ival
 
   function var_entry_get_rval (var) result (rval)
     real(default) :: rval
     type(var_entry_t), intent(in) :: var
     rval = var%rval
   end function var_entry_get_rval
 
   function var_entry_get_cval (var) result (cval)
     complex(default) :: cval
     type(var_entry_t), intent(in) :: var
     cval = var%cval
   end function var_entry_get_cval
 
   function var_entry_get_aval (var) result (aval)
     type(pdg_array_t) :: aval
     type(var_entry_t), intent(in) :: var
     aval = var%aval
   end function var_entry_get_aval
 
   function var_entry_get_pval (var) result (pval)
     type(subevt_t) :: pval
     type(var_entry_t), intent(in) :: var
     pval = var%pval
   end function var_entry_get_pval
 
   function var_entry_get_sval (var) result (sval)
     type(string_t) :: sval
     type(var_entry_t), intent(in) :: var
     sval = var%sval
   end function var_entry_get_sval
 
 @ %def var_entry_get_lval
 @ %def var_entry_get_ival
 @ %def var_entry_get_rval
 @ %def var_entry_get_cval
 @ %def var_entry_get_aval
 @ %def var_entry_get_pval
 @ %def var_entry_get_sval
 @ Return pointers to components.
 <<Variables: procedures>>=
   function var_entry_get_known_ptr (var) result (ptr)
     logical, pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%is_known
   end function var_entry_get_known_ptr
 
   function var_entry_get_lval_ptr (var) result (ptr)
     logical, pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%lval
   end function var_entry_get_lval_ptr
 
   function var_entry_get_ival_ptr (var) result (ptr)
     integer, pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%ival
   end function var_entry_get_ival_ptr
 
   function var_entry_get_rval_ptr (var) result (ptr)
     real(default), pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%rval
   end function var_entry_get_rval_ptr
 
   function var_entry_get_cval_ptr (var) result (ptr)
     complex(default), pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%cval
   end function var_entry_get_cval_ptr
 
   function var_entry_get_pval_ptr (var) result (ptr)
     type(subevt_t), pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%pval
   end function var_entry_get_pval_ptr
 
   function var_entry_get_aval_ptr (var) result (ptr)
     type(pdg_array_t), pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%aval
   end function var_entry_get_aval_ptr
 
   function var_entry_get_sval_ptr (var) result (ptr)
     type(string_t), pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%sval
   end function var_entry_get_sval_ptr
 
 @ %def var_entry_get_known_ptr
 @ %def var_entry_get_lval_ptr var_entry_get_ival_ptr var_entry_get_rval_ptr
 @ %def var_entry_get_cval_ptr var_entry_get_aval_ptr var_entry_get_pval_ptr
 @ %def var_entry_get_sval_ptr
 @ Furthermore,
 <<Variables: procedures>>=
   function var_entry_get_prt1_ptr (var) result (ptr)
     type(prt_t), pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%prt1
   end function var_entry_get_prt1_ptr
 
   function var_entry_get_prt2_ptr (var) result (ptr)
     type(prt_t), pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%prt2
   end function var_entry_get_prt2_ptr
 
 @ %def var_entry_get_prt1_ptr
 @ %def var_entry_get_prt2_ptr
 @ Subroutines might be safer than functions for procedure pointer transfer.
 <<Variables: procedures>>=
   subroutine var_entry_assign_obs1_int_ptr (ptr, var)
     procedure(obs_unary_int), pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%obs1_int
   end subroutine var_entry_assign_obs1_int_ptr
 
   subroutine var_entry_assign_obs1_real_ptr (ptr, var)
     procedure(obs_unary_real), pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%obs1_real
   end subroutine var_entry_assign_obs1_real_ptr
 
   subroutine var_entry_assign_obs2_int_ptr (ptr, var)
     procedure(obs_binary_int), pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%obs2_int
   end subroutine var_entry_assign_obs2_int_ptr
 
   subroutine var_entry_assign_obs2_real_ptr (ptr, var)
     procedure(obs_binary_real), pointer :: ptr
     type(var_entry_t), intent(in), target :: var
     ptr => var%obs2_real
   end subroutine var_entry_assign_obs2_real_ptr
 
 @ %def var_entry_assign_obs1_int_ptr var_entry_assign_obs1_real_ptr
 @ %def var_entry_assign_obs2_int_ptr var_entry_assign_obs2_real_ptr
 @
 \subsection{Setting values}
 Undefine the value.
 <<Variables: procedures>>=
   subroutine var_entry_clear_value (var)
     type(var_entry_t), intent(inout) :: var
     var%is_known = .false.
   end subroutine var_entry_clear_value
 
 @ %def var_entry_clear_value
 <<Variables: procedures>>=
   recursive subroutine var_entry_set_log &
        (var, lval, is_known, verbose, model_name)
     type(var_entry_t), intent(inout) :: var
     logical, intent(in) :: lval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: verbose
     type(string_t), intent(in), optional :: model_name
     integer :: u
     u = logfile_unit ()
     var%lval = lval
     var%is_known = is_known
     var%is_defined = .true.
     if (present (verbose)) then
        if (verbose) then
           call var_entry_write (var, model_name=model_name)
           call var_entry_write (var, model_name=model_name, unit=u)
           if (u >= 0) flush (u)
        end if
     end if
   end subroutine var_entry_set_log
 
   recursive subroutine var_entry_set_int &
        (var, ival, is_known, verbose, model_name)
     type(var_entry_t), intent(inout) :: var
     integer, intent(in) :: ival
     logical, intent(in) :: is_known
     logical, intent(in), optional :: verbose
     type(string_t), intent(in), optional :: model_name
     integer :: u
     u = logfile_unit ()
     var%ival = ival
     var%is_known = is_known
     var%is_defined = .true.
     if (present (verbose)) then
        if (verbose) then
           call var_entry_write (var, model_name=model_name)
           call var_entry_write (var, model_name=model_name, unit=u)
           if (u >= 0) flush (u)
        end if
     end if
   end subroutine var_entry_set_int
 
   recursive subroutine var_entry_set_real &
        (var, rval, is_known, verbose, model_name, pacified)
     type(var_entry_t), intent(inout) :: var
     real(default), intent(in) :: rval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: verbose, pacified
     type(string_t), intent(in), optional :: model_name
     integer :: u
     u = logfile_unit ()
     var%rval = rval
     var%is_known = is_known
     var%is_defined = .true.
     if (present (verbose)) then
        if (verbose) then
           call var_entry_write &
                (var, model_name=model_name, pacified = pacified)
           call var_entry_write &
                (var, model_name=model_name, unit=u, pacified = pacified)
           if (u >= 0) flush (u)
        end if
     end if
   end subroutine var_entry_set_real
 
   recursive subroutine var_entry_set_cmplx &
        (var, cval, is_known, verbose, model_name, pacified)
     type(var_entry_t), intent(inout) :: var
     complex(default), intent(in) :: cval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: verbose, pacified
     type(string_t), intent(in), optional :: model_name
     integer :: u
     u = logfile_unit ()
     var%cval = cval
     var%is_known = is_known
     var%is_defined = .true.
     if (present (verbose)) then
        if (verbose) then
           call var_entry_write &
                (var, model_name=model_name, pacified = pacified)
           call var_entry_write &
                (var, model_name=model_name, unit=u, pacified = pacified)
           if (u >= 0) flush (u)
        end if
     end if
   end subroutine var_entry_set_cmplx
 
   recursive subroutine var_entry_set_pdg_array &
        (var, aval, is_known, verbose, model_name)
     type(var_entry_t), intent(inout) :: var
     type(pdg_array_t), intent(in) :: aval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: verbose
     type(string_t), intent(in), optional :: model_name
     integer :: u
     u = logfile_unit ()
     var%aval = aval
     var%is_known = is_known
     var%is_defined = .true.
     if (present (verbose)) then
        if (verbose) then
           call var_entry_write (var, model_name=model_name)
           call var_entry_write (var, model_name=model_name, unit=u)
           if (u >= 0) flush (u)
        end if
     end if
   end subroutine var_entry_set_pdg_array
 
   recursive subroutine var_entry_set_subevt &
        (var, pval, is_known, verbose, model_name)
     type(var_entry_t), intent(inout) :: var
     type(subevt_t), intent(in) :: pval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: verbose
     type(string_t), intent(in), optional :: model_name
     integer :: u
     u = logfile_unit ()
     var%pval = pval
     var%is_known = is_known
     var%is_defined = .true.
     if (present (verbose)) then
        if (verbose) then
           call var_entry_write (var, model_name=model_name)
           call var_entry_write (var, model_name=model_name, unit=u)
           if (u >= 0) flush (u)
        end if
     end if
   end subroutine var_entry_set_subevt
 
   recursive subroutine var_entry_set_string &
        (var, sval, is_known, verbose, model_name)
     type(var_entry_t), intent(inout) :: var
     type(string_t), intent(in) :: sval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: verbose
     type(string_t), intent(in), optional :: model_name
     integer :: u
     u = logfile_unit ()
     var%sval = sval
     var%is_known = is_known
     var%is_defined = .true.
     if (present (verbose)) then
        if (verbose) then
           call var_entry_write (var, model_name=model_name)
           call var_entry_write (var, model_name=model_name, unit=u)
           if (u >= 0) flush (u)
        end if
     end if
   end subroutine var_entry_set_string
 
 @ %def var_entry_set_log
 @ %def var_entry_set_int
 @ %def var_entry_set_real
 @ %def var_entry_set_cmplx
 @ %def var_entry_set_pdg_array
 @ %def var_entry_set_subevt
 @ %def var_entry_set_string
 @
 <<Variables: public>>=
   public :: var_entry_set_description
 <<Variables: procedures>>=
   pure subroutine var_entry_set_description (var_entry, description)
     type(var_entry_t), intent(inout) :: var_entry
     type(string_t), intent(in) :: description
     var_entry%description = description
   end subroutine var_entry_set_description
 
 @ %def var_entry_set_description
 @
 \subsection{Copies and pointer variables}
 Initialize an entry with a copy of an existing variable entry.  The
 copy is physically allocated with the same type as the original.
 <<Variables: procedures>>=
   subroutine var_entry_init_copy (var, original, user)
     type(var_entry_t), intent(out) :: var
     type(var_entry_t), intent(in), target :: original
     logical, intent(in), optional :: user
     type(string_t) :: name
     logical :: intrinsic
     name = var_entry_get_name (original)
     intrinsic = original%is_intrinsic
     select case (original%type)
     case (V_LOG)
        call var_entry_init_log (var, name, intrinsic=intrinsic, user=user)
     case (V_INT)
        call var_entry_init_int (var, name, intrinsic=intrinsic, user=user)
     case (V_REAL)
        call var_entry_init_real (var, name, intrinsic=intrinsic, user=user)
     case (V_CMPLX)
        call var_entry_init_cmplx (var, name, intrinsic=intrinsic, user=user)
     case (V_SEV)
        call var_entry_init_subevt (var, name, intrinsic=intrinsic, user=user)
     case (V_PDG)
        call var_entry_init_pdg_array (var, name, intrinsic=intrinsic, user=user)
     case (V_STR)
        call var_entry_init_string (var, name, intrinsic=intrinsic, user=user)
     end select
   end subroutine var_entry_init_copy
 
 @ %def var_entry_init_copy
 @ Copy the value of an entry.  The target variable entry must be initialized
 correctly.
 <<Variables: procedures>>=
   subroutine var_entry_copy_value (var, original)
     type(var_entry_t), intent(inout) :: var
     type(var_entry_t), intent(in), target :: original
     if (var_entry_is_known (original)) then
        select case (original%type)
        case (V_LOG)
           call var_entry_set_log (var, var_entry_get_lval (original), .true.)
        case (V_INT)
           call var_entry_set_int (var, var_entry_get_ival (original), .true.)
        case (V_REAL)
           call var_entry_set_real (var, var_entry_get_rval (original), .true.)
        case (V_CMPLX)
           call var_entry_set_cmplx (var, var_entry_get_cval (original), .true.)
        case (V_SEV)
           call var_entry_set_subevt (var, var_entry_get_pval (original), .true.)
        case (V_PDG)
           call var_entry_set_pdg_array (var, var_entry_get_aval (original), .true.)
        case (V_STR)
           call var_entry_set_string (var, var_entry_get_sval (original), .true.)
        end select
     else
        call var_entry_clear (var)
     end if
   end subroutine var_entry_copy_value
 
 @ %def var_entry_copy_value
 @
 \subsection{Variable lists}
 \subsubsection{The type}
 Variable lists can be linked together.  No initializer needed.
 They are deleted separately.
 <<Variables: public>>=
   public :: var_list_t
 <<Variables: types>>=
   type, extends (vars_t) :: var_list_t
      private
      type(var_entry_t), pointer :: first => null ()
      type(var_entry_t), pointer :: last => null ()
      type(var_list_t), pointer :: next => null ()
    contains
    <<Variables: var list: TBP>>
   end type var_list_t
 
 @ %def var_list_t
 @
 \subsubsection{Constructors}
 Implementation of the [[link]] deferred method.  The implementation
 restricts itself to var lists of the same type.  We might need to
 relax this constraint.
 <<Variables: var list: TBP>>=
   procedure :: link => var_list_link
 <<Variables: procedures>>=
   subroutine var_list_link (vars, target_vars)
     class(var_list_t), intent(inout) :: vars
     class(vars_t), intent(in), target :: target_vars
     select type (target_vars)
     type is (var_list_t)
        vars%next => target_vars
     class default
        call msg_bug ("var_list_link: unsupported target type")
     end select
   end subroutine var_list_link
 
 @ %def var_list_link
 @ Append a new entry to an existing list.
 <<Variables: procedures>>=
   subroutine var_list_append (var_list, var, verbose)
     type(var_list_t), intent(inout), target :: var_list
     type(var_entry_t), intent(inout), target :: var
     logical, intent(in), optional :: verbose
     if (associated (var_list%last)) then
        var%previous => var_list%last
        var_list%last%next => var
     else
        var%previous => null ()
        var_list%first => var
     end if
     var_list%last => var
     if (present (verbose)) then
        if (verbose)  call var_entry_write (var)
     end if
   end subroutine var_list_append
 
 @ %def var_list_append
 @ Sort a list.
 <<Variables: var list: TBP>>=
   procedure :: sort => var_list_sort
 <<Variables: procedures>>=
   subroutine var_list_sort (var_list)
     class(var_list_t), intent(inout) :: var_list
     type(var_entry_t), pointer :: var, previous
     if (associated (var_list%first)) then
        var => var_list%first
        do while (associated (var))
           previous => var%previous
           do while (associated (previous))
              if (larger_var (previous, var)) then
                 call var_list%swap_with_next (previous)
              end if
              previous => previous%previous
           end do
           var => var%next
        end do
     end if
   end subroutine var_list_sort
 
 @ %def var_list_sort
 @
 <<Variables: procedures>>=
   pure function larger_var (var1, var2) result (larger)
     logical :: larger
     type(var_entry_t), intent(in) :: var1, var2
     type(string_t) :: str1, str2
     str1 = replace (var1%name, "?", "")
     str1 = replace (str1, "$", "")
     str2 = replace (var2%name, "?", "")
     str2 = replace (str2, "$", "")
     larger = str1 > str2
   end function larger_var
 
 @ %def larger_var
 @
 <<Variables: var list: TBP>>=
   procedure :: get_previous => var_list_get_previous
 <<Variables: procedures>>=
   function var_list_get_previous (var_list, var_entry) result (previous)
     type(var_entry_t), pointer :: previous
     class(var_list_t), intent(in) :: var_list
     type(var_entry_t), intent(in) :: var_entry
     previous => var_list%first
     if (previous%name == var_entry%name) then
        previous => null ()
     else
        do while (associated (previous))
           if (previous%next%name == var_entry%name) exit
           previous => previous%next
        end do
     end if
   end function var_list_get_previous
 
 @ %def var_list_get_previous
 @
 <<Variables: var list: TBP>>=
   procedure :: swap_with_next => var_list_swap_with_next
 <<Variables: procedures>>=
   subroutine var_list_swap_with_next (var_list, var_entry)
     class(var_list_t), intent(inout) :: var_list
     type(var_entry_t), intent(in) :: var_entry
     type(var_entry_t), pointer :: previous, this, next, next_next
     previous => var_list%get_previous (var_entry)
     if (.not. associated (previous)) then
        this => var_list%first
     else
        this => previous%next
     end if
     next => this%next
     next_next => next%next
     if (associated (previous)) then
        previous%next => next
        next%previous => previous
     else
        var_list%first => next
        next%previous => null ()
     end if
     this%next => next_next
     if (associated (next_next)) then
        next_next%previous => this
     end if
     next%next => this
     this%previous => next
     if (.not. associated (next%next)) then
        var_list%last => next
     end if
   end subroutine var_list_swap_with_next
 
 @ %def var_list_swap_with_next
 @ Public methods for expanding the variable list (as subroutines)
 <<Variables: var list: TBP>>=
   generic :: append_log => var_list_append_log_s, var_list_append_log_c
   procedure, private :: var_list_append_log_s
   procedure, private :: var_list_append_log_c
   generic :: append_int => var_list_append_int_s, var_list_append_int_c
   procedure, private :: var_list_append_int_s
   procedure, private :: var_list_append_int_c
   generic :: append_real => var_list_append_real_s, var_list_append_real_c
   procedure, private :: var_list_append_real_s
   procedure, private :: var_list_append_real_c
   generic :: append_cmplx => var_list_append_cmplx_s, var_list_append_cmplx_c
   procedure, private :: var_list_append_cmplx_s
   procedure, private :: var_list_append_cmplx_c
   generic :: append_subevt => var_list_append_subevt_s, var_list_append_subevt_c
   procedure, private :: var_list_append_subevt_s
   procedure, private :: var_list_append_subevt_c
   generic :: append_pdg_array => var_list_append_pdg_array_s, var_list_append_pdg_array_c
   procedure, private :: var_list_append_pdg_array_s
   procedure, private :: var_list_append_pdg_array_c
   generic :: append_string => var_list_append_string_s, var_list_append_string_c
   procedure, private :: var_list_append_string_s
   procedure, private :: var_list_append_string_c
 <<Variables: public>>=
   public :: var_list_append_log
   public :: var_list_append_int
   public :: var_list_append_real
   public :: var_list_append_cmplx
   public :: var_list_append_subevt
   public :: var_list_append_pdg_array
   public :: var_list_append_string
 <<Variables: interfaces>>=
   interface var_list_append_log
      module procedure var_list_append_log_s
      module procedure var_list_append_log_c
   end interface
   interface var_list_append_int
      module procedure var_list_append_int_s
      module procedure var_list_append_int_c
   end interface
   interface var_list_append_real
      module procedure var_list_append_real_s
      module procedure var_list_append_real_c
   end interface
   interface var_list_append_cmplx
      module procedure var_list_append_cmplx_s
      module procedure var_list_append_cmplx_c
   end interface
   interface var_list_append_subevt
      module procedure var_list_append_subevt_s
      module procedure var_list_append_subevt_c
   end interface
   interface var_list_append_pdg_array
      module procedure var_list_append_pdg_array_s
      module procedure var_list_append_pdg_array_c
   end interface
   interface var_list_append_string
      module procedure var_list_append_string_s
      module procedure var_list_append_string_c
   end interface
 <<Variables: procedures>>=
   subroutine var_list_append_log_s &
        (var_list, name, lval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     logical, intent(in), optional :: lval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_log (var, name, lval, intrinsic, user)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_log_s
 
   subroutine var_list_append_int_s &
        (var_list, name, ival, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     integer, intent(in), optional :: ival
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_int (var, name, ival, intrinsic, user)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_int_s
 
   subroutine var_list_append_real_s &
        (var_list, name, rval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     real(default), intent(in), optional :: rval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_real (var, name, rval, intrinsic, user)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_real_s
 
   subroutine var_list_append_cmplx_s &
        (var_list, name, cval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     complex(default), intent(in), optional :: cval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_cmplx (var, name, cval, intrinsic, user)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_cmplx_s
 
   subroutine var_list_append_subevt_s &
        (var_list, name, pval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     type(subevt_t), intent(in), optional :: pval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_subevt (var, name, pval, intrinsic, user)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_subevt_s
 
   subroutine var_list_append_pdg_array_s &
        (var_list, name, aval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     type(pdg_array_t), intent(in), optional :: aval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_pdg_array (var, name, aval, intrinsic, user)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_pdg_array_s
 
   subroutine var_list_append_string_s &
        (var_list, name, sval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: sval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_string (var, name, sval, intrinsic, user)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_string_s
 
   subroutine var_list_append_log_c &
        (var_list, name, lval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     character(*), intent(in) :: name
     logical, intent(in), optional :: lval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     call var_list_append_log_s &
          (var_list, var_str (name), lval, locked, verbose, &
          intrinsic, user, description)
   end subroutine var_list_append_log_c
 
   subroutine var_list_append_int_c &
        (var_list, name, ival, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     character(*), intent(in) :: name
     integer, intent(in), optional :: ival
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     call var_list_append_int_s &
          (var_list, var_str (name), ival, locked, verbose, &
          intrinsic, user, description)
   end subroutine var_list_append_int_c
 
   subroutine var_list_append_real_c &
        (var_list, name, rval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     character(*), intent(in) :: name
     real(default), intent(in), optional :: rval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     call var_list_append_real_s &
          (var_list, var_str (name), rval, locked, verbose, &
          intrinsic, user, description)
   end subroutine var_list_append_real_c
 
   subroutine var_list_append_cmplx_c &
        (var_list, name, cval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     character(*), intent(in) :: name
     complex(default), intent(in), optional :: cval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     call var_list_append_cmplx_s &
          (var_list, var_str (name), cval, locked, verbose, &
          intrinsic, user, description)
   end subroutine var_list_append_cmplx_c
 
   subroutine var_list_append_subevt_c &
        (var_list, name, pval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     character(*), intent(in) :: name
     type(subevt_t), intent(in), optional :: pval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     call var_list_append_subevt_s &
          (var_list, var_str (name), pval, locked, verbose, &
          intrinsic, user, description)
   end subroutine var_list_append_subevt_c
 
   subroutine var_list_append_pdg_array_c &
        (var_list, name, aval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     character(*), intent(in) :: name
     type(pdg_array_t), intent(in), optional :: aval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     call var_list_append_pdg_array_s &
          (var_list, var_str (name), aval, locked, verbose, &
          intrinsic, user, description)
   end subroutine var_list_append_pdg_array_c
 
   subroutine var_list_append_string_c &
        (var_list, name, sval, locked, verbose, intrinsic, user, description)
     class(var_list_t), intent(inout) :: var_list
     character(*), intent(in) :: name
     character(*), intent(in), optional :: sval
     logical, intent(in), optional :: locked, verbose, intrinsic, user
     type(string_t), intent(in), optional :: description
     if (present (sval)) then
        call var_list_append_string_s &
             (var_list, var_str (name), var_str (sval), &
             locked, verbose, intrinsic, user, description)
     else
        call var_list_append_string_s &
             (var_list, var_str (name), &
             locked=locked, verbose=verbose, intrinsic=intrinsic, &
             user=user, description=description)
     end if
   end subroutine var_list_append_string_c
 
 @ %def var_list_append_log
 @ %def var_list_append_int
 @ %def var_list_append_real
 @ %def var_list_append_cmplx
 @ %def var_list_append_subevt
 @ %def var_list_append_pdg_array
 @ %def var_list_append_string
 <<Variables: public>>=
   public :: var_list_append_log_ptr
   public :: var_list_append_int_ptr
   public :: var_list_append_real_ptr
   public :: var_list_append_cmplx_ptr
   public :: var_list_append_pdg_array_ptr
   public :: var_list_append_subevt_ptr
   public :: var_list_append_string_ptr
 <<Variables: var list: TBP>>=
   procedure :: append_log_ptr => var_list_append_log_ptr
   procedure :: append_int_ptr => var_list_append_int_ptr
   procedure :: append_real_ptr => var_list_append_real_ptr
   procedure :: append_cmplx_ptr => var_list_append_cmplx_ptr
   procedure :: append_pdg_array_ptr => var_list_append_pdg_array_ptr
   procedure :: append_subevt_ptr => var_list_append_subevt_ptr
   procedure :: append_string_ptr => var_list_append_string_ptr
 <<Variables: procedures>>=
   subroutine var_list_append_log_ptr &
        (var_list, name, lval, is_known, locked, verbose, intrinsic, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     logical, intent(in), target :: lval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: locked, verbose, intrinsic
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_log_ptr (var, name, lval, is_known, intrinsic)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_log_ptr
 
   subroutine var_list_append_int_ptr &
        (var_list, name, ival, is_known, locked, verbose, intrinsic, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     integer, intent(in), target :: ival
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: locked, verbose, intrinsic
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_int_ptr (var, name, ival, is_known, intrinsic)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_int_ptr
 
   subroutine var_list_append_real_ptr &
        (var_list, name, rval, is_known, locked, verbose, intrinsic, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     real(default), intent(in), target :: rval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: locked, verbose, intrinsic
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_real_ptr (var, name, rval, is_known, intrinsic)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_real_ptr
 
   subroutine var_list_append_cmplx_ptr &
        (var_list, name, cval, is_known, locked, verbose, intrinsic, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     complex(default), intent(in), target :: cval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: locked, verbose, intrinsic
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_cmplx_ptr (var, name, cval, is_known, intrinsic)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_cmplx_ptr
 
   subroutine var_list_append_pdg_array_ptr &
        (var_list, name, aval, is_known, locked, verbose, intrinsic, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     type(pdg_array_t), intent(in), target :: aval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: locked, verbose, intrinsic
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_pdg_array_ptr (var, name, aval, is_known, intrinsic)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_pdg_array_ptr
 
   subroutine var_list_append_subevt_ptr &
        (var_list, name, pval, is_known, locked, verbose, intrinsic, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     type(subevt_t), intent(in), target :: pval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: locked, verbose, intrinsic
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_subevt_ptr (var, name, pval, is_known, intrinsic)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_subevt_ptr
 
   subroutine var_list_append_string_ptr &
        (var_list, name, sval, is_known, locked, verbose, intrinsic, description)
     class(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     type(string_t), intent(in), target :: sval
     logical, intent(in), target :: is_known
     logical, intent(in), optional :: locked, verbose, intrinsic
     type(string_t), intent(in), optional :: description
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_string_ptr (var, name, sval, is_known, intrinsic)
     if (present (description))  call var_entry_set_description (var, description)
     if (present (locked))  call var_entry_lock (var, locked)
     call var_list_append (var_list, var, verbose)
   end subroutine var_list_append_string_ptr
 
 @ %def var_list_append_log_ptr
 @ %def var_list_append_int_ptr
 @ %def var_list_append_real_ptr
 @ %def var_list_append_cmplx_ptr
 @ %def var_list_append_pdg_array_ptr
 @ %def var_list_append_subevt_ptr
 @
 \subsubsection{Finalizer}
 Finalize, delete the list entry by entry.  The link itself is kept
 intact.  Follow link and delete recursively only if requested
 explicitly.
 <<Variables: var list: TBP>>=
   procedure :: final => var_list_final
 <<Variables: procedures>>=
   recursive subroutine var_list_final (vars, follow_link)
     class(var_list_t), intent(inout) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     vars%last => null ()
     do while (associated (vars%first))
        var => vars%first
        vars%first => var%next
        call var_entry_final (var)
        deallocate (var)
     end do
     if (present (follow_link)) then
        if (follow_link) then
           if (associated (vars%next)) then
              call vars%next%final (follow_link)
              deallocate (vars%next)
           end if
        end if
     end if
   end subroutine var_list_final
 
 @ %def var_list_final
 @
 \subsubsection{Output}
 Show variable list with precise control over options.  E.g.,
 show only variables of a certain type.
 
 Many options, thus not an ordinary [[write]] method.
 <<Variables: public>>=
   public :: var_list_write
 <<Variables: var list: TBP>>=
   procedure :: write => var_list_write
 <<Variables: procedures>>=
   recursive subroutine var_list_write &
        (var_list, unit, follow_link, only_type, prefix, model_name, &
         intrinsic, pacified, descriptions, ascii_output)
     class(var_list_t), intent(in), target :: var_list
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: follow_link
     integer, intent(in), optional :: only_type
     character(*), intent(in), optional :: prefix
     type(string_t), intent(in), optional :: model_name
     logical, intent(in), optional :: intrinsic
     logical, intent(in), optional :: pacified
     logical, intent(in), optional :: descriptions
     logical, intent(in), optional :: ascii_output
     type(var_entry_t), pointer :: var
     integer :: u, length
     logical :: write_this, write_next
     u = given_output_unit (unit);  if (u < 0)  return
     if (present (prefix))  length = len (prefix)
     var => var_list%first
     if (associated (var)) then
        do while (associated (var))
           if (present (only_type)) then
              write_this = only_type == var%type
           else
              write_this = .true.
           end if
           if (write_this .and. present (prefix)) then
              if (prefix /= extract (var%name, 1, length)) &
                   write_this = .false.
           end if
           if (write_this) then
              call var_entry_write &
                   (var, unit, model_name=model_name, &
                    intrinsic=intrinsic, pacified=pacified, &
                    descriptions=descriptions, ascii_output=ascii_output)
           end if
           var => var%next
        end do
     end if
     if (present (follow_link)) then
        write_next = follow_link .and. associated (var_list%next)
     else
        write_next = associated (var_list%next)
     end if
     if (write_next) then
        call var_list_write (var_list%next, &
             unit, follow_link, only_type, prefix, model_name, &
             intrinsic, pacified)
     end if
   end subroutine var_list_write
 
 @ %def var_list_write
 @ Write only a certain variable.
 <<Variables: public>>=
   public :: var_list_write_var
 <<Variables: var list: TBP>>=
   procedure :: write_var => var_list_write_var
 <<Variables: procedures>>=
   recursive subroutine var_list_write_var &
        (var_list, name, unit, type, follow_link, &
        model_name, pacified, defined, descriptions, ascii_output)
     class(var_list_t), intent(in), target :: var_list
     type(string_t), intent(in) :: name
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: type
     logical, intent(in), optional :: follow_link
     type(string_t), intent(in), optional :: model_name
     logical, intent(in), optional :: pacified
     logical, intent(in), optional :: defined
     logical, intent(in), optional :: descriptions
     logical, intent(in), optional :: ascii_output
     type(var_entry_t), pointer :: var
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     var => var_list_get_var_ptr &
          (var_list, name, type, follow_link=follow_link, defined=defined)
     if (associated (var)) then
        call var_entry_write &
             (var, unit, model_name = model_name, &
             pacified = pacified, &
             descriptions=descriptions, ascii_output=ascii_output)
     else
        write (u, "(A)")  char (name) // " = [undefined]"
     end if
   end subroutine var_list_write_var
 
 @ %def var_list_write_var
 @
 \subsection{Tools}
 Return a pointer to the variable list linked to by the current one.
 <<Variables: procedures>>=
   function var_list_get_next_ptr (var_list) result (next_ptr)
     type(var_list_t), pointer :: next_ptr
     type(var_list_t), intent(in) :: var_list
     next_ptr => var_list%next
   end function var_list_get_next_ptr
 
 @ %def var_list_get_next_ptr
 @ Used by [[eval_trees]]:
 Return a pointer to the variable with the requested name.  If no such
 name exists, return a null pointer.  In that case, try the next list
 if present, unless [[follow_link]] is unset.  If [[defined]] is set, ignore
 entries that exist but are undefined.
 <<Variables: public>>=
   public :: var_list_get_var_ptr
 <<Variables: procedures>>=
   recursive function var_list_get_var_ptr &
        (var_list, name, type, follow_link, defined) result (var)
     type(var_entry_t), pointer :: var
     type(var_list_t), intent(in), target :: var_list
     type(string_t), intent(in) :: name
     integer, intent(in), optional :: type
     logical, intent(in), optional :: follow_link, defined
     logical :: ignore_undef, search_next
     ignore_undef = .true.;  if (present (defined))  ignore_undef = .not. defined
     var => var_list%first
     if (present (type)) then
        do while (associated (var))
           if (var%type == type) then
              if (var%name == name) then
                 if (ignore_undef .or. var%is_defined)  return
              end if
           end if
           var => var%next
        end do
     else
        do while (associated (var))
           if (var%name == name) then
              if (ignore_undef .or. var%is_defined)  return
           end if
           var => var%next
        end do
     end if
     search_next = associated (var_list%next)
     if (present (follow_link)) &
          search_next = search_next .and. follow_link
     if (search_next) &
          var => var_list_get_var_ptr &
               (var_list%next, name, type, defined=defined)
   end function var_list_get_var_ptr
 
 @ %def var_list_get_var_ptr
 @ Return the variable type
 <<Variables: var list: TBP>>=
   procedure :: get_type => var_list_get_type
 <<Variables: procedures>>=
   function var_list_get_type (var_list, name, follow_link) result (type)
     class(var_list_t), intent(in), target :: var_list
     type(string_t), intent(in) :: name
     logical, intent(in), optional :: follow_link
     integer :: type
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, follow_link=follow_link)
     if (associated (var)) then
        type = var%type
     else
        type = V_NONE
     end if
   end function var_list_get_type
 
 @ %def var_list_get_type
 @ Return true if the variable exists in the current list.
 <<Variables: var list: TBP>>=
   procedure :: contains => var_list_exists
 <<Variables: procedures>>=
   function var_list_exists (vars, name, follow_link) result (lval)
     logical :: lval
     type(string_t), intent(in) :: name
     class(var_list_t), intent(in) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
     lval = associated (var)
   end function var_list_exists
 
 @ %def var_list_exists
 @ Return true if the variable is declared as intrinsic.  (This is not a
 property of the abstract [[vars_t]] type, and therefore the method is
 not inherited.)
 <<Variables: var list: TBP>>=
   procedure :: is_intrinsic => var_list_is_intrinsic
 <<Variables: procedures>>=
   function var_list_is_intrinsic (vars, name, follow_link) result (lval)
     logical :: lval
     type(string_t), intent(in) :: name
     class(var_list_t), intent(in) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
     if (associated (var)) then
        lval = var%is_intrinsic
     else
        lval = .false.
     end if
   end function var_list_is_intrinsic
 
 @ %def var_list_is_intrinsic
 @ Return true if the value is known.
 <<Variables: var list: TBP>>=
   procedure :: is_known => var_list_is_known
 <<Variables: procedures>>=
   function var_list_is_known (vars, name, follow_link) result (lval)
     logical :: lval
     type(string_t), intent(in) :: name
     class(var_list_t), intent(in) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
     if (associated (var)) then
        lval = var%is_known
     else
        lval = .false.
     end if
   end function var_list_is_known
 
 @ %def var_list_is_known
 @ Return true if the value is locked.  (This is not a
 property of the abstract [[vars_t]] type, and therefore the method is
 not inherited.)
 <<Variables: var list: TBP>>=
   procedure :: is_locked => var_list_is_locked
 <<Variables: procedures>>=
   function var_list_is_locked (vars, name, follow_link) result (lval)
     logical :: lval
     type(string_t), intent(in) :: name
     class(var_list_t), intent(in) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
     if (associated (var)) then
        lval = var_entry_is_locked (var)
     else
        lval = .false.
     end if
   end function var_list_is_locked
 
 @ %def var_list_is_locked
 @ Return several properties at once.
 <<Variables: var list: TBP>>=
   procedure :: get_var_properties => var_list_get_var_properties
 <<Variables: procedures>>=
   subroutine var_list_get_var_properties (vars, name, req_type, follow_link, &
        type, is_defined, is_known, is_locked)
     class(var_list_t), intent(in) :: vars
     type(string_t), intent(in) :: name
     integer, intent(in), optional :: req_type
     logical, intent(in), optional :: follow_link
     integer, intent(out), optional :: type
     logical, intent(out), optional :: is_defined, is_known, is_locked
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr &
          (vars, name, type=req_type, follow_link=follow_link)
     if (associated (var)) then
        if (present (type))  type = var_entry_get_type (var)
        if (present (is_defined))  is_defined = var_entry_is_defined (var)
        if (present (is_known))  is_known = var_entry_is_known (var)
        if (present (is_locked))  is_locked = var_entry_is_locked (var)
     else
        if (present (type))  type = V_NONE
        if (present (is_defined))  is_defined = .false.
        if (present (is_known))  is_known = .false.
        if (present (is_locked))  is_locked = .false.
     end if
   end subroutine var_list_get_var_properties
 
 @ %def var_list_get_var_properties
 @ Return the value, assuming that the type is correct.  We consider only
 variable entries that have been [[defined]].
 
 For convenience, allow both variable and fixed-length (literal) strings.
 <<Variables: var list: TBP>>=
   procedure :: get_lval => var_list_get_lval
   procedure :: get_ival => var_list_get_ival
   procedure :: get_rval => var_list_get_rval
   procedure :: get_cval => var_list_get_cval
   procedure :: get_pval => var_list_get_pval
   procedure :: get_aval => var_list_get_aval
   procedure :: get_sval => var_list_get_sval
 <<Variables: procedures>>=
   function var_list_get_lval (vars, name, follow_link) result (lval)
     logical :: lval
     type(string_t), intent(in) :: name
     class(var_list_t), intent(in) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr &
          (vars, name, V_LOG, follow_link, defined=.true.)
     if (associated (var)) then
        if (var_has_value (var)) then
           lval = var%lval
        else
           lval = .false.
        end if
     else
        lval = .false.
     end if
   end function var_list_get_lval
 
   function var_list_get_ival (vars, name, follow_link) result (ival)
     integer :: ival
     type(string_t), intent(in) :: name
     class(var_list_t), intent(in) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr &
          (vars, name, V_INT, follow_link, defined=.true.)
     if (associated (var)) then
        if (var_has_value (var)) then
           ival = var%ival
        else
           ival = 0
        end if
     else
        ival = 0
     end if
   end function var_list_get_ival
 
   function var_list_get_rval (vars, name, follow_link) result (rval)
     real(default) :: rval
     type(string_t), intent(in) :: name
     class(var_list_t), intent(in) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr &
          (vars, name, V_REAL, follow_link, defined=.true.)
     if (associated (var)) then
        if (var_has_value (var)) then
           rval = var%rval
        else
           rval = 0
        end if
     else
        rval = 0
     end if
   end function var_list_get_rval
 
   function var_list_get_cval (vars, name, follow_link) result (cval)
     complex(default) :: cval
     type(string_t), intent(in) :: name
     class(var_list_t), intent(in) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr &
          (vars, name, V_CMPLX, follow_link, defined=.true.)
     if (associated (var)) then
        if (var_has_value (var)) then
           cval = var%cval
        else
           cval = 0
        end if
     else
        cval = 0
     end if
   end function var_list_get_cval
 
   function var_list_get_aval (vars, name, follow_link) result (aval)
     type(pdg_array_t) :: aval
     type(string_t), intent(in) :: name
     class(var_list_t), intent(in) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr &
          (vars, name, V_PDG, follow_link, defined=.true.)
     if (associated (var)) then
        if (var_has_value (var)) then
           aval = var%aval
        end if
     end if
   end function var_list_get_aval
 
   function var_list_get_pval (vars, name, follow_link) result (pval)
     type(subevt_t) :: pval
     type(string_t), intent(in) :: name
     class(var_list_t), intent(in) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr &
          (vars, name, V_SEV, follow_link, defined=.true.)
     if (associated (var)) then
        if (var_has_value (var)) then
           pval = var%pval
        end if
     end if
   end function var_list_get_pval
 
   function var_list_get_sval (vars, name, follow_link) result (sval)
     type(string_t) :: sval
     type(string_t), intent(in) :: name
     class(var_list_t), intent(in) :: vars
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr &
          (vars, name, V_STR, follow_link, defined=.true.)
     if (associated (var)) then
        if (var_has_value (var)) then
           sval = var%sval
        else
           sval = ""
        end if
     else
        sval = ""
     end if
   end function var_list_get_sval
 
 @ %def var_list_get_lval
 @ %def var_list_get_ival
 @ %def var_list_get_rval
 @ %def var_list_get_cval
 @ %def var_list_get_pval
 @ %def var_list_get_aval
 @ %def var_list_get_sval
 @ Check for a valid value, given a pointer.  Issue error messages if invalid.
 <<Variables: procedures>>=
   function var_has_value (var) result (valid)
     logical :: valid
     type(var_entry_t), pointer :: var
     if (associated (var)) then
        if (var%is_known) then
           valid = .true.
        else
           call msg_error ("The value of variable '" // char (var%name) &
                // "' is unknown but must be known at this point.")
           valid = .false.
        end if
     else
        call msg_error ("Variable '" // char (var%name) &
             // "' is undefined but must have a known value at this point.")
        valid = .false.
     end if
   end function var_has_value
 
 @ %def var_has_value
 @ Return pointers instead of values, including a pointer to the
 [[known]] entry.
 <<Variables: var list: TBP>>=
   procedure :: get_lptr => var_list_get_lptr
   procedure :: get_iptr => var_list_get_iptr
   procedure :: get_rptr => var_list_get_rptr
   procedure :: get_cptr => var_list_get_cptr
   procedure :: get_aptr => var_list_get_aptr
   procedure :: get_pptr => var_list_get_pptr
   procedure :: get_sptr => var_list_get_sptr
 <<Variables: procedures>>=
   subroutine var_list_get_lptr (var_list, name, lptr, known)
     class(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: name
     logical, pointer, intent(out) :: lptr
     logical, pointer, intent(out), optional :: known
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_LOG)
     if (associated (var)) then
        lptr => var_entry_get_lval_ptr (var)
        if (present (known))  known => var_entry_get_known_ptr (var)
     else
        lptr => null ()
        if (present (known))  known => null ()
     end if
   end subroutine var_list_get_lptr
 
   subroutine var_list_get_iptr (var_list, name, iptr, known)
     class(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: name
     integer, pointer, intent(out) :: iptr
     logical, pointer, intent(out), optional :: known
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_INT)
     if (associated (var)) then
        iptr => var_entry_get_ival_ptr (var)
        if (present (known))  known => var_entry_get_known_ptr (var)
     else
        iptr => null ()
        if (present (known))  known => null ()
     end if
   end subroutine var_list_get_iptr
 
   subroutine var_list_get_rptr (var_list, name, rptr, known)
     class(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: name
     real(default), pointer, intent(out) :: rptr
     logical, pointer, intent(out), optional :: known
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_REAL)
     if (associated (var)) then
        rptr => var_entry_get_rval_ptr (var)
        if (present (known))  known => var_entry_get_known_ptr (var)
     else
        rptr => null ()
        if (present (known))  known => null ()
     end if
   end subroutine var_list_get_rptr
 
   subroutine var_list_get_cptr (var_list, name, cptr, known)
     class(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: name
     complex(default), pointer, intent(out) :: cptr
     logical, pointer, intent(out), optional :: known
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_CMPLX)
     if (associated (var)) then
        cptr => var_entry_get_cval_ptr (var)
        if (present (known))  known => var_entry_get_known_ptr (var)
     else
        cptr => null ()
        if (present (known))  known => null ()
     end if
   end subroutine var_list_get_cptr
 
   subroutine var_list_get_aptr (var_list, name, aptr, known)
     class(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: name
     type(pdg_array_t), pointer, intent(out) :: aptr
     logical, pointer, intent(out), optional :: known
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_PDG)
     if (associated (var)) then
        aptr => var_entry_get_aval_ptr (var)
        if (present (known))  known => var_entry_get_known_ptr (var)
     else
        aptr => null ()
        if (present (known))  known => null ()
     end if
   end subroutine var_list_get_aptr
 
   subroutine var_list_get_pptr (var_list, name, pptr, known)
     class(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: name
     type(subevt_t), pointer, intent(out) :: pptr
     logical, pointer, intent(out), optional :: known
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_SEV)
     if (associated (var)) then
        pptr => var_entry_get_pval_ptr (var)
        if (present (known))  known => var_entry_get_known_ptr (var)
     else
        pptr => null ()
        if (present (known))  known => null ()
     end if
   end subroutine var_list_get_pptr
 
   subroutine var_list_get_sptr (var_list, name, sptr, known)
     class(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: name
     type(string_t), pointer, intent(out) :: sptr
     logical, pointer, intent(out), optional :: known
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_STR)
     if (associated (var)) then
        sptr => var_entry_get_sval_ptr (var)
        if (present (known))  known => var_entry_get_known_ptr (var)
     else
        sptr => null ()
        if (present (known))  known => null ()
     end if
   end subroutine var_list_get_sptr
 
 @ %def var_list_get_lptr
 @ %def var_list_get_iptr
 @ %def var_list_get_rptr
 @ %def var_list_get_cptr
 @ %def var_list_get_aptr
 @ %def var_list_get_pptr
 @ %def var_list_get_sptr
 @
 This bunch of methods handles the procedure-pointer cases.
 <<Variables: var list: TBP>>=
   procedure :: get_obs1_iptr => var_list_get_obs1_iptr
   procedure :: get_obs2_iptr => var_list_get_obs2_iptr
   procedure :: get_obs1_rptr => var_list_get_obs1_rptr
   procedure :: get_obs2_rptr => var_list_get_obs2_rptr
 <<Variables: procedures>>=
   subroutine var_list_get_obs1_iptr (var_list, name, obs1_iptr, p1)
     class(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: name
     procedure(obs_unary_int), pointer, intent(out) :: obs1_iptr
     type(prt_t), pointer, intent(out) :: p1
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_OBS1_INT)
     if (associated (var)) then
        call var_entry_assign_obs1_int_ptr (obs1_iptr, var)
        p1 => var_entry_get_prt1_ptr (var)
     else
        obs1_iptr => null ()
        p1 => null ()
     end if
   end subroutine var_list_get_obs1_iptr
 
   subroutine var_list_get_obs2_iptr (var_list, name, obs2_iptr, p1, p2)
     class(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: name
     procedure(obs_binary_int), pointer, intent(out) :: obs2_iptr
     type(prt_t), pointer, intent(out) :: p1, p2
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_OBS2_INT)
     if (associated (var)) then
        call var_entry_assign_obs2_int_ptr (obs2_iptr, var)
        p1 => var_entry_get_prt1_ptr (var)
        p2 => var_entry_get_prt2_ptr (var)
     else
        obs2_iptr => null ()
        p1 => null ()
        p2 => null ()
     end if
   end subroutine var_list_get_obs2_iptr
 
   subroutine var_list_get_obs1_rptr (var_list, name, obs1_rptr, p1)
     class(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: name
     procedure(obs_unary_real), pointer, intent(out) :: obs1_rptr
     type(prt_t), pointer, intent(out) :: p1
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_OBS1_REAL)
     if (associated (var)) then
        call var_entry_assign_obs1_real_ptr (obs1_rptr, var)
        p1 => var_entry_get_prt1_ptr (var)
     else
        obs1_rptr => null ()
        p1 => null ()
     end if
   end subroutine var_list_get_obs1_rptr
 
   subroutine var_list_get_obs2_rptr (var_list, name, obs2_rptr, p1, p2)
     class(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: name
     procedure(obs_binary_real), pointer, intent(out) :: obs2_rptr
     type(prt_t), pointer, intent(out) :: p1, p2
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_OBS2_REAL)
     if (associated (var)) then
        call var_entry_assign_obs2_real_ptr (obs2_rptr, var)
        p1 => var_entry_get_prt1_ptr (var)
        p2 => var_entry_get_prt2_ptr (var)
     else
        obs2_rptr => null ()
        p1 => null ()
        p2 => null ()
     end if
   end subroutine var_list_get_obs2_rptr
 
 @ %def var_list_get_obs1_iptr
 @ %def var_list_get_obs2_iptr
 @ %def var_list_get_obs1_rptr
 @ %def var_list_get_obs2_rptr
 @
 \subsection{Process Result Variables}
 These variables are associated to process (integration) runs and their
 results.  Their names contain brackets (so they look like function
 evaluations), therefore we need to special-case them.
 <<Variables: public>>=
   public :: var_list_set_procvar_int
   public :: var_list_set_procvar_real
 <<Variables: procedures>>=
   subroutine var_list_set_procvar_int (var_list, proc_id, name, ival)
     type(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: proc_id
     type(string_t), intent(in) :: name
     integer, intent(in), optional :: ival
     type(string_t) :: var_name
     type(var_entry_t), pointer :: var
     var_name = name // "(" // proc_id // ")"
     var => var_list_get_var_ptr (var_list, var_name)
     if (.not. associated (var)) then
        call var_list%append_int (var_name, ival, intrinsic=.true.)
     else if (present (ival)) then
        call var_list%set_int (var_name, ival, is_known=.true.)
     end if
   end subroutine var_list_set_procvar_int
 
   subroutine var_list_set_procvar_real (var_list, proc_id, name, rval)
     type(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: proc_id
     type(string_t), intent(in) :: name
     real(default), intent(in), optional :: rval
     type(string_t) :: var_name
     type(var_entry_t), pointer :: var
     var_name = name // "(" // proc_id // ")"
     var => var_list_get_var_ptr (var_list, var_name)
     if (.not. associated (var)) then
        call var_list%append_real (var_name, rval, intrinsic=.true.)
     else if (present (rval)) then
        call var_list%set_real (var_name, rval, is_known=.true.)
     end if
   end subroutine var_list_set_procvar_real
 
 @ %def var_list_set_procvar_int
 @ %def var_list_set_procvar_real
 @
 \subsection{Observable initialization}
 Observables are formally treated as variables, which however are
 evaluated each time the observable is used.  The arguments (pointers)
 to evaluate and the function are part of the variable-list entry.
 <<Variables: public>>=
   public :: var_list_append_obs1_iptr
   public :: var_list_append_obs2_iptr
   public :: var_list_append_obs1_rptr
   public :: var_list_append_obs2_rptr
 <<Variables: procedures>>=
   subroutine var_list_append_obs1_iptr (var_list, name, obs1_iptr, p1)
     type(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     procedure(obs_unary_int) :: obs1_iptr
     type(prt_t), intent(in), target :: p1
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_obs (var, name, V_OBS1_INT, p1)
     var%obs1_int => obs1_iptr
     call var_list_append (var_list, var)
   end subroutine var_list_append_obs1_iptr
 
   subroutine var_list_append_obs2_iptr (var_list, name, obs2_iptr, p1, p2)
     type(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     procedure(obs_binary_int) :: obs2_iptr
     type(prt_t), intent(in), target :: p1, p2
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_obs (var, name, V_OBS2_INT, p1, p2)
     var%obs2_int => obs2_iptr
     call var_list_append (var_list, var)
   end subroutine var_list_append_obs2_iptr
 
   subroutine var_list_append_obs1_rptr (var_list, name, obs1_rptr, p1)
     type(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     procedure(obs_unary_real) :: obs1_rptr
     type(prt_t), intent(in), target :: p1
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_obs (var, name, V_OBS1_REAL, p1)
     var%obs1_real => obs1_rptr
     call var_list_append (var_list, var)
   end subroutine var_list_append_obs1_rptr
 
   subroutine var_list_append_obs2_rptr (var_list, name, obs2_rptr, p1, p2)
     type(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     procedure(obs_binary_real) :: obs2_rptr
     type(prt_t), intent(in), target :: p1, p2
     type(var_entry_t), pointer :: var
     allocate (var)
     call var_entry_init_obs (var, name, V_OBS2_REAL, p1, p2)
     var%obs2_real => obs2_rptr
     call var_list_append (var_list, var)
   end subroutine var_list_append_obs2_rptr
 
 @ %def var_list_append_obs1_iptr
 @ %def var_list_append_obs2_iptr
 @ %def var_list_append_obs1_rptr
 @ %def var_list_append_obs2_rptr
 @ User observables: no pointer needs to be stored.
 <<Variables: public>>=
   public :: var_list_append_uobs_int
   public :: var_list_append_uobs_real
 <<Variables: procedures>>=
   subroutine var_list_append_uobs_int (var_list, name, p1, p2)
     type(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     type(prt_t), intent(in), target :: p1
     type(prt_t), intent(in), target, optional :: p2
     type(var_entry_t), pointer :: var
     allocate (var)
     if (present (p2)) then
        call var_entry_init_obs (var, name, V_UOBS2_INT, p1, p2)
     else
        call var_entry_init_obs (var, name, V_UOBS1_INT, p1)
     end if
     call var_list_append (var_list, var)
   end subroutine var_list_append_uobs_int
 
   subroutine var_list_append_uobs_real (var_list, name, p1, p2)
     type(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: name
     type(prt_t), intent(in), target :: p1
     type(prt_t), intent(in), target, optional :: p2
     type(var_entry_t), pointer :: var
     allocate (var)
     if (present (p2)) then
        call var_entry_init_obs (var, name, V_UOBS2_REAL, p1, p2)
     else
        call var_entry_init_obs (var, name, V_UOBS1_REAL, p1)
     end if
     call var_list_append (var_list, var)
   end subroutine var_list_append_uobs_real
 
 @ %def var_list_append_uobs_int
 @ %def var_list_append_uobs_real
 @
 \subsection{API for variable lists}
 Set a new value.  If the variable holds a pointer, this pointer is
 followed, e.g., a model parameter is actually set.  If [[ignore]] is
 set, do nothing if the variable does not exist.  If [[verbose]] is
 set, echo the new value.
 
 Clear a variable (all variables), i.e., undefine the value.
 <<Variables: var list: TBP>>=
   procedure :: unset => var_list_clear
 <<Variables: procedures>>=
   subroutine var_list_clear (vars, name, follow_link)
     class(var_list_t), intent(inout) :: vars
     type(string_t), intent(in) :: name
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
     if (associated (var)) then
        call var_entry_clear (var)
     end if
   end subroutine var_list_clear
 
 @ %def var_list_clear
 @
 Setting the value, concise specific versions (implementing deferred TBP):
 <<Variables: var list: TBP>>=
   procedure :: set_ival => var_list_set_ival
   procedure :: set_rval => var_list_set_rval
   procedure :: set_cval => var_list_set_cval
   procedure :: set_lval => var_list_set_lval
   procedure :: set_sval => var_list_set_sval
 <<Variables: procedures>>=
   subroutine var_list_set_ival (vars, name, ival, follow_link)
     class(var_list_t), intent(inout) :: vars
     type(string_t), intent(in) :: name
     integer, intent(in) :: ival
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
     if (associated (var)) then
        call var_entry_set_int (var, ival, is_known=.true.)
     end if
   end subroutine var_list_set_ival
 
   subroutine var_list_set_rval (vars, name, rval, follow_link)
     class(var_list_t), intent(inout) :: vars
     type(string_t), intent(in) :: name
     real(default), intent(in) :: rval
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
     if (associated (var)) then
        call var_entry_set_real (var, rval, is_known=.true.)
     end if
   end subroutine var_list_set_rval
 
   subroutine var_list_set_cval (vars, name, cval, follow_link)
     class(var_list_t), intent(inout) :: vars
     type(string_t), intent(in) :: name
     complex(default), intent(in) :: cval
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
     if (associated (var)) then
        call var_entry_set_cmplx (var, cval, is_known=.true.)
     end if
   end subroutine var_list_set_cval
 
   subroutine var_list_set_lval (vars, name, lval, follow_link)
     class(var_list_t), intent(inout) :: vars
     type(string_t), intent(in) :: name
     logical, intent(in) :: lval
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
     if (associated (var)) then
        call var_entry_set_log (var, lval, is_known=.true.)
     end if
   end subroutine var_list_set_lval
 
   subroutine var_list_set_sval (vars, name, sval, follow_link)
     class(var_list_t), intent(inout) :: vars
     type(string_t), intent(in) :: name
     type(string_t), intent(in) :: sval
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
     if (associated (var)) then
        call var_entry_set_string (var, sval, is_known=.true.)
     end if
   end subroutine var_list_set_sval
 
 @ %def var_list_set_ival
 @ %def var_list_set_rval
 @ %def var_list_set_cval
 @ %def var_list_set_lval
 @ %def var_list_set_sval
 @
 Setting the value, verbose specific versions (as subroutines):
 <<Variables: var list: TBP>>=
   procedure :: set_log => var_list_set_log
   procedure :: set_int => var_list_set_int
   procedure :: set_real => var_list_set_real
   procedure :: set_cmplx => var_list_set_cmplx
   procedure :: set_subevt => var_list_set_subevt
   procedure :: set_pdg_array => var_list_set_pdg_array
   procedure :: set_string => var_list_set_string
 <<Variables: procedures>>=
   subroutine var_list_set_log &
        (var_list, name, lval, is_known, ignore, force, verbose, model_name)
     class(var_list_t), intent(inout), target :: var_list
     type(string_t), intent(in) :: name
     logical, intent(in) :: lval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: ignore, force, verbose
     type(string_t), intent(in), optional :: model_name
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_LOG)
     if (associated (var)) then
        if (.not. var_entry_is_locked (var, force)) then
           select case (var%type)
           case (V_LOG)
              call var_entry_set_log (var, lval, is_known, verbose, model_name)
           case default
              call var_mismatch_error (name)
           end select
        else
           call var_locked_error (name)
        end if
     else
        call var_missing_error (name, ignore)
     end if
   end subroutine var_list_set_log
 
   subroutine var_list_set_int &
        (var_list, name, ival, is_known, ignore, force, verbose, model_name)
     class(var_list_t), intent(inout), target :: var_list
     type(string_t), intent(in) :: name
     integer, intent(in) :: ival
     logical, intent(in) :: is_known
     logical, intent(in), optional :: ignore, force, verbose
     type(string_t), intent(in), optional :: model_name
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_INT)
     if (associated (var)) then
        if (.not. var_entry_is_locked (var, force)) then
           select case (var%type)
           case (V_INT)
              call var_entry_set_int (var, ival, is_known, verbose, model_name)
           case default
              call var_mismatch_error (name)
           end select
        else
           call var_locked_error (name)
        end if
     else
        call var_missing_error (name, ignore)
     end if
   end subroutine var_list_set_int
 
   subroutine var_list_set_real &
        (var_list, name, rval, is_known, ignore, force, &
         verbose, model_name, pacified)
     class(var_list_t), intent(inout), target :: var_list
     type(string_t), intent(in) :: name
     real(default), intent(in) :: rval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: ignore, force, verbose, pacified
     type(string_t), intent(in), optional :: model_name
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_REAL)
     if (associated (var)) then
        if (.not. var_entry_is_locked (var, force)) then
           select case (var%type)
           case (V_REAL)
              call var_entry_set_real &
                   (var, rval, is_known, verbose, model_name, pacified)
           case default
              call var_mismatch_error (name)
           end select
        else
           call var_locked_error (name)
        end if
     else
        call var_missing_error (name, ignore)
     end if
   end subroutine var_list_set_real
 
   subroutine var_list_set_cmplx &
        (var_list, name, cval, is_known, ignore, force, &
         verbose, model_name, pacified)
     class(var_list_t), intent(inout), target :: var_list
     type(string_t), intent(in) :: name
     complex(default), intent(in) :: cval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: ignore, force, verbose, pacified
     type(string_t), intent(in), optional :: model_name
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_CMPLX)
     if (associated (var)) then
        if (.not. var_entry_is_locked (var, force)) then
           select case (var%type)
           case (V_CMPLX)
              call var_entry_set_cmplx &
                   (var, cval, is_known, verbose, model_name, pacified)
           case default
              call var_mismatch_error (name)
           end select
        else
           call var_locked_error (name)
        end if
     else
        call var_missing_error (name, ignore)
     end if
   end subroutine var_list_set_cmplx
 
   subroutine var_list_set_pdg_array &
        (var_list, name, aval, is_known, ignore, force, verbose, model_name)
     class(var_list_t), intent(inout), target :: var_list
     type(string_t), intent(in) :: name
     type(pdg_array_t), intent(in) :: aval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: ignore, force, verbose
     type(string_t), intent(in), optional :: model_name
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_PDG)
     if (associated (var)) then
        if (.not. var_entry_is_locked (var, force)) then
           select case (var%type)
           case (V_PDG)
              call var_entry_set_pdg_array &
                   (var, aval, is_known, verbose, model_name)
           case default
              call var_mismatch_error (name)
           end select
        else
           call var_locked_error (name)
        end if
     else
        call var_missing_error (name, ignore)
     end if
   end subroutine var_list_set_pdg_array
 
   subroutine var_list_set_subevt &
        (var_list, name, pval, is_known, ignore, force, verbose, model_name)
     class(var_list_t), intent(inout), target :: var_list
     type(string_t), intent(in) :: name
     type(subevt_t), intent(in) :: pval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: ignore, force, verbose
     type(string_t), intent(in), optional :: model_name
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_SEV)
     if (associated (var)) then
        if (.not. var_entry_is_locked (var, force)) then
           select case (var%type)
           case (V_SEV)
              call var_entry_set_subevt &
                   (var, pval, is_known, verbose, model_name)
           case default
              call var_mismatch_error (name)
           end select
        else
           call var_locked_error (name)
        end if
     else
        call var_missing_error (name, ignore)
     end if
   end subroutine var_list_set_subevt
 
   subroutine var_list_set_string &
        (var_list, name, sval, is_known, ignore, force, verbose, model_name)
     class(var_list_t), intent(inout), target :: var_list
     type(string_t), intent(in) :: name
     type(string_t), intent(in) :: sval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: ignore, force, verbose
     type(string_t), intent(in), optional :: model_name
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name, V_STR)
     if (associated (var)) then
        if (.not. var_entry_is_locked (var, force)) then
           select case (var%type)
           case (V_STR)
              call var_entry_set_string &
                   (var, sval, is_known, verbose, model_name)
           case default
              call var_mismatch_error (name)
           end select
        else
           call var_locked_error (name)
        end if
     else
        call var_missing_error (name, ignore)
     end if
   end subroutine var_list_set_string
 
   subroutine var_mismatch_error (name)
     type(string_t), intent(in) :: name
     call msg_fatal ("Type mismatch for variable '" // char (name) // "'")
   end subroutine var_mismatch_error
 
   subroutine var_locked_error (name)
     type(string_t), intent(in) :: name
     call msg_error ("Variable '" // char (name) // "' is not user-definable")
   end subroutine var_locked_error
 
   subroutine var_missing_error (name, ignore)
     type(string_t), intent(in) :: name
     logical, intent(in), optional :: ignore
     logical :: error
     if (present (ignore)) then
        error = .not. ignore
     else
        error = .true.
     end if
     if (error) then
        call msg_fatal ("Variable '" // char (name) // "' has not been declared")
     end if
   end subroutine var_missing_error
 
 @ %def var_list_set_log
 @ %def var_list_set_int
 @ %def var_list_set_real
 @ %def var_list_set_cmplx
 @ %def var_list_set_subevt
 @ %def var_list_set_pdg_array
 @ %def var_list_set_string
 @ %def var_mismatch_error
 @ %def var_missing_error
 @
 Import values for the current variable list from another list.
 <<Variables: public>>=
   public :: var_list_import
 <<Variables: var list: TBP>>=
   procedure :: import => var_list_import
 <<Variables: procedures>>=
   subroutine var_list_import (var_list, src_list)
     class(var_list_t), intent(inout) :: var_list
     type(var_list_t), intent(in) :: src_list
     type(var_entry_t), pointer :: var, src
     var => var_list%first
     do while (associated (var))
        src => var_list_get_var_ptr (src_list, var%name)
        if (associated (src)) then
           call var_entry_copy_value (var, src)
        end if
        var => var%next
     end do
   end subroutine var_list_import
 
 @ %def var_list_import
 @ Mark all entries in the current variable list as undefined.  This is done
 when a local variable list is discarded.  If the local list is used again (by
 a loop), the entries will be re-initialized.
 <<Variables: public>>=
   public :: var_list_undefine
 <<Variables: var list: TBP>>=
   procedure :: undefine => var_list_undefine
 <<Variables: procedures>>=
   recursive subroutine var_list_undefine (var_list, follow_link)
     class(var_list_t), intent(inout) :: var_list
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var
     logical :: rec
     rec = .true.;  if (present (follow_link))  rec = follow_link
     var => var_list%first
     do while (associated (var))
        call var_entry_undefine (var)
        var => var%next
     end do
     if (rec .and. associated (var_list%next)) then
        call var_list_undefine (var_list%next, follow_link=follow_link)
     end if
   end subroutine var_list_undefine
 
 @ %def var_list_undefine
 @ Make a deep copy of a variable list.
 <<Variables: public>>=
   public :: var_list_init_snapshot
 <<Variables: var list: TBP>>=
   procedure :: init_snapshot => var_list_init_snapshot
 <<Variables: procedures>>=
   recursive subroutine var_list_init_snapshot (var_list, vars_in, follow_link)
     class(var_list_t), intent(out) :: var_list
     type(var_list_t), intent(in) :: vars_in
     logical, intent(in), optional :: follow_link
     type(var_entry_t), pointer :: var, var_in
     type(var_list_t), pointer :: var_list_next
     logical :: rec
     rec = .true.;  if (present (follow_link))  rec = follow_link
     var_in => vars_in%first
     do while (associated (var_in))
        allocate (var)
        call var_entry_init_copy (var, var_in)
        call var_entry_copy_value (var, var_in)
        call var_list_append (var_list, var)
        var_in => var_in%next
     end do
     if (rec .and. associated (vars_in%next)) then
        allocate (var_list_next)
        call var_list_init_snapshot (var_list_next, vars_in%next)
        call var_list%link (var_list_next)
     end if
   end subroutine var_list_init_snapshot
 
 @ %def var_list_init_snapshot
 @ Check if a user variable can be set.  The [[new]] flag is set if the user
 variable has an explicit declaration.  If an error occurs, return [[V_NONE]]
 as variable type.
 
 Also determine the actual type of generic numerical variables, which enter the
 procedure with type [[V_NONE]].
 <<Variables: public>>=
   public :: var_list_check_user_var
 <<Variables: var list: TBP>>=
   procedure :: check_user_var => var_list_check_user_var
 <<Variables: procedures>>=
   subroutine var_list_check_user_var (var_list, name, type, new)
     class(var_list_t), intent(in), target :: var_list
     type(string_t), intent(in) :: name
     integer, intent(inout) :: type
     logical, intent(in) :: new
     type(var_entry_t), pointer :: var
     var => var_list_get_var_ptr (var_list, name)
     if (associated (var)) then
        if (type == V_NONE) then
           type = var_entry_get_type (var)
        end if
        if (var_entry_is_locked (var)) then
           call msg_fatal ("Variable '" // char (name) &
                // "' is not user-definable")
           type = V_NONE
           return
        else if (new) then
           if (var_entry_is_intrinsic (var)) then
              call msg_fatal ("Intrinsic variable '" &
                   // char (name) // "' redeclared")
              type = V_NONE
              return
           end if
           if (var_entry_get_type (var) /= type) then
              call msg_fatal ("Variable '" // char (name) // "' " &
                   // "redeclared with different type")
              type = V_NONE
              return
           end if
        end if
     end if
   end subroutine var_list_check_user_var
 
 @ %def var_list_check_user_var
 @
 \subsection{Default values for global var list}
 
 <<Variables: var list: TBP>>=
   procedure :: init_defaults => var_list_init_defaults
 <<Variables: procedures>>=
   subroutine var_list_init_defaults (var_list, seed, paths)
     class(var_list_t), intent(out) :: var_list
     integer, intent(in) :: seed
     type(paths_t), intent(in), optional :: paths
     call var_list%set_beams_defaults (paths)
     call var_list%set_core_defaults (seed)
     call var_list%set_integration_defaults ()
     call var_list%set_phase_space_defaults ()
     call var_list%set_gamelan_defaults ()
     call var_list%set_clustering_defaults ()
     call var_list%set_isolation_defaults ()
     call var_list%set_eio_defaults ()
     call var_list%set_shower_defaults ()
     call var_list%set_hadronization_defaults ()
     call var_list%set_tauola_defaults  ()
     call var_list%set_mlm_matching_defaults ()
     call var_list%set_powheg_matching_defaults ()
     call var_list%append_log (var_str ("?ckkw_matching"), .false., &
             intrinsic=.true., description=var_str ('Master flag that switches ' // &
             'on the CKKW(-L) (LO) matching between hard scattering matrix ' // &
             'elements and QCD parton showers. Note that this is not yet ' // &
             '(completely) implemented in \whizard. (cf. also \ttt{?allow\_shower}, ' // &
             '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...})'))
     call var_list%set_openmp_defaults ()
     call var_list%set_mpi_defaults ()
     call var_list%set_nlo_defaults ()
   end subroutine var_list_init_defaults
 
 @ %def var_list_init_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_beams_defaults => var_list_set_beams_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_beams_defaults (var_list, paths)
     type(paths_t), intent(in), optional :: paths
     class(var_list_t), intent(inout) :: var_list
     call 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 (collider energy $\sqrt{s}$, not ' // &
           'hard interaction energy $\sqrt{\hat{s}}$): \ttt{sqrts = {\em ' // &
           '<num>} [ {\em <phys\_unit>} ]}. The physical unit can be one ' // &
           'of the following \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{GeV}, ' // &
           'and \ttt{TeV}. If absent, \whizard\ takes \ttt{GeV} as its ' // &
           'standard unit. Note that this variable is absolutely mandatory ' // &
           'for integration and simulation of scattering processes.'))
     call 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. Note that WHIZARD itself chooses the ' // &
           'number from the \ttt{luminosity} or from the \ttt{n\_events} ' // &
           'specifier, whichever would give the larger number of events. ' // &
           'As this depends on the cross section under consideration, it ' // &
           'might be different for different processes in the process list.  ' // &
           '(cf. \ttt{n\_events}, \ttt{\$sample}, \ttt{sample\_format}, \ttt{?unweighted})'))
     call var_list%append_log (var_str ("?sf_trace"), .false., &
           intrinsic=.true., &
           description=var_str ('Debug flag that writes out detailed information ' // &
           'about the structure function setup into the file \ttt{{\em ' // &
           '<proc\_name>}\_sftrace.dat}. This file name can be changed ' // &
           'with ($\to$) \ttt{\$sf\_trace\_file}.'))
     call var_list%append_string (var_str ("$sf_trace_file"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('\ttt{\$sf\_trace\_file = "{\em <file\_name>}"} ' // &
           'allows to change the detailed structure function information ' // &
           'switched on by the debug flag ($\to$) \ttt{?sf\_trace} into ' // &
           'a different file \ttt{{\em <file\_name>}} than the default ' // &
           '\ttt{{\em <proc\_name>}\_sftrace.dat}.'))
     call var_list%append_log (var_str ("?sf_allow_s_mapping"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that determines whether special mappings ' // &
           'for processes with structure functions and $s$-channel resonances ' // &
           'are applied, e.g. Drell-Yan at hadron colliders, or $Z$ production ' // &
           'at linear colliders with beamstrahlung and ISR.'))
     if (present (paths)) then
        call var_list%append_string (var_str ("$lhapdf_dir"), paths%lhapdfdir, &
              intrinsic=.true., &
              description=var_str ('String variable that tells the path ' // &
              'where the \lhapdf\ library and PDF sets can be found. When ' // &
              'the library has been correctly recognized during configuration, ' // &
              'this is automatically set by \whizard. (cf. also \ttt{lhapdf}, ' // &
              '\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // &
              '\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})'))
     else
        call var_list%append_string (var_str ("$lhapdf_dir"), var_str(""), &
              intrinsic=.true., &
              description=var_str ('String variable that tells the path ' // &
              'where the \lhapdf\ library and PDF sets can be found. When ' // &
              'the library has been correctly recognized during configuration, ' // &
              'this is automatically set by \whizard. (cf. also \ttt{lhapdf}, ' // &
              '\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // &
              '\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})'))
     end if
     call var_list%append_string (var_str ("$lhapdf_file"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('This string variable \ttt{\$lhapdf\_file ' // &
           '= "{\em <pdf\_set>}"} allows to specify the PDF set \ttt{{\em ' // &
           '<pdf\_set>}} from the external \lhapdf\ library. It must match ' // &
           'the exact name of the PDF set from the \lhapdf\ library. The ' // &
           'default is empty, and the default set from \lhapdf\ is taken. ' // &
           'Only one argument is possible, the PDF set must be identical ' // &
           'for both beams, unless there are fundamentally different beam ' // &
           'particles like proton and photon. (cf. also \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // &
           '\ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_photon\_scheme}, ' // &
           '\ttt{lhapdf\_member})'))
     call var_list%append_string (var_str ("$lhapdf_photon_file"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('String variable \ttt{\$lhapdf\_photon\_file ' // &
           '= "{\em <pdf\_set>}"} analagous to ($\to$) \ttt{\$lhapdf\_file} ' // &
           'for photon PDF structure functions from the external \lhapdf\ ' // &
           'library. The name must exactly match the one of the set from ' // &
           '\lhapdf.  (cf. \ttt{beams}, \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // &
           '\ttt{\$lhapdf\_file}, \ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member}, ' // &
           '\ttt{lhapdf\_photon\_scheme})'))
     call var_list%append_int (var_str ("lhapdf_member"), 0, &
           intrinsic=.true., &
           description=var_str ('Integer variable that specifies the number ' // &
           'of the corresponding PDF set chosen via the command ($\to$) ' // &
           '\ttt{\$lhapdf\_file} or ($\to$) \ttt{\$lhapdf\_photon\_file} ' // &
           'from the external \lhapdf\ library. E.g. error PDF sets can ' // &
           'be chosen by this. (cf. also \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // &
           '\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // &
           '\ttt{lhapdf\_photon\_scheme})'))
     call var_list%append_int (var_str ("lhapdf_photon_scheme"), 0, &
           intrinsic=.true., &
           description=var_str ('Integer parameter that controls the different ' // &
           'available schemes for photon PDFs inside the external \lhapdf\ ' // &
           'library. For more details see the \lhapdf\ manual.  (cf. also ' // &
           '\ttt{lhapdf}, \ttt{\$lhapdf\_dir}, \ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, ' // &
           '\ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member})'))
     call var_list%append_string (var_str ("$pdf_builtin_set"), var_str ("CTEQ6L"), &
          intrinsic=.true., &
          description=var_str ("For \whizard's internal PDF structure functions " // &
          'for hadron colliders, this string variable allows to set the ' // &
          'particular PDF set. (cf. also \ttt{pdf\_builtin}, \ttt{pdf\_builtin\_photon})'))
     call var_list%append_log (var_str ("?hoppet_b_matching"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that switches on the matching between ' // &
           '4- and 5-flavor schemes for hadron collider $b$-parton initiated ' // &
           'processes. Works either with builtin PDFs or with the external ' // &
           '\lhapdf\ interface. Needs the external \ttt{HOPPET} library ' // &
           'to be linked. (cf. \ttt{beams}, \ttt{pdf\_builtin}, \ttt{lhapdf})'))
     call var_list%append_real (var_str ("isr_alpha"), 0._default, &
           intrinsic=.true., &
           description=var_str ('For lepton collider initial-state QED ' // &
           'radiation (ISR), this real parameter sets the value of $\alpha_{em}$ ' // &
           'used in the structure function. If not set, it is taken from ' // &
           'the parameter set of the physics model in use (cf. also \ttt{isr}, ' // &
           '\ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order}, \ttt{?isr\_recoil}, ' // &
           '\ttt{?isr\_keep\_energy})'))
     call var_list%append_real (var_str ("isr_q_max"), 0._default, &
           intrinsic=.true., &
           description=var_str ('This real parameter allows to set the ' // &
           'scale of the initial-state QED radiation (ISR) structure function. ' // &
           'If not set, it is taken internally to be $\sqrt{s}$.  (cf. ' // &
           'also \ttt{isr}, \ttt{isr\_alpha}, \ttt{isr\_mass}, \ttt{isr\_order}, ' // &
           '\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})'))
     call var_list%append_real (var_str ("isr_mass"), 0._default, &
           intrinsic=.true., &
           description=var_str ('This real parameter allows to set by hand ' // &
           'the mass of the incoming particle for lepton collider initial-state ' // &
           'QED radiation (ISR). If not set, the mass for the initial beam ' // &
           'particle is taken from the model in use. (cf. also \ttt{isr}, ' // &
           '\ttt{isr\_q\_max}, \ttt{isr\_alpha}, \ttt{isr\_order}, \ttt{?isr\_recoil}, ' // &
           '\ttt{?isr\_keep\_energy})'))
     call var_list%append_int (var_str ("isr_order"), 3, &
           intrinsic=.true., &
           description=var_str ('For lepton collider initial-state QED ' // &
           'radiation (ISR), this integer parameter allows to set the order ' // &
           'up to which hard-collinear radiation is taken into account. ' // &
           'Default is the highest available, namely third order. (cf. ' // &
           'also \ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_alpha}, ' // &
           '\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})'))
     call var_list%append_log (var_str ("?isr_recoil"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // &
           '$p_T$-kick for the lepton collider initial-state QED radiation ' // &
           '(ISR).  (cf. also \ttt{isr}, \ttt{isr}, \ttt{isr\_alpha}, \ttt{isr\_mass}, ' // &
           '\ttt{isr\_order}, \ttt{isr\_q\_max})'))
     call var_list%append_log (var_str ("?isr_keep_energy"), .false., &
           intrinsic=.true., &
           description=var_str ('As the splitting kinematics for the ISR ' // &
           'structure function violates Lorentz invariance when the recoil ' // &
           'is switched on, this flag forces energy conservation when set ' // &
           'to true, otherwise violating energy conservation.  (cf. also ' // &
           '\ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order}, ' // &
           '\ttt{?isr\_recoil}, \ttt{?isr\_alpha})'))
     call var_list%append_log (var_str ("?isr_handler"), .false., &
           intrinsic=.true., &
           description=var_str ('Activate ISR ' // &
           'handler for event generation (no effect on integration). ' // &
           'Requires \ttt{isr\_recoil = false}'))
     call var_list%append_string (var_str ("$isr_handler_mode"), &
           var_str ("trivial"), &
           intrinsic=.true., &
           description=var_str ('Operation mode for the ISR ' // &
           'event handler.  Allowed values: \ttt{trivial} (no effect), ' // &
           '\ttt{recoil} (recoil kinematics with two photons)'))
     call var_list%append_real (var_str ("epa_alpha"), 0._default, &
           intrinsic=.true., &
           description=var_str ('For the equivalent photon approximation ' // &
           '(EPA), this real parameter sets the value of $\alpha_{em}$ ' // &
           'used in the structure function. If not set, it is taken from ' // &
           'the parameter set of the physics model in use (cf. also \ttt{epa}, ' // &
           '\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_e\_max}, \ttt{epa\_q\_min}, ' // &
           '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
     call var_list%append_real (var_str ("epa_x_min"), 0._default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that sets the lower cutoff ' // &
           'for the energy fraction in the splitting for the equivalent-photon ' // &
           'approximation (EPA). This parameter has to be set by the user ' // &
           'to a non-zero value smaller than one. (cf. also \ttt{epa}, ' // &
           '\ttt{epa\_e\_max}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // &
           '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
     call var_list%append_real (var_str ("epa_q_min"), 0._default, &
           intrinsic=.true., &
           description=var_str ('In the equivalent-photon approximation ' // &
           '(EPA), this real parameters sets the minimal value for the ' // &
           'transferred momentum. Either this parameter or the mass of ' // &
           'the beam particle has to be non-zero.  (cf. also \ttt{epa}, ' // &
           '\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_max}, ' // &
           '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
     call var_list%append_real (var_str ("epa_q_max"), 0._default, &
           intrinsic=.true., &
           description=var_str ('This real parameter allows to set the ' // &
           'upper energy cutoff for the equivalent-photon approximation ' // &
           '(EPA). If not set, \whizard\ simply takes the collider energy, ' // &
           '$\sqrt{s}$. (cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, ' // &
           '\ttt{epa\_alpha}, \ttt{epa\_q\_min}, \ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
     call var_list%append_real (var_str ("epa_mass"), 0._default, &
           intrinsic=.true., &
           description=var_str ('This real parameter allows to set by hand ' // &
           'the mass of the incoming particle for the equivalent-photon ' // &
           'approximation (EPA). If not set, the mass for the initial beam ' // &
           'particle is taken from the model in use. (cf. also \ttt{epa}, ' // &
           '\ttt{epa\_x\_min}, \ttt{epa\_e\_max}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // &
           '\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
     call var_list%append_log (var_str ("?epa_recoil"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // &
           '$p_T$-kick for the equivalent-photon approximation (EPA).  ' // &
           '(cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // &
           '\ttt{epa\_e\_max}, \ttt{epa\_q\_min}, \ttt{?epa\_keep\_energy})'))
     call var_list%append_log (var_str ("?epa_keep_energy"), .false., &
           intrinsic=.true., &
           description=var_str ('As the splitting kinematics for the EPA ' // &
           'structure function violates Lorentz invariance when the recoil ' // &
           'is switched on, this flag forces energy conservation when set ' // &
           'to true, otherwise violating energy conservation. (cf. also ' // &
           '\ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // &
           '\ttt{epa\_q\_min}, \ttt{?epa\_recoil})'))
     call var_list%append_log (var_str ("?epa_handler"), .false., &
           intrinsic=.true., &
           description=var_str ('Activate EPA ' // &
           'handler for event generation (no effect on integration). ' // &
           'Requires \ttt{epa\_recoil = false}'))
     call var_list%append_string (var_str ("$epa_handler_mode"), &
           var_str ("trivial"), &
           intrinsic=.true., &
           description=var_str ('Operation mode for the EPA ' // &
           'event handler.  Allowed values: \ttt{trivial} (no effect), ' // &
           '\ttt{recoil} (recoil kinematics with two beams)'))
     call var_list%append_real (var_str ("ewa_x_min"), 0._default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that sets the lower cutoff ' // &
           'for the energy fraction in the splitting for the equivalent ' // &
           '$W$ approximation (EWA). This parameter has to be set by the ' // &
           'user to a non-zero value smaller than one. (cf. also \ttt{ewa}, ' // &
           '\ttt{ewa\_pt\_max}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // &
           '\ttt{?ewa\_recoil})'))
     call var_list%append_real (var_str ("ewa_pt_max"), 0._default, &
           intrinsic=.true., &
           description=var_str ('This real parameter allows to set the ' // &
           'upper $p_T$ cutoff for the equivalent $W$ approximation (EWA). ' // &
           'If not set, \whizard\ simply takes the collider energy, $\sqrt{s}$. ' // &
           '(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // &
           '\ttt{?ewa\_recoil})'))
     call var_list%append_real (var_str ("ewa_mass"), 0._default, &
           intrinsic=.true., &
           description=var_str ('This real parameter allows to set by hand ' // &
           'the mass of the incoming particle for the equivalent $W$ approximation ' // &
           '(EWA). If not set, the mass for the initial beam particle is ' // &
           'taken from the model in use. (cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, ' // &
           '\ttt{ewa\_pt\_max}, \ttt{?ewa\_keep\_energy}, \ttt{?ewa\_recoil})'))
     call var_list%append_log (var_str ("?ewa_recoil"), .false., &
          intrinsic=.true., &
          description=var_str ('For the equivalent $W$ approximation (EWA), ' // &
          'this flag switches on recoil, i.e. non-collinear splitting.  ' // &
          '(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max},  ' // &
          '\ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy})'))
     call var_list%append_log (var_str ("?ewa_keep_energy"), .false., &
           intrinsic=.true., &
           description=var_str ('As the splitting kinematics for the equivalent ' // &
           '$W$ approximation (EWA) violates Lorentz invariance when the ' // &
           'recoil is switched on, this flag forces energy conservation ' // &
           'when set to true, otherwise violating energy conservation. ' // &
           '(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max},  ' // &
           '\ttt{ewa\_mass}, \ttt{?ewa\_recoil})'))
     call var_list%append_log (var_str ("?circe1_photon1"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag to tell \whizard\ to use the photon ' // &
           'of the \circeone\ beamstrahlung structure function as initiator ' // &
           'for the hard scattering process in the first beam. (cf. also ' // &
           '\ttt{circe1}, \ttt{?circe1\_photon2}, \ttt{circe1\_sqrts},  ' // &
           '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
           '\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
           '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
           '\ttt{?circe1\_with\_radiation})'))
     call var_list%append_log (var_str ("?circe1_photon2"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag to tell \whizard\ to use the photon ' // &
           'of the \circeone\ beamstrahlung structure function as initiator ' // &
           'for the hard scattering process in the second beam. (cf. also ' // &
           '\ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{circe1\_sqrts},  ' // &
           '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
           '\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
           '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // &
           '\newline\ttt{?circe1\_with\_radiation})'))
     call var_list%append_real (var_str ("circe1_sqrts"), &
           intrinsic=.true., &
           description=var_str ('Real parameter that allows to set the ' // &
           'value of the collider energy for the lepton collider beamstrahlung ' // &
           'structure function \circeone. If not set, $\sqrt{s}$ is taken. ' // &
           '(cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2},  ' // &
           '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
           '\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
           '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
           '\ttt{?circe1\_with\_radiation})'))
     call var_list%append_log (var_str ("?circe1_generate"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that determines whether the \circeone\ ' // &
           'structure function for lepton collider beamstrahlung uses the ' // &
           'generator mode for the spectrum, or a pre-defined (semi-)analytical ' // &
           'parameterization. Default is the generator mode. (cf. also ' // &
           '\ttt{circe1}, \ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2},  ' // &
           '\ttt{circe1\_sqrts}, \ttt{?circe1\_map}, \ttt{circe1\_mapping\_slope}, ' // &
           '\ttt{circe1\_eps}, \newline \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // &
           '\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
     call var_list%append_log (var_str ("?circe1_map"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that determines whether the \circeone\ ' // &
           'structure function for lepton collider beamstrahlung uses special ' // &
           'mappings for $s$-channel resonances. (cf. also \ttt{circe1}, ' // &
           '\ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2},  ' // &
           '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // &
           '\ttt{circe1\_mapping\_slope}, \ttt{circe1\_eps}, \newline ' // &
           '\ttt{circe1\_ver}, \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, ' // &
           '\ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
     call var_list%append_real (var_str ("circe1_mapping_slope"), 2._default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that allows to vary the ' // &
           'slope of the mapping function for the \circeone\ structure ' // &
           'function for lepton collider beamstrahlung from the default ' // &
           'value \ttt{2.}. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // &
           '\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts},  \ttt{?circe1\_generate}, ' // &
           '\ttt{?circe1\_map}, \ttt{circe1\_eps}, \ttt{circe1\_ver}, ' // &
           '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
           '\ttt{?circe1\_with\_radiation})'))
     call var_list%append_real (var_str ("circe1_eps"), 1e-5_default, &
           intrinsic=.true., &
           description=var_str ('Real parameter, that takes care of the ' // &
           'mapping of the peak in the lepton collider beamstrahlung structure ' // &
           'function spectrum of \circeone.  (cf. also \ttt{circe1}, \ttt{?circe1\_photons}, ' // &
           '\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // &
           '\ttt{?circe1\_map}, \ttt{circe1\_eps}, \newline ' // &
           '\ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // &
           '\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline\ttt{?circe1\_with\_radiation})'))
     call var_list%append_int (var_str ("circe1_ver"), 0, intrinsic=.true., &
          description=var_str ('Integer parameter that sets the internal ' // &
          'versioning number of the \circeone\ structure function for lepton-collider ' // &
          'beamstrahlung. It has to be set by the user explicitly, it takes ' // &
          'values from one to ten.  (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // &
          '\ttt{?circe1\_photon2},  \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
          '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, ' // &
          '\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // &
          '\ttt{?circe1\_with\_radiation})'))
     call var_list%append_int (var_str ("circe1_rev"), 0, intrinsic=.true., &
          description=var_str ('Integer parameter that sets the internal ' // &
          'revision number of the \circeone\ structure function for lepton-collider ' // &
          'beamstrahlung. The default \ttt{0} translates always into the ' // &
          'most recent version; older versions have to be accessed through ' // &
          'the explicit revision date. For more details cf.~the \circeone ' // &
          'manual.  (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2},  ' // &
          '\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
          '\ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, \ttt{circe1\_ver}, ' // &
          '\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
     call var_list%append_string (var_str ("$circe1_acc"), var_str ("SBAND"), &
           intrinsic=.true., &
           description=var_str ('String variable that specifies the accelerator ' // &
           'type for the \circeone\ structure function for lepton-collider ' // &
           'beamstrahlung.  (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
           '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
           '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
           '\newline \ttt{circe1\_rev}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
     call var_list%append_int (var_str ("circe1_chat"), 0, intrinsic=.true., &
          description=var_str ('Chattiness of the \circeone\ structure ' // &
          'function for lepton-collider beamstrahlung. The higher the integer ' // &
          'value, the more information will be given out by the \circeone\ ' // &
          'package. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
          '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
          '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
          '\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{?circe1\_with\_radiation})'))
     call var_list%append_log (var_str ("?circe1_with_radiation"), .false., &
          intrinsic=.true., &
          description=var_str ('This logical decides whether the additional photon ' // &
          'or electron ("beam remnant") will be considered in the event record or ' // &
          'not. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
          '\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
          '\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
          '\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc})'))
     call var_list%append_log (var_str ("?circe2_polarized"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag whether the photon spectra from the ' // &
           '\circetwo\ structure function for lepton colliders should be ' // &
           'treated polarized. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, ' // &
           '\ttt{\$circe2\_design})'))
     call var_list%append_string (var_str ("$circe2_file"), &
           intrinsic=.true., &
           description=var_str ('String variable by which the corresponding ' // &
           'photon collider spectrum for the \circetwo\ structure function ' // &
           'can be selected. (cf. also \ttt{circe2}, \ttt{?circe2\_polarized}, ' // &
           '\ttt{\$circe2\_design})'))
     call var_list%append_string (var_str ("$circe2_design"), var_str ("*"), &
           intrinsic=.true., &
           description=var_str ('String variable that sets the collider ' // &
           'design for the \circetwo\ structure function for photon collider ' // &
           'spectra. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, \ttt{?circe2\_polarized})'))
     call var_list%append_real (var_str ("gaussian_spread1"), 0._default, &
           intrinsic=.true., &
           description=var_str ('Parameter that sets the energy spread ' // &
           '($\sigma$ value) of the first beam for a Gaussian spectrum.  ' // &
           '(cf. \ttt{gaussian})'))
      call var_list%append_real (var_str ("gaussian_spread2"), 0._default, &
           intrinsic=.true., &
           description=var_str ('Ditto, for the second beam.'))
     call var_list%append_string (var_str ("$beam_events_file"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows to set the ' // &
           "name of the external file from which a beamstrahlung's spectrum " // &
           'for lepton colliders as pairs of energy fractions is read in. ' // &
           '(cf. also \ttt{beam\_events}, \ttt{?beam\_events\_warn\_eof})'))
     call var_list%append_log (var_str ("?beam_events_warn_eof"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that tells \whizard\ to ' // &
           'issue a warning when in a simulation the end of an external ' // &
           "file for beamstrahlung's spectra for lepton colliders are reached, " // &
           'and energy fractions from the beginning of the file are reused. ' // &
           '(cf. also \ttt{beam\_events}, \ttt{\$beam\_events\_file})'))
     call var_list%append_log (var_str ("?energy_scan_normalize"), .false., &
           intrinsic=.true., &
           description=var_str ('Normalization flag for the energy scan ' // &
           'structure function: if set the total cross section is normalized ' // &
           'to unity. (cf. also \ttt{energy\_scan})'))
   end subroutine var_list_set_beams_defaults
 
 @ %def var_list_set_beams_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_core_defaults => var_list_set_core_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_core_defaults (var_list, seed)
     class(var_list_t), intent(inout) :: var_list
     integer, intent(in) :: seed
     logical, target, save :: known = .true.     !!! ??????
     real(default), parameter :: real_specimen = 1.
     call var_list_append_log_ptr &
          (var_list, var_str ("?logging"), logging, known, &
          intrinsic=.true., &
          description=var_str ('This logical -- when set to \ttt{false} ' // &
          '-- suppresses writing out a logfile (default: \ttt{whizard.log}) ' // &
          'for the whole \whizard\ run, or when \whizard\ is run with the ' // &
          '\ttt{--no-logging} option, to suppress parts of the logging ' // &
          'when setting it to \ttt{true} again at a later part of the ' // &
          '\sindarin\ input file. Mainly for debugging purposes.  ' // &
          '(cf. also \ttt{?openmp\_logging}, \ttt{?mpi\_logging})'))
     call var_list%append_string (var_str ("$job_id"), &
          intrinsic=.true., &
          description=var_str ('Arbitrary string that can be used for ' // &
          'creating unique names.  The variable is initialized with the ' // &
          'value of the \ttt{job\_id} option on startup. (cf. also ' // &
          '\ttt{\$compile\_workspace}, \ttt{\$run\_id})'))
     call var_list%append_string (var_str ("$compile_workspace"), &
          intrinsic=.true., &
          description=var_str ('If set, create process source code ' // &
          'and process-driver library code in a subdirectory with this ' // &
          'name.  If non-existent, the directory will be created. (cf. ' // &
          'also \ttt{\$job\_id}, \ttt{\$run\_id}, \ttt{\$integrate\_workspace})'))
     call var_list%append_int (var_str ("seed"), seed, &
           intrinsic=.true., &
           description=var_str ('Integer variable \ttt{seed = {\em <num>}} ' // &
           'that allows to set a specific random seed \ttt{num}. If not ' // &
           'set, \whizard\ takes the time from the system clock to determine ' // &
           'the random seed.'))
     call var_list%append_string (var_str ("$model_name"), &
           intrinsic=.true., &
           description=var_str ('This variable makes the locally used physics ' // &
           'model available as a string, e.g. as \ttt{show (\$model\_name)}. ' // &
           'However, the user is not able to change the current model by ' // &
           'setting this variable to a different string. (cf. also \ttt{model}, ' // &
           '\ttt{\$library\_name}, \ttt{printf}, \ttt{show})'))
     call var_list%append_int (var_str ("process_num_id"), &
          intrinsic=.true., &
          description=var_str ('Using the integer \ttt{process\_num\_id ' // &
          '= {\em <int\_var>}} one can set a numerical identifier for processes ' // &
          'within a process library. This can be set either just before ' // &
          'the corresponding \ttt{process} definition or as an optional ' // &
-         'local argument of the latter. (cf. also \ttt{process})'))
+         'local argument of the latter. (cf. also \ttt{process}, ' // &
+         '\ttt{?proc\_as\_run\_id}, \ttt{lcio\_run\_id})'))
+    call var_list%append_log (var_str ("?proc_as_run_id"), .true., &
+         intrinsic=.true., &
+         description=var_str ('Normally, for LCIO the process ID (cf. ' // &
+         '\ttt{process\_num\_id}) is used as run ID, unless this flag is ' // &
+         'set to \ttt{false}, cf. also \ttt{process}, \ttt{lcio\_run\_id}.'))
+    call var_list%append_int (var_str ("lcio_run_id"), 0, &
+         intrinsic=.true., &
+         description=var_str ('Allows to set an integer run ID for the LCIO ' // &
+         'event format. Normally, the process ID is taken as run ID, unless ' // &
+         'the flag (cf.) \ttt{?proc\_as\_run\_id} is set to \ttt{false}, ' // &
+         'cf. also \ttt{process}.'))
     call 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. The default ' // &
          "is the intrinsic \oMega\ matrix element generator " // &
          '(\ttt{"omega"}), other options are: \ttt{"ovm"}, \ttt{"unit\_test"}, ' // &
          '\ttt{"template\_unity"}, \ttt{"threshold"}. For processes defined ' // &
          '\ttt{"template"}, with \ttt{nlo\_calculation = ...}, please refer to ' // &
          '\ttt{\$born\_me\_method}, \ttt{\$real\_tree\_me\_method}, ' // &
          '\ttt{\$loop\_me\_method} and \ttt{\$correlation\_me\_method}.'))
     call var_list%append_log (var_str ("?report_progress"), .true., &
          intrinsic=.true., &
          description=var_str ('Flag for the \oMega\ matrix element generator ' // &
          'whether to print out status messages about progress during ' // &
          'matrix element generation. (cf. also \ttt{\$method}, \ttt{\$omega\_flags})'))
     call var_list%append_log (var_str ("?me_verbose"), .false., &
          description=var_str ("Flag determining whether " // &
          "the makefile command for generating and compiling the \oMega\ matrix " // &
          "element code is silent or verbose. Default is silent."))
     call var_list%append_string (var_str ("$restrictions"), var_str (""), &
          intrinsic=.true., &
          description=var_str ('This is an optional argument for process ' // &
          'definitions for the matrix element method \ttt{"omega"}. Using ' // &
          'the following construction, it defines a string variable, \ttt{process ' // &
          '\newline {\em <process\_name>} = {\em <particle1>}, {\em <particle2>} ' // &
          '=> {\em <particle3>}, {\em <particle4>}, ... \{ \$restrictions ' // &
          '= "{\em <restriction\_def>}" \}}. The string argument \ttt{{\em ' // &
          '<restriction\_def>}} is directly transferred during the code ' // &
          'generation to the ME generator \oMega. It has to be of the form ' // &
          '\ttt{n1 + n2 + ...  \url{~} {\em <particle (list)>}}, where ' // &
          '\ttt{n1} and so on are the numbers of the particles above in ' // &
          'the process definition. The tilde specifies a certain intermediate ' // &
          'state to be equal to the particle(s) in \ttt{particle (list)}. ' // &
          'An example is \ttt{process eemm\_z =     e1, E1  =>  e2, E2 ' // &
          '\{ \$restrictions = "1+2 \url{~} Z" \} } restricts the code ' // &
          'to be generated for the process $e^- e^+ \to \mu^- \mu^+$ to ' // &
          'the $s$-channel $Z$-boson exchange. For more details see Sec.~\ref{sec:omega_me} ' // &
          '(cf. also \ttt{process})'))
     call var_list%append_log (var_str ("?omega_write_phs_output"), .false., &
          intrinsic=.true., &
          description=var_str ('This flag decides whether a the phase-space ' // &
          'output is produced by the \oMega\ matrix element generator. This ' // &
          'output is written to file(s) and contains the Feynman diagrams ' // &
          'which belong to the process(es) under consideration. The file is ' // &
          'mandatory whenever the variable \ttt{\$phs\_method} has the value ' // &
          '\ttt{fast\_wood}, i.e. if the phase-space file is provided by ' // &
          'cascades2.'))
     call var_list%append_string (var_str ("$omega_flags"), var_str (""), &
          intrinsic=.true., &
          description=var_str ('String variable that allows to pass flags ' // &
          'to the \oMega\ matrix element generator. Normally, \whizard\ ' // &
          'takes care of all flags automatically. Note that for restrictions ' // &
          'of intermediate states, there is a special string variable: ' // &
          '(cf. $\to$) \ttt{\$restrictions}.'))
     call 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.'))
      !!! JRR: WK please check (#529)
 !     call var_list_append_string &
 !          (var_list, var_str ("$user_procs_cut"), var_str (""), &
 !           intrinsic=.true.)
 !     call var_list_append_string &
 !          (var_list, var_str ("$user_procs_event_shape"), var_str (""), &
 !           intrinsic=.true.)
 !     call var_list_append_string &
 !          (var_list, var_str ("$user_procs_obs1"), var_str (""), &
 !           intrinsic=.true.)
 !     call var_list_append_string &
 !          (var_list, var_str ("$user_procs_obs2"), var_str (""), &
 !           intrinsic=.true.)
 !     call var_list_append_string &
 !          (var_list, var_str ("$user_procs_sf"), var_str (""), &
 !           intrinsic=.true.)
     call var_list%append_log (var_str ("?slha_read_input"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag which decides whether \whizard\ reads ' // &
           'in the SM and parameter information from the \ttt{SMINPUTS} ' // &
           'and \ttt{MINPAR} common blocks of the SUSY Les Houches Accord ' // &
           'files. (cf. also \ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, ' // &
           '\ttt{?slha\_read\_decays})'))
     call var_list%append_log (var_str ("?slha_read_spectrum"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag which decides whether \whizard\ reads ' // &
           'in the whole spectrum and mixing angle information from the ' // &
           'common blocks of the SUSY Les Houches Accord files. (cf. also ' // &
           '\ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_decays}, ' // &
           '\ttt{?slha\_read\_input})'))
     call var_list%append_log (var_str ("?slha_read_decays"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag which decides whether \whizard\ reads ' // &
           'in the widths and branching ratios from the \ttt{DCINFO} common ' // &
           'block of the SUSY Les Houches Accord files. (cf. also \ttt{read\_slha}, ' // &
           '\ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, \ttt{?slha\_read\_input})'))
     call var_list%append_string (var_str ("$library_name"), &
           intrinsic=.true., &
           description=var_str ('Similar to \ttt{\$model\_name}, this string ' // &
           'variable is used solely to access the name of the active process ' // &
           'library, e.g. in \ttt{printf} statements. (cf. \ttt{compile}, ' // &
           '\ttt{library}, \ttt{printf}, \ttt{show}, \ttt{\$model\_name})'))
     call var_list%append_log (var_str ("?alphas_is_fixed"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that tells \whizard\ to use a non-running ' // &
           '$\alpha_s$. Note that this has to be set explicitly to $\ttt{false}$ ' // &
           'if the user wants to use one of the running $\alpha_s$ options. ' // &
           '(cf. also \ttt{alphas\_order}, \ttt{?alphas\_from\_lhapdf}, ' // &
           '\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // &
           '\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
     call var_list%append_log (var_str ("?alphas_from_lhapdf"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that tells \whizard\ to use a running ' // &
           '$\alpha_s$ from the \lhapdf\ library (which has to be correctly ' // &
           'linked). Note that \ttt{?alphas\_is\_fixed} has to be set ' // &
           'explicitly to $\ttt{false}$. (cf. also \ttt{alphas\_order}, ' // &
           '\ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
           '\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // &
           '\ttt{lambda\_qcd})'))
     call var_list%append_log (var_str ("?alphas_from_pdf_builtin"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that tells \whizard\ to use a running ' // &
           '$\alpha_s$ from the internal PDFs. Note that in that case \ttt{?alphas\_is\_fixed} ' // &
           'has to be set explicitly to $\ttt{false}$. (cf. also ' // &
           '\ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // &
           '\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \newline \ttt{?alphas\_from\_lambda\_qcd}, ' // &
           '\ttt{lambda\_qcd})'))
     call var_list%append_int (var_str ("alphas_order"), 0, &
           intrinsic=.true., &
           description=var_str ('Integer parameter that sets the order ' // &
           'of the internal evolution for running $\alpha_s$ in \whizard: ' // &
           'the default, \ttt{0}, is LO running, \ttt{1} is NLO, \ttt{2} ' // &
           'is NNLO. (cf. also \ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // &
           '\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // &
           '\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
     call var_list%append_int (var_str ("alphas_nf"), 5, &
           intrinsic=.true., &
           description=var_str ('Integer parameter that sets the number ' // &
           'of active quark flavors for the internal evolution for running ' // &
           '$\alpha_s$ in \whizard: the default is \ttt{5}. (cf. also ' // &
           '\ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
           '\ttt{alphas\_order}, \ttt{?alphas\_from\_mz}, \newline ' // &
           '\ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
     call var_list%append_log (var_str ("?alphas_from_mz"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that tells \whizard\ to use its internal ' // &
           'running $\alpha_s$ from $\alpha_s(M_Z)$. Note that in that ' // &
           'case \ttt{?alphas\_is\_fixed} has to be set explicitly to ' // &
           '$\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // &
           '\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
           '\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
     call var_list%append_log (var_str ("?alphas_from_lambda_qcd"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that tells \whizard\ to use its internal ' // &
           'running $\alpha_s$ from $\alpha_s(\Lambda_{QCD})$. Note that ' // &
           'in that case \ttt{?alphas\_is\_fixed} has  to be set explicitly ' // &
           'to $\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // &
           '\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
           '\newline \ttt{?alphas\_from\_mz}, \ttt{lambda\_qcd})'))
     call var_list%append_real (var_str ("lambda_qcd"), 200.e-3_default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that sets the value for ' // &
           '$\Lambda_{QCD}$ used in the internal evolution for running ' // &
           '$\alpha_s$ in \whizard. (cf. also \ttt{alphas\_is\_fixed}, ' // &
           '\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, ' // &
           '\newline \ttt{?alphas\_from\_pdf\_builtin}, ' // &
           '\ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // &
           '\ttt{alphas\_order})'))
     call var_list%append_log (var_str ("?fatal_beam_decay"), .true., &
           intrinsic=.true., &
           description=var_str ('Logical variable that let the user decide ' // &
           'whether the possibility of a beam decay is treated as a fatal ' // &
           'error or only as a warning. An example is a process $b t \to ' // &
           'X$, where the bottom quark as an inital state particle appears ' // &
           'as a possible decay product of the second incoming particle, ' // &
           'the top quark. This might trigger inconsistencies or instabilities ' // &
           'in the phase space set-up.'))
     call var_list%append_log (var_str ("?helicity_selection_active"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether \whizard\ uses ' // &
           'a numerical selection rule for vanishing helicities: if active, ' // &
           'then, if a certain helicity combination yields an absolute ' // &
           '(\oMega) matrix element smaller than a certain threshold ($\to$ ' // &
           '\ttt{helicity\_selection\_threshold}) more often than a certain ' // &
           'cutoff ($\to$ \ttt{helicity\_selection\_cutoff}), it will be dropped.'))
     call var_list%append_real (var_str ("helicity_selection_threshold"), &
           1E10_default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that gives the threshold ' // &
           'for the absolute value of a certain helicity combination of ' // &
           'an (\oMega) amplitude. If a certain number ($\to$ ' // &
           '\ttt{helicity\_selection\_cutoff}) of calls stays below this ' // &
           'threshold, that combination will be dropped from then on. (cf. ' // &
           'also \ttt{?helicity\_selection\_active})'))
     call var_list%append_int (var_str ("helicity_selection_cutoff"), 1000, &
           intrinsic=.true., &
           description=var_str ('Integer parameter that gives the number ' // &
           "a certain helicity combination of an (\oMega) amplitude has " // &
           'to be below a certain threshold ($\to$ \ttt{helicity\_selection\_threshold}) ' // &
           'in order to be dropped from then on. (cf. also \ttt{?helicity\_selection\_active})'))
     call var_list%append_string (var_str ("$rng_method"), var_str ("tao"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows to set the ' // &
           'method for the random number generation. Default is Donald ' // &
           "Knuth' RNG method \ttt{TAO}."))
     call var_list%append_log (var_str ("?vis_diags"), .false., &
           intrinsic=.true., &
           description=var_str ('Logical variable that allows to give out ' // &
           "a Postscript or PDF file for the Feynman diagrams for a \oMega\ " // &
           'process.  (cf. \ttt{?vis\_diags\_color}).'))
     call var_list%append_log (var_str ("?vis_diags_color"), .false., &
           intrinsic=.true., &
           description=var_str ('Same as \ttt{?vis\_diags}, but switches ' // &
           'on color flow instead of Feynman diagram generation. (cf. \ttt{?vis\_diags}).'))
     call var_list%append_log (var_str ("?check_event_file"), .true., &
           intrinsic=.true., &
           description=var_str ('Setting this to false turns off all sanity ' // &
           'checks when reading a raw event file with previously generated ' // &
           'events.  Use this at your own risk; the program may return ' // &
           'wrong results or crash if data do not match. (cf. also \ttt{?check\_grid\_file}, ' // &
           '\ttt{?check\_phs\_file})'))
     call var_list%append_string (var_str ("$event_file_version"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('String variable that allows to set the ' // &
           'format version of the \whizard\ internal binary event format.'))
     call var_list%append_int (var_str ("n_events"), 0, &
           intrinsic=.true., &
           description=var_str ('This specifier \ttt{n\_events = {\em <num>}} ' // &
           'sets the number of events for the event generation of the processes ' // &
           'in the \sindarin\ input files. Note that WHIZARD itself chooses ' // &
           'the number from the \ttt{n\_events} or from the \ttt{luminosity} ' // &
           'specifier, whichever would give the larger number of events. ' // &
           'As this depends on the cross section under consideration, it ' // &
           'might be different for different processes in the process list.  ' // &
           '(cf. \ttt{luminosity}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
           '\ttt{?unweighted}, \ttt{event\_index\_offset})'))
     call var_list%append_int (var_str ("event_index_offset"), 0, &
           intrinsic=.true., &
           description=var_str ('The value ' // &
           '\ttt{event\_index\_offset = {\em <num>}} ' // &
           'initializes the event counter for a subsequent ' // &
           'event sample.  By default (value 0), the first event ' // &
           'gets index value 1, incrementing by one for each generated event ' // &
           'within a sample.  The event counter is initialized again ' // &
           'for each new sample (i.e., \ttt{integrate} command). ' // &
           'If events are read from file, and the ' // &
           'event file format supports event numbering, the event numbers ' // &
           'will be taken from file instead, and the value of ' // &
           '\ttt{event\_index\_offset} has no effect. ' // &
           '(cf. \ttt{luminosity}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
           '\ttt{?unweighted}, \ttt{n\_events})'))
     call var_list%append_log (var_str ("?unweighted"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that distinguishes between unweighted ' // &
           'and weighted event generation. (cf. also \ttt{simulate}, \ttt{n\_events}, ' // &
           '\ttt{luminosity}, \ttt{event\_index\_offset})'))
     call var_list%append_real (var_str ("safety_factor"), 1._default, &
           intrinsic=.true., &
           description=var_str ('This real variable \ttt{safety\_factor ' // &
           '= {\em <num>}} reduces the acceptance probability for unweighting.  ' // &
           'If greater than one, excess events become less likely, but ' // &
           'the reweighting efficiency also drops. (cf. \ttt{simulate}, \ttt{?unweighted})'))
     call var_list%append_log (var_str ("?negative_weights"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that tells \whizard\ to allow negative ' // &
           'weights in integration and simulation. (cf. also \ttt{simulate}, ' // &
           '\ttt{?unweighted})'))
     call var_list%append_log (var_str ("?resonance_history"), .false., &
           intrinsic=.true., &
           description=var_str ( &
           'The logical variable \texttt{?resonance\_history ' // &
           '= true/false} specifies whether during a simulation pass, ' // &
           'the event generator should try to reconstruct intermediate ' // &
           'resonances.  If activated, appropriate resonant subprocess ' // &
           'matrix element code will be automatically generated. '))
     call var_list%append_real (var_str ("resonance_on_shell_limit"), &
           4._default, &
           intrinsic=.true., &
           description=var_str ( &
           'The real variable \texttt{resonance\_on\_shell\_limit ' // &
           '= {\em <num>}} specifies the maximum relative distance from a ' // &
           'resonance peak, such that the kinematical configuration ' // &
           'can still be considered on-shell.  This is relevant only if ' // &
           '\texttt{?resonance\_history = true}.'))
     call var_list%append_real (var_str ("resonance_on_shell_turnoff"), &
           0._default, &
           intrinsic=.true., &
           description=var_str ( &
           'The real variable \texttt{resonance\_on\_shell\_turnoff ' // &
           '= {\em <num>}}, if positive, ' // &
           'controls the smooth transition from resonance-like ' // &
           'to background-like events.  The relative strength of a ' // &
           'resonance is reduced by a Gaussian with width given by this ' // &
           'variable.  In any case, events are treated as background-like ' // &
           'when the off-shellness is greater than ' // &
           '\texttt{resonance\_on\_shell\_limit}.  All of this applies ' // &
           'only if \texttt{?resonance\_history = true}.'))
     call var_list%append_real (var_str ("resonance_background_factor"), &
           1._default, &
           intrinsic=.true., &
           description=var_str ( &
           'The real variable \texttt{resonance\_background\_factor} ' // &
           'controls resonance insertion if a resonance ' // &
           'history applies to a particular event.  In determining '// &
           'whether event kinematics qualifies as resonant or non-resonant, ' //&
           'the non-resonant probability is multiplied by this factor ' // &
           'Setting the factor to zero removes the background ' // &
           'configuration as long as the kinematics qualifies as on-shell ' // &
           'as qualified by \texttt{resonance\_on\_shell\_limit}.'))
      call var_list%append_log (var_str ("?keep_beams"), .false., &
           intrinsic=.true., &
           description=var_str ('The logical variable \ttt{?keep\_beams ' // &
           '= true/false} specifies whether beam particles and beam remnants ' // &
           'are included when writing event files.  For example, in order ' // &
           'to read Les Houches accord event files into \pythia, no beam ' // &
           'particles are allowed.'))
     call var_list%append_log (var_str ("?keep_remnants"), .true., &
           intrinsic=.true., &
           description=var_str ('The logical variable \ttt{?keep\_beams ' // &
           '= true/false} is respected only if \ttt{?keep\_beams} is set.  ' // &
           'If \ttt{true}, beam remnants are tagged as outgoing particles ' // &
           'if they have been neither showered nor hadronized, i.e., have ' // &
           'no children.  If \ttt{false}, beam remnants are also included ' // &
           'in the event record, but tagged as unphysical.  Note that for ' // &
           'ISR and/or beamstrahlung spectra, the radiated photons are ' // &
           'considered as beam remnants.'))
     call var_list%append_log (var_str ("?recover_beams"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether the beam particles ' // &
           'should be reconstructed when reading event/rescanning files ' // &
           'into \whizard. (cf. \ttt{rescan}, \ttt{?update\_event}, \ttt{?update\_sqme}, ' // &
           '\newline \ttt{?update\_weight})'))
     call var_list%append_log (var_str ("?update_event"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether the events in ' // &
           'an event file should be rebuilt from the hard process when ' // &
           'reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // &
           '\ttt{?recover\_beams}, \ttt{?update\_sqme}, \ttt{?update\_weight})'))
     call var_list%append_log (var_str ("?update_sqme"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whehter the squared ' // &
           'matrix element in an event file should be updated/recalculated ' // &
           'when reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // &
           '\newline \ttt{?recover\_beams}, \ttt{?update\_event}, \ttt{?update\_weight})'))
     call var_list%append_log (var_str ("?update_weight"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether the weights ' // &
           'in an event file should be updated/recalculated when reading ' // &
           'event/rescanning files into \whizard. (cf. \ttt{rescan}, \ttt{?recover\_beams}, ' // &
           '\newline \ttt{?update\_event}, \ttt{?update\_sqme})'))
     call var_list%append_log (var_str ("?use_alphas_from_file"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether the current ' // &
           '$\alpha_s$ definition should be used when recalculating matrix ' // &
           'elements for events read from file, or the value that is stored ' // &
           'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // &
           '\ttt{?use\_scale\_from\_file})'))
     call var_list%append_log (var_str ("?use_scale_from_file"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether the current ' // &
           'energy-scale expression should be used when recalculating matrix ' // &
           'elements for events read from file, or the value that is stored ' // &
           'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // &
           '\ttt{?use\_alphas\_from\_file})'))
     call var_list%append_log (var_str ("?allow_decays"), .true., &
           intrinsic=.true., &
           description=var_str ('Master flag to switch on cascade decays ' // &
           'for final state particles as an event transform. As a default, ' // &
           'it is switched on. (cf. also \ttt{?auto\_decays}, ' // &
           '\ttt{auto\_decays\_multiplicity}, \ttt{?auto\_decays\_radiative}, ' // &
           '\ttt{?decay\_rest\_frame})'))
     call var_list%append_log (var_str ("?auto_decays"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag, particularly as optional argument of the ($\to$) ' // &
           '\ttt{unstable} command, that tells \whizard\ to automatically ' // &
           'determine the decays of that particle up to the final state ' // &
           'multplicity ($\to$) \ttt{auto\_decays\_multiplicity}. Depending ' // &
           'on the flag ($\to$) \ttt{?auto\_decays\_radiative}, radiative ' // &
           'decays will be taken into account or not. (cf. also \ttt{unstable}, ' // &
           '\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay})'))
     call var_list%append_int (var_str ("auto_decays_multiplicity"), 2, &
           intrinsic=.true., &
           description=var_str ('Integer parameter, that sets -- ' // &
           'for the ($\to$) \ttt{?auto\_decays} option to let \whizard\ ' // &
           'automatically determine the decays of a particle set as ($\to$) ' // &
           '\ttt{unstable} -- the maximal final state multiplicity that ' // &
           'is taken into account. The default is \ttt{2}. The flag \ttt{?auto\_decays\_radiative} ' // &
           'decides whether radiative decays are taken into account. (cf.\ ' // &
           'also \ttt{unstable}, \ttt{?auto\_decays})'))
     call var_list%append_log (var_str ("?auto_decays_radiative"), .false., &
           intrinsic=.true., &
           description=var_str ("If \whizard's automatic detection " // &
           'of decay channels are switched on ($\to$ \ttt{?auto\_decays} ' // &
           'for the ($\to$) \ttt{unstable} command, this flags decides ' // &
           'whether radiative decays (e.g. containing additional photon(s)/gluon(s)) ' // &
           'are taken into account or not. (cf. also \ttt{unstable}, \ttt{auto\_decays\_multiplicity})'))
     call var_list%append_log (var_str ("?decay_rest_frame"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that allows to force a particle decay ' // &
           'to be simulated in its rest frame.  This simplifies the calculation ' // &
           'for decays as stand-alone processes, but makes the process ' // &
           'unsuitable for use in a decay chain.'))
     call var_list%append_log (var_str ("?isotropic_decay"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that -- in case of using factorized ' // &
           'production and decays using the ($\to$) \ttt{unstable} command ' // &
           '-- tells \whizard\ to switch off spin correlations completely ' // &
           '(isotropic decay). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // &
           '\ttt{decay\_helicity}, \ttt{?diagonal\_decay})'))
     call var_list%append_log (var_str ("?diagonal_decay"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that -- in case of using factorized ' // &
           'production and decays using the ($\to$) \ttt{unstable} command ' // &
           '-- tells \whizard\ instead of full spin correlations to take ' // &
           'only the diagonal entries in the spin-density matrix (i.e. ' // &
           'classical spin correlations). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // &
           '\ttt{decay\_helicity}, \ttt{?isotropic\_decay})'))
     call var_list%append_int (var_str ("decay_helicity"), &
           intrinsic=.true., &
           description=var_str ('If this parameter is given an integer ' // &
           'value, any particle decay triggered by a subsequent \ttt{unstable} ' // &
           'declaration will receive a projection on the given helicity ' // &
           'state for the unstable particle.  (cf. also \ttt{unstable}, ' // &
           '\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay}.  The latter ' // &
           'parameters, if true, take precdence over any \ttt{?decay\_helicity} setting.)'))
     call var_list%append_log (var_str ("?polarized_events"), .false., &
             intrinsic=.true., &
             description=var_str ('Flag that allows to select certain helicity ' // &
             'combinations in final state particles in the event files, ' // &
             'and perform analysis on polarized event samples. (cf. also ' // &
             '\ttt{simulate}, \ttt{polarized}, \ttt{unpolarized})'))
     call var_list%append_string (var_str ("$polarization_mode"), &
          var_str ("helicity"), &
          intrinsic=.true., &
          description=var_str ('String variable that specifies the mode in ' // &
          'which the polarization of particles is handled when polarized events ' // &
          'are written out. Possible options are \ttt{"ignore"}, \ttt{"helicity"}, ' // &
          '\ttt{"factorized"}, and \ttt{"correlated"}. For more details cf. the ' // &
          'detailed section.'))
     call var_list%append_log (var_str ("?colorize_subevt"), .false., &
             intrinsic=.true., &
             description=var_str ('Flag that enables color-index tracking ' // &
             'in the subevent (\ttt{subevt}) objects that are used for ' // &
             'internal event analysis.'))
     call var_list%append_real (var_str ("tolerance"), 0._default, &
           intrinsic=.true., &
           description=var_str ('Real variable that defines the absolute ' // &
           'tolerance with which the (logical) function \ttt{expect} accepts ' // &
           'equality or inequality: \ttt{tolerance = {\em <num>}}. This ' // &
           'can e.g. be used for cross-section tests and backwards compatibility ' // &
           'checks.  (cf. also \ttt{expect})'))
     call var_list%append_int (var_str ("checkpoint"), 0, &
          intrinsic = .true., &
          description=var_str ('Setting this integer variable to a positive ' // &
          'integer $n$ instructs simulate to print out a progress summary ' // &
          'every $n$ events.'))
     call var_list%append_int (var_str ("event_callback_interval"), 0, &
          intrinsic = .true., &
          description=var_str ('Setting this integer variable to a positive ' // &
          'integer $n$ instructs simulate to print out a progress summary ' // &
          'every $n$ events.'))
     call var_list%append_log (var_str ("?pacify"), .false., &
          intrinsic=.true., &
          description=var_str ('Flag that allows to suppress numerical ' // &
          'noise and give screen and log file output with a lower number ' // &
          'of significant digits. Mainly for debugging purposes. (cf. also ' // &
          '\ttt{?sample\_pacify})'))
     call var_list%append_string (var_str ("$out_file"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('This character variable allows to specify ' // &
           'the name of the data file to which the histogram and plot data ' // &
           'are written (cf. also \ttt{write\_analysis}, \ttt{open\_out}, ' // &
           '\ttt{close\_out})'))
     call var_list%append_log (var_str ("?out_advance"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that sets advancing in the \ttt{printf} ' // &
           'output commands, i.e. continuous printing with no line feed ' // &
           'etc. (cf. also \ttt{printf})'))
      !!! JRR: WK please check (#542)
 !     call var_list%append_log (var_str ("?out_custom"), .false., &
 !           intrinsic=.true.)
 !     call var_list%append_string (var_str ("$out_comment"), var_str ("# "), &
 !           intrinsic=.true.)
 !     call var_list%append_log (var_str ("?out_header"), .true., &
 !           intrinsic=.true.)
 !     call var_list%append_log (var_str ("?out_yerr"), .true., &
 !           intrinsic=.true.)
 !     call var_list%append_log (var_str ("?out_xerr"), .true., &
 !           intrinsic=.true.)
     call var_list%append_int (var_str ("real_range"), &
          range (real_specimen), intrinsic = .true., locked = .true., &
          description=var_str ('This integer gives the decimal exponent ' // &
          'range of the numeric model for the real float type in use. It cannot ' // &
          'be set by the user. (cf. also \ttt{real\_precision}, ' // &
          '\ttt{real\_epsilon}, \ttt{real\_tiny}).'))
     call var_list%append_int (var_str ("real_precision"), &
          precision (real_specimen), intrinsic = .true., locked = .true., &
          description=var_str ('This integer gives the precision of ' // &
          'the numeric model for the real float type in use. It cannot ' // &
          'be set by the user. (cf. also \ttt{real\_range}, ' // &
          '\ttt{real\_epsilon}, \ttt{real\_tiny}).'))
     call var_list%append_real (var_str ("real_epsilon"), &
          epsilon (real_specimen), intrinsic = .true., locked = .true., &
          description=var_str ('This gives the smallest number $E$ ' // &
          'of the same kind as the float type for which $1 + E > 1$. ' // &
          'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // &
          '\ttt{real\_tiny}, \ttt{real\_precision}).'))
     call var_list%append_real (var_str ("real_tiny"), &
          tiny (real_specimen), intrinsic = .true., locked = .true., &
          description=var_str ('This gives the smallest positive (non-zero) ' // &
          'number in the numeric model for the real float type in use. ' // &
          'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // &
          '\ttt{real\_epsilon}, \ttt{real\_precision}).'))
   end subroutine var_list_set_core_defaults
 
 @ %def var_list_set_core_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_integration_defaults => var_list_set_integration_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_integration_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_string (var_str ("$integration_method"), var_str ("vamp"), &
           intrinsic=.true., &
           description=var_str ('This string variable specifies the method ' // &
           'for performing the multi-dimensional phase-space integration. ' // &
           'The default is the \vamp\ algorithm (\ttt{"vamp"}), other options ' // &
           'are via the numerical midpoint rule (\ttt{"midpoint"}) or an ' // &
           'alternate \vamptwo\ implementation that is MPI-parallelizable ' // &
           '(\ttt{"vamp2"}).'))
     call var_list%append_int (var_str ("threshold_calls"), 10, &
           intrinsic=.true., &
           description=var_str ('This integer variable gives a limit for ' // &
           'the number of calls in a given channel which acts as a lower ' // &
           'threshold for the channel weight. If the number of calls in ' // &
           'that channel falls below this threshold, the weight is not ' // &
           'lowered further but kept at this threshold. (cf. also ' // &
           '\ttt{channel\_weights\_power})'))
     call var_list%append_int (var_str ("min_calls_per_channel"), 10, &
           intrinsic=.true., &
           description=var_str ('Integer parameter that modifies the settings ' // &
           "of the \vamp\ integrator's grid parameters. It sets the minimal " // &
           'number every channel must be called. If the number of calls ' // &
           'from the iterations is too small, \whizard\ will automatically ' // &
           'increase the number of calls. (cf. \ttt{iterations}, \ttt{min\_calls\_per\_bin}, ' // &
           '\ttt{min\_bins}, \ttt{max\_bins})'))
     call var_list%append_int (var_str ("min_calls_per_bin"), 10, &
           intrinsic=.true., &
           description=var_str ('Integer parameter that modifies the settings ' // &
           "of the \vamp\ integrator's grid parameters. It sets the minimal " // &
           'number every bin in an integration dimension must be called. ' // &
           'If the number of calls from the iterations is too small, \whizard\ ' // &
           'will automatically increase the number of calls. (cf. \ttt{iterations}, ' // &
           '\ttt{min\_calls\_per\_channel}, \ttt{min\_bins}, \ttt{max\_bins})'))
     call var_list%append_int (var_str ("min_bins"), 3, &
           intrinsic=.true., &
           description=var_str ('Integer parameter that modifies the settings ' // &
           "of the \vamp\ integrator's grid parameters. It sets the minimal " // &
           'number of bins per integration dimension. (cf. \ttt{iterations}, ' // &
           '\ttt{max\_bins}, \ttt{min\_calls\_per\_channel}, \ttt{min\_calls\_per\_bin})'))
     call var_list%append_int (var_str ("max_bins"), 20, &
           intrinsic=.true., &
           description=var_str ('Integer parameter that modifies the settings ' // &
           "of the \vamp\ integrator's grid parameters. It sets the maximal " // &
           'number of bins per integration dimension. (cf. \ttt{iterations}, ' // &
           '\ttt{min\_bins}, \ttt{min\_calls\_per\_channel}, \ttt{min\_calls\_per\_bin})'))
     call var_list%append_log (var_str ("?stratified"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that switches between stratified ' // &
           'and importance sampling for the \vamp\ integration method.'))
     call var_list%append_log (var_str ("?use_vamp_equivalences"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether equivalence ' // &
           'relations (symmetries) between different integration channels ' // &
           'are used by the \vamp\ integrator.'))
     call var_list%append_log (var_str ("?vamp_verbose"), .false., &
          intrinsic=.true., &
          description=var_str ('Flag that sets the chattiness of the \vamp\ ' // &
          'integrator. If set, not only errors, but also all warnings and ' // &
          'messages will be written out (not the default). (cf. also \newline ' // &
          '\ttt{?vamp\_history\_global}, \ttt{?vamp\_history\_global\_verbose}, ' // &
          '\ttt{?vamp\_history\_channels}, \newline \ttt{?vamp\_history\_channels\_verbose})'))
     call var_list%append_log (var_str ("?vamp_history_global"), &
          .true., intrinsic=.true., &
          description=var_str ('Flag that decides whether the global history ' // &
          'of the grid adaptation of the \vamp\ integrator are written ' // &
          'into the process logfiles.  (cf. also \ttt{?vamp\_history\_global\_verbose}, ' // &
          '\ttt{?vamp\_history\_channels}, \ttt{?vamp\_history\_channels\_verbose}, ' // &
          '\ttt{?vamp\_verbose})'))
     call var_list%append_log (var_str ("?vamp_history_global_verbose"), &
          .false., intrinsic=.true., &
          description=var_str ('Flag that decides whether the global history ' // &
          'of the grid adaptation of the \vamp\ integrator are written ' // &
          'into the process logfiles in an extended version. Only for debugging ' // &
          'purposes.  (cf. also \ttt{?vamp\_history\_global}, \ttt{?vamp\_history\_channels}, ' // &
          '\ttt{?vamp\_verbose}, \ttt{?vamp\_history\_channels\_verbose})'))
     call var_list%append_log (var_str ("?vamp_history_channels"), &
          .false., intrinsic=.true., &
          description=var_str ('Flag that decides whether the history of ' // &
          'the grid adaptation of the \vamp\ integrator for every single ' // &
          'channel are written into the process logfiles. Only for debugging ' // &
          'purposes.  (cf. also \ttt{?vamp\_history\_global\_verbose}, ' // &
          '\ttt{?vamp\_history\_global}, \ttt{?vamp\_verbose}, \newline ' // &
          '\ttt{?vamp\_history\_channels\_verbose})'))
     call var_list%append_log (var_str ("?vamp_history_channels_verbose"), &
          .false., intrinsic=.true., &
          description=var_str ('Flag that decides whether the history of ' // &
          'the grid adaptation of the \vamp\ integrator for every single ' // &
          'channel are written into the process logfiles in an extended ' // &
          'version. Only for debugging purposes.  (cf. also \ttt{?vamp\_history\_global}, ' // &
          '\ttt{?vamp\_history\_channels}, \ttt{?vamp\_verbose}, \ttt{?vamp\_history\_global\_verbose})'))
     call var_list%append_string (var_str ("$run_id"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('String variable \ttt{\$run\_id = "{\em ' // &
           '<id>}"} that allows to set a special ID for a particular process ' // &
           'run, e.g. in a scan. The run ID is then attached to the process ' // &
           'log file: \newline \ttt{{\em <proc\_name>}\_{\em <proc\_comp>}.{\em ' // &
           '<id>}.log}, the \vamp\ grid file: \newline \ttt{{\em <proc\_name>}\_{\em ' // &
           '<proc\_comp>}.{\em <id>}.vg}, and the phase space file: \newline ' // &
           '\ttt{{\em <proc\_name>}\_{\em <proc\_comp>}.{\em <id>}.phs}. ' // &
           'The run ID string distinguishes among several runs for the ' // &
           'same process.  It identifies process instances with respect ' // &
           'to adapted integration grids and similar run-specific data.  ' // &
           'The run ID is kept when copying processes for creating instances, ' // &
           'however, so it does not distinguish event samples. (cf.\ also ' // &
           '\ttt{\$job\_id}, \ttt{\$compile\_workspace}'))
     call var_list%append_int (var_str ("n_calls_test"), 0, &
           intrinsic=.true., &
           description=var_str ('Integer variable that allows to set a ' // &
           'certain number of matrix element sampling test calls without ' // &
           'actually integrating the process under consideration. (cf. ' // &
           '\ttt{integrate})'))
     call var_list%append_log (var_str ("?integration_timer"), .true., &
           intrinsic=.true., &
           description=var_str ('This flag switches the integration timer ' // &
           'on and off, that gives the estimate for the duration of the ' // &
           'generation of 10,000 unweighted events for each integrated ' // &
           'process.'))
     call var_list%append_log (var_str ("?check_grid_file"), .true., &
           intrinsic=.true., &
           description=var_str ('Setting this to false turns off all sanity ' // &
           'checks when reading a grid file with previous integration data.  ' // &
           'Use this at your own risk; the program may return wrong results ' // &
           'or crash if data do not match. (cf. also \ttt{?check\_event\_file}, \ttt{?check\_phs\_file}) '))
     call var_list%append_real (var_str ("accuracy_goal"), 0._default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that allows the user to ' // &
           'set a minimal accuracy that should be achieved in the Monte-Carlo ' // &
           'integration of a certain process. If that goal is reached, ' // &
           'grid and weight adapation stop, and this result is used for ' // &
           'simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // &
           '\ttt{error\_goal}, \ttt{relative\_error\_goal}, ' // &
           '\ttt{error\_threshold})'))
     call var_list%append_real (var_str ("error_goal"), 0._default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that allows the user to ' // &
           'set a minimal absolute error that should be achieved in the ' // &
           'Monte-Carlo integration of a certain process. If that goal ' // &
           'is reached, grid and weight adapation stop, and this result ' // &
           'is used for simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // &
           '\ttt{accuracy\_goal}, \ttt{relative\_error\_goal}, \ttt{error\_threshold})'))
     call var_list%append_real (var_str ("relative_error_goal"), 0._default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that allows the user to ' // &
           'set a minimal relative error that should be achieved in the ' // &
           'Monte-Carlo integration of a certain process. If that goal ' // &
           'is reached, grid and weight adaptation stop, and this result ' // &
           'is used for simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // &
           '\ttt{accuracy\_goal}, \ttt{error\_goal}, \ttt{error\_threshold})'))
     call var_list%append_int (var_str ("integration_results_verbosity"), 1, &
           intrinsic=.true., &
           description=var_str ('Integer parameter for the verbosity of ' // &
           'the integration results in the process-specific logfile.'))
     call var_list%append_real (var_str ("error_threshold"), &
          0._default, intrinsic=.true., &
          description=var_str ('The real parameter \ttt{error\_threshold ' // &
          '= {\em <num>}} declares that any error value (in absolute numbers) ' // &
          'smaller than \ttt{{\em <num>}} is to be considered zero. The ' // &
          'units are \ttt{fb} for scatterings and \ttt{GeV} for decays. ' // &
          '(cf. also \ttt{integrate}, \ttt{iterations}, \ttt{accuracy\_goal}, ' // &
          '\ttt{error\_goal}, \ttt{relative\_error\_goal})'))
     call var_list%append_real (var_str ("channel_weights_power"), 0.25_default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that allows to vary the ' // &
           'exponent of the channel weights for the \vamp\ integrator.'))
     call var_list%append_string (var_str ("$integrate_workspace"), &
           intrinsic=.true., &
           description=var_str ('Character string that tells \whizard\ ' // &
           'the subdirectory where to find the run-specific phase-space ' // &
           'configuration and the \vamp\ and \vamptwo\ grid files. ' // &
           'If undefined (as per default), \whizard\ creates them and ' // &
           'searches for them in the ' // &
           'current directory.  (cf. also  \ttt{\$job\_id}, ' // &
           '\ttt{\$run\_id}, \ttt{\$compile\_workspace})'))
     call var_list%append_string (var_str ("$vamp_grid_format"), var_str ("ascii"), &
          intrinsic=.true., &
          description=var_str ('Character string that tells \whizard\ ' // &
          'the file format for \ttt{vamp2} to use for writing and reading ' // &
          'the configuration for the multi-channel integration setup and the ' // &
          '\vamptwo\ (only) grid data. The values can be \ttt{ascii} for a single ' // &
          'human-readable grid file with ending \ttt{.vg2} or \ttt{binary} for two files, ' // &
          'a human-readable header file with ending \ttt{.vg2} and binary file with ending ' // &
          '\ttt{.vgx2} storing the grid data.' // &
          'The main purpose of the binary format is to perform faster I/O, e.g. for HPC runs.' // &
          '\whizard\ can convert between the different file formats automatically.'))
   end subroutine var_list_set_integration_defaults
 
 @ %def var_list_set_integration_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_phase_space_defaults => var_list_set_phase_space_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_phase_space_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_string (var_str ("$phs_method"), var_str ("default"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows to choose ' // &
           'the phase-space parameterization method. The default is the ' // &
           '\ttt{"wood"} method that takes into account electroweak/BSM ' // &
           'resonances. Note that this might not be the best choice for ' // &
           '(pure) QCD amplitudes. (cf. also \ttt{\$phs\_file})'))
     call var_list%append_log (var_str ("?vis_channels"), .false., &
           intrinsic=.true., &
           description=var_str ('Optional logical argument for the \ttt{integrate} ' // &
           'command that demands \whizard\ to generate a PDF or postscript ' // &
           'output showing the classification of the found phase space ' // &
           'channels (if the phase space method \ttt{wood} has been used) ' // &
           'according to their properties: \ttt{integrate (foo) \{ iterations=3:10000 ' // &
           '?vis\_channels = true \}}. The default is \ttt{false}.  (cf. ' // &
           'also \ttt{integrate}, \ttt{?vis\_history})'))
     call var_list%append_log (var_str ("?check_phs_file"), .true., &
           intrinsic=.true., &
           description=var_str ('Setting this to false turns off all sanity ' // &
           'checks when reading a previously generated phase-space configuration ' // &
           'file.  Use this at your own risk; the program may return wrong ' // &
           'results or crash if data do not match. (cf. also \ttt{?check\_event\_file}, ' // &
           '\ttt{?check\_grid\_file})'))
     call var_list%append_string (var_str ("$phs_file"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('This string variable allows the user to ' // &
           'set an individual file name for the phase space parameterization ' // &
           'for a particular process: \ttt{\$phs\_file = "{\em <file\_name>}"}. ' // &
           'If not set, the default is \ttt{{\em <proc\_name>}\_{\em <proc\_comp>}.{\em ' // &
           '<run\_id>}.phs}. (cf. also \ttt{\$phs\_method})'))
     call var_list%append_log (var_str ("?phs_only"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag (particularly as optional argument ' // &
           'of the $\to$ \ttt{integrate} command) that allows to only generate ' // &
           'the phase space file, but not perform the integration. (cf. ' // &
           'also \ttt{\$phs\_method}, \ttt{\$phs\_file})'))
     call var_list%append_real (var_str ("phs_threshold_s"), 50._default, &
           intrinsic=.true., &
           description=var_str ('For the phase space method \ttt{wood}, ' // &
           'this real parameter sets the threshold below which particles ' // &
           'are assumed to be massless in the $s$-channel like kinematic ' // &
           'regions. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_off\_shell}, ' // &
           '\ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, ' // &
           '\newline \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
           '\ttt{?phs\_step\_mapping\_exp}, \newline \ttt{?phs\_s\_mapping})'))
     call var_list%append_real (var_str ("phs_threshold_t"), 100._default, &
           intrinsic=.true., &
           description=var_str ('For the phase space method \ttt{wood}, ' // &
           'this real parameter sets the threshold below which particles ' // &
           'are assumed to be massless in the $t$-channel like kinematic ' // &
           'regions. (cf. also \ttt{phs\_threshold\_s}, \ttt{phs\_off\_shell}, ' // &
           '\ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, ' // &
           '\newline \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
           '\ttt{?phs\_step\_mapping\_exp}, \newline \ttt{?phs\_s\_mapping})'))
     call var_list%append_int (var_str ("phs_off_shell"), 2, &
           intrinsic=.true., &
           description=var_str ('Integer parameter that sets the number ' // &
           'of off-shell (not $t$-channel-like, non-resonant) lines that ' // &
           'are taken into account to find a valid phase-space setup in ' // &
           'the \ttt{wood} phase-space method.  (cf. also \ttt{phs\_threshold\_t}, ' // &
           '\ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, ' // &
           '\ttt{phs\_m\_scale}, \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
           '\ttt{?phs\_step\_mapping}, \newline \ttt{?phs\_step\_mapping\_exp}, ' // &
           '\ttt{?phs\_s\_mapping})'))
     call var_list%append_int (var_str ("phs_t_channel"), 6, &
           intrinsic=.true., &
           description=var_str ('Integer parameter that sets the number ' // &
           'of $t$-channel propagators in multi-peripheral diagrams that ' // &
           'are taken into account to find a valid phase-space setup in ' // &
           'the \ttt{wood} phase-space method.  (cf. also \ttt{phs\_threshold\_t}, ' // &
           '\ttt{phs\_threshold\_s}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // &
           '\ttt{phs\_m\_scale}, \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
           '\ttt{?phs\_step\_mapping}, \newline \ttt{?phs\_step\_mapping\_exp}, ' // &
           '\ttt{?phs\_s\_mapping})'))
     call var_list%append_real (var_str ("phs_e_scale"), 10._default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that sets the energy scale ' // &
           'that acts as a cutoff for parameterizing radiation-like kinematics ' // &
           'in the \ttt{wood} phase space method. \whizard\ takes the maximum ' // &
           'of this value and the width of the propagating particle as ' // &
           'a cutoff. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
           '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_m\_scale}, ' // &
           '\ttt{phs\_q\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
           '\ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})'))
     call var_list%append_real (var_str ("phs_m_scale"), 10._default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that sets the mass scale ' // &
           'that acts as a cutoff for parameterizing collinear and infrared ' // &
           'kinematics in the \ttt{wood} phase space method. \whizard\ ' // &
           'takes the maximum of this value and the mass of the propagating ' // &
           'particle as a cutoff. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
           '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell},  \ttt{phs\_e\_scale}, ' // &
           '\ttt{phs\_q\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
           '\ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})'))
     call var_list%append_real (var_str ("phs_q_scale"), 10._default, &
           intrinsic=.true., &
           description=var_str ('Real parameter that sets the momentum ' // &
           'transfer scale that acts as a cutoff for parameterizing $t$- ' // &
           'and $u$-channel like kinematics in the \ttt{wood} phase space ' // &
           'method. \whizard\ takes the maximum of this value and the mass ' // &
           'of the propagating particle as a cutoff. (cf. also \ttt{phs\_threshold\_t}, ' // &
           '\ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, \ttt{phs\_off\_shell},  ' // &
           '\ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
           '\ttt{?phs\_step\_mapping}, \ttt{?phs\_step\_mapping\_exp}, ' // &
           '\newline \ttt{?phs\_s\_mapping})'))
     call var_list%append_log (var_str ("?phs_keep_nonresonant"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether the \ttt{wood} ' // &
           'phase space method takes into account also non-resonant contributions.  ' // &
           '(cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
           '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_m\_scale}, ' // &
           '\ttt{phs\_q\_scale}, \ttt{phs\_e\_scale}, \ttt{?phs\_step\_mapping}, ' // &
           '\newline \ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})'))
     call var_list%append_log (var_str ("?phs_step_mapping"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that switches on (or off) a particular ' // &
           'phase space mapping for resonances, where the mass and width ' // &
           'of the resonance are explicitly set as channel cutoffs. (cf. ' // &
           'also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, ' // &
           '\ttt{phs\_off\_shell},  \ttt{phs\_e\_scale}, \newline \ttt{phs\_m\_scale}, ' // &
           '\ttt{?phs\_keep\_resonant}, \ttt{?phs\_q\_scale}, \ttt{?phs\_step\_mapping\_exp}, ' // &
           '\newline \ttt{?phs\_s\_mapping})'))
     call var_list%append_log (var_str ("?phs_step_mapping_exp"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that switches on (or off) a particular ' // &
           'phase space mapping for resonances, where the mass and width ' // &
           'of the resonance are explicitly set as channel cutoffs. This ' // &
           'is an exponential mapping in contrast to ($\to$) \ttt{?phs\_step\_mapping}. ' // &
           '(cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
           '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell},  \ttt{phs\_e\_scale}, ' // &
           '\ttt{phs\_m\_scale}, \newline \ttt{?phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
           '\ttt{?phs\_step\_mapping}, \ttt{?phs\_s\_mapping})'))
     call var_list%append_log (var_str ("?phs_s_mapping"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that allows special mapping for $s$-channel ' // &
           'resonances.  (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
           '\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell},  \ttt{phs\_e\_scale}, ' // &
           '\ttt{phs\_m\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_q\_scale}, ' // &
           '\ttt{?phs\_step\_mapping}, \ttt{?phs\_step\_mapping\_exp})'))
     call var_list%append_log (var_str ("?vis_history"), .false., &
           intrinsic=.true., &
           description=var_str ('Optional logical argument for the \ttt{integrate} ' // &
           'command that demands \whizard\ to generate a PDF or postscript ' // &
           'output showing the adaptation history of the Monte-Carlo integration ' // &
           'of the process under consideration. (cf. also \ttt{integrate}, ' // &
           '\ttt{?vis\_channels})'))
   end subroutine var_list_set_phase_space_defaults
 
 @ %def var_list_set_phase_space_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_gamelan_defaults => var_list_set_gamelan_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_gamelan_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_int (&
          var_str ("n_bins"), 20, &
          intrinsic=.true., &
          description=var_str ("Settings for \whizard's internal graphics " // &
          'output: integer value that sets the number of bins in histograms. ' // &
          '(cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // &
          '\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // &
          '\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{?y\_log}, ' // &
          '\ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, ' // &
          '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
          '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
          '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
          '\newline \ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
          '\ttt{\$symbol})'))
     call var_list%append_log (&
          var_str ("?normalize_bins"), .false., &
          intrinsic=.true., &
          description=var_str ("Settings for \whizard's internal graphics " // &
          'output: flag that determines whether the weights shall be normalized ' // &
          'to the bin width or not. (cf. also \ttt{n\_bins}, \ttt{\$obs\_label}, ' // &
          '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
          '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
          '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
          '\ttt{y\_max}, \ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
          '\newline \ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
          '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \newline ' // &
          '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
          '\ttt{\$err\_options})'))
     call var_list%append_string (var_str ("$obs_label"), var_str (""), &
          intrinsic=.true., &
          description=var_str ("Settings for \whizard's internal graphics " // &
          'output: this is a string variable \ttt{\$obs\_label = "{\em ' // &
          '<LaTeX\_Code>}"} that allows to attach a label to a plotted ' // &
          'or histogrammed observable. (cf. also \ttt{n\_bins}, \ttt{?normalize\_bins}, ' // &
          '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
          '\ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
          '\ttt{graph\_height\_mm}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
          '\ttt{y\_max}, \ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // &
          '\ttt{?draw\_histogram}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // &
          '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
          '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
     call var_list%append_string (var_str ("$obs_unit"), var_str (""), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: this is a string variable \ttt{\$obs\_unit = "{\em ' // &
           '<LaTeX\_Code>}"} that allows to attach a \LaTeX\ physical unit ' // &
           'to a plotted or histogrammed observable. (cf. also \ttt{n\_bins}, ' // &
           '\ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
           '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
           '\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{x\_min}, ' // &
           '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // &
           '\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \ttt{?draw\_curve}, ' // &
           '\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
           '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
     call var_list%append_string (var_str ("$title"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('This string variable sets the title of ' // &
           'a plot in a \whizard\ analysis setup, e.g. a histogram or an ' // &
           'observable. The syntax is \ttt{\$title = "{\em <your title>}"}. ' // &
           'This title appears as a section header in the analysis file, ' // &
           'but not in the screen output of the analysis.  (cf. also \ttt{n\_bins}, ' // &
           '\ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$description}, ' // &
           '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
           '\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{x\_min}, ' // &
           '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // &
           '\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \newline \ttt{?draw\_curve}, ' // &
           '\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
           '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
     call var_list%append_string (var_str ("$description"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('String variable that allows to specify ' // &
           'a description text for the analysis, \ttt{\$description = "{\em ' // &
           '<LaTeX analysis descr.>}"}.  This line appears below the title ' // &
           'of a corresponding analysis, on top of the respective plot.  ' // &
           '(cf. also \ttt{analysis}, \ttt{n\_bins}, \ttt{?normalize\_bins}, ' // &
           '\ttt{\$obs\_unit}, \ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, ' // &
           '\ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // &
           '\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \ttt{?draw\_curve}, ' // &
           '\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
           '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
     call var_list%append_string (var_str ("$x_label"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('String variable, \ttt{\$x\_label = "{\em ' // &
           '<LaTeX code>}"}, that sets the $x$ axis label in a plot or ' // &
           'histogram in a \whizard\ analysis.  (cf. also \ttt{analysis}, ' // &
           '\ttt{n\_bins}, \ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$y\_label}, ' // &
           '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
           '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // &
           '\ttt{?draw\_histogram}, \ttt{?fill\_curve}, \newline \ttt{?draw\_piecewise}, ' // &
           '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
           '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
     call var_list%append_string (var_str ("$y_label"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('String variable, \ttt{\$y\_label = "{\em ' // &
           '<LaTeX\_code>}"}, that sets the $y$ axis label in a plot or ' // &
           'histogram in a \whizard\ analysis.  (cf. also \ttt{analysis}, ' // &
           '\ttt{n\_bins}, \ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{?y\_log}, ' // &
           '\ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
           '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // &
           '\ttt{?draw\_histogram}, \ttt{?fill\_curve}, \newline \ttt{?draw\_piecewise}, ' // &
           '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
           '\newline \ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
     call var_list%append_int (var_str ("graph_width_mm"), 130, &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: integer value that sets the width of a graph or histogram ' // &
           'in millimeters. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
           '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
           '\ttt{\$y\_label}, \ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
           '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, \ttt{?draw\_base}, ' // &
           '\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
           '\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // &
           '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_int (var_str ("graph_height_mm"), 90, &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: integer value that sets the height of a graph or histogram ' // &
           'in millimeters. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
           '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
           '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
           '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, \ttt{?draw\_base}, ' // &
           '\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
           '\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // &
           '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_log (var_str ("?y_log"), .false., &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: flag that makes the $y$ axis logarithmic. (cf. also ' // &
           '\ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // &
           '\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // &
           '\ttt{graph\_height\_mm}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, ' // &
           '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
           '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
           '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // &
           '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
           '\ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
           '\ttt{\$symbol})'))
     call var_list%append_log (var_str ("?x_log"), .false., &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: flag that makes the $x$ axis logarithmic. (cf. also ' // &
           '\ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // &
           '\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // &
           '\ttt{graph\_height\_mm}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, ' // &
           '\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
           '\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
           '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // &
           '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
           '\ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
           '\ttt{\$symbol})'))
     call var_list%append_real (var_str ("x_min"),  &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: real parameter that sets the lower limit of the $x$ ' // &
           'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
           '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
           '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
           '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
           '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
           '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
           '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_real (var_str ("x_max"),  &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: real parameter that sets the upper limit of the $x$ ' // &
           'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
           '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
           '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
           '\ttt{x\_min}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
           '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
           '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
           '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_real (var_str ("y_min"),  &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: real parameter that sets the lower limit of the $y$ ' // &
           'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
           '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
           '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
           '\ttt{x\_max}, \ttt{y\_max}, \ttt{x\_min}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
           '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
           '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
           '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_real (var_str ("y_max"),  &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: real parameter that sets the upper limit of the $y$ ' // &
           'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
           '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
           '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
           '\ttt{x\_max}, \ttt{x\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
           '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
           '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
           '\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_string (var_str ("$gmlcode_bg"), var_str (""), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: string variable that allows to define a background ' // &
           'for plots and histograms (i.e. it is overwritten by the plot/histogram), ' // &
           'e.g. a grid: \ttt{\$gmlcode\_bg = "standardgrid.lr(5);"}. For ' // &
           'more details, see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // &
           '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
           '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
           '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
           '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // &
           '\ttt{?draw\_histogram}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
           '\newline \ttt{?fill\_curve}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // &
           '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, ' // &
           '\ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_string (var_str ("$gmlcode_fg"), var_str (""), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: string variable that allows to define a foreground ' // &
           'for plots and histograms (i.e. it overwrites the plot/histogram), ' // &
           'e.g. a grid: \ttt{\$gmlcode\_bg = "standardgrid.lr(5);"}. For ' // &
           'more details, see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // &
           '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
           '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
           '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
           '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{?draw\_histogram}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
           '\newline \ttt{?fill\_curve}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // &
           '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, ' // &
           '\ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_log (var_str ("?draw_histogram"), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: flag that tells \whizard\ to either plot data as a ' // &
           'histogram or as a continuous line (if $\to$ \ttt{?draw\_curve} ' // &
           'is set \ttt{true}). (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
           '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
           '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
           '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
           '\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
           '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
           '\ttt{\$symbol})'))
     call var_list%append_log (var_str ("?draw_base"), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: flag that tells \whizard\ to insert a \ttt{base} statement ' // &
           'in the analysis code to calculate the plot data from a data ' // &
           'set. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
           '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
           '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
           '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{?draw\_curve}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
           '\ttt{\$symbol}, \newline \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
           '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
           '\newline \ttt{\$err\_options})'))
     call var_list%append_log (var_str ("?draw_piecewise"), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: flag that tells \whizard\ to data from a data set piecewise, ' // &
           'i.e. histogram style. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
           '\ttt{\$obs\_unit},  \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
           '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max},  ' // &
           '\ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg},  ' // &
           '\ttt{?draw\_curve}, \ttt{?draw\_base}, \ttt{?fill\_curve}, ' // &
           '\ttt{\$symbol}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
           '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
           '\ttt{\$err\_options})'))
     call var_list%append_log (var_str ("?fill_curve"), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: flag that tells \whizard\ to fill data curves (e.g. ' // &
           'as a histogram). The style can be set with $\to$ \ttt{\$fill\_options ' // &
           '= "{\em <LaTeX\_code>}"}. (cf. also \ttt{?normalize\_bins}, ' // &
           '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
           '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
           '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
           '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, ' // &
           '\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
           '\ttt{?draw\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
           '\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
           '\ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_log (var_str ("?draw_curve"), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: flag that tells \whizard\ to either plot data as a ' // &
           'continuous line or as a histogram (if $\to$ \ttt{?draw\_histogram} ' // &
           'is set \ttt{true}). (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
           '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
           '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
           '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
           '\ttt{?draw\_histogram}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
           '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
           '\ttt{\$symbol})'))
     call var_list%append_log (var_str ("?draw_errors"), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: flag that determines whether error bars should be drawn ' // &
           'or not. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
           '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
           '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
           '\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // &
           '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // &
           '\ttt{?draw\_curve}, \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
           '\newline \ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_log (var_str ("?draw_symbols"), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: flag that determines whether particular symbols (specified ' // &
           'by $\to$ \ttt{\$symbol = "{\em <LaTeX\_code>}"}) should be ' // &
           'used for plotting data points  (cf. also \ttt{?normalize\_bins}, ' // &
           '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
           '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
           '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
           '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // &
           '\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
           '\ttt{?fill\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_curve}, ' // &
           '\ttt{?draw\_errors}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
           '\newline \ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_string (var_str ("$fill_options"), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: \ttt{\$fill\_options = "{\em <LaTeX\_code>}"} is a ' // &
           'string variable that allows to set fill options when plotting ' // &
           'data as filled curves with the $\to$ \ttt{?fill\_curve} flag. ' // &
           'For more details see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // &
           '\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
           '\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
           '\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
           '\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // &
           '\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
           '\ttt{?draw\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
           '\newline \ttt{?draw\_symbols}, \ttt{?fill\_curve}, \ttt{\$draw\_options}, ' // &
           '\ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_string (var_str ("$draw_options"), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: \ttt{\$draw\_options = "{\em <LaTeX\_code>}"} is a ' // &
           'string variable that allows to set specific drawing options ' // &
           'for plots and histograms. For more details see the \gamelan\ ' // &
           'manual. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
           '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
           '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
           '\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // &
           '\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // &
           '\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // &
           '\ttt{?draw\_histogram}, \ttt{\$err\_options}, \ttt{\$symbol})'))
     call var_list%append_string (var_str ("$err_options"), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: \ttt{\$err\_options = "{\em <LaTeX\_code>}"} is a string ' // &
           'variable that allows to set specific drawing options for errors ' // &
           'in plots and histograms. For more details see the \gamelan\ ' // &
           'manual. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
           '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
           '\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
           '\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // &
           '\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // &
           '\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
           '\ttt{?draw\_histogram}, \ttt{\$draw\_options}, \ttt{\$symbol})'))
     call var_list%append_string (var_str ("$symbol"), &
           intrinsic=.true., &
           description=var_str ("Settings for \whizard's internal graphics " // &
           'output: \ttt{\$symbol = "{\em <LaTeX\_code>}"} is a string ' // &
           'variable for the symbols that should be used for plotting data ' // &
           'points.  (cf. also \ttt{\$obs\_label}, \ttt{?normalize\_bins}, ' // &
           '\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
           '\ttt{\$y\_label}, \newline \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
           '\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
           '\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
           '\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
           '\newline \ttt{?draw\_histogram}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // &
           '\ttt{\$fill\_options}, \ttt{\$draw\_options}, \newline \ttt{\$err\_options}, ' // &
           '\ttt{?draw\_symbols})'))
     call var_list%append_log (&
          var_str ("?analysis_file_only"), .false., &
          intrinsic=.true., &
          description=var_str ('Allows to specify that only \LaTeX\ files ' // &
          "for \whizard's graphical analysis are written out, but not processed. " // &
          '(cf. \ttt{compile\_analysis}, \ttt{write\_analysis})'))
   end subroutine var_list_set_gamelan_defaults
 
 @ %def var_list_set_gamelan_defaults
 @ FastJet parameters and friends
 <<Variables: var list: TBP>>=
   procedure :: set_clustering_defaults => var_list_set_clustering_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_clustering_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_int (&
          var_str ("kt_algorithm"), &
          kt_algorithm, &
          intrinsic = .true., locked = .true., &
          description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
          '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
          'subevent function. At the moment only available for the ' // &
          'interfaced external \fastjet\ package.  (cf. also ' // &
          '\ttt{cambridge\_[for\_passive\_]algorithm}, ' // &
          '\ttt{plugin\_algorithm}, ' // &
          '\newline\ttt{genkt\_[for\_passive\_]algorithm}, ' // &
          '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})'))
     call var_list%append_int (&
          var_str ("cambridge_algorithm"), &
          cambridge_algorithm, intrinsic = .true., locked = .true., &
          description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
          '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
          'subevent function. At the moment only available for the interfaced ' // &
          'external \fastjet\ package.  (cf. also \ttt{kt\_algorithm}, ' // &
          '\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
          '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
          '\ttt{jet\_r})'))
     call var_list%append_int (&
          var_str ("antikt_algorithm"), &
          antikt_algorithm, &
          intrinsic = .true., locked = .true., &
          description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
          '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
          'subevent function. At the moment only available for the interfaced ' // &
          'external \fastjet\ package.  (cf. also \ttt{kt\_algorithm}, ' // &
          '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
          '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
          '\ttt{jet\_r})'))
     call var_list%append_int (&
          var_str ("genkt_algorithm"), &
          genkt_algorithm, &
          intrinsic = .true., locked = .true., &
          description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
          '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
          'subevent function. At the moment only available for the interfaced ' // &
          'external \fastjet\ package.  (cf. also \ttt{kt\_algorithm}, ' // &
          '\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
          '\ttt{genkt\_for\_passive\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
          '\ttt{jet\_r})'))
     call var_list%append_int (&
          var_str ("cambridge_for_passive_algorithm"), &
          cambridge_for_passive_algorithm, &
          intrinsic = .true., locked = .true., &
          description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
          '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
          'subevent function. At the moment only available for the interfaced ' // &
          'external \fastjet\ package.  (cf. also \ttt{kt\_algorithm}, ' // &
          '\ttt{cambridge\_algorithm}, \ttt{plugin\_algorithm}, \newline ' // &
          '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
          '\ttt{jet\_r})'))
     call var_list%append_int (&
          var_str ("genkt_for_passive_algorithm"), &
          genkt_for_passive_algorithm, &
          intrinsic = .true., locked = .true., &
          description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
          '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
          'subevent function. At the moment only available for the interfaced ' // &
          'external \fastjet\ package.  (cf. also \ttt{kt\_algorithm}, ' // &
          '\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
          '\ttt{genkt\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})'))
     call var_list%append_int (&
          var_str ("ee_kt_algorithm"), &
          ee_kt_algorithm, &
          intrinsic = .true., locked = .true., &
          description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
          '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
          'subevent function. At the moment only available for the interfaced ' // &
          'external \fastjet\ package.  (cf. also \ttt{kt\_algorithm}, ' // &
          '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
          '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_genkt\_algorithm}, ' // &
          '\ttt{jet\_r})'))
     call var_list%append_int (&
          var_str ("ee_genkt_algorithm"), &
          ee_genkt_algorithm, &
          intrinsic = .true., locked = .true., &
          description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
          '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
          'subevent function. At the moment only available for the interfaced ' // &
          'external \fastjet\ package.  (cf. also \ttt{kt\_algorithm}, ' // &
          '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
          '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_kt\_algorithm}, ' // &
          '\ttt{jet\_r})'))
     call var_list%append_int (&
          var_str ("plugin_algorithm"), &
          plugin_algorithm, &
          intrinsic = .true., locked = .true., &
          description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
          '\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
          'subevent function. At the moment only available for the interfaced ' // &
          'external \fastjet\ package.  (cf. also \ttt{kt\_algorithm}, ' // &
          '\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // &
          '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
          '\ttt{jet\_r})'))
     call var_list%append_int (&
          var_str ("undefined_jet_algorithm"), &
          undefined_jet_algorithm, &
          intrinsic = .true., locked = .true., &
          description=var_str ('This is just a place holder for any kind of jet ' // &
          'jet algorithm that is not further specified.  (cf. also \ttt{kt\_algorithm}, ' // &
          '\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // &
          '\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
          '\ttt{jet\_r}, \ttt{plugin\_algorithm})'))
     call var_list%append_int (&
          var_str ("jet_algorithm"), undefined_jet_algorithm, &
          intrinsic = .true., &
          description=var_str ('Variable that allows to set the type of ' // &
          'jet algorithm when using the external \fastjet\ library. It ' // &
          'accepts one of the following algorithms: ($\to$) \ttt{kt\_algorithm}, ' // &
          '\newline ($\to$) \ttt{cambridge\_[for\_passive\_]algorithm}, ' // &
          '($\to$) \ttt{antikt\_algorithm}, ($\to$) \ttt{plugin\_algorithm}, ' // &
          '($\to$) \ttt{genkt\_[for\_passive\_]algorithm}, ($\to$) ' // &
          '\ttt{ee\_[gen]kt\_algorithm}).  (cf. also \ttt{cluster}, ' // &
          '\ttt{jet\_p}, \ttt{jet\_r}, \ttt{jet\_ycut})'))
     call var_list%append_real (&
          var_str ("jet_r"), 0._default, &
          intrinsic = .true., &
          description=var_str ('Value for the distance measure $R$ used in ' // &
          'the (non-Cambridge) algorithms that are available via the interface ' // &
          'to the \fastjet\ package.  (cf. also \ttt{cluster}, \ttt{combine}, ' // &
          '\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // &
          '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
          '\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
          '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_ycut})'))
     call var_list%append_real (&
          var_str ("jet_p"), 0._default, &
          intrinsic = .true., &
          description=var_str ('Value for the exponent of the distance measure $R$ in ' // &
          'the generalized $k_T$ algorithms that are available via the interface ' // &
          'to the \fastjet\ package.  (cf. also \ttt{cluster}, \ttt{combine}, ' // &
          '\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // &
          '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
          '\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
          '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r}, \newline\ttt{jet\_ycut})'))
     call var_list%append_real (&
          var_str ("jet_ycut"), 0._default, &
          intrinsic = .true., &
          description=var_str ('Value for the $y$ separation measure used in ' // &
          'the Cambridge-Aachen algorithms that are available via the interface ' // &
          'to the \fastjet\ package.  (cf. also \ttt{cluster}, \ttt{combine}, ' // &
          '\ttt{kt\_algorithm}, \ttt{jet\_algorithm}, ' // &
          '\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
          '\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
          '\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_r})'))
     call var_list%append_log (&
          var_str ("?keep_flavors_when_clustering"), .false., &
          intrinsic = .true., &
          description=var_str ('The logical variable \ttt{?keep\_flavors\_when\_clustering ' // &
          '= true/false} specifies whether the flavor of a jet should be ' // &
          'kept during \ttt{cluster} when a jet consists of one quark and ' // &
          'zero or more gluons. Especially useful for cuts on b-tagged ' // &
          'jets (cf. also \ttt{cluster}).'))
   end subroutine var_list_set_clustering_defaults
 
 @ %def var_list_set_clustering_defaults
 @ Frixione isolation parameters and all that:
 <<Variables: var list: TBP>>=
   procedure :: set_isolation_defaults => var_list_set_isolation_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_isolation_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_real (var_str ("photon_iso_eps"), 1._default, &
          intrinsic=.true., &
          description=var_str ('Photon isolation parameter $\epsilon_\gamma$ ' // &
          '(energy fraction) from hep-ph/9801442 (cf. also ' // &
          '\ttt{photon\_iso\_n}, \ttt{photon\_iso\_r0})'))
     call var_list%append_real (var_str ("photon_iso_n"), 1._default, &
          intrinsic=.true., &
          description=var_str ('Photon isolation parameter $n$ ' // &
          '(cone function exponent) from hep-ph/9801442 (cf. also ' // &
          '\ttt{photon\_iso\_eps}, \ttt{photon\_iso\_r0})'))
     call var_list%append_real (var_str ("photon_iso_r0"), 0.4_default, &
          intrinsic=.true., &
          description=var_str ('Photon isolation parameter $R_0^\gamma$ ' // &
          '(isolation cone radius) from hep-ph/9801442 (cf. also ' // &
          '\ttt{photon\_iso\_eps}, \ttt{photon\_iso\_n})'))
   end subroutine var_list_set_isolation_defaults
 
 @ %def var_list_set_isolation_defaults
 <<Variables: var list: TBP>>=
   procedure :: set_eio_defaults => var_list_set_eio_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_eio_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_string (var_str ("$sample"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('String variable to set the (base) name ' // &
           'of the event output format, e.g. \ttt{\$sample = "foo"} will ' // &
           'result in an intrinsic binary format event file \ttt{foo.evx}. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{simulate}, \ttt{hepevt}, ' // &
           '\ttt{ascii}, \ttt{athena}, \ttt{debug}, \ttt{long}, \ttt{short}, ' // &
           '\ttt{hepmc}, \ttt{lhef}, \ttt{lha}, \ttt{stdhep}, \ttt{stdhep\_up}, ' // &
           '\ttt{\$sample\_normalization}, \ttt{?sample\_pacify}, \ttt{sample\_max\_tries})'))
     call var_list%append_string (var_str ("$sample_normalization"), var_str ("auto"),&
           intrinsic=.true., &
           description=var_str ('String variable that allows to set the ' // &
           'normalization of generated events. There are four options: ' // &
           'option \ttt{"1"} (events normalized to one), \ttt{"1/n"} (sum ' // &
           'of all events in a sample normalized to one), \ttt{"sigma"} ' // &
           '(events normalized to the cross section of the process), and ' // &
           '\ttt{"sigma/n"} (sum of all events normalized to the cross ' // &
           'section). The default is \ttt{"auto"} where unweighted events ' // &
           'are normalized to one, and weighted ones to the cross section. ' // &
           '(cf. also \ttt{simulate}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
           '\ttt{?sample\_pacify}, \ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt}, ' // &
           '\ttt{sample\_split\_n\_kbytes})'))
     call var_list%append_log (var_str ("?sample_pacify"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag, mainly for debugging purposes: suppresses ' // &
           'numerical noise in the output of a simulation. (cf. also \ttt{simulate}, ' // &
           '\ttt{\$sample}, \ttt{sample\_format}, \ttt{\$sample\_normalization}, ' // &
           '\ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt}, ' // &
           '\ttt{sample\_split\_n\_kbytes})'))
     call var_list%append_log (var_str ("?sample_select"), .true., &
           intrinsic=.true., &
           description=var_str ('Logical that determines whether a selection should ' // &
           'be applied to the output event format or not. If set to \ttt{false} a ' // &
           'selection is only considered for the evaluation of observables. (cf. ' // &
           '\ttt{select}, \ttt{selection}, \ttt{analysis})'))
     call var_list%append_int (var_str ("sample_max_tries"), 10000, &
          intrinsic = .true., &
          description=var_str ('Integer variable that sets the maximal ' // &
          'number of tries for generating a single event. The event might ' // &
          'be vetoed because of a very low unweighting efficiency, errors ' // &
          'in the event transforms like decays, shower, matching, hadronization ' // &
          'etc. (cf. also \ttt{simulate}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
          '\ttt{?sample\_pacify}, \ttt{\$sample\_normalization}, ' // &
          '\ttt{sample\_split\_n\_evt}, \newline\ttt{sample\_split\_n\_kbytes})'))
     call var_list%append_int (var_str ("sample_split_n_evt"), 0, &
          intrinsic = .true., &
          description=var_str ('When generating events, this integer parameter ' // &
          '\ttt{sample\_split\_n\_evt = {\em <num>}} gives the number \ttt{{\em ' // &
          '<num>}} of breakpoints in the event files, i.e. it splits the ' // &
          'event files into \ttt{{\em <num>} + 1} parts. The parts are ' // &
          'denoted by \ttt{{\em <proc\_name>}.{\em <split\_index>}.{\em ' // &
          '<evt\_extension>}}. Here, \ttt{{\em <split\_index>}} is an integer ' // &
          'running from \ttt{0} to \ttt{{\em <num>}}. The start can be ' // &
          'reset by ($\to$) \ttt{sample\_split\_index}. (cf. also \ttt{simulate}, ' // &
          '\ttt{\$sample}, \ttt{sample\_format}, \ttt{sample\_max\_tries}, ' // &
          '\ttt{\$sample\_normalization}, \ttt{?sample\_pacify}, ' // &
          '\ttt{sample\_split\_n\_kbytes})'))
     call var_list%append_int (var_str ("sample_split_n_kbytes"), 0, &
          intrinsic = .true., &
          description=var_str ('When generating events, this integer parameter ' // &
          '\ttt{sample\_split\_n\_kbytes = {\em <num>}} limits the file ' // &
          'size of event files.  Whenever an event file has exceeded this ' // &
          'size, counted in kilobytes, the following events will be written ' // &
          'to a new file.  The naming conventions are the same as for ' // &
          '\ttt{sample\_split\_n\_evt}. (cf. also \ttt{simulate}, \ttt{\$sample}, ' // &
          '\ttt{sample\_format}, \ttt{sample\_max\_tries}, \ttt{\$sample\_normalization}, ' // &
          '\ttt{?sample\_pacify})'))
     call var_list%append_int (var_str ("sample_split_index"), 0, &
          intrinsic = .true., &
          description=var_str ('Integer number that gives the starting ' // &
          'index \ttt{sample\_split\_index = {\em <split\_index>}} for ' // &
          'the numbering of event samples \ttt{{\em <proc\_name>}.{\em ' // &
          '<split\_index>}.{\em <evt\_extension>}} split by the \ttt{sample\_split\_n\_evt ' // &
          '= {\em <num>}}. The index runs from \ttt{{\em <split\_index>}} ' // &
          'to \newline \ttt{{\em <split\_index>} + {\em <num>}}. (cf. also \ttt{simulate}, ' // &
          '\ttt{\$sample}, \ttt{sample\_format}, \newline\ttt{\$sample\_normalization}, ' // &
          '\ttt{sample\_max\_tries}, \ttt{?sample\_pacify})'))
     call var_list%append_string (var_str ("$rescan_input_format"), var_str ("raw"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows to set the ' // &
           'event format of the event file that is to be rescanned by the ' // &
           '($\to$) \ttt{rescan} command.'))
     call var_list%append_log (var_str ("?read_raw"), .true., &
           intrinsic=.true., &
           description=var_str ('This flag demands \whizard\ to (try to) ' // &
           'read events (from the internal binary format) first before ' // &
           'generating new ones. (cf. \ttt{simulate}, \ttt{?write\_raw}, ' // &
           '\ttt{\$sample}, \ttt{sample\_format})'))
     call var_list%append_log (var_str ("?write_raw"), .true., &
           intrinsic=.true., &
           description=var_str ("Flag to write out events in \whizard's " // &
           'internal binary format. (cf. \ttt{simulate}, \ttt{?read\_raw}, ' // &
           '\ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_raw"), var_str ("evx"), &
          intrinsic=.true., &
          description=var_str ('String variable that allows via \ttt{\$extension\_raw ' // &
          '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
          "to which events in \whizard's internal format are written. If " // &
          'not set, the default file name and suffix is \ttt{{\em <process\_name>}.evx}. ' // &
          '(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_default"), var_str ("evt"), &
          intrinsic=.true., &
          description=var_str ('String variable that allows via \ttt{\$extension\_default ' // &
          '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
          'to which events in a the standard \whizard\ verbose ASCII format ' // &
          'are written. If not set, the default file name and suffix is ' // &
          '\ttt{{\em <process\_name>}.evt}. (cf. also \ttt{sample\_format}, ' // &
          '\ttt{\$sample})'))
     call var_list%append_string (var_str ("$debug_extension"), var_str ("debug"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$debug\_extension ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in a long verbose format with debugging information ' // &
           'are written. If not set, the default file name and suffix is ' // &
           '\ttt{{\em <process\_name>}.debug}. (cf. also \ttt{sample\_format}, ' // &
           '\ttt{\$sample}, \ttt{?debug\_process}, \ttt{?debug\_transforms}, ' // &
           '\ttt{?debug\_decay}, \ttt{?debug\_verbose})'))
     call var_list%append_log (var_str ("?debug_process"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether process information ' // &
           'will be displayed in the ASCII debug event format ($\to$) \ttt{debug}. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{\$debug\_extension}, ' // &
           '\ttt{?debug\_decay}, \ttt{?debug\_transforms}, \ttt{?debug\_verbose})'))
     call var_list%append_log (var_str ("?debug_transforms"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether information ' // &
           'about event transforms will be displayed in the ASCII debug ' // &
           'event format ($\to$) \ttt{debug}. (cf. also \ttt{sample\_format}, ' // &
           '\ttt{\$sample}, \ttt{?debug\_decay}, \ttt{\$debug\_extension}, ' // &
           '\ttt{?debug\_process}, \ttt{?debug\_verbose})'))
     call var_list%append_log (var_str ("?debug_decay"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether decay information ' // &
           'will be displayed in the ASCII debug event format ($\to$) \ttt{debug}. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{\$debug\_extension}, ' // &
           '\ttt{?debug\_process}, \ttt{?debug\_transforms}, \ttt{?debug\_verbose})'))
     call var_list%append_log (var_str ("?debug_verbose"), .true., &
           intrinsic=.true., &
           description=var_str ('Flag that decides whether extensive verbose ' // &
           'information will be included in the ASCII debug event format ' // &
           '($\to$) \ttt{debug}. (cf. also \ttt{sample\_format}, \ttt{\$sample}, ' // &
           '\ttt{\$debug\_extension}, \ttt{?debug\_decay}, \ttt{?debug\_transforms}, ' // &
           '\ttt{?debug\_process})'))
     call var_list%append_string (var_str ("$dump_extension"), var_str ("pset.dat"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$dump\_extension ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           "to which events in \whizard's internal particle set format " // &
           'are written. If not set, the default file name and suffix is ' // &
           '\ttt{{\em <process\_name>}.pset.dat}. (cf. also \ttt{sample\_format}, ' // &
           '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
           '\ttt{?dump\_screen}, \ttt{?dump\_summary}, \ttt{?dump\_weights})'))
     call var_list%append_log (var_str ("?dump_compressed"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that, if set to \ttt{true}, issues ' // &
           'a very compressed and clear version of the \ttt{dump} ($\to$) ' // &
           'event format. (cf. also \ttt{sample\_format}, ' // &
           '\ttt{\$sample}, \ttt{dump}, \ttt{\$dump\_extension},  ' // &
           '\ttt{?dump\_screen}, \ttt{?dump\_summary}, \ttt{?dump\_weights})'))
     call var_list%append_log (var_str ("?dump_weights"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that, if set to \ttt{true}, includes ' // &
           'cross sections, weights and excess in the \ttt{dump} ($\to$) ' // &
           'event format. (cf. also \ttt{sample\_format}, ' // &
           '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
           '\ttt{\$dump\_extension}, \ttt{?dump\_screen}, \ttt{?dump\_summary})'))
     call var_list%append_log (var_str ("?dump_summary"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that, if set to \ttt{true}, includes ' // &
           'a summary with momentum sums for incoming and outgoing particles ' // &
           'as well as for beam remnants in the \ttt{dump} ($\to$) ' // &
           'event format. (cf. also \ttt{sample\_format}, ' // &
           '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
           '\ttt{\$dump\_extension}, \ttt{?dump\_screen}, \ttt{?dump\_weights})'))
     call var_list%append_log (var_str ("?dump_screen"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag that, if set to \ttt{true}, outputs ' // &
           'events for the \ttt{dump} ($\to$) event format on screen ' // &
           ' instead of to a file. (cf. also \ttt{sample\_format}, ' // &
           '\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
           '\ttt{\$dump\_extension}, \ttt{?dump\_summary}, \ttt{?dump\_weights})'))
     call var_list%append_log (var_str ("?hepevt_ensure_order"), .false., &
           intrinsic=.true., &
           description=var_str ('Flag to ensure that the particle set confirms ' // &
           'the HEPEVT standard. This involves some copying and reordering ' // &
           'to guarantee that mothers and daughters are always next to ' // &
           'each other. Usually this is not necessary.'))
     call var_list%append_string (var_str ("$extension_hepevt"), var_str ("hepevt"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_hepevt ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the \whizard\ version 1 style HEPEVT ASCII ' // &
           'format are written. If not set, the default file name and suffix ' // &
           'is \ttt{{\em <process\_name>}.hepevt}. (cf. also \ttt{sample\_format}, ' // &
           '\ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_ascii_short"), &
           var_str ("short.evt"), intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_ascii\_short ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the so called short variant of the \whizard\ ' // &
           'version 1 style HEPEVT ASCII format are written. If not set, ' // &
           'the default file name and suffix is \ttt{{\em <process\_name>}.short.evt}. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_ascii_long"), &
           var_str ("long.evt"), intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_ascii\_long ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the so called long variant of the \whizard\ ' // &
           'version 1 style HEPEVT ASCII format are written. If not set, ' // &
           'the default file name and suffix is \ttt{{\em <process\_name>}.long.evt}. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_athena"), &
           var_str ("athena.evt"), intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_athena ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the ATHENA file format are written. If not ' // &
           'set, the default file name and suffix is \ttt{{\em <process\_name>}.athena.evt}. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_mokka"), &
            var_str ("mokka.evt"), intrinsic=.true., &
            description=var_str ('String variable that allows via \ttt{\$extension\_mokka ' // &
            '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
            'to which events in the MOKKA format are written. If not set, ' // &
            'the default file name and suffix is \ttt{{\em <process\_name>}.mokka.evt}. ' // &
            '(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_string (var_str ("$lhef_version"), var_str ("2.0"), &
          intrinsic = .true., &
          description=var_str ('Specifier for the Les Houches Accord (LHEF) ' // &
          'event format files with XML headers to discriminate among different ' // &
          'versions of this format.  (cf. also \ttt{\$sample}, \ttt{sample\_format}, ' // &
          '\ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // &
          '\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_ref}, ' // &
          '\ttt{?lhef\_write\_sqme\_alt})'))
     call var_list%append_string (var_str ("$lhef_extension"), var_str ("lhe"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$lhef\_extension ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the LHEF format are written. If not set, ' // &
           'the default file name and suffix is \ttt{{\em <process\_name>}.lhe}. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{lhef}, ' // &
           '\ttt{\$lhef\_extension}, \ttt{\$lhef\_version}, \ttt{?lhef\_write\_sqme\_prc}, ' // &
           '\ttt{?lhef\_write\_sqme\_ref}, \ttt{?lhef\_write\_sqme\_alt})'))
     call var_list%append_log (var_str ("?lhef_write_sqme_prc"), .true., &
          intrinsic = .true., &
          description=var_str ('Flag that decides whether in the ($\to$) ' // &
          '\ttt{lhef} event format the weights of the squared matrix element ' // &
          'of the corresponding process shall be written in the LHE file. ' // &
          '(cf. also \ttt{\$sample}, \ttt{sample\_format}, \ttt{lhef}, ' // &
          '\ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, \ttt{?lhef\_write\_sqme\_ref}, ' // &
          '\newline \ttt{?lhef\_write\_sqme\_alt})'))
     call var_list%append_log (var_str ("?lhef_write_sqme_ref"), .false., &
          intrinsic = .true., &
          description=var_str ('Flag that decides whether in the ($\to$) ' // &
          '\ttt{lhef} event format reference weights of the squared matrix ' // &
          'element shall be written in the LHE file. (cf. also \ttt{\$sample}, ' // &
          '\ttt{sample\_format}, \ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // &
          '\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_alt})'))
     call var_list%append_log (var_str ("?lhef_write_sqme_alt"), .true., &
          intrinsic = .true., &
          description=var_str ('Flag that decides whether in the ($\to$) ' // &
          '\ttt{lhef} event format alternative weights of the squared matrix ' // &
          'element shall be written in the LHE file. (cf. also \ttt{\$sample}, ' // &
          '\ttt{sample\_format}, \ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // &
          '\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_ref})'))
     call var_list%append_string (var_str ("$extension_lha"), var_str ("lha"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_lha ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the (deprecated) LHA format are written. ' // &
           'If not set, the default file name and suffix is \ttt{{\em <process\_name>}.lha}. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_hepmc"), var_str ("hepmc"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_hepmc ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the HepMC format are written. If not set, ' // &
           'the default file name and suffix is \ttt{{\em <process\_name>}.hepmc}. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_log (var_str ("?hepmc_output_cross_section"), .false., &
          intrinsic = .true., &
          description=var_str ('Flag for the HepMC event format that allows ' // &
          'to write out the cross section (and error) from the integration ' // &
          'together with each HepMC event. This can be used by programs ' // &
          'like Rivet to scale histograms according to the cross section. ' // &
          '(cf.  also \ttt{hepmc})'))
     call var_list%append_log (var_str ("?hepmc3_hepmc2mode"), .false., &
          intrinsic = .true., &
          description=var_str ('Flag for the HepMC event format that allows ' // &
          'to use HepMC3 to write in HepMC2 backwards compatibility mode.  ' // &
          'This option has no effect when HepMC2 is linked. ' // &
          '(cf.  also \ttt{hepmc})'))
     call var_list%append_string (var_str ("$extension_lcio"), var_str ("slcio"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_lcio ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the LCIO format are written. If not set, ' // &
           'the default file name and suffix is \ttt{{\em <process\_name>}.slcio}. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_stdhep"), var_str ("hep"), &
           intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_stdhep ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the StdHEP format via the HEPEVT common ' // &
           'block are written. If not set, the default file name and suffix ' // &
           'is \ttt{{\em <process\_name>}.hep}. (cf. also \ttt{sample\_format}, ' // &
           '\ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_stdhep_up"), &
           var_str ("up.hep"), intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_stdhep\_up ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the StdHEP format via the HEPRUP/HEPEUP ' // &
           'common blocks are written. \ttt{{\em <process\_name>}.up.hep} ' // &
           'is the default file name and suffix, if this variable not set. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_stdhep_ev4"), &
           var_str ("ev4.hep"), intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_stdhep\_ev4 ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the StdHEP format via the HEPEVT/HEPEV4 ' // &
           'common blocks are written. \ttt{{\em <process\_name>}.up.hep} ' // &
           'is the default file name and suffix, if this variable not set. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_hepevt_verb"), &
           var_str ("hepevt.verb"), intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_hepevt\_verb ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the \whizard\ version 1 style extended or ' // &
           'verbose HEPEVT ASCII format are written. If not set, the default ' // &
           'file name and suffix is \ttt{{\em <process\_name>}.hepevt.verb}. ' // &
           '(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
     call var_list%append_string (var_str ("$extension_lha_verb"), &
           var_str ("lha.verb"), intrinsic=.true., &
           description=var_str ('String variable that allows via \ttt{\$extension\_lha\_verb ' // &
           '= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
           'to which events in the (deprecated) extended or verbose LHA ' // &
           'format are written. If not set, the default file name and suffix ' // &
           'is \ttt{{\em <process\_name>}.lha.verb}. (cf. also \ttt{sample\_format}, ' // &
           '\ttt{\$sample})'))
   end subroutine var_list_set_eio_defaults
 
 @ %def var_list_set_eio_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_shower_defaults => var_list_set_shower_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_shower_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_log (var_str ("?allow_shower"), .true., &
          intrinsic=.true., &
          description=var_str ('Master flag to switch on (initial and ' // &
          'final state) parton shower, matching/merging as an event ' // &
          'transform. As a default, it is switched on. (cf. also \ttt{?ps\_ ' // &
          '....}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_log (var_str ("?ps_fsr_active"), .false., &
          intrinsic=.true., &
          description=var_str ('Flag that switches final-state QCD radiation ' // &
          '(FSR) on.  (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // &
          '\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_log (var_str ("?ps_isr_active"), .false., &
          intrinsic=.true., &
          description=var_str ('Flag that switches initial-state QCD ' // &
          'radiation (ISR) on.  (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
          '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_log (var_str ("?ps_taudec_active"), .false., &
             intrinsic=.true., &
             description=var_str ('Flag to switch on $\tau$ decays, at ' // &
             'the moment only via the included external package \ttt{TAUOLA} ' // &
             'and \ttt{PHOTOS}.  (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
             '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_log (var_str ("?muli_active"), .false., &
             intrinsic=.true., &
             description=var_str ("Master flag that switches on \whizard's " // &
             'module for multiple interaction with interleaved QCD parton ' // &
             'showers for hadron colliders. Note that this feature is still ' // &
             'experimental. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
             '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...})'))
     call var_list%append_string (var_str ("$shower_method"), var_str ("WHIZARD"), &
             intrinsic=.true., &
             description=var_str ('String variable that allows to specify ' // &
             'which parton shower is being used, the default, \ttt{"WHIZARD"}, ' // &
             'is one of the in-house showers of \whizard. Other possibilities ' // &
             'at the moment are only \ttt{"PYTHIA6"}.'))
     call var_list%append_log (var_str ("?shower_verbose"), .false., &
             intrinsic=.true., &
             description=var_str ('Flag to switch on verbose messages when ' // &
             'using shower and/or hadronization. (cf. also \ttt{?allow\_shower}, ' // &
             '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...},'))
     call var_list%append_string (var_str ("$ps_PYTHIA_PYGIVE"), var_str (""), &
           intrinsic=.true., &
           description=var_str ('String variable that allows to pass options ' // &
           'for tunes etc. to the attached \pythia\ parton shower or hadronization, ' // &
           'e.g.: \ttt{\$ps\_PYTHIA\_PYGIVE = "MSTJ(41)=1"}.  (cf. also ' // &
           '\newline \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
           '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_string (var_str ("$ps_PYTHIA8_config"), var_str (""), &
          intrinsic=.true., &
          description=var_str ('String variable that allows to pass options ' // &
          'for tunes etc. to the attached \pythia\ttt{8} parton shower or hadronization, ' // &
          'e.g.: \ttt{\$ps\_PYTHIA8\_config = "PartonLevel:MPI = off"}.  (cf. also ' // &
          '\newline \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
          '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_string (var_str ("$ps_PYTHIA8_config_file"), var_str (""), &
          intrinsic=.true., &
          description=var_str ('String variable that allows to pass a filename to a ' // &
          '\pythia\ttt{8} configuration file.'))
     call var_list%append_real (&
          var_str ("ps_mass_cutoff"), 1._default, intrinsic = .true., &
          description=var_str ('Real value that sets the QCD parton shower ' // &
          'lower cutoff scale, where hadronization sets in. (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (&
          var_str ("ps_fsr_lambda"), 0.29_default, intrinsic = .true., &
          description=var_str ('By this real parameter, the value of $\Lambda_{QCD}$ ' // &
          'used in running $\alpha_s$ for time-like showers is set (except ' // &
          'for showers in the decay of a resonance). (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (&
          var_str ("ps_isr_lambda"), 0.29_default, intrinsic = .true., &
          description=var_str ('By this real parameter, the value of $\Lambda_{QCD}$ ' // &
          'used in running $\alpha_s$ for space-like showers is set. (cf. ' // &
          'also \ttt{?allow\_shower}, \ttt{?ps\_   ...}, \ttt{\$ps\_ ...}, ' // &
          '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_int (&
          var_str ("ps_max_n_flavors"), 5, intrinsic = .true., &
          description=var_str ('This integer parameter sets the maxmimum ' // &
          'number of flavors that can be produced in a QCD shower $g\to ' // &
          'q\bar q$. It is also used as the maximal number of active flavors ' // &
          'for the running of $\alpha_s$ in the shower (with a minimum ' // &
          'of 3). (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
          '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_log (var_str ("?ps_isr_alphas_running"), .true., &
             intrinsic=.true., &
             description=var_str ('Flag that decides whether a running ' // &
             '$\alpha_s$ is taken in space-like QCD parton showers. (cf. ' // &
             'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
             '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_log (var_str ("?ps_fsr_alphas_running"), .true., &
             intrinsic=.true., &
             description=var_str ('Flag that decides whether a running ' // &
             '$\alpha_s$ is taken in time-like QCD parton showers. (cf. ' // &
             'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
             '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str ("ps_fixed_alphas"), &
          0._default, intrinsic = .true., &
          description=var_str ('This real parameter sets the value of $\alpha_s$ ' // &
          'if it is (cf. $\to$ \ttt{?ps\_isr\_alphas\_running}, \newline ' // &
          '\ttt{?ps\_fsr\_alphas\_running}) not running in initial and/or ' // &
          'final-state QCD showers.  (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
          '...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_log (var_str ("?ps_isr_pt_ordered"), .false., &
             intrinsic=.true., &
             description=var_str ('By this flag, it can be switched between ' // &
             'the analytic QCD ISR shower (\ttt{false}, default) and the ' // &
             '$p_T$ ISR QCD shower (\ttt{true}). (cf. also \ttt{?allow\_shower}, ' // &
             '\ttt{?ps\_   ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_log (var_str ("?ps_isr_angular_ordered"), .true., &
             intrinsic=.true., &
             description=var_str ('If switched one, this flag forces opening ' // &
             'angles of emitted partons in the QCD ISR shower to be strictly ' // &
             'ordered, i.e. increasing towards the hard interaction.  (cf. ' // &
             'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
             '\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("ps_isr_primordial_kt_width"), 0._default, intrinsic = .true., &
          description=var_str ('This real parameter sets the width $\sigma ' // &
          '= \braket{k_T^2}$ for the Gaussian primordial $k_T$ distribution ' // &
          'inside the hadron, given by: $\exp[-k_T^2/\sigma^2] k_T dk_T$.  ' // &
          '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_   ...}, \ttt{\$ps\_ ' // &
          '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("ps_isr_primordial_kt_cutoff"), 5._default, intrinsic = .true., &
          description=var_str ('Real parameter that sets the upper cutoff ' // &
          'for the primordial $k_T$ distribution inside a hadron.  (cf. ' // &
          'also \ttt{?allow\_shower}, \ttt{?ps\_   ...}, \ttt{\$ps\_ ...}, ' // &
          '\ttt{?hadronization\_active}, \ttt{?mlm\_ ...})'))
     call var_list%append_real (var_str &
          ("ps_isr_z_cutoff"), 0.999_default, intrinsic = .true., &
          description=var_str ('This real parameter allows to set the upper ' // &
          'cutoff on the splitting variable $z$ in space-like QCD parton ' // &
          'showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_   ...}, ' // &
          '\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("ps_isr_minenergy"), 1._default, intrinsic = .true., &
          description=var_str ('By this real parameter, the minimal effective ' // &
          'energy (in the c.m. frame) of a time-like or on-shell-emitted ' // &
          'parton in a space-like QCD shower is set. For a hard subprocess ' // &
          'that is not in the rest frame, this number is roughly reduced ' // &
          'by a boost factor $1/\gamma$ to the rest frame of the hard scattering ' // &
          'process.  (cf. also \ttt{?allow\_shower}, \ttt{?ps\_   ...}, ' // &
          '\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("ps_isr_tscalefactor"), 1._default, intrinsic = .true., &
          description=var_str ('The $Q^2$ scale of the hard scattering ' // &
          'process is multiplied by this real factor to define the maximum ' // &
          'parton virtuality allowed in time-like QCD showers. This does ' // &
          'only apply to $t$- and $u$-channels, while for $s$-channel resonances ' // &
          'the maximum virtuality is set by $m^2$.  (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_   ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_log (var_str &
          ("?ps_isr_only_onshell_emitted_partons"), .false., intrinsic=.true., &
          description=var_str ('This flag if set true sets all emitted ' // &
          'partons off space-like showers on-shell, i.e. it would not allow ' // &
          'associated time-like showers.  (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_   ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
   end subroutine var_list_set_shower_defaults
 
 @ %def var_list_set_shower_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_hadronization_defaults => var_list_set_hadronization_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_hadronization_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_log &
          (var_str ("?allow_hadronization"), .true., intrinsic=.true., &
          description=var_str ('Master flag to switch on hadronization ' // &
          'as an event transform. As a default, it is switched on. (cf. ' // &
          'also \ttt{?ps\_ ....}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, ' // &
          '\ttt{?hadronization\_active})'))
     call var_list%append_log &
          (var_str ("?hadronization_active"), .false., intrinsic=.true., &
          description=var_str ('Master flag to switch hadronization (through ' // &
          'the attached \pythia\ package) on or off. As a default, it is ' // &
          'off. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
          '...}, \ttt{?mlm\_ ...})'))
     call var_list%append_string &
          (var_str ("$hadronization_method"), var_str ("PYTHIA6"), intrinsic = .true., &
          description=var_str ("Determines whether \whizard's own " // &
          "hadronization or the (internally included) \pythiasix\ should be used."))
     call var_list%append_real &
          (var_str ("hadron_enhanced_fraction"), 0.01_default, intrinsic = .true., &
          description=var_str ('Fraction of Lund strings that break with enhanced ' // &
          'width. [not yet active]'))
     call var_list%append_real &
          (var_str ("hadron_enhanced_width"), 2.0_default, intrinsic = .true., &
          description=var_str ('Enhancement factor for the width of breaking ' // &
          'Lund strings. [not yet active]'))
   end subroutine var_list_set_hadronization_defaults
 
 @ %def var_list_set_hadronization_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_tauola_defaults => var_list_set_tauola_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_tauola_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_log (&
          var_str ("?ps_tauola_photos"), .false., intrinsic=.true., &
          description=var_str ('Flag to switch on \ttt{PHOTOS} for photon ' // &
          'showering inside the \ttt{TAUOLA} package.  (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
     call var_list%append_log (&
          var_str ("?ps_tauola_transverse"), .false., intrinsic=.true., &
          description=var_str ('Flag to switch transverse $\tau$ polarization ' // &
          'on or off for Higgs decays into $\tau$ leptons.  (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
     call var_list%append_log (&
          var_str ("?ps_tauola_dec_rad_cor"), .true., intrinsic=.true., &
          description=var_str ('Flag to switch radiative corrections for ' // &
          '$\tau$ decays in \ttt{TAUOLA} on or off.  (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
     call var_list%append_int (&
          var_str ("ps_tauola_dec_mode1"), 0, intrinsic = .true., &
          description=var_str ('Integer code to request a specific $\tau$ ' // &
          'decay within \ttt{TAUOLA} for the decaying $\tau$, and -- ' // &
          'in correlated decays -- for the second $\tau$. For more information ' // &
          'cf. the comments in the code or the \ttt{TAUOLA} manual.  ' // &
          '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
          '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
     call var_list%append_int (&
          var_str ("ps_tauola_dec_mode2"), 0, intrinsic = .true., &
          description=var_str ('Integer code to request a specific $\tau$ ' // &
          'decay within \ttt{TAUOLA} for the decaying $\tau$, and -- ' // &
          'in correlated decays -- for the second $\tau$. For more information ' // &
          'cf. the comments in the code or the \ttt{TAUOLA} manual.  ' // &
          '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
          '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
     call var_list%append_real (&
          var_str ("ps_tauola_mh"), 125._default, intrinsic = .true., &
          description=var_str ('Real option to set the Higgs mass for Higgs ' // &
          'decays into $\tau$ leptons in the interface to \ttt{TAUOLA}.  ' // &
          '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
          '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
     call var_list%append_real (&
          var_str ("ps_tauola_mix_angle"), 90._default, intrinsic = .true., &
          description=var_str ('Option to set the mixing angle between ' // &
          'scalar and pseudoscalar Higgs bosons for Higgs decays into $\tau$ ' // &
          'leptons in the interface to \ttt{TAUOLA}.  (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
     call var_list%append_log (&
          var_str ("?ps_tauola_pol_vector"), .false., intrinsic = .true., &
          description=var_str ('Flag to decide whether for transverse $\tau$ ' // &
          'polarization, polarization information should be taken from ' // &
          '\ttt{TAUOLA} or not.  The default is just based on random numbers.  ' // &
          '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
          '...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
   end subroutine var_list_set_tauola_defaults
 
 @ %def var_list_set_tauola_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_mlm_matching_defaults => var_list_set_mlm_matching_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_mlm_matching_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_log (var_str ("?mlm_matching"), .false., &
             intrinsic=.true., &
             description=var_str ('Master flag to switch on MLM (LO) jet ' // &
             'matching between hard matrix elements and the QCD parton ' // &
             'shower. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // &
             '\ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("mlm_Qcut_ME"), 0._default, intrinsic = .true., &
          description=var_str ('Real parameter that in the MLM jet matching ' // &
          'between hard matrix elements and QCD parton shower sets a possible ' // &
          'virtuality cut on jets from the hard matrix element. (cf. also ' // &
          '\ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ' // &
          '...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("mlm_Qcut_PS"), 0._default, intrinsic = .true., &
          description=var_str ('Real parameter that in the MLM jet matching ' // &
          'between hard matrix elements and QCD parton shower sets a possible ' // &
          'virtuality cut on jets from the parton shower. (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("mlm_ptmin"), 0._default, intrinsic = .true., &
          description=var_str ('This real parameter sets a minimal $p_T$ ' // &
          'that enters the $y_{cut}$ jet clustering measure in the MLM ' // &
          'jet matching between hard matrix elements and QCD parton showers.  ' // &
          '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
          '...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("mlm_etamax"), 0._default, intrinsic = .true., &
          description=var_str ('This real parameter sets a maximal pseudorapidity ' // &
          'that enters the MLM jet matching between hard matrix elements ' // &
          'and QCD parton showers.  (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
          '...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("mlm_Rmin"), 0._default, intrinsic = .true., &
          description=var_str ('Real parameter that sets a minimal $R$ ' // &
          'distance value that enters the $y_{cut}$ jet clustering measure ' // &
          'in the MLM jet matching between hard matrix elements and QCD ' // &
          'parton showers.  (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
          '...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("mlm_Emin"), 0._default, intrinsic = .true., &
          description=var_str ('Real parameter that sets a minimal energy ' // &
          '$E_{min}$ value as an infrared cutoff in the MLM jet matching ' // &
          'between hard matrix elements and QCD parton showers.  (cf. also ' // &
          '\ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ' // &
          '...}, \ttt{?hadronization\_active})'))
     call var_list%append_int (var_str &
          ("mlm_nmaxMEjets"), 0, intrinsic = .true., &
          description=var_str ('This integer sets the maximal number of ' // &
          'jets that are available from hard matrix elements in the MLM ' // &
          'jet matching between hard matrix elements and QCD parton shower. ' // &
          '(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
          '...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("mlm_ETclusfactor"), 0.2_default, intrinsic = .true., &
          description=var_str ('This real parameter is a factor that enters ' // &
          'the calculation of the $y_{cut}$ measure for jet clustering ' // &
          'after the parton shower in the MLM jet matching between hard ' // &
          'matrix elements and QCD parton showers.  (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("mlm_ETclusminE"), 5._default, intrinsic = .true., &
          description=var_str ('This real parameter is a minimal energy ' // &
          'that enters the calculation of the $y_{cut}$ measure for jet ' // &
          'clustering after the parton shower in the MLM jet matching between ' // &
          'hard matrix elements and QCD parton showers.  (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("mlm_etaclusfactor"), 1._default, intrinsic = .true., &
          description=var_str ('This real parameter is a factor that enters ' // &
          'the calculation of the $y_{cut}$ measure for jet clustering ' // &
          'after the parton shower in the MLM jet matching between hard ' // &
          'matrix elements and QCD parton showers.  (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("mlm_Rclusfactor"), 1._default, intrinsic = .true., &
          description=var_str ('This real parameter is a factor that enters ' // &
          'the calculation of the $y_{cut}$ measure for jet clustering ' // &
          'after the parton shower in the MLM jet matching between hard ' // &
          'matrix elements and QCD parton showers.  (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
     call var_list%append_real (var_str &
          ("mlm_Eclusfactor"), 1._default, intrinsic = .true., &
          description=var_str ('This real parameter is a factor that enters ' // &
          'the calculation of the $y_{cut}$ measure for jet clustering ' // &
          'after the parton shower in the MLM jet matching between hard ' // &
          'matrix elements and QCD parton showers.  (cf. also \ttt{?allow\_shower}, ' // &
          '\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
 
   end subroutine var_list_set_mlm_matching_defaults
 
 @ %def var_list_set_mlm_matching_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_powheg_matching_defaults => &
        var_list_set_powheg_matching_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_powheg_matching_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_log (var_str ("?powheg_matching"), &
          .false., intrinsic = .true., &
          description=var_str ('Activates Powheg matching. Needs to be ' // &
          'combined with the \ttt{?combined\_nlo\_integration}-method.'))
     call var_list%append_log (var_str ("?powheg_use_singular_jacobian"), &
          .false., intrinsic = .true., &
          description=var_str ('This allows to give a different ' // &
          'normalization of the Jacobian, resulting in an alternative ' // &
          'POWHEG damping in the singular regions.'))
     call var_list%append_int (var_str ("powheg_grid_size_xi"), &
          5, intrinsic = .true., &
          description=var_str ('Number of $\xi$ points in the POWHEG grid.'))
     call var_list%append_int (var_str ("powheg_grid_size_y"), &
          5, intrinsic = .true., &
          description=var_str ('Number of $y$ points in the POWHEG grid.'))
     call var_list%append_int (var_str ("powheg_grid_sampling_points"), &
          500000, intrinsic = .true., &
          description=var_str ('Number of calls used to initialize the ' // &
          'POWHEG grid.'))
     call var_list%append_real (var_str ("powheg_pt_min"), &
           1._default, intrinsic = .true., &
           description=var_str ('Lower $p_T$-cut-off for the POWHEG ' // &
           'hardest emission.'))
     call var_list%append_real (var_str ("powheg_lambda"), &
           LAMBDA_QCD_REF, intrinsic = .true., &
           description=var_str ('Reference scale of the $\alpha_s$ evolution ' // &
           'in the POWHEG matching algorithm.'))
     call var_list%append_log (var_str ("?powheg_rebuild_grids"), &
           .false., intrinsic = .true., &
           description=var_str ('If set to \ttt{true}, the existing POWHEG ' // &
           'grid is discarded and a new one is generated.'))
     call var_list%append_log (var_str ("?powheg_test_sudakov"), &
           .false., intrinsic = .true., &
           description=var_str ('Performs an internal consistency check ' // &
           'on the POWHEG event generation.'))
     call var_list%append_log (var_str ("?powheg_disable_sudakov"), &
           .false., intrinsic = .true., &
           description=var_str ('This flag allows to set the Sudakov form ' // &
           'factor to one. This effectively results in a version of ' // &
           'the matrix-element method (MEM) at NLO.'))
   end subroutine var_list_set_powheg_matching_defaults
 
 @ %def var_list_set_powheg_matching_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_openmp_defaults => var_list_set_openmp_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_openmp_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_log (var_str ("?omega_openmp"), &
          openmp_is_active (), &
          intrinsic=.true., &
          description=var_str ('Flag to switch on or off OpenMP multi-threading ' // &
          "for \oMega\ matrix elements. (cf. also \ttt{\$method}, \ttt{\$omega\_flag})"))
     call var_list%append_log (var_str ("?openmp_is_active"), &
          openmp_is_active (), &
          locked=.true., intrinsic=.true., &
          description=var_str ('Flag to switch on or off OpenMP multi-threading ' // &
          'for \whizard. (cf. also \ttt{?openmp\_logging}, \ttt{openmp\_num\_threads}, ' // &
          '\ttt{openmp\_num\_threads\_default}, \ttt{?omega\_openmp})'))
     call var_list%append_int (var_str ("openmp_num_threads_default"), &
          openmp_get_default_max_threads (), &
          locked=.true., intrinsic=.true., &
          description=var_str ('Integer parameter that shows the number ' // &
          'of default OpenMP threads for multi-threading. Note that this ' // &
          'parameter can only be accessed, but not reset by the user. (cf. ' // &
          'also \ttt{?openmp\_logging}, \ttt{openmp\_num\_threads}, \ttt{?omega\_openmp})'))
     call var_list%append_int (var_str ("openmp_num_threads"), &
          openmp_get_max_threads (), &
          intrinsic=.true., &
          description=var_str ('Integer parameter that sets the number ' // &
          'of OpenMP threads for multi-threading.  (cf. also \ttt{?openmp\_logging}, ' // &
          '\ttt{openmp\_num\_threads\_default}, \ttt{?omega\_openmp})'))
     call var_list%append_log (var_str ("?openmp_logging"), &
          .true., intrinsic=.true., &
          description=var_str ('This logical -- when set to \ttt{false} ' // &
          '-- suppresses writing out messages about OpenMP parallelization ' // &
          '(number of used threads etc.) on screen and into the logfile ' // &
          '(default name \ttt{whizard.log}) for the whole \whizard\ run. ' // &
          'Mainly for debugging purposes.  (cf. also \ttt{?logging}, ' // &
          '\ttt{?mpi\_logging})'))
   end subroutine var_list_set_openmp_defaults
 
 @ %def var_list_set_openmp_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_mpi_defaults => var_list_set_mpi_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_mpi_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_log (var_str ("?mpi_logging"), &
          .false., intrinsic=.true., &
          description=var_str('This logical -- when set to \ttt{false} ' // &
          '-- suppresses writing out messages about MPI parallelization ' // &
          '(number of used workers etc.) on screen and into the logfile ' // &
          '(default name \ttt{whizard.log}) for the whole \whizard\ run. ' // &
          'Mainly for debugging purposes.  (cf. also \ttt{?logging}, ' // &
          '\ttt{?openmp\_logging})'))
   end subroutine var_list_set_mpi_defaults
 
 @ %def var_list_set_mpi_defaults
 @
 <<Variables: var list: TBP>>=
   procedure :: set_nlo_defaults => var_list_set_nlo_defaults
 <<Variables: procedures>>=
   subroutine var_list_set_nlo_defaults (var_list)
     class(var_list_t), intent(inout) :: var_list
     call var_list%append_string (var_str ("$born_me_method"), &
          var_str (""), intrinsic = .true., &
          description=var_str ("This string variable specifies the method " // &
          "for the matrix elements to be used in the evaluation of the " // &
          "Born part of the NLO computation. The default is the empty string, " // &
          "i.e. the \ttt{\$method} being the intrinsic \oMega\ matrix element " // &
          'generator (\ttt{"omega"}), other options ' // &
          'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, ' // &
          '\ttt{"template\_unity"}, \ttt{"threshold"}, \ttt{"gosam"}, ' // &
          '\ttt{"openloops"}. Note that this option is inoperative if ' // &
          'no NLO calculation is specified in the process definition. ' // &
          'If you want ot use different matrix element methods in a LO ' // &
          'computation, use the usual \ttt{method} command. (cf. also ' // &
          '\ttt{\$correlation\_me\_method}, ' // &
          '\ttt{\$dglap\_me\_method}, \ttt{\$loop\_me\_method} and ' // &
          '\ttt{\$real\_tree\_me\_method}.)'))
     call var_list%append_string (var_str ("$loop_me_method"), &
          var_str (""), intrinsic = .true., &
          description=var_str ('This string variable specifies the method ' // &
          'for the matrix elements to be used in the evaluation of the ' // &
          'virtual part of the NLO computation. The default is the empty string,' // &
          'i.e. the same as \ttt{\$method}. Working options are: ' // &
          '\ttt{"threshold"}, \ttt{"openloops"}, \ttt{"recola"}, \ttt{gosam}. ' // &
          '(cf. also \ttt{\$real\_tree\_me\_method}, \ttt{\$correlation\_me\_method} ' // &
          'and \ttt{\$born\_me\_method}.)'))
     call var_list%append_string (var_str ("$correlation_me_method"), &
          var_str (""), intrinsic = .true., &
          description=var_str ('This string variable specifies ' // &
          'the method for the matrix elements to be used in the evaluation ' // &
          'of the color (and helicity) correlated part of the NLO computation. ' // &
          "The default is the same as the \ttt{\$method}, i.e. the intrinsic " // &
          "\oMega\ matrix element generator " // &
          '(\ttt{"omega"}), other options are: \ttt{"ovm"}, \ttt{"unit\_test"}, ' // &
          '\ttt{"template"}, \ttt{"template\_unity"}, \ttt{"threshold"}, ' // &
          '\ttt{"gosam"}, \ttt{"openloops"}. (cf. also ' // &
          '\ttt{\$born\_me\_method}, \ttt{\$dglap\_me\_method}, ' // &
          '\ttt{\$loop\_me\_method} and \newline' // &
          '\ttt{\$real\_tree\_me\_method}.)'))
     call var_list%append_string (var_str ("$real_tree_me_method"), &
          var_str (""), intrinsic = .true., &
          description=var_str ('This string variable specifies the method ' // &
          'for the matrix elements to be used in the evaluation of the ' // &
          'real part of the NLO computation. The default is the same as ' // &
          'the \ttt{\$method}, i.e. the intrinsic ' // &
          "\oMega\ matrix element generator " // &
          '(\ttt{"omega"}), other options ' // &
          'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, \ttt{"template\_unity"}, ' // &
          '\ttt{"threshold"}, \ttt{"gosam"}, \ttt{"openloops"}. (cf. also ' // &
          '\ttt{\$born\_me\_method}, \ttt{\$correlation\_me\_method}, ' // &
          '\ttt{\$dglap\_me\_method} and \ttt{\$loop\_me\_method}.)'))
     call var_list%append_string (var_str ("$dglap_me_method"), &
          var_str (""), intrinsic = .true., &
          description=var_str ('This string variable specifies the method ' // &
          'for the matrix elements to be used in the evaluation of the ' // &
          'DGLAP remnants of the NLO computation. The default is the same as ' // &
          "\ttt{\$method}, i.e. the \oMega\ matrix element generator " // &
          '(\ttt{"omega"}), other options ' // &
          'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, \ttt{"template\_unity"}, ' // &
          '\ttt{"threshold"}, \ttt{"gosam"}, \ttt{"openloops"}. (cf. also \newline' // &
          '\ttt{\$born\_me\_method}, \ttt{\$correlation\_me\_method}, ' // &
          '\ttt{\$loop\_me\_method} and \ttt{\$real\_tree\_me\_method}.)'))
     call var_list%append_log (&
          var_str ("?test_soft_limit"), .false., intrinsic = .true., &
          description=var_str ('Sets the fixed values $\tilde{\xi} = 0.00001$ ' // &
          'and $y = 0.5$ as radiation variables.  This way, only soft, ' // &
          'but non-collinear phase space points are generated, which allows ' // &
          'for testing subtraction in this region.'))
     call var_list%append_log (&
          var_str ("?test_coll_limit"), .false., intrinsic = .true., &
          description=var_str ('Sets the fixed values $\tilde{\xi} = 0.5$ ' // &
          'and $y = 0.9999999$ as radiation variables.  This way, only collinear, ' // &
          'but non-soft phase space points are generated, which allows ' // &
          'for testing subtraction in this region. Can be combined with ' // &
          '\ttt{?test\_soft\_limit} to probe soft-collinear regions.'))
     call var_list%append_log (&
          var_str ("?test_anti_coll_limit"), .false., intrinsic = .true., &
          description=var_str ('Sets the fixed values $\tilde{\xi} = 0.5$ ' // &
          'and $y = -0.9999999$ as radiation variables.  This way, only anti-collinear, ' // &
          'but non-soft phase space points are generated, which allows ' // &
          'for testing subtraction in this region. Can be combined with ' // &
          '\ttt{?test\_soft\_limit} to probe soft-collinear regions.'))
     call var_list%append_string (var_str ("$select_alpha_regions"), &
          var_str (""), intrinsic = .true., &
          description=var_str ('Fixes the $\alpha_r$ in the real ' // &
          ' subtraction component. Allows for testing in one individual ' // &
          'singular region.'))
     call var_list%append_string (var_str ("$virtual_selection"), &
          var_str ("Full"), intrinsic = .true., &
          description=var_str ('String variable to select either the full ' // &
          'or only parts of the virtual components of an NLO calculation. ' // &
          'Possible modes are \ttt{"Full"}, \ttt{"OLP"} and ' // &
          '\ttt{"Subtraction."}. Mainly for debugging purposes.'))
     call var_list%append_log (var_str ("?virtual_collinear_resonance_aware"), &
          .true., intrinsic = .true., &
          description=var_str ('This flag allows to switch between two ' // &
          'different implementations of the collinear subtraction in the ' // &
          'resonance-aware FKS setup.'))
     call var_list%append_real (&
          var_str ("blha_top_yukawa"), -1._default, intrinsic = .true., &
          description=var_str ('If this value is set, the given value will ' // &
          'be used as the top Yukawa coupling instead of the top mass. ' // &
          'Note that having different values for $y_t$ and $m_t$ must be ' // &
          'supported by your OLP-library and yield errors if this is not the case.'))
     call var_list%append_string (var_str ("$blha_ew_scheme"), &
          var_str ("alpha_internal"), intrinsic = .true., &
          description=var_str ('String variable that transfers the electroweak ' // &
          'renormalization scheme via BLHA to the one-loop provider. Possible ' // &
          'values are \ttt{GF} or \ttt{Gmu} for the $G_\mu$ scheme, ' // &
          '\ttt{alpha\_internal} (default, $G_\mu$ scheme, but value of ' // &
          '$\alpha_S$ calculated internally by \whizard), \ttt{alpha\_mz} ' // &
          'and \ttt{alpha\_0} (or \ttt{alpha\_thompson}) for different schemes ' // &
          'with $\alpha$ as input.'))
     call var_list%append_int (var_str ("openloops_verbosity"), 1, &
          intrinsic = .true., &
          description=var_str ('Decides how much \openloops\ output is printed. ' // &
          'Can have values 0, 1 and 2, where 2 is the highest verbosity level.'))
     call var_list%append_log (var_str ("?openloops_use_cms"), &
          .true., intrinsic = .true., &
          description=var_str ('Activates the complex mass scheme in ' // &
          '\openloops. (cf. also ' // &
          '\ttt{openloos\_verbosity}, \ttt{\$method}, ' // &
          '\ttt{?openloops\_switch\_off\_muon\_yukawa}, ' // &
          '\ttt{openloops\_stability\_log}, \newline' // &
          '\ttt{\$openloops\_extra\_cmd})'))
     call var_list%append_int (var_str ("openloops_phs_tolerance"), 7, &
          intrinsic = .true., &
          description=var_str ('This integer parameter gives via ' // &
          '\ttt{openloops\_phs\_tolerance = <n>} the relative numerical ' // &
          'tolerance $10^{-n}$ for the momentum conservation of the ' // &
          'external particles within \openloops. (cf. also ' // &
          '\ttt{openloos\_verbosity}, \ttt{\$method}, ' // &
          '\ttt{?openloops\_switch\_off\_muon\_yukawa}, ' // &
          '\newline\ttt{openloops\_stability\_log}, ' // &
          '\ttt{\$openloops\_extra\_cmd})'))
     call var_list%append_int (var_str ("openloops_stability_log"), 0, &
          intrinsic = .true., &
          description=var_str ('Creates the directory \ttt{stability\_log} ' // &
          'containing information about the performance of the \openloops ' // &
          'matrix elements. Possible values are 0 (No output), 1 (On ' // &
          '\ttt{finish()}-call), 2 (Adaptive) and 3 (Always).'))
     call var_list%append_log (var_str ("?openloops_switch_off_muon_yukawa"), &
          .false., intrinsic = .true., &
          description=var_str ('Sets the Yukawa coupling of muons for ' // &
          '\openloops\ to zero. (cf. also ' // &
          '\ttt{openloos\_verbosity}, \ttt{\$method}, ' // &
          '\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // &
          '\ttt{\$openloops\_extra\_cmd})'))
     call var_list%append_string (var_str ("$openloops_extra_cmd"), &
          var_str (""), intrinsic = .true., &
          description=var_str ('String variable to transfer customized ' // &
          'special commands to \openloops. The three supported examples ' // &
          '\ttt{\$openloops\_extra\_command = "extra approx top/stop/not"} ' // &
          'are for selection of subdiagrams in top production. (cf. also ' // &
          '\ttt{\$method}, \ttt{openloos\_verbosity}, ' // &
          '\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // &
          '\ttt{?openloops\_switch\_off\_muon\_yukawa})'))
     call var_list%append_real (var_str ("ellis_sexton_scale"), &
          -1._default, intrinsic = .true., &
          description = var_str ('Real positive paramter for the Ellis-Sexton scale' // &
          '$\mathcal{Q}$ used both in the finite one-loop contribution provided by' // &
          'the OLP and in the virtual counter terms. The NLO cross section is' // &
          'independend of $\mathcal{Q}$. Therefore, this allows for debugging of' // &
          'the implemention of the virtual counter terms. As the default' // &
          '$\mathcal{Q} = \mu_{\rm{R}}$ is chosen. So far, setting this parameter' // &
          'only works for OpenLoops2, otherwise the default behaviour is invoked.'))
     call var_list%append_log (var_str ("?disable_subtraction"), &
          .false., intrinsic = .true., &
          description=var_str ('Disables the subtraction of soft and collinear ' // &
          'divergences from the real matrix element.'))
     call var_list%append_real (var_str ("fks_dij_exp1"), &
          1._default, intrinsic = .true., &
          description=var_str ('Fine-tuning parameters of the FKS ' // &
          'partition functions. The exact meaning depends on the mapping ' // &
          'implementation. (cf. also \ttt{fks\_dij\_exp2}, ' // &
          '\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})'))
     call var_list%append_real (var_str ("fks_dij_exp2"), &
          1._default, intrinsic = .true., &
          description=var_str ('Fine-tuning parameters of the FKS ' // &
          'partition functions. The exact meaning depends on the mapping ' // &
          'implementation. (cf. also \ttt{fks\_dij\_exp1}, ' // &
          '\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})'))
     call var_list%append_real (var_str ("fks_xi_min"), &
          0.0000001_default, intrinsic = .true., &
          description=var_str ('Real parameter for the FKS ' // &
          'phase space that sets the numerical lower value of the $\xi$ ' // &
          'variable. (cf. also \ttt{fks\_dij\_exp1}, ' // &
          '\ttt{fks\_dij\_exp2}, \ttt{\$fks\_mapping\_type}, \ttt{fks\_y\_max})'))
     call var_list%append_real (var_str ("fks_y_max"), &
          1._default, intrinsic = .true., &
          description=var_str ('Real parameter for the FKS ' // &
          'phase space that sets the numerical upper value of the $y$ ' // &
          'variable. (cf. also \ttt{fks\_dij\_exp1}, ' // &
          '\ttt{\$fks\_mapping\_type}, \ttt{fks\_dij\_exp2}, \ttt{fks\_y\_max})'))
     call var_list%append_log (var_str ("?vis_fks_regions"), &
          .false., intrinsic = .true., &
          description=var_str ('Logical variable that, if set to ' // &
          '\ttt{true}, generates \LaTeX\ code and executes it into a PDF ' // &
          ' to produce a table of all singular FKS regions and their ' // &
          ' flavor structures. The default is \ttt{false}.'))
     call var_list%append_real (var_str ("fks_xi_cut"), &
          1.0_default, intrinsic = .true., &
          description = var_str ('Real paramter for the FKS ' // &
          'phase space that applies a cut to $\xi$ variable with $0 < \xi_{\text{cut}}' // &
          '\leq \xi_{\text{max}}$. The dependence on the parameter vanishes between ' // &
          'real subtraction and integrated subtraction term.'))
     call var_list%append_real (var_str ("fks_delta_o"), &
          2._default, intrinsic = .true., &
          description = var_str ('Real paramter for the FKS ' // &
          'phase space that applies a cut to the $y$ variable with $0 < \delta_o \leq 2$. ' // &
          'The dependence on the parameter vanishes between real subtraction and integrated ' // &
          'subtraction term.'))
     call var_list%append_real (var_str ("fks_delta_i"), &
          2._default, intrinsic = .true., &
          description = var_str ('Real paramter for the FKS ' // &
          'phase space that applies a cut to the $y$ variable with ' // &
          '$0 < \delta_{\mathrm{I}} \leq 2$ '// &
          'for initial state singularities only. ' // &
          'The dependence on the parameter vanishes between real subtraction and integrated ' // &
          'subtraction term.'))
     call var_list%append_string (var_str ("$fks_mapping_type"), &
          var_str ("default"), intrinsic = .true., &
          description=var_str ('Sets the FKS mapping type. Possible values ' // &
          'are \ttt{"default"} and \ttt{"resonances"}. The latter option ' // &
          'activates the resonance-aware subtraction mode and induces the ' // &
          'generation of a soft mismatch component. (cf. also ' // &
          '\ttt{fks\_dij\_exp1}, \ttt{fks\_dij\_exp2}, \ttt{fks\_xi\_min}, ' // &
          '\ttt{fks\_y\_max})'))
     call var_list%append_string (var_str ("$resonances_exclude_particles"), &
          var_str ("default"), intrinsic = .true., &
          description=var_str ('Accepts a string of particle names. These ' // &
          'particles will be ignored when the resonance histories are generated. ' // &
          'If \ttt{\$fks\_mapping\_type} is not \ttt{"resonances"}, this ' // &
          'option does nothing.'))
     call var_list%append_int (var_str ("alpha_power"), &
          2, intrinsic = .true., &
          description=var_str ('Fixes the electroweak coupling ' // &
          'powers used by BLHA matrix element generators. Setting these ' // &
          'values is necessary for the correct generation of OLP-files. ' // &
          'Having inconsistent values yields to error messages by the corresponding ' // &
          'OLP-providers.'))
     call var_list%append_int (var_str ("alphas_power"), &
          0, intrinsic = .true., &
          description=var_str ('Fixes the strong coupling ' // &
          'powers used by BLHA matrix element generators. Setting these ' // &
          'values is necessary for the correct generation of OLP-files. ' // &
          'Having inconsistent values yields to error messages by the corresponding ' // &
          'OLP-providers.'))
     call var_list%append_log (var_str ("?combined_nlo_integration"), &
          .false., intrinsic = .true., &
          description=var_str ('When this option is set to \ttt{true}, ' // &
          'the NLO integration will not be performed in the separate components, ' // &
          'but instead the sum of all components will be integrated directly. ' // &
          'When fixed-order NLO events are requested, this integration ' // &
          'mode is possible, but not necessary.  However, it is necessary ' // &
          'for POWHEG events.'))
     call var_list%append_log (var_str ("?fixed_order_nlo_events"), &
          .false., intrinsic = .true., &
          description=var_str ('Induces the generation of fixed-order ' // &
          'NLO events.  Deprecated name: \ttt{?nlo\_fixed\_order}.'))
     call var_list%append_log (var_str ("?check_event_weights_against_xsection"), &
          .false., intrinsic = .true., &
          description=var_str ('Activates an internal recording of event ' // &
          'weights when unweighted events are generated.  At the end of ' // &
          'the simulation, the mean value of the weights and its standard ' // &
          'deviation are displayed. This allows to cross-check event generation ' // &
          'and integration, because the value displayed must be equal to ' // &
          'the integration result.'))
     call var_list%append_log (var_str ("?keep_failed_events"), &
          .false., intrinsic = .true., &
          description=var_str ('In the context of weighted event generation, ' // &
          'if set to \ttt{true}, events with failed kinematics will be ' // &
          'written to the event output with an associated weight of zero. ' // &
          'This way, the total cross section can be reconstructed from the event output.'))
     call var_list%append_int (var_str ("gks_multiplicity"), &
          0, intrinsic = .true., &
          description=var_str ('Jet multiplicity for the GKS merging scheme.'))
     call var_list%append_string (var_str ("$gosam_filter_lo"), &
          var_str (""), intrinsic = .true., &
          description=var_str ('The filter string given to \gosam\ in order to ' // &
          'filter out tree-level diagrams. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // &
          '\ttt{\$gosam\_symmetries})'))
     call var_list%append_string (var_str ("$gosam_filter_nlo"), &
          var_str (""), intrinsic = .true., &
          description=var_str ('The same as \ttt{\$gosam\_filter\_lo}, but for ' // &
          'loop matrix elements. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // &
          '\ttt{\$gosam\_symmetries})'))
     call var_list%append_string (var_str ("$gosam_symmetries"), &
          var_str ("family,generation"), intrinsic = .true., &
          description=var_str ('String variable that is transferred to \gosam\ ' // &
          'configuration file to determine whether certain helicity configurations ' // &
          'are considered to be equal. Possible values are \ttt{flavour}, ' // &
          '\ttt{family} etc. For more info see the \gosam\ manual.'))
     call var_list%append_int (var_str ("form_threads"), &
          2, intrinsic = .true., &
          description=var_str ('The number of threads used by \gosam when ' // &
          'matrix elements are evaluated using \ttt{FORM}'))
     call var_list%append_int (var_str ("form_workspace"), &
          1000, intrinsic = .true., &
          description=var_str ('The size of the workspace \gosam requires ' // &
          'from \ttt{FORM}. Inside \ttt{FORM}, it corresponds to the heap ' // &
          'size used by the algebra processor.'))
     call var_list%append_string (var_str ("$gosam_fc"), &
          var_str (""), intrinsic = .true., &
          description=var_str ('The Fortran compiler used by \gosam.'))
     call var_list%append_real (&
          var_str ("mult_call_real"), 1._default, &
          intrinsic = .true., &
          description=var_str ('(Real-valued) multiplier for the number ' // &
          'of calls used in the integration of the real subtraction ' // &
          'NLO component. This way, a higher accuracy can be achieved for ' // &
          'the real component, while simultaneously avoiding redundant ' // &
          'integration calls for the other components. (cf. also ' // &
          '\ttt{mult\_call\_dglap}, \ttt{mult\_call\_virt})'))
     call var_list%append_real (&
          var_str ("mult_call_virt"), 1._default, &
          intrinsic = .true., &
          description=var_str ('(Real-valued) multiplier for the number ' // &
          'of calls used in the integration of the virtual NLO ' // &
          'component. This way, a higher accuracy can be achieved for ' // &
          'this component, while simultaneously avoiding redundant ' // &
          'integration calls for the other components. (cf. also ' // &
          '\ttt{mult\_call\_dglap}, \ttt{mult\_call\_real})'))
     call var_list%append_real (&
          var_str ("mult_call_dglap"), 1._default, &
          intrinsic = .true., &
          description=var_str ('(Real-valued) multiplier for the number ' // &
          'of calls used in the integration of the DGLAP remnant NLO ' // &
          'component. This way, a higher accuracy can be achieved for ' // &
          'this component, while simultaneously avoiding redundant ' // &
          'integration calls for the other components. (cf. also ' // &
          '\ttt{mult\_call\_real}, \ttt{mult\_call\_virt})'))
     call var_list%append_string (var_str ("$dalitz_plot"), &
          var_str (''), intrinsic = .true., &
          description=var_str ('This string variable has two purposes: ' // &
          'when different from the empty string, it switches on generation ' // &
          'of the Dalitz plot file (ASCII tables) for the real emitters. ' // &
          'The string variable itself provides the file name.'))
     call var_list%append_string (var_str ("$nlo_correction_type"), &
          var_str ("QCD"), intrinsic = .true., &
          description=var_str ('String variable which sets the NLO correction ' // &
          'type via \ttt{nlo\_correction\_type = "{\em <type>}"} to either ' // &
          '\ttt{"QCD"}, \ttt{"EW"}, or to all with \ttt{\em{<type>}} ' // &
          'set to \ttt{"Full"}. Must be set before the \texttt{process} statement.'))
     call var_list%append_string (var_str ("$exclude_gauge_splittings"), &
          var_str ("c:b:t:e2:e3"), intrinsic = .true., &
          description=var_str ('String variable that allows via ' // &
          '\ttt{\$exclude\_gauge\_splittings = "{\em <prt1>:<prt2>:\dots}"} ' // &
          'to exclude fermion flavors from gluon/photon splitting into ' // &
          'fermion pairs beyond LO. For example \ttt{\$exclude\_gauge\_splittings ' // &
          '= "c:s:b:t"} would lead to \ttt{gl => u U} and \ttt{gl => d ' // &
          'D} as possible splittings in QCD. It is important to keep in ' // &
          'mind that only the particles listed in the string are excluded! ' // &
          'In QED this string would additionally allow for all splittings into ' // &
          'lepton pairs \ttt{A => l L}. Therefore, once set the variable ' // &
          'acts as a replacement of the default value, not as an addition!  ' // &
          'Note: \ttt{"\em <prt>"} can be both particle or antiparticle. It ' // &
          'will always exclude the corresponding fermion pair. An empty ' // &
          'string allows for all fermion flavors to take part in the splitting! ' // &
          'Also, particles included in an \ttt{alias} are not excluded by ' // &
          '\ttt{\$exclude\_gauge\_splittings}!'))
     call var_list%append_log (var_str ("?nlo_use_born_scale"), &
          .false., intrinsic = .true., &
          description=var_str ('Flag that decides whether a scale expression ' // &
          'defined for the Born component of an NLO process shall be applied ' // &
          'to all other components as well or not. ' // &
          '(cf. also \ttt{?nlo\_cut\_all\_sqmes})'))
     call var_list%append_log (var_str ("?nlo_cut_all_sqmes"), &
          .false., intrinsic = .true., &
          description=var_str ('Flag that decides whether in the case that ' // &
          'some NLO component does not pass a cut, all other components ' // &
          'shall be discarded for that phase space point as well or not. ' // &
          '(cf. also \ttt{?nlo\_use\_born\_scale})'))
     call var_list%append_log (var_str ("?nlo_use_real_partition"), &
          .false., intrinsic = .true., &
          description=var_str (' If set to \ttt{true}, the real matrix ' // &
          'element is split into a finite and a singular part using a ' // &
          'partition function $f$, such that $\mathcal{R} ' // &
          '= [1-f(p_T^2)]\mathcal{R} + f(p_T^2)\mathcal{R} = ' // &
          '\mathcal{R}_{\text{fin}} ' // &
          '+ \mathcal{R}_{\text{sing}}$. The emission ' // &
          'generation is then performed using $\mathcal{R}_{\text{sing}}$, ' // &
          'whereas $\mathcal{R}_{\text{fin}}$ is treated separately. ' // &
          '(cf. also \ttt{real\_partition\_scale})'))
     call var_list%append_real (var_str ("real_partition_scale"), &
          10._default, intrinsic = .true., &
          description=var_str ('This real variable sets the invariant mass ' // &
          'of the FKS pair used as a separator between the singular and the ' // &
          'finite part of the real subtraction terms in an NLO calculation, ' // &
          'e.g. in $e^+e^- \to ' // &
          't\bar tj$. (cf. also \ttt{?nlo\_use\_real\_partition})'))
   end subroutine var_list_set_nlo_defaults
 
 @ %def var_list_set_nlo_defaults
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Observables}
 
 In this module we define concrete variables and operators (observables)
 that we want to support in expressions.
 <<[[observables.f90]]>>=
 <<File header>>
 
 module observables
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use diagnostics
   use lorentz
   use subevents
   use variables
 
 <<Standard module head>>
 
 <<Observables: public>>
 
 contains
 
 <<Observables: procedures>>
 
 end module observables
 @ %def observables
 @
 \subsection{Process-specific variables}
 We allow the user to set a numeric process ID for each declared process.
 <<Observables: public>>=
   public :: var_list_init_num_id
 <<Observables: procedures>>=
   subroutine var_list_init_num_id (var_list, proc_id, num_id)
     type(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: proc_id
     integer, intent(in), optional :: num_id
     call var_list_set_procvar_int (var_list, proc_id, &
          var_str ("num_id"), num_id)
   end subroutine var_list_init_num_id
 
 @ %def var_list_init_num_id
 @
 Integration results are stored in special variables.  They are
 initialized by this subroutine.  The values may or may not already
 known.
 
 Note: the values which are accessible are those that are unique for a
 process with multiple MCI records. The rest has been discarded.
 <<Observables: public>>=
   public :: var_list_init_process_results
 <<Observables: procedures>>=
   subroutine var_list_init_process_results (var_list, proc_id, &
        n_calls, integral, error, accuracy, chi2, efficiency)
     type(var_list_t), intent(inout) :: var_list
     type(string_t), intent(in) :: proc_id
     integer, intent(in), optional :: n_calls
     real(default), intent(in), optional :: integral, error, accuracy
     real(default), intent(in), optional :: chi2, efficiency
     call var_list_set_procvar_real (var_list, proc_id, &
          var_str ("integral"), integral)
     call var_list_set_procvar_real (var_list, proc_id, &
          var_str ("error"), error)
   end subroutine var_list_init_process_results
 
 @ %def var_list_init_process_results
 @
 \subsection{Observables as Pseudo-Variables}
 Unary and binary observables are different.  Most unary observables
 can be equally well evaluated for particle pairs.  Binary observables
 cannot be evaluated for single particles.
 <<Observables: public>>=
   public :: var_list_set_observables_unary
   public :: var_list_set_observables_binary
 <<Observables: procedures>>=
   subroutine var_list_set_observables_unary (var_list, prt1)
     type(var_list_t), intent(inout) :: var_list
     type(prt_t), intent(in), target :: prt1
     call var_list_append_obs1_iptr &
          (var_list, var_str ("PDG"), obs_pdg1, prt1)
     call var_list_append_obs1_iptr &
          (var_list, var_str ("Hel"), obs_helicity1, prt1)
     call var_list_append_obs1_iptr &
          (var_list, var_str ("Ncol"), obs_n_col1, prt1)
     call var_list_append_obs1_iptr &
          (var_list, var_str ("Nacl"), obs_n_acl1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("M"), obs_signed_mass1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("M2"), obs_mass_squared1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("E"), obs_energy1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("Px"), obs_px1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("Py"), obs_py1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("Pz"), obs_pz1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("P"), obs_p1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("Pl"), obs_pl1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("Pt"), obs_pt1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("Theta"), obs_theta1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("Phi"), obs_phi1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("Rap"), obs_rap1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("Eta"), obs_eta1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("Theta_star"), obs_theta_star1, prt1)
     call var_list_append_obs1_rptr &
          (var_list, var_str ("Dist"), obs_dist1, prt1)
     call var_list_append_uobs_real &
          (var_list, var_str ("_User_obs_real"), prt1)
     call var_list_append_uobs_int &
          (var_list, var_str ("_User_obs_int"), prt1)
   end subroutine var_list_set_observables_unary
 
   subroutine var_list_set_observables_binary (var_list, prt1, prt2)
     type(var_list_t), intent(inout) :: var_list
     type(prt_t), intent(in), target :: prt1
     type(prt_t), intent(in), optional, target :: prt2
     call var_list_append_obs2_iptr &
          (var_list, var_str ("PDG"), obs_pdg2, prt1, prt2)
     call var_list_append_obs2_iptr &
          (var_list, var_str ("Hel"), obs_helicity2, prt1, prt2)
     call var_list_append_obs2_iptr &
          (var_list, var_str ("Ncol"), obs_n_col2, prt1, prt2)
     call var_list_append_obs2_iptr &
          (var_list, var_str ("Nacl"), obs_n_acl2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("M"), obs_signed_mass2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("M2"), obs_mass_squared2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("E"), obs_energy2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("Px"), obs_px2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("Py"), obs_py2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("Pz"), obs_pz2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("P"), obs_p2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("Pl"), obs_pl2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("Pt"), obs_pt2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("Theta"), obs_theta2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("Phi"), obs_phi2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("Rap"), obs_rap2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("Eta"), obs_eta2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("Theta_star"), obs_theta_star2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("Dist"), obs_dist2, prt1, prt2)
     call var_list_append_obs2_rptr &
          (var_list, var_str ("kT"), obs_ktmeasure, prt1, prt2)
     call var_list_append_uobs_real &
          (var_list, var_str ("_User_obs_real"), prt1, prt2)
     call var_list_append_uobs_int &
          (var_list, var_str ("_User_obs_int"), prt1, prt2)
   end subroutine var_list_set_observables_binary
 
 @ %def var_list_set_observables_unary var_list_set_observables_binary
 @
 \subsection{Checks}
 <<Observables: public>>=
   public :: var_list_check_observable
 <<Observables: procedures>>=
   subroutine var_list_check_observable (var_list, name, type)
     class(var_list_t), intent(in), target :: var_list
     type(string_t), intent(in) :: name
     integer, intent(inout) :: type
     if (string_is_observable_id (name)) then
        call msg_fatal ("Variable name '" // char (name) &
             // "' is reserved for an observable")
        type = V_NONE
        return
     end if
   end subroutine var_list_check_observable
 
 @ %def var_list_check_observable
 @
 Check if a variable name is defined as an observable:
 <<Observables: procedures>>=
   function string_is_observable_id (string) result (flag)
     logical :: flag
     type(string_t), intent(in) :: string
     select case (char (string))
     case ("PDG", "Hel", "Ncol", &
          "M", "M2", "E", "Px", "Py", "Pz", "P", "Pl", "Pt", &
          "Theta", "Phi", "Rap", "Eta", "Theta_star", "Dist", "kT")
        flag = .true.
     case default
        flag = .false.
     end select
   end function string_is_observable_id
 
 @ %def string_is_observable_id
 @ Check for result and process variables.
 <<Observables: public>>=
   public :: var_list_check_result_var
 <<Observables: procedures>>=
   subroutine var_list_check_result_var (var_list, name, type)
     class(var_list_t), intent(in), target :: var_list
     type(string_t), intent(in) :: name
     integer, intent(inout) :: type
     if (string_is_integer_result_var (name))  type = V_INT
     if (.not. var_list%contains (name)) then
        if (string_is_result_var (name)) then
           call msg_fatal ("Result variable '" // char (name) // "' " &
                // "set without prior integration")
           type = V_NONE
           return
        else if (string_is_num_id (name)) then
           call msg_fatal ("Numeric process ID '" // char (name) // "' " &
                // "set without process declaration")
           type = V_NONE
           return
        end if
     end if
   end subroutine var_list_check_result_var
 
 @ %def var_list_check_result_var
 @
 Check if a variable name is a result variable of integer type:
 <<Observables: procedures>>=
   function string_is_integer_result_var (string) result (flag)
     logical :: flag
     type(string_t), intent(in) :: string
     type(string_t) :: buffer, name, separator
     buffer = string
     call split (buffer, name, "(", separator=separator)  ! ")"
     if (separator == "(") then
        select case (char (name))
        case ("num_id", "n_calls")
           flag = .true.
        case default
           flag = .false.
        end select
     else
        flag = .false.
     end if
   end function string_is_integer_result_var
 
 @ %def string_is_integer_result_var
 @
 Check if a variable name is an integration-result variable:
 <<Observables: procedures>>=
   function string_is_result_var (string) result (flag)
     logical :: flag
     type(string_t), intent(in) :: string
     type(string_t) :: buffer, name, separator
     buffer = string
     call split (buffer, name, "(", separator=separator)  ! ")"
     if (separator == "(") then
        select case (char (name))
        case ("integral", "error")
           flag = .true.
        case default
           flag = .false.
        end select
     else
        flag = .false.
     end if
   end function string_is_result_var
 
 @ %def string_is_result_var
 @
 Check if a variable name is a numeric process ID:
 <<Observables: procedures>>=
   function string_is_num_id (string) result (flag)
     logical :: flag
     type(string_t), intent(in) :: string
     type(string_t) :: buffer, name, separator
     buffer = string
     call split (buffer, name, "(", separator=separator)  ! ")"
     if (separator == "(") then
        select case (char (name))
        case ("num_id")
           flag = .true.
        case default
           flag = .false.
        end select
     else
        flag = .false.
     end if
   end function string_is_num_id
 
 @ %def string_is_num_id
 @
 \subsection{Observables}
 These are analogous to the unary and binary numeric functions listed
 above.  An observable takes the [[pval]] component(s) of its one or
 two argument nodes and produces an integer or real value.
 
 \subsubsection{Integer-valued unary observables}
 The PDG code
 <<Observables: procedures>>=
   integer function obs_pdg1 (prt1) result (pdg)
     type(prt_t), intent(in) :: prt1
     pdg = prt_get_pdg (prt1)
   end function obs_pdg1
 
 @ %def obs_pdg
 @ The helicity.  The return value is meaningful only if the particle
 is polarized, otherwise an invalid value is returned (-9).
 <<Observables: procedures>>=
   integer function obs_helicity1 (prt1) result (h)
     type(prt_t), intent(in) :: prt1
     if (prt_is_polarized (prt1)) then
        h = prt_get_helicity (prt1)
     else
        h = -9
     end if
   end function obs_helicity1
 
 @ %def obs_helicity1
 @ The number of open color (anticolor) lines.  The return value is meaningful
 only if the particle is colorized (i.e., the subevent has been given color
 information), otherwise the function returns zero.
 <<Observables: procedures>>=
   integer function obs_n_col1 (prt1) result (n)
     type(prt_t), intent(in) :: prt1
     if (prt_is_colorized (prt1)) then
        n = prt_get_n_col (prt1)
     else
        n = 0
     end if
   end function obs_n_col1
 
   integer function obs_n_acl1 (prt1) result (n)
     type(prt_t), intent(in) :: prt1
     if (prt_is_colorized (prt1)) then
        n = prt_get_n_acl (prt1)
     else
        n = 0
     end if
   end function obs_n_acl1
 
 @ %def obs_n_col1
 @ %def obs_n_acl1
 @
 \subsubsection{Real-valued unary observables}
 The invariant mass squared, obtained from the separately stored value.
 <<Observables: procedures>>=
   real(default) function obs_mass_squared1 (prt1) result (p2)
     type(prt_t), intent(in) :: prt1
     p2 = prt_get_msq (prt1)
   end function obs_mass_squared1
 
 @ %def obs_mass_squared1
 @ The signed invariant mass, which is the signed square root of the
 previous observable.
 <<Observables: procedures>>=
   real(default) function obs_signed_mass1 (prt1) result (m)
     type(prt_t), intent(in) :: prt1
     real(default) :: msq
     msq = prt_get_msq (prt1)
     m = sign (sqrt (abs (msq)), msq)
   end function obs_signed_mass1
 
 @ %def obs_signed_mass1
 @ The particle energy
 <<Observables: procedures>>=
   real(default) function obs_energy1 (prt1) result (e)
     type(prt_t), intent(in) :: prt1
     e = energy (prt_get_momentum (prt1))
   end function obs_energy1
 
 @ %def obs_energy1
 @ Particle momentum (components)
 <<Observables: procedures>>=
   real(default) function obs_px1 (prt1) result (p)
     type(prt_t), intent(in) :: prt1
     p = vector4_get_component (prt_get_momentum (prt1), 1)
   end function obs_px1
 
   real(default) function obs_py1 (prt1) result (p)
     type(prt_t), intent(in) :: prt1
     p = vector4_get_component (prt_get_momentum (prt1), 2)
   end function obs_py1
 
   real(default) function obs_pz1 (prt1) result (p)
     type(prt_t), intent(in) :: prt1
     p = vector4_get_component (prt_get_momentum (prt1), 3)
   end function obs_pz1
 
   real(default) function obs_p1 (prt1) result (p)
     type(prt_t), intent(in) :: prt1
     p = space_part_norm (prt_get_momentum (prt1))
   end function obs_p1
 
   real(default) function obs_pl1 (prt1) result (p)
     type(prt_t), intent(in) :: prt1
     p = longitudinal_part (prt_get_momentum (prt1))
   end function obs_pl1
 
   real(default) function obs_pt1 (prt1) result (p)
     type(prt_t), intent(in) :: prt1
     p = transverse_part (prt_get_momentum (prt1))
   end function obs_pt1
 
 @ %def obs_px1 obs_py1 obs_pz1
 @ %def obs_p1 obs_pl1 obs_pt1
 @ Polar and azimuthal angle (lab frame).
 <<Observables: procedures>>=
   real(default) function obs_theta1 (prt1) result (p)
     type(prt_t), intent(in) :: prt1
     p = polar_angle (prt_get_momentum (prt1))
   end function obs_theta1
 
   real(default) function obs_phi1 (prt1) result (p)
     type(prt_t), intent(in) :: prt1
     p = azimuthal_angle (prt_get_momentum (prt1))
   end function obs_phi1
 
 @ %def obs_theta1 obs_phi1
 @ Rapidity and pseudorapidity
 <<Observables: procedures>>=
   real(default) function obs_rap1 (prt1) result (p)
     type(prt_t), intent(in) :: prt1
     p = rapidity (prt_get_momentum (prt1))
   end function obs_rap1
 
   real(default) function obs_eta1 (prt1) result (p)
     type(prt_t), intent(in) :: prt1
     p = pseudorapidity (prt_get_momentum (prt1))
   end function obs_eta1
 
 @ %def obs_rap1 obs_eta1
 @ Meaningless: Polar angle in the rest frame of the two arguments
 combined.
 <<Observables: procedures>>=
   real(default) function obs_theta_star1 (prt1) result (dist)
     type(prt_t), intent(in) :: prt1
     call msg_fatal (" 'Theta_star' is undefined as unary observable")
     dist = 0
   end function obs_theta_star1
 
 @ %def obs_theta_star1
 @ [Obsolete] Meaningless: Polar angle in the rest frame of the 2nd argument.
 <<XXX Observables: procedures>>=
   real(default) function obs_theta_rf1 (prt1) result (dist)
     type(prt_t), intent(in) :: prt1
     call msg_fatal (" 'Theta_RF' is undefined as unary observable")
     dist = 0
   end function obs_theta_rf1
 
 @ %def obs_theta_rf1
 @ Meaningless: Distance on the $\eta$-$\phi$ cylinder.
 <<Observables: procedures>>=
   real(default) function obs_dist1 (prt1) result (dist)
     type(prt_t), intent(in) :: prt1
     call msg_fatal (" 'Dist' is undefined as unary observable")
     dist = 0
   end function obs_dist1
 
 @ %def obs_dist1
 @
 \subsubsection{Integer-valued binary observables}
 These observables are meaningless as binary functions.
 <<Observables: procedures>>=
   integer function obs_pdg2 (prt1, prt2) result (pdg)
     type(prt_t), intent(in) :: prt1, prt2
     call msg_fatal (" PDG_Code is undefined as binary observable")
     pdg = 0
   end function obs_pdg2
 
   integer function obs_helicity2 (prt1, prt2) result (h)
     type(prt_t), intent(in) :: prt1, prt2
     call msg_fatal (" Helicity is undefined as binary observable")
     h = 0
   end function obs_helicity2
 
   integer function obs_n_col2 (prt1, prt2) result (n)
     type(prt_t), intent(in) :: prt1, prt2
     call msg_fatal (" Ncol is undefined as binary observable")
     n = 0
   end function obs_n_col2
 
   integer function obs_n_acl2 (prt1, prt2) result (n)
     type(prt_t), intent(in) :: prt1, prt2
     call msg_fatal (" Nacl is undefined as binary observable")
     n = 0
   end function obs_n_acl2
 
 @ %def obs_pdg2
 @ %def obs_helicity2
 @ %def obs_n_col2
 @ %def obs_n_acl2
 @
 \subsubsection{Real-valued binary observables}
 The invariant mass squared, obtained from the separately stored value.
 <<Observables: procedures>>=
   real(default) function obs_mass_squared2 (prt1, prt2) result (p2)
     type(prt_t), intent(in) :: prt1, prt2
     type(prt_t) :: prt
     call prt_init_combine (prt, prt1, prt2)
     p2 = prt_get_msq (prt)
   end function obs_mass_squared2
 
 @ %def obs_mass_squared2
 @ The signed invariant mass, which is the signed square root of the
 previous observable.
 <<Observables: procedures>>=
   real(default) function obs_signed_mass2 (prt1, prt2) result (m)
     type(prt_t), intent(in) :: prt1, prt2
     type(prt_t) :: prt
     real(default) :: msq
     call prt_init_combine (prt, prt1, prt2)
     msq = prt_get_msq (prt)
     m = sign (sqrt (abs (msq)), msq)
   end function obs_signed_mass2
 
 @ %def obs_signed_mass2
 @ The particle energy
 <<Observables: procedures>>=
   real(default) function obs_energy2 (prt1, prt2) result (e)
     type(prt_t), intent(in) :: prt1, prt2
     type(prt_t) :: prt
     call prt_init_combine (prt, prt1, prt2)
     e = energy (prt_get_momentum (prt))
   end function obs_energy2
 
 @ %def obs_energy2
 @ Particle momentum (components)
 <<Observables: procedures>>=
   real(default) function obs_px2 (prt1, prt2) result (p)
     type(prt_t), intent(in) :: prt1, prt2
     type(prt_t) :: prt
     call prt_init_combine (prt, prt1, prt2)
     p = vector4_get_component (prt_get_momentum (prt), 1)
   end function obs_px2
 
   real(default) function obs_py2 (prt1, prt2) result (p)
     type(prt_t), intent(in) :: prt1, prt2
     type(prt_t) :: prt
     call prt_init_combine (prt, prt1, prt2)
     p = vector4_get_component (prt_get_momentum (prt), 2)
   end function obs_py2
 
   real(default) function obs_pz2 (prt1, prt2) result (p)
     type(prt_t), intent(in) :: prt1, prt2
     type(prt_t) :: prt
     call prt_init_combine (prt, prt1, prt2)
     p = vector4_get_component (prt_get_momentum (prt), 3)
   end function obs_pz2
 
   real(default) function obs_p2 (prt1, prt2) result (p)
     type(prt_t), intent(in) :: prt1, prt2
     type(prt_t) :: prt
     call prt_init_combine (prt, prt1, prt2)
     p = space_part_norm (prt_get_momentum (prt))
   end function obs_p2
 
   real(default) function obs_pl2 (prt1, prt2) result (p)
     type(prt_t), intent(in) :: prt1, prt2
     type(prt_t) :: prt
     call prt_init_combine (prt, prt1, prt2)
     p = longitudinal_part (prt_get_momentum (prt))
   end function obs_pl2
 
   real(default) function obs_pt2 (prt1, prt2) result (p)
     type(prt_t), intent(in) :: prt1, prt2
     type(prt_t) :: prt
     call prt_init_combine (prt, prt1, prt2)
     p = transverse_part (prt_get_momentum (prt))
   end function obs_pt2
 
 @ %def obs_px2 obs_py2 obs_pz2
 @ %def obs_p2 obs_pl2 obs_pt2
 @ Enclosed angle and azimuthal distance (lab frame).
 <<Observables: procedures>>=
   real(default) function obs_theta2 (prt1, prt2) result (p)
     type(prt_t), intent(in) :: prt1, prt2
     p = enclosed_angle (prt_get_momentum (prt1), prt_get_momentum (prt2))
   end function obs_theta2
 
   real(default) function obs_phi2 (prt1, prt2) result (p)
     type(prt_t), intent(in) :: prt1, prt2
     type(prt_t) :: prt
     call prt_init_combine (prt, prt1, prt2)
     p = azimuthal_distance (prt_get_momentum (prt1), prt_get_momentum (prt2))
   end function obs_phi2
 
 @ %def obs_theta2 obs_phi2
 @ Rapidity and pseudorapidity distance
 <<Observables: procedures>>=
   real(default) function obs_rap2 (prt1, prt2) result (p)
     type(prt_t), intent(in) :: prt1, prt2
     p = rapidity_distance &
          (prt_get_momentum (prt1), prt_get_momentum (prt2))
   end function obs_rap2
 
   real(default) function obs_eta2 (prt1, prt2) result (p)
     type(prt_t), intent(in) :: prt1, prt2
     type(prt_t) :: prt
     call prt_init_combine (prt, prt1, prt2)
     p = pseudorapidity_distance &
          (prt_get_momentum (prt1), prt_get_momentum (prt2))
   end function obs_eta2
 
 @ %def obs_rap2 obs_eta2
 @ [This doesn't work!  The principle of no common particle for momentum
   combination prohibits us from combining a decay particle with the momentum
   of its parent.] Polar angle in the rest frame of the 2nd argument.
 <<XXX Observables: procedures>>=
   real(default) function obs_theta_rf2 (prt1, prt2) result (theta)
     type(prt_t), intent(in) :: prt1, prt2
     theta = enclosed_angle_rest_frame &
          (prt_get_momentum (prt1), prt_get_momentum (prt2))
   end function obs_theta_rf2
 
 @ %def obs_theta_rf2
 @ Polar angle of the first particle in the rest frame of the two particles
 combined.
 <<Observables: procedures>>=
   real(default) function obs_theta_star2 (prt1, prt2) result (theta)
     type(prt_t), intent(in) :: prt1, prt2
     theta = enclosed_angle_rest_frame &
          (prt_get_momentum (prt1), &
          prt_get_momentum (prt1) + prt_get_momentum (prt2))
   end function obs_theta_star2
 
 @ %def obs_theta_star2
 @ Distance on the $\eta$-$\phi$ cylinder.
 <<Observables: procedures>>=
   real(default) function obs_dist2 (prt1, prt2) result (dist)
     type(prt_t), intent(in) :: prt1, prt2
     dist = eta_phi_distance &
          (prt_get_momentum (prt1), prt_get_momentum (prt2))
   end function obs_dist2
 
 @ %def obs_dist2
 @ Durham kT measure.
 <<Observables: procedures>>=
   real(default) function obs_ktmeasure (prt1, prt2) result (kt)
     type(prt_t), intent(in) :: prt1, prt2
     real (default) :: q2, e1, e2
     ! Normalized scale to one for now! (#67)
     q2 = 1
     e1 = energy (prt_get_momentum (prt1))
     e2 = energy (prt_get_momentum (prt2))
     kt = (2/q2) * min(e1**2,e2**2) *  &
          (1 - enclosed_angle_ct(prt_get_momentum (prt1), &
          prt_get_momentum (prt2)))
   end function obs_ktmeasure
 
 @ %def obs_ktmeasure
Index: trunk/tests/functional_tests/lcio_11.sh
===================================================================
--- trunk/tests/functional_tests/lcio_11.sh	(revision 0)
+++ trunk/tests/functional_tests/lcio_11.sh	(revision 8385)
@@ -0,0 +1,17 @@
+#!/bin/sh
+### Check WHIZARD for a simple test process
+echo "Running script $0"
+if test -f OCAML_FLAG -a -f LCIO_FLAG; then
+    rm -f @script@_lib.* @script@_p?.*
+    s=`basename @script@`
+    ./run_whizard.sh @script@ --no-logging --model QED
+    echo "Output from running ${s}_rd:" >> ${s}.log
+    ./lcio_rd ${s}_p.slcio 27 347 >> ${s}.log
+    cat ${s}.log | sed -e 's/^ date:.*$/ date: [...]/' | sed -e 's/timestamp .*$/ timestamp [...]/' > ${s}.log.tmp && mv ${s}.log.tmp ${s}.log
+    diff ref-output/$s.ref ${s}.log    
+else
+    echo "|=============================================================================|"
+    echo "No LCIO or no O'Mega matrix elements available, test skipped"
+    exit 77
+fi
+
Index: trunk/tests/functional_tests/lcio_1.sh
===================================================================
--- trunk/tests/functional_tests/lcio_1.sh	(revision 8384)
+++ trunk/tests/functional_tests/lcio_1.sh	(revision 8385)
@@ -1,17 +1,17 @@
 #!/bin/sh
 ### Check WHIZARD for a simple test process
 echo "Running script $0"
 if test -f OCAML_FLAG -a -f LCIO_FLAG; then
     rm -f @script@_lib.* @script@_p?.*
     s=`basename @script@`
     ./run_whizard.sh @script@ --no-logging --model QED
     echo "Output from running ${s}_rd:" >> ${s}.log
-    ./lcio_rd ${s}_p.slcio 0 1 >> ${s}.log
+    ./lcio_rd ${s}_p.slcio 21 1 >> ${s}.log
     cat ${s}.log | sed -e 's/^ date:.*$/ date: [...]/' | sed -e 's/timestamp .*$/ timestamp [...]/' > ${s}.log.tmp && mv ${s}.log.tmp ${s}.log
     diff ref-output/$s.ref ${s}.log    
 else
     echo "|=============================================================================|"
     echo "No LCIO or no O'Mega matrix elements available, test skipped"
     exit 77
 fi
 
Index: trunk/tests/functional_tests/lcio_2.sh
===================================================================
--- trunk/tests/functional_tests/lcio_2.sh	(revision 8384)
+++ trunk/tests/functional_tests/lcio_2.sh	(revision 8385)
@@ -1,17 +1,17 @@
 #!/bin/sh
 ### Check WHIZARD for a simple test process
 echo "Running script $0"
 if test -f OCAML_FLAG -a -f LCIO_FLAG; then
     rm -f @script@_lib.* @script@_p?.*
     s=`basename @script@`
     ./run_whizard.sh @script@ --no-logging --model QED
     echo "Output from running ${s}_rd:" >> ${s}.log
-    ./lcio_rd ${s}_p.slcio 0 1 >> ${s}.log
+    ./lcio_rd ${s}_p.slcio 1 1 >> ${s}.log
     cat ${s}.log | sed -e 's/^ date:.*$/ date: [...]/' | sed -e 's/timestamp .*$/ timestamp [...]/' > ${s}.log.tmp && mv ${s}.log.tmp ${s}.log
     diff ref-output/$s.ref ${s}.log    
 else
     echo "|=============================================================================|"
     echo "No LCIO or no O'Mega matrix elements available, test skipped"
     exit 77
 fi
 
Index: trunk/tests/functional_tests/lcio_3.sh
===================================================================
--- trunk/tests/functional_tests/lcio_3.sh	(revision 8384)
+++ trunk/tests/functional_tests/lcio_3.sh	(revision 8385)
@@ -1,17 +1,17 @@
 #!/bin/sh
 ### Check WHIZARD for a simple test process
 echo "Running script $0"
 if test -f OCAML_FLAG -a -f LCIO_FLAG; then
     rm -f @script@_lib.* @script@_p?.*
     s=`basename @script@`
     ./run_whizard.sh @script@ --no-logging --model QED
     echo "Output from running ${s}_rd:" >> ${s}.log
-    ./lcio_rd ${s}_p.slcio 0 1 >> ${s}.log
+    ./lcio_rd ${s}_p.slcio 1 1 >> ${s}.log
     cat ${s}.log | sed -e 's/^ date:.*$/ date: [...]/' | sed -e 's/timestamp .*$/ timestamp [...]/' > ${s}.log.tmp && mv ${s}.log.tmp ${s}.log
     diff ref-output/$s.ref ${s}.log    
 else
     echo "|=============================================================================|"
     echo "No LCIO or no O'Mega matrix elements available, test skipped"
     exit 77
 fi
 
Index: trunk/tests/functional_tests/lcio_4.sh
===================================================================
--- trunk/tests/functional_tests/lcio_4.sh	(revision 8384)
+++ trunk/tests/functional_tests/lcio_4.sh	(revision 8385)
@@ -1,17 +1,17 @@
 #!/bin/sh
 ### Check WHIZARD for a simple test process
 echo "Running script $0"
 if test -f OCAML_FLAG -a -f LCIO_FLAG; then
     rm -f @script@_lib.* @script@_p?.*
     s=`basename @script@`
     ./run_whizard.sh @script@ --no-logging --model QED
     echo "Output from running ${s}_rd:" >> ${s}.log
-    ./lcio_rd ${s}_p.slcio 0 1 >> ${s}.log
+    ./lcio_rd ${s}_p.slcio 1 1 >> ${s}.log
     cat ${s}.log | sed -e 's/^ date:.*$/ date: [...]/' | sed -e 's/timestamp .*$/ timestamp [...]/' > ${s}.log.tmp && mv ${s}.log.tmp ${s}.log
     diff ref-output/$s.ref ${s}.log    
 else
     echo "|=============================================================================|"
     echo "No LCIO or no O'Mega matrix elements available, test skipped"
     exit 77
 fi
 
Index: trunk/tests/functional_tests/lcio_5.sh
===================================================================
--- trunk/tests/functional_tests/lcio_5.sh	(revision 8384)
+++ trunk/tests/functional_tests/lcio_5.sh	(revision 8385)
@@ -1,17 +1,17 @@
 #!/bin/sh
 ### Check WHIZARD for a simple test process
 echo "Running script $0"
 if test -f OCAML_FLAG -a -f LCIO_FLAG; then
     rm -f @script@_lib.* @script@_p?.*
     s=`basename @script@`
     ./run_whizard.sh @script@ --no-logging --model QED
     echo "Output from running ${s}_rd:" >> ${s}.log
-    ./lcio_rd ${s}_p.slcio 0 1 >> ${s}.log
+    ./lcio_rd ${s}_p.slcio 1 1 >> ${s}.log
     cat ${s}.log | sed -e 's/^ date:.*$/ date: [...]/' | sed -e 's/timestamp .*$/ timestamp [...]/' > ${s}.log.tmp && mv ${s}.log.tmp ${s}.log
     diff ref-output/$s.ref ${s}.log    
 else
     echo "|=============================================================================|"
     echo "No LCIO or no O'Mega matrix elements available, test skipped"
     exit 77
 fi
 
Index: trunk/tests/functional_tests/lcio_10.sh
===================================================================
--- trunk/tests/functional_tests/lcio_10.sh	(revision 8384)
+++ trunk/tests/functional_tests/lcio_10.sh	(revision 8385)
@@ -1,17 +1,17 @@
 #!/bin/sh
 ### Check WHIZARD for a simple test process
 echo "Running script $0"
 if test -f OCAML_FLAG -a -f LCIO_FLAG; then
     rm -f @script@_lib.* @script@_p?.*
     s=`basename @script@`
     ./run_whizard.sh @script@ --no-logging --model QED
     echo "Output from running ${s}_rd:" >> ${s}.log
-    ./lcio_rd ${s}_p.slcio 0 1 >> ${s}.log
+    ./lcio_rd ${s}_p.slcio 1 1 >> ${s}.log
     cat ${s}.log | sed -e 's/^ date:.*$/ date: [...]/' | sed -e 's/timestamp .*$/ timestamp [...]/' > ${s}.log.tmp && mv ${s}.log.tmp ${s}.log
     diff ref-output/$s.ref ${s}.log    
 else
     echo "|=============================================================================|"
     echo "No LCIO or no O'Mega matrix elements available, test skipped"
     exit 77
 fi
 
Index: trunk/tests/functional_tests/Makefile.am
===================================================================
--- trunk/tests/functional_tests/Makefile.am	(revision 8384)
+++ trunk/tests/functional_tests/Makefile.am	(revision 8385)
@@ -1,812 +1,814 @@
 ## Makefile.am -- Makefile for executable WHIZARD test scripts
 ##
 ## Process this file with automake to produce Makefile.in
 ##
 ########################################################################
 #
 # Copyright (C) 1999-2020 by
 #     Wolfgang Kilian <kilian@physik.uni-siegen.de>
 #     Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
 #     Juergen Reuter <juergen.reuter@desy.de>
 #     with contributions from
 #     cf. main AUTHORS file
 #
 # WHIZARD is free software; you can redistribute it and/or modify it
 # under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 2, or (at your option)
 # any later version.
 #
 # WHIZARD is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
 #
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 #
 ########################################################################
 
 WHIZARD_DRIVER = run_whizard.sh
 
 TESTS_DEFAULT = \
     empty.run \
     fatal.run \
     cmdline_1.run \
     structure_1.run \
     structure_2.run \
     structure_3.run \
     structure_4.run \
     structure_5.run \
     structure_6.run \
     structure_7.run \
     structure_8.run \
     vars.run \
     extpar.run \
     testproc_1.run \
     testproc_2.run \
     testproc_3.run \
     testproc_4.run \
     testproc_5.run \
     testproc_6.run \
     testproc_7.run \
     testproc_8.run \
     testproc_9.run \
     testproc_10.run \
     testproc_11.run \
     testproc_12.run \
     template_me_1.run \
     template_me_2.run \
     model_scheme_1.run \
     rebuild_1.run \
     rebuild_4.run \
     susyhit.run \
     helicity.run \
     libraries_4.run \
     job_id_1.run \
     pack_1.run
 
 XFAIL_TESTS_DEFAULT =
 
 TESTS_REQ_FASTJET = \
     analyze_4.run \
     bjet_cluster.run \
     openloops_12.run \
     openloops_13.run
 
 TESTS_REQ_OCAML = \
     libraries_1.run \
     libraries_2.run \
     libraries_3.run \
     rebuild_2.run \
     rebuild_3.run \
     rebuild_5.run \
     defaultcuts.run \
     cuts.run \
     model_change_1.run \
     model_change_2.run \
     model_change_3.run \
     model_test.run \
     job_id_2.run \
     job_id_3.run \
     job_id_4.run \
     qedtest_1.run \
     qedtest_2.run \
     qedtest_3.run \
     qedtest_4.run \
     qedtest_5.run \
     qedtest_6.run \
     qedtest_7.run \
     qedtest_8.run \
     qedtest_9.run \
     qedtest_10.run \
     rambo_vamp_1.run \
     rambo_vamp_2.run \
     beam_setup_1.run \
     beam_setup_2.run \
     beam_setup_3.run \
     beam_setup_4.run \
     beam_setup_5.run \
     qcdtest_1.run \
     qcdtest_2.run \
     qcdtest_3.run \
     qcdtest_4.run \
     qcdtest_5.run \
     qcdtest_6.run \
     observables_1.run \
     observables_2.run \
     event_weights_1.run \
     event_weights_2.run \
     event_eff_1.run \
     event_eff_2.run \
     event_dump_1.run \
     event_dump_2.run \
     event_failed_1.run \
     reweight_1.run \
     reweight_2.run \
     reweight_3.run \
     reweight_4.run \
     reweight_5.run \
     reweight_6.run \
     reweight_7.run \
     reweight_8.run \
     reweight_9.run \
     reweight_10.run \
     analyze_1.run \
     analyze_2.run \
     analyze_5.run \
     analyze_6.run \
     colors.run \
     colors_2.run \
     colors_hgg.run \
     alphas.run \
     jets_xsec.run \
     lhef_1.run \
     lhef_2.run \
     lhef_3.run \
     lhef_4.run \
     lhef_5.run \
     lhef_6.run \
     lhef_7.run \
     lhef_8.run \
     lhef_9.run \
     lhef_10.run \
     lhef_11.run \
     stdhep_1.run \
     stdhep_2.run \
     stdhep_3.run \
     stdhep_4.run \
     stdhep_5.run \
     stdhep_6.run \
     select_1.run \
     select_2.run \
     fatal_beam_decay.run \
     smtest_1.run \
     smtest_2.run \
     smtest_3.run \
     smtest_4.run \
     smtest_5.run \
     smtest_6.run \
     smtest_7.run \
     smtest_8.run \
     smtest_9.run \
     smtest_10.run \
     smtest_11.run \
     smtest_12.run \
     smtest_13.run \
     smtest_14.run \
     smtest_15.run \
     smtest_16.run \
     photon_isolation_1.run \
     photon_isolation_2.run \
     resonances_1.run \
     resonances_2.run \
     resonances_3.run \
     resonances_4.run \
     resonances_5.run \
     resonances_6.run \
     resonances_7.run \
     resonances_8.run \
     resonances_9.run \
     resonances_10.run \
     resonances_11.run \
     resonances_12.run \
     mssmtest_1.run \
     mssmtest_2.run \
     mssmtest_3.run \
     sm_cms_1.run \
     ufo_1.run \
     ufo_2.run \
     ufo_3.run \
     ufo_4.run \
     ufo_5.run \
     nlo_1.run \
     nlo_2.run \
     nlo_3.run \
     nlo_4.run \
     nlo_5.run \
     nlo_6.run \
     nlo_decay_1.run \
     real_partition_1.run \
     fks_res_1.run \
     fks_res_2.run \
     fks_res_3.run \
     openloops_1.run \
     openloops_2.run \
     openloops_3.run \
     openloops_4.run \
     openloops_5.run \
     openloops_6.run \
     openloops_7.run \
     openloops_8.run \
     openloops_9.run \
     openloops_10.run \
     openloops_11.run \
     recola_1.run \
     recola_2.run \
     recola_3.run \
     recola_4.run \
     recola_5.run \
     recola_6.run \
     recola_7.run \
     recola_8.run \
     recola_9.run \
     powheg_1.run \
     spincor_1.run \
     show_1.run \
     show_2.run \
     show_3.run \
     show_4.run \
     show_5.run \
     method_ovm_1.run \
     multi_comp_1.run \
     multi_comp_2.run \
     multi_comp_3.run \
     multi_comp_4.run \
     flvsum_1.run \
     br_redef_1.run \
     decay_err_1.run \
     decay_err_2.run \
     decay_err_3.run \
     polarized_1.run \
     pdf_builtin.run \
     ep_1.run \
     ep_2.run \
     ep_3.run \
     circe1_1.run \
     circe1_2.run \
     circe1_3.run \
     circe1_4.run \
     circe1_5.run \
     circe1_6.run \
     circe1_7.run \
     circe1_8.run \
     circe1_9.run \
     circe1_10.run \
     circe1_photons_1.run \
     circe1_photons_2.run \
     circe1_photons_3.run \
     circe1_photons_4.run \
     circe1_photons_5.run \
     circe1_errors_1.run \
     circe2_1.run \
     circe2_2.run \
     circe2_3.run \
     ewa_1.run \
     ewa_2.run \
     ewa_3.run \
     ewa_4.run \
     isr_1.run \
     isr_2.run \
     isr_3.run \
     isr_4.run \
     isr_5.run \
     epa_1.run \
     epa_2.run \
     epa_3.run \
     isr_epa_1.run \
     ilc.run \
     gaussian_1.run \
     gaussian_2.run \
     beam_events_1.run \
     beam_events_2.run \
     beam_events_3.run \
     beam_events_4.run \
     energy_scan_1.run \
     restrictions.run \
     process_log.run \
     shower_err_1.run \
     parton_shower_1.run \
     parton_shower_2.run \
     hadronize_1.run \
     mlm_matching_fsr.run \
     user_cuts.run \
     user_prc_threshold_1.run \
     cascades2_phs_1.run \
     user_prc_threshold_2.run \
     vamp2_1.run \
     vamp2_2.run
 
 XFAIL_TESTS_REQ_OCAML = \
     colors_hgg.run \
     hadronize_1.run \
     user_cuts.run
 
 TESTS_REQ_HEPMC = \
     hepmc_1.run \
     hepmc_2.run \
     hepmc_3.run \
     hepmc_4.run \
     hepmc_5.run \
     hepmc_6.run \
     hepmc_7.run \
     hepmc_8.run \
     hepmc_9.run \
     hepmc_10.run
 XFAIL_TESTS_REQ_HEPMC =
 
 TESTS_REQ_LCIO = \
     lcio_1.run \
     lcio_2.run \
     lcio_3.run \
     lcio_4.run \
     lcio_5.run \
     lcio_6.run \
     lcio_7.run \
     lcio_8.run \
     lcio_9.run \
-    lcio_10.run
+    lcio_10.run \
+    lcio_11.run
 XFAIL_TESTS_REQ_LCIO =
 
 TESTS_REQ_LHAPDF5 = \
     lhapdf5.run
 TESTS_REQ_LHAPDF6 = \
     lhapdf6.run
 XFAIL_TESTS_REQ_LHAPDF5 =
 XFAIL_TESTS_REQ_LHAPDF6 =
 
 TESTS_STATIC = \
     static_1.run \
     static_2.run
 XFAIL_TESTS_STATIC =
 
 TESTS_REQ_PYTHIA6 = \
     pythia6_1.run \
     pythia6_2.run \
     pythia6_3.run \
     pythia6_4.run \
     tauola_1.run \
     tauola_2.run \
     isr_5.run \
     mlm_pythia6_isr.run \
     mlm_matching_isr.run
 XFAIL_TESTS_REQ_PYTHIA6 =
 
 TESTS_REQ_PYTHIA8 =
 #    pythia8_1.run \
 #    pythia8_2.run
 XFAIL_TESTS_REQ_PYTHIA8 =
 
 TESTS_REQ_EV_ANA = \
     analyze_3.run
 XFAIL_TESTS_REQ_EV_ANA =
 
 TESTS_REQ_GAMELAN = \
     analyze_3.run
 
 TEST_DRIVERS_RUN = \
     $(TESTS_DEFAULT) \
     $(TESTS_REQ_OCAML) \
     $(TESTS_REQ_LHAPDF5) \
     $(TESTS_REQ_LHAPDF6) \
     $(TESTS_REQ_HEPMC) \
     $(TESTS_REQ_LCIO) \
     $(TESTS_REQ_FASTJET) \
     $(TESTS_REQ_PYTHIA6) \
     $(TESTS_REQ_EV_ANA) \
     $(TESTS_STATIC)
 
 TEST_DRIVERS_SH = $(TEST_DRIVERS_RUN:.run=.sh)
 
 ########################################################################
 
 TESTS = 
 XFAIL_TESTS =
 TESTS_SRC =
 
 TESTS += $(TESTS_DEFAULT)
 XFAIL_TESTS += $(XFAIL_TESTS_DEFAULT)
 
 TESTS += $(TESTS_REQ_OCAML)
 XFAIL_TESTS += $(XFAIL_TESTS_REQ_OCAML)
 
 TESTS += $(TESTS_REQ_HEPMC)
 XFAIL_TESTS += $(XFAIL_TESTS_REQ_HEPMC)
 
 TESTS += $(TESTS_REQ_LCIO)
 XFAIL_TESTS += $(XFAIL_TESTS_REQ_LCIO)
 
 TESTS += $(TESTS_REQ_FASTJET)
 XFAIL_TESTS += $(XFAIL_TESTS_REQ_FASTJET)
 
 TESTS += $(TESTS_REQ_LHAPDF5)
 XFAIL_TESTS += $(XFAIL_TESTS_REQ_LHAPDF5)
 
 TESTS += $(TESTS_REQ_LHAPDF6)
 XFAIL_TESTS += $(XFAIL_TESTS_REQ_LHAPDF6)
 
 TESTS += $(TESTS_REQ_PYTHIA6)
 XFAIL_TESTS += $(XFAIL_TESTS_REQ_PYTHIA6)
 
 TESTS += $(TESTS_REQ_PYTHIA8)
 XFAIL_TESTS += $(XFAIL_TESTS_REQ_PYTHIA8)
 
 TESTS += $(TESTS_REQ_EV_ANA)
 XFAIL_TESTS += $(XFAIL_TESTS_REQ_EV_ANA)
 
 TESTS += $(TESTS_STATIC)
 XFAIL_TESTS += $(XFAIL_TESTS_STATIC)
 
 
 EXTRA_DIST = $(TEST_DRIVERS_SH) \
     $(TESTS_SRC)
 
 ########################################################################
 
 VPATH = $(srcdir)
 
 SUFFIXES = .sh .run
 
 .sh.run:
 	@rm -f $@
 	@if test -f $(top_builddir)/share/tests/functional_tests/$*.sin; then \
 		$(SED) 's|@script@|$(top_builddir)/share/tests/functional_tests/$*|g' $< > $@; \
 	elif test -f $(top_srcdir)/share/tests/functional_tests/$*.sin; then \
 		$(SED) 's|@script@|$(top_srcdir)/share/tests/functional_tests/$*|g' $< > $@; \
 	else \
 		echo "$*.sin not found!" 1>&2; \
 		exit 2; \
 	fi
 	@chmod +x $@
 
 cmdline_1.run: cmdline_1_a.sin cmdline_1_b.sin
 cmdline_1_a.sin: $(top_builddir)/share/tests/functional_tests/cmdline_1_a.sin
 	cp $< $@
 cmdline_1_b.sin: $(top_builddir)/share/tests/functional_tests/cmdline_1_b.sin
 	cp $< $@
 
 structure_2.run: structure_2_inc.sin
 structure_2_inc.sin: $(top_builddir)/share/tests/functional_tests/structure_2_inc.sin
 	cp $< $@
 
 testproc_3.run: testproc_3.phs
 testproc_3.phs: $(top_builddir)/share/tests/functional_tests/testproc_3.phs
 	cp $< $@
 
 static_1.run: static_1.exe.sin
 static_1.exe.sin: $(top_builddir)/share/tests/functional_tests/static_1.exe.sin
 	cp $< $@
 static_2.run: static_2.exe.sin
 static_2.exe.sin: $(top_builddir)/share/tests/functional_tests/static_2.exe.sin
 	cp $< $@
 
 susyhit.run: susyhit.in
 user_cuts.run: user_cuts.f90
 user_cuts.f90: $(top_builddir)/share/tests/functional_tests/user_cuts.f90
 	cp $< $@
 
 model_test.run: tdefs.$(FC_MODULE_EXT) tglue.$(FC_MODULE_EXT) \
 	threeshl.$(FC_MODULE_EXT) tscript.$(FC_MODULE_EXT)
 tdefs.mod: $(top_builddir)/src/models/threeshl_bundle/tdefs.$(FC_MODULE_EXT)
 	cp $< $@
 tglue.mod: $(top_builddir)/src/models/threeshl_bundle/tglue.$(FC_MODULE_EXT)
 	cp $< $@
 tscript.mod: $(top_builddir)/src/models/threeshl_bundle/tscript.$(FC_MODULE_EXT)
 	cp $< $@
 threeshl.mod: $(top_builddir)/src/models/threeshl_bundle/threeshl.$(FC_MODULE_EXT)
 	cp $< $@
 
 WT_OCAML_NATIVE_EXT=opt
 
 if OCAML_AVAILABLE
 OMEGA_QED = $(top_builddir)/omega/bin/omega_QED.$(WT_OCAML_NATIVE_EXT)
 OMEGA_QCD = $(top_builddir)/omega/bin/omega_QCD.$(WT_OCAML_NATIVE_EXT)
 OMEGA_MSSM = $(top_builddir)/omega/bin/omega_MSSM.$(WT_OCAML_NATIVE_EXT)
 
 omega_MSSM.$(WT_OMEGA_CACHE_SUFFIX): $(OMEGA_MSSM)
 	$(OMEGA_MSSM) -initialize .
 
 UFO_TAG_FILE = __init__.py
 UFO_MODELPATH = ../models/UFO
 
 ufo_1.run: ufo_1_SM/$(UFO_TAG_FILE)
 ufo_2.run: ufo_2_SM/$(UFO_TAG_FILE)
 ufo_3.run: ufo_3_models/ufo_3_SM/$(UFO_TAG_FILE)
 ufo_4.run: ufo_4_models/ufo_4_SM/$(UFO_TAG_FILE)
 ufo_5.run: ufo_5_SM/$(UFO_TAG_FILE)
 
 ufo_1_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
 	mkdir -p ufo_1_SM
 	cp $(UFO_MODELPATH)/SM/*.py ufo_1_SM
 ufo_2_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
 	mkdir -p ufo_2_SM
 	cp $(UFO_MODELPATH)/SM/*.py ufo_2_SM
 ufo_3_models/ufo_3_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
 	mkdir -p ufo_3_models/ufo_3_SM
 	cp $(UFO_MODELPATH)/SM/*.py ufo_3_models/ufo_3_SM
 ufo_4_models/ufo_4_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
 	mkdir -p ufo_4_models/ufo_4_SM
 	cp $(UFO_MODELPATH)/SM/*.py ufo_4_models/ufo_4_SM
 ufo_5_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
 	mkdir -p ufo_5_SM
 	cp $(UFO_MODELPATH)/SM/*.py ufo_5_SM
 
 ufo_5.run: ufo_5_test.slha
 ufo_5_test.slha: $(top_builddir)/share/tests/functional_tests/ufo_5_test.slha
 	cp $< $@
 
 $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE): $(top_srcdir)/omega/tests/UFO/SM/$(UFO_TAG_FILE)
 	$(MAKE) -C $(UFO_MODELPATH)/SM all
 
 endif OCAML_AVAILABLE
 
 if MPOST_AVAILABLE
 $(TESTS_REQ_GAMELAN): gamelan.sty
 gamelan.sty: $(top_builddir)/src/gamelan/gamelan.sty
 	cp $< $@
 
 $(top_builddir)/src/gamelan/gamelan.sty:
 	$(MAKE) -C $(top_builddir)/src/gamelan gamelan.sty
 endif
 
 noinst_PROGRAMS = 
 
 if OCAML_AVAILABLE
 noinst_PROGRAMS += resonances_1_count
 resonances_1_count_SOURCES = resonances_1_count.f90
 resonances_1.run: resonances_1_count
 
 noinst_PROGRAMS += resonances_2_count
 resonances_2_count_SOURCES = resonances_2_count.f90
 resonances_2.run: resonances_2_count
 
 noinst_PROGRAMS += resonances_3_count
 resonances_3_count_SOURCES = resonances_3_count.f90
 resonances_3.run: resonances_3_count
 
 noinst_PROGRAMS += resonances_4_count
 resonances_4_count_SOURCES = resonances_4_count.f90
 resonances_4.run: resonances_4_count
 
 noinst_PROGRAMS += resonances_9_count
 resonances_9_count_SOURCES = resonances_9_count.f90
 resonances_9.run: resonances_9_count
 
 noinst_PROGRAMS += resonances_10_count
 resonances_10_count_SOURCES = resonances_10_count.f90
 resonances_10.run: resonances_10_count
 
 noinst_PROGRAMS += resonances_11_count
 resonances_11_count_SOURCES = resonances_11_count.f90
 resonances_11.run: resonances_11_count
 
 noinst_PROGRAMS += epa_2_count
 epa_2_count_SOURCES = epa_2_count.f90
 epa_2.run: epa_2_count
 
 noinst_PROGRAMS += isr_epa_1_count
 isr_epa_1_count_SOURCES = isr_epa_1_count.f90
 isr_epa_1.run: isr_epa_1_count
 
 noinst_PROGRAMS += analyze_6_check
 analyze_6_check_SOURCES = analyze_6_check.f90
 analyze_6.run: analyze_6_check
 
 endif
 
 if HEPMC_AVAILABLE
 TESTS_SRC += $(hepmc_6_rd_SOURCES)
 noinst_PROGRAMS += hepmc_6_rd
 if HEPMC_IS_VERSION3
 hepmc_6_rd_SOURCES = hepmc3_6_rd.cpp
 else
 hepmc_6_rd_SOURCES = hepmc2_6_rd.cpp
 endif
 hepmc_6_rd_CXXFLAGS = $(HEPMC_INCLUDES) $(AM_CXXFLAGS)
 hepmc_6_rd_LDADD = $(LDFLAGS_HEPMC)
 hepmc_6.run: hepmc_6_rd
 endif
 
 if LCIO_AVAILABLE
 TESTS_SRC += $(lcio_rd_SOURCES)
 noinst_PROGRAMS += lcio_rd
 lcio_rd_SOURCES = lcio_rd.cpp
 lcio_rd_CXXFLAGS = $(LCIO_INCLUDES) $(AM_CXXFLAGS)
 lcio_rd_LDADD = $(LDFLAGS_LCIO)
 lcio_1.run: lcio_rd
 lcio_2.run: lcio_rd
 lcio_3.run: lcio_rd
 lcio_4.run: lcio_rd
 lcio_5.run: lcio_rd
 lcio_10.run: lcio_rd
+lcio_11.run: lcio_rd
 endif
 
 stdhep_4.run: stdhep_rd
 stdhep_5.run: stdhep_rd
 stdhep_6.run: stdhep_rd
 polarized_1.run: stdhep_rd
 tauola_1.run: stdhep_rd
 tauola_2.run: stdhep_rd
 stdhep_rd: $(top_builddir)/src/xdr/stdhep_rd
 	cp $< $@
 
 susyhit.in: $(top_builddir)/share/tests/functional_tests/susyhit.in
 	cp $< $@
 
 BUILT_SOURCES = \
     TESTFLAG  \
     HEPMC2_FLAG \
     HEPMC3_FLAG \
     LCIO_FLAG \
     FASTJET_FLAG \
     LHAPDF5_FLAG \
     LHAPDF6_FLAG \
     GAMELAN_FLAG \
     MPI_FLAG \
     EVENT_ANALYSIS_FLAG \
     OCAML_FLAG \
     PYTHIA6_FLAG \
     PYTHIA8_FLAG \
     OPENLOOPS_FLAG \
     RECOLA_FLAG \
     GZIP_FLAG \
     STATIC_FLAG \
     ref-output
 
 # If this file is found in the working directory, WHIZARD
 # will use the paths for the uninstalled version (source/build tree),
 # otherwise it uses the installed version
 TESTFLAG:
 	touch $@
 
 FASTJET_FLAG:
 if FASTJET_AVAILABLE
 	touch $@
 endif
 
 HEPMC2_FLAG:
 if HEPMC2_AVAILABLE
 	touch $@
 endif
 
 HEPMC3_FLAG:
 if HEPMC3_AVAILABLE
 	touch $@
 endif
 
 LCIO_FLAG:
 if LCIO_AVAILABLE
 	touch $@
 endif
 
 LHAPDF5_FLAG:
 if LHAPDF5_AVAILABLE
 	touch $@
 endif
 
 LHAPDF6_FLAG:
 if LHAPDF6_AVAILABLE
 	touch $@
 endif
 
 GAMELAN_FLAG:
 if MPOST_AVAILABLE
 	touch $@
 endif
 
 MPI_FLAG:
 if FC_USE_MPI
 	touch $@
 endif
 
 OCAML_FLAG:
 if OCAML_AVAILABLE
 	touch $@
 endif
 
 PYTHIA6_FLAG:
 if PYTHIA6_AVAILABLE
 	touch $@
 endif
 
 PYTHIA8_FLAG:
 if PYTHIA8_AVAILABLE
 	touch $@
 endif
 
 OPENLOOPS_FLAG:
 if OPENLOOPS_AVAILABLE
 	touch $@
 endif
 
 RECOLA_FLAG:
 if RECOLA_AVAILABLE
 	touch $@
 endif
 
 EVENT_ANALYSIS_FLAG:
 if EVENT_ANALYSIS_AVAILABLE
 	touch $@
 endif
 
 GZIP_FLAG:
 if GZIP_AVAILABLE
 	touch $@
 endif
 
 STATIC_FLAG:
 if STATIC_AVAILABLE
 	touch $@
 endif
 
 # The reference output files are in the source directory.  Copy them here.
 if FC_QUAD
 ref-output: $(top_srcdir)/share/tests/functional_tests/ref-output
 	mkdir -p ref-output
 	for f in $</*.ref; do cp $$f $@; done
 	for f in $</../ref-output-prec/*.ref; do cp $$f $@; done
 	for f in $</../ref-output-quad/*.ref; do cp $$f $@; done
 else
 if FC_EXT
 ref-output: $(top_srcdir)/share/tests/functional_tests/ref-output
 	mkdir -p ref-output
 	for f in $</*.ref; do cp $$f $@; done
 	for f in $</../ref-output-prec/*.ref; do cp $$f $@; done
 	for f in $</../ref-output-ext/*.ref; do cp $$f $@; done
 else
 ref-output: $(top_srcdir)/share/tests/functional_tests/ref-output
 	mkdir -p ref-output
 	for f in $</*.ref; do cp $$f $@; done
 	for f in $</../ref-output-double/*.ref; do cp $$f $@; done
 endif
 endif
 
 ## installcheck runs the test scripts with the TESTFLAG removed.
 installcheck-local: notestflag check-am
 notestflag:
 	rm -f TESTFLAG
 .PHONY: notestflag
 
 ### Remove DWARF debug information on MAC OS X
 clean-macosx:
 	-rm -rf hepmc_6_rd.dSYM
 	-rm -rf lcio_rd.dSYM
 	-rm -rf static_1.exe.dSYM
 	-rm -rf static_2.exe.dSYM
 .PHONY: clean-macosx
 
 ## Remove generated files
 clean-local: clean-macosx
 	rm -f gamelan.sty
 	rm -f TESTFLAG GAMELAN_FLAG MPI_FLAG RECOLA_FLAG
 	rm -f OCAML_FLAG OPENLOOPS_FLAG FASTJET_FLAG HEPMC2_FLAG HEPMC3_FLAG
 	rm -f LCIO_FLAG EVENT_ANALYSIS_FLAG PYTHIA6_FLAG PYTHIA8_FLAG 
 	rm -f LHAPDF5_FLAG LHAPDF6_FLAG 
 	rm -f GZIP_FLAG STATIC_FLAG static_1.exe static_2.exe
 	rm -f *.run *.log slha_test.out *_check.out ufo_5_test.slha
 	rm -f core* stdhep_rd
 	rm -f *.f90 *.f90.in *.c *.$(FC_MODULE_EXT) *.o *.la
 	rm -f *_count.out
 	rm -f *.makefile
 	rm -f *.grid
 	rm -rf err-output
 	rm -rf ref-output
 	rm -f *.sin *.hbc *_fks_regions.out
 	rm -f *.olc *.olp *.olp_parameters output.rcl
 	rm -f *.phs *.vg *.vg2 *.vgx2 *.pg *.vgb *.evt *.evx *.lhe *.hepmc *.dat *.debug *.fds
 	rm -f *.tmp *.hepevt *.hepevt.verb *.lha *.lha.verb *.slcio
 	rm -f prc_omega_diags_1_p_i1_diags.out prc_omega_diags_1_p_i1_diags.toc
 	rm -rf pack_1.1 pack_1.2 pack_1.3 pack_1.4
 	rm -rf pack_1.1.tgz pack_1.2.tgz pack_1.3.tgz pack_1.4.tgz
 	rm -f *.hep *.up.hep *.[1-9] *.[1-9][0-9] *.[1-9][0-9][0-9] 
 	rm -f *.tex *.mp *.mpx *.t[1-9] *.t[1-9][0-9] *.t[1-9][0-9][0-9] 
 	rm -f *.ltp *.aux *.dvi *.ps *.pdf so_test.*
 	rm -f *.tbl sps1ap_decays.slha bar structure_6[a-b].out 
 	rm -f slhaspectrum.in suspect2.out suspect2_lha.out 
 	rm -f susyhit.in susyhit_slha.out suspect2_lha.in
 	rm -rf job_id_3_x.8001 job_id_4_x.8001
 	rm -rf ufo_1_SM ufo_2_SM ufo_3_models ufo_4_models ufo_5_SM
 	rm -f ufo_1_SM.ufo.mdl ufo_2_SM.ufo.mdl
 	rm -f ufo_3_SM.ufo.mdl ufo_4_SM.ufo.mdl
 	rm -f ufo_5_SM.ufo.mdl
 	rm -f *.$(WT_OMEGA_CACHE_SUFFIX)
 	rm -rf output_cll
 	rm -rf *.dSYM
 if FC_SUBMODULES
 	rm -f *.smod
 endif
 
 ## Remove backup files
 maintainer-clean-local: maintainer-clean-fc
 	-rm -f *~
 .PHONY: maintainer-clean-local
Index: trunk/share/tests/functional_tests/ref-output-double/lcio_2.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-double/lcio_2.ref	(revision 8384)
+++ trunk/share/tests/functional_tests/ref-output-double/lcio_2.ref	(revision 8385)
@@ -1,119 +1,119 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?write_raw = false
 seed = 0
 | Process library 'lcio_2_lib': recorded process 'lcio_2_p'
 sqrts =  1.000000000000E+03
 | Integrate: current process library needs compilation
 | Process library 'lcio_2_lib': compiling ...
 | Process library 'lcio_2_lib': writing makefile
 | Process library 'lcio_2_lib': removing old files
 | Process library 'lcio_2_lib': writing driver
 | Process library 'lcio_2_lib': creating source code
 | Process library 'lcio_2_lib': compiling sources
 | Process library 'lcio_2_lib': linking
 | Process library 'lcio_2_lib': loading
 | Process library 'lcio_2_lib': ... success.
 | Integrate: compilation done
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process lcio_2_p:
 | Beam structure: e-, e+ => isr
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)
 |   e+  (mass = 5.1100000E-04 GeV)
 |   sqrts = 1.000000000000E+03 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'lcio_2_p.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'lcio_2_p'
 |   Library name  = 'lcio_2_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'lcio_2_p_i1':   e-, e+ => m-, m+ [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 'lcio_2_p'
 | 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  9.9403105E+01  4.65E+00    4.67    0.47*  24.86
 |-----------------------------------------------------------------------------|
    1        100  9.9403105E+01  4.65E+00    4.67    0.47   24.86
 |=============================================================================|
 n_events = 1
 openmp_num_threads = 1
 | Starting simulation for process 'lcio_2_p'
 | Simulate: using integration grids from file 'lcio_2_p.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] =   1.0060E-02
 | Events: writing to LCIO file 'lcio_2_p.slcio'
 | Events: generating 1 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: actual unweighting efficiency = 100.00 %
 | Events: closing LCIO file 'lcio_2_p.slcio'
 | There were no errors and    1 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
 Output from running lcio_2_rd:
 
 ============================================================================
-        Event  : 1 - run:  0 -  timestamp [...]
+        Event  : 1 - run:  1 -  timestamp [...]
 ============================================================================
  date: [...]
  detector : unknown
  event parameters: 
  parameter Event Number [int]: 1, 
  parameter ProcessID [int]: 1, 
- parameter Run ID [int]: 0, 
+ parameter Run ID [int]: 1, 
  parameter beamPDG1 [int]: 11, 
  parameter beamPDG2 [int]: -11, 
  parameter Energy [float]: 1000, 
  parameter _weight [float]: 1, 
  parameter alphaQCD [float]: 0.1178, 
  parameter beamPol1 [float]: 0, 
  parameter beamPol2 [float]: 0, 
  parameter crossSection [float]: 99.4031, 
  parameter crossSectionError [float]: 4.64628, 
  parameter scale [float]: 998.962, 
  parameter sqme [float]: 1.34846e+06, 
  parameter BeamSpectrum [string]: , 
  parameter processName [string]: lcio_2_p, 
 
  collection name : MCParticle
  parameters: 
 
 --------------- print out of MCParticle collection --------------- 
 
   flag:  0x0
   simulator status bits: [sbvtcls]  s: created in simulation b: backscatter v: vertex is not endpoint of parent t: decayed in tracker c: decayed in calorimeter l: has left detector s: stopped o: overlay
 
 
 [   id   ]index|      PDG |    px,     py,        pz    | energy  |gen|[simstat ]| vertex x,     y   ,   z     |    mass |  charge |            spin             | colorflow | [parents] - [daughters]
 
 [00000004]    0|        11| 0.00e+00, 0.00e+00, 5.00e+02| 5.00e+02| 4 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,4] 
 [00000005]    1|       -11| 0.00e+00, 0.00e+00,-5.00e+02| 5.00e+02| 4 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [3,5] 
 [00000006]    2|        11| 0.00e+00, 0.00e+00, 4.99e+02| 4.99e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0] - [6,7] 
 [00000007]    3|       -11| 0.00e+00, 0.00e+00,-5.00e+02| 5.00e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [1] - [6,7] 
 [00000008]    4|        22| 0.00e+00, 0.00e+00, 1.04e+00| 1.04e+00| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0] - [] 
 [00000009]    5|        22| 0.00e+00, 0.00e+00,-2.44e-06| 2.44e-06| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [1] - [] 
 [00000010]    6|        13| 2.77e+01,-2.11e+02,-4.52e+02| 5.00e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [2,3] - [] 
 [00000011]    7|       -13|-2.77e+01, 2.11e+02, 4.51e+02| 4.99e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [2,3] - [] 
 
 -------------------------------------------------------------------------------- 
Index: trunk/share/tests/functional_tests/ref-output-quad/lcio_2.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-quad/lcio_2.ref	(revision 8384)
+++ trunk/share/tests/functional_tests/ref-output-quad/lcio_2.ref	(revision 8385)
@@ -1,119 +1,119 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?write_raw = false
 seed = 0
 | Process library 'lcio_2_lib': recorded process 'lcio_2_p'
 sqrts =  1.000000000000E+03
 | Integrate: current process library needs compilation
 | Process library 'lcio_2_lib': compiling ...
 | Process library 'lcio_2_lib': writing makefile
 | Process library 'lcio_2_lib': removing old files
 | Process library 'lcio_2_lib': writing driver
 | Process library 'lcio_2_lib': creating source code
 | Process library 'lcio_2_lib': compiling sources
 | Process library 'lcio_2_lib': linking
 | Process library 'lcio_2_lib': loading
 | Process library 'lcio_2_lib': ... success.
 | Integrate: compilation done
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process lcio_2_p:
 | Beam structure: e-, e+ => isr
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)
 |   e+  (mass = 5.1100000E-04 GeV)
 |   sqrts = 1.000000000000E+03 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'lcio_2_p.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'lcio_2_p'
 |   Library name  = 'lcio_2_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'lcio_2_p_i1':   e-, e+ => m-, m+ [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 'lcio_2_p'
 | 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  9.9402933E+01  4.65E+00    4.67    0.47*  24.86
 |-----------------------------------------------------------------------------|
    1        100  9.9402933E+01  4.65E+00    4.67    0.47   24.86
 |=============================================================================|
 n_events = 1
 openmp_num_threads = 1
 | Starting simulation for process 'lcio_2_p'
 | Simulate: using integration grids from file 'lcio_2_p.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] =   1.0060E-02
 | Events: writing to LCIO file 'lcio_2_p.slcio'
 | Events: generating 1 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: actual unweighting efficiency = 100.00 %
 | Events: closing LCIO file 'lcio_2_p.slcio'
 | There were no errors and    1 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
 Output from running lcio_2_rd:
 
 ============================================================================
-        Event  : 1 - run:  0 -  timestamp [...]
+        Event  : 1 - run:  1 -  timestamp [...]
 ============================================================================
  date: [...]
  detector : unknown
  event parameters: 
  parameter Event Number [int]: 1, 
  parameter ProcessID [int]: 1, 
- parameter Run ID [int]: 0, 
+ parameter Run ID [int]: 1, 
  parameter beamPDG1 [int]: 11, 
  parameter beamPDG2 [int]: -11, 
  parameter Energy [float]: 1000, 
  parameter _weight [float]: 1, 
  parameter alphaQCD [float]: 0.1178, 
  parameter beamPol1 [float]: 0, 
  parameter beamPol2 [float]: 0, 
  parameter crossSection [float]: 99.4029, 
  parameter crossSectionError [float]: 4.64628, 
  parameter scale [float]: 998.962, 
  parameter sqme [float]: 1.34846e+06, 
  parameter BeamSpectrum [string]: , 
  parameter processName [string]: lcio_2_p, 
 
  collection name : MCParticle
  parameters: 
 
 --------------- print out of MCParticle collection --------------- 
 
   flag:  0x0
   simulator status bits: [sbvtcls]  s: created in simulation b: backscatter v: vertex is not endpoint of parent t: decayed in tracker c: decayed in calorimeter l: has left detector s: stopped o: overlay
 
 
 [   id   ]index|      PDG |    px,     py,        pz    | energy  |gen|[simstat ]| vertex x,     y   ,   z     |    mass |  charge |            spin             | colorflow | [parents] - [daughters]
 
 [00000004]    0|        11| 0.00e+00, 0.00e+00, 5.00e+02| 5.00e+02| 4 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,4] 
 [00000005]    1|       -11| 0.00e+00, 0.00e+00,-5.00e+02| 5.00e+02| 4 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [3,5] 
 [00000006]    2|        11| 0.00e+00, 0.00e+00, 4.99e+02| 4.99e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0] - [6,7] 
 [00000007]    3|       -11| 0.00e+00, 0.00e+00,-5.00e+02| 5.00e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [1] - [6,7] 
 [00000008]    4|        22| 0.00e+00, 0.00e+00, 1.04e+00| 1.04e+00| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0] - [] 
 [00000009]    5|        22| 0.00e+00, 0.00e+00,-2.44e-06| 2.44e-06| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [1] - [] 
 [00000010]    6|        13| 2.77e+01,-2.11e+02,-4.52e+02| 5.00e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [2,3] - [] 
 [00000011]    7|       -13|-2.77e+01, 2.11e+02, 4.51e+02| 4.99e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [2,3] - [] 
 
 -------------------------------------------------------------------------------- 
Index: trunk/share/tests/functional_tests/lcio_1.sin
===================================================================
--- trunk/share/tests/functional_tests/lcio_1.sin	(revision 8384)
+++ trunk/share/tests/functional_tests/lcio_1.sin	(revision 8385)
@@ -1,22 +1,22 @@
 # SINDARIN input for WHIZARD self-test
 
 ?logging = true
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?write_raw = false
 
 seed = 0
 
-process lcio_1_p = e1, E1 => e2, E2
+process lcio_1_p = e1, E1 => e2, E2 { process_num_id = 21 }
 
 sqrts = 1000
 
 iterations = 1:100
 integrate (lcio_1_p)
 
 n_events = 1
 sample_format = lcio
 !!! Tests should be run single-threaded 
 openmp_num_threads = 1
 simulate (lcio_1_p)
Index: trunk/share/tests/functional_tests/ref-output/process_log.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/process_log.ref	(revision 8384)
+++ trunk/share/tests/functional_tests/ref-output/process_log.ref	(revision 8385)
@@ -1,549 +1,551 @@
 ###############################################################################
  Process [scattering]: 'process_log_1_p1'
    Run ID        = ''
    Library name  = 'process_log_lib'
    Process index = 1
    Process components:
      1: 'process_log_1_p1_i1':   e-, e+ => m-, m+ [omega]
 ------------------------------------------------------------------------
 ###############################################################################
    Integral   =  8.3556567814E+03
    Error      =  3.2359019246E+00
    Accuracy   =  1.8972317270E-02
    Chi2       =  5.2032955661E-01
    Efficiency =  7.8315602603E-01
    T(10k evt) =  <time estimate>
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1        800  8.3525258E+03  6.97E+00    0.08    0.02*  67.98
    2        800  8.3688100E+03  5.46E+00    0.07    0.02*  59.78
    3        800  8.3686236E+03  5.53E+00    0.07    0.02   78.45
 |-----------------------------------------------------------------------------|
    3       2400  8.3648733E+03  3.39E+00    0.04    0.02   78.45    2.06   3
 |-----------------------------------------------------------------------------|
    4        800  8.3602554E+03  5.63E+00    0.07    0.02   78.37
    5        800  8.3525628E+03  5.62E+00    0.07    0.02   78.30
    6        800  8.3541861E+03  5.56E+00    0.07    0.02*  78.32
 |-----------------------------------------------------------------------------|
    6       2400  8.3556568E+03  3.24E+00    0.04    0.02   78.32    0.52   3
 |=============================================================================|
 ###############################################################################
 | Phase-space chain (grove) weight history: (numbers in %)
 | chain |   1
 |=============================================================================|
       1 | 100
       2 | 100
       3 | 100
 |-----------------------------------------------------------------------------|
       4 | 100
       5 | 100
       6 | 100
 |=============================================================================|
 ###############################################################################
  Call statistics (current run):
    total       = 2400
    failed kin. = 0
    failed cuts = 0
    passed cuts = 0
    evaluated   = 2400
 ###############################################################################
  MC Integrator is VAMP
 ------------------------------------------------------------------------
  VAMP history (global):
  Pass #1:
  ------------------------------------------------------------------------------
  [vamp]   it   #calls     integral                 average           chi2  eff.
  [vamp]    1      800*  0.0000E+00(0.00E+00)  8.352526E+03(6.97E+00)  0.0 0.000
  [vamp]    2      800*  0.0000E+00(0.00E+00)  8.368810E+03(5.46E+00)  0.0 0.000
  [vamp]    3      800*  0.0000E+00(0.00E+00)  8.368624E+03(5.53E+00)  0.0 0.000
  ------------------------------------------------------------------------------
  Channel histories: [undefined]
  Pass #2:
  ------------------------------------------------------------------------------
  [vamp]   it   #calls     integral                 average           chi2  eff.
  [vamp]    1      800*  0.0000E+00(0.00E+00)  8.360255E+03(5.63E+00)  0.0 0.000
  [vamp]    2      800*  0.0000E+00(0.00E+00)  8.352563E+03(5.62E+00)  0.0 0.000
  [vamp]    3      800*  0.0000E+00(0.00E+00)  8.354186E+03(5.56E+00)  0.0 0.000
  ------------------------------------------------------------------------------
  Channel histories: [undefined]
 ------------------------------------------------------------------------
  Inequivalent channels:
    Channel 1:    Mult. = 1    Symm. = 1    Invar.: TF
  Equivalence list:
    Equivalent channels: 1 1
      Permutation: 1 2
      Mode:        3 0
 ------------------------------------------------------------------------
  Weights of channel chains (groves):
    1 1.0000000000
 ###############################################################################
  Beam data (collision):
    e-  (mass = 0.0000000E+00 GeV)
    e+  (mass = 0.0000000E+00 GeV)
    sqrts = 1.000000000000E+02 GeV
 ###############################################################################
    No cuts used.
 ------------------------------------------------------------------------
    No scale expression was given.
 ------------------------------------------------------------------------
    No factorization scale expression was given.
 ------------------------------------------------------------------------
    No renormalization scale expression was given.
 ------------------------------------------------------------------------
    No weight expression was given.
 ###############################################################################
  Summary of quantum-number states:
   + sign: allowed and contributing
   no +  : switched off at runtime
 ------------------------------------------------------------------------
  Term #1
    1  [f(11) h(-1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(-1)]
    2  [f(11) h(-1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(1)]
    3  [f(11) h(-1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(-1)]
    4  [f(11) h(-1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(1)]
  + 5  [f(11) h(-1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(-1)]
  + 6  [f(11) h(-1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(1)]
  + 7  [f(11) h(-1) / f(-11) h(1) / f(13) h(1) / f(-13) h(-1)]
  + 8  [f(11) h(-1) / f(-11) h(1) / f(13) h(1) / f(-13) h(1)]
  + 9  [f(11) h(1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(-1)]
  + 10  [f(11) h(1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(1)]
  + 11  [f(11) h(1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(-1)]
  + 12  [f(11) h(1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(1)]
    13  [f(11) h(1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(-1)]
    14  [f(11) h(1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(1)]
    15  [f(11) h(1) / f(-11) h(1) / f(13) h(1) / f(-13) h(-1)]
    16  [f(11) h(1) / f(-11) h(1) / f(13) h(1) / f(-13) h(1)]
 ###############################################################################
  Variable list:
 ------------------------------------------------------------------------
 ee =  3.000000000000E-01
 me =  0.000000000000E+00
 mmu =  1.000000000000E+01
 mtau =  1.777000000000E+00
 particle = PDG(0)
 E_LEPTON = PDG(11)
 e- = PDG(11)
 e1 = PDG(11)
 e+ = PDG(-11)
 E1 = PDG(-11)
 MU_LEPTON = PDG(13)
 m- = PDG(13)
 e2 = PDG(13)
 mu- = PDG(13)
 m+ = PDG(-13)
 E2 = PDG(-13)
 mu+ = PDG(-13)
 TAU_LEPTON = PDG(15)
 t- = PDG(15)
 e3 = PDG(15)
 ta- = PDG(15)
 tau- = PDG(15)
 t+ = PDG(-15)
 E3 = PDG(-15)
 ta+ = PDG(-15)
 tau+ = PDG(-15)
 PHOTON = PDG(22)
 A = PDG(22)
 gamma = PDG(22)
 photon = PDG(22)
 charged = PDG(11, 13, 15, -11, -13, -15)
 neutral = PDG(22)
 colored = PDG()
 sqrts =  1.000000000000E+02
 luminosity =  0.000000000000E+00
 ?sf_trace = false
 $sf_trace_file = ""
 ?sf_allow_s_mapping = true
 $lhapdf_dir = ""
 $lhapdf_file = ""
 $lhapdf_photon_file = ""
 lhapdf_member = 0
 lhapdf_photon_scheme = 0
 $pdf_builtin_set = "CTEQ6L"
 ?hoppet_b_matching = false
 isr_alpha =  0.000000000000E+00
 isr_q_max =  0.000000000000E+00
 isr_mass =  0.000000000000E+00
 isr_order = 3
 ?isr_recoil = false
 ?isr_keep_energy = false
 ?isr_handler = false
 $isr_handler_mode = "trivial"
 epa_alpha =  0.000000000000E+00
 epa_x_min =  0.000000000000E+00
 epa_q_min =  0.000000000000E+00
 epa_q_max =  0.000000000000E+00
 epa_mass =  0.000000000000E+00
 ?epa_recoil = false
 ?epa_keep_energy = false
 ?epa_handler = false
 $epa_handler_mode = "trivial"
 ewa_x_min =  0.000000000000E+00
 ewa_pt_max =  0.000000000000E+00
 ewa_mass =  0.000000000000E+00
 ?ewa_recoil = false
 ?ewa_keep_energy = false
 ?circe1_photon1 = false
 ?circe1_photon2 = false
 [undefined] circe1_sqrts = [unknown real]
 ?circe1_generate = true
 ?circe1_map = true
 circe1_mapping_slope =  2.000000000000E+00
 circe1_eps =  1.000000000000E-05
 circe1_ver = 0
 circe1_rev = 0
 $circe1_acc = "SBAND"
 circe1_chat = 0
 ?circe1_with_radiation = false
 ?circe2_polarized = true
 [undefined] $circe2_file = [unknown string]
 $circe2_design = "*"
 gaussian_spread1 =  0.000000000000E+00
 gaussian_spread2 =  0.000000000000E+00
 [undefined] $beam_events_file = [unknown string]
 ?beam_events_warn_eof = true
 ?energy_scan_normalize = false
 ?logging = true
 [undefined] $job_id = [unknown string]
 [undefined] $compile_workspace = [unknown string]
 seed = 0
 $model_name = "QED"
 [undefined] process_num_id = [unknown integer]
+?proc_as_run_id = true
+lcio_run_id = 0
 $method = "omega"
 ?report_progress = true
 [user variable] ?me_verbose = false
 $restrictions = ""
 ?omega_write_phs_output = false
 $omega_flags = ""
 ?read_color_factors = true
 ?slha_read_input = true
 ?slha_read_spectrum = true
 ?slha_read_decays = false
 $library_name = "process_log_lib"
 ?alphas_is_fixed = true
 ?alphas_from_lhapdf = false
 ?alphas_from_pdf_builtin = false
 alphas_order = 0
 alphas_nf = 5
 ?alphas_from_mz = false
 ?alphas_from_lambda_qcd = false
 lambda_qcd =  2.000000000000E-01
 ?fatal_beam_decay = true
 ?helicity_selection_active = true
 helicity_selection_threshold =  1.000000000000E+10
 helicity_selection_cutoff = 1000
 $rng_method = "tao"
 ?vis_diags = false
 ?vis_diags_color = false
 ?check_event_file = true
 $event_file_version = ""
 n_events = 0
 event_index_offset = 0
 ?unweighted = true
 safety_factor =  1.000000000000E+00
 ?negative_weights = false
 ?resonance_history = false
 resonance_on_shell_limit =  4.000000000000E+00
 resonance_on_shell_turnoff =  0.000000000000E+00
 resonance_background_factor =  1.000000000000E+00
 ?keep_beams = false
 ?keep_remnants = true
 ?recover_beams = true
 ?update_event = false
 ?update_sqme = false
 ?update_weight = false
 ?use_alphas_from_file = false
 ?use_scale_from_file = false
 ?allow_decays = true
 ?auto_decays = false
 auto_decays_multiplicity = 2
 ?auto_decays_radiative = false
 ?decay_rest_frame = false
 ?isotropic_decay = false
 ?diagonal_decay = false
 [undefined] decay_helicity = [unknown integer]
 ?polarized_events = false
 $polarization_mode = "helicity"
 ?colorize_subevt = false
 tolerance =  0.000000000000E+00
 checkpoint = 0
 event_callback_interval = 0
 ?pacify = false
 $out_file = ""
 ?out_advance = true
 real_range = <real_range>
 real_precision = <real_precision>
 real_epsilon = <real_epsilon>
 real_tiny = <real_tiny>
 $integration_method = "vamp"
 threshold_calls = 10
 min_calls_per_channel = 10
 min_calls_per_bin = 10
 min_bins = 3
 max_bins = 20
 ?stratified = true
 ?use_vamp_equivalences = true
 ?vamp_verbose = false
 ?vamp_history_global = true
 ?vamp_history_global_verbose = false
 ?vamp_history_channels = false
 ?vamp_history_channels_verbose = false
 $run_id = ""
 n_calls_test = 0
 ?integration_timer = true
 ?check_grid_file = true
 accuracy_goal =  0.000000000000E+00
 error_goal =  0.000000000000E+00
 relative_error_goal =  0.000000000000E+00
 integration_results_verbosity = 1
 error_threshold =  0.000000000000E+00
 channel_weights_power =  2.500000000000E-01
 [undefined] $integrate_workspace = [unknown string]
 $vamp_grid_format = "ascii"
 $phs_method = "wood"
 ?vis_channels = false
 ?check_phs_file = true
 $phs_file = ""
 ?phs_only = false
 phs_threshold_s =  5.000000000000E+01
 phs_threshold_t =  1.000000000000E+02
 phs_off_shell = 2
 phs_t_channel = 6
 phs_e_scale =  1.000000000000E+01
 phs_m_scale =  1.000000000000E+01
 phs_q_scale =  1.000000000000E+01
 ?phs_keep_nonresonant = true
 ?phs_step_mapping = true
 ?phs_step_mapping_exp = true
 ?phs_s_mapping = true
 ?vis_history = false
 n_bins = 20
 ?normalize_bins = false
 $obs_label = ""
 $obs_unit = ""
 $title = ""
 $description = ""
 $x_label = ""
 $y_label = ""
 graph_width_mm = 130
 graph_height_mm = 90
 ?y_log = false
 ?x_log = false
 [undefined] x_min = [unknown real]
 [undefined] x_max = [unknown real]
 [undefined] y_min = [unknown real]
 [undefined] y_max = [unknown real]
 $gmlcode_bg = ""
 $gmlcode_fg = ""
 [undefined] ?draw_histogram = [unknown logical]
 [undefined] ?draw_base = [unknown logical]
 [undefined] ?draw_piecewise = [unknown logical]
 [undefined] ?fill_curve = [unknown logical]
 [undefined] ?draw_curve = [unknown logical]
 [undefined] ?draw_errors = [unknown logical]
 [undefined] ?draw_symbols = [unknown logical]
 [undefined] $fill_options = [unknown string]
 [undefined] $draw_options = [unknown string]
 [undefined] $err_options = [unknown string]
 [undefined] $symbol = [unknown string]
 ?analysis_file_only = false
 kt_algorithm = 0
 cambridge_algorithm = 1
 antikt_algorithm = 2
 genkt_algorithm = 3
 cambridge_for_passive_algorithm = 11
 genkt_for_passive_algorithm = 13
 ee_kt_algorithm = 50
 ee_genkt_algorithm = 53
 plugin_algorithm = 99
 undefined_jet_algorithm = 999
 jet_algorithm = 999
 jet_r =  0.000000000000E+00
 jet_p =  0.000000000000E+00
 jet_ycut =  0.000000000000E+00
 ?keep_flavors_when_clustering = false
 photon_iso_eps =  1.000000000000E+00
 photon_iso_n =  1.000000000000E+00
 photon_iso_r0 =  4.000000000000E-01
 $sample = ""
 $sample_normalization = "auto"
 ?sample_pacify = false
 ?sample_select = true
 sample_max_tries = 10000
 sample_split_n_evt = 0
 sample_split_n_kbytes = 0
 sample_split_index = 0
 $rescan_input_format = "raw"
 ?read_raw = true
 ?write_raw = true
 $extension_raw = "evx"
 $extension_default = "evt"
 $debug_extension = "debug"
 ?debug_process = true
 ?debug_transforms = true
 ?debug_decay = true
 ?debug_verbose = true
 $dump_extension = "pset.dat"
 ?dump_compressed = false
 ?dump_weights = false
 ?dump_summary = false
 ?dump_screen = false
 ?hepevt_ensure_order = false
 $extension_hepevt = "hepevt"
 $extension_ascii_short = "short.evt"
 $extension_ascii_long = "long.evt"
 $extension_athena = "athena.evt"
 $extension_mokka = "mokka.evt"
 $lhef_version = "2.0"
 $lhef_extension = "lhe"
 ?lhef_write_sqme_prc = true
 ?lhef_write_sqme_ref = false
 ?lhef_write_sqme_alt = true
 $extension_lha = "lha"
 $extension_hepmc = "hepmc"
 ?hepmc_output_cross_section = false
 ?hepmc3_hepmc2mode = false
 $extension_lcio = "slcio"
 $extension_stdhep = "hep"
 $extension_stdhep_up = "up.hep"
 $extension_stdhep_ev4 = "ev4.hep"
 $extension_hepevt_verb = "hepevt.verb"
 $extension_lha_verb = "lha.verb"
 ?allow_shower = true
 ?ps_fsr_active = false
 ?ps_isr_active = false
 ?ps_taudec_active = false
 ?muli_active = false
 $shower_method = "WHIZARD"
 ?shower_verbose = false
 $ps_PYTHIA_PYGIVE = ""
 $ps_PYTHIA8_config = ""
 $ps_PYTHIA8_config_file = ""
 ps_mass_cutoff =  1.000000000000E+00
 ps_fsr_lambda =  2.900000000000E-01
 ps_isr_lambda =  2.900000000000E-01
 ps_max_n_flavors = 5
 ?ps_isr_alphas_running = true
 ?ps_fsr_alphas_running = true
 ps_fixed_alphas =  0.000000000000E+00
 ?ps_isr_pt_ordered = false
 ?ps_isr_angular_ordered = true
 ps_isr_primordial_kt_width =  0.000000000000E+00
 ps_isr_primordial_kt_cutoff =  5.000000000000E+00
 ps_isr_z_cutoff =  9.990000000000E-01
 ps_isr_minenergy =  1.000000000000E+00
 ps_isr_tscalefactor =  1.000000000000E+00
 ?ps_isr_only_onshell_emitted_partons = false
 ?allow_hadronization = true
 ?hadronization_active = false
 $hadronization_method = "PYTHIA6"
 hadron_enhanced_fraction =  1.000000000000E-02
 hadron_enhanced_width =  2.000000000000E+00
 ?ps_tauola_photos = false
 ?ps_tauola_transverse = false
 ?ps_tauola_dec_rad_cor = true
 ps_tauola_dec_mode1 = 0
 ps_tauola_dec_mode2 = 0
 ps_tauola_mh =  1.250000000000E+02
 ps_tauola_mix_angle =  9.000000000000E+01
 ?ps_tauola_pol_vector = false
 ?mlm_matching = false
 mlm_Qcut_ME =  0.000000000000E+00
 mlm_Qcut_PS =  0.000000000000E+00
 mlm_ptmin =  0.000000000000E+00
 mlm_etamax =  0.000000000000E+00
 mlm_Rmin =  0.000000000000E+00
 mlm_Emin =  0.000000000000E+00
 mlm_nmaxMEjets = 0
 mlm_ETclusfactor =  2.000000000000E-01
 mlm_ETclusminE =  5.000000000000E+00
 mlm_etaclusfactor =  1.000000000000E+00
 mlm_Rclusfactor =  1.000000000000E+00
 mlm_Eclusfactor =  1.000000000000E+00
 ?powheg_matching = false
 ?powheg_use_singular_jacobian = false
 powheg_grid_size_xi = 5
 powheg_grid_size_y = 5
 powheg_grid_sampling_points = 500000
 powheg_pt_min =  1.000000000000E+00
 powheg_lambda =  2.000000000000E-01
 ?powheg_rebuild_grids = false
 ?powheg_test_sudakov = false
 ?powheg_disable_sudakov = false
 ?ckkw_matching = false
 ?omega_openmp => false
 ?openmp_is_active = false
 openmp_num_threads_default = 1
 openmp_num_threads = 1
 ?openmp_logging = false
 ?mpi_logging = false
 $born_me_method = ""
 $loop_me_method = ""
 $correlation_me_method = ""
 $real_tree_me_method = ""
 $dglap_me_method = ""
 ?test_soft_limit = false
 ?test_coll_limit = false
 ?test_anti_coll_limit = false
 $select_alpha_regions = ""
 $virtual_selection = "Full"
 ?virtual_collinear_resonance_aware = true
 blha_top_yukawa = -1.000000000000E+00
 $blha_ew_scheme = "alpha_internal"
 openloops_verbosity = 1
 ?openloops_use_cms = true
 openloops_phs_tolerance = 7
 openloops_stability_log = 0
 ?openloops_switch_off_muon_yukawa = false
 $openloops_extra_cmd = ""
 ellis_sexton_scale = -1.000000000000E+00
 ?disable_subtraction = false
 fks_dij_exp1 =  1.000000000000E+00
 fks_dij_exp2 =  1.000000000000E+00
 fks_xi_min =  1.000000000000E-07
 fks_y_max =  1.000000000000E+00
 ?vis_fks_regions = false
 fks_xi_cut =  1.000000000000E+00
 fks_delta_o =  2.000000000000E+00
 fks_delta_i =  2.000000000000E+00
 $fks_mapping_type = "default"
 $resonances_exclude_particles = "default"
 alpha_power = 2
 alphas_power = 0
 ?combined_nlo_integration = false
 ?fixed_order_nlo_events = false
 ?check_event_weights_against_xsection = false
 ?keep_failed_events = false
 gks_multiplicity = 0
 $gosam_filter_lo = ""
 $gosam_filter_nlo = ""
 $gosam_symmetries = "family,generation"
 form_threads = 2
 form_workspace = 1000
 $gosam_fc = ""
 mult_call_real =  1.000000000000E+00
 mult_call_virt =  1.000000000000E+00
 mult_call_dglap =  1.000000000000E+00
 $dalitz_plot = ""
 $nlo_correction_type = "QCD"
 $exclude_gauge_splittings = "c:b:t:e2:e3"
 ?nlo_use_born_scale = false
 ?nlo_cut_all_sqmes = false
 ?nlo_use_real_partition = false
 real_partition_scale =  1.000000000000E+01
 $fc = Fortran-compiler
 $fcflags = Fortran-flags
 ?rebuild_library = true
 ?recompile_library = false
 ?rebuild_phase_space = true
 ?rebuild_grids = true
 ?powheg_rebuild_grids = true
 ?rebuild_events = true
 [undefined] num_id(process_log_1_p1) = [unknown integer]
 [undefined] integral(process_log_1_p1) = [unknown real]
 [undefined] error(process_log_1_p1) = [unknown real]
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
  Beam structure: [any particles]
 ###############################################################################
Index: trunk/share/tests/functional_tests/ref-output/lcio_1.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/lcio_1.ref	(revision 8384)
+++ trunk/share/tests/functional_tests/ref-output/lcio_1.ref	(revision 8385)
@@ -1,113 +1,115 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?write_raw = false
 seed = 0
-| Process library 'lcio_1_lib': recorded process 'lcio_1_p'
+process_num_id = 21
+| Process library 'lcio_1_lib': recorded process 'lcio_1_p' (21)
 sqrts =  1.000000000000E+03
 | Integrate: current process library needs compilation
 | Process library 'lcio_1_lib': compiling ...
 | Process library 'lcio_1_lib': writing makefile
 | Process library 'lcio_1_lib': removing old files
 | Process library 'lcio_1_lib': writing driver
 | Process library 'lcio_1_lib': creating source code
 | Process library 'lcio_1_lib': compiling sources
 | Process library 'lcio_1_lib': linking
 | Process library 'lcio_1_lib': loading
 | Process library 'lcio_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 lcio_1_p:
 | Beam structure: [any particles]
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)
 |   e+  (mass = 5.1100000E-04 GeV)
 |   sqrts = 1.000000000000E+03 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'lcio_1_p.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'lcio_1_p'
+|   ID (num)      = 21
 |   Library name  = 'lcio_1_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'lcio_1_p_i1':   e-, e+ => m-, m+ [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 'lcio_1_p'
 | 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  8.4620428E+01  1.81E+00    2.14    0.21*  65.91
 |-----------------------------------------------------------------------------|
    1        100  8.4620428E+01  1.81E+00    2.14    0.21   65.91
 |=============================================================================|
 n_events = 1
 openmp_num_threads = 1
 | Starting simulation for process 'lcio_1_p'
 | Simulate: using integration grids from file 'lcio_1_p.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] =   1.1817E-02
 | Events: writing to LCIO file 'lcio_1_p.slcio'
 | Events: generating 1 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: actual unweighting efficiency = 100.00 %
 | Events: closing LCIO file 'lcio_1_p.slcio'
 | There were no errors and    1 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
 Output from running lcio_1_rd:
 
 ============================================================================
-        Event  : 1 - run:  0 -  timestamp [...]
+        Event  : 1 - run:  21 -  timestamp [...]
 ============================================================================
  date: [...]
  detector : unknown
  event parameters: 
  parameter Event Number [int]: 1, 
- parameter ProcessID [int]: 1, 
- parameter Run ID [int]: 0, 
+ parameter ProcessID [int]: 21, 
+ parameter Run ID [int]: 21, 
  parameter beamPDG1 [int]: 11, 
  parameter beamPDG2 [int]: -11, 
  parameter Energy [float]: 1000, 
  parameter _weight [float]: 1, 
  parameter alphaQCD [float]: 0.1178, 
  parameter beamPol1 [float]: 0, 
  parameter beamPol2 [float]: 0, 
  parameter crossSection [float]: 84.6204, 
  parameter crossSectionError [float]: 1.8082, 
  parameter scale [float]: 1000, 
  parameter sqme [float]: 0.00878025, 
  parameter BeamSpectrum [string]: , 
  parameter processName [string]: lcio_1_p, 
 
  collection name : MCParticle
  parameters: 
 
 --------------- print out of MCParticle collection --------------- 
 
   flag:  0x0
   simulator status bits: [sbvtcls]  s: created in simulation b: backscatter v: vertex is not endpoint of parent t: decayed in tracker c: decayed in calorimeter l: has left detector s: stopped o: overlay
 
 
 [   id   ]index|      PDG |    px,     py,        pz    | energy  |gen|[simstat ]| vertex x,     y   ,   z     |    mass |  charge |            spin             | colorflow | [parents] - [daughters]
 
 [00000004]    0|        11| 0.00e+00, 0.00e+00, 5.00e+02| 5.00e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3] 
 [00000005]    1|       -11| 0.00e+00, 0.00e+00,-5.00e+02| 5.00e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3] 
 [00000006]    2|        13| 2.85e+02, 3.98e+02,-1.04e+02| 5.00e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0,1] - [] 
 [00000007]    3|       -13|-2.85e+02,-3.98e+02, 1.04e+02| 5.00e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0,1] - [] 
 
 -------------------------------------------------------------------------------- 
Index: trunk/share/tests/functional_tests/ref-output/lcio_3.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/lcio_3.ref	(revision 8384)
+++ trunk/share/tests/functional_tests/ref-output/lcio_3.ref	(revision 8385)
@@ -1,118 +1,118 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?write_raw = false
 seed = 0
 | Process library 'lcio_3_lib': recorded process 'lcio_3_p'
 sqrts =  5.000000000000E+02
 | Integrate: current process library needs compilation
 | Process library 'lcio_3_lib': compiling ...
 | Process library 'lcio_3_lib': writing makefile
 | Process library 'lcio_3_lib': removing old files
 | Process library 'lcio_3_lib': writing driver
 | Process library 'lcio_3_lib': creating source code
 | Process library 'lcio_3_lib': compiling sources
 | Process library 'lcio_3_lib': linking
 | Process library 'lcio_3_lib': loading
 | Process library 'lcio_3_lib': ... success.
 | Integrate: compilation done
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process lcio_3_p:
 | Beam structure: e-, e+
 |   polarization (beam 1):
 |     @(-1: -1: ( 1.000000000000E+00, 0.000000000000E+00))
 |   polarization (beam 2):
 |     @(+1: +1: ( 1.000000000000E+00, 0.000000000000E+00))
 |   polarization degree = 0.8000000, 0.3000000
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)  polarized
 |   e+  (mass = 5.1100000E-04 GeV)  polarized
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'lcio_3_p.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'lcio_3_p'
 |   Library name  = 'lcio_3_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'lcio_3_p_i1':   e-, e+ => m-, m+ [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 'lcio_3_p'
 | 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  4.1971732E+02  8.97E+00    2.14    0.21*  65.91
 |-----------------------------------------------------------------------------|
    1        100  4.1971732E+02  8.97E+00    2.14    0.21   65.91
 |=============================================================================|
 n_events = 1
 openmp_num_threads = 1
 | Starting simulation for process 'lcio_3_p'
 | Simulate: using integration grids from file 'lcio_3_p.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] =   2.3826E-03
 | Events: writing to LCIO file 'lcio_3_p.slcio'
 | Events: generating 1 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: actual unweighting efficiency = 100.00 %
 | Events: closing LCIO file 'lcio_3_p.slcio'
 | There were no errors and    1 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
 Output from running lcio_3_rd:
 
 ============================================================================
-        Event  : 1 - run:  0 -  timestamp [...]
+        Event  : 1 - run:  1 -  timestamp [...]
 ============================================================================
  date: [...]
  detector : unknown
  event parameters: 
  parameter Event Number [int]: 1, 
  parameter ProcessID [int]: 1, 
- parameter Run ID [int]: 0, 
+ parameter Run ID [int]: 1, 
  parameter beamPDG1 [int]: 11, 
  parameter beamPDG2 [int]: -11, 
  parameter Energy [float]: 500, 
  parameter _weight [float]: 1, 
  parameter alphaQCD [float]: 0.1178, 
  parameter beamPol1 [float]: -0.8, 
  parameter beamPol2 [float]: 0.3, 
  parameter crossSection [float]: 419.717, 
  parameter crossSectionError [float]: 8.96867, 
  parameter scale [float]: 500, 
  parameter sqme [float]: 0.0108875, 
  parameter BeamSpectrum [string]: , 
  parameter processName [string]: lcio_3_p, 
 
  collection name : MCParticle
  parameters: 
 
 --------------- print out of MCParticle collection --------------- 
 
   flag:  0x0
   simulator status bits: [sbvtcls]  s: created in simulation b: backscatter v: vertex is not endpoint of parent t: decayed in tracker c: decayed in calorimeter l: has left detector s: stopped o: overlay
 
 
 [   id   ]index|      PDG |    px,     py,        pz    | energy  |gen|[simstat ]| vertex x,     y   ,   z     |    mass |  charge |            spin             | colorflow | [parents] - [daughters]
 
 [00000004]    0|        11| 0.00e+00, 0.00e+00, 2.50e+02| 2.50e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3] 
 [00000005]    1|       -11| 0.00e+00, 0.00e+00,-2.50e+02| 2.50e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3] 
 [00000006]    2|        13| 1.42e+02, 1.99e+02,-5.22e+01| 2.50e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0,1] - [] 
 [00000007]    3|       -13|-1.42e+02,-1.99e+02, 5.22e+01| 2.50e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0,1] - [] 
 
 -------------------------------------------------------------------------------- 
Index: trunk/share/tests/functional_tests/ref-output/lcio_5.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/lcio_5.ref	(revision 8384)
+++ trunk/share/tests/functional_tests/ref-output/lcio_5.ref	(revision 8385)
@@ -1,116 +1,116 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?write_raw = false
 seed = 0
 | Process library 'lcio_5_lib': recorded process 'lcio_5_p'
 sqrts =  5.000000000000E+02
 | Integrate: current process library needs compilation
 | Process library 'lcio_5_lib': compiling ...
 | Process library 'lcio_5_lib': writing makefile
 | Process library 'lcio_5_lib': removing old files
 | Process library 'lcio_5_lib': writing driver
 | Process library 'lcio_5_lib': creating source code
 | Process library 'lcio_5_lib': compiling sources
 | Process library 'lcio_5_lib': linking
 | Process library 'lcio_5_lib': loading
 | Process library 'lcio_5_lib': ... success.
 | Integrate: compilation done
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process lcio_5_p:
 | Beam structure: [any particles]
 | 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 'lcio_5_p.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'lcio_5_p'
 |   Library name  = 'lcio_5_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'lcio_5_p_i1':   e-, e+ => m-, m+ [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 'lcio_5_p'
 | 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  3.3848171E+02  7.23E+00    2.14    0.21*  65.91
 |-----------------------------------------------------------------------------|
    1        100  3.3848171E+02  7.23E+00    2.14    0.21   65.91
 |=============================================================================|
 | Particle m- declared as polarized
 | Particle m+ declared as polarized
 ?polarized_events = true
 n_events = 1
 openmp_num_threads = 1
 | Starting simulation for process 'lcio_5_p'
 | Simulate: using integration grids from file 'lcio_5_p.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] =   2.9544E-03
 | Events: writing to LCIO file 'lcio_5_p.slcio'
 | Events: generating 1 unweighted, polarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: actual unweighting efficiency = 100.00 %
 | Events: closing LCIO file 'lcio_5_p.slcio'
 | There were no errors and    1 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
 Output from running lcio_5_rd:
 
 ============================================================================
-        Event  : 1 - run:  0 -  timestamp [...]
+        Event  : 1 - run:  1 -  timestamp [...]
 ============================================================================
  date: [...]
  detector : unknown
  event parameters: 
  parameter Event Number [int]: 1, 
  parameter ProcessID [int]: 1, 
- parameter Run ID [int]: 0, 
+ parameter Run ID [int]: 1, 
  parameter beamPDG1 [int]: 11, 
  parameter beamPDG2 [int]: -11, 
  parameter Energy [float]: 500, 
  parameter _weight [float]: 1, 
  parameter alphaQCD [float]: 0.1178, 
  parameter beamPol1 [float]: 0, 
  parameter beamPol2 [float]: 0, 
  parameter crossSection [float]: 338.482, 
  parameter crossSectionError [float]: 7.2328, 
  parameter scale [float]: 500, 
  parameter sqme [float]: 0.00878025, 
  parameter BeamSpectrum [string]: , 
  parameter processName [string]: lcio_5_p, 
 
  collection name : MCParticle
  parameters: 
 
 --------------- print out of MCParticle collection --------------- 
 
   flag:  0x0
   simulator status bits: [sbvtcls]  s: created in simulation b: backscatter v: vertex is not endpoint of parent t: decayed in tracker c: decayed in calorimeter l: has left detector s: stopped o: overlay
 
 
 [   id   ]index|      PDG |    px,     py,        pz    | energy  |gen|[simstat ]| vertex x,     y   ,   z     |    mass |  charge |            spin             | colorflow | [parents] - [daughters]
 
 [00000004]    0|        11| 0.00e+00, 0.00e+00, 2.50e+02| 2.50e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3] 
 [00000005]    1|       -11| 0.00e+00, 0.00e+00,-2.50e+02| 2.50e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3] 
 [00000006]    2|        13| 1.42e+02, 1.99e+02,-5.22e+01| 2.50e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01|-1.00e+00| 0.00e+00, 0.00e+00, 1.00e+00|  (0, 0)   | [0,1] - [] 
 [00000007]    3|       -13|-1.42e+02,-1.99e+02, 5.22e+01| 2.50e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01| 1.00e+00| 0.00e+00, 0.00e+00,-1.00e+00|  (0, 0)   | [0,1] - [] 
 
 -------------------------------------------------------------------------------- 
Index: trunk/share/tests/functional_tests/ref-output/lcio_11.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/lcio_11.ref	(revision 0)
+++ trunk/share/tests/functional_tests/ref-output/lcio_11.ref	(revision 8385)
@@ -0,0 +1,118 @@
+?openmp_logging = false
+?vis_history = false
+?integration_timer = false
+?write_raw = false
+seed = 0
+process_num_id = 25
+| Process library 'lcio_11_lib': recorded process 'lcio_11_p' (25)
+sqrts =  1.000000000000E+03
+| Integrate: current process library needs compilation
+| Process library 'lcio_11_lib': compiling ...
+| Process library 'lcio_11_lib': writing makefile
+| Process library 'lcio_11_lib': removing old files
+| Process library 'lcio_11_lib': writing driver
+| Process library 'lcio_11_lib': creating source code
+| Process library 'lcio_11_lib': compiling sources
+| Process library 'lcio_11_lib': linking
+| Process library 'lcio_11_lib': loading
+| Process library 'lcio_11_lib': ... success.
+| Integrate: compilation done
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 0
+| Initializing integration for process lcio_11_p:
+| Beam structure: [any particles]
+| Beam data (collision):
+|   e-  (mass = 5.1100000E-04 GeV)
+|   e+  (mass = 5.1100000E-04 GeV)
+|   sqrts = 1.000000000000E+03 GeV
+| Phase space: generating configuration ...
+| Phase space: ... success.
+| Phase space: writing configuration file 'lcio_11_p.i1.phs'
+| ------------------------------------------------------------------------
+| Process [scattering]: 'lcio_11_p'
+|   ID (num)      = 25
+|   Library name  = 'lcio_11_lib'
+|   Process index = 1
+|   Process components:
+|     1: 'lcio_11_p_i1':   e-, e+ => m-, m+ [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 'lcio_11_p'
+| 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  8.4620428E+01  1.81E+00    2.14    0.21*  65.91
+|-----------------------------------------------------------------------------|
+   1        100  8.4620428E+01  1.81E+00    2.14    0.21   65.91
+|=============================================================================|
+lcio_run_id = 27
+?proc_as_run_id = false
+event_index_offset = 345
+n_events = 2
+openmp_num_threads = 1
+| Starting simulation for process 'lcio_11_p'
+| Simulate: using integration grids from file 'lcio_11_p.m1.vg'
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 1
+| Simulation: requested number of events = 2
+|             corr. to luminosity [fb-1] =   2.3635E-02
+| Events: writing to LCIO file 'lcio_11_p.slcio'
+| Events: generating 2 unweighted, unpolarized events ...
+| Events: event normalization mode '1'
+|         ... event sample complete.
+| Events: actual unweighting efficiency = 100.00 %
+| Events: closing LCIO file 'lcio_11_p.slcio'
+| There were no errors and    1 warning(s).
+| WHIZARD run finished.
+|=============================================================================|
+Output from running lcio_11_rd:
+
+============================================================================
+        Event  : 347 - run:  27 -  timestamp [...]
+============================================================================
+ date: [...]
+ detector : unknown
+ event parameters: 
+ parameter Event Number [int]: 347, 
+ parameter ProcessID [int]: 25, 
+ parameter Run ID [int]: 27, 
+ parameter beamPDG1 [int]: 11, 
+ parameter beamPDG2 [int]: -11, 
+ parameter Energy [float]: 1000, 
+ parameter _weight [float]: 1, 
+ parameter alphaQCD [float]: 0.1178, 
+ parameter beamPol1 [float]: 0, 
+ parameter beamPol2 [float]: 0, 
+ parameter crossSection [float]: 84.6204, 
+ parameter crossSectionError [float]: 1.8082, 
+ parameter scale [float]: 1000, 
+ parameter sqme [float]: 0.00877082, 
+ parameter BeamSpectrum [string]: , 
+ parameter processName [string]: lcio_11_p, 
+
+ collection name : MCParticle
+ parameters: 
+
+--------------- print out of MCParticle collection --------------- 
+
+  flag:  0x0
+  simulator status bits: [sbvtcls]  s: created in simulation b: backscatter v: vertex is not endpoint of parent t: decayed in tracker c: decayed in calorimeter l: has left detector s: stopped o: overlay
+
+
+[   id   ]index|      PDG |    px,     py,        pz    | energy  |gen|[simstat ]| vertex x,     y   ,   z     |    mass |  charge |            spin             | colorflow | [parents] - [daughters]
+
+[00000004]    0|        11| 0.00e+00, 0.00e+00, 5.00e+02| 5.00e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3] 
+[00000005]    1|       -11| 0.00e+00, 0.00e+00,-5.00e+02| 5.00e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3] 
+[00000006]    2|        13|-3.67e+02, 3.24e+02, 1.03e+02| 5.00e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0,1] - [] 
+[00000007]    3|       -13| 3.67e+02,-3.24e+02,-1.03e+02| 5.00e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0,1] - [] 
+
+-------------------------------------------------------------------------------- 
Index: trunk/share/tests/functional_tests/ref-output/lcio_4.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/lcio_4.ref	(revision 8384)
+++ trunk/share/tests/functional_tests/ref-output/lcio_4.ref	(revision 8385)
@@ -1,123 +1,123 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?write_raw = false
 seed = 0
 | Process library 'lcio_4_lib': recorded process 'lcio_4_p'
 sqrts =  5.000000000000E+02
 $circe2_file = "ilc500.circe"
 $circe2_design = "ILC"
 ?circe2_polarized = false
 | Integrate: current process library needs compilation
 | Process library 'lcio_4_lib': compiling ...
 | Process library 'lcio_4_lib': writing makefile
 | Process library 'lcio_4_lib': removing old files
 | Process library 'lcio_4_lib': writing driver
 | Process library 'lcio_4_lib': creating source code
 | Process library 'lcio_4_lib': compiling sources
 | Process library 'lcio_4_lib': linking
 | Process library 'lcio_4_lib': loading
 | Process library 'lcio_4_lib': ... success.
 | Integrate: compilation done
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process lcio_4_p:
 | Beam structure: e-, e+ => circe2
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)
 |   e+  (mass = 5.1100000E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | CIRCE2: 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 'lcio_4_p.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'lcio_4_p'
 |   Library name  = 'lcio_4_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'lcio_4_p_i1':   e-, e+ => m-, m+ [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: circe2
 | Beam structure: 1 channels, 0 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'lcio_4_p'
 | 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  3.6192633E+02  9.69E+00    2.68    0.27*  43.00
 |-----------------------------------------------------------------------------|
    1        100  3.6192633E+02  9.69E+00    2.68    0.27   43.00
 |=============================================================================|
 n_events = 1
 openmp_num_threads = 1
 | Starting simulation for process 'lcio_4_p'
 | Simulate: using integration grids from file 'lcio_4_p.m1.vg'
 | 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] =   2.7630E-03
 | Events: writing to LCIO file 'lcio_4_p.slcio'
 | Events: generating 1 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: actual unweighting efficiency = 100.00 %
 | Events: closing LCIO file 'lcio_4_p.slcio'
 | There were no errors and    1 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
 Output from running lcio_4_rd:
 
 ============================================================================
-        Event  : 1 - run:  0 -  timestamp [...]
+        Event  : 1 - run:  1 -  timestamp [...]
 ============================================================================
  date: [...]
  detector : unknown
  event parameters: 
  parameter Event Number [int]: 1, 
  parameter ProcessID [int]: 1, 
- parameter Run ID [int]: 0, 
+ parameter Run ID [int]: 1, 
  parameter beamPDG1 [int]: 11, 
  parameter beamPDG2 [int]: -11, 
  parameter Energy [float]: 500, 
  parameter _weight [float]: 1, 
  parameter alphaQCD [float]: 0.1178, 
  parameter beamPol1 [float]: 0, 
  parameter beamPol2 [float]: 0, 
  parameter crossSection [float]: 361.926, 
  parameter crossSectionError [float]: 9.68695, 
  parameter scale [float]: 457.78, 
  parameter sqme [float]: 0.00878025, 
  parameter BeamSpectrum [string]: CIRCE2: ilc500.circe, 
  parameter processName [string]: lcio_4_p, 
 
  collection name : MCParticle
  parameters: 
 
 --------------- print out of MCParticle collection --------------- 
 
   flag:  0x0
   simulator status bits: [sbvtcls]  s: created in simulation b: backscatter v: vertex is not endpoint of parent t: decayed in tracker c: decayed in calorimeter l: has left detector s: stopped o: overlay
 
 
 [   id   ]index|      PDG |    px,     py,        pz    | energy  |gen|[simstat ]| vertex x,     y   ,   z     |    mass |  charge |            spin             | colorflow | [parents] - [daughters]
 
 [00000004]    0|        11| 0.00e+00, 0.00e+00, 2.50e+02| 2.50e+02| 4 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3] 
 [00000005]    1|       -11| 0.00e+00, 0.00e+00,-2.50e+02| 2.50e+02| 4 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3] 
 [00000006]    2|        11| 0.00e+00, 0.00e+00, 2.24e+02| 2.24e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0,1] - [4,5] 
 [00000007]    3|       -11| 0.00e+00, 0.00e+00,-2.34e+02| 2.34e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0,1] - [4,5] 
 [00000008]    4|        13| 1.30e+02, 1.82e+02,-5.25e+01| 2.30e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [2,3] - [] 
 [00000009]    5|       -13|-1.30e+02,-1.82e+02, 4.31e+01| 2.28e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [2,3] - [] 
 
 -------------------------------------------------------------------------------- 
Index: trunk/share/tests/functional_tests/ref-output/lcio_10.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/lcio_10.ref	(revision 8384)
+++ trunk/share/tests/functional_tests/ref-output/lcio_10.ref	(revision 8385)
@@ -1,220 +1,220 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?alphas_is_fixed = true
 seed = 0
 | Process library 'lcio_10_lib': recorded process 'lcio_10_p'
 sqrts =  8.000000000000E+03
 openmp_num_threads = 1
 n_events = 1
 ?unweighted = true
 ?read_raw = false
 ?write_raw = false
 ?update_sqme = true
 ?update_weight = true
 ?keep_beams = true
 QCD.alphas =>  1.250000000000E-01
 QCD.alphas =>  2.500000000000E-01
 QCD.alphas =>  5.000000000000E-01
 QCD.alphas =>  1.000000000000E+00
 QCD.alphas =>  2.000000000000E+00
 QCD.alphas =>  4.000000000000E+00
 QCD.alphas =>  8.000000000000E+00
 QCD.alphas =>  1.600000000000E+01
 QCD.alphas =>  3.200000000000E+01
 QCD.alphas =>  6.400000000000E+01
 | Starting simulation for process 'lcio_10_p'
 | Simulate: process 'lcio_10_p' needs integration
 | Integrate: current process library needs compilation
 | Process library 'lcio_10_lib': compiling ...
 | Process library 'lcio_10_lib': writing makefile
 | Process library 'lcio_10_lib': removing old files
 | Process library 'lcio_10_lib': writing driver
 | Process library 'lcio_10_lib': creating source code
 | Process library 'lcio_10_lib': compiling sources
 | Process library 'lcio_10_lib': linking
 | Process library 'lcio_10_lib': loading
 | Process library 'lcio_10_lib': ... success.
 | Integrate: compilation done
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process lcio_10_p:
 | Beam structure: p, p => pdf_builtin
 | Beam data (collision):
 |   p  (mass = 0.0000000E+00 GeV)
 |   p  (mass = 0.0000000E+00 GeV)
 |   sqrts = 8.000000000000E+03 GeV
 | Initialized builtin PDF CTEQ6L
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'lcio_10_p.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'lcio_10_p'
 |   Library name  = 'lcio_10_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'lcio_10_p_i1':   gl, gl => t, tbar [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: pdf_builtin, none => none, pdf_builtin
 | Beam structure: 1 channels, 2 dimensions
 Warning: No cuts have been defined.
 | Starting integration for process 'lcio_10_p'
 | Integrate: iterations = 1: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  9.7927939E+04  2.08E+04   21.24    6.72*   1.51
 |-----------------------------------------------------------------------------|
    1       1000  9.7927939E+04  2.08E+04   21.24    6.72    1.51
 |=============================================================================|
 | Simulate: integration done
 | Simulate: using integration grids from file 'lcio_10_p.m1.vg'
 | Simulate: initializing alternate process setup ...
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 1
 Warning: Reading phs file: MD5 sum check disabled
 | Phase space: keeping configuration file 'lcio_10_p.i1.phs'
 | ...  alternate process setup complete.
 | Simulate: initializing alternate process setup ...
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 2
 Warning: Reading phs file: MD5 sum check disabled
 | Phase space: keeping configuration file 'lcio_10_p.i1.phs'
 | ...  alternate process setup complete.
 | Simulate: initializing alternate process setup ...
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 3
 Warning: Reading phs file: MD5 sum check disabled
 | Phase space: keeping configuration file 'lcio_10_p.i1.phs'
 | ...  alternate process setup complete.
 | Simulate: initializing alternate process setup ...
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 4
 Warning: Reading phs file: MD5 sum check disabled
 | Phase space: keeping configuration file 'lcio_10_p.i1.phs'
 | ...  alternate process setup complete.
 | Simulate: initializing alternate process setup ...
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 5
 Warning: Reading phs file: MD5 sum check disabled
 | Phase space: keeping configuration file 'lcio_10_p.i1.phs'
 | ...  alternate process setup complete.
 | Simulate: initializing alternate process setup ...
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 6
 Warning: Reading phs file: MD5 sum check disabled
 | Phase space: keeping configuration file 'lcio_10_p.i1.phs'
 | ...  alternate process setup complete.
 | Simulate: initializing alternate process setup ...
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 7
 Warning: Reading phs file: MD5 sum check disabled
 | Phase space: keeping configuration file 'lcio_10_p.i1.phs'
 | ...  alternate process setup complete.
 | Simulate: initializing alternate process setup ...
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 8
 Warning: Reading phs file: MD5 sum check disabled
 | Phase space: keeping configuration file 'lcio_10_p.i1.phs'
 | ...  alternate process setup complete.
 | Simulate: initializing alternate process setup ...
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 9
 Warning: Reading phs file: MD5 sum check disabled
 | Phase space: keeping configuration file 'lcio_10_p.i1.phs'
 | ...  alternate process setup complete.
 | Simulate: initializing alternate process setup ...
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 10
 Warning: Reading phs file: MD5 sum check disabled
 | Phase space: keeping configuration file 'lcio_10_p.i1.phs'
 | ...  alternate process setup complete.
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 11
 | Simulation: requested number of events = 1
 |             corr. to luminosity [fb-1] =   1.0212E-05
 | Events: writing to LCIO file 'lcio_10_p.slcio'
 | Events: writing to weight stream file 'lcio_10_p.weights.dat'
 | Events: generating 1 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: actual unweighting efficiency =   0.32 %
 | Events: closing LCIO file 'lcio_10_p.slcio'
 | Events: closing weight stream file 'lcio_10_p.weights.dat'
 | There were no errors and   11 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
 Output from running lcio_10_rd:
 
 ============================================================================
-        Event  : 1 - run:  0 -  timestamp [...]
+        Event  : 1 - run:  1 -  timestamp [...]
 ============================================================================
  date: [...]
  detector : unknown
  event parameters: 
  parameter Event Number [int]: 1, 
  parameter ProcessID [int]: 1, 
- parameter Run ID [int]: 0, 
+ parameter Run ID [int]: 1, 
  parameter beamPDG1 [int]: 2212, 
  parameter beamPDG2 [int]: 2212, 
  parameter Energy [float]: 8000, 
  parameter _weight [float]: 1, 
  parameter alphaQCD [float]: 0.1178, 
  parameter alternateSqme1 [float]: 135.189, 
  parameter alternateSqme10 [float]: 3.54389e+07, 
  parameter alternateSqme2 [float]: 540.754, 
  parameter alternateSqme3 [float]: 2163.02, 
  parameter alternateSqme4 [float]: 8652.07, 
  parameter alternateSqme5 [float]: 34608.3, 
  parameter alternateSqme6 [float]: 138433, 
  parameter alternateSqme7 [float]: 553732, 
  parameter alternateSqme8 [float]: 2.21493e+06, 
  parameter alternateSqme9 [float]: 8.85972e+06, 
  parameter alternateWeight1 [float]: 1.12598, 
  parameter alternateWeight10 [float]: 295168, 
  parameter alternateWeight2 [float]: 4.50391, 
  parameter alternateWeight3 [float]: 18.0156, 
  parameter alternateWeight4 [float]: 72.0625, 
  parameter alternateWeight5 [float]: 288.25, 
  parameter alternateWeight6 [float]: 1153, 
  parameter alternateWeight7 [float]: 4612, 
  parameter alternateWeight8 [float]: 18448, 
  parameter alternateWeight9 [float]: 73792, 
  parameter beamPol1 [float]: 0, 
  parameter beamPol2 [float]: 0, 
  parameter crossSection [float]: 97927.9, 
  parameter crossSectionError [float]: 20802.6, 
  parameter scale [float]: 488.791, 
  parameter sqme [float]: 120.063, 
  parameter BeamSpectrum [string]: , 
  parameter processName [string]: lcio_10_p, 
 
  collection name : MCParticle
  parameters: 
 
 --------------- print out of MCParticle collection --------------- 
 
   flag:  0x0
   simulator status bits: [sbvtcls]  s: created in simulation b: backscatter v: vertex is not endpoint of parent t: decayed in tracker c: decayed in calorimeter l: has left detector s: stopped o: overlay
 
 
 [   id   ]index|      PDG |    px,     py,        pz    | energy  |gen|[simstat ]| vertex x,     y   ,   z     |    mass |  charge |            spin             | colorflow | [parents] - [daughters]
 
 [00000004]    0|      2212| 0.00e+00, 0.00e+00, 4.00e+03| 4.00e+03| 4 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,4] 
 [00000005]    1|      2212| 0.00e+00, 0.00e+00,-4.00e+03| 4.00e+03| 4 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [3,5] 
 [00000006]    2|        21| 0.00e+00, 0.00e+00, 7.22e+01| 7.22e+01| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (1, 2)   | [0] - [6,7] 
 [00000007]    3|        21| 0.00e+00, 0.00e+00,-8.27e+02| 8.27e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (3, 1)   | [1] - [6,7] 
 [00000008]    4|        93| 0.00e+00, 0.00e+00, 3.93e+03| 3.93e+03| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (2, 1)   | [0] - [] 
 [00000009]    5|        93| 0.00e+00, 0.00e+00,-3.17e+03| 3.17e+03| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (1, 3)   | [1] - [] 
 [00000010]    6|         6| 1.60e+02,-2.33e+01,-4.88e+02| 5.42e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.73e+02| 6.67e-01| 0.00e+00, 0.00e+00, 0.00e+00|  (3, 0)   | [2,3] - [] 
 [00000011]    7|        -6|-1.60e+02, 2.33e+01,-2.67e+02| 3.57e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.73e+02|-6.67e-01| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 2)   | [2,3] - [] 
 
 -------------------------------------------------------------------------------- 
Index: trunk/share/tests/functional_tests/ref-output/show_4.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/show_4.ref	(revision 8384)
+++ trunk/share/tests/functional_tests/ref-output/show_4.ref	(revision 8385)
@@ -1,1161 +1,1166 @@
 ?openmp_logging = false
 [user variable] foo = PDG(11, 13, 15)
 [user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
 #####################################################
 QED.ee =>  3.028600000000E-01
 QED.me =>  5.110000000000E-04
 QED.mmu =>  1.057000000000E-01
 QED.mtau =>  1.777000000000E+00
 [undefined] sqrts = [unknown real]
 luminosity =  0.000000000000E+00
 isr_alpha =  0.000000000000E+00
 isr_q_max =  0.000000000000E+00
 isr_mass =  0.000000000000E+00
 epa_alpha =  0.000000000000E+00
 epa_x_min =  0.000000000000E+00
 epa_q_min =  0.000000000000E+00
 epa_q_max =  0.000000000000E+00
 epa_mass =  0.000000000000E+00
 ewa_x_min =  0.000000000000E+00
 ewa_pt_max =  0.000000000000E+00
 ewa_mass =  0.000000000000E+00
 [undefined] circe1_sqrts = [unknown real]
 circe1_mapping_slope =  2.000000000000E+00
 circe1_eps =  1.000000000000E-05
 gaussian_spread1 =  0.000000000000E+00
 gaussian_spread2 =  0.000000000000E+00
 lambda_qcd =  2.000000000000E-01
 helicity_selection_threshold =  1.000000000000E+10
 safety_factor =  1.000000000000E+00
 resonance_on_shell_limit =  4.000000000000E+00
 resonance_on_shell_turnoff =  0.000000000000E+00
 resonance_background_factor =  1.000000000000E+00
 tolerance =  0.000000000000E+00
 real_epsilon* = <real_epsilon>
 real_tiny* = <real_tiny>
 accuracy_goal =  0.000000000000E+00
 error_goal =  0.000000000000E+00
 relative_error_goal =  0.000000000000E+00
 error_threshold =  0.000000000000E+00
 channel_weights_power =  2.500000000000E-01
 phs_threshold_s =  5.000000000000E+01
 phs_threshold_t =  1.000000000000E+02
 phs_e_scale =  1.000000000000E+01
 phs_m_scale =  1.000000000000E+01
 phs_q_scale =  1.000000000000E+01
 [undefined] x_min = [unknown real]
 [undefined] x_max = [unknown real]
 [undefined] y_min = [unknown real]
 [undefined] y_max = [unknown real]
 jet_r =  0.000000000000E+00
 jet_p =  0.000000000000E+00
 jet_ycut =  0.000000000000E+00
 photon_iso_eps =  1.000000000000E+00
 photon_iso_n =  1.000000000000E+00
 photon_iso_r0 =  4.000000000000E-01
 ps_mass_cutoff =  1.000000000000E+00
 ps_fsr_lambda =  2.900000000000E-01
 ps_isr_lambda =  2.900000000000E-01
 ps_fixed_alphas =  0.000000000000E+00
 ps_isr_primordial_kt_width =  0.000000000000E+00
 ps_isr_primordial_kt_cutoff =  5.000000000000E+00
 ps_isr_z_cutoff =  9.990000000000E-01
 ps_isr_minenergy =  1.000000000000E+00
 ps_isr_tscalefactor =  1.000000000000E+00
 hadron_enhanced_fraction =  1.000000000000E-02
 hadron_enhanced_width =  2.000000000000E+00
 ps_tauola_mh =  1.250000000000E+02
 ps_tauola_mix_angle =  9.000000000000E+01
 mlm_Qcut_ME =  0.000000000000E+00
 mlm_Qcut_PS =  0.000000000000E+00
 mlm_ptmin =  0.000000000000E+00
 mlm_etamax =  0.000000000000E+00
 mlm_Rmin =  0.000000000000E+00
 mlm_Emin =  0.000000000000E+00
 mlm_ETclusfactor =  2.000000000000E-01
 mlm_ETclusminE =  5.000000000000E+00
 mlm_etaclusfactor =  1.000000000000E+00
 mlm_Rclusfactor =  1.000000000000E+00
 mlm_Eclusfactor =  1.000000000000E+00
 powheg_pt_min =  1.000000000000E+00
 powheg_lambda =  2.000000000000E-01
 blha_top_yukawa = -1.000000000000E+00
 ellis_sexton_scale = -1.000000000000E+00
 fks_dij_exp1 =  1.000000000000E+00
 fks_dij_exp2 =  1.000000000000E+00
 fks_xi_min =  1.000000000000E-07
 fks_y_max =  1.000000000000E+00
 fks_xi_cut =  1.000000000000E+00
 fks_delta_o =  2.000000000000E+00
 fks_delta_i =  2.000000000000E+00
 mult_call_real =  1.000000000000E+00
 mult_call_virt =  1.000000000000E+00
 mult_call_dglap =  1.000000000000E+00
 real_partition_scale =  1.000000000000E+01
 #####################################################
 QED.charged* = PDG(11, 13, 15, -11, -13, -15)
 #####################################################
 [user variable] foo = PDG(11, 13, 15)
 #####################################################
 [user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
 #####################################################
 $sf_trace_file = ""
 $lhapdf_dir = ""
 $lhapdf_file = ""
 $lhapdf_photon_file = ""
 $pdf_builtin_set = "CTEQ6L"
 $isr_handler_mode = "trivial"
 $epa_handler_mode = "trivial"
 $circe1_acc = "SBAND"
 [undefined] $circe2_file = [unknown string]
 $circe2_design = "*"
 [undefined] $beam_events_file = [unknown string]
 [undefined] $job_id = [unknown string]
 [undefined] $compile_workspace = [unknown string]
 $model_name = "QED"
 $method = "omega"
 $restrictions = ""
 $omega_flags = ""
 $library_name = "show_4_lib"
 $rng_method = "tao"
 $event_file_version = ""
 $polarization_mode = "helicity"
 $out_file = ""
 $integration_method = "vamp"
 $run_id = ""
 [undefined] $integrate_workspace = [unknown string]
 $vamp_grid_format = "ascii"
 $phs_method = "default"
 $phs_file = ""
 $obs_label = ""
 $obs_unit = ""
 $title = ""
 $description = ""
 $x_label = ""
 $y_label = ""
 $gmlcode_bg = ""
 $gmlcode_fg = ""
 [undefined] $fill_options = [unknown string]
 [undefined] $draw_options = [unknown string]
 [undefined] $err_options = [unknown string]
 [undefined] $symbol = [unknown string]
 $sample = ""
 $sample_normalization = "auto"
 $rescan_input_format = "raw"
 $extension_raw = "evx"
 $extension_default = "evt"
 $debug_extension = "debug"
 $dump_extension = "pset.dat"
 $extension_hepevt = "hepevt"
 $extension_ascii_short = "short.evt"
 $extension_ascii_long = "long.evt"
 $extension_athena = "athena.evt"
 $extension_mokka = "mokka.evt"
 $lhef_version = "2.0"
 $lhef_extension = "lhe"
 $extension_lha = "lha"
 $extension_hepmc = "hepmc"
 $extension_lcio = "slcio"
 $extension_stdhep = "hep"
 $extension_stdhep_up = "up.hep"
 $extension_stdhep_ev4 = "ev4.hep"
 $extension_hepevt_verb = "hepevt.verb"
 $extension_lha_verb = "lha.verb"
 $shower_method = "WHIZARD"
 $ps_PYTHIA_PYGIVE = ""
 $ps_PYTHIA8_config = ""
 $ps_PYTHIA8_config_file = ""
 $hadronization_method = "PYTHIA6"
 $born_me_method = ""
 $loop_me_method = ""
 $correlation_me_method = ""
 $real_tree_me_method = ""
 $dglap_me_method = ""
 $select_alpha_regions = ""
 $virtual_selection = "Full"
 $blha_ew_scheme = "alpha_internal"
 $openloops_extra_cmd = ""
 $fks_mapping_type = "default"
 $resonances_exclude_particles = "default"
 $gosam_filter_lo = ""
 $gosam_filter_nlo = ""
 $gosam_symmetries = "family,generation"
 $gosam_fc = ""
 $dalitz_plot = ""
 $nlo_correction_type = "QCD"
 $exclude_gauge_splittings = "c:b:t:e2:e3"
 $fc => Fortran-compiler
 $fcflags => Fortran-flags
 #####################################################
 ?sf_trace = false
 ?sf_allow_s_mapping = true
 ?hoppet_b_matching = false
 ?isr_recoil = false
 ?isr_keep_energy = false
 ?isr_handler = false
 ?epa_recoil = false
 ?epa_keep_energy = false
 ?epa_handler = false
 ?ewa_recoil = false
 ?ewa_keep_energy = false
 ?circe1_photon1 = false
 ?circe1_photon2 = false
 ?circe1_generate = true
 ?circe1_map = true
 ?circe1_with_radiation = false
 ?circe2_polarized = true
 ?beam_events_warn_eof = true
 ?energy_scan_normalize = false
 ?logging => true
+?proc_as_run_id = true
 ?report_progress = true
 [user variable] ?me_verbose = false
 ?omega_write_phs_output = false
 ?read_color_factors = true
 ?slha_read_input = true
 ?slha_read_spectrum = true
 ?slha_read_decays = false
 ?alphas_is_fixed = true
 ?alphas_from_lhapdf = false
 ?alphas_from_pdf_builtin = false
 ?alphas_from_mz = false
 ?alphas_from_lambda_qcd = false
 ?fatal_beam_decay = true
 ?helicity_selection_active = true
 ?vis_diags = false
 ?vis_diags_color = false
 ?check_event_file = true
 ?unweighted = true
 ?negative_weights = false
 ?resonance_history = false
 ?keep_beams = false
 ?keep_remnants = true
 ?recover_beams = true
 ?update_event = false
 ?update_sqme = false
 ?update_weight = false
 ?use_alphas_from_file = false
 ?use_scale_from_file = false
 ?allow_decays = true
 ?auto_decays = false
 ?auto_decays_radiative = false
 ?decay_rest_frame = false
 ?isotropic_decay = false
 ?diagonal_decay = false
 ?polarized_events = false
 ?colorize_subevt = false
 ?pacify = false
 ?out_advance = true
 ?stratified = true
 ?use_vamp_equivalences = true
 ?vamp_verbose = false
 ?vamp_history_global = true
 ?vamp_history_global_verbose = false
 ?vamp_history_channels = false
 ?vamp_history_channels_verbose = false
 ?integration_timer = true
 ?check_grid_file = true
 ?vis_channels = false
 ?check_phs_file = true
 ?phs_only = false
 ?phs_keep_nonresonant = true
 ?phs_step_mapping = true
 ?phs_step_mapping_exp = true
 ?phs_s_mapping = true
 ?vis_history = false
 ?normalize_bins = false
 ?y_log = false
 ?x_log = false
 [undefined] ?draw_histogram = [unknown logical]
 [undefined] ?draw_base = [unknown logical]
 [undefined] ?draw_piecewise = [unknown logical]
 [undefined] ?fill_curve = [unknown logical]
 [undefined] ?draw_curve = [unknown logical]
 [undefined] ?draw_errors = [unknown logical]
 [undefined] ?draw_symbols = [unknown logical]
 ?analysis_file_only = false
 ?keep_flavors_when_clustering = false
 ?sample_pacify = false
 ?sample_select = true
 ?read_raw = true
 ?write_raw = true
 ?debug_process = true
 ?debug_transforms = true
 ?debug_decay = true
 ?debug_verbose = true
 ?dump_compressed = false
 ?dump_weights = false
 ?dump_summary = false
 ?dump_screen = false
 ?hepevt_ensure_order = false
 ?lhef_write_sqme_prc = true
 ?lhef_write_sqme_ref = false
 ?lhef_write_sqme_alt = true
 ?hepmc_output_cross_section = false
 ?hepmc3_hepmc2mode = false
 ?allow_shower = true
 ?ps_fsr_active = false
 ?ps_isr_active = false
 ?ps_taudec_active = false
 ?muli_active = false
 ?shower_verbose = false
 ?ps_isr_alphas_running = true
 ?ps_fsr_alphas_running = true
 ?ps_isr_pt_ordered = false
 ?ps_isr_angular_ordered = true
 ?ps_isr_only_onshell_emitted_partons = false
 ?allow_hadronization = true
 ?hadronization_active = false
 ?ps_tauola_photos = false
 ?ps_tauola_transverse = false
 ?ps_tauola_dec_rad_cor = true
 ?ps_tauola_pol_vector = false
 ?mlm_matching = false
 ?powheg_matching = false
 ?powheg_use_singular_jacobian = false
 ?powheg_rebuild_grids = false
 ?powheg_test_sudakov = false
 ?powheg_disable_sudakov = false
 ?ckkw_matching = false
 ?omega_openmp => false
 ?openmp_is_active* = false
 ?openmp_logging = false
 ?mpi_logging = false
 ?test_soft_limit = false
 ?test_coll_limit = false
 ?test_anti_coll_limit = false
 ?virtual_collinear_resonance_aware = true
 ?openloops_use_cms = true
 ?openloops_switch_off_muon_yukawa = false
 ?disable_subtraction = false
 ?vis_fks_regions = false
 ?combined_nlo_integration = false
 ?fixed_order_nlo_events = false
 ?check_event_weights_against_xsection = false
 ?keep_failed_events = false
 ?nlo_use_born_scale = false
 ?nlo_cut_all_sqmes = false
 ?nlo_use_real_partition = false
 ?rebuild_library = true
 ?recompile_library = false
 ?rebuild_phase_space = true
 ?rebuild_grids = true
 ?powheg_rebuild_grids = true
 ?rebuild_events = true
 #####################################################
 [undefined] sqrts = [unknown real]
 luminosity =  0.000000000000E+00
 ?sf_trace = false
 $sf_trace_file = ""
 ?sf_allow_s_mapping = true
 $lhapdf_dir = ""
 $lhapdf_file = ""
 $lhapdf_photon_file = ""
 lhapdf_member = 0
 lhapdf_photon_scheme = 0
 $pdf_builtin_set = "CTEQ6L"
 ?hoppet_b_matching = false
 isr_alpha =  0.000000000000E+00
 isr_q_max =  0.000000000000E+00
 isr_mass =  0.000000000000E+00
 isr_order = 3
 ?isr_recoil = false
 ?isr_keep_energy = false
 ?isr_handler = false
 $isr_handler_mode = "trivial"
 epa_alpha =  0.000000000000E+00
 epa_x_min =  0.000000000000E+00
 epa_q_min =  0.000000000000E+00
 epa_q_max =  0.000000000000E+00
 epa_mass =  0.000000000000E+00
 ?epa_recoil = false
 ?epa_keep_energy = false
 ?epa_handler = false
 $epa_handler_mode = "trivial"
 ewa_x_min =  0.000000000000E+00
 ewa_pt_max =  0.000000000000E+00
 ewa_mass =  0.000000000000E+00
 ?ewa_recoil = false
 ?ewa_keep_energy = false
 ?circe1_photon1 = false
 ?circe1_photon2 = false
 [undefined] circe1_sqrts = [unknown real]
 ?circe1_generate = true
 ?circe1_map = true
 circe1_mapping_slope =  2.000000000000E+00
 circe1_eps =  1.000000000000E-05
 circe1_ver = 0
 circe1_rev = 0
 $circe1_acc = "SBAND"
 circe1_chat = 0
 ?circe1_with_radiation = false
 ?circe2_polarized = true
 [undefined] $circe2_file = [unknown string]
 $circe2_design = "*"
 gaussian_spread1 =  0.000000000000E+00
 gaussian_spread2 =  0.000000000000E+00
 [undefined] $beam_events_file = [unknown string]
 ?beam_events_warn_eof = true
 ?energy_scan_normalize = false
 ?logging => true
 [undefined] $job_id = [unknown string]
 [undefined] $compile_workspace = [unknown string]
 seed = 0
 $model_name = "QED"
 [undefined] process_num_id = [unknown integer]
+?proc_as_run_id = true
+lcio_run_id = 0
 $method = "omega"
 ?report_progress = true
 $restrictions = ""
 ?omega_write_phs_output = false
 $omega_flags = ""
 ?read_color_factors = true
 ?slha_read_input = true
 ?slha_read_spectrum = true
 ?slha_read_decays = false
 $library_name = "show_4_lib"
 ?alphas_is_fixed = true
 ?alphas_from_lhapdf = false
 ?alphas_from_pdf_builtin = false
 alphas_order = 0
 alphas_nf = 5
 ?alphas_from_mz = false
 ?alphas_from_lambda_qcd = false
 lambda_qcd =  2.000000000000E-01
 ?fatal_beam_decay = true
 ?helicity_selection_active = true
 helicity_selection_threshold =  1.000000000000E+10
 helicity_selection_cutoff = 1000
 $rng_method = "tao"
 ?vis_diags = false
 ?vis_diags_color = false
 ?check_event_file = true
 $event_file_version = ""
 n_events = 0
 event_index_offset = 0
 ?unweighted = true
 safety_factor =  1.000000000000E+00
 ?negative_weights = false
 ?resonance_history = false
 resonance_on_shell_limit =  4.000000000000E+00
 resonance_on_shell_turnoff =  0.000000000000E+00
 resonance_background_factor =  1.000000000000E+00
 ?keep_beams = false
 ?keep_remnants = true
 ?recover_beams = true
 ?update_event = false
 ?update_sqme = false
 ?update_weight = false
 ?use_alphas_from_file = false
 ?use_scale_from_file = false
 ?allow_decays = true
 ?auto_decays = false
 auto_decays_multiplicity = 2
 ?auto_decays_radiative = false
 ?decay_rest_frame = false
 ?isotropic_decay = false
 ?diagonal_decay = false
 [undefined] decay_helicity = [unknown integer]
 ?polarized_events = false
 $polarization_mode = "helicity"
 ?colorize_subevt = false
 tolerance =  0.000000000000E+00
 checkpoint = 0
 event_callback_interval = 0
 ?pacify = false
 $out_file = ""
 ?out_advance = true
 real_range* = <real_range>
 real_precision* = <real_precision>
 real_epsilon* = <real_epsilon>
 real_tiny* = <real_tiny>
 $integration_method = "vamp"
 threshold_calls = 10
 min_calls_per_channel = 10
 min_calls_per_bin = 10
 min_bins = 3
 max_bins = 20
 ?stratified = true
 ?use_vamp_equivalences = true
 ?vamp_verbose = false
 ?vamp_history_global = true
 ?vamp_history_global_verbose = false
 ?vamp_history_channels = false
 ?vamp_history_channels_verbose = false
 $run_id = ""
 n_calls_test = 0
 ?integration_timer = true
 ?check_grid_file = true
 accuracy_goal =  0.000000000000E+00
 error_goal =  0.000000000000E+00
 relative_error_goal =  0.000000000000E+00
 integration_results_verbosity = 1
 error_threshold =  0.000000000000E+00
 channel_weights_power =  2.500000000000E-01
 [undefined] $integrate_workspace = [unknown string]
 $vamp_grid_format = "ascii"
 $phs_method = "default"
 ?vis_channels = false
 ?check_phs_file = true
 $phs_file = ""
 ?phs_only = false
 phs_threshold_s =  5.000000000000E+01
 phs_threshold_t =  1.000000000000E+02
 phs_off_shell = 2
 phs_t_channel = 6
 phs_e_scale =  1.000000000000E+01
 phs_m_scale =  1.000000000000E+01
 phs_q_scale =  1.000000000000E+01
 ?phs_keep_nonresonant = true
 ?phs_step_mapping = true
 ?phs_step_mapping_exp = true
 ?phs_s_mapping = true
 ?vis_history = false
 n_bins = 20
 ?normalize_bins = false
 $obs_label = ""
 $obs_unit = ""
 $title = ""
 $description = ""
 $x_label = ""
 $y_label = ""
 graph_width_mm = 130
 graph_height_mm = 90
 ?y_log = false
 ?x_log = false
 [undefined] x_min = [unknown real]
 [undefined] x_max = [unknown real]
 [undefined] y_min = [unknown real]
 [undefined] y_max = [unknown real]
 $gmlcode_bg = ""
 $gmlcode_fg = ""
 [undefined] ?draw_histogram = [unknown logical]
 [undefined] ?draw_base = [unknown logical]
 [undefined] ?draw_piecewise = [unknown logical]
 [undefined] ?fill_curve = [unknown logical]
 [undefined] ?draw_curve = [unknown logical]
 [undefined] ?draw_errors = [unknown logical]
 [undefined] ?draw_symbols = [unknown logical]
 [undefined] $fill_options = [unknown string]
 [undefined] $draw_options = [unknown string]
 [undefined] $err_options = [unknown string]
 [undefined] $symbol = [unknown string]
 ?analysis_file_only = false
 kt_algorithm* = 0
 cambridge_algorithm* = 1
 antikt_algorithm* = 2
 genkt_algorithm* = 3
 cambridge_for_passive_algorithm* = 11
 genkt_for_passive_algorithm* = 13
 ee_kt_algorithm* = 50
 ee_genkt_algorithm* = 53
 plugin_algorithm* = 99
 undefined_jet_algorithm* = 999
 jet_algorithm = 999
 jet_r =  0.000000000000E+00
 jet_p =  0.000000000000E+00
 jet_ycut =  0.000000000000E+00
 ?keep_flavors_when_clustering = false
 photon_iso_eps =  1.000000000000E+00
 photon_iso_n =  1.000000000000E+00
 photon_iso_r0 =  4.000000000000E-01
 $sample = ""
 $sample_normalization = "auto"
 ?sample_pacify = false
 ?sample_select = true
 sample_max_tries = 10000
 sample_split_n_evt = 0
 sample_split_n_kbytes = 0
 sample_split_index = 0
 $rescan_input_format = "raw"
 ?read_raw = true
 ?write_raw = true
 $extension_raw = "evx"
 $extension_default = "evt"
 $debug_extension = "debug"
 ?debug_process = true
 ?debug_transforms = true
 ?debug_decay = true
 ?debug_verbose = true
 $dump_extension = "pset.dat"
 ?dump_compressed = false
 ?dump_weights = false
 ?dump_summary = false
 ?dump_screen = false
 ?hepevt_ensure_order = false
 $extension_hepevt = "hepevt"
 $extension_ascii_short = "short.evt"
 $extension_ascii_long = "long.evt"
 $extension_athena = "athena.evt"
 $extension_mokka = "mokka.evt"
 $lhef_version = "2.0"
 $lhef_extension = "lhe"
 ?lhef_write_sqme_prc = true
 ?lhef_write_sqme_ref = false
 ?lhef_write_sqme_alt = true
 $extension_lha = "lha"
 $extension_hepmc = "hepmc"
 ?hepmc_output_cross_section = false
 ?hepmc3_hepmc2mode = false
 $extension_lcio = "slcio"
 $extension_stdhep = "hep"
 $extension_stdhep_up = "up.hep"
 $extension_stdhep_ev4 = "ev4.hep"
 $extension_hepevt_verb = "hepevt.verb"
 $extension_lha_verb = "lha.verb"
 ?allow_shower = true
 ?ps_fsr_active = false
 ?ps_isr_active = false
 ?ps_taudec_active = false
 ?muli_active = false
 $shower_method = "WHIZARD"
 ?shower_verbose = false
 $ps_PYTHIA_PYGIVE = ""
 $ps_PYTHIA8_config = ""
 $ps_PYTHIA8_config_file = ""
 ps_mass_cutoff =  1.000000000000E+00
 ps_fsr_lambda =  2.900000000000E-01
 ps_isr_lambda =  2.900000000000E-01
 ps_max_n_flavors = 5
 ?ps_isr_alphas_running = true
 ?ps_fsr_alphas_running = true
 ps_fixed_alphas =  0.000000000000E+00
 ?ps_isr_pt_ordered = false
 ?ps_isr_angular_ordered = true
 ps_isr_primordial_kt_width =  0.000000000000E+00
 ps_isr_primordial_kt_cutoff =  5.000000000000E+00
 ps_isr_z_cutoff =  9.990000000000E-01
 ps_isr_minenergy =  1.000000000000E+00
 ps_isr_tscalefactor =  1.000000000000E+00
 ?ps_isr_only_onshell_emitted_partons = false
 ?allow_hadronization = true
 ?hadronization_active = false
 $hadronization_method = "PYTHIA6"
 hadron_enhanced_fraction =  1.000000000000E-02
 hadron_enhanced_width =  2.000000000000E+00
 ?ps_tauola_photos = false
 ?ps_tauola_transverse = false
 ?ps_tauola_dec_rad_cor = true
 ps_tauola_dec_mode1 = 0
 ps_tauola_dec_mode2 = 0
 ps_tauola_mh =  1.250000000000E+02
 ps_tauola_mix_angle =  9.000000000000E+01
 ?ps_tauola_pol_vector = false
 ?mlm_matching = false
 mlm_Qcut_ME =  0.000000000000E+00
 mlm_Qcut_PS =  0.000000000000E+00
 mlm_ptmin =  0.000000000000E+00
 mlm_etamax =  0.000000000000E+00
 mlm_Rmin =  0.000000000000E+00
 mlm_Emin =  0.000000000000E+00
 mlm_nmaxMEjets = 0
 mlm_ETclusfactor =  2.000000000000E-01
 mlm_ETclusminE =  5.000000000000E+00
 mlm_etaclusfactor =  1.000000000000E+00
 mlm_Rclusfactor =  1.000000000000E+00
 mlm_Eclusfactor =  1.000000000000E+00
 ?powheg_matching = false
 ?powheg_use_singular_jacobian = false
 powheg_grid_size_xi = 5
 powheg_grid_size_y = 5
 powheg_grid_sampling_points = 500000
 powheg_pt_min =  1.000000000000E+00
 powheg_lambda =  2.000000000000E-01
 ?powheg_rebuild_grids = false
 ?powheg_test_sudakov = false
 ?powheg_disable_sudakov = false
 ?ckkw_matching = false
 ?omega_openmp => false
 ?openmp_is_active* = false
 openmp_num_threads_default* = 1
 openmp_num_threads = 1
 ?openmp_logging = false
 ?mpi_logging = false
 $born_me_method = ""
 $loop_me_method = ""
 $correlation_me_method = ""
 $real_tree_me_method = ""
 $dglap_me_method = ""
 ?test_soft_limit = false
 ?test_coll_limit = false
 ?test_anti_coll_limit = false
 $select_alpha_regions = ""
 $virtual_selection = "Full"
 ?virtual_collinear_resonance_aware = true
 blha_top_yukawa = -1.000000000000E+00
 $blha_ew_scheme = "alpha_internal"
 openloops_verbosity = 1
 ?openloops_use_cms = true
 openloops_phs_tolerance = 7
 openloops_stability_log = 0
 ?openloops_switch_off_muon_yukawa = false
 $openloops_extra_cmd = ""
 ellis_sexton_scale = -1.000000000000E+00
 ?disable_subtraction = false
 fks_dij_exp1 =  1.000000000000E+00
 fks_dij_exp2 =  1.000000000000E+00
 fks_xi_min =  1.000000000000E-07
 fks_y_max =  1.000000000000E+00
 ?vis_fks_regions = false
 fks_xi_cut =  1.000000000000E+00
 fks_delta_o =  2.000000000000E+00
 fks_delta_i =  2.000000000000E+00
 $fks_mapping_type = "default"
 $resonances_exclude_particles = "default"
 alpha_power = 2
 alphas_power = 0
 ?combined_nlo_integration = false
 ?fixed_order_nlo_events = false
 ?check_event_weights_against_xsection = false
 ?keep_failed_events = false
 gks_multiplicity = 0
 $gosam_filter_lo = ""
 $gosam_filter_nlo = ""
 $gosam_symmetries = "family,generation"
 form_threads = 2
 form_workspace = 1000
 $gosam_fc = ""
 mult_call_real =  1.000000000000E+00
 mult_call_virt =  1.000000000000E+00
 mult_call_dglap =  1.000000000000E+00
 $dalitz_plot = ""
 $nlo_correction_type = "QCD"
 $exclude_gauge_splittings = "c:b:t:e2:e3"
 ?nlo_use_born_scale = false
 ?nlo_cut_all_sqmes = false
 ?nlo_use_real_partition = false
 real_partition_scale =  1.000000000000E+01
 $fc => Fortran-compiler
 $fcflags => Fortran-flags
 ?rebuild_library = true
 ?recompile_library = false
 ?rebuild_phase_space = true
 ?rebuild_grids = true
 ?powheg_rebuild_grids = true
 ?rebuild_events = true
 #####################################################
 QED.ee =>  3.028600000000E-01
 QED.me =>  5.110000000000E-04
 QED.mmu =>  1.057000000000E-01
 QED.mtau =>  1.777000000000E+00
 QED.particle* = PDG(0)
 QED.E_LEPTON* = PDG(11)
 QED.e-* = PDG(11)
 QED.e1* = PDG(11)
 QED.e+* = PDG(-11)
 QED.E1* = PDG(-11)
 QED.MU_LEPTON* = PDG(13)
 QED.m-* = PDG(13)
 QED.e2* = PDG(13)
 QED.mu-* = PDG(13)
 QED.m+* = PDG(-13)
 QED.E2* = PDG(-13)
 QED.mu+* = PDG(-13)
 QED.TAU_LEPTON* = PDG(15)
 QED.t-* = PDG(15)
 QED.e3* = PDG(15)
 QED.ta-* = PDG(15)
 QED.tau-* = PDG(15)
 QED.t+* = PDG(-15)
 QED.E3* = PDG(-15)
 QED.ta+* = PDG(-15)
 QED.tau+* = PDG(-15)
 QED.PHOTON* = PDG(22)
 QED.A* = PDG(22)
 QED.gamma* = PDG(22)
 QED.photon* = PDG(22)
 QED.charged* = PDG(11, 13, 15, -11, -13, -15)
 QED.neutral* = PDG(22)
 QED.colored* = PDG()
 [undefined] sqrts = [unknown real]
 luminosity =  0.000000000000E+00
 ?sf_trace = false
 $sf_trace_file = ""
 ?sf_allow_s_mapping = true
 $lhapdf_dir = ""
 $lhapdf_file = ""
 $lhapdf_photon_file = ""
 lhapdf_member = 0
 lhapdf_photon_scheme = 0
 $pdf_builtin_set = "CTEQ6L"
 ?hoppet_b_matching = false
 isr_alpha =  0.000000000000E+00
 isr_q_max =  0.000000000000E+00
 isr_mass =  0.000000000000E+00
 isr_order = 3
 ?isr_recoil = false
 ?isr_keep_energy = false
 ?isr_handler = false
 $isr_handler_mode = "trivial"
 epa_alpha =  0.000000000000E+00
 epa_x_min =  0.000000000000E+00
 epa_q_min =  0.000000000000E+00
 epa_q_max =  0.000000000000E+00
 epa_mass =  0.000000000000E+00
 ?epa_recoil = false
 ?epa_keep_energy = false
 ?epa_handler = false
 $epa_handler_mode = "trivial"
 ewa_x_min =  0.000000000000E+00
 ewa_pt_max =  0.000000000000E+00
 ewa_mass =  0.000000000000E+00
 ?ewa_recoil = false
 ?ewa_keep_energy = false
 ?circe1_photon1 = false
 ?circe1_photon2 = false
 [undefined] circe1_sqrts = [unknown real]
 ?circe1_generate = true
 ?circe1_map = true
 circe1_mapping_slope =  2.000000000000E+00
 circe1_eps =  1.000000000000E-05
 circe1_ver = 0
 circe1_rev = 0
 $circe1_acc = "SBAND"
 circe1_chat = 0
 ?circe1_with_radiation = false
 ?circe2_polarized = true
 [undefined] $circe2_file = [unknown string]
 $circe2_design = "*"
 gaussian_spread1 =  0.000000000000E+00
 gaussian_spread2 =  0.000000000000E+00
 [undefined] $beam_events_file = [unknown string]
 ?beam_events_warn_eof = true
 ?energy_scan_normalize = false
 ?logging => true
 [undefined] $job_id = [unknown string]
 [undefined] $compile_workspace = [unknown string]
 seed = 0
 $model_name = "QED"
 [undefined] process_num_id = [unknown integer]
+?proc_as_run_id = true
+lcio_run_id = 0
 $method = "omega"
 ?report_progress = true
 [user variable] ?me_verbose = false
 $restrictions = ""
 ?omega_write_phs_output = false
 $omega_flags = ""
 ?read_color_factors = true
 ?slha_read_input = true
 ?slha_read_spectrum = true
 ?slha_read_decays = false
 $library_name = "show_4_lib"
 ?alphas_is_fixed = true
 ?alphas_from_lhapdf = false
 ?alphas_from_pdf_builtin = false
 alphas_order = 0
 alphas_nf = 5
 ?alphas_from_mz = false
 ?alphas_from_lambda_qcd = false
 lambda_qcd =  2.000000000000E-01
 ?fatal_beam_decay = true
 ?helicity_selection_active = true
 helicity_selection_threshold =  1.000000000000E+10
 helicity_selection_cutoff = 1000
 $rng_method = "tao"
 ?vis_diags = false
 ?vis_diags_color = false
 ?check_event_file = true
 $event_file_version = ""
 n_events = 0
 event_index_offset = 0
 ?unweighted = true
 safety_factor =  1.000000000000E+00
 ?negative_weights = false
 ?resonance_history = false
 resonance_on_shell_limit =  4.000000000000E+00
 resonance_on_shell_turnoff =  0.000000000000E+00
 resonance_background_factor =  1.000000000000E+00
 ?keep_beams = false
 ?keep_remnants = true
 ?recover_beams = true
 ?update_event = false
 ?update_sqme = false
 ?update_weight = false
 ?use_alphas_from_file = false
 ?use_scale_from_file = false
 ?allow_decays = true
 ?auto_decays = false
 auto_decays_multiplicity = 2
 ?auto_decays_radiative = false
 ?decay_rest_frame = false
 ?isotropic_decay = false
 ?diagonal_decay = false
 [undefined] decay_helicity = [unknown integer]
 ?polarized_events = false
 $polarization_mode = "helicity"
 ?colorize_subevt = false
 tolerance =  0.000000000000E+00
 checkpoint = 0
 event_callback_interval = 0
 ?pacify = false
 $out_file = ""
 ?out_advance = true
 real_range* = <real_range>
 real_precision* = <real_precision>
 real_epsilon* = <real_epsilon>
 real_tiny* = <real_tiny>
 $integration_method = "vamp"
 threshold_calls = 10
 min_calls_per_channel = 10
 min_calls_per_bin = 10
 min_bins = 3
 max_bins = 20
 ?stratified = true
 ?use_vamp_equivalences = true
 ?vamp_verbose = false
 ?vamp_history_global = true
 ?vamp_history_global_verbose = false
 ?vamp_history_channels = false
 ?vamp_history_channels_verbose = false
 $run_id = ""
 n_calls_test = 0
 ?integration_timer = true
 ?check_grid_file = true
 accuracy_goal =  0.000000000000E+00
 error_goal =  0.000000000000E+00
 relative_error_goal =  0.000000000000E+00
 integration_results_verbosity = 1
 error_threshold =  0.000000000000E+00
 channel_weights_power =  2.500000000000E-01
 [undefined] $integrate_workspace = [unknown string]
 $vamp_grid_format = "ascii"
 $phs_method = "default"
 ?vis_channels = false
 ?check_phs_file = true
 $phs_file = ""
 ?phs_only = false
 phs_threshold_s =  5.000000000000E+01
 phs_threshold_t =  1.000000000000E+02
 phs_off_shell = 2
 phs_t_channel = 6
 phs_e_scale =  1.000000000000E+01
 phs_m_scale =  1.000000000000E+01
 phs_q_scale =  1.000000000000E+01
 ?phs_keep_nonresonant = true
 ?phs_step_mapping = true
 ?phs_step_mapping_exp = true
 ?phs_s_mapping = true
 ?vis_history = false
 n_bins = 20
 ?normalize_bins = false
 $obs_label = ""
 $obs_unit = ""
 $title = ""
 $description = ""
 $x_label = ""
 $y_label = ""
 graph_width_mm = 130
 graph_height_mm = 90
 ?y_log = false
 ?x_log = false
 [undefined] x_min = [unknown real]
 [undefined] x_max = [unknown real]
 [undefined] y_min = [unknown real]
 [undefined] y_max = [unknown real]
 $gmlcode_bg = ""
 $gmlcode_fg = ""
 [undefined] ?draw_histogram = [unknown logical]
 [undefined] ?draw_base = [unknown logical]
 [undefined] ?draw_piecewise = [unknown logical]
 [undefined] ?fill_curve = [unknown logical]
 [undefined] ?draw_curve = [unknown logical]
 [undefined] ?draw_errors = [unknown logical]
 [undefined] ?draw_symbols = [unknown logical]
 [undefined] $fill_options = [unknown string]
 [undefined] $draw_options = [unknown string]
 [undefined] $err_options = [unknown string]
 [undefined] $symbol = [unknown string]
 ?analysis_file_only = false
 kt_algorithm* = 0
 cambridge_algorithm* = 1
 antikt_algorithm* = 2
 genkt_algorithm* = 3
 cambridge_for_passive_algorithm* = 11
 genkt_for_passive_algorithm* = 13
 ee_kt_algorithm* = 50
 ee_genkt_algorithm* = 53
 plugin_algorithm* = 99
 undefined_jet_algorithm* = 999
 jet_algorithm = 999
 jet_r =  0.000000000000E+00
 jet_p =  0.000000000000E+00
 jet_ycut =  0.000000000000E+00
 ?keep_flavors_when_clustering = false
 photon_iso_eps =  1.000000000000E+00
 photon_iso_n =  1.000000000000E+00
 photon_iso_r0 =  4.000000000000E-01
 $sample = ""
 $sample_normalization = "auto"
 ?sample_pacify = false
 ?sample_select = true
 sample_max_tries = 10000
 sample_split_n_evt = 0
 sample_split_n_kbytes = 0
 sample_split_index = 0
 $rescan_input_format = "raw"
 ?read_raw = true
 ?write_raw = true
 $extension_raw = "evx"
 $extension_default = "evt"
 $debug_extension = "debug"
 ?debug_process = true
 ?debug_transforms = true
 ?debug_decay = true
 ?debug_verbose = true
 $dump_extension = "pset.dat"
 ?dump_compressed = false
 ?dump_weights = false
 ?dump_summary = false
 ?dump_screen = false
 ?hepevt_ensure_order = false
 $extension_hepevt = "hepevt"
 $extension_ascii_short = "short.evt"
 $extension_ascii_long = "long.evt"
 $extension_athena = "athena.evt"
 $extension_mokka = "mokka.evt"
 $lhef_version = "2.0"
 $lhef_extension = "lhe"
 ?lhef_write_sqme_prc = true
 ?lhef_write_sqme_ref = false
 ?lhef_write_sqme_alt = true
 $extension_lha = "lha"
 $extension_hepmc = "hepmc"
 ?hepmc_output_cross_section = false
 ?hepmc3_hepmc2mode = false
 $extension_lcio = "slcio"
 $extension_stdhep = "hep"
 $extension_stdhep_up = "up.hep"
 $extension_stdhep_ev4 = "ev4.hep"
 $extension_hepevt_verb = "hepevt.verb"
 $extension_lha_verb = "lha.verb"
 ?allow_shower = true
 ?ps_fsr_active = false
 ?ps_isr_active = false
 ?ps_taudec_active = false
 ?muli_active = false
 $shower_method = "WHIZARD"
 ?shower_verbose = false
 $ps_PYTHIA_PYGIVE = ""
 $ps_PYTHIA8_config = ""
 $ps_PYTHIA8_config_file = ""
 ps_mass_cutoff =  1.000000000000E+00
 ps_fsr_lambda =  2.900000000000E-01
 ps_isr_lambda =  2.900000000000E-01
 ps_max_n_flavors = 5
 ?ps_isr_alphas_running = true
 ?ps_fsr_alphas_running = true
 ps_fixed_alphas =  0.000000000000E+00
 ?ps_isr_pt_ordered = false
 ?ps_isr_angular_ordered = true
 ps_isr_primordial_kt_width =  0.000000000000E+00
 ps_isr_primordial_kt_cutoff =  5.000000000000E+00
 ps_isr_z_cutoff =  9.990000000000E-01
 ps_isr_minenergy =  1.000000000000E+00
 ps_isr_tscalefactor =  1.000000000000E+00
 ?ps_isr_only_onshell_emitted_partons = false
 ?allow_hadronization = true
 ?hadronization_active = false
 $hadronization_method = "PYTHIA6"
 hadron_enhanced_fraction =  1.000000000000E-02
 hadron_enhanced_width =  2.000000000000E+00
 ?ps_tauola_photos = false
 ?ps_tauola_transverse = false
 ?ps_tauola_dec_rad_cor = true
 ps_tauola_dec_mode1 = 0
 ps_tauola_dec_mode2 = 0
 ps_tauola_mh =  1.250000000000E+02
 ps_tauola_mix_angle =  9.000000000000E+01
 ?ps_tauola_pol_vector = false
 ?mlm_matching = false
 mlm_Qcut_ME =  0.000000000000E+00
 mlm_Qcut_PS =  0.000000000000E+00
 mlm_ptmin =  0.000000000000E+00
 mlm_etamax =  0.000000000000E+00
 mlm_Rmin =  0.000000000000E+00
 mlm_Emin =  0.000000000000E+00
 mlm_nmaxMEjets = 0
 mlm_ETclusfactor =  2.000000000000E-01
 mlm_ETclusminE =  5.000000000000E+00
 mlm_etaclusfactor =  1.000000000000E+00
 mlm_Rclusfactor =  1.000000000000E+00
 mlm_Eclusfactor =  1.000000000000E+00
 ?powheg_matching = false
 ?powheg_use_singular_jacobian = false
 powheg_grid_size_xi = 5
 powheg_grid_size_y = 5
 powheg_grid_sampling_points = 500000
 powheg_pt_min =  1.000000000000E+00
 powheg_lambda =  2.000000000000E-01
 ?powheg_rebuild_grids = false
 ?powheg_test_sudakov = false
 ?powheg_disable_sudakov = false
 ?ckkw_matching = false
 ?omega_openmp => false
 ?openmp_is_active* = false
 openmp_num_threads_default* = 1
 openmp_num_threads = 1
 ?openmp_logging = false
 ?mpi_logging = false
 $born_me_method = ""
 $loop_me_method = ""
 $correlation_me_method = ""
 $real_tree_me_method = ""
 $dglap_me_method = ""
 ?test_soft_limit = false
 ?test_coll_limit = false
 ?test_anti_coll_limit = false
 $select_alpha_regions = ""
 $virtual_selection = "Full"
 ?virtual_collinear_resonance_aware = true
 blha_top_yukawa = -1.000000000000E+00
 $blha_ew_scheme = "alpha_internal"
 openloops_verbosity = 1
 ?openloops_use_cms = true
 openloops_phs_tolerance = 7
 openloops_stability_log = 0
 ?openloops_switch_off_muon_yukawa = false
 $openloops_extra_cmd = ""
 ellis_sexton_scale = -1.000000000000E+00
 ?disable_subtraction = false
 fks_dij_exp1 =  1.000000000000E+00
 fks_dij_exp2 =  1.000000000000E+00
 fks_xi_min =  1.000000000000E-07
 fks_y_max =  1.000000000000E+00
 ?vis_fks_regions = false
 fks_xi_cut =  1.000000000000E+00
 fks_delta_o =  2.000000000000E+00
 fks_delta_i =  2.000000000000E+00
 $fks_mapping_type = "default"
 $resonances_exclude_particles = "default"
 alpha_power = 2
 alphas_power = 0
 ?combined_nlo_integration = false
 ?fixed_order_nlo_events = false
 ?check_event_weights_against_xsection = false
 ?keep_failed_events = false
 gks_multiplicity = 0
 $gosam_filter_lo = ""
 $gosam_filter_nlo = ""
 $gosam_symmetries = "family,generation"
 form_threads = 2
 form_workspace = 1000
 $gosam_fc = ""
 mult_call_real =  1.000000000000E+00
 mult_call_virt =  1.000000000000E+00
 mult_call_dglap =  1.000000000000E+00
 $dalitz_plot = ""
 $nlo_correction_type = "QCD"
 $exclude_gauge_splittings = "c:b:t:e2:e3"
 ?nlo_use_born_scale = false
 ?nlo_cut_all_sqmes = false
 ?nlo_use_real_partition = false
 real_partition_scale =  1.000000000000E+01
 $fc => Fortran-compiler
 $fcflags => Fortran-flags
 ?rebuild_library = true
 ?recompile_library = false
 ?rebuild_phase_space = true
 ?rebuild_grids = true
 ?powheg_rebuild_grids = true
 ?rebuild_events = true
 [user variable] foo = PDG(11, 13, 15)
 [user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/ref-output/vars.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/vars.ref	(revision 8384)
+++ trunk/share/tests/functional_tests/ref-output/vars.ref	(revision 8385)
@@ -1,376 +1,377 @@
 ?openmp_logging = false
 [user variable] foo = -7.800000000000E-02
 [user variable] bar = 1
 [user variable] a =  2.010000000000E-05
 [user variable] i = 3
 [user variable] foo =  2.922000000000E+00
 [user variable] i = 9
 [user variable] foo =  2.922000000000E+00
 [user variable] bar = 1
 [user variable] i = 9
 [user variable] k = 1
 [user variable] k2 =  1.000000000000E+00
 [user variable] i = -1
 [user variable] k = 2
 [user variable] k2 =  4.000000000000E+00
 [user variable] i = -2
 [user variable] k = 3
 [user variable] k2 =  9.000000000000E+00
 [user variable] i = -3
 [user variable] k = 4
 [user variable] k2 =  1.600000000000E+01
 [user variable] i = -4
 [user variable] k = 8
 [user variable] k2 =  6.400000000000E+01
 [user variable] i = -8
 [user variable] i = 9
 [user variable] MW =  7.980000000000E+01
 [user variable] MW =  7.980000000000E+01
 SM.mtau =>  8.000000000000E-01
 SM.mW =>  8.011900000000E+01
 SM.mW =>  8.011900000000E+01
 SM.sw* =>  4.775372811515E-01
 SM.mW =>  7.500000000000E+01
 SM.sw* =>  5.688014954824E-01
 SM.mW =>  8.000000000000E+01
 SM.sw* =>  4.799305327664E-01
 SM.mW =>  8.050000000000E+01
 SM.sw* =>  4.697684723671E-01
 SM.mW =>  8.100000000000E+01
 SM.sw* =>  4.593162187090E-01
 SM.mW =>  8.150000000000E+01
 SM.sw* =>  4.485534858838E-01
 SM.mW =>  8.200000000000E+01
 SM.sw* =>  4.374573583998E-01
 SM.mW =>  8.300000000000E+01
 SM.sw* =>  4.141569403361E-01
 SM.mW =>  8.469722796445E+01
 SM.sw* =>  3.705366373038E-01
 SM.mW =>  8.642916174533E+01
 SM.sw* =>  3.188332912310E-01
 SM.mW =>  8.819651102555E+01
 SM.sw* =>  2.540459583362E-01
 SM.mW =>  9.000000000000E+01
 SM.sw* =>  1.609055729882E-01
 mW is 80.119 and sw is:   0.4775
 seed = 32
 seed = 32
 seed = 30
 seed = 30
 seed = 28
 seed = 28
 seed = 26
 seed = 26
 seed = 24
 seed = 24
 seed = 22
 seed = 22
 seed = 20
 seed = 20
 seed = 18
 seed = 18
 seed = 16
 seed = 16
 seed = 14
 seed = 14
 seed = 12
 seed = 12
 seed = 10
 seed = 10
 seed = 8
 seed = 8
 seed = 6
 seed = 6
 seed = 4
 seed = 4
 seed = 2
 seed = 2
 [user variable] $str = "foo"
 [user variable] $str = "bar"
 [user variable] ?ok = false
 [user variable] ?ok = false
 [user variable] ?ok = true
 ?sf_trace = false
 ?sf_allow_s_mapping = true
 ?hoppet_b_matching = false
 ?isr_recoil = false
 ?isr_keep_energy = false
 ?isr_handler = false
 ?epa_recoil = false
 ?epa_keep_energy = false
 ?epa_handler = false
 ?ewa_recoil = false
 ?ewa_keep_energy = false
 ?circe1_photon1 = false
 ?circe1_photon2 = false
 ?circe1_generate = true
 ?circe1_map = true
 ?circe1_with_radiation = false
 ?circe2_polarized = true
 ?beam_events_warn_eof = true
 ?energy_scan_normalize = false
 ?logging => true
+?proc_as_run_id = true
 ?report_progress = true
 [user variable] ?me_verbose = false
 ?omega_write_phs_output = false
 ?read_color_factors = true
 ?slha_read_input = true
 ?slha_read_spectrum = true
 ?slha_read_decays = false
 ?alphas_is_fixed = true
 ?alphas_from_lhapdf = false
 ?alphas_from_pdf_builtin = false
 ?alphas_from_mz = false
 ?alphas_from_lambda_qcd = false
 ?fatal_beam_decay = true
 ?helicity_selection_active = true
 ?vis_diags = false
 ?vis_diags_color = false
 ?check_event_file = true
 ?unweighted = true
 ?negative_weights = false
 ?resonance_history = false
 ?keep_beams = false
 ?keep_remnants = true
 ?recover_beams = true
 ?update_event = false
 ?update_sqme = false
 ?update_weight = false
 ?use_alphas_from_file = false
 ?use_scale_from_file = false
 ?allow_decays = true
 ?auto_decays = false
 ?auto_decays_radiative = false
 ?decay_rest_frame = false
 ?isotropic_decay = false
 ?diagonal_decay = false
 ?polarized_events = false
 ?colorize_subevt = false
 ?pacify = false
 ?out_advance = true
 ?stratified = true
 ?use_vamp_equivalences = true
 ?vamp_verbose = false
 ?vamp_history_global = true
 ?vamp_history_global_verbose = false
 ?vamp_history_channels = false
 ?vamp_history_channels_verbose = false
 ?integration_timer = true
 ?check_grid_file = true
 ?vis_channels = false
 ?check_phs_file = true
 ?phs_only = false
 ?phs_keep_nonresonant = true
 ?phs_step_mapping = true
 ?phs_step_mapping_exp = true
 ?phs_s_mapping = true
 ?vis_history = false
 ?normalize_bins = false
 ?y_log = false
 ?x_log = false
 [undefined] ?draw_histogram = [unknown logical]
 [undefined] ?draw_base = [unknown logical]
 [undefined] ?draw_piecewise = [unknown logical]
 [undefined] ?fill_curve = [unknown logical]
 [undefined] ?draw_curve = [unknown logical]
 [undefined] ?draw_errors = [unknown logical]
 [undefined] ?draw_symbols = [unknown logical]
 ?analysis_file_only = false
 ?keep_flavors_when_clustering = false
 ?sample_pacify = false
 ?sample_select = true
 ?read_raw = true
 ?write_raw = true
 ?debug_process = true
 ?debug_transforms = true
 ?debug_decay = true
 ?debug_verbose = true
 ?dump_compressed = false
 ?dump_weights = false
 ?dump_summary = false
 ?dump_screen = false
 ?hepevt_ensure_order = false
 ?lhef_write_sqme_prc = true
 ?lhef_write_sqme_ref = false
 ?lhef_write_sqme_alt = true
 ?hepmc_output_cross_section = false
 ?hepmc3_hepmc2mode = false
 ?allow_shower = true
 ?ps_fsr_active = false
 ?ps_isr_active = false
 ?ps_taudec_active = false
 ?muli_active = false
 ?shower_verbose = false
 ?ps_isr_alphas_running = true
 ?ps_fsr_alphas_running = true
 ?ps_isr_pt_ordered = false
 ?ps_isr_angular_ordered = true
 ?ps_isr_only_onshell_emitted_partons = false
 ?allow_hadronization = true
 ?hadronization_active = false
 ?ps_tauola_photos = false
 ?ps_tauola_transverse = false
 ?ps_tauola_dec_rad_cor = true
 ?ps_tauola_pol_vector = false
 ?mlm_matching = false
 ?powheg_matching = false
 ?powheg_use_singular_jacobian = false
 ?powheg_rebuild_grids = false
 ?powheg_test_sudakov = false
 ?powheg_disable_sudakov = false
 ?ckkw_matching = false
 ?omega_openmp => false
 ?openmp_is_active* = false
 ?openmp_logging = false
 ?mpi_logging = false
 ?test_soft_limit = false
 ?test_coll_limit = false
 ?test_anti_coll_limit = false
 ?virtual_collinear_resonance_aware = true
 ?openloops_use_cms = true
 ?openloops_switch_off_muon_yukawa = false
 ?disable_subtraction = false
 ?vis_fks_regions = false
 ?combined_nlo_integration = false
 ?fixed_order_nlo_events = false
 ?check_event_weights_against_xsection = false
 ?keep_failed_events = false
 ?nlo_use_born_scale = false
 ?nlo_cut_all_sqmes = false
 ?nlo_use_real_partition = false
 ?rebuild_library = true
 ?recompile_library = false
 ?rebuild_phase_space = true
 ?rebuild_grids = true
 ?powheg_rebuild_grids = true
 ?rebuild_events = true
 [user variable] ?ok = true
 [user variable] $str = "foo"
 [user variable] $str = "foobar"
 $sf_trace_file = ""
 $lhapdf_dir = ""
 $lhapdf_file = ""
 $lhapdf_photon_file = ""
 $pdf_builtin_set = "CTEQ6L"
 $isr_handler_mode = "trivial"
 $epa_handler_mode = "trivial"
 $circe1_acc = "SBAND"
 [undefined] $circe2_file = [unknown string]
 $circe2_design = "*"
 [undefined] $beam_events_file = [unknown string]
 [undefined] $job_id = [unknown string]
 [undefined] $compile_workspace = [unknown string]
 $model_name = "SM"
 $method = "omega"
 $restrictions = ""
 $omega_flags = ""
 $library_name = "vars_lib"
 $rng_method = "tao"
 $event_file_version = ""
 $polarization_mode = "helicity"
 $out_file = ""
 $integration_method = "vamp"
 $run_id = ""
 [undefined] $integrate_workspace = [unknown string]
 $vamp_grid_format = "ascii"
 $phs_method = "default"
 $phs_file = ""
 $obs_label = ""
 $obs_unit = ""
 $title = ""
 $description = ""
 $x_label = ""
 $y_label = ""
 $gmlcode_bg = ""
 $gmlcode_fg = ""
 [undefined] $fill_options = [unknown string]
 [undefined] $draw_options = [unknown string]
 [undefined] $err_options = [unknown string]
 [undefined] $symbol = [unknown string]
 $sample = ""
 $sample_normalization = "auto"
 $rescan_input_format = "raw"
 $extension_raw = "evx"
 $extension_default = "evt"
 $debug_extension = "debug"
 $dump_extension = "pset.dat"
 $extension_hepevt = "hepevt"
 $extension_ascii_short = "short.evt"
 $extension_ascii_long = "long.evt"
 $extension_athena = "athena.evt"
 $extension_mokka = "mokka.evt"
 $lhef_version = "2.0"
 $lhef_extension = "lhe"
 $extension_lha = "lha"
 $extension_hepmc = "hepmc"
 $extension_lcio = "slcio"
 $extension_stdhep = "hep"
 $extension_stdhep_up = "up.hep"
 $extension_stdhep_ev4 = "ev4.hep"
 $extension_hepevt_verb = "hepevt.verb"
 $extension_lha_verb = "lha.verb"
 $shower_method = "WHIZARD"
 $ps_PYTHIA_PYGIVE = ""
 $ps_PYTHIA8_config = ""
 $ps_PYTHIA8_config_file = ""
 $hadronization_method = "PYTHIA6"
 $born_me_method = ""
 $loop_me_method = ""
 $correlation_me_method = ""
 $real_tree_me_method = ""
 $dglap_me_method = ""
 $select_alpha_regions = ""
 $virtual_selection = "Full"
 $blha_ew_scheme = "alpha_internal"
 $openloops_extra_cmd = ""
 $fks_mapping_type = "default"
 $resonances_exclude_particles = "default"
 $gosam_filter_lo = ""
 $gosam_filter_nlo = ""
 $gosam_symmetries = "family,generation"
 $gosam_fc = ""
 $dalitz_plot = ""
 $nlo_correction_type = "QCD"
 $exclude_gauge_splittings = "c:b:t:e2:e3"
 $fc => Fortran-compiler
 $fcflags => Fortran-flags
 [user variable] $str = "foobar"
 [user variable] q = PDG(2)
 [user variable] q = PDG(2, 1, -2, -1)
 Q is only local and hence not not defined
 ******************************************************************************
 *** ERROR: show: object 'Q' not found
 ******************************************************************************
 |             (WHIZARD run continues)
 SM.u* = PDG(2)
 [user variable] q = PDG(2, 1, -2, -1)
 [user variable] i = 1
 one = 1
 [user variable] i = 2
 two
 [user variable] i = 3
 three
 [user variable] i = 4
 four
 [user variable] i = -1
 [user variable] $str = "i<=0"
 [user variable] i = 1
 [user variable] $str = "i>0"
 [user variable] i = 2
 [user variable] $str = "i>1"
 Testing the complex calculus
 [user variable] ca = ( 2.000000000000E+00, 1.000000000000E+00)
 [user variable] ca = ( 2.000000000000E+00, 1.000000000000E+00)
 [user variable] ia = 2
 [user variable] ia = 2
 [user variable] ra =  2.000000000000E+00
 [user variable] ra =  2.000000000000E+00
 [user variable] cb = ( 3.000000000000E+00, 4.000000000000E+00)
 [user variable] cb = ( 3.000000000000E+00, 4.000000000000E+00)
 ?pacify = true
 [user variable] cc = ( 1.00000E+00, 0.00000E+00)
 ?pacify = true
 [user variable] cc = ( 1.00000E+00, 0.00000E+00)
 | There were  1 error(s) and no warnings.
 | WHIZARD run finished.
 |=============================================================================|
Index: trunk/share/tests/functional_tests/lcio_11.sin
===================================================================
--- trunk/share/tests/functional_tests/lcio_11.sin	(revision 0)
+++ trunk/share/tests/functional_tests/lcio_11.sin	(revision 8385)
@@ -0,0 +1,28 @@
+# SINDARIN input for WHIZARD self-test
+
+?logging = true
+?openmp_logging = false
+?vis_history = false
+?integration_timer = false
+?write_raw = false
+
+seed = 0
+
+process lcio_11_p = e1, E1 => e2, E2 { process_num_id = 25 }
+
+sqrts = 1000
+
+iterations = 1:100
+integrate (lcio_11_p)
+
+lcio_run_id = 27
+
+?proc_as_run_id = false
+
+event_index_offset = 345
+
+n_events = 2
+sample_format = lcio
+!!! Tests should be run single-threaded 
+openmp_num_threads = 1
+simulate (lcio_11_p)
Index: trunk/share/tests/functional_tests/ref-output-ext/lcio_2.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output-ext/lcio_2.ref	(revision 8384)
+++ trunk/share/tests/functional_tests/ref-output-ext/lcio_2.ref	(revision 8385)
@@ -1,119 +1,119 @@
 ?openmp_logging = false
 ?vis_history = false
 ?integration_timer = false
 ?write_raw = false
 seed = 0
 | Process library 'lcio_2_lib': recorded process 'lcio_2_p'
 sqrts =  1.000000000000E+03
 | Integrate: current process library needs compilation
 | Process library 'lcio_2_lib': compiling ...
 | Process library 'lcio_2_lib': writing makefile
 | Process library 'lcio_2_lib': removing old files
 | Process library 'lcio_2_lib': writing driver
 | Process library 'lcio_2_lib': creating source code
 | Process library 'lcio_2_lib': compiling sources
 | Process library 'lcio_2_lib': linking
 | Process library 'lcio_2_lib': loading
 | Process library 'lcio_2_lib': ... success.
 | Integrate: compilation done
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 0
 | Initializing integration for process lcio_2_p:
 | Beam structure: e-, e+ => isr
 | Beam data (collision):
 |   e-  (mass = 5.1100000E-04 GeV)
 |   e+  (mass = 5.1100000E-04 GeV)
 |   sqrts = 1.000000000000E+03 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'lcio_2_p.i1.phs'
 | ------------------------------------------------------------------------
 | Process [scattering]: 'lcio_2_p'
 |   Library name  = 'lcio_2_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'lcio_2_p_i1':   e-, e+ => m-, m+ [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 'lcio_2_p'
 | 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  9.9402995E+01  4.65E+00    4.67    0.47*  24.86
 |-----------------------------------------------------------------------------|
    1        100  9.9402995E+01  4.65E+00    4.67    0.47   24.86
 |=============================================================================|
 n_events = 1
 openmp_num_threads = 1
 | Starting simulation for process 'lcio_2_p'
 | Simulate: using integration grids from file 'lcio_2_p.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] =   1.0060E-02
 | Events: writing to LCIO file 'lcio_2_p.slcio'
 | Events: generating 1 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: actual unweighting efficiency = 100.00 %
 | Events: closing LCIO file 'lcio_2_p.slcio'
 | There were no errors and    1 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
 Output from running lcio_2_rd:
 
 ============================================================================
-        Event  : 1 - run:  0 -  timestamp [...]
+        Event  : 1 - run:  1 -  timestamp [...]
 ============================================================================
  date: [...]
  detector : unknown
  event parameters: 
  parameter Event Number [int]: 1, 
  parameter ProcessID [int]: 1, 
- parameter Run ID [int]: 0, 
+ parameter Run ID [int]: 1, 
  parameter beamPDG1 [int]: 11, 
  parameter beamPDG2 [int]: -11, 
  parameter Energy [float]: 1000, 
  parameter _weight [float]: 1, 
  parameter alphaQCD [float]: 0.1178, 
  parameter beamPol1 [float]: 0, 
  parameter beamPol2 [float]: 0, 
  parameter crossSection [float]: 99.403, 
  parameter crossSectionError [float]: 4.64628, 
  parameter scale [float]: 998.962, 
  parameter sqme [float]: 1.34846e+06, 
  parameter BeamSpectrum [string]: , 
  parameter processName [string]: lcio_2_p, 
 
  collection name : MCParticle
  parameters: 
 
 --------------- print out of MCParticle collection --------------- 
 
   flag:  0x0
   simulator status bits: [sbvtcls]  s: created in simulation b: backscatter v: vertex is not endpoint of parent t: decayed in tracker c: decayed in calorimeter l: has left detector s: stopped o: overlay
 
 
 [   id   ]index|      PDG |    px,     py,        pz    | energy  |gen|[simstat ]| vertex x,     y   ,   z     |    mass |  charge |            spin             | colorflow | [parents] - [daughters]
 
 [00000004]    0|        11| 0.00e+00, 0.00e+00, 5.00e+02| 5.00e+02| 4 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,4] 
 [00000005]    1|       -11| 0.00e+00, 0.00e+00,-5.00e+02| 5.00e+02| 4 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [3,5] 
 [00000006]    2|        11| 0.00e+00, 0.00e+00, 4.99e+02| 4.99e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0] - [6,7] 
 [00000007]    3|       -11| 0.00e+00, 0.00e+00,-5.00e+02| 5.00e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 5.11e-04| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [1] - [6,7] 
 [00000008]    4|        22| 0.00e+00, 0.00e+00, 1.04e+00| 1.04e+00| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0] - [] 
 [00000009]    5|        22| 0.00e+00, 0.00e+00,-2.44e-06| 2.44e-06| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [1] - [] 
 [00000010]    6|        13| 2.77e+01,-2.11e+02,-4.52e+02| 5.00e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01|-1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [2,3] - [] 
 [00000011]    7|       -13|-2.77e+01, 2.11e+02, 4.51e+02| 4.99e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 1.06e-01| 1.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [2,3] - [] 
 
 -------------------------------------------------------------------------------- 
Index: trunk/share/tests/unit_tests/ref-output/rt_data_1.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/rt_data_1.ref	(revision 8384)
+++ trunk/share/tests/unit_tests/ref-output/rt_data_1.ref	(revision 8385)
@@ -1,424 +1,426 @@
 * Test output: rt_data_1
 *   Purpose: initialize global runtime data
 
 ========================================================================
  Runtime data:
 ========================================================================
 [undefined] sqrts = [unknown real]
 luminosity =  0.000000000000E+00
 ?sf_trace = false
 $sf_trace_file = ""
 ?sf_allow_s_mapping = true
 $lhapdf_dir = ""
 $lhapdf_file = ""
 $lhapdf_photon_file = ""
 lhapdf_member = 0
 lhapdf_photon_scheme = 0
 $pdf_builtin_set = "CTEQ6L"
 ?hoppet_b_matching = false
 isr_alpha =  0.000000000000E+00
 isr_q_max =  0.000000000000E+00
 isr_mass =  0.000000000000E+00
 isr_order = 3
 ?isr_recoil = false
 ?isr_keep_energy = false
 ?isr_handler = false
 $isr_handler_mode = "trivial"
 epa_alpha =  0.000000000000E+00
 epa_x_min =  0.000000000000E+00
 epa_q_min =  0.000000000000E+00
 epa_q_max =  0.000000000000E+00
 epa_mass =  0.000000000000E+00
 ?epa_recoil = false
 ?epa_keep_energy = false
 ?epa_handler = false
 $epa_handler_mode = "trivial"
 ewa_x_min =  0.000000000000E+00
 ewa_pt_max =  0.000000000000E+00
 ewa_mass =  0.000000000000E+00
 ?ewa_recoil = false
 ?ewa_keep_energy = false
 ?circe1_photon1 = false
 ?circe1_photon2 = false
 [undefined] circe1_sqrts = [unknown real]
 ?circe1_generate = true
 ?circe1_map = true
 circe1_mapping_slope =  2.000000000000E+00
 circe1_eps =  1.000000000000E-05
 circe1_ver = 0
 circe1_rev = 0
 $circe1_acc = "SBAND"
 circe1_chat = 0
 ?circe1_with_radiation = false
 ?circe2_polarized = true
 [undefined] $circe2_file = [unknown string]
 $circe2_design = "*"
 gaussian_spread1 =  0.000000000000E+00
 gaussian_spread2 =  0.000000000000E+00
 [undefined] $beam_events_file = [unknown string]
 ?beam_events_warn_eof = true
 ?energy_scan_normalize = false
 ?logging => false
 [undefined] $job_id = [unknown string]
 [undefined] $compile_workspace = [unknown string]
 seed = 0
 [undefined] $model_name = [unknown string]
 [undefined] process_num_id = [unknown integer]
+?proc_as_run_id = true
+lcio_run_id = 0
 $method = "omega"
 ?report_progress = true
 [user variable] ?me_verbose = false
 $restrictions = ""
 ?omega_write_phs_output = false
 $omega_flags = ""
 ?read_color_factors = true
 ?slha_read_input = true
 ?slha_read_spectrum = true
 ?slha_read_decays = false
 [undefined] $library_name = [unknown string]
 ?alphas_is_fixed = true
 ?alphas_from_lhapdf = false
 ?alphas_from_pdf_builtin = false
 alphas_order = 0
 alphas_nf = 5
 ?alphas_from_mz = false
 ?alphas_from_lambda_qcd = false
 lambda_qcd =  2.000000000000E-01
 ?fatal_beam_decay = true
 ?helicity_selection_active = true
 helicity_selection_threshold =  1.000000000000E+10
 helicity_selection_cutoff = 1000
 $rng_method = "tao"
 ?vis_diags = false
 ?vis_diags_color = false
 ?check_event_file = true
 $event_file_version = ""
 n_events = 0
 event_index_offset = 0
 ?unweighted = true
 safety_factor =  1.000000000000E+00
 ?negative_weights = false
 ?resonance_history = false
 resonance_on_shell_limit =  4.000000000000E+00
 resonance_on_shell_turnoff =  0.000000000000E+00
 resonance_background_factor =  1.000000000000E+00
 ?keep_beams = false
 ?keep_remnants = true
 ?recover_beams = true
 ?update_event = false
 ?update_sqme = false
 ?update_weight = false
 ?use_alphas_from_file = false
 ?use_scale_from_file = false
 ?allow_decays = true
 ?auto_decays = false
 auto_decays_multiplicity = 2
 ?auto_decays_radiative = false
 ?decay_rest_frame = false
 ?isotropic_decay = false
 ?diagonal_decay = false
 [undefined] decay_helicity = [unknown integer]
 ?polarized_events = false
 $polarization_mode = "helicity"
 ?colorize_subevt = false
 tolerance =  0.000000000000E+00
 checkpoint = 0
 event_callback_interval = 0
 ?pacify = false
 $out_file = ""
 ?out_advance = true
 real_range* = 307
 real_precision* = 15
 real_epsilon* =  1.000000000000E-16
 real_tiny* =  1.000000000000-300
 $integration_method = "vamp"
 threshold_calls = 10
 min_calls_per_channel = 10
 min_calls_per_bin = 10
 min_bins = 3
 max_bins = 20
 ?stratified = true
 ?use_vamp_equivalences = true
 ?vamp_verbose = false
 ?vamp_history_global = true
 ?vamp_history_global_verbose = false
 ?vamp_history_channels = false
 ?vamp_history_channels_verbose = false
 $run_id = ""
 n_calls_test = 0
 ?integration_timer = true
 ?check_grid_file = true
 accuracy_goal =  0.000000000000E+00
 error_goal =  0.000000000000E+00
 relative_error_goal =  0.000000000000E+00
 integration_results_verbosity = 1
 error_threshold =  0.000000000000E+00
 channel_weights_power =  2.500000000000E-01
 [undefined] $integrate_workspace = [unknown string]
 $vamp_grid_format = "ascii"
 $phs_method = "default"
 ?vis_channels = false
 ?check_phs_file = true
 $phs_file = ""
 ?phs_only = false
 phs_threshold_s =  5.000000000000E+01
 phs_threshold_t =  1.000000000000E+02
 phs_off_shell = 2
 phs_t_channel = 6
 phs_e_scale =  1.000000000000E+01
 phs_m_scale =  1.000000000000E+01
 phs_q_scale =  1.000000000000E+01
 ?phs_keep_nonresonant = true
 ?phs_step_mapping = true
 ?phs_step_mapping_exp = true
 ?phs_s_mapping = true
 ?vis_history = false
 n_bins = 20
 ?normalize_bins = false
 $obs_label = ""
 $obs_unit = ""
 $title = ""
 $description = ""
 $x_label = ""
 $y_label = ""
 graph_width_mm = 130
 graph_height_mm = 90
 ?y_log = false
 ?x_log = false
 [undefined] x_min = [unknown real]
 [undefined] x_max = [unknown real]
 [undefined] y_min = [unknown real]
 [undefined] y_max = [unknown real]
 $gmlcode_bg = ""
 $gmlcode_fg = ""
 [undefined] ?draw_histogram = [unknown logical]
 [undefined] ?draw_base = [unknown logical]
 [undefined] ?draw_piecewise = [unknown logical]
 [undefined] ?fill_curve = [unknown logical]
 [undefined] ?draw_curve = [unknown logical]
 [undefined] ?draw_errors = [unknown logical]
 [undefined] ?draw_symbols = [unknown logical]
 [undefined] $fill_options = [unknown string]
 [undefined] $draw_options = [unknown string]
 [undefined] $err_options = [unknown string]
 [undefined] $symbol = [unknown string]
 ?analysis_file_only = false
 kt_algorithm* = 0
 cambridge_algorithm* = 1
 antikt_algorithm* = 2
 genkt_algorithm* = 3
 cambridge_for_passive_algorithm* = 11
 genkt_for_passive_algorithm* = 13
 ee_kt_algorithm* = 50
 ee_genkt_algorithm* = 53
 plugin_algorithm* = 99
 undefined_jet_algorithm* = 999
 jet_algorithm = 999
 jet_r =  0.000000000000E+00
 jet_p =  0.000000000000E+00
 jet_ycut =  0.000000000000E+00
 ?keep_flavors_when_clustering = false
 photon_iso_eps =  1.000000000000E+00
 photon_iso_n =  1.000000000000E+00
 photon_iso_r0 =  4.000000000000E-01
 $sample = ""
 $sample_normalization = "auto"
 ?sample_pacify = false
 ?sample_select = true
 sample_max_tries = 10000
 sample_split_n_evt = 0
 sample_split_n_kbytes = 0
 sample_split_index = 0
 $rescan_input_format = "raw"
 ?read_raw = true
 ?write_raw = true
 $extension_raw = "evx"
 $extension_default = "evt"
 $debug_extension = "debug"
 ?debug_process = true
 ?debug_transforms = true
 ?debug_decay = true
 ?debug_verbose = true
 $dump_extension = "pset.dat"
 ?dump_compressed = false
 ?dump_weights = false
 ?dump_summary = false
 ?dump_screen = false
 ?hepevt_ensure_order = false
 $extension_hepevt = "hepevt"
 $extension_ascii_short = "short.evt"
 $extension_ascii_long = "long.evt"
 $extension_athena = "athena.evt"
 $extension_mokka = "mokka.evt"
 $lhef_version = "2.0"
 $lhef_extension = "lhe"
 ?lhef_write_sqme_prc = true
 ?lhef_write_sqme_ref = false
 ?lhef_write_sqme_alt = true
 $extension_lha = "lha"
 $extension_hepmc = "hepmc"
 ?hepmc_output_cross_section = false
 ?hepmc3_hepmc2mode = false
 $extension_lcio = "slcio"
 $extension_stdhep = "hep"
 $extension_stdhep_up = "up.hep"
 $extension_stdhep_ev4 = "ev4.hep"
 $extension_hepevt_verb = "hepevt.verb"
 $extension_lha_verb = "lha.verb"
 ?allow_shower = true
 ?ps_fsr_active = false
 ?ps_isr_active = false
 ?ps_taudec_active = false
 ?muli_active = false
 $shower_method = "WHIZARD"
 ?shower_verbose = false
 $ps_PYTHIA_PYGIVE = ""
 $ps_PYTHIA8_config = ""
 $ps_PYTHIA8_config_file = ""
 ps_mass_cutoff =  1.000000000000E+00
 ps_fsr_lambda =  2.900000000000E-01
 ps_isr_lambda =  2.900000000000E-01
 ps_max_n_flavors = 5
 ?ps_isr_alphas_running = true
 ?ps_fsr_alphas_running = true
 ps_fixed_alphas =  0.000000000000E+00
 ?ps_isr_pt_ordered = false
 ?ps_isr_angular_ordered = true
 ps_isr_primordial_kt_width =  0.000000000000E+00
 ps_isr_primordial_kt_cutoff =  5.000000000000E+00
 ps_isr_z_cutoff =  9.990000000000E-01
 ps_isr_minenergy =  1.000000000000E+00
 ps_isr_tscalefactor =  1.000000000000E+00
 ?ps_isr_only_onshell_emitted_partons = false
 ?allow_hadronization = true
 ?hadronization_active = false
 $hadronization_method = "PYTHIA6"
 hadron_enhanced_fraction =  1.000000000000E-02
 hadron_enhanced_width =  2.000000000000E+00
 ?ps_tauola_photos = false
 ?ps_tauola_transverse = false
 ?ps_tauola_dec_rad_cor = true
 ps_tauola_dec_mode1 = 0
 ps_tauola_dec_mode2 = 0
 ps_tauola_mh =  1.250000000000E+02
 ps_tauola_mix_angle =  9.000000000000E+01
 ?ps_tauola_pol_vector = false
 ?mlm_matching = false
 mlm_Qcut_ME =  0.000000000000E+00
 mlm_Qcut_PS =  0.000000000000E+00
 mlm_ptmin =  0.000000000000E+00
 mlm_etamax =  0.000000000000E+00
 mlm_Rmin =  0.000000000000E+00
 mlm_Emin =  0.000000000000E+00
 mlm_nmaxMEjets = 0
 mlm_ETclusfactor =  2.000000000000E-01
 mlm_ETclusminE =  5.000000000000E+00
 mlm_etaclusfactor =  1.000000000000E+00
 mlm_Rclusfactor =  1.000000000000E+00
 mlm_Eclusfactor =  1.000000000000E+00
 ?powheg_matching = false
 ?powheg_use_singular_jacobian = false
 powheg_grid_size_xi = 5
 powheg_grid_size_y = 5
 powheg_grid_sampling_points = 500000
 powheg_pt_min =  1.000000000000E+00
 powheg_lambda =  2.000000000000E-01
 ?powheg_rebuild_grids = false
 ?powheg_test_sudakov = false
 ?powheg_disable_sudakov = false
 ?ckkw_matching = false
 ?omega_openmp = false
 ?openmp_is_active* = false
 openmp_num_threads_default* = 1
 openmp_num_threads = 1
 ?openmp_logging = true
 ?mpi_logging = false
 $born_me_method = ""
 $loop_me_method = ""
 $correlation_me_method = ""
 $real_tree_me_method = ""
 $dglap_me_method = ""
 ?test_soft_limit = false
 ?test_coll_limit = false
 ?test_anti_coll_limit = false
 $select_alpha_regions = ""
 $virtual_selection = "Full"
 ?virtual_collinear_resonance_aware = true
 blha_top_yukawa = -1.000000000000E+00
 $blha_ew_scheme = "alpha_internal"
 openloops_verbosity = 1
 ?openloops_use_cms = true
 openloops_phs_tolerance = 7
 openloops_stability_log = 0
 ?openloops_switch_off_muon_yukawa = false
 $openloops_extra_cmd = ""
 ellis_sexton_scale = -1.000000000000E+00
 ?disable_subtraction = false
 fks_dij_exp1 =  1.000000000000E+00
 fks_dij_exp2 =  1.000000000000E+00
 fks_xi_min =  1.000000000000E-07
 fks_y_max =  1.000000000000E+00
 ?vis_fks_regions = false
 fks_xi_cut =  1.000000000000E+00
 fks_delta_o =  2.000000000000E+00
 fks_delta_i =  2.000000000000E+00
 $fks_mapping_type = "default"
 $resonances_exclude_particles = "default"
 alpha_power = 2
 alphas_power = 0
 ?combined_nlo_integration = false
 ?fixed_order_nlo_events = false
 ?check_event_weights_against_xsection = false
 ?keep_failed_events = false
 gks_multiplicity = 0
 $gosam_filter_lo = ""
 $gosam_filter_nlo = ""
 $gosam_symmetries = "family,generation"
 form_threads = 2
 form_workspace = 1000
 $gosam_fc = ""
 mult_call_real =  1.000000000000E+00
 mult_call_virt =  1.000000000000E+00
 mult_call_dglap =  1.000000000000E+00
 $dalitz_plot = ""
 $nlo_correction_type = "QCD"
 $exclude_gauge_splittings = "c:b:t:e2:e3"
 ?nlo_use_born_scale = false
 ?nlo_cut_all_sqmes = false
 ?nlo_use_real_partition = false
 real_partition_scale =  1.000000000000E+01
 $fc => "Fortran-compiler"
 $fcflags => "Fortran-flags"
 ========================================================================
  iterations = 2:5000:"gw", 3:20000
 ========================================================================
  Process library stack: [empty]
 ========================================================================
  Beam structure: [any particles]
 ========================================================================
  Cuts: [undefined]
 ------------------------------------------------------------------------
  Scale: [undefined]
 ------------------------------------------------------------------------
  Factorization scale: [undefined]
 ------------------------------------------------------------------------
  Renormalization scale: [undefined]
 ------------------------------------------------------------------------
  Weight: [undefined]
 ========================================================================
  Event selection: [undefined]
 ------------------------------------------------------------------------
  Event reweighting factor: [undefined]
 ------------------------------------------------------------------------
  Event analysis: [undefined]
 ------------------------------------------------------------------------
  Event callback: [undefined]
 ========================================================================
  Process stack: [empty]
 ========================================================================
  quit     : F
  quit_code: 0
 ========================================================================
  Logfile  : 'rt_data.log'
 ========================================================================
 
 * Test output end: rt_data_1
Index: trunk/share/tests/unit_tests/ref-output/rt_data_2.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/rt_data_2.ref	(revision 8384)
+++ trunk/share/tests/unit_tests/ref-output/rt_data_2.ref	(revision 8385)
@@ -1,488 +1,490 @@
 * Test output: rt_data_2
 *   Purpose: initialize global runtime data and fill contents
 
 ========================================================================
  Runtime data:
 ========================================================================
 gy =>  1.000000000000E+00
 ms =>  1.250000000000E+02
 ff =>  1.500000000000E+00
 mf* =>  1.875000000000E+02
 particle* = PDG(0)
 SCALAR* = PDG(25)
 s* = PDG(25)
 FERMION* = PDG(6)
 f* = PDG(6)
 fbar* = PDG(-6)
 F* = PDG(-6)
 charged* = PDG(6, -6)
 neutral* = PDG(25)
 colored* = PDG(6, -6)
 sqrts =  1.000000000000E+03
 luminosity =  3.300000000000E+01
 ?sf_trace = false
 $sf_trace_file = ""
 ?sf_allow_s_mapping = true
 $lhapdf_dir = ""
 $lhapdf_file = ""
 $lhapdf_photon_file = ""
 lhapdf_member = 0
 lhapdf_photon_scheme = 0
 $pdf_builtin_set = "CTEQ6L"
 ?hoppet_b_matching = false
 isr_alpha =  0.000000000000E+00
 isr_q_max =  0.000000000000E+00
 isr_mass =  0.000000000000E+00
 isr_order = 3
 ?isr_recoil = false
 ?isr_keep_energy = false
 ?isr_handler = false
 $isr_handler_mode = "trivial"
 epa_alpha =  0.000000000000E+00
 epa_x_min =  0.000000000000E+00
 epa_q_min =  0.000000000000E+00
 epa_q_max =  0.000000000000E+00
 epa_mass =  0.000000000000E+00
 ?epa_recoil = false
 ?epa_keep_energy = false
 ?epa_handler = false
 $epa_handler_mode = "trivial"
 ewa_x_min =  0.000000000000E+00
 ewa_pt_max =  0.000000000000E+00
 ewa_mass =  0.000000000000E+00
 ?ewa_recoil = false
 ?ewa_keep_energy = false
 ?circe1_photon1 = false
 ?circe1_photon2 = false
 [undefined] circe1_sqrts = [unknown real]
 ?circe1_generate = true
 ?circe1_map = true
 circe1_mapping_slope =  2.000000000000E+00
 circe1_eps =  1.000000000000E-05
 circe1_ver = 0
 circe1_rev = 0
 $circe1_acc = "SBAND"
 circe1_chat = 0
 ?circe1_with_radiation = false
 ?circe2_polarized = true
 [undefined] $circe2_file = [unknown string]
 $circe2_design = "*"
 gaussian_spread1 =  0.000000000000E+00
 gaussian_spread2 =  0.000000000000E+00
 [undefined] $beam_events_file = [unknown string]
 ?beam_events_warn_eof = true
 ?energy_scan_normalize = false
 ?logging => false
 [undefined] $job_id = [unknown string]
 [undefined] $compile_workspace = [unknown string]
 seed = 0
 $model_name = "Test"
 [undefined] process_num_id = [unknown integer]
+?proc_as_run_id = true
+lcio_run_id = 0
 $method = "omega"
 ?report_progress = true
 [user variable] ?me_verbose = false
 $restrictions = ""
 ?omega_write_phs_output = false
 $omega_flags = ""
 ?read_color_factors = true
 ?slha_read_input = true
 ?slha_read_spectrum = true
 ?slha_read_decays = false
 [undefined] $library_name = [unknown string]
 ?alphas_is_fixed = true
 ?alphas_from_lhapdf = false
 ?alphas_from_pdf_builtin = false
 alphas_order = 0
 alphas_nf = 5
 ?alphas_from_mz = false
 ?alphas_from_lambda_qcd = false
 lambda_qcd =  2.000000000000E-01
 ?fatal_beam_decay = true
 ?helicity_selection_active = true
 helicity_selection_threshold =  1.000000000000E+10
 helicity_selection_cutoff = 1000
 $rng_method = "tao"
 ?vis_diags = false
 ?vis_diags_color = false
 ?check_event_file = true
 $event_file_version = ""
 n_events = 0
 event_index_offset = 0
 ?unweighted = true
 safety_factor =  1.000000000000E+00
 ?negative_weights = false
 ?resonance_history = false
 resonance_on_shell_limit =  4.000000000000E+00
 resonance_on_shell_turnoff =  0.000000000000E+00
 resonance_background_factor =  1.000000000000E+00
 ?keep_beams = false
 ?keep_remnants = true
 ?recover_beams = true
 ?update_event = false
 ?update_sqme = false
 ?update_weight = false
 ?use_alphas_from_file = false
 ?use_scale_from_file = false
 ?allow_decays = true
 ?auto_decays = false
 auto_decays_multiplicity = 2
 ?auto_decays_radiative = false
 ?decay_rest_frame = false
 ?isotropic_decay = false
 ?diagonal_decay = false
 [undefined] decay_helicity = [unknown integer]
 ?polarized_events = false
 $polarization_mode = "helicity"
 ?colorize_subevt = false
 tolerance =  0.000000000000E+00
 checkpoint = 0
 event_callback_interval = 0
 ?pacify = false
 $out_file = ""
 ?out_advance = true
 real_range* = 307
 real_precision* = 15
 real_epsilon* =  1.000000000000E-16
 real_tiny* =  1.000000000000-300
 $integration_method = "vamp"
 threshold_calls = 10
 min_calls_per_channel = 10
 min_calls_per_bin = 10
 min_bins = 3
 max_bins = 20
 ?stratified = true
 ?use_vamp_equivalences = true
 ?vamp_verbose = false
 ?vamp_history_global = true
 ?vamp_history_global_verbose = false
 ?vamp_history_channels = false
 ?vamp_history_channels_verbose = false
 $run_id = "run1"
 n_calls_test = 0
 ?integration_timer = true
 ?check_grid_file = true
 accuracy_goal =  0.000000000000E+00
 error_goal =  0.000000000000E+00
 relative_error_goal =  0.000000000000E+00
 integration_results_verbosity = 1
 error_threshold =  0.000000000000E+00
 channel_weights_power =  2.500000000000E-01
 [undefined] $integrate_workspace = [unknown string]
 $vamp_grid_format = "ascii"
 $phs_method = "default"
 ?vis_channels = false
 ?check_phs_file = true
 $phs_file = ""
 ?phs_only = false
 phs_threshold_s =  5.000000000000E+01
 phs_threshold_t =  1.000000000000E+02
 phs_off_shell = 2
 phs_t_channel = 6
 phs_e_scale =  1.000000000000E+01
 phs_m_scale =  1.000000000000E+01
 phs_q_scale =  1.000000000000E+01
 ?phs_keep_nonresonant = true
 ?phs_step_mapping = true
 ?phs_step_mapping_exp = true
 ?phs_s_mapping = true
 ?vis_history = false
 n_bins = 20
 ?normalize_bins = false
 $obs_label = ""
 $obs_unit = ""
 $title = ""
 $description = ""
 $x_label = ""
 $y_label = ""
 graph_width_mm = 130
 graph_height_mm = 90
 ?y_log = false
 ?x_log = false
 [undefined] x_min = [unknown real]
 [undefined] x_max = [unknown real]
 [undefined] y_min = [unknown real]
 [undefined] y_max = [unknown real]
 $gmlcode_bg = ""
 $gmlcode_fg = ""
 [undefined] ?draw_histogram = [unknown logical]
 [undefined] ?draw_base = [unknown logical]
 [undefined] ?draw_piecewise = [unknown logical]
 [undefined] ?fill_curve = [unknown logical]
 [undefined] ?draw_curve = [unknown logical]
 [undefined] ?draw_errors = [unknown logical]
 [undefined] ?draw_symbols = [unknown logical]
 [undefined] $fill_options = [unknown string]
 [undefined] $draw_options = [unknown string]
 [undefined] $err_options = [unknown string]
 [undefined] $symbol = [unknown string]
 ?analysis_file_only = false
 kt_algorithm* = 0
 cambridge_algorithm* = 1
 antikt_algorithm* = 2
 genkt_algorithm* = 3
 cambridge_for_passive_algorithm* = 11
 genkt_for_passive_algorithm* = 13
 ee_kt_algorithm* = 50
 ee_genkt_algorithm* = 53
 plugin_algorithm* = 99
 undefined_jet_algorithm* = 999
 jet_algorithm = 999
 jet_r =  0.000000000000E+00
 jet_p =  0.000000000000E+00
 jet_ycut =  0.000000000000E+00
 ?keep_flavors_when_clustering = false
 photon_iso_eps =  1.000000000000E+00
 photon_iso_n =  1.000000000000E+00
 photon_iso_r0 =  4.000000000000E-01
 $sample = ""
 $sample_normalization = "auto"
 ?sample_pacify = false
 ?sample_select = true
 sample_max_tries = 10000
 sample_split_n_evt = 0
 sample_split_n_kbytes = 0
 sample_split_index = 0
 $rescan_input_format = "raw"
 ?read_raw = true
 ?write_raw = true
 $extension_raw = "evx"
 $extension_default = "evt"
 $debug_extension = "debug"
 ?debug_process = true
 ?debug_transforms = true
 ?debug_decay = true
 ?debug_verbose = true
 $dump_extension = "pset.dat"
 ?dump_compressed = false
 ?dump_weights = false
 ?dump_summary = false
 ?dump_screen = false
 ?hepevt_ensure_order = false
 $extension_hepevt = "hepevt"
 $extension_ascii_short = "short.evt"
 $extension_ascii_long = "long.evt"
 $extension_athena = "athena.evt"
 $extension_mokka = "mokka.evt"
 $lhef_version = "2.0"
 $lhef_extension = "lhe"
 ?lhef_write_sqme_prc = true
 ?lhef_write_sqme_ref = false
 ?lhef_write_sqme_alt = true
 $extension_lha = "lha"
 $extension_hepmc = "hepmc"
 ?hepmc_output_cross_section = false
 ?hepmc3_hepmc2mode = false
 $extension_lcio = "slcio"
 $extension_stdhep = "hep"
 $extension_stdhep_up = "up.hep"
 $extension_stdhep_ev4 = "ev4.hep"
 $extension_hepevt_verb = "hepevt.verb"
 $extension_lha_verb = "lha.verb"
 ?allow_shower = true
 ?ps_fsr_active = false
 ?ps_isr_active = false
 ?ps_taudec_active = false
 ?muli_active = false
 $shower_method = "WHIZARD"
 ?shower_verbose = false
 $ps_PYTHIA_PYGIVE = ""
 $ps_PYTHIA8_config = ""
 $ps_PYTHIA8_config_file = ""
 ps_mass_cutoff =  1.000000000000E+00
 ps_fsr_lambda =  2.900000000000E-01
 ps_isr_lambda =  2.900000000000E-01
 ps_max_n_flavors = 5
 ?ps_isr_alphas_running = true
 ?ps_fsr_alphas_running = true
 ps_fixed_alphas =  0.000000000000E+00
 ?ps_isr_pt_ordered = false
 ?ps_isr_angular_ordered = true
 ps_isr_primordial_kt_width =  0.000000000000E+00
 ps_isr_primordial_kt_cutoff =  5.000000000000E+00
 ps_isr_z_cutoff =  9.990000000000E-01
 ps_isr_minenergy =  1.000000000000E+00
 ps_isr_tscalefactor =  1.000000000000E+00
 ?ps_isr_only_onshell_emitted_partons = false
 ?allow_hadronization = true
 ?hadronization_active = false
 $hadronization_method = "PYTHIA6"
 hadron_enhanced_fraction =  1.000000000000E-02
 hadron_enhanced_width =  2.000000000000E+00
 ?ps_tauola_photos = false
 ?ps_tauola_transverse = false
 ?ps_tauola_dec_rad_cor = true
 ps_tauola_dec_mode1 = 0
 ps_tauola_dec_mode2 = 0
 ps_tauola_mh =  1.250000000000E+02
 ps_tauola_mix_angle =  9.000000000000E+01
 ?ps_tauola_pol_vector = false
 ?mlm_matching = false
 mlm_Qcut_ME =  0.000000000000E+00
 mlm_Qcut_PS =  0.000000000000E+00
 mlm_ptmin =  0.000000000000E+00
 mlm_etamax =  0.000000000000E+00
 mlm_Rmin =  0.000000000000E+00
 mlm_Emin =  0.000000000000E+00
 mlm_nmaxMEjets = 0
 mlm_ETclusfactor =  2.000000000000E-01
 mlm_ETclusminE =  5.000000000000E+00
 mlm_etaclusfactor =  1.000000000000E+00
 mlm_Rclusfactor =  1.000000000000E+00
 mlm_Eclusfactor =  1.000000000000E+00
 ?powheg_matching = false
 ?powheg_use_singular_jacobian = false
 powheg_grid_size_xi = 5
 powheg_grid_size_y = 5
 powheg_grid_sampling_points = 500000
 powheg_pt_min =  1.000000000000E+00
 powheg_lambda =  2.000000000000E-01
 ?powheg_rebuild_grids = false
 ?powheg_test_sudakov = false
 ?powheg_disable_sudakov = false
 ?ckkw_matching = false
 ?omega_openmp = false
 ?openmp_is_active* = false
 openmp_num_threads_default* = 1
 openmp_num_threads = 1
 ?openmp_logging = true
 ?mpi_logging = false
 $born_me_method = ""
 $loop_me_method = ""
 $correlation_me_method = ""
 $real_tree_me_method = ""
 $dglap_me_method = ""
 ?test_soft_limit = false
 ?test_coll_limit = false
 ?test_anti_coll_limit = false
 $select_alpha_regions = ""
 $virtual_selection = "Full"
 ?virtual_collinear_resonance_aware = true
 blha_top_yukawa = -1.000000000000E+00
 $blha_ew_scheme = "alpha_internal"
 openloops_verbosity = 1
 ?openloops_use_cms = true
 openloops_phs_tolerance = 7
 openloops_stability_log = 0
 ?openloops_switch_off_muon_yukawa = false
 $openloops_extra_cmd = ""
 ellis_sexton_scale = -1.000000000000E+00
 ?disable_subtraction = false
 fks_dij_exp1 =  1.000000000000E+00
 fks_dij_exp2 =  1.000000000000E+00
 fks_xi_min =  1.000000000000E-07
 fks_y_max =  1.000000000000E+00
 ?vis_fks_regions = false
 fks_xi_cut =  1.000000000000E+00
 fks_delta_o =  2.000000000000E+00
 fks_delta_i =  2.000000000000E+00
 $fks_mapping_type = "default"
 $resonances_exclude_particles = "default"
 alpha_power = 2
 alphas_power = 0
 ?combined_nlo_integration = false
 ?fixed_order_nlo_events = false
 ?check_event_weights_against_xsection = false
 ?keep_failed_events = false
 gks_multiplicity = 0
 $gosam_filter_lo = ""
 $gosam_filter_nlo = ""
 $gosam_symmetries = "family,generation"
 form_threads = 2
 form_workspace = 1000
 $gosam_fc = ""
 mult_call_real =  1.000000000000E+00
 mult_call_virt =  1.000000000000E+00
 mult_call_dglap =  1.000000000000E+00
 $dalitz_plot = ""
 $nlo_correction_type = "QCD"
 $exclude_gauge_splittings = "c:b:t:e2:e3"
 ?nlo_use_born_scale = false
 ?nlo_cut_all_sqmes = false
 ?nlo_use_real_partition = false
 real_partition_scale =  1.000000000000E+01
 $fc => "Fortran-compiler"
 $fcflags => "Fortran-flags"
 ========================================================================
 model "Test"
  ! md5sum = 'DB28187ADA60804A3CFC14A025DED784'
 
    parameter gy =  1.000000000000E+00
    parameter ms =  1.250000000000E+02
    parameter ff =  1.500000000000E+00
    external mf =  1.875000000000E+02
 
    particle SCALAR 25
      name "s"
      spin 0
      mass ms
    particle FERMION 6
      name "f"
      anti "fbar" "F"
      tex_anti "\bar{f}"
      spin 1/2  isospin 1/2  charge 2/3  color 3
      mass mf
 
    vertex "fbar" "f" "s"
    vertex "s" "s" "s"
 ========================================================================
  Process library stack: [empty]
 ========================================================================
  Beam structure: [any particles]
 ========================================================================
  Cuts:
 ------------------------------------------------------------------------
 +  SEQUENCE    <lexpr>  =  <lsinglet>
 +  SEQUENCE    <lsinglet>  =  <lterm>
 |  +  SEQUENCE    <lterm>  =  <all_fun>
 |  |  +  SEQUENCE    <all_fun>  =  all <lexpr> <pargs1>
 |  |  |  +  KEYWORD     all  = [keyword] all
 |  |  |  +  SEQUENCE    <lexpr>  =  <lsinglet>
 |  |  |  |  +  SEQUENCE    <lsinglet>  =  <lterm>
 |  |  |  |  |  +  SEQUENCE    <lterm>  =  <compared_expr>
 |  |  |  |  |  |  +  SEQUENCE    <compared_expr>  =  <expr> <comparison>
 |  |  |  |  |  |  |  +  SEQUENCE    <expr>  =  <term>
 |  |  |  |  |  |  |  |  +  SEQUENCE    <term>  =  <factor>
 |  |  |  |  |  |  |  |  |  +  SEQUENCE    <factor>  =  <variable>
 |  |  |  |  |  |  |  |  |  |  +  IDENTIFIER  <variable>  = Pt
 |  |  |  |  |  |  |  +  SEQUENCE    <comparison>  =  '>' <expr>
 |  |  |  |  |  |  |  |  +  KEYWORD     '>'  = [keyword] >
 |  |  |  |  |  |  |  |  +  SEQUENCE    <expr>  =  <term>
 |  |  |  |  |  |  |  |  |  +  SEQUENCE    <term>  =  <factor>
 |  |  |  |  |  |  |  |  |  |  +  SEQUENCE    <factor>  =  <integer_value>
 |  |  |  |  |  |  |  |  |  |  |  +  SEQUENCE    <integer_value>  =  <integer_literal>
 |  |  |  |  |  |  |  |  |  |  |  |  +  INTEGER     <integer_literal>  = 100
 |  |  |  +  ARGUMENTS   <pargs1>  =  <pexpr>
 |  |  |  |  +  SEQUENCE    <pexpr>  =  <pterm>
 |  |  |  |  |  +  SEQUENCE    <pterm>  =  <pexpr_src>
 |  |  |  |  |  |  +  SEQUENCE    <pexpr_src>  =  <unspecified_prt>
 |  |  |  |  |  |  |  +  SEQUENCE    <unspecified_prt>  =  <cexpr>
 |  |  |  |  |  |  |  |  +  SEQUENCE    <cexpr>  =  <variable>
 |  |  |  |  |  |  |  |  |  +  IDENTIFIER  <variable>  = s
 ------------------------------------------------------------------------
  Scale: [undefined]
 ------------------------------------------------------------------------
  Factorization scale: [undefined]
 ------------------------------------------------------------------------
  Renormalization scale: [undefined]
 ------------------------------------------------------------------------
  Weight: [undefined]
 ========================================================================
  Event selection: [undefined]
 ------------------------------------------------------------------------
  Event reweighting factor: [undefined]
 ------------------------------------------------------------------------
  Event analysis: [undefined]
 ------------------------------------------------------------------------
  Event sample formats = foo_fmt, bar_fmt
 ------------------------------------------------------------------------
  Event callback: [undefined]
 ========================================================================
  Process stack: [empty]
 ========================================================================
  quit     : F
  quit_code: 0
 ========================================================================
  Logfile  : ''
 ========================================================================
 
 * Test output end: rt_data_2
Index: trunk/share/tests/unit_tests/ref-output/eio_lcio_1.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/eio_lcio_1.ref	(revision 8384)
+++ trunk/share/tests/unit_tests/ref-output/eio_lcio_1.ref	(revision 8385)
@@ -1,57 +1,61 @@
 * Test output: eio_lcio_1
 *   Purpose: write a LCIO file
 
 * Initialize test process
 
 * Generate and write an event
 
  LCIO event stream:
    Writing to file   = eio_lcio_1.slcio
    Recover beams     = F
    Alpha_s from file = F
    Scale from file   = F
+   Process as run ID = T
+   LCIO run ID       = 0
    File extension    = 'slcio'
    Numerical process IDs:
      1: 42
 
 * Reset data
 
  LCIO event stream:
    [closed]
    Recover beams     = F
    Alpha_s from file = F
    Scale from file   = F
+   Process as run ID = T
+   LCIO run ID       = 0
    File extension    = 'slcio'
 
 * Write LCIO file contents to ASCII file
 
 
 * Read in ASCII contents of LCIO file
 
 =========================================
  - Event  : 77
  - run:  0
  - weight 1
 =========================================
  detector : unknown
  event parameters:
  parameter Event Number [int]: 77,
  parameter ProcessID [int]: 42,
  parameter Run ID [int]: 0,
  parameter beamPDG1 [int]: 25,
  parameter beamPDG2 [int]: 25,
  collection name : MCParticle
  parameters:
 --------------- print out of MCParticle collection ---------------
   flag:  0x0
   simulator status bits: [sbvtcls]  s: created in simulation b: backscatter v: vertex is not endpoint of parent t: decayed in tracker c: decayed in calorimeter l: has left detector s: stopped o: overlay
 [   id   ]index|      PDG |    px,     py,        pz    | energy  |gen|[simstat ]| vertex x,     y   ,   z     | endpoint x,    y  ,   z     |    mass |  charge |            spin             | colorflow | [parents]
 [00000014]    0|        25| 0.00e+00, 0.00e+00, 4.84e+02| 5.00e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00| 1.25e+02| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3]
 [00000015]    1|        25| 0.00e+00, 0.00e+00,-4.84e+02| 5.00e+02| 3 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00| 1.25e+02| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [] - [2,3]
 [00000016]    2|        25|-4.44e+02, 0.00e+00, 1.94e+02| 5.00e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00| 1.25e+02| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0,1] - []
 [00000017]    3|        25| 4.44e+02, 0.00e+00,-1.94e+02| 5.00e+02| 1 |[    0   ]| 0.00e+00, 0.00e+00, 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00| 1.25e+02| 0.00e+00| 0.00e+00, 0.00e+00, 0.00e+00|  (0, 0)   | [0,1] - []
 --------------------------------------------------------------------------------
 
 * Cleanup
 
 * Test output end: eio_lcio_1
Index: trunk/share/tests/unit_tests/ref-output/rt_data_3.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/rt_data_3.ref	(revision 8384)
+++ trunk/share/tests/unit_tests/ref-output/rt_data_3.ref	(revision 8385)
@@ -1,1029 +1,1033 @@
 * Test output: rt_data_3
 *   Purpose: initialize global runtime data and fill contents;
 *            copy to local block and back
 
 * Init global data
 
 * Init and modify local data
 
  model associated   = T
  library associated = T
 
 ========================================================================
  Runtime data:
 ========================================================================
 gy =>  1.000000000000E+00
 ms =>  1.500000000000E+02
 ff =>  1.500000000000E+00
 mf* =>  2.250000000000E+02
 particle* = PDG(0)
 SCALAR* = PDG(25)
 s* = PDG(25)
 FERMION* = PDG(6)
 f* = PDG(6)
 fbar* = PDG(-6)
 F* = PDG(-6)
 charged* = PDG(6, -6)
 neutral* = PDG(25)
 colored* = PDG(6, -6)
 $model_name = "Test"
 $fc => "Local compiler"
 $fcflags => "Fortran-flags"
 $integration_method = "midpoint"
 $phs_method = "single"
 $library_name = "library_2"
 sqrts =  1.000000000000E+03
 luminosity =  3.300000000000E+01
 ?sf_trace = false
 $sf_trace_file = ""
 ?sf_allow_s_mapping = true
 $lhapdf_dir = ""
 $lhapdf_file = ""
 $lhapdf_photon_file = ""
 lhapdf_member = 0
 lhapdf_photon_scheme = 0
 $pdf_builtin_set = "CTEQ6L"
 ?hoppet_b_matching = false
 isr_alpha =  0.000000000000E+00
 isr_q_max =  0.000000000000E+00
 isr_mass =  0.000000000000E+00
 isr_order = 3
 ?isr_recoil = false
 ?isr_keep_energy = false
 ?isr_handler = false
 $isr_handler_mode = "trivial"
 epa_alpha =  0.000000000000E+00
 epa_x_min =  0.000000000000E+00
 epa_q_min =  0.000000000000E+00
 epa_q_max =  0.000000000000E+00
 epa_mass =  0.000000000000E+00
 ?epa_recoil = false
 ?epa_keep_energy = false
 ?epa_handler = false
 $epa_handler_mode = "trivial"
 ewa_x_min =  0.000000000000E+00
 ewa_pt_max =  0.000000000000E+00
 ewa_mass =  0.000000000000E+00
 ?ewa_recoil = false
 ?ewa_keep_energy = false
 ?circe1_photon1 = false
 ?circe1_photon2 = false
 [undefined] circe1_sqrts = [unknown real]
 ?circe1_generate = true
 ?circe1_map = true
 circe1_mapping_slope =  2.000000000000E+00
 circe1_eps =  1.000000000000E-05
 circe1_ver = 0
 circe1_rev = 0
 $circe1_acc = "SBAND"
 circe1_chat = 0
 ?circe1_with_radiation = false
 ?circe2_polarized = true
 [undefined] $circe2_file = [unknown string]
 $circe2_design = "*"
 gaussian_spread1 =  0.000000000000E+00
 gaussian_spread2 =  0.000000000000E+00
 [undefined] $beam_events_file = [unknown string]
 ?beam_events_warn_eof = true
 ?energy_scan_normalize = false
 ?logging => false
 [undefined] $job_id = [unknown string]
 [undefined] $compile_workspace = [unknown string]
 seed = 0
 $model_name = "Test"
 [undefined] process_num_id = [unknown integer]
+?proc_as_run_id = true
+lcio_run_id = 0
 $method = "omega"
 ?report_progress = true
 [user variable] ?me_verbose = false
 $restrictions = ""
 ?omega_write_phs_output = false
 $omega_flags = ""
 ?read_color_factors = true
 ?slha_read_input = true
 ?slha_read_spectrum = true
 ?slha_read_decays = false
 $library_name = "library_1"
 ?alphas_is_fixed = true
 ?alphas_from_lhapdf = false
 ?alphas_from_pdf_builtin = false
 alphas_order = 0
 alphas_nf = 5
 ?alphas_from_mz = false
 ?alphas_from_lambda_qcd = false
 lambda_qcd =  2.000000000000E-01
 ?fatal_beam_decay = true
 ?helicity_selection_active = true
 helicity_selection_threshold =  1.000000000000E+10
 helicity_selection_cutoff = 1000
 $rng_method = "tao"
 ?vis_diags = false
 ?vis_diags_color = false
 ?check_event_file = true
 $event_file_version = ""
 n_events = 0
 event_index_offset = 0
 ?unweighted = true
 safety_factor =  1.000000000000E+00
 ?negative_weights = false
 ?resonance_history = false
 resonance_on_shell_limit =  4.000000000000E+00
 resonance_on_shell_turnoff =  0.000000000000E+00
 resonance_background_factor =  1.000000000000E+00
 ?keep_beams = false
 ?keep_remnants = true
 ?recover_beams = true
 ?update_event = false
 ?update_sqme = false
 ?update_weight = false
 ?use_alphas_from_file = false
 ?use_scale_from_file = false
 ?allow_decays = true
 ?auto_decays = false
 auto_decays_multiplicity = 2
 ?auto_decays_radiative = false
 ?decay_rest_frame = false
 ?isotropic_decay = false
 ?diagonal_decay = false
 [undefined] decay_helicity = [unknown integer]
 ?polarized_events = false
 $polarization_mode = "helicity"
 ?colorize_subevt = false
 tolerance =  0.000000000000E+00
 checkpoint = 0
 event_callback_interval = 0
 ?pacify = false
 $out_file = ""
 ?out_advance = true
 real_range* = 307
 real_precision* = 15
 real_epsilon* =  1.000000000000E-16
 real_tiny* =  1.000000000000-300
 $integration_method = "vamp"
 threshold_calls = 10
 min_calls_per_channel = 10
 min_calls_per_bin = 10
 min_bins = 3
 max_bins = 20
 ?stratified = true
 ?use_vamp_equivalences = true
 ?vamp_verbose = false
 ?vamp_history_global = true
 ?vamp_history_global_verbose = false
 ?vamp_history_channels = false
 ?vamp_history_channels_verbose = false
 $run_id = "run1"
 n_calls_test = 0
 ?integration_timer = true
 ?check_grid_file = true
 accuracy_goal =  0.000000000000E+00
 error_goal =  0.000000000000E+00
 relative_error_goal =  0.000000000000E+00
 integration_results_verbosity = 1
 error_threshold =  0.000000000000E+00
 channel_weights_power =  2.500000000000E-01
 [undefined] $integrate_workspace = [unknown string]
 $vamp_grid_format = "ascii"
 $phs_method = "default"
 ?vis_channels = false
 ?check_phs_file = true
 $phs_file = ""
 ?phs_only = false
 phs_threshold_s =  5.000000000000E+01
 phs_threshold_t =  1.000000000000E+02
 phs_off_shell = 2
 phs_t_channel = 6
 phs_e_scale =  1.000000000000E+01
 phs_m_scale =  1.000000000000E+01
 phs_q_scale =  1.000000000000E+01
 ?phs_keep_nonresonant = true
 ?phs_step_mapping = true
 ?phs_step_mapping_exp = true
 ?phs_s_mapping = true
 ?vis_history = false
 n_bins = 20
 ?normalize_bins = false
 $obs_label = ""
 $obs_unit = ""
 $title = ""
 $description = ""
 $x_label = ""
 $y_label = ""
 graph_width_mm = 130
 graph_height_mm = 90
 ?y_log = false
 ?x_log = false
 [undefined] x_min = [unknown real]
 [undefined] x_max = [unknown real]
 [undefined] y_min = [unknown real]
 [undefined] y_max = [unknown real]
 $gmlcode_bg = ""
 $gmlcode_fg = ""
 [undefined] ?draw_histogram = [unknown logical]
 [undefined] ?draw_base = [unknown logical]
 [undefined] ?draw_piecewise = [unknown logical]
 [undefined] ?fill_curve = [unknown logical]
 [undefined] ?draw_curve = [unknown logical]
 [undefined] ?draw_errors = [unknown logical]
 [undefined] ?draw_symbols = [unknown logical]
 [undefined] $fill_options = [unknown string]
 [undefined] $draw_options = [unknown string]
 [undefined] $err_options = [unknown string]
 [undefined] $symbol = [unknown string]
 ?analysis_file_only = false
 kt_algorithm* = 0
 cambridge_algorithm* = 1
 antikt_algorithm* = 2
 genkt_algorithm* = 3
 cambridge_for_passive_algorithm* = 11
 genkt_for_passive_algorithm* = 13
 ee_kt_algorithm* = 50
 ee_genkt_algorithm* = 53
 plugin_algorithm* = 99
 undefined_jet_algorithm* = 999
 jet_algorithm = 999
 jet_r =  0.000000000000E+00
 jet_p =  0.000000000000E+00
 jet_ycut =  0.000000000000E+00
 ?keep_flavors_when_clustering = false
 photon_iso_eps =  1.000000000000E+00
 photon_iso_n =  1.000000000000E+00
 photon_iso_r0 =  4.000000000000E-01
 $sample = ""
 $sample_normalization = "auto"
 ?sample_pacify = false
 ?sample_select = true
 sample_max_tries = 10000
 sample_split_n_evt = 0
 sample_split_n_kbytes = 0
 sample_split_index = 0
 $rescan_input_format = "raw"
 ?read_raw = true
 ?write_raw = true
 $extension_raw = "evx"
 $extension_default = "evt"
 $debug_extension = "debug"
 ?debug_process = true
 ?debug_transforms = true
 ?debug_decay = true
 ?debug_verbose = true
 $dump_extension = "pset.dat"
 ?dump_compressed = false
 ?dump_weights = false
 ?dump_summary = false
 ?dump_screen = false
 ?hepevt_ensure_order = false
 $extension_hepevt = "hepevt"
 $extension_ascii_short = "short.evt"
 $extension_ascii_long = "long.evt"
 $extension_athena = "athena.evt"
 $extension_mokka = "mokka.evt"
 $lhef_version = "2.0"
 $lhef_extension = "lhe"
 ?lhef_write_sqme_prc = true
 ?lhef_write_sqme_ref = false
 ?lhef_write_sqme_alt = true
 $extension_lha = "lha"
 $extension_hepmc = "hepmc"
 ?hepmc_output_cross_section = false
 ?hepmc3_hepmc2mode = false
 $extension_lcio = "slcio"
 $extension_stdhep = "hep"
 $extension_stdhep_up = "up.hep"
 $extension_stdhep_ev4 = "ev4.hep"
 $extension_hepevt_verb = "hepevt.verb"
 $extension_lha_verb = "lha.verb"
 ?allow_shower = true
 ?ps_fsr_active = false
 ?ps_isr_active = false
 ?ps_taudec_active = false
 ?muli_active = false
 $shower_method = "WHIZARD"
 ?shower_verbose = false
 $ps_PYTHIA_PYGIVE = ""
 $ps_PYTHIA8_config = ""
 $ps_PYTHIA8_config_file = ""
 ps_mass_cutoff =  1.000000000000E+00
 ps_fsr_lambda =  2.900000000000E-01
 ps_isr_lambda =  2.900000000000E-01
 ps_max_n_flavors = 5
 ?ps_isr_alphas_running = true
 ?ps_fsr_alphas_running = true
 ps_fixed_alphas =  0.000000000000E+00
 ?ps_isr_pt_ordered = false
 ?ps_isr_angular_ordered = true
 ps_isr_primordial_kt_width =  0.000000000000E+00
 ps_isr_primordial_kt_cutoff =  5.000000000000E+00
 ps_isr_z_cutoff =  9.990000000000E-01
 ps_isr_minenergy =  1.000000000000E+00
 ps_isr_tscalefactor =  1.000000000000E+00
 ?ps_isr_only_onshell_emitted_partons = false
 ?allow_hadronization = true
 ?hadronization_active = false
 $hadronization_method = "PYTHIA6"
 hadron_enhanced_fraction =  1.000000000000E-02
 hadron_enhanced_width =  2.000000000000E+00
 ?ps_tauola_photos = false
 ?ps_tauola_transverse = false
 ?ps_tauola_dec_rad_cor = true
 ps_tauola_dec_mode1 = 0
 ps_tauola_dec_mode2 = 0
 ps_tauola_mh =  1.250000000000E+02
 ps_tauola_mix_angle =  9.000000000000E+01
 ?ps_tauola_pol_vector = false
 ?mlm_matching = false
 mlm_Qcut_ME =  0.000000000000E+00
 mlm_Qcut_PS =  0.000000000000E+00
 mlm_ptmin =  0.000000000000E+00
 mlm_etamax =  0.000000000000E+00
 mlm_Rmin =  0.000000000000E+00
 mlm_Emin =  0.000000000000E+00
 mlm_nmaxMEjets = 0
 mlm_ETclusfactor =  2.000000000000E-01
 mlm_ETclusminE =  5.000000000000E+00
 mlm_etaclusfactor =  1.000000000000E+00
 mlm_Rclusfactor =  1.000000000000E+00
 mlm_Eclusfactor =  1.000000000000E+00
 ?powheg_matching = false
 ?powheg_use_singular_jacobian = false
 powheg_grid_size_xi = 5
 powheg_grid_size_y = 5
 powheg_grid_sampling_points = 500000
 powheg_pt_min =  1.000000000000E+00
 powheg_lambda =  2.000000000000E-01
 ?powheg_rebuild_grids = false
 ?powheg_test_sudakov = false
 ?powheg_disable_sudakov = false
 ?ckkw_matching = false
 ?omega_openmp = false
 ?openmp_is_active* = false
 openmp_num_threads_default* = 1
 openmp_num_threads = 1
 ?openmp_logging = true
 ?mpi_logging = false
 $born_me_method = ""
 $loop_me_method = ""
 $correlation_me_method = ""
 $real_tree_me_method = ""
 $dglap_me_method = ""
 ?test_soft_limit = false
 ?test_coll_limit = false
 ?test_anti_coll_limit = false
 $select_alpha_regions = ""
 $virtual_selection = "Full"
 ?virtual_collinear_resonance_aware = true
 blha_top_yukawa = -1.000000000000E+00
 $blha_ew_scheme = "alpha_internal"
 openloops_verbosity = 1
 ?openloops_use_cms = true
 openloops_phs_tolerance = 7
 openloops_stability_log = 0
 ?openloops_switch_off_muon_yukawa = false
 $openloops_extra_cmd = ""
 ellis_sexton_scale = -1.000000000000E+00
 ?disable_subtraction = false
 fks_dij_exp1 =  1.000000000000E+00
 fks_dij_exp2 =  1.000000000000E+00
 fks_xi_min =  1.000000000000E-07
 fks_y_max =  1.000000000000E+00
 ?vis_fks_regions = false
 fks_xi_cut =  1.000000000000E+00
 fks_delta_o =  2.000000000000E+00
 fks_delta_i =  2.000000000000E+00
 $fks_mapping_type = "default"
 $resonances_exclude_particles = "default"
 alpha_power = 2
 alphas_power = 0
 ?combined_nlo_integration = false
 ?fixed_order_nlo_events = false
 ?check_event_weights_against_xsection = false
 ?keep_failed_events = false
 gks_multiplicity = 0
 $gosam_filter_lo = ""
 $gosam_filter_nlo = ""
 $gosam_symmetries = "family,generation"
 form_threads = 2
 form_workspace = 1000
 $gosam_fc = ""
 mult_call_real =  1.000000000000E+00
 mult_call_virt =  1.000000000000E+00
 mult_call_dglap =  1.000000000000E+00
 $dalitz_plot = ""
 $nlo_correction_type = "QCD"
 $exclude_gauge_splittings = "c:b:t:e2:e3"
 ?nlo_use_born_scale = false
 ?nlo_cut_all_sqmes = false
 ?nlo_use_real_partition = false
 real_partition_scale =  1.000000000000E+01
 $fc => "Fortran-compiler"
 $fcflags => "Fortran-flags"
 ========================================================================
 model "Test"
  ! md5sum = 'DB28187ADA60804A3CFC14A025DED784'
 
    parameter gy =  1.000000000000E+00
    parameter ms =  1.500000000000E+02
    parameter ff =  1.500000000000E+00
    external mf =  2.250000000000E+02
 
    particle SCALAR 25
      name "s"
      spin 0
      mass ms
    particle FERMION 6
      name "f"
      anti "fbar" "F"
      tex_anti "\bar{f}"
      spin 1/2  isospin 1/2  charge 2/3  color 3
      mass mf
 
    vertex "fbar" "f" "s"
    vertex "s" "s" "s"
 ========================================================================
  Process library stack:
 ------------------------------------------------------------------------
  Process library: library_2
    external        = F
    makefile exists = F
    driver exists   = F
    code status     = o
 
  Process definition list: [empty]
 ------------------------------------------------------------------------
  Process library: library_1
    external        = F
    makefile exists = F
    driver exists   = F
    code status     = o
 
  Process definition list: [empty]
 ========================================================================
  Beam structure: s, s => pdf_builtin
 ========================================================================
  Cuts:
 ------------------------------------------------------------------------
 +  SEQUENCE    <lexpr>  =  <lsinglet>
 +  SEQUENCE    <lsinglet>  =  <lterm>
 |  +  SEQUENCE    <lterm>  =  <all_fun>
 |  |  +  SEQUENCE    <all_fun>  =  all <lexpr> <pargs1>
 |  |  |  +  KEYWORD     all  = [keyword] all
 |  |  |  +  SEQUENCE    <lexpr>  =  <lsinglet>
 |  |  |  |  +  SEQUENCE    <lsinglet>  =  <lterm>
 |  |  |  |  |  +  SEQUENCE    <lterm>  =  <compared_expr>
 |  |  |  |  |  |  +  SEQUENCE    <compared_expr>  =  <expr> <comparison>
 |  |  |  |  |  |  |  +  SEQUENCE    <expr>  =  <term>
 |  |  |  |  |  |  |  |  +  SEQUENCE    <term>  =  <factor>
 |  |  |  |  |  |  |  |  |  +  SEQUENCE    <factor>  =  <variable>
 |  |  |  |  |  |  |  |  |  |  +  IDENTIFIER  <variable>  = Pt
 |  |  |  |  |  |  |  +  SEQUENCE    <comparison>  =  '>' <expr>
 |  |  |  |  |  |  |  |  +  KEYWORD     '>'  = [keyword] >
 |  |  |  |  |  |  |  |  +  SEQUENCE    <expr>  =  <term>
 |  |  |  |  |  |  |  |  |  +  SEQUENCE    <term>  =  <factor>
 |  |  |  |  |  |  |  |  |  |  +  SEQUENCE    <factor>  =  <integer_value>
 |  |  |  |  |  |  |  |  |  |  |  +  SEQUENCE    <integer_value>  =  <integer_literal>
 |  |  |  |  |  |  |  |  |  |  |  |  +  INTEGER     <integer_literal>  = 100
 |  |  |  +  ARGUMENTS   <pargs1>  =  <pexpr>
 |  |  |  |  +  SEQUENCE    <pexpr>  =  <pterm>
 |  |  |  |  |  +  SEQUENCE    <pterm>  =  <pexpr_src>
 |  |  |  |  |  |  +  SEQUENCE    <pexpr_src>  =  <unspecified_prt>
 |  |  |  |  |  |  |  +  SEQUENCE    <unspecified_prt>  =  <cexpr>
 |  |  |  |  |  |  |  |  +  SEQUENCE    <cexpr>  =  <variable>
 |  |  |  |  |  |  |  |  |  +  IDENTIFIER  <variable>  = s
 ------------------------------------------------------------------------
  Scale: [undefined]
 ------------------------------------------------------------------------
  Factorization scale: [undefined]
 ------------------------------------------------------------------------
  Renormalization scale: [undefined]
 ------------------------------------------------------------------------
  Weight: [undefined]
 ========================================================================
  Event selection: [undefined]
 ------------------------------------------------------------------------
  Event reweighting factor: [undefined]
 ------------------------------------------------------------------------
  Event analysis: [undefined]
 ------------------------------------------------------------------------
  Event sample formats = foo_fmt, bar_fmt
 ------------------------------------------------------------------------
  Event callback: NOP
 ========================================================================
  Process stack: [empty]
 ========================================================================
  [Processes from context environment:]
 ========================================================================
  Process stack: [empty]
 ========================================================================
  quit     : F
  quit_code: 0
 ========================================================================
  Logfile  : ''
 ========================================================================
 
 * Restore global data
 
  model associated   = T
  library associated = T
 
 ========================================================================
  Runtime data:
 ========================================================================
 gy =>  1.000000000000E+00
 ms =>  1.250000000000E+02
 ff =>  1.500000000000E+00
 mf* =>  1.875000000000E+02
 particle* = PDG(0)
 SCALAR* = PDG(25)
 s* = PDG(25)
 FERMION* = PDG(6)
 f* = PDG(6)
 fbar* = PDG(-6)
 F* = PDG(-6)
 charged* = PDG(6, -6)
 neutral* = PDG(25)
 colored* = PDG(6, -6)
 sqrts =  1.000000000000E+03
 luminosity =  3.300000000000E+01
 ?sf_trace = false
 $sf_trace_file = ""
 ?sf_allow_s_mapping = true
 $lhapdf_dir = ""
 $lhapdf_file = ""
 $lhapdf_photon_file = ""
 lhapdf_member = 0
 lhapdf_photon_scheme = 0
 $pdf_builtin_set = "CTEQ6L"
 ?hoppet_b_matching = false
 isr_alpha =  0.000000000000E+00
 isr_q_max =  0.000000000000E+00
 isr_mass =  0.000000000000E+00
 isr_order = 3
 ?isr_recoil = false
 ?isr_keep_energy = false
 ?isr_handler = false
 $isr_handler_mode = "trivial"
 epa_alpha =  0.000000000000E+00
 epa_x_min =  0.000000000000E+00
 epa_q_min =  0.000000000000E+00
 epa_q_max =  0.000000000000E+00
 epa_mass =  0.000000000000E+00
 ?epa_recoil = false
 ?epa_keep_energy = false
 ?epa_handler = false
 $epa_handler_mode = "trivial"
 ewa_x_min =  0.000000000000E+00
 ewa_pt_max =  0.000000000000E+00
 ewa_mass =  0.000000000000E+00
 ?ewa_recoil = false
 ?ewa_keep_energy = false
 ?circe1_photon1 = false
 ?circe1_photon2 = false
 [undefined] circe1_sqrts = [unknown real]
 ?circe1_generate = true
 ?circe1_map = true
 circe1_mapping_slope =  2.000000000000E+00
 circe1_eps =  1.000000000000E-05
 circe1_ver = 0
 circe1_rev = 0
 $circe1_acc = "SBAND"
 circe1_chat = 0
 ?circe1_with_radiation = false
 ?circe2_polarized = true
 [undefined] $circe2_file = [unknown string]
 $circe2_design = "*"
 gaussian_spread1 =  0.000000000000E+00
 gaussian_spread2 =  0.000000000000E+00
 [undefined] $beam_events_file = [unknown string]
 ?beam_events_warn_eof = true
 ?energy_scan_normalize = false
 ?logging => false
 [undefined] $job_id = [unknown string]
 [undefined] $compile_workspace = [unknown string]
 seed = 0
 $model_name = "Test"
 [undefined] process_num_id = [unknown integer]
+?proc_as_run_id = true
+lcio_run_id = 0
 $method = "omega"
 ?report_progress = true
 [user variable] ?me_verbose = false
 $restrictions = ""
 ?omega_write_phs_output = false
 $omega_flags = ""
 ?read_color_factors = true
 ?slha_read_input = true
 ?slha_read_spectrum = true
 ?slha_read_decays = false
 $library_name = "library_1"
 ?alphas_is_fixed = true
 ?alphas_from_lhapdf = false
 ?alphas_from_pdf_builtin = false
 alphas_order = 0
 alphas_nf = 5
 ?alphas_from_mz = false
 ?alphas_from_lambda_qcd = false
 lambda_qcd =  2.000000000000E-01
 ?fatal_beam_decay = true
 ?helicity_selection_active = true
 helicity_selection_threshold =  1.000000000000E+10
 helicity_selection_cutoff = 1000
 $rng_method = "tao"
 ?vis_diags = false
 ?vis_diags_color = false
 ?check_event_file = true
 $event_file_version = ""
 n_events = 0
 event_index_offset = 0
 ?unweighted = true
 safety_factor =  1.000000000000E+00
 ?negative_weights = false
 ?resonance_history = false
 resonance_on_shell_limit =  4.000000000000E+00
 resonance_on_shell_turnoff =  0.000000000000E+00
 resonance_background_factor =  1.000000000000E+00
 ?keep_beams = false
 ?keep_remnants = true
 ?recover_beams = true
 ?update_event = false
 ?update_sqme = false
 ?update_weight = false
 ?use_alphas_from_file = false
 ?use_scale_from_file = false
 ?allow_decays = true
 ?auto_decays = false
 auto_decays_multiplicity = 2
 ?auto_decays_radiative = false
 ?decay_rest_frame = false
 ?isotropic_decay = false
 ?diagonal_decay = false
 [undefined] decay_helicity = [unknown integer]
 ?polarized_events = false
 $polarization_mode = "helicity"
 ?colorize_subevt = false
 tolerance =  0.000000000000E+00
 checkpoint = 0
 event_callback_interval = 0
 ?pacify = false
 $out_file = ""
 ?out_advance = true
 real_range* = 307
 real_precision* = 15
 real_epsilon* =  1.000000000000E-16
 real_tiny* =  1.000000000000-300
 $integration_method = "vamp"
 threshold_calls = 10
 min_calls_per_channel = 10
 min_calls_per_bin = 10
 min_bins = 3
 max_bins = 20
 ?stratified = true
 ?use_vamp_equivalences = true
 ?vamp_verbose = false
 ?vamp_history_global = true
 ?vamp_history_global_verbose = false
 ?vamp_history_channels = false
 ?vamp_history_channels_verbose = false
 $run_id = "run1"
 n_calls_test = 0
 ?integration_timer = true
 ?check_grid_file = true
 accuracy_goal =  0.000000000000E+00
 error_goal =  0.000000000000E+00
 relative_error_goal =  0.000000000000E+00
 integration_results_verbosity = 1
 error_threshold =  0.000000000000E+00
 channel_weights_power =  2.500000000000E-01
 [undefined] $integrate_workspace = [unknown string]
 $vamp_grid_format = "ascii"
 $phs_method = "default"
 ?vis_channels = false
 ?check_phs_file = true
 $phs_file = ""
 ?phs_only = false
 phs_threshold_s =  5.000000000000E+01
 phs_threshold_t =  1.000000000000E+02
 phs_off_shell = 2
 phs_t_channel = 6
 phs_e_scale =  1.000000000000E+01
 phs_m_scale =  1.000000000000E+01
 phs_q_scale =  1.000000000000E+01
 ?phs_keep_nonresonant = true
 ?phs_step_mapping = true
 ?phs_step_mapping_exp = true
 ?phs_s_mapping = true
 ?vis_history = false
 n_bins = 20
 ?normalize_bins = false
 $obs_label = ""
 $obs_unit = ""
 $title = ""
 $description = ""
 $x_label = ""
 $y_label = ""
 graph_width_mm = 130
 graph_height_mm = 90
 ?y_log = false
 ?x_log = false
 [undefined] x_min = [unknown real]
 [undefined] x_max = [unknown real]
 [undefined] y_min = [unknown real]
 [undefined] y_max = [unknown real]
 $gmlcode_bg = ""
 $gmlcode_fg = ""
 [undefined] ?draw_histogram = [unknown logical]
 [undefined] ?draw_base = [unknown logical]
 [undefined] ?draw_piecewise = [unknown logical]
 [undefined] ?fill_curve = [unknown logical]
 [undefined] ?draw_curve = [unknown logical]
 [undefined] ?draw_errors = [unknown logical]
 [undefined] ?draw_symbols = [unknown logical]
 [undefined] $fill_options = [unknown string]
 [undefined] $draw_options = [unknown string]
 [undefined] $err_options = [unknown string]
 [undefined] $symbol = [unknown string]
 ?analysis_file_only = false
 kt_algorithm* = 0
 cambridge_algorithm* = 1
 antikt_algorithm* = 2
 genkt_algorithm* = 3
 cambridge_for_passive_algorithm* = 11
 genkt_for_passive_algorithm* = 13
 ee_kt_algorithm* = 50
 ee_genkt_algorithm* = 53
 plugin_algorithm* = 99
 undefined_jet_algorithm* = 999
 jet_algorithm = 999
 jet_r =  0.000000000000E+00
 jet_p =  0.000000000000E+00
 jet_ycut =  0.000000000000E+00
 ?keep_flavors_when_clustering = false
 photon_iso_eps =  1.000000000000E+00
 photon_iso_n =  1.000000000000E+00
 photon_iso_r0 =  4.000000000000E-01
 $sample = ""
 $sample_normalization = "auto"
 ?sample_pacify = false
 ?sample_select = true
 sample_max_tries = 10000
 sample_split_n_evt = 0
 sample_split_n_kbytes = 0
 sample_split_index = 0
 $rescan_input_format = "raw"
 ?read_raw = true
 ?write_raw = true
 $extension_raw = "evx"
 $extension_default = "evt"
 $debug_extension = "debug"
 ?debug_process = true
 ?debug_transforms = true
 ?debug_decay = true
 ?debug_verbose = true
 $dump_extension = "pset.dat"
 ?dump_compressed = false
 ?dump_weights = false
 ?dump_summary = false
 ?dump_screen = false
 ?hepevt_ensure_order = false
 $extension_hepevt = "hepevt"
 $extension_ascii_short = "short.evt"
 $extension_ascii_long = "long.evt"
 $extension_athena = "athena.evt"
 $extension_mokka = "mokka.evt"
 $lhef_version = "2.0"
 $lhef_extension = "lhe"
 ?lhef_write_sqme_prc = true
 ?lhef_write_sqme_ref = false
 ?lhef_write_sqme_alt = true
 $extension_lha = "lha"
 $extension_hepmc = "hepmc"
 ?hepmc_output_cross_section = false
 ?hepmc3_hepmc2mode = false
 $extension_lcio = "slcio"
 $extension_stdhep = "hep"
 $extension_stdhep_up = "up.hep"
 $extension_stdhep_ev4 = "ev4.hep"
 $extension_hepevt_verb = "hepevt.verb"
 $extension_lha_verb = "lha.verb"
 ?allow_shower = true
 ?ps_fsr_active = false
 ?ps_isr_active = false
 ?ps_taudec_active = false
 ?muli_active = false
 $shower_method = "WHIZARD"
 ?shower_verbose = false
 $ps_PYTHIA_PYGIVE = ""
 $ps_PYTHIA8_config = ""
 $ps_PYTHIA8_config_file = ""
 ps_mass_cutoff =  1.000000000000E+00
 ps_fsr_lambda =  2.900000000000E-01
 ps_isr_lambda =  2.900000000000E-01
 ps_max_n_flavors = 5
 ?ps_isr_alphas_running = true
 ?ps_fsr_alphas_running = true
 ps_fixed_alphas =  0.000000000000E+00
 ?ps_isr_pt_ordered = false
 ?ps_isr_angular_ordered = true
 ps_isr_primordial_kt_width =  0.000000000000E+00
 ps_isr_primordial_kt_cutoff =  5.000000000000E+00
 ps_isr_z_cutoff =  9.990000000000E-01
 ps_isr_minenergy =  1.000000000000E+00
 ps_isr_tscalefactor =  1.000000000000E+00
 ?ps_isr_only_onshell_emitted_partons = false
 ?allow_hadronization = true
 ?hadronization_active = false
 $hadronization_method = "PYTHIA6"
 hadron_enhanced_fraction =  1.000000000000E-02
 hadron_enhanced_width =  2.000000000000E+00
 ?ps_tauola_photos = false
 ?ps_tauola_transverse = false
 ?ps_tauola_dec_rad_cor = true
 ps_tauola_dec_mode1 = 0
 ps_tauola_dec_mode2 = 0
 ps_tauola_mh =  1.250000000000E+02
 ps_tauola_mix_angle =  9.000000000000E+01
 ?ps_tauola_pol_vector = false
 ?mlm_matching = false
 mlm_Qcut_ME =  0.000000000000E+00
 mlm_Qcut_PS =  0.000000000000E+00
 mlm_ptmin =  0.000000000000E+00
 mlm_etamax =  0.000000000000E+00
 mlm_Rmin =  0.000000000000E+00
 mlm_Emin =  0.000000000000E+00
 mlm_nmaxMEjets = 0
 mlm_ETclusfactor =  2.000000000000E-01
 mlm_ETclusminE =  5.000000000000E+00
 mlm_etaclusfactor =  1.000000000000E+00
 mlm_Rclusfactor =  1.000000000000E+00
 mlm_Eclusfactor =  1.000000000000E+00
 ?powheg_matching = false
 ?powheg_use_singular_jacobian = false
 powheg_grid_size_xi = 5
 powheg_grid_size_y = 5
 powheg_grid_sampling_points = 500000
 powheg_pt_min =  1.000000000000E+00
 powheg_lambda =  2.000000000000E-01
 ?powheg_rebuild_grids = false
 ?powheg_test_sudakov = false
 ?powheg_disable_sudakov = false
 ?ckkw_matching = false
 ?omega_openmp = false
 ?openmp_is_active* = false
 openmp_num_threads_default* = 1
 openmp_num_threads = 1
 ?openmp_logging = true
 ?mpi_logging = false
 $born_me_method = ""
 $loop_me_method = ""
 $correlation_me_method = ""
 $real_tree_me_method = ""
 $dglap_me_method = ""
 ?test_soft_limit = false
 ?test_coll_limit = false
 ?test_anti_coll_limit = false
 $select_alpha_regions = ""
 $virtual_selection = "Full"
 ?virtual_collinear_resonance_aware = true
 blha_top_yukawa = -1.000000000000E+00
 $blha_ew_scheme = "alpha_internal"
 openloops_verbosity = 1
 ?openloops_use_cms = true
 openloops_phs_tolerance = 7
 openloops_stability_log = 0
 ?openloops_switch_off_muon_yukawa = false
 $openloops_extra_cmd = ""
 ellis_sexton_scale = -1.000000000000E+00
 ?disable_subtraction = false
 fks_dij_exp1 =  1.000000000000E+00
 fks_dij_exp2 =  1.000000000000E+00
 fks_xi_min =  1.000000000000E-07
 fks_y_max =  1.000000000000E+00
 ?vis_fks_regions = false
 fks_xi_cut =  1.000000000000E+00
 fks_delta_o =  2.000000000000E+00
 fks_delta_i =  2.000000000000E+00
 $fks_mapping_type = "default"
 $resonances_exclude_particles = "default"
 alpha_power = 2
 alphas_power = 0
 ?combined_nlo_integration = false
 ?fixed_order_nlo_events = false
 ?check_event_weights_against_xsection = false
 ?keep_failed_events = false
 gks_multiplicity = 0
 $gosam_filter_lo = ""
 $gosam_filter_nlo = ""
 $gosam_symmetries = "family,generation"
 form_threads = 2
 form_workspace = 1000
 $gosam_fc = ""
 mult_call_real =  1.000000000000E+00
 mult_call_virt =  1.000000000000E+00
 mult_call_dglap =  1.000000000000E+00
 $dalitz_plot = ""
 $nlo_correction_type = "QCD"
 $exclude_gauge_splittings = "c:b:t:e2:e3"
 ?nlo_use_born_scale = false
 ?nlo_cut_all_sqmes = false
 ?nlo_use_real_partition = false
 real_partition_scale =  1.000000000000E+01
 $fc => "Fortran-compiler"
 $fcflags => "Fortran-flags"
 ========================================================================
 model "Test"
  ! md5sum = 'DB28187ADA60804A3CFC14A025DED784'
 
    parameter gy =  1.000000000000E+00
    parameter ms =  1.250000000000E+02
    parameter ff =  1.500000000000E+00
    external mf =  1.875000000000E+02
 
    particle SCALAR 25
      name "s"
      spin 0
      mass ms
    particle FERMION 6
      name "f"
      anti "fbar" "F"
      tex_anti "\bar{f}"
      spin 1/2  isospin 1/2  charge 2/3  color 3
      mass mf
 
    vertex "fbar" "f" "s"
    vertex "s" "s" "s"
 ========================================================================
  Process library stack:
 ------------------------------------------------------------------------
  Process library: library_2
    external        = F
    makefile exists = F
    driver exists   = F
    code status     = o
 
  Process definition list: [empty]
 ------------------------------------------------------------------------
  Process library: library_1
    external        = F
    makefile exists = F
    driver exists   = F
    code status     = o
 
  Process definition list: [empty]
 ========================================================================
  Beam structure: s, s => pdf_builtin
 ========================================================================
  Cuts:
 ------------------------------------------------------------------------
 +  SEQUENCE    <lexpr>  =  <lsinglet>
 +  SEQUENCE    <lsinglet>  =  <lterm>
 |  +  SEQUENCE    <lterm>  =  <all_fun>
 |  |  +  SEQUENCE    <all_fun>  =  all <lexpr> <pargs1>
 |  |  |  +  KEYWORD     all  = [keyword] all
 |  |  |  +  SEQUENCE    <lexpr>  =  <lsinglet>
 |  |  |  |  +  SEQUENCE    <lsinglet>  =  <lterm>
 |  |  |  |  |  +  SEQUENCE    <lterm>  =  <compared_expr>
 |  |  |  |  |  |  +  SEQUENCE    <compared_expr>  =  <expr> <comparison>
 |  |  |  |  |  |  |  +  SEQUENCE    <expr>  =  <term>
 |  |  |  |  |  |  |  |  +  SEQUENCE    <term>  =  <factor>
 |  |  |  |  |  |  |  |  |  +  SEQUENCE    <factor>  =  <variable>
 |  |  |  |  |  |  |  |  |  |  +  IDENTIFIER  <variable>  = Pt
 |  |  |  |  |  |  |  +  SEQUENCE    <comparison>  =  '>' <expr>
 |  |  |  |  |  |  |  |  +  KEYWORD     '>'  = [keyword] >
 |  |  |  |  |  |  |  |  +  SEQUENCE    <expr>  =  <term>
 |  |  |  |  |  |  |  |  |  +  SEQUENCE    <term>  =  <factor>
 |  |  |  |  |  |  |  |  |  |  +  SEQUENCE    <factor>  =  <integer_value>
 |  |  |  |  |  |  |  |  |  |  |  +  SEQUENCE    <integer_value>  =  <integer_literal>
 |  |  |  |  |  |  |  |  |  |  |  |  +  INTEGER     <integer_literal>  = 100
 |  |  |  +  ARGUMENTS   <pargs1>  =  <pexpr>
 |  |  |  |  +  SEQUENCE    <pexpr>  =  <pterm>
 |  |  |  |  |  +  SEQUENCE    <pterm>  =  <pexpr_src>
 |  |  |  |  |  |  +  SEQUENCE    <pexpr_src>  =  <unspecified_prt>
 |  |  |  |  |  |  |  +  SEQUENCE    <unspecified_prt>  =  <cexpr>
 |  |  |  |  |  |  |  |  +  SEQUENCE    <cexpr>  =  <variable>
 |  |  |  |  |  |  |  |  |  +  IDENTIFIER  <variable>  = s
 ------------------------------------------------------------------------
  Scale: [undefined]
 ------------------------------------------------------------------------
  Factorization scale: [undefined]
 ------------------------------------------------------------------------
  Renormalization scale: [undefined]
 ------------------------------------------------------------------------
  Weight: [undefined]
 ========================================================================
  Event selection: [undefined]
 ------------------------------------------------------------------------
  Event reweighting factor: [undefined]
 ------------------------------------------------------------------------
  Event analysis: [undefined]
 ------------------------------------------------------------------------
  Event sample formats = foo_fmt, bar_fmt
 ------------------------------------------------------------------------
  Event callback: [undefined]
 ========================================================================
  Process stack: [empty]
 ========================================================================
  quit     : F
  quit_code: 0
 ========================================================================
  Logfile  : ''
 ========================================================================
 
 * Cleanup
 
 * Test output end: rt_data_3
Index: trunk/share/tests/unit_tests/ref-output/eio_lcio_2.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/eio_lcio_2.ref	(revision 8384)
+++ trunk/share/tests/unit_tests/ref-output/eio_lcio_2.ref	(revision 8385)
@@ -1,105 +1,109 @@
 * Test output: eio_lcio_2
 *   Purpose: read a LCIO event
 
 * Initialize test process
 
 * Generate and write an event
 
  LCIO event stream:
    Writing to file   = eio_lcio_2.slcio
    Recover beams     = F
    Alpha_s from file = F
    Scale from file   = F
+   Process as run ID = T
+   LCIO run ID       = 0
    File extension    = 'slcio'
    Numerical process IDs:
      1: 42
 
 * Initialize
 
  Event sample properties:
    MD5 sum (proc)   = '                                '
    MD5 sum (config) = '                                '
    unweighted       = T
    negative weights = F
    normalization    = '1'
    number of beams  = 2
      PDG    =                   25                  25
      Energy =   5.000000000000E+02  5.000000000000E+02
    num of processes = 1
    Process #42
      CSec  =  0.000000000000E+00
      Error =  0.000000000000E+00
 
 * Initialize
 
  LCIO event stream:
    Reading from file = eio_lcio_2.slcio
    Recover beams     = F
    Alpha_s from file = F
    Scale from file   = F
+   Process as run ID = T
+   LCIO run ID       = 0
    File extension    = 'slcio'
    Numerical process IDs:
      1: 42
 
 * Read event
 
 Found process #1 with ID = 42
 ========================================================================
  Event #88 [incomplete]
 ------------------------------------------------------------------------
    Unweighted         = T
    Normalization      = '1'
    Helicity handling  = drop
    Keep correlations  = F
    Safety factor      =  0.00000E+00
 ------------------------------------------------------------------------
    Event weight (ref)       =  1.000000000000E+00
 ------------------------------------------------------------------------
    Selected MCI group = 1
    Selected term      = 1
    Selected channel   = 1
 ========================================================================
  Process instance [scattering]: 'processes_test'
    Run ID = 'run_test'
    Process components:
      1: 'processes_test_i1':   s, s => s, s [test_me]
    status = initialized
 ========================================================================
 ========================================================================
  Event transform: trivial (hard process)
 ------------------------------------------------------------------------
    Associated process: 'processes_test'
    Random-number generator: test (state = 7)
    Number of tries = 0
 ------------------------------------------------------------------------
  Particle set:
 ------------------------------------------------------------------------
  Particle 1 [i] f(25)
  E =   5.000000063214E+02
  P =   0.000000000000E+00  0.000000000000E+00  4.841229248047E+02
  T =   1.562500000000E+04
  Children: 3 4
  Particle 2 [i] f(25)
  E =   5.000000063214E+02
  P =   0.000000000000E+00  0.000000000000E+00 -4.841229248047E+02
  T =   1.562500000000E+04
  Children: 3 4
  Particle 3 [o] f(25)
  E =   5.000000098144E+02
  P =  -4.437059936523E+02  0.000000000000E+00  1.936491699219E+02
  T =   1.562500000000E+04
  Parents:  1 2
  Particle 4 [o] f(25)
  E =   5.000000098144E+02
  P =   4.437059936523E+02  0.000000000000E+00 -1.936491699219E+02
  T =   1.562500000000E+04
  Parents:  1 2
 ========================================================================
 
 * Read closing
 
 iostat = -1
 
 * Cleanup
 
 * Test output end: eio_lcio_2
Index: trunk/share/tests/Makefile.am
===================================================================
--- trunk/share/tests/Makefile.am	(revision 8384)
+++ trunk/share/tests/Makefile.am	(revision 8385)
@@ -1,1471 +1,1473 @@
 ## Makefile.am -- Makefile for WHIZARD tests
 ##
 ## Process this file with automake to produce Makefile.in
 ##
 ########################################################################
 #
 # Copyright (C) 1999-2020 by
 #     Wolfgang Kilian <kilian@physik.uni-siegen.de>
 #     Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
 #     Juergen Reuter <juergen.reuter@desy.de>
 #     with contributions from
 #     cf. main AUTHORS file
 #
 # WHIZARD is free software; you can redistribute it and/or modify it
 # under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 2, or (at your option)
 # any later version.
 #
 # WHIZARD is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
 #
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 #
 ########################################################################
 
 EXTRA_DIST = \
     $(TESTSUITE_MACROS) $(TESTSUITES_M4) $(TESTSUITES_SIN) \
     $(TESTSUITE_TOOLS) \
     $(REF_OUTPUT_FILES) \
     cascades2_lexer_1.fds \
     cascades2_1.fds \
     cascades2_2.fds \
     functional_tests/structure_2_inc.sin functional_tests/testproc_3.phs \
     functional_tests/user_cuts.f90 \
     functional_tests/susyhit.in \
     functional_tests/ufo_5_test.slha \
     ext_tests_nmssm/nmssm.slha
 
 TESTSUITE_MACROS = testsuite.m4
 TESTSUITE_TOOLS = \
     check-debug-output.py \
     check-debug-output-hadro.py \
     check-hepmc-weights.py \
     compare-integrals.py \
     compare-integrals-multi.py \
     compare-methods.py \
     compare-histograms.py
 
 REF_OUTPUT_FILES = \
     extra_integration_results.dat \
     $(REF_OUTPUT_FILES_BASE) $(REF_OUTPUT_FILES_DOUBLE) \
     $(REF_OUTPUT_FILES_PREC) $(REF_OUTPUT_FILES_EXT) \
     $(REF_OUTPUT_FILES_QUAD)
 
 REF_OUTPUT_FILES_BASE = \
     unit_tests/ref-output/analysis_1.ref \
     unit_tests/ref-output/pdg_arrays_1.ref \
     unit_tests/ref-output/pdg_arrays_2.ref \
     unit_tests/ref-output/pdg_arrays_3.ref \
     unit_tests/ref-output/pdg_arrays_4.ref \
     unit_tests/ref-output/pdg_arrays_5.ref \
     unit_tests/ref-output/expressions_1.ref \
     unit_tests/ref-output/expressions_2.ref \
     unit_tests/ref-output/expressions_3.ref \
     unit_tests/ref-output/expressions_4.ref \
     unit_tests/ref-output/su_algebra_1.ref \
     unit_tests/ref-output/su_algebra_2.ref \
     unit_tests/ref-output/su_algebra_3.ref \
     unit_tests/ref-output/su_algebra_4.ref \
     unit_tests/ref-output/bloch_vectors_1.ref \
     unit_tests/ref-output/bloch_vectors_2.ref \
     unit_tests/ref-output/bloch_vectors_3.ref \
     unit_tests/ref-output/bloch_vectors_4.ref \
     unit_tests/ref-output/bloch_vectors_5.ref \
     unit_tests/ref-output/bloch_vectors_6.ref \
     unit_tests/ref-output/bloch_vectors_7.ref \
     unit_tests/ref-output/polarization_1.ref \
     unit_tests/ref-output/polarization_2.ref \
     unit_tests/ref-output/beam_1.ref \
     unit_tests/ref-output/beam_2.ref \
     unit_tests/ref-output/beam_3.ref \
     unit_tests/ref-output/md5_1.ref \
     unit_tests/ref-output/cputime_1.ref \
     unit_tests/ref-output/cputime_2.ref \
     unit_tests/ref-output/lexer_1.ref \
     unit_tests/ref-output/parse_1.ref \
     unit_tests/ref-output/color_1.ref \
     unit_tests/ref-output/color_2.ref \
     unit_tests/ref-output/os_interface_1.ref \
     unit_tests/ref-output/evaluator_1.ref \
     unit_tests/ref-output/evaluator_2.ref \
     unit_tests/ref-output/evaluator_3.ref \
     unit_tests/ref-output/evaluator_4.ref \
     unit_tests/ref-output/format_1.ref \
     unit_tests/ref-output/sorting_1.ref \
     unit_tests/ref-output/grids_1.ref \
     unit_tests/ref-output/grids_2.ref \
     unit_tests/ref-output/grids_3.ref \
     unit_tests/ref-output/grids_4.ref \
     unit_tests/ref-output/grids_5.ref \
     unit_tests/ref-output/solver_1.ref \
     unit_tests/ref-output/state_matrix_1.ref \
     unit_tests/ref-output/state_matrix_2.ref \
     unit_tests/ref-output/state_matrix_3.ref \
     unit_tests/ref-output/state_matrix_4.ref \
     unit_tests/ref-output/state_matrix_5.ref \
     unit_tests/ref-output/state_matrix_6.ref \
     unit_tests/ref-output/state_matrix_7.ref \
     unit_tests/ref-output/interaction_1.ref \
     unit_tests/ref-output/xml_1.ref \
     unit_tests/ref-output/xml_2.ref \
     unit_tests/ref-output/xml_3.ref \
     unit_tests/ref-output/xml_4.ref \
     unit_tests/ref-output/sm_qcd_1.ref \
     unit_tests/ref-output/sm_physics_1.ref \
     unit_tests/ref-output/sm_physics_2.ref \
     unit_tests/ref-output/models_1.ref \
     unit_tests/ref-output/models_2.ref \
     unit_tests/ref-output/models_3.ref \
     unit_tests/ref-output/models_4.ref \
     unit_tests/ref-output/models_5.ref \
     unit_tests/ref-output/models_6.ref \
     unit_tests/ref-output/models_7.ref \
     unit_tests/ref-output/models_8.ref \
     unit_tests/ref-output/models_9.ref \
     unit_tests/ref-output/models_10.ref \
     unit_tests/ref-output/auto_components_1.ref \
     unit_tests/ref-output/auto_components_2.ref \
     unit_tests/ref-output/auto_components_3.ref \
     unit_tests/ref-output/radiation_generator_1.ref \
     unit_tests/ref-output/radiation_generator_2.ref \
     unit_tests/ref-output/radiation_generator_3.ref \
     unit_tests/ref-output/radiation_generator_4.ref \
     unit_tests/ref-output/particles_1.ref \
     unit_tests/ref-output/particles_2.ref \
     unit_tests/ref-output/particles_3.ref \
     unit_tests/ref-output/particles_4.ref \
     unit_tests/ref-output/particles_5.ref \
     unit_tests/ref-output/particles_6.ref \
     unit_tests/ref-output/particles_7.ref \
     unit_tests/ref-output/particles_8.ref \
     unit_tests/ref-output/particles_9.ref \
     unit_tests/ref-output/beam_structures_1.ref \
     unit_tests/ref-output/beam_structures_2.ref \
     unit_tests/ref-output/beam_structures_3.ref \
     unit_tests/ref-output/beam_structures_4.ref \
     unit_tests/ref-output/beam_structures_5.ref \
     unit_tests/ref-output/beam_structures_6.ref \
     unit_tests/ref-output/sf_aux_1.ref \
     unit_tests/ref-output/sf_aux_2.ref \
     unit_tests/ref-output/sf_aux_3.ref \
     unit_tests/ref-output/sf_aux_4.ref \
     unit_tests/ref-output/sf_mappings_1.ref \
     unit_tests/ref-output/sf_mappings_2.ref \
     unit_tests/ref-output/sf_mappings_3.ref \
     unit_tests/ref-output/sf_mappings_4.ref \
     unit_tests/ref-output/sf_mappings_5.ref \
     unit_tests/ref-output/sf_mappings_6.ref \
     unit_tests/ref-output/sf_mappings_7.ref \
     unit_tests/ref-output/sf_mappings_8.ref \
     unit_tests/ref-output/sf_mappings_9.ref \
     unit_tests/ref-output/sf_mappings_10.ref \
     unit_tests/ref-output/sf_mappings_11.ref \
     unit_tests/ref-output/sf_mappings_12.ref \
     unit_tests/ref-output/sf_mappings_13.ref \
     unit_tests/ref-output/sf_mappings_14.ref \
     unit_tests/ref-output/sf_mappings_15.ref \
     unit_tests/ref-output/sf_mappings_16.ref \
     unit_tests/ref-output/sf_base_1.ref \
     unit_tests/ref-output/sf_base_2.ref \
     unit_tests/ref-output/sf_base_3.ref \
     unit_tests/ref-output/sf_base_4.ref \
     unit_tests/ref-output/sf_base_5.ref \
     unit_tests/ref-output/sf_base_6.ref \
     unit_tests/ref-output/sf_base_7.ref \
     unit_tests/ref-output/sf_base_8.ref \
     unit_tests/ref-output/sf_base_9.ref \
     unit_tests/ref-output/sf_base_10.ref \
     unit_tests/ref-output/sf_base_11.ref \
     unit_tests/ref-output/sf_base_12.ref \
     unit_tests/ref-output/sf_base_13.ref \
     unit_tests/ref-output/sf_base_14.ref \
     unit_tests/ref-output/sf_pdf_builtin_1.ref \
     unit_tests/ref-output/sf_pdf_builtin_2.ref \
     unit_tests/ref-output/sf_pdf_builtin_3.ref \
     unit_tests/ref-output/sf_lhapdf5_1.ref \
     unit_tests/ref-output/sf_lhapdf5_2.ref \
     unit_tests/ref-output/sf_lhapdf5_3.ref \
     unit_tests/ref-output/sf_lhapdf6_1.ref \
     unit_tests/ref-output/sf_lhapdf6_2.ref \
     unit_tests/ref-output/sf_lhapdf6_3.ref \
     unit_tests/ref-output/sf_isr_1.ref \
     unit_tests/ref-output/sf_isr_2.ref \
     unit_tests/ref-output/sf_isr_3.ref \
     unit_tests/ref-output/sf_isr_4.ref \
     unit_tests/ref-output/sf_isr_5.ref \
     unit_tests/ref-output/sf_epa_1.ref \
     unit_tests/ref-output/sf_epa_2.ref \
     unit_tests/ref-output/sf_epa_3.ref \
     unit_tests/ref-output/sf_epa_4.ref \
     unit_tests/ref-output/sf_epa_5.ref \
     unit_tests/ref-output/sf_ewa_1.ref \
     unit_tests/ref-output/sf_ewa_2.ref \
     unit_tests/ref-output/sf_ewa_3.ref \
     unit_tests/ref-output/sf_ewa_4.ref \
     unit_tests/ref-output/sf_ewa_5.ref \
     unit_tests/ref-output/sf_circe1_1.ref \
     unit_tests/ref-output/sf_circe1_2.ref \
     unit_tests/ref-output/sf_circe1_3.ref \
     unit_tests/ref-output/sf_circe2_1.ref \
     unit_tests/ref-output/sf_circe2_2.ref \
     unit_tests/ref-output/sf_circe2_3.ref \
     unit_tests/ref-output/sf_gaussian_1.ref \
     unit_tests/ref-output/sf_gaussian_2.ref \
     unit_tests/ref-output/sf_beam_events_1.ref \
     unit_tests/ref-output/sf_beam_events_2.ref \
     unit_tests/ref-output/sf_beam_events_3.ref \
     unit_tests/ref-output/sf_escan_1.ref \
     unit_tests/ref-output/sf_escan_2.ref \
     unit_tests/ref-output/phs_base_1.ref \
     unit_tests/ref-output/phs_base_2.ref \
     unit_tests/ref-output/phs_base_3.ref \
     unit_tests/ref-output/phs_base_4.ref \
     unit_tests/ref-output/phs_base_5.ref \
     unit_tests/ref-output/phs_none_1.ref \
     unit_tests/ref-output/phs_single_1.ref \
     unit_tests/ref-output/phs_single_2.ref \
     unit_tests/ref-output/phs_single_3.ref \
     unit_tests/ref-output/phs_single_4.ref \
     unit_tests/ref-output/phs_rambo_1.ref \
     unit_tests/ref-output/phs_rambo_2.ref \
     unit_tests/ref-output/phs_rambo_3.ref \
     unit_tests/ref-output/phs_rambo_4.ref \
     unit_tests/ref-output/resonances_1.ref \
     unit_tests/ref-output/resonances_2.ref \
     unit_tests/ref-output/resonances_3.ref \
     unit_tests/ref-output/resonances_4.ref \
     unit_tests/ref-output/resonances_5.ref \
     unit_tests/ref-output/resonances_6.ref \
     unit_tests/ref-output/resonances_7.ref \
     unit_tests/ref-output/phs_tree_1.ref \
     unit_tests/ref-output/phs_tree_2.ref \
     unit_tests/ref-output/phs_forest_1.ref \
     unit_tests/ref-output/phs_forest_2.ref \
     unit_tests/ref-output/phs_wood_1.ref \
     unit_tests/ref-output/phs_wood_2.ref \
     unit_tests/ref-output/phs_wood_3.ref \
     unit_tests/ref-output/phs_wood_4.ref \
     unit_tests/ref-output/phs_wood_5.ref \
     unit_tests/ref-output/phs_wood_6.ref \
     unit_tests/ref-output/phs_wood_vis_1.ref \
     unit_tests/ref-output/phs_fks_generator_1.ref \
     unit_tests/ref-output/phs_fks_generator_2.ref \
     unit_tests/ref-output/phs_fks_generator_3.ref \
     unit_tests/ref-output/phs_fks_generator_4.ref \
     unit_tests/ref-output/phs_fks_generator_5.ref \
     unit_tests/ref-output/phs_fks_generator_6.ref \
     unit_tests/ref-output/phs_fks_generator_7.ref \
     unit_tests/ref-output/fks_regions_1.ref \
     unit_tests/ref-output/fks_regions_2.ref \
     unit_tests/ref-output/fks_regions_3.ref \
     unit_tests/ref-output/fks_regions_4.ref \
     unit_tests/ref-output/fks_regions_5.ref \
     unit_tests/ref-output/fks_regions_6.ref \
     unit_tests/ref-output/fks_regions_7.ref \
     unit_tests/ref-output/fks_regions_8.ref \
     unit_tests/ref-output/real_subtraction_1.ref \
     unit_tests/ref-output/prc_recola_1.ref \
     unit_tests/ref-output/prc_recola_2.ref \
     unit_tests/ref-output/rng_base_1.ref \
     unit_tests/ref-output/rng_base_2.ref \
     unit_tests/ref-output/rng_tao_1.ref \
     unit_tests/ref-output/rng_tao_2.ref \
     unit_tests/ref-output/rng_stream_1.ref \
     unit_tests/ref-output/rng_stream_2.ref \
     unit_tests/ref-output/rng_stream_3.ref \
     unit_tests/ref-output/selectors_1.ref \
     unit_tests/ref-output/selectors_2.ref \
     unit_tests/ref-output/vegas_1.ref \
     unit_tests/ref-output/vegas_2.ref \
     unit_tests/ref-output/vegas_3.ref \
     unit_tests/ref-output/vegas_4.ref \
     unit_tests/ref-output/vegas_5.ref \
     unit_tests/ref-output/vegas_6.ref \
     unit_tests/ref-output/vamp2_1.ref \
     unit_tests/ref-output/vamp2_2.ref \
     unit_tests/ref-output/vamp2_3.ref \
     unit_tests/ref-output/vamp2_4.ref \
     unit_tests/ref-output/vamp2_5.ref \
     unit_tests/ref-output/mci_base_1.ref \
     unit_tests/ref-output/mci_base_2.ref \
     unit_tests/ref-output/mci_base_3.ref \
     unit_tests/ref-output/mci_base_4.ref \
     unit_tests/ref-output/mci_base_5.ref \
     unit_tests/ref-output/mci_base_6.ref \
     unit_tests/ref-output/mci_base_7.ref \
     unit_tests/ref-output/mci_base_8.ref \
     unit_tests/ref-output/mci_none_1.ref \
     unit_tests/ref-output/mci_midpoint_1.ref \
     unit_tests/ref-output/mci_midpoint_2.ref \
     unit_tests/ref-output/mci_midpoint_3.ref \
     unit_tests/ref-output/mci_midpoint_4.ref \
     unit_tests/ref-output/mci_midpoint_5.ref \
     unit_tests/ref-output/mci_midpoint_6.ref \
     unit_tests/ref-output/mci_midpoint_7.ref \
     unit_tests/ref-output/mci_vamp_1.ref \
     unit_tests/ref-output/mci_vamp_2.ref \
     unit_tests/ref-output/mci_vamp_3.ref \
     unit_tests/ref-output/mci_vamp_4.ref \
     unit_tests/ref-output/mci_vamp_5.ref \
     unit_tests/ref-output/mci_vamp_6.ref \
     unit_tests/ref-output/mci_vamp_7.ref \
     unit_tests/ref-output/mci_vamp_8.ref \
     unit_tests/ref-output/mci_vamp_9.ref \
     unit_tests/ref-output/mci_vamp_10.ref \
     unit_tests/ref-output/mci_vamp_11.ref \
     unit_tests/ref-output/mci_vamp_12.ref \
     unit_tests/ref-output/mci_vamp_13.ref \
     unit_tests/ref-output/mci_vamp_14.ref \
     unit_tests/ref-output/mci_vamp_15.ref \
     unit_tests/ref-output/mci_vamp_16.ref \
     unit_tests/ref-output/mci_vamp2_1.ref \
     unit_tests/ref-output/mci_vamp2_2.ref \
     unit_tests/ref-output/mci_vamp2_3.ref \
     unit_tests/ref-output/integration_results_1.ref \
     unit_tests/ref-output/integration_results_2.ref \
     unit_tests/ref-output/integration_results_3.ref \
     unit_tests/ref-output/integration_results_4.ref \
     unit_tests/ref-output/integration_results_5.ref \
     unit_tests/ref-output/prclib_interfaces_1.ref \
     unit_tests/ref-output/prclib_interfaces_2.ref \
     unit_tests/ref-output/prclib_interfaces_3.ref \
     unit_tests/ref-output/prclib_interfaces_4.ref \
     unit_tests/ref-output/prclib_interfaces_5.ref \
     unit_tests/ref-output/prclib_interfaces_6.ref \
     unit_tests/ref-output/prclib_interfaces_7.ref \
     unit_tests/ref-output/particle_specifiers_1.ref \
     unit_tests/ref-output/particle_specifiers_2.ref \
     unit_tests/ref-output/process_libraries_1.ref \
     unit_tests/ref-output/process_libraries_2.ref \
     unit_tests/ref-output/process_libraries_3.ref \
     unit_tests/ref-output/process_libraries_4.ref \
     unit_tests/ref-output/process_libraries_5.ref \
     unit_tests/ref-output/process_libraries_6.ref \
     unit_tests/ref-output/process_libraries_7.ref \
     unit_tests/ref-output/process_libraries_8.ref \
     unit_tests/ref-output/prclib_stacks_1.ref \
     unit_tests/ref-output/prclib_stacks_2.ref \
     unit_tests/ref-output/slha_1.ref \
     unit_tests/ref-output/slha_2.ref \
     unit_tests/ref-output/prc_test_1.ref \
     unit_tests/ref-output/prc_test_2.ref \
     unit_tests/ref-output/prc_test_3.ref \
     unit_tests/ref-output/prc_test_4.ref \
     unit_tests/ref-output/prc_template_me_1.ref \
     unit_tests/ref-output/prc_template_me_2.ref \
     unit_tests/ref-output/prc_omega_1.ref \
     unit_tests/ref-output/prc_omega_2.ref \
     unit_tests/ref-output/prc_omega_3.ref \
     unit_tests/ref-output/prc_omega_4.ref \
     unit_tests/ref-output/prc_omega_5.ref \
     unit_tests/ref-output/prc_omega_6.ref \
     unit_tests/ref-output/prc_omega_diags_1.ref \
     unit_tests/ref-output/parton_states_1.ref \
     unit_tests/ref-output/subevt_expr_1.ref \
     unit_tests/ref-output/subevt_expr_2.ref \
     unit_tests/ref-output/processes_1.ref \
     unit_tests/ref-output/processes_2.ref \
     unit_tests/ref-output/processes_3.ref \
     unit_tests/ref-output/processes_4.ref \
     unit_tests/ref-output/processes_5.ref \
     unit_tests/ref-output/processes_6.ref \
     unit_tests/ref-output/processes_7.ref \
     unit_tests/ref-output/processes_8.ref \
     unit_tests/ref-output/processes_9.ref \
     unit_tests/ref-output/processes_10.ref \
     unit_tests/ref-output/processes_11.ref \
     unit_tests/ref-output/processes_12.ref \
     unit_tests/ref-output/processes_13.ref \
     unit_tests/ref-output/processes_14.ref \
     unit_tests/ref-output/processes_15.ref \
     unit_tests/ref-output/processes_16.ref \
     unit_tests/ref-output/processes_17.ref \
     unit_tests/ref-output/processes_18.ref \
     unit_tests/ref-output/processes_19.ref \
     unit_tests/ref-output/process_stacks_1.ref \
     unit_tests/ref-output/process_stacks_2.ref \
     unit_tests/ref-output/process_stacks_3.ref \
     unit_tests/ref-output/process_stacks_4.ref \
     unit_tests/ref-output/cascades_1.ref \
     unit_tests/ref-output/cascades_2.ref \
     unit_tests/ref-output/cascades2_lexer_1.ref \
     unit_tests/ref-output/cascades2_1.ref \
     unit_tests/ref-output/cascades2_2.ref \
     unit_tests/ref-output/event_transforms_1.ref \
     unit_tests/ref-output/recoil_kinematics_1.ref \
     unit_tests/ref-output/recoil_kinematics_2.ref \
     unit_tests/ref-output/recoil_kinematics_3.ref \
     unit_tests/ref-output/recoil_kinematics_4.ref \
     unit_tests/ref-output/recoil_kinematics_5.ref \
     unit_tests/ref-output/resonance_insertion_1.ref \
     unit_tests/ref-output/resonance_insertion_2.ref \
     unit_tests/ref-output/resonance_insertion_3.ref \
     unit_tests/ref-output/resonance_insertion_4.ref \
     unit_tests/ref-output/resonance_insertion_5.ref \
     unit_tests/ref-output/resonance_insertion_6.ref \
     unit_tests/ref-output/isr_handler_1.ref \
     unit_tests/ref-output/isr_handler_2.ref \
     unit_tests/ref-output/isr_handler_3.ref \
     unit_tests/ref-output/epa_handler_1.ref \
     unit_tests/ref-output/epa_handler_2.ref \
     unit_tests/ref-output/epa_handler_3.ref \
     unit_tests/ref-output/decays_1.ref \
     unit_tests/ref-output/decays_2.ref \
     unit_tests/ref-output/decays_3.ref \
     unit_tests/ref-output/decays_4.ref \
     unit_tests/ref-output/decays_5.ref \
     unit_tests/ref-output/decays_6.ref \
     unit_tests/ref-output/shower_1.ref \
     unit_tests/ref-output/shower_2.ref \
     unit_tests/ref-output/shower_base_1.ref \
     unit_tests/ref-output/events_1.ref \
     unit_tests/ref-output/events_2.ref \
     unit_tests/ref-output/events_3.ref \
     unit_tests/ref-output/events_4.ref \
     unit_tests/ref-output/events_5.ref \
     unit_tests/ref-output/events_6.ref \
     unit_tests/ref-output/events_7.ref \
     unit_tests/ref-output/hep_events_1.ref \
     unit_tests/ref-output/eio_data_1.ref \
     unit_tests/ref-output/eio_data_2.ref \
     unit_tests/ref-output/eio_base_1.ref \
     unit_tests/ref-output/eio_direct_1.ref \
     unit_tests/ref-output/eio_raw_1.ref \
     unit_tests/ref-output/eio_raw_2.ref \
     unit_tests/ref-output/eio_checkpoints_1.ref \
     unit_tests/ref-output/eio_lhef_1.ref \
     unit_tests/ref-output/eio_lhef_2.ref \
     unit_tests/ref-output/eio_lhef_3.ref \
     unit_tests/ref-output/eio_lhef_4.ref \
     unit_tests/ref-output/eio_lhef_5.ref \
     unit_tests/ref-output/eio_lhef_6.ref \
     unit_tests/ref-output/eio_stdhep_1.ref \
     unit_tests/ref-output/eio_stdhep_2.ref \
     unit_tests/ref-output/eio_stdhep_3.ref \
     unit_tests/ref-output/eio_stdhep_4.ref \
     unit_tests/ref-output/eio_hepmc2_1.ref \
     unit_tests/ref-output/eio_hepmc2_2.ref \
     unit_tests/ref-output/eio_hepmc3_1.ref \
     unit_tests/ref-output/eio_hepmc3_2.ref \
     unit_tests/ref-output/eio_lcio_1.ref \
     unit_tests/ref-output/eio_lcio_2.ref \
     unit_tests/ref-output/eio_ascii_1.ref \
     unit_tests/ref-output/eio_ascii_2.ref \
     unit_tests/ref-output/eio_ascii_3.ref \
     unit_tests/ref-output/eio_ascii_4.ref \
     unit_tests/ref-output/eio_ascii_5.ref \
     unit_tests/ref-output/eio_ascii_6.ref \
     unit_tests/ref-output/eio_ascii_7.ref \
     unit_tests/ref-output/eio_ascii_8.ref \
     unit_tests/ref-output/eio_ascii_9.ref \
     unit_tests/ref-output/eio_ascii_10.ref \
     unit_tests/ref-output/eio_ascii_11.ref \
     unit_tests/ref-output/eio_weights_1.ref \
     unit_tests/ref-output/eio_weights_2.ref \
     unit_tests/ref-output/eio_weights_3.ref \
     unit_tests/ref-output/eio_dump_1.ref \
     unit_tests/ref-output/iterations_1.ref \
     unit_tests/ref-output/iterations_2.ref \
     unit_tests/ref-output/rt_data_1.ref \
     unit_tests/ref-output/rt_data_2.ref \
     unit_tests/ref-output/rt_data_3.ref \
     unit_tests/ref-output/rt_data_4.ref \
     unit_tests/ref-output/rt_data_5.ref \
     unit_tests/ref-output/rt_data_6.ref \
     unit_tests/ref-output/rt_data_7.ref \
     unit_tests/ref-output/rt_data_8.ref \
     unit_tests/ref-output/rt_data_9.ref \
     unit_tests/ref-output/rt_data_10.ref \
     unit_tests/ref-output/rt_data_11.ref \
     unit_tests/ref-output/dispatch_1.ref \
     unit_tests/ref-output/dispatch_2.ref \
     unit_tests/ref-output/dispatch_7.ref \
     unit_tests/ref-output/dispatch_8.ref \
     unit_tests/ref-output/dispatch_10.ref \
     unit_tests/ref-output/dispatch_11.ref \
     unit_tests/ref-output/dispatch_rng_1.ref \
     unit_tests/ref-output/dispatch_phs_1.ref \
     unit_tests/ref-output/dispatch_phs_2.ref \
     unit_tests/ref-output/dispatch_mci_1.ref \
     unit_tests/ref-output/dispatch_transforms_1.ref \
     unit_tests/ref-output/dispatch_transforms_2.ref \
     unit_tests/ref-output/process_configurations_1.ref \
     unit_tests/ref-output/process_configurations_2.ref \
     unit_tests/ref-output/event_streams_1.ref \
     unit_tests/ref-output/event_streams_2.ref \
     unit_tests/ref-output/event_streams_3.ref \
     unit_tests/ref-output/event_streams_4.ref \
     unit_tests/ref-output/compilations_1.ref \
     unit_tests/ref-output/compilations_2.ref \
     unit_tests/ref-output/compilations_3.ref \
     unit_tests/ref-output/compilations_static_1.ref \
     unit_tests/ref-output/compilations_static_2.ref \
     unit_tests/ref-output/integrations_1.ref \
     unit_tests/ref-output/integrations_2.ref \
     unit_tests/ref-output/integrations_3.ref \
     unit_tests/ref-output/integrations_4.ref \
     unit_tests/ref-output/integrations_5.ref \
     unit_tests/ref-output/integrations_6.ref \
     unit_tests/ref-output/integrations_7.ref \
     unit_tests/ref-output/integrations_8.ref \
     unit_tests/ref-output/integrations_9.ref \
     unit_tests/ref-output/integrations_history_1.ref \
     unit_tests/ref-output/restricted_subprocesses_1.ref \
     unit_tests/ref-output/restricted_subprocesses_2.ref \
     unit_tests/ref-output/restricted_subprocesses_3.ref \
     unit_tests/ref-output/restricted_subprocesses_4.ref \
     unit_tests/ref-output/restricted_subprocesses_5.ref \
     unit_tests/ref-output/restricted_subprocesses_6.ref \
     unit_tests/ref-output/simulations_1.ref \
     unit_tests/ref-output/simulations_2.ref \
     unit_tests/ref-output/simulations_3.ref \
     unit_tests/ref-output/simulations_4.ref \
     unit_tests/ref-output/simulations_5.ref \
     unit_tests/ref-output/simulations_6.ref \
     unit_tests/ref-output/simulations_7.ref \
     unit_tests/ref-output/simulations_8.ref \
     unit_tests/ref-output/simulations_9.ref \
     unit_tests/ref-output/simulations_10.ref \
     unit_tests/ref-output/simulations_11.ref \
     unit_tests/ref-output/simulations_12.ref \
     unit_tests/ref-output/simulations_13.ref \
     unit_tests/ref-output/simulations_14.ref \
     unit_tests/ref-output/simulations_15.ref \
     unit_tests/ref-output/commands_1.ref \
     unit_tests/ref-output/commands_2.ref \
     unit_tests/ref-output/commands_3.ref \
     unit_tests/ref-output/commands_4.ref \
     unit_tests/ref-output/commands_5.ref \
     unit_tests/ref-output/commands_6.ref \
     unit_tests/ref-output/commands_7.ref \
     unit_tests/ref-output/commands_8.ref \
     unit_tests/ref-output/commands_9.ref \
     unit_tests/ref-output/commands_10.ref \
     unit_tests/ref-output/commands_11.ref \
     unit_tests/ref-output/commands_12.ref \
     unit_tests/ref-output/commands_13.ref \
     unit_tests/ref-output/commands_14.ref \
     unit_tests/ref-output/commands_15.ref \
     unit_tests/ref-output/commands_16.ref \
     unit_tests/ref-output/commands_17.ref \
     unit_tests/ref-output/commands_18.ref \
     unit_tests/ref-output/commands_19.ref \
     unit_tests/ref-output/commands_20.ref \
     unit_tests/ref-output/commands_21.ref \
     unit_tests/ref-output/commands_22.ref \
     unit_tests/ref-output/commands_23.ref \
     unit_tests/ref-output/commands_24.ref \
     unit_tests/ref-output/commands_25.ref \
     unit_tests/ref-output/commands_26.ref \
     unit_tests/ref-output/commands_27.ref \
     unit_tests/ref-output/commands_28.ref \
     unit_tests/ref-output/commands_29.ref \
     unit_tests/ref-output/commands_30.ref \
     unit_tests/ref-output/commands_31.ref \
     unit_tests/ref-output/commands_32.ref \
     unit_tests/ref-output/commands_33.ref \
     unit_tests/ref-output/commands_34.ref \
     unit_tests/ref-output/jets_1.ref \
     unit_tests/ref-output/hepmc2_interface_1.ref \
     unit_tests/ref-output/hepmc3_interface_1.ref \
     unit_tests/ref-output/lcio_interface_1.ref \
     unit_tests/ref-output/ttv_formfactors_1.ref \
     unit_tests/ref-output/ttv_formfactors_2.ref \
     unit_tests/ref-output/blha_1.ref \
     unit_tests/ref-output/blha_2.ref \
     unit_tests/ref-output/blha_3.ref \
     unit_tests/ref-output/whizard_lha_1.ref \
     functional_tests/ref-output/pack_1.ref \
     functional_tests/ref-output/structure_1.ref \
     functional_tests/ref-output/structure_2.ref \
     functional_tests/ref-output/structure_3.ref \
     functional_tests/ref-output/structure_4.ref \
     functional_tests/ref-output/structure_5.ref \
     functional_tests/ref-output/structure_6.ref \
     functional_tests/ref-output/structure_7.ref \
     functional_tests/ref-output/structure_8.ref \
     functional_tests/ref-output/vars.ref \
     functional_tests/ref-output/extpar.ref \
     functional_tests/ref-output/testproc_1.ref \
     functional_tests/ref-output/testproc_2.ref \
     functional_tests/ref-output/testproc_3.ref \
     functional_tests/ref-output/testproc_4.ref \
     functional_tests/ref-output/testproc_5.ref \
     functional_tests/ref-output/testproc_6.ref \
     functional_tests/ref-output/testproc_7.ref \
     functional_tests/ref-output/testproc_8.ref \
     functional_tests/ref-output/testproc_9.ref \
     functional_tests/ref-output/testproc_10.ref \
     functional_tests/ref-output/testproc_11.ref \
     functional_tests/ref-output/testproc_12.ref \
     functional_tests/ref-output/template_me_1.ref \
     functional_tests/ref-output/template_me_2.ref \
     functional_tests/ref-output/susyhit.ref \
     functional_tests/ref-output/restrictions.ref \
     functional_tests/ref-output/process_log.ref \
     functional_tests/ref-output/static_1.ref \
     functional_tests/ref-output/static_2.ref \
     functional_tests/ref-output/libraries_1.ref \
     functional_tests/ref-output/libraries_2.ref \
     functional_tests/ref-output/libraries_4.ref \
     functional_tests/ref-output/job_id_1.ref \
     functional_tests/ref-output/job_id_2.ref \
     functional_tests/ref-output/job_id_3.ref \
     functional_tests/ref-output/job_id_4.ref \
     functional_tests/ref-output/rebuild_2.ref \
     functional_tests/ref-output/rebuild_3.ref \
     functional_tests/ref-output/rebuild_4.ref \
     functional_tests/ref-output/fatal.ref \
     functional_tests/ref-output/cmdline_1.ref \
     functional_tests/ref-output/model_change_1.ref \
     functional_tests/ref-output/model_change_2.ref \
     functional_tests/ref-output/model_change_3.ref \
     functional_tests/ref-output/model_scheme_1.ref \
     functional_tests/ref-output/model_test.ref \
     functional_tests/ref-output/cuts.ref \
     functional_tests/ref-output/user_cuts.ref \
     functional_tests/ref-output/user_prc_threshold_1.ref \
     functional_tests/ref-output/user_prc_threshold_2.ref \
     functional_tests/ref-output/qedtest_1.ref \
     functional_tests/ref-output/qedtest_2.ref \
     functional_tests/ref-output/qedtest_5.ref \
     functional_tests/ref-output/qedtest_6.ref \
     functional_tests/ref-output/qedtest_7.ref \
     functional_tests/ref-output/qedtest_8.ref \
     functional_tests/ref-output/qedtest_9.ref \
     functional_tests/ref-output/qedtest_10.ref \
     functional_tests/ref-output/qcdtest_4.ref \
     functional_tests/ref-output/qcdtest_5.ref \
     functional_tests/ref-output/qcdtest_6.ref \
     functional_tests/ref-output/rambo_vamp_1.ref \
     functional_tests/ref-output/rambo_vamp_2.ref \
     functional_tests/ref-output/beam_setup_1.ref \
     functional_tests/ref-output/beam_setup_2.ref \
     functional_tests/ref-output/beam_setup_3.ref \
     functional_tests/ref-output/beam_setup_4.ref \
     functional_tests/ref-output/observables_1.ref \
     functional_tests/ref-output/event_weights_1.ref \
     functional_tests/ref-output/event_weights_2.ref \
     functional_tests/ref-output/event_eff_1.ref \
     functional_tests/ref-output/event_eff_2.ref \
     functional_tests/ref-output/event_dump_1.ref \
     functional_tests/ref-output/event_dump_2.ref \
     functional_tests/ref-output/event_failed_1.ref \
     functional_tests/ref-output/reweight_1.ref \
     functional_tests/ref-output/reweight_2.ref \
     functional_tests/ref-output/reweight_3.ref \
     functional_tests/ref-output/reweight_4.ref \
     functional_tests/ref-output/reweight_5.ref \
     functional_tests/ref-output/reweight_6.ref \
     functional_tests/ref-output/reweight_7.ref \
     functional_tests/ref-output/reweight_8.ref \
     functional_tests/ref-output/reweight_9.ref \
     functional_tests/ref-output/reweight_10.ref \
     functional_tests/ref-output/analyze_1.ref \
     functional_tests/ref-output/analyze_2.ref \
     functional_tests/ref-output/analyze_3.ref \
     functional_tests/ref-output/analyze_4.ref \
     functional_tests/ref-output/analyze_5.ref \
     functional_tests/ref-output/analyze_6.ref \
     functional_tests/ref-output/bjet_cluster.ref \
     functional_tests/ref-output/colors.ref \
     functional_tests/ref-output/colors_hgg.ref \
     functional_tests/ref-output/alphas.ref \
     functional_tests/ref-output/jets_xsec.ref \
     functional_tests/ref-output/shower_err_1.ref \
     functional_tests/ref-output/parton_shower_1.ref \
     functional_tests/ref-output/pythia6_1.ref \
     functional_tests/ref-output/pythia6_2.ref \
     functional_tests/ref-output/hadronize_1.ref \
     functional_tests/ref-output/mlm_matching_fsr.ref \
     functional_tests/ref-output/mlm_pythia6_isr.ref \
     functional_tests/ref-output/hepmc_1.ref \
     functional_tests/ref-output/hepmc_2.ref \
     functional_tests/ref-output/hepmc_3.ref \
     functional_tests/ref-output/hepmc_4.ref \
     functional_tests/ref-output/hepmc_5.ref \
     functional_tests/ref-output/hepmc_6.ref \
     functional_tests/ref-output/hepmc_7.ref \
     functional_tests/ref-output/hepmc_9.ref \
     functional_tests/ref-output/hepmc_10.ref \
     functional_tests/ref-output/lhef_1.ref \
     functional_tests/ref-output/lhef_2.ref \
     functional_tests/ref-output/lhef_3.ref \
     functional_tests/ref-output/lhef_4.ref \
     functional_tests/ref-output/lhef_5.ref \
     functional_tests/ref-output/lhef_6.ref \
     functional_tests/ref-output/lhef_9.ref \
     functional_tests/ref-output/lhef_10.ref \
     functional_tests/ref-output/lhef_11.ref \
     functional_tests/ref-output/select_1.ref \
     functional_tests/ref-output/select_2.ref \
     functional_tests/ref-output/stdhep_1.ref \
     functional_tests/ref-output/stdhep_2.ref \
     functional_tests/ref-output/stdhep_3.ref \
     functional_tests/ref-output/stdhep_4.ref \
     functional_tests/ref-output/stdhep_5.ref \
     functional_tests/ref-output/stdhep_6.ref \
     functional_tests/ref-output/lcio_1.ref \
     functional_tests/ref-output/lcio_3.ref \
     functional_tests/ref-output/lcio_4.ref \
     functional_tests/ref-output/lcio_5.ref \
     functional_tests/ref-output/lcio_6.ref \
     functional_tests/ref-output/lcio_8.ref \
     functional_tests/ref-output/lcio_9.ref \
     functional_tests/ref-output/lcio_10.ref \
+    functional_tests/ref-output/lcio_11.ref \
     functional_tests/ref-output/fatal_beam_decay.ref \
     functional_tests/ref-output/smtest_1.ref \
     functional_tests/ref-output/smtest_3.ref \
     functional_tests/ref-output/smtest_4.ref \
     functional_tests/ref-output/smtest_5.ref \
     functional_tests/ref-output/smtest_6.ref \
     functional_tests/ref-output/smtest_7.ref \
     functional_tests/ref-output/smtest_9.ref \
     functional_tests/ref-output/smtest_10.ref \
     functional_tests/ref-output/smtest_11.ref \
     functional_tests/ref-output/smtest_12.ref \
     functional_tests/ref-output/smtest_13.ref \
     functional_tests/ref-output/smtest_14.ref \
     functional_tests/ref-output/smtest_15.ref \
     functional_tests/ref-output/smtest_16.ref \
     functional_tests/ref-output/photon_isolation_1.ref \
     functional_tests/ref-output/photon_isolation_2.ref \
     functional_tests/ref-output/sm_cms_1.ref \
     functional_tests/ref-output/resonances_5.ref \
     functional_tests/ref-output/resonances_6.ref \
     functional_tests/ref-output/resonances_7.ref \
     functional_tests/ref-output/resonances_8.ref \
     functional_tests/ref-output/resonances_9.ref \
     functional_tests/ref-output/resonances_12.ref \
     functional_tests/ref-output/ufo_1.ref \
     functional_tests/ref-output/ufo_2.ref \
     functional_tests/ref-output/ufo_3.ref \
     functional_tests/ref-output/ufo_4.ref \
     functional_tests/ref-output/ufo_5.ref \
     functional_tests/ref-output/nlo_1.ref \
     functional_tests/ref-output/nlo_2.ref \
     functional_tests/ref-output/nlo_6.ref \
     functional_tests/ref-output/real_partition_1.ref \
     functional_tests/ref-output/fks_res_2.ref \
     functional_tests/ref-output/openloops_1.ref \
     functional_tests/ref-output/openloops_2.ref \
     functional_tests/ref-output/openloops_4.ref \
     functional_tests/ref-output/openloops_5.ref \
     functional_tests/ref-output/openloops_6.ref \
     functional_tests/ref-output/openloops_7.ref \
     functional_tests/ref-output/openloops_8.ref \
     functional_tests/ref-output/openloops_9.ref \
     functional_tests/ref-output/openloops_10.ref \
     functional_tests/ref-output/openloops_11.ref \
     functional_tests/ref-output/openloops_12.ref \
     functional_tests/ref-output/openloops_13.ref \
     functional_tests/ref-output/recola_1.ref \
     functional_tests/ref-output/recola_2.ref \
     functional_tests/ref-output/recola_3.ref \
     functional_tests/ref-output/recola_4.ref \
     functional_tests/ref-output/recola_5.ref \
     functional_tests/ref-output/recola_6.ref \
     functional_tests/ref-output/recola_7.ref \
     functional_tests/ref-output/recola_8.ref \
     functional_tests/ref-output/recola_9.ref \
     functional_tests/ref-output/nlo_decay_1.ref \
     functional_tests/ref-output/mssmtest_1.ref \
     functional_tests/ref-output/mssmtest_2.ref \
     functional_tests/ref-output/mssmtest_3.ref \
     functional_tests/ref-output/spincor_1.ref \
     functional_tests/ref-output/show_1.ref \
     functional_tests/ref-output/show_2.ref \
     functional_tests/ref-output/show_3.ref \
     functional_tests/ref-output/show_4.ref \
     functional_tests/ref-output/show_5.ref \
     functional_tests/ref-output/method_ovm_1.ref \
     functional_tests/ref-output/multi_comp_4.ref \
     functional_tests/ref-output/flvsum_1.ref \
     functional_tests/ref-output/br_redef_1.ref \
     functional_tests/ref-output/decay_err_1.ref \
     functional_tests/ref-output/decay_err_2.ref \
     functional_tests/ref-output/decay_err_3.ref \
     functional_tests/ref-output/polarized_1.ref \
     functional_tests/ref-output/circe1_1.ref \
     functional_tests/ref-output/circe1_2.ref \
     functional_tests/ref-output/circe1_3.ref \
     functional_tests/ref-output/circe1_6.ref \
     functional_tests/ref-output/circe1_10.ref \
     functional_tests/ref-output/circe1_errors_1.ref \
     functional_tests/ref-output/circe2_1.ref \
     functional_tests/ref-output/circe2_2.ref \
     functional_tests/ref-output/circe2_3.ref \
     functional_tests/ref-output/isr_1.ref \
     functional_tests/ref-output/epa_1.ref \
     functional_tests/ref-output/epa_2.ref \
     functional_tests/ref-output/epa_3.ref \
     functional_tests/ref-output/isr_epa_1.ref \
     functional_tests/ref-output/ep_3.ref \
     functional_tests/ref-output/ewa_4.ref \
     functional_tests/ref-output/gaussian_1.ref \
     functional_tests/ref-output/gaussian_2.ref \
     functional_tests/ref-output/beam_events_1.ref \
     functional_tests/ref-output/beam_events_4.ref \
     functional_tests/ref-output/energy_scan_1.ref \
     functional_tests/ref-output/cascades2_phs_1.ref \
     functional_tests/ref-output/vamp2_1.ref \
     functional_tests/ref-output/vamp2_2.ref \
     ext_tests_nlo/ref-output/nlo_ee4j.ref \
     ext_tests_nlo/ref-output/nlo_ee4t.ref \
     ext_tests_nlo/ref-output/nlo_ee5j.ref \
     ext_tests_nlo/ref-output/nlo_eejj.ref \
     ext_tests_nlo/ref-output/nlo_eejjj.ref \
     ext_tests_nlo/ref-output/nlo_eett.ref \
     ext_tests_nlo/ref-output/nlo_eetth.ref \
     ext_tests_nlo/ref-output/nlo_eetthh.ref \
     ext_tests_nlo/ref-output/nlo_eetthj.ref \
     ext_tests_nlo/ref-output/nlo_eetthz.ref \
     ext_tests_nlo/ref-output/nlo_eettwjj.ref \
     ext_tests_nlo/ref-output/nlo_eettww.ref \
     ext_tests_nlo/ref-output/nlo_eettz.ref \
     ext_tests_nlo/ref-output/nlo_eettzj.ref \
     ext_tests_nlo/ref-output/nlo_eettzjj.ref \
     ext_tests_nlo/ref-output/nlo_eettzz.ref \
     ext_tests_nlo/ref-output/nlo_pptttt.ref \
     ext_tests_nlo/ref-output/nlo_ppz.ref \
     ext_tests_nlo/ref-output/nlo_ppw.ref \
     ext_tests_nlo/ref-output/nlo_ppzw.ref \
     ext_tests_nlo/ref-output/nlo_ppzz.ref
 
 # Reference files that depend on the numerical precision
 REF_OUTPUT_FILES_DOUBLE = \
     functional_tests/ref-output-double/qedtest_3.ref \
     functional_tests/ref-output-double/qedtest_4.ref \
     functional_tests/ref-output-double/qcdtest_1.ref \
     functional_tests/ref-output-double/qcdtest_2.ref \
     functional_tests/ref-output-double/qcdtest_3.ref \
     functional_tests/ref-output-double/smtest_2.ref \
     functional_tests/ref-output-double/smtest_8.ref \
     functional_tests/ref-output-double/observables_2.ref \
     functional_tests/ref-output-double/colors_2.ref \
     functional_tests/ref-output-double/resonances_1.ref \
     functional_tests/ref-output-double/resonances_2.ref \
     functional_tests/ref-output-double/resonances_3.ref \
     functional_tests/ref-output-double/resonances_4.ref \
     functional_tests/ref-output-double/resonances_10.ref \
     functional_tests/ref-output-double/resonances_11.ref \
     functional_tests/ref-output-double/beam_setup_5.ref \
     functional_tests/ref-output-double/nlo_3.ref \
     functional_tests/ref-output-double/nlo_4.ref \
     functional_tests/ref-output-double/nlo_5.ref \
     functional_tests/ref-output-double/fks_res_1.ref \
     functional_tests/ref-output-double/fks_res_3.ref \
     functional_tests/ref-output-double/openloops_3.ref \
     functional_tests/ref-output-double/powheg_1.ref \
     functional_tests/ref-output-double/defaultcuts.ref \
     functional_tests/ref-output-double/parton_shower_2.ref \
     functional_tests/ref-output-double/helicity.ref \
     functional_tests/ref-output-double/lhef_7.ref \
     functional_tests/ref-output-double/hepmc_8.ref \
     functional_tests/ref-output-double/lcio_2.ref \
     functional_tests/ref-output-double/lcio_7.ref \
     functional_tests/ref-output-double/multi_comp_1.ref \
     functional_tests/ref-output-double/multi_comp_2.ref \
     functional_tests/ref-output-double/multi_comp_3.ref \
     functional_tests/ref-output-double/pdf_builtin.ref \
     functional_tests/ref-output-double/lhapdf5.ref \
     functional_tests/ref-output-double/lhapdf6.ref \
     functional_tests/ref-output-double/ep_1.ref \
     functional_tests/ref-output-double/ep_2.ref \
     functional_tests/ref-output-double/circe1_4.ref \
     functional_tests/ref-output-double/circe1_5.ref \
     functional_tests/ref-output-double/circe1_7.ref \
     functional_tests/ref-output-double/circe1_8.ref \
     functional_tests/ref-output-double/circe1_9.ref \
     functional_tests/ref-output-double/circe1_photons_1.ref \
     functional_tests/ref-output-double/circe1_photons_2.ref \
     functional_tests/ref-output-double/circe1_photons_3.ref \
     functional_tests/ref-output-double/circe1_photons_4.ref \
     functional_tests/ref-output-double/circe1_photons_5.ref \
     functional_tests/ref-output-double/isr_2.ref \
     functional_tests/ref-output-double/isr_3.ref \
     functional_tests/ref-output-double/isr_4.ref \
     functional_tests/ref-output-double/isr_5.ref \
     functional_tests/ref-output-double/pythia6_3.ref \
     functional_tests/ref-output-double/pythia6_4.ref \
     functional_tests/ref-output-double/tauola_1.ref \
     functional_tests/ref-output-double/tauola_2.ref \
     functional_tests/ref-output-double/mlm_matching_isr.ref \
     functional_tests/ref-output-double/ewa_1.ref \
     functional_tests/ref-output-double/ewa_2.ref \
     functional_tests/ref-output-double/ewa_3.ref \
     functional_tests/ref-output-double/ilc.ref \
     functional_tests/ref-output-double/beam_events_2.ref \
     functional_tests/ref-output-double/beam_events_3.ref
 
 REF_OUTPUT_FILES_PREC = \
     functional_tests/ref-output-prec/qedtest_3.ref \
     functional_tests/ref-output-prec/qedtest_4.ref \
     functional_tests/ref-output-prec/qcdtest_1.ref \
     functional_tests/ref-output-prec/qcdtest_2.ref \
     functional_tests/ref-output-prec/qcdtest_3.ref \
     functional_tests/ref-output-prec/smtest_2.ref \
     functional_tests/ref-output-prec/smtest_8.ref \
     functional_tests/ref-output-prec/colors_2.ref \
     functional_tests/ref-output-prec/beam_setup_5.ref \
     functional_tests/ref-output-prec/nlo_3.ref \
     functional_tests/ref-output-prec/nlo_4.ref \
     functional_tests/ref-output-prec/fks_res_1.ref \
     functional_tests/ref-output-prec/fks_res_3.ref \
     functional_tests/ref-output-prec/openloops_3.ref \
     functional_tests/ref-output-prec/defaultcuts.ref \
     functional_tests/ref-output-prec/parton_shower_2.ref \
     functional_tests/ref-output-prec/helicity.ref \
     functional_tests/ref-output-prec/lhef_7.ref \
     functional_tests/ref-output-prec/multi_comp_1.ref \
     functional_tests/ref-output-prec/multi_comp_2.ref \
     functional_tests/ref-output-prec/multi_comp_3.ref \
     functional_tests/ref-output-prec/pdf_builtin.ref \
     functional_tests/ref-output-prec/lhapdf5.ref \
     functional_tests/ref-output-prec/lhapdf6.ref \
     functional_tests/ref-output-prec/ep_1.ref \
     functional_tests/ref-output-prec/ep_2.ref \
     functional_tests/ref-output-prec/ilc.ref \
     functional_tests/ref-output-prec/circe1_9.ref \
     functional_tests/ref-output-prec/circe1_photons_1.ref \
     functional_tests/ref-output-prec/circe1_photons_2.ref \
     functional_tests/ref-output-prec/circe1_photons_3.ref \
     functional_tests/ref-output-prec/circe1_photons_4.ref \
     functional_tests/ref-output-prec/circe1_photons_5.ref \
     functional_tests/ref-output-prec/ewa_1.ref
 
 REF_OUTPUT_FILES_EXT = \
     functional_tests/ref-output-ext/observables_2.ref \
     functional_tests/ref-output-ext/resonances_1.ref \
     functional_tests/ref-output-ext/resonances_2.ref \
     functional_tests/ref-output-ext/resonances_3.ref \
     functional_tests/ref-output-ext/resonances_4.ref \
     functional_tests/ref-output-ext/resonances_10.ref \
     functional_tests/ref-output-ext/resonances_11.ref \
     functional_tests/ref-output-ext/circe1_4.ref \
     functional_tests/ref-output-ext/circe1_5.ref \
     functional_tests/ref-output-ext/circe1_7.ref \
     functional_tests/ref-output-ext/circe1_8.ref \
     functional_tests/ref-output-ext/isr_2.ref \
     functional_tests/ref-output-ext/isr_3.ref \
     functional_tests/ref-output-ext/isr_4.ref \
     functional_tests/ref-output-ext/isr_5.ref \
     functional_tests/ref-output-ext/nlo_5.ref \
     functional_tests/ref-output-ext/powheg_1.ref \
     functional_tests/ref-output-ext/pythia6_3.ref \
     functional_tests/ref-output-ext/pythia6_4.ref \
     functional_tests/ref-output-ext/tauola_1.ref \
     functional_tests/ref-output-ext/tauola_2.ref \
     functional_tests/ref-output-ext/ewa_2.ref \
     functional_tests/ref-output-ext/ewa_3.ref \
     functional_tests/ref-output-ext/beam_events_2.ref \
     functional_tests/ref-output-ext/beam_events_3.ref \
     functional_tests/ref-output-ext/mlm_matching_isr.ref \
     functional_tests/ref-output-ext/hepmc_8.ref \
     functional_tests/ref-output-ext/lcio_2.ref \
     functional_tests/ref-output-ext/lcio_7.ref
 
 REF_OUTPUT_FILES_QUAD = \
     functional_tests/ref-output-quad/observables_2.ref \
     functional_tests/ref-output-quad/resonances_1.ref \
     functional_tests/ref-output-quad/resonances_2.ref \
     functional_tests/ref-output-quad/resonances_3.ref \
     functional_tests/ref-output-quad/resonances_4.ref \
     functional_tests/ref-output-quad/resonances_10.ref \
     functional_tests/ref-output-quad/resonances_11.ref \
     functional_tests/ref-output-quad/circe1_4.ref \
     functional_tests/ref-output-quad/circe1_5.ref \
     functional_tests/ref-output-quad/circe1_7.ref \
     functional_tests/ref-output-quad/circe1_8.ref \
     functional_tests/ref-output-quad/isr_2.ref \
     functional_tests/ref-output-quad/isr_3.ref \
     functional_tests/ref-output-quad/isr_4.ref \
     functional_tests/ref-output-quad/isr_5.ref \
     functional_tests/ref-output-quad/nlo_5.ref \
     functional_tests/ref-output-quad/powheg_1.ref \
     functional_tests/ref-output-quad/pythia6_3.ref \
     functional_tests/ref-output-quad/pythia6_4.ref \
     functional_tests/ref-output-quad/tauola_1.ref \
     functional_tests/ref-output-quad/tauola_2.ref \
     functional_tests/ref-output-quad/ewa_2.ref \
     functional_tests/ref-output-quad/ewa_3.ref \
     functional_tests/ref-output-quad/beam_events_2.ref \
     functional_tests/ref-output-quad/beam_events_3.ref \
     functional_tests/ref-output-quad/mlm_matching_isr.ref \
     functional_tests/ref-output-quad/hepmc_8.ref \
     functional_tests/ref-output-quad/lcio_2.ref \
     functional_tests/ref-output-quad/lcio_7.ref
 
 TESTSUITES_M4 = \
     $(MISC_TESTS_M4) \
     $(EXT_MSSM_M4) \
     $(EXT_NMSSM_M4)
 
 TESTSUITES_SIN = \
     $(MISC_TESTS_SIN) \
     $(EXT_ILC_SIN) \
     $(EXT_MSSM_SIN) \
     $(EXT_NMSSM_SIN) \
     $(EXT_SHOWER_SIN) \
     $(EXT_NLO_SIN) \
     $(EXT_NLO_ADD_SIN)
 
 
 MISC_TESTS_M4 =
 
 MISC_TESTS_SIN = \
     functional_tests/empty.sin \
     functional_tests/fatal.sin \
     functional_tests/cmdline_1_a.sin \
     functional_tests/cmdline_1_b.sin \
     functional_tests/cmdline_1.sin \
     functional_tests/pack_1.sin \
     functional_tests/defaultcuts.sin \
     functional_tests/cuts.sin \
     functional_tests/model_change_1.sin \
     functional_tests/model_change_2.sin \
     functional_tests/model_change_3.sin \
     functional_tests/model_scheme_1.sin \
     functional_tests/model_test.sin \
     functional_tests/structure_1.sin \
     functional_tests/structure_2.sin \
     functional_tests/structure_3.sin \
     functional_tests/structure_4.sin \
     functional_tests/structure_5.sin \
     functional_tests/structure_6.sin \
     functional_tests/structure_7.sin \
     functional_tests/structure_8.sin \
     functional_tests/vars.sin \
     functional_tests/extpar.sin \
     functional_tests/testproc_1.sin \
     functional_tests/testproc_2.sin \
     functional_tests/testproc_3.sin \
     functional_tests/testproc_4.sin \
     functional_tests/testproc_5.sin \
     functional_tests/testproc_6.sin \
     functional_tests/testproc_7.sin \
     functional_tests/testproc_8.sin \
     functional_tests/testproc_9.sin \
     functional_tests/testproc_10.sin \
     functional_tests/testproc_11.sin \
     functional_tests/testproc_12.sin \
     functional_tests/template_me_1.sin \
     functional_tests/template_me_2.sin \
     functional_tests/libraries_1.sin \
     functional_tests/libraries_2.sin \
     functional_tests/libraries_3.sin \
     functional_tests/libraries_4.sin \
     functional_tests/job_id_1.sin \
     functional_tests/job_id_2.sin \
     functional_tests/job_id_3.sin \
     functional_tests/job_id_4.sin \
     functional_tests/rebuild_1.sin \
     functional_tests/rebuild_2.sin \
     functional_tests/rebuild_3.sin \
     functional_tests/rebuild_4.sin \
     functional_tests/rebuild_5.sin \
     functional_tests/qedtest_1.sin \
     functional_tests/qedtest_2.sin \
     functional_tests/qedtest_3.sin \
     functional_tests/qedtest_4.sin \
     functional_tests/qedtest_5.sin \
     functional_tests/qedtest_6.sin \
     functional_tests/qedtest_7.sin \
     functional_tests/qedtest_8.sin \
     functional_tests/qedtest_9.sin \
     functional_tests/qedtest_10.sin \
     functional_tests/rambo_vamp_1.sin \
     functional_tests/rambo_vamp_2.sin \
     functional_tests/beam_setup_1.sin \
     functional_tests/beam_setup_2.sin \
     functional_tests/beam_setup_3.sin \
     functional_tests/beam_setup_4.sin \
     functional_tests/beam_setup_5.sin \
     functional_tests/qcdtest_1.sin \
     functional_tests/qcdtest_2.sin \
     functional_tests/qcdtest_3.sin \
     functional_tests/qcdtest_4.sin \
     functional_tests/qcdtest_5.sin \
     functional_tests/qcdtest_6.sin \
     functional_tests/observables_1.sin \
     functional_tests/observables_2.sin \
     functional_tests/event_weights_1.sin \
     functional_tests/event_weights_2.sin \
     functional_tests/event_eff_1.sin \
     functional_tests/event_eff_2.sin \
     functional_tests/event_dump_1.sin \
     functional_tests/event_dump_2.sin \
     functional_tests/event_failed_1.sin \
     functional_tests/reweight_1.sin \
     functional_tests/reweight_2.sin \
     functional_tests/reweight_3.sin \
     functional_tests/reweight_4.sin \
     functional_tests/reweight_5.sin \
     functional_tests/reweight_6.sin \
     functional_tests/reweight_7.sin \
     functional_tests/reweight_8.sin \
     functional_tests/reweight_9.sin \
     functional_tests/reweight_10.sin \
     functional_tests/analyze_1.sin \
     functional_tests/analyze_2.sin \
     functional_tests/analyze_3.sin \
     functional_tests/analyze_4.sin \
     functional_tests/analyze_5.sin \
     functional_tests/analyze_6.sin \
     functional_tests/bjet_cluster.sin \
     functional_tests/colors.sin \
     functional_tests/colors_2.sin \
     functional_tests/colors_hgg.sin \
     functional_tests/alphas.sin \
     functional_tests/jets_xsec.sin \
     functional_tests/lhef_1.sin \
     functional_tests/lhef_2.sin \
     functional_tests/lhef_3.sin \
     functional_tests/lhef_4.sin \
     functional_tests/lhef_5.sin \
     functional_tests/lhef_6.sin \
     functional_tests/lhef_7.sin \
     functional_tests/lhef_8.sin \
     functional_tests/lhef_9.sin \
     functional_tests/lhef_10.sin \
     functional_tests/lhef_11.sin \
     functional_tests/select_1.sin \
     functional_tests/select_2.sin \
     functional_tests/shower_err_1.sin \
     functional_tests/parton_shower_1.sin \
     functional_tests/parton_shower_2.sin \
     functional_tests/pythia6_1.sin \
     functional_tests/pythia6_2.sin \
     functional_tests/pythia6_3.sin \
     functional_tests/pythia6_4.sin \
     functional_tests/pythia8_1.sin \
     functional_tests/pythia8_2.sin \
     functional_tests/hadronize_1.sin \
     functional_tests/tauola_1.sin \
     functional_tests/tauola_2.sin \
     functional_tests/mlm_matching_fsr.sin \
     functional_tests/mlm_matching_isr.sin \
     functional_tests/mlm_pythia6_isr.sin \
     functional_tests/hepmc_1.sin \
     functional_tests/hepmc_2.sin \
     functional_tests/hepmc_3.sin \
     functional_tests/hepmc_4.sin \
     functional_tests/hepmc_5.sin \
     functional_tests/hepmc_6.sin \
     functional_tests/hepmc_7.sin \
     functional_tests/hepmc_8.sin \
     functional_tests/hepmc_9.sin \
     functional_tests/hepmc_10.sin \
     functional_tests/stdhep_1.sin \
     functional_tests/stdhep_2.sin \
     functional_tests/stdhep_3.sin \
     functional_tests/stdhep_4.sin \
     functional_tests/stdhep_5.sin \
     functional_tests/stdhep_6.sin \
     functional_tests/lcio_1.sin \
     functional_tests/lcio_2.sin \
     functional_tests/lcio_3.sin \
     functional_tests/lcio_4.sin \
     functional_tests/lcio_5.sin \
     functional_tests/lcio_6.sin \
     functional_tests/lcio_7.sin \
     functional_tests/lcio_8.sin \
     functional_tests/lcio_9.sin \
     functional_tests/lcio_10.sin \
+    functional_tests/lcio_11.sin \
     functional_tests/fatal_beam_decay.sin \
     functional_tests/smtest_1.sin \
     functional_tests/smtest_2.sin \
     functional_tests/smtest_3.sin \
     functional_tests/smtest_4.sin \
     functional_tests/smtest_5.sin \
     functional_tests/smtest_6.sin \
     functional_tests/smtest_7.sin \
     functional_tests/smtest_8.sin \
     functional_tests/smtest_9.sin \
     functional_tests/smtest_10.sin \
     functional_tests/smtest_11.sin \
     functional_tests/smtest_12.sin \
     functional_tests/smtest_13.sin \
     functional_tests/smtest_14.sin \
     functional_tests/smtest_15.sin \
     functional_tests/smtest_16.sin \
     functional_tests/photon_isolation_1.sin \
     functional_tests/photon_isolation_2.sin \
     functional_tests/resonances_1.sin \
     functional_tests/resonances_2.sin \
     functional_tests/resonances_3.sin \
     functional_tests/resonances_4.sin \
     functional_tests/resonances_5.sin \
     functional_tests/resonances_6.sin \
     functional_tests/resonances_7.sin \
     functional_tests/resonances_8.sin \
     functional_tests/resonances_9.sin \
     functional_tests/resonances_10.sin \
     functional_tests/resonances_11.sin \
     functional_tests/resonances_12.sin \
     functional_tests/sm_cms_1.sin \
     functional_tests/ufo_1.sin \
     functional_tests/ufo_2.sin \
     functional_tests/ufo_3.sin \
     functional_tests/ufo_4.sin \
     functional_tests/ufo_5.sin \
     functional_tests/nlo_1.sin \
     functional_tests/nlo_2.sin \
     functional_tests/nlo_3.sin \
     functional_tests/nlo_4.sin \
     functional_tests/nlo_5.sin \
     functional_tests/nlo_6.sin \
     functional_tests/nlo_decay_1.sin \
     functional_tests/real_partition_1.sin \
     functional_tests/fks_res_1.sin \
     functional_tests/fks_res_2.sin \
     functional_tests/fks_res_3.sin \
     functional_tests/openloops_1.sin \
     functional_tests/openloops_2.sin \
     functional_tests/openloops_3.sin \
     functional_tests/openloops_4.sin \
     functional_tests/openloops_5.sin \
     functional_tests/openloops_6.sin \
     functional_tests/openloops_7.sin \
     functional_tests/openloops_8.sin \
     functional_tests/openloops_9.sin \
     functional_tests/openloops_10.sin \
     functional_tests/openloops_11.sin \
     functional_tests/openloops_12.sin \
     functional_tests/openloops_13.sin \
     functional_tests/recola_1.sin \
     functional_tests/recola_2.sin \
     functional_tests/recola_3.sin \
     functional_tests/recola_4.sin \
     functional_tests/recola_5.sin \
     functional_tests/recola_6.sin \
     functional_tests/recola_7.sin \
     functional_tests/recola_8.sin \
     functional_tests/recola_9.sin \
     functional_tests/powheg_1.sin \
     functional_tests/mssmtest_1.sin \
     functional_tests/mssmtest_2.sin \
     functional_tests/mssmtest_3.sin \
     functional_tests/spincor_1.sin \
     functional_tests/show_1.sin \
     functional_tests/show_2.sin \
     functional_tests/show_3.sin \
     functional_tests/show_4.sin \
     functional_tests/show_5.sin \
     functional_tests/method_ovm_1.sin \
     functional_tests/multi_comp_1.sin \
     functional_tests/multi_comp_2.sin \
     functional_tests/multi_comp_3.sin \
     functional_tests/multi_comp_4.sin \
     functional_tests/flvsum_1.sin \
     functional_tests/br_redef_1.sin \
     functional_tests/decay_err_1.sin \
     functional_tests/decay_err_2.sin \
     functional_tests/decay_err_3.sin \
     functional_tests/polarized_1.sin \
     functional_tests/pdf_builtin.sin \
     functional_tests/lhapdf5.sin \
     functional_tests/lhapdf6.sin \
     functional_tests/ep_1.sin \
     functional_tests/ep_2.sin \
     functional_tests/ep_3.sin \
     functional_tests/circe1_1.sin \
     functional_tests/circe1_2.sin \
     functional_tests/circe1_3.sin \
     functional_tests/circe1_4.sin \
     functional_tests/circe1_5.sin \
     functional_tests/circe1_6.sin \
     functional_tests/circe1_7.sin \
     functional_tests/circe1_8.sin \
     functional_tests/circe1_9.sin \
     functional_tests/circe1_10.sin \
     functional_tests/circe1_photons_1.sin \
     functional_tests/circe1_photons_2.sin \
     functional_tests/circe1_photons_3.sin \
     functional_tests/circe1_photons_4.sin \
     functional_tests/circe1_photons_5.sin \
     functional_tests/circe1_errors_1.sin \
     functional_tests/circe2_1.sin \
     functional_tests/circe2_2.sin \
     functional_tests/circe2_3.sin \
     functional_tests/isr_1.sin \
     functional_tests/isr_2.sin \
     functional_tests/isr_3.sin \
     functional_tests/isr_4.sin \
     functional_tests/isr_5.sin \
     functional_tests/epa_1.sin \
     functional_tests/epa_2.sin \
     functional_tests/epa_3.sin \
     functional_tests/isr_epa_1.sin \
     functional_tests/ewa_1.sin \
     functional_tests/ewa_2.sin \
     functional_tests/ewa_3.sin \
     functional_tests/ewa_4.sin \
     functional_tests/ilc.sin \
     functional_tests/gaussian_1.sin \
     functional_tests/gaussian_2.sin \
     functional_tests/beam_events_1.sin \
     functional_tests/beam_events_2.sin \
     functional_tests/beam_events_3.sin \
     functional_tests/beam_events_4.sin \
     functional_tests/energy_scan_1.sin \
     functional_tests/susyhit.sin \
     functional_tests/restrictions.sin \
     functional_tests/helicity.sin \
     functional_tests/process_log.sin \
     functional_tests/static_1.sin \
     functional_tests/static_1.exe.sin \
     functional_tests/static_2.sin \
     functional_tests/static_2.exe.sin \
     functional_tests/user_cuts.sin \
     functional_tests/user_prc_threshold_1.sin \
     functional_tests/cascades2_phs_1.sin \
     functional_tests/user_prc_threshold_2.sin \
     functional_tests/vamp2_1.sin \
     functional_tests/vamp2_2.sin
 
 EXT_MSSM_M4 = \
     ext_tests_mssm/mssm_ext-ee.m4 \
     ext_tests_mssm/mssm_ext-ee2.m4 \
     ext_tests_mssm/mssm_ext-en.m4 \
     ext_tests_mssm/mssm_ext-tn.m4 \
     ext_tests_mssm/mssm_ext-uu.m4 \
     ext_tests_mssm/mssm_ext-uu2.m4 \
     ext_tests_mssm/mssm_ext-uuckm.m4 \
     ext_tests_mssm/mssm_ext-dd.m4 \
     ext_tests_mssm/mssm_ext-dd2.m4 \
     ext_tests_mssm/mssm_ext-ddckm.m4 \
     ext_tests_mssm/mssm_ext-bb.m4 \
     ext_tests_mssm/mssm_ext-bt.m4 \
     ext_tests_mssm/mssm_ext-tt.m4 \
     ext_tests_mssm/mssm_ext-ug.m4 \
     ext_tests_mssm/mssm_ext-dg.m4 \
     ext_tests_mssm/mssm_ext-aa.m4 \
     ext_tests_mssm/mssm_ext-wa.m4 \
     ext_tests_mssm/mssm_ext-za.m4 \
     ext_tests_mssm/mssm_ext-ww.m4 \
     ext_tests_mssm/mssm_ext-wz.m4 \
     ext_tests_mssm/mssm_ext-zz.m4 \
     ext_tests_mssm/mssm_ext-gg.m4 \
     ext_tests_mssm/mssm_ext-ga.m4 \
     ext_tests_mssm/mssm_ext-gw.m4 \
     ext_tests_mssm/mssm_ext-gz.m4
 
 EXT_NMSSM_M4 = \
     ext_tests_nmssm/nmssm_ext-aa.m4  \
     ext_tests_nmssm/nmssm_ext-bb1.m4 \
     ext_tests_nmssm/nmssm_ext-bb2.m4 \
     ext_tests_nmssm/nmssm_ext-bt.m4  \
     ext_tests_nmssm/nmssm_ext-dd1.m4 \
     ext_tests_nmssm/nmssm_ext-dd2.m4 \
     ext_tests_nmssm/nmssm_ext-ee1.m4 \
     ext_tests_nmssm/nmssm_ext-ee2.m4 \
     ext_tests_nmssm/nmssm_ext-en.m4  \
     ext_tests_nmssm/nmssm_ext-ga.m4  \
     ext_tests_nmssm/nmssm_ext-gg.m4  \
     ext_tests_nmssm/nmssm_ext-gw.m4  \
     ext_tests_nmssm/nmssm_ext-gz.m4  \
     ext_tests_nmssm/nmssm_ext-qg.m4  \
     ext_tests_nmssm/nmssm_ext-tn.m4  \
     ext_tests_nmssm/nmssm_ext-tt1.m4 \
     ext_tests_nmssm/nmssm_ext-tt2.m4 \
     ext_tests_nmssm/nmssm_ext-uu1.m4 \
     ext_tests_nmssm/nmssm_ext-uu2.m4 \
     ext_tests_nmssm/nmssm_ext-wa.m4  \
     ext_tests_nmssm/nmssm_ext-ww1.m4 \
     ext_tests_nmssm/nmssm_ext-ww2.m4 \
     ext_tests_nmssm/nmssm_ext-wz.m4  \
     ext_tests_nmssm/nmssm_ext-za.m4  \
     ext_tests_nmssm/nmssm_ext-zz1.m4 \
     ext_tests_nmssm/nmssm_ext-zz2.m4
 
 EXT_MSSM_SIN = $(EXT_MSSM_M4:.m4=.sin)
 EXT_NMSSM_SIN = $(EXT_NMSSM_M4:.m4=.sin)
 
 EXT_ILC_SIN = \
     ext_tests_ilc/ilc_ext.sin
 
 EXT_SHOWER_SIN = \
     ext_tests_shower/shower_1_norad.sin \
     ext_tests_shower/shower_2_aall.sin \
     ext_tests_shower/shower_3_bb.sin \
     ext_tests_shower/shower_3_jj.sin \
     ext_tests_shower/shower_3_qqqq.sin \
     ext_tests_shower/shower_3_tt.sin \
     ext_tests_shower/shower_3_z_nu.sin \
     ext_tests_shower/shower_3_z_tau.sin \
     ext_tests_shower/shower_4_ee.sin \
     ext_tests_shower/shower_5.sin \
     ext_tests_shower/shower_6.sin
 
 EXT_NLO_SIN = \
     ext_tests_nlo/nlo_settings.sin \
     ext_tests_nlo/nlo_eejj.sin \
     ext_tests_nlo/nlo_eejjj.sin \
     ext_tests_nlo/nlo_ee4j.sin \
     ext_tests_nlo/nlo_ee5j.sin \
     ext_tests_nlo/nlo_eebb.sin \
     ext_tests_nlo/nlo_eebbj.sin \
     ext_tests_nlo/nlo_eebbjj.sin \
     ext_tests_nlo/nlo_ee4b.sin \
     ext_tests_nlo/nlo_eett.sin \
     ext_tests_nlo/nlo_eettj.sin \
     ext_tests_nlo/nlo_eettjj.sin \
     ext_tests_nlo/nlo_eettjjj.sin \
     ext_tests_nlo/nlo_eettbb.sin \
     ext_tests_nlo/nlo_eetta.sin \
     ext_tests_nlo/nlo_eettaa.sin \
     ext_tests_nlo/nlo_eettaj.sin \
     ext_tests_nlo/nlo_eettajj.sin \
     ext_tests_nlo/nlo_eettaz.sin \
     ext_tests_nlo/nlo_eettah.sin \
     ext_tests_nlo/nlo_eettz.sin \
     ext_tests_nlo/nlo_eettzj.sin \
     ext_tests_nlo/nlo_eettzjj.sin \
     ext_tests_nlo/nlo_eettzz.sin \
     ext_tests_nlo/nlo_eettwjj.sin \
     ext_tests_nlo/nlo_eettww.sin \
     ext_tests_nlo/nlo_eetth.sin \
     ext_tests_nlo/nlo_eetthj.sin \
     ext_tests_nlo/nlo_eetthjj.sin \
     ext_tests_nlo/nlo_eetthh.sin \
     ext_tests_nlo/nlo_eetthz.sin \
     ext_tests_nlo/nlo_ee4t.sin \
     ext_tests_nlo/nlo_ee4tj.sin \
     ext_tests_nlo/nlo_ppz.sin \
     ext_tests_nlo/nlo_ppw.sin \
     ext_tests_nlo/nlo_ppzz.sin \
     ext_tests_nlo/nlo_ppzw.sin \
     ext_tests_nlo/nlo_pptttt.sin
 
 EXT_NLO_ADD_SIN = \
     ext_tests_nlo_add/nlo_decay_tbw.sin \
     ext_tests_nlo_add/nlo_tt.sin \
     ext_tests_nlo_add/nlo_tt_powheg.sin \
     ext_tests_nlo_add/nlo_tt_powheg_sudakov.sin \
     ext_tests_nlo_add/nlo_uu.sin \
     ext_tests_nlo_add/nlo_uu_powheg.sin \
     ext_tests_nlo_add/nlo_qq_powheg.sin \
     ext_tests_nlo_add/nlo_threshold.sin \
     ext_tests_nlo_add/nlo_threshold_factorized.sin \
     ext_tests_nlo_add/nlo_methods_gosam.sin \
     ext_tests_nlo_add/nlo_jets.sin \
     ext_tests_nlo_add/nlo_fks_delta_o_eejj.sin \
     ext_tests_nlo_add/nlo_fks_delta_i_ppee.sin
 
 all-local: $(TESTSUITES_SIN)
 
 if M4_AVAILABLE
 SUFFIXES = .m4 .sin
 .m4.sin:
 	case "$@" in \
 	*/*) \
 		mkdir -p `sed 's,/.[^/]*$$,,g' <<< "$@"` ;; \
 	esac
 	$(M4) $(srcdir)/$(TESTSUITE_MACROS) $< > $@
 endif M4_AVAILABLE