Index: trunk/src/whizard-core/whizard.nw
===================================================================
--- trunk/src/whizard-core/whizard.nw	(revision 8186)
+++ trunk/src/whizard-core/whizard.nw	(revision 8187)
@@ -1,31406 +1,31415 @@
 % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
 % WHIZARD main code as NOWEB source
 \includemodulegraph{whizard-core}
 \chapter{Integration and Simulation}
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{User-controlled File I/O}
 
 The SINDARIN language includes commands that write output to file (input may
 be added later).  We identify files by their name, and manage the unit
 internally.  We need procedures for opening, closing, and printing files.
 
 <<[[user_files.f90]]>>=
 <<File header>>
 
 module user_files
 
 <<Use strings>>
   use io_units
   use diagnostics
   use ifiles
   use analysis
 
 <<Standard module head>>
 
 <<User files: public>>
 
 <<User files: types>>
 
 <<User files: interfaces>>
 
 contains
 
 <<User files: procedures>>
 
 end module user_files
 @ %def user_files
 @
 \subsection{The file type}
 This is a type that describes an open user file and its properties.  The entry
 is part of a doubly-linked list.
 <<User files: types>>=
   type :: file_t
      private
      type(string_t) :: name
      integer :: unit = -1
      logical :: reading = .false.
      logical :: writing = .false.
      type(file_t), pointer :: prev => null ()
      type(file_t), pointer :: next => null ()
   end type file_t
 
 @ %def file_t
 @ The initializer opens the file.
 <<User files: procedures>>=
   subroutine file_init (file, name, action, status, position)
     type(file_t), intent(out) :: file
     type(string_t), intent(in) :: name
     character(len=*), intent(in) :: action, status, position
     file%unit = free_unit ()
     file%name = name
     open (unit = file%unit, file = char (file%name), &
           action = action, status = status, position = position)
     select case (action)
     case ("read")
        file%reading = .true.
     case ("write")
        file%writing = .true.
     case ("readwrite")
        file%reading = .true.
        file%writing = .true.
     end select
   end subroutine file_init
 
 @ %def file_init
 @ The finalizer closes it.
 <<User files: procedures>>=
   subroutine file_final (file)
     type(file_t), intent(inout) :: file
     close (unit = file%unit)
     file%unit = -1
   end subroutine file_final
 
 @ %def file_final
 @ Check if a file is open with correct status.
 <<User files: procedures>>=
   function file_is_open (file, action) result (flag)
     logical :: flag
     type(file_t), intent(in) :: file
     character(*), intent(in) :: action
     select case (action)
     case ("read")
        flag = file%reading
     case ("write")
        flag = file%writing
     case ("readwrite")
        flag = file%reading .and. file%writing
     case default
        call msg_bug ("Checking file '" // char (file%name) &
             // "': illegal action specifier")
     end select
   end function file_is_open
 
 @ %def file_is_open
 @ Return the unit number of a file for direct access.  It should be checked
 first whether the file is open.
 <<User files: procedures>>=
   function file_get_unit (file) result (unit)
     integer :: unit
     type(file_t), intent(in) :: file
     unit = file%unit
   end function file_get_unit
 
 @ %def file_get_unit
 @ Write to the file.  Error if in wrong mode.  If there is no string, just
 write an empty record.  If there is a string, respect the [[advancing]]
 option.
 <<User files: procedures>>=
   subroutine file_write_string (file, string, advancing)
     type(file_t), intent(in) :: file
     type(string_t), intent(in), optional :: string
     logical, intent(in), optional :: advancing
     if (file%writing) then
        if (present (string)) then
           if (present (advancing)) then
              if (advancing) then
                 write (file%unit, "(A)")  char (string)
              else
                 write (file%unit, "(A)", advance="no")  char (string)
              end if
           else
              write (file%unit, "(A)")  char (string)
           end if
        else
           write (file%unit, *)
        end if
     else
        call msg_error ("Writing to file: File '" // char (file%name) &
             // "' is not open for writing.")
     end if
   end subroutine file_write_string
 
 @ %def file_write
 @ Write a whole ifile, line by line.
 <<User files: procedures>>=
   subroutine file_write_ifile (file, ifile)
     type(file_t), intent(in) :: file
     type(ifile_t), intent(in) :: ifile
     type(line_p) :: line
     call line_init (line, ifile)
     do while (line_is_associated (line))
        call file_write_string (file, line_get_string_advance (line))
     end do
   end subroutine file_write_ifile
 
 @ %def file_write_ifile
 @ Write an analysis object (or all objects) to an open file.
 <<User files: procedures>>=
   subroutine file_write_analysis (file, tag)
     type(file_t), intent(in) :: file
     type(string_t), intent(in), optional :: tag
     if (file%writing) then
        if (present (tag)) then
           call analysis_write (tag, unit = file%unit)
        else
           call analysis_write (unit = file%unit)
        end if
     else
        call msg_error ("Writing analysis to file: File '" // char (file%name) &
             // "' is not open for writing.")
     end if
   end subroutine file_write_analysis
 
 @ %def file_write_analysis
 @
 \subsection{The file list}
 We maintain a list of all open files and their attributes.  The list must be
 doubly-linked because we may delete entries.
 <<User files: public>>=
   public :: file_list_t
 <<User files: types>>=
   type :: file_list_t
      type(file_t), pointer :: first => null ()
      type(file_t), pointer :: last => null ()
   end type file_list_t
 
 @ %def file_list_t
 @ There is no initialization routine, but a finalizer which deletes all:
 <<User files: public>>=
   public :: file_list_final
 <<User files: procedures>>=
   subroutine file_list_final (file_list)
     type(file_list_t), intent(inout) :: file_list
     type(file_t), pointer :: current
     do while (associated (file_list%first))
        current => file_list%first
        file_list%first => current%next
        call file_final (current)
        deallocate (current)
     end do
     file_list%last => null ()
   end subroutine file_list_final
 
 @ %def file_list_final
 @ Find an entry in the list.  Return null pointer on failure.
 <<User files: procedures>>=
   function file_list_get_file_ptr (file_list, name) result (current)
     type(file_t), pointer :: current
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     current => file_list%first
     do while (associated (current))
        if (current%name == name)  return
        current => current%next
     end do
   end function file_list_get_file_ptr
 
 @ %def file_list_get_file_ptr
 @ Check if a file is open, public version:
 <<User files: public>>=
   public :: file_list_is_open
 <<User files: procedures>>=
   function file_list_is_open (file_list, name, action) result (flag)
     logical :: flag
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     character(len=*), intent(in) :: action
     type(file_t), pointer :: current
     current => file_list_get_file_ptr (file_list, name)
     if (associated (current)) then
        flag = file_is_open (current, action)
     else
        flag = .false.
     end if
   end function file_list_is_open
 
 @ %def file_list_is_open
 @ Return the unit number for a file.  It should be checked first whether the
 file is open.
 <<User files: public>>=
   public :: file_list_get_unit
 <<User files: procedures>>=
   function file_list_get_unit (file_list, name) result (unit)
     integer :: unit
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     type(file_t), pointer :: current
     current => file_list_get_file_ptr (file_list, name)
     if (associated (current)) then
        unit = file_get_unit (current)
     else
        unit = -1
     end if
   end function file_list_get_unit
   
 @ %def file_list_get_unit
 @ Append a new file entry, i.e., open this file.  Error if it is
 already open.
 <<User files: public>>=
   public :: file_list_open
 <<User files: procedures>>=
   subroutine file_list_open (file_list, name, action, status, position)
     type(file_list_t), intent(inout) :: file_list
     type(string_t), intent(in) :: name
     character(len=*), intent(in) :: action, status, position
     type(file_t), pointer :: current
     if (.not. associated (file_list_get_file_ptr (file_list, name))) then
        allocate (current)
        call msg_message ("Opening file '" // char (name) // "' for output")
        call file_init (current, name, action, status, position)
        if (associated (file_list%last)) then
           file_list%last%next => current
           current%prev => file_list%last
        else
           file_list%first => current
        end if
        file_list%last => current
     else
        call msg_error ("Opening file: File '" // char (name) &
             // "' is already open.")
     end if
   end subroutine file_list_open
 
 @ %def file_list_open
 @ Delete a file entry, i.e., close this file.  Error if it is not open.
 <<User files: public>>=
   public :: file_list_close
 <<User files: procedures>>=
   subroutine file_list_close (file_list, name)
     type(file_list_t), intent(inout) :: file_list
     type(string_t), intent(in) :: name
     type(file_t), pointer :: current
     current => file_list_get_file_ptr (file_list, name)
     if (associated (current)) then
        if (associated (current%prev)) then
           current%prev%next => current%next
        else
           file_list%first => current%next
        end if
        if (associated (current%next)) then
           current%next%prev => current%prev
        else
           file_list%last => current%prev
        end if
        call msg_message ("Closing file '" // char (name) // "' for output")
        call file_final (current)
        deallocate (current)
     else
        call msg_error ("Closing file: File '" // char (name) &
             // "' is not open.")
     end if
   end subroutine file_list_close
 
 @ %def file_list_close
 @ Write a string to file.  Error if it is not open.
 <<User files: public>>=
   public :: file_list_write
 <<User files: interfaces>>=
   interface file_list_write
      module procedure file_list_write_string
      module procedure file_list_write_ifile
   end interface
 <<User files: procedures>>=
   subroutine file_list_write_string (file_list, name, string, advancing)
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: string
     logical, intent(in), optional :: advancing
     type(file_t), pointer :: current
     current => file_list_get_file_ptr (file_list, name)
     if (associated (current)) then
        call file_write_string (current, string, advancing)
     else
        call msg_error ("Writing to file: File '" // char (name) &
             // "'is not open.")
     end if
   end subroutine file_list_write_string
 
   subroutine file_list_write_ifile (file_list, name, ifile)
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     type(ifile_t), intent(in) :: ifile
     type(file_t), pointer :: current
     current => file_list_get_file_ptr (file_list, name)
     if (associated (current)) then
        call file_write_ifile (current, ifile)
     else
        call msg_error ("Writing to file: File '" // char (name) &
             // "'is not open.")
     end if
   end subroutine file_list_write_ifile
 
 @ %def file_list_write
 @ Write an analysis object or all objects to data file.  Error if it is not
 open.  If the file name is empty, write to standard output.
 <<User files: public>>=
   public :: file_list_write_analysis
 <<User files: procedures>>=
   subroutine file_list_write_analysis (file_list, name, tag)
     type(file_list_t), intent(in) :: file_list
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: tag
     type(file_t), pointer :: current
     if (name == "") then
        if (present (tag)) then
           call analysis_write (tag)
        else
           call analysis_write
        end if
     else
        current => file_list_get_file_ptr (file_list, name)
        if (associated (current)) then
           call file_write_analysis (current, tag)
        else
           call msg_error ("Writing analysis to file: File '" // char (name) &
                // "' is not open.")
        end if
     end if
   end subroutine file_list_write_analysis
 
 @ %def file_list_write_analysis
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Runtime data}
 
 <<[[rt_data.f90]]>>=
 <<File header>>
 
 module rt_data
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_utils, only: write_separator
   use format_defs, only: FMT_19, FMT_12
   use system_dependencies
   use diagnostics
   use os_interface
   use lexers
   use parser
   use models
   use subevents
   use pdg_arrays
   use variables, only: var_list_t
   use process_libraries
   use prclib_stacks
   use prc_core, only: helicity_selection_t
   use beam_structures
   use event_base, only: event_callback_t
   use user_files
   use process_stacks
   use iterations
 
 <<Standard module head>>
 
 <<RT data: public>>
 
 <<RT data: types>>
 
 contains
 
 <<RT data: procedures>>
 
 end module rt_data
 @ %def rt_data
 @
 \subsection{Strategy for models and variables}
 The program manages its data via a main [[rt_data_t]] object.  During program
 flow, various commands create and use local [[rt_data_t]] objects.  Those
 transient blocks contain either pointers to global object or local copies
 which are deleted after use.
 
 Each [[rt_data_t]] object contains a variable list component.  This lists
 holds (local copies of) all kinds of intrinsic or user-defined variables.  The
 variable list is linked to the variable list contained in the local process
 library.  This, in turn, is linked to the variable list of the [[rt_data_t]]
 context, and so on.
 
 A variable lookup will thus be recursively delegated to the linked variable
 lists, until a match is found.  When modifying a variable which is not yet
 local, the program creates a local copy and uses this afterwards.  Thus, when
 the local [[rt_data_t]] object is deleted, the context value is recovered.
 
 Models are kept in a model list which is separate from the variable list.
 Otherwise, they are treated in a similar manner: the local list is linked to
 the context model list.  Model lookup is thus recursively delegated.  When a
 model or any part of it is modified, the model is copied to the local
 [[rt_data_t]] object, so the context model is not modified.  Commands such as
 [[integrate]] will create their own copy of the current model (and of the
 current variable list) at the point where they are executed.
 
 When a model is encountered for the first time, it is read from file.  The
 reading is automatically delegated to the global context.  Thus, this master
 copy survives until the main [[rt_data_t]] object is deleted, at program
 completion.
 
 If there is a currently active model, its variable list is linked to the main
 variable list.  Variable lookups will then start from the model variable
 list.  When the current model is switched, the new active model will get this
 link instead.  Consequently, a change to the current model is kept as long as
 this model has a local copy; it survives local model switches.  On the other
 hand, a parameter change in the current model doesn't affect any other model,
 even if the parameter name is identical.
 @
 \subsection{Container for parse nodes}
 The runtime data set contains a bunch of parse nodes (chunks of code
 that have not been compiled into evaluation trees but saved for later
 use).  We collect them here.
 
 This implementation has the useful effect that an assignment between two
 objects of this type will establish a pointer-target relationship for
 all components.
 <<RT data: types>>=
   type :: rt_parse_nodes_t
      type(parse_node_t), pointer :: cuts_lexpr => null ()
      type(parse_node_t), pointer :: scale_expr => null ()
      type(parse_node_t), pointer :: fac_scale_expr => null ()
      type(parse_node_t), pointer :: ren_scale_expr => null ()
      type(parse_node_t), pointer :: weight_expr => null ()
      type(parse_node_t), pointer :: selection_lexpr => null ()
      type(parse_node_t), pointer :: reweight_expr => null ()
      type(parse_node_t), pointer :: analysis_lexpr => null ()
      type(parse_node_p), dimension(:), allocatable :: alt_setup
    contains
    <<RT data: rt parse nodes: TBP>>
   end type rt_parse_nodes_t
 
 @ %def rt_parse_nodes_t
 @ Clear individual components.  The parse nodes are nullified.  No
 finalization needed since the pointer targets are part of the global
 parse tree.
 <<RT data: rt parse nodes: TBP>>=
   procedure :: clear => rt_parse_nodes_clear
 <<RT data: procedures>>=
   subroutine rt_parse_nodes_clear (rt_pn, name)
     class(rt_parse_nodes_t), intent(inout) :: rt_pn
     type(string_t), intent(in) :: name
     select case (char (name))
     case ("cuts")
        rt_pn%cuts_lexpr => null ()
     case ("scale")
        rt_pn%scale_expr => null ()
     case ("factorization_scale")
        rt_pn%fac_scale_expr => null ()
     case ("renormalization_scale")
        rt_pn%ren_scale_expr => null ()
     case ("weight")
        rt_pn%weight_expr => null ()
     case ("selection")
        rt_pn%selection_lexpr => null ()
     case ("reweight")
        rt_pn%reweight_expr => null ()
     case ("analysis")
        rt_pn%analysis_lexpr => null ()
     end select
   end subroutine rt_parse_nodes_clear
 
 @ %def rt_parse_nodes_clear
 @ Output for the parse nodes.
 <<RT data: rt parse nodes: TBP>>=
   procedure :: write => rt_parse_nodes_write
 <<RT data: procedures>>=
   subroutine rt_parse_nodes_write (object, unit)
     class(rt_parse_nodes_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     call wrt ("Cuts", object%cuts_lexpr)
     call write_separator (u)
     call wrt ("Scale", object%scale_expr)
     call write_separator (u)
     call wrt ("Factorization scale", object%fac_scale_expr)
     call write_separator (u)
     call wrt ("Renormalization scale", object%ren_scale_expr)
     call write_separator (u)
     call wrt ("Weight", object%weight_expr)
     call write_separator (u, 2)
     call wrt ("Event selection", object%selection_lexpr)
     call write_separator (u)
     call wrt ("Event reweighting factor", object%reweight_expr)
     call write_separator (u)
     call wrt ("Event analysis", object%analysis_lexpr)
     if (allocated (object%alt_setup)) then
        call write_separator (u, 2)
        write (u, "(1x,A,':')")  "Alternative setups"
        do i = 1, size (object%alt_setup)
           call write_separator (u)
           call wrt ("Commands", object%alt_setup(i)%ptr)
        end do
     end if
   contains
     subroutine wrt (title, pn)
       character(*), intent(in) :: title
       type(parse_node_t), intent(in), pointer :: pn
       if (associated (pn)) then
          write (u, "(1x,A,':')")  title
          call write_separator (u)
          call parse_node_write_rec (pn, u)
       else
          write (u, "(1x,A,':',1x,A)")  title, "[undefined]"
       end if
     end subroutine wrt
   end subroutine rt_parse_nodes_write
 
 @ %def rt_parse_nodes_write
 @ Screen output for individual components.  (This should eventually be more
 condensed, currently we print the internal representation tree.)
 <<RT data: rt parse nodes: TBP>>=
   procedure :: show => rt_parse_nodes_show
 <<RT data: procedures>>=
   subroutine rt_parse_nodes_show (rt_pn, name, unit)
     class(rt_parse_nodes_t), intent(in) :: rt_pn
     type(string_t), intent(in) :: name
     integer, intent(in), optional :: unit
     type(parse_node_t), pointer :: pn
     integer :: u
     u = given_output_unit (unit)
     select case (char (name))
     case ("cuts")
        pn => rt_pn%cuts_lexpr
     case ("scale")
        pn => rt_pn%scale_expr
     case ("factorization_scale")
        pn => rt_pn%fac_scale_expr
     case ("renormalization_scale")
        pn => rt_pn%ren_scale_expr
     case ("weight")
        pn => rt_pn%weight_expr
     case ("selection")
        pn => rt_pn%selection_lexpr
     case ("reweight")
        pn => rt_pn%reweight_expr
     case ("analysis")
        pn => rt_pn%analysis_lexpr
     end select
     if (associated (pn)) then
        write (u, "(A,1x,A,1x,A)")  "Expression:", char (name), "(parse tree):"
        call parse_node_write_rec (pn, u)
     else
        write (u, "(A,1x,A,A)")  "Expression:", char (name), ": [undefined]"
     end if
   end subroutine rt_parse_nodes_show
 
 @ %def rt_parse_nodes_show
 @
 \subsection{The data type}
 This is a big data container which contains everything that is used and
 modified during the command flow.  A local copy of this can be used to
 temporarily override defaults.  The data set is transparent.
 <<RT data: public>>=
   public :: rt_data_t
 <<RT data: types>>=
   type :: rt_data_t
      type(lexer_t), pointer :: lexer => null ()
      type(rt_data_t), pointer :: context => null ()
      type(string_t), dimension(:), allocatable :: export
      type(var_list_t) :: var_list
      type(iterations_list_t) :: it_list
      type(os_data_t) :: os_data
      type(model_list_t) :: model_list
      type(model_t), pointer :: model => null ()
      logical :: model_is_copy = .false.
      type(model_t), pointer :: preload_model => null ()
      type(model_t), pointer :: fallback_model => null ()
      type(prclib_stack_t) :: prclib_stack
      type(process_library_t), pointer :: prclib => null ()
      type(beam_structure_t) :: beam_structure
      type(rt_parse_nodes_t) :: pn
      type(process_stack_t) :: process_stack
      type(string_t), dimension(:), allocatable :: sample_fmt
      class(event_callback_t), allocatable :: event_callback
      type(file_list_t), pointer :: out_files => null ()
      logical :: quit = .false.
      integer :: quit_code = 0
      type(string_t) :: logfile
      logical :: nlo_fixed_order = .false.
      logical, dimension(0:5) :: selected_nlo_parts = .false.
      integer, dimension(:), allocatable :: nlo_component
    contains
    <<RT data: rt data: TBP>>
   end type rt_data_t
 
 @ %def rt_data_t
 @
 \subsection{Output}
 <<RT data: rt data: TBP>>=
   procedure :: write => rt_data_write
 <<RT data: procedures>>=
   subroutine rt_data_write (object, unit, vars, pacify)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     type(string_t), dimension(:), intent(in), optional :: vars
     logical, intent(in), optional :: pacify
     integer :: u, i
     u = given_output_unit (unit)
     call write_separator (u, 2)
     write (u, "(1x,A)")  "Runtime data:"
     if (object%get_n_export () > 0) then
        call write_separator (u, 2)
        write (u, "(1x,A)")  "Exported objects and variables:"
        call write_separator (u)
        call object%write_exports (u)
     end if
     if (present (vars)) then
        if (size (vars) /= 0) then
           call write_separator (u, 2)
           write (u, "(1x,A)")  "Selected variables:"
           call write_separator (u)
           call object%write_vars (u, vars)
        end if
     else
        call write_separator (u, 2)
        if (associated (object%model)) then
           call object%model%write_var_list (u, follow_link=.true.)
        else
           call object%var_list%write (u, follow_link=.true.)
        end if
     end if
     if (object%it_list%get_n_pass () > 0) then
        call write_separator (u, 2)
        write (u, "(1x)", advance="no")
        call object%it_list%write (u)
     end if
     if (associated (object%model)) then
        call write_separator (u, 2)
        call object%model%write (u)
     end if
     call object%prclib_stack%write (u)
     call object%beam_structure%write (u)
     call write_separator (u, 2)
     call object%pn%write (u)
     if (allocated (object%sample_fmt)) then
        call write_separator (u)
        write (u, "(1x,A)", advance="no")  "Event sample formats = "
        do i = 1, size (object%sample_fmt)
           if (i > 1)  write (u, "(A,1x)", advance="no")  ","
           write (u, "(A)", advance="no")  char (object%sample_fmt(i))
        end do
        write (u, "(A)")
     end if
     call write_separator (u)
     write (u, "(1x,A)", advance="no")  "Event callback:"
     if (allocated (object%event_callback)) then
        call object%event_callback%write (u)
     else
        write (u, "(1x,A)")  "[undefined]"
     end if
     call object%process_stack%write (u, pacify)
     write (u, "(1x,A,1x,L1)")  "quit     :", object%quit
     write (u, "(1x,A,1x,I0)")  "quit_code:", object%quit_code
     call write_separator (u, 2)
     write (u, "(1x,A,1x,A)")   "Logfile  :", "'" // trim (char (object%logfile)) // "'"
     call write_separator (u, 2)
   end subroutine rt_data_write
 
 @ %def rt_data_write
 @ Write only selected variables.
 <<RT data: rt data: TBP>>=
   procedure :: write_vars => rt_data_write_vars
 <<RT data: procedures>>=
   subroutine rt_data_write_vars (object, unit, vars)
     class(rt_data_t), intent(in), target :: object
     integer, intent(in), optional :: unit
     type(string_t), dimension(:), intent(in) :: vars
     type(var_list_t), pointer :: var_list
     integer :: u, i
     u = given_output_unit (unit)
     var_list => object%get_var_list_ptr ()
     do i = 1, size (vars)
        associate (var => vars(i))
          if (var_list%contains (var, follow_link=.true.)) then
             call var_list%write_var (var, unit = u, &
                  follow_link = .true., defined=.true.)
          end if
        end associate
     end do
   end subroutine rt_data_write_vars
 
 @ %def rt_data_write_vars
 @ Write only the model list.
 <<RT data: rt data: TBP>>=
   procedure :: write_model_list => rt_data_write_model_list
 <<RT data: procedures>>=
   subroutine rt_data_write_model_list (object, unit)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call object%model_list%write (u)
   end subroutine rt_data_write_model_list
 
 @ %def rt_data_write_model_list
 @ Write only the library stack.
 <<RT data: rt data: TBP>>=
   procedure :: write_libraries => rt_data_write_libraries
 <<RT data: procedures>>=
   subroutine rt_data_write_libraries (object, unit, libpath)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: libpath
     integer :: u
     u = given_output_unit (unit)
     call object%prclib_stack%write (u, libpath)
   end subroutine rt_data_write_libraries
 
 @ %def rt_data_write_libraries
 @ Write only the beam data.
 <<RT data: rt data: TBP>>=
   procedure :: write_beams => rt_data_write_beams
 <<RT data: procedures>>=
   subroutine rt_data_write_beams (object, unit)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call write_separator (u, 2)
     call object%beam_structure%write (u)
     call write_separator (u, 2)
   end subroutine rt_data_write_beams
 
 @ %def rt_data_write_beams
 @ Write only the process and event expressions.
 <<RT data: rt data: TBP>>=
   procedure :: write_expr => rt_data_write_expr
 <<RT data: procedures>>=
   subroutine rt_data_write_expr (object, unit)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call write_separator (u, 2)
     call object%pn%write (u)
     call write_separator (u, 2)
   end subroutine rt_data_write_expr
 
 @ %def rt_data_write_expr
 @ Write only the process stack.
 <<RT data: rt data: TBP>>=
   procedure :: write_process_stack => rt_data_write_process_stack
 <<RT data: procedures>>=
   subroutine rt_data_write_process_stack (object, unit)
     class(rt_data_t), intent(in) :: object
     integer, intent(in), optional :: unit
     call object%process_stack%write (unit)
   end subroutine rt_data_write_process_stack
 
 @ %def rt_data_write_process_stack
 @
 <<RT data: rt data: TBP>>=
   procedure :: write_var_descriptions => rt_data_write_var_descriptions
 <<RT data: procedures>>=
   subroutine rt_data_write_var_descriptions (rt_data, unit, ascii_output)
     class(rt_data_t), intent(in) :: rt_data
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: ascii_output
     integer :: u
     logical :: ao
     u = given_output_unit (unit)
     ao = .false.;  if (present (ascii_output))  ao = ascii_output
     call rt_data%var_list%write (u, follow_link=.true., &
          descriptions=.true., ascii_output=ao)
   end subroutine rt_data_write_var_descriptions
 
 @ %def rt_data_write_var_descriptions
 @
 <<RT data: rt data: TBP>>=
   procedure :: show_description_of_string => rt_data_show_description_of_string
 <<RT data: procedures>>=
   subroutine rt_data_show_description_of_string (rt_data, string, &
          unit, ascii_output)
     class(rt_data_t), intent(in) :: rt_data
     type(string_t), intent(in) :: string
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: ascii_output
     integer :: u
     logical :: ao
     u = given_output_unit (unit)
     ao = .false.;  if (present (ascii_output))  ao = ascii_output
     call rt_data%var_list%write_var (string, unit=u, follow_link=.true., &
          defined=.false., descriptions=.true., ascii_output=ao)
   end subroutine rt_data_show_description_of_string
 
 @ %def rt_data_show_description_of_string
 @
 \subsection{Clear}
 The [[clear]] command can remove the contents of various subobjects.
 The objects themselves should stay.
 <<RT data: rt data: TBP>>=
   procedure :: clear_beams => rt_data_clear_beams
 <<RT data: procedures>>=
   subroutine rt_data_clear_beams (global)
     class(rt_data_t), intent(inout) :: global
     call global%beam_structure%final_sf ()
     call global%beam_structure%final_pol ()
     call global%beam_structure%final_mom ()
   end subroutine rt_data_clear_beams
 
 @ %def rt_data_clear_beams
 @
 \subsection{Initialization}
 Initialize runtime data.  This defines special variables such as
 [[sqrts]], and should be done only for the instance that is actually
 global.   Local copies will inherit the special variables.
 
 We link the global variable list to the process stack variable list,
 so the latter is always available (and kept global).
 <<RT data: rt data: TBP>>=
   procedure :: global_init => rt_data_global_init
 <<RT data: procedures>>=
   subroutine rt_data_global_init (global, paths, logfile)
     class(rt_data_t), intent(out), target :: global
     type(paths_t), intent(in), optional :: paths
     type(string_t), intent(in), optional :: logfile
     integer :: seed
     call os_data_init (global%os_data, paths)
     if (present (logfile)) then
        global%logfile = logfile
     else
        global%logfile = ""
     end if
     allocate (global%out_files)
     call system_clock (seed)
     call global%var_list%init_defaults (seed, paths)
     call global%init_pointer_variables ()
     call global%process_stack%init_var_list (global%var_list)
   end subroutine rt_data_global_init
 
 @ %def rt_data_global_init
 @
 \subsection{Local copies}
 This is done at compile time when a local copy of runtime data is
 needed: Link the variable list and initialize all derived parameters.
 This allows for synchronizing them with local variable changes without
 affecting global data.
 
 Also re-initialize pointer variables, so they point to local copies of
 their targets.
 <<RT data: rt data: TBP>>=
   procedure :: local_init => rt_data_local_init
 <<RT data: procedures>>=
   subroutine rt_data_local_init (local, global, env)
     class(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(in), target :: global
     integer, intent(in), optional :: env
     local%context => global
     call local%process_stack%link (global%process_stack)
     call local%process_stack%init_var_list (local%var_list)
     call local%process_stack%link_var_list (global%var_list)
     call local%var_list%append_string (var_str ("$model_name"), &
          var_str (""), intrinsic=.true.)
     call local%init_pointer_variables ()
     local%fallback_model => global%fallback_model
     local%os_data = global%os_data
     local%logfile = global%logfile
     call local%model_list%link (global%model_list)
     local%model => global%model
     if (associated (local%model)) then
        call local%model%link_var_list (local%var_list)
     end if
     if (allocated (global%event_callback)) then
        allocate (local%event_callback, source = global%event_callback)
     end if
   end subroutine rt_data_local_init
 
 @ %def rt_data_local_init
 @ These variables point to objects which get local copies:
 <<RT data: rt data: TBP>>=
   procedure :: init_pointer_variables => rt_data_init_pointer_variables
 <<RT data: procedures>>=
   subroutine rt_data_init_pointer_variables (local)
     class(rt_data_t), intent(inout), target :: local
     logical, target, save :: known = .true.
     call local%var_list%append_string_ptr (var_str ("$fc"), &
          local%os_data%fc, known, intrinsic=.true., &
          description=var_str('This string variable gives the ' // &
          '\ttt{Fortran} compiler used within \whizard. It can ' // &
          'only be accessed, not set by the user. (cf. also ' // &
          '\ttt{\$fcflags})'))
     call local%var_list%append_string_ptr (var_str ("$fcflags"), &
          local%os_data%fcflags, known, intrinsic=.true., &
          description=var_str('This string variable gives the ' // &
          'compiler flags for the \ttt{Fortran} compiler used ' // &
          'within \whizard. It can only be accessed, not set by ' // &
          'the user. (cf. also \ttt{\$fc})'))
   end subroutine rt_data_init_pointer_variables
 
 @ %def rt_data_init_pointer_variables
 @ This is done at execution time: Copy data, transfer pointers.
 [[local]] has intent(inout) because its local variable list has
 already been prepared by the previous routine.
 
 To be pedantic, the local pointers to model and library should point
 to the entries in the local copies.  (However, as long as these are
 just shallow copies with identical content, this is actually
 irrelevant.)
 
 The process library and process stacks behave as global objects.  The
 copies of the process library and process stacks should be shallow
 copies, so the contents stay identical.  Since objects may be pushed
 on the stack in the local environment, upon restoring the global
 environment, we should reverse the assignment.  Then the added stack
 elements will end up on the global stack.  (This should be
 reconsidered in a parallel environment.)
 <<RT data: rt data: TBP>>=
   procedure :: activate => rt_data_activate
 <<RT data: procedures>>=
   subroutine rt_data_activate (local)
     class(rt_data_t), intent(inout), target :: local
     class(rt_data_t), pointer :: global
     global => local%context
     if (associated (global)) then
        local%lexer => global%lexer
        call global%copy_globals (local)
        local%os_data = global%os_data
        local%logfile = global%logfile
        if (associated (global%prclib)) then
           local%prclib => &
                local%prclib_stack%get_library_ptr (global%prclib%get_name ())
        end if
        call local%import_values ()
        call local%process_stack%link (global%process_stack)
        local%it_list = global%it_list
        local%beam_structure = global%beam_structure
        local%pn = global%pn
        if (allocated (local%sample_fmt))  deallocate (local%sample_fmt)
        if (allocated (global%sample_fmt)) then
           allocate (local%sample_fmt (size (global%sample_fmt)), &
                source = global%sample_fmt)
        end if
        local%out_files => global%out_files
        local%model => global%model
        local%model_is_copy = .false.
     else if (.not. associated (local%model)) then
        local%model => local%preload_model
        local%model_is_copy = .false.
     end if
     if (associated (local%model)) then
        call local%model%link_var_list (local%var_list)
        call local%var_list%set_string (var_str ("$model_name"), &
             local%model%get_name (), is_known = .true.)
     else
        call local%var_list%set_string (var_str ("$model_name"), &
             var_str (""), is_known = .false.)
     end if
   end subroutine rt_data_activate
 
 @ %def rt_data_activate
 @ Restore the previous state of data, without actually finalizing the local
 environment.  We also clear the local process stack.  Some local modifications
 (model list and process library stack) are communicated to the global context,
 if there is any.
 
 If the [[keep_local]] flag is set, we want to retain current settings in
 the local environment.  In particular, we create an instance of the currently
 selected model (which thus becomes separated from the model library!).
 The local variables are also kept.
 <<RT data: rt data: TBP>>=
   procedure :: deactivate => rt_data_deactivate
 <<RT data: procedures>>=
   subroutine rt_data_deactivate (local, global, keep_local)
     class(rt_data_t), intent(inout), target :: local
     class(rt_data_t), intent(inout), optional, target :: global
     logical, intent(in), optional :: keep_local
     type(string_t) :: local_model, local_scheme
     logical :: same_model, delete
     delete = .true.;  if (present (keep_local))  delete = .not. keep_local
     if (present (global)) then
        if (associated (global%model) .and. associated (local%model)) then
           local_model = local%model%get_name ()
           if (global%model%has_schemes ()) then
              local_scheme = local%model%get_scheme ()
              same_model = &
                   global%model%matches (local_model, local_scheme)
           else
              same_model = global%model%matches (local_model)
           end if
        else
           same_model = .false.
        end if
        if (delete) then
           call local%process_stack%clear ()
           call local%unselect_model ()
           call local%unset_values ()
        else if (associated (local%model)) then
           call local%ensure_model_copy ()
        end if
        if (.not. same_model .and. associated (global%model)) then
           if (global%model%has_schemes ()) then
              call msg_message ("Restoring model '" // &
                   char (global%model%get_name ()) // "', scheme '" // &
                   char (global%model%get_scheme ()) // "'")
           else
              call msg_message ("Restoring model '" // &
                   char (global%model%get_name ()) // "'")
           end if
        end if
        if (associated (global%model)) then
           call global%model%link_var_list (global%var_list)
        end if
        call global%restore_globals (local)
     else
        call local%unselect_model ()
     end if
   end subroutine rt_data_deactivate
 
 @ %def rt_data_deactivate
 @ This imports the global objects for which local modifications
 should be kept.  Currently, this is only the process library stack.
 <<RT data: rt data: TBP>>=
   procedure :: copy_globals => rt_data_copy_globals
 <<RT data: procedures>>=
   subroutine rt_data_copy_globals (global, local)
     class(rt_data_t), intent(in) :: global
     class(rt_data_t), intent(inout) :: local
     local%prclib_stack = global%prclib_stack
   end subroutine rt_data_copy_globals
 
 @ %def rt_data_copy_globals
 @ This restores global objects for which local modifications
 should be kept.  May also modify (remove) the local objects.
 <<RT data: rt data: TBP>>=
   procedure :: restore_globals => rt_data_restore_globals
 <<RT data: procedures>>=
   subroutine rt_data_restore_globals (global, local)
     class(rt_data_t), intent(inout) :: global
     class(rt_data_t), intent(inout) :: local
     global%prclib_stack = local%prclib_stack
     call local%handle_exports (global)
   end subroutine rt_data_restore_globals
 
 @ %def rt_data_restore_globals
 @
 \subsection{Exported objects}
 Exported objects are transferred to the global state when a local environment
 is closed.  (For the top-level global data set, there is no effect.)
 
 The current implementation handles only the [[results]] object, which resolves
 to the local process stack.  The stack elements are appended to the global
 stack without modification, the local stack becomes empty.
 
 Write names of objects to be exported:
 <<RT data: rt data: TBP>>=
   procedure :: write_exports => rt_data_write_exports
 <<RT data: procedures>>=
   subroutine rt_data_write_exports (rt_data, unit)
     class(rt_data_t), intent(in) :: rt_data
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     do i = 1, rt_data%get_n_export ()
        write (u, "(A)")  char (rt_data%export(i))
     end do
   end subroutine rt_data_write_exports
 
 @ %def rt_data_write_exports
 @ The number of entries in the export list.
 <<RT data: rt data: TBP>>=
   procedure :: get_n_export => rt_data_get_n_export
 <<RT data: procedures>>=
   function rt_data_get_n_export (rt_data) result (n)
     class(rt_data_t), intent(in) :: rt_data
     integer :: n
     if (allocated (rt_data%export)) then
        n = size (rt_data%export)
     else
        n = 0
     end if
   end function rt_data_get_n_export
 
 @ %def rt_data_get_n_export
 @ Return a specific export 
 @ Append new names to the export list.  If a duplicate occurs, do not transfer
 it.
 <<RT data: rt data: TBP>>=
   procedure :: append_exports => rt_data_append_exports
 <<RT data: procedures>>=
   subroutine rt_data_append_exports (rt_data, export)
     class(rt_data_t), intent(inout) :: rt_data
     type(string_t), dimension(:), intent(in) :: export
     logical, dimension(:), allocatable :: mask
     type(string_t), dimension(:), allocatable :: tmp
     integer :: i, j, n
     if (.not. allocated (rt_data%export))  allocate (rt_data%export (0))
     n = size (rt_data%export)
     allocate (mask (size (export)), source=.false.)
     do i = 1, size (export)
        mask(i) = all (export(i) /= rt_data%export) &
             .and. all (export(i) /= export(:i-1))
     end do
     if (count (mask) > 0) then
        allocate (tmp (n + count (mask)))
        tmp(1:n) = rt_data%export(:)
        j = n
        do i = 1, size (export)
           if (mask(i)) then
              j = j + 1
              tmp(j) = export(i)
           end if
        end do
        call move_alloc (from=tmp, to=rt_data%export)
     end if
   end subroutine rt_data_append_exports
 
 @ %def rt_data_append_exports
 @ Transfer export-objects from the [[local]] rt data to the [[global]] rt
 data, as far as supported.
 <<RT data: rt data: TBP>>=
   procedure :: handle_exports => rt_data_handle_exports
 <<RT data: procedures>>=
   subroutine rt_data_handle_exports (local, global)
     class(rt_data_t), intent(inout), target :: local
     class(rt_data_t), intent(inout), target :: global
     type(string_t) :: export
     integer :: i
     if (local%get_n_export () > 0) then
        do i = 1, local%get_n_export ()
           export = local%export(i)
           select case (char (export))
           case ("results")
              call msg_message ("Exporting integration results &
                   &to outer environment")
              call local%transfer_process_stack (global)
           case default
              call msg_bug ("handle exports: '" &
                   // char (export) // "' unsupported")
           end select
        end do
     end if
   end subroutine rt_data_handle_exports
 
 @ %def rt_data_handle_exports
 @ Export the process stack.  One-by-one, take the last process from the local
 stack and push it on the global stack.  Also handle the corresponding result
 variables: append if the process did not exist yet in the global stack,
 otherwise update.
 
 TODO: result variables don't work that way yet, require initialization in the
 global variable list.
 <<RT data: rt data: TBP>>=
   procedure :: transfer_process_stack => rt_data_transfer_process_stack
 <<RT data: procedures>>=
   subroutine rt_data_transfer_process_stack (local, global)
     class(rt_data_t), intent(inout), target :: local
     class(rt_data_t), intent(inout), target :: global
     type(process_entry_t), pointer :: process
     type(string_t) :: process_id
     do
        call local%process_stack%pop_last (process)
        if (.not. associated (process))  exit
        process_id = process%get_id ()
        call global%process_stack%push (process)
        call global%process_stack%fill_result_vars (process_id)
        call global%process_stack%update_result_vars &
             (process_id, global%var_list)
     end do
   end subroutine rt_data_transfer_process_stack
     
 @ %def rt_data_transfer_process_stack
 @
 \subsection{Finalization}
 Finalizer for the variable list and the structure-function list.
 This is done only for the global RT dataset; local copies contain
 pointers to this and do not need a finalizer.
 <<RT data: rt data: TBP>>=
   procedure :: final => rt_data_global_final
 <<RT data: procedures>>=
   subroutine rt_data_global_final (global)
     class(rt_data_t), intent(inout) :: global
     call global%process_stack%final ()
     call global%prclib_stack%final ()
     call global%model_list%final ()
     call global%var_list%final (follow_link=.false.)
     if (associated (global%out_files)) then
        call file_list_final (global%out_files)
        deallocate (global%out_files)
     end if
   end subroutine rt_data_global_final
 
 @ %def rt_data_global_final
 @ The local copy needs a finalizer for the variable list, which consists
 of local copies.  This finalizer is called only when the local
 environment is finally discarded.  (Note that the process stack should
 already have been cleared after execution, which can occur many times
 for the same local environment.)
 <<RT data: rt data: TBP>>=
   procedure :: local_final => rt_data_local_final
 <<RT data: procedures>>=
   subroutine rt_data_local_final (local)
     class(rt_data_t), intent(inout) :: local
     call local%process_stack%clear ()
     call local%model_list%final ()
     call local%var_list%final (follow_link=.false.)
   end subroutine rt_data_local_final
 
 @ %def rt_data_local_final
 @
 \subsection{Model Management}
 Read a model, so it becomes available for activation.  No variables or model
 copies, this is just initialization.
 
 If this is a local environment, the model will be automatically read into the
 global context.
 <<RT data: rt data: TBP>>=
   procedure :: read_model => rt_data_read_model
 <<RT data: procedures>>=
   subroutine rt_data_read_model (global, name, model, scheme)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: scheme
     type(model_t), pointer, intent(out) :: model
     type(string_t) :: filename
     filename = name // ".mdl"
     call global%model_list%read_model &
          (name, filename, global%os_data, model, scheme)
   end subroutine rt_data_read_model
 
 @ %def rt_data_read_model
 @ Read a UFO model.  Create it on the fly if necessary.
 <<RT data: rt data: TBP>>=
   procedure :: read_ufo_model => rt_data_read_ufo_model
 <<RT data: procedures>>=
   subroutine rt_data_read_ufo_model (global, name, model, ufo_path)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     type(model_t), pointer, intent(out) :: model
     type(string_t), intent(in), optional :: ufo_path
     type(string_t) :: filename
     filename = name // ".ufo.mdl"
     call global%model_list%read_model &
          (name, filename, global%os_data, model, ufo=.true., ufo_path=ufo_path)
   end subroutine rt_data_read_ufo_model
 
 @ %def rt_data_read_ufo_model
 @ Initialize the fallback model.  This model is used
 whenever the current model does not describe all physical particles
 (hadrons, mainly).  It is not supposed to be modified, and the pointer
 should remain linked to this model.
 <<RT data: rt data: TBP>>=
   procedure :: init_fallback_model => rt_data_init_fallback_model
 <<RT data: procedures>>=
   subroutine rt_data_init_fallback_model (global, name, filename)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name, filename
     call global%model_list%read_model &
          (name, filename, global%os_data, global%fallback_model)
   end subroutine rt_data_init_fallback_model
 
 @ %def rt_data_init_fallback_model
 @
 Activate a model: assign the current-model pointer and set the model name in
 the variable list.  If necessary, read the model from file.  Link the global
 variable list to the model variable list.
 <<RT data: rt data: TBP>>=
   procedure :: select_model => rt_data_select_model
 <<RT data: procedures>>=
   subroutine rt_data_select_model (global, name, scheme, ufo, ufo_path)
     class(rt_data_t), intent(inout), target :: global
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: scheme
     logical, intent(in), optional :: ufo
     type(string_t), intent(in), optional :: ufo_path
     logical :: same_model, ufo_model
     ufo_model = .false.;  if (present (ufo))  ufo_model = ufo
     if (associated (global%model)) then
        same_model = global%model%matches (name, scheme, ufo)
     else
        same_model = .false.
     end if
     if (.not. same_model) then
        global%model => global%model_list%get_model_ptr (name, scheme, ufo)
        if (.not. associated (global%model)) then
           if (ufo_model) then
              call global%read_ufo_model (name, global%model, ufo_path)
           else
              call global%read_model (name, global%model)
           end if
           global%model_is_copy = .false.
        else if (associated (global%context)) then
           global%model_is_copy = &
                global%model_list%model_exists (name, scheme, ufo, &
                follow_link=.false.)
        else
           global%model_is_copy = .false.
        end if
     end if
     if (associated (global%model)) then
        call global%model%link_var_list (global%var_list)
        call global%var_list%set_string (var_str ("$model_name"), &
             name, is_known = .true.)
        if (global%model%is_ufo_model ()) then
           call msg_message ("Switching to model '" // char (name) // "' " &
                // "(generated from UFO source)")
        else if (global%model%has_schemes ()) then
           call msg_message ("Switching to model '" // char (name) // "', " &
                // "scheme '" // char (global%model%get_scheme ()) // "'")
        else
           call msg_message ("Switching to model '" // char (name) // "'")
        end if
     else
        call global%var_list%set_string (var_str ("$model_name"), &
             var_str (""), is_known = .false.)
     end if
   end subroutine rt_data_select_model
 
 @ %def rt_data_select_model
 @
 Remove the model link and unset the model name variable.
 <<RT data: rt data: TBP>>=
   procedure :: unselect_model => rt_data_unselect_model
 <<RT data: procedures>>=
   subroutine rt_data_unselect_model (global)
     class(rt_data_t), intent(inout), target :: global
     if (associated (global%model)) then
        global%model => null ()
        global%model_is_copy = .false.
        call global%var_list%set_string (var_str ("$model_name"), &
             var_str (""), is_known = .false.)
     end if
   end subroutine rt_data_unselect_model
 
 @ %def rt_data_unselect_model
 @
 Create a copy of the currently selected model and append it to the local model
 list.  The model pointer is redirected to the copy.
 (Not applicable for the global model list, those models will be
 modified in-place.)
 <<RT data: rt data: TBP>>=
   procedure :: ensure_model_copy => rt_data_ensure_model_copy
 <<RT data: procedures>>=
   subroutine rt_data_ensure_model_copy (global)
     class(rt_data_t), intent(inout), target :: global
     if (associated (global%context)) then
        if (.not. global%model_is_copy) then
           call global%model_list%append_copy (global%model, global%model)
           global%model_is_copy = .true.
           call global%model%link_var_list (global%var_list)
        end if
     end if
   end subroutine rt_data_ensure_model_copy
 
 @ %def rt_data_ensure_model_copy
 @
 Modify a model variable.  The update mechanism will ensure that the model
 parameter set remains consistent.  This has to take place in a local copy
 of the current model.  If there is none yet, create one.
 <<RT data: rt data: TBP>>=
   procedure :: model_set_real => rt_data_model_set_real
 <<RT data: procedures>>=
   subroutine rt_data_model_set_real (global, name, rval, verbose, pacified)
     class(rt_data_t), intent(inout), target :: global
     type(string_t), intent(in) :: name
     real(default), intent(in) :: rval
     logical, intent(in), optional :: verbose, pacified
     call global%ensure_model_copy ()
     call global%model%set_real (name, rval, verbose, pacified)
   end subroutine rt_data_model_set_real
 
 @ %def rt_data_model_set_real
 @
 Modify particle properties.  This has to take place in a local copy
 of the current model.  If there is none yet, create one.
 <<RT data: rt data: TBP>>=
   procedure :: modify_particle => rt_data_modify_particle
 <<RT data: procedures>>=
   subroutine rt_data_modify_particle &
        (global, pdg, polarized, stable, decay, &
        isotropic_decay, diagonal_decay, decay_helicity)
     class(rt_data_t), intent(inout), target :: global
     integer, intent(in) :: pdg
     logical, intent(in), optional :: polarized, stable
     logical, intent(in), optional :: isotropic_decay, diagonal_decay
     integer, intent(in), optional :: decay_helicity
     type(string_t), dimension(:), intent(in), optional :: decay
     call global%ensure_model_copy ()
     if (present (polarized)) then
        if (polarized) then
           call global%model%set_polarized (pdg)
        else
           call global%model%set_unpolarized (pdg)
        end if
     end if
     if (present (stable)) then
        if (stable) then
           call global%model%set_stable (pdg)
        else if (present (decay)) then
           call global%model%set_unstable &
                (pdg, decay, isotropic_decay, diagonal_decay, decay_helicity)
        else
           call msg_bug ("Setting particle unstable: missing decay processes")
        end if
     end if
   end subroutine rt_data_modify_particle
 
 @ %def rt_data_modify_particle
 @
 \subsection{Managing Variables}
 Return a pointer to the currently active variable list.  If there is no model,
 this is the global variable list.  If there is one, it is the model variable
 list, which should be linked to the former.
 <<RT data: rt data: TBP>>=
   procedure :: get_var_list_ptr => rt_data_get_var_list_ptr
 <<RT data: procedures>>=
   function rt_data_get_var_list_ptr (global) result (var_list)
     class(rt_data_t), intent(in), target :: global
     type(var_list_t), pointer :: var_list
     if (associated (global%model)) then
        var_list => global%model%get_var_list_ptr ()
     else
        var_list => global%var_list
     end if
   end function rt_data_get_var_list_ptr
 
 @ %def rt_data_get_var_list_ptr
 @ Initialize a local variable: append it to the current variable list.  No
 initial value, yet.
 <<RT data: rt data: TBP>>=
   procedure :: append_log => rt_data_append_log
   procedure :: append_int => rt_data_append_int
   procedure :: append_real => rt_data_append_real
   procedure :: append_cmplx => rt_data_append_cmplx
   procedure :: append_subevt => rt_data_append_subevt
   procedure :: append_pdg_array => rt_data_append_pdg_array
   procedure :: append_string => rt_data_append_string
 <<RT data: procedures>>=
   subroutine rt_data_append_log (local, name, lval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     logical, intent(in), optional :: lval
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_log (name, lval, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_log
 
   subroutine rt_data_append_int (local, name, ival, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     integer, intent(in), optional :: ival
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_int (name, ival, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_int
 
   subroutine rt_data_append_real (local, name, rval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     real(default), intent(in), optional :: rval
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_real (name, rval, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_real
 
   subroutine rt_data_append_cmplx (local, name, cval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     complex(default), intent(in), optional :: cval
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_cmplx (name, cval, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_cmplx
 
   subroutine rt_data_append_subevt (local, name, pval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     type(subevt_t), intent(in), optional :: pval
     logical, intent(in) :: intrinsic, user
     call local%var_list%append_subevt (name, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_subevt
 
   subroutine rt_data_append_pdg_array (local, name, aval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     type(pdg_array_t), intent(in), optional :: aval
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_pdg_array (name, aval, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_pdg_array
 
   subroutine rt_data_append_string (local, name, sval, intrinsic, user)
     class(rt_data_t), intent(inout) :: local
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: sval
     logical, intent(in), optional :: intrinsic, user
     call local%var_list%append_string (name, sval, &
          intrinsic = intrinsic, user = user)
   end subroutine rt_data_append_string
 
 @ %def rt_data_append_log
 @ %def rt_data_append_int
 @ %def rt_data_append_real
 @ %def rt_data_append_cmplx
 @ %def rt_data_append_subevt
 @ %def rt_data_append_pdg_array
 @ %def rt_data_append_string
 @ Import values for all local variables, given a global context environment
 where these variables are defined.
 <<RT data: rt data: TBP>>=
   procedure :: import_values => rt_data_import_values
 <<RT data: procedures>>=
   subroutine rt_data_import_values (local)
     class(rt_data_t), intent(inout) :: local
     type(rt_data_t), pointer :: global
     global => local%context
     if (associated (global)) then
        call local%var_list%import (global%var_list)
     end if
   end subroutine rt_data_import_values
 
 @ %def rt_data_import_values
 @ Unset all variable values.
 <<RT data: rt data: TBP>>=
   procedure :: unset_values => rt_data_unset_values
 <<RT data: procedures>>=
   subroutine rt_data_unset_values (global)
     class(rt_data_t), intent(inout) :: global
     call global%var_list%undefine (follow_link=.false.)
   end subroutine rt_data_unset_values
 
 @ %def rt_data_unset_values
 @ Set a variable.  (Not a model variable, these are handled separately.)  We
 can assume that the variable has been initialized.
 <<RT data: rt data: TBP>>=
   procedure :: set_log => rt_data_set_log
   procedure :: set_int => rt_data_set_int
   procedure :: set_real => rt_data_set_real
   procedure :: set_cmplx => rt_data_set_cmplx
   procedure :: set_subevt => rt_data_set_subevt
   procedure :: set_pdg_array => rt_data_set_pdg_array
   procedure :: set_string => rt_data_set_string
 <<RT data: procedures>>=
   subroutine rt_data_set_log &
        (global, name, lval, is_known, force, verbose)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     logical, intent(in) :: lval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose
     call global%var_list%set_log (name, lval, is_known, &
          force=force, verbose=verbose)
   end subroutine rt_data_set_log
 
   subroutine rt_data_set_int &
        (global, name, ival, is_known, force, verbose)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     integer, intent(in) :: ival
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose
     call global%var_list%set_int (name, ival, is_known, &
          force=force, verbose=verbose)
   end subroutine rt_data_set_int
 
   subroutine rt_data_set_real &
        (global, name, rval, is_known, force, verbose, pacified)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     real(default), intent(in) :: rval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose, pacified
     call global%var_list%set_real (name, rval, is_known, &
          force=force, verbose=verbose, pacified=pacified)
   end subroutine rt_data_set_real
 
   subroutine rt_data_set_cmplx &
        (global, name, cval, is_known, force, verbose, pacified)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     complex(default), intent(in) :: cval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose, pacified
     call global%var_list%set_cmplx (name, cval, is_known, &
          force=force, verbose=verbose, pacified=pacified)
   end subroutine rt_data_set_cmplx
 
   subroutine rt_data_set_subevt &
        (global, name, pval, is_known, force, verbose)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     type(subevt_t), intent(in) :: pval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose
     call global%var_list%set_subevt (name, pval, is_known, &
          force=force, verbose=verbose)
   end subroutine rt_data_set_subevt
 
   subroutine rt_data_set_pdg_array &
        (global, name, aval, is_known, force, verbose)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     type(pdg_array_t), intent(in) :: aval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose
     call global%var_list%set_pdg_array (name, aval, is_known, &
          force=force, verbose=verbose)
   end subroutine rt_data_set_pdg_array
 
   subroutine rt_data_set_string &
        (global, name, sval, is_known, force, verbose)
     class(rt_data_t), intent(inout) :: global
     type(string_t), intent(in) :: name
     type(string_t), intent(in) :: sval
     logical, intent(in) :: is_known
     logical, intent(in), optional :: force, verbose
     call global%var_list%set_string (name, sval, is_known, &
          force=force, verbose=verbose)
   end subroutine rt_data_set_string
 
 @ %def rt_data_set_log
 @ %def rt_data_set_int
 @ %def rt_data_set_real
 @ %def rt_data_set_cmplx
 @ %def rt_data_set_subevt
 @ %def rt_data_set_pdg_array
 @ %def rt_data_set_string
 @ Return the value of a variable, assuming that the type is correct.
 <<RT data: rt data: TBP>>=
   procedure :: get_lval => rt_data_get_lval
   procedure :: get_ival => rt_data_get_ival
   procedure :: get_rval => rt_data_get_rval
   procedure :: get_cval => rt_data_get_cval
   procedure :: get_pval => rt_data_get_pval
   procedure :: get_aval => rt_data_get_aval
   procedure :: get_sval => rt_data_get_sval
 <<RT data: procedures>>=
   function rt_data_get_lval (global, name) result (lval)
     logical :: lval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     lval = var_list%get_lval (name)
   end function rt_data_get_lval
 
   function rt_data_get_ival (global, name) result (ival)
     integer :: ival
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     ival = var_list%get_ival (name)
   end function rt_data_get_ival
 
   function rt_data_get_rval (global, name) result (rval)
     real(default) :: rval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     rval = var_list%get_rval (name)
   end function rt_data_get_rval
 
   function rt_data_get_cval (global, name) result (cval)
     complex(default) :: cval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     cval = var_list%get_cval (name)
   end function rt_data_get_cval
 
   function rt_data_get_aval (global, name) result (aval)
     type(pdg_array_t) :: aval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     aval = var_list%get_aval (name)
   end function rt_data_get_aval
 
   function rt_data_get_pval (global, name) result (pval)
     type(subevt_t) :: pval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     pval = var_list%get_pval (name)
   end function rt_data_get_pval
 
   function rt_data_get_sval (global, name) result (sval)
     type(string_t) :: sval
     class(rt_data_t), intent(in), target :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     sval = var_list%get_sval (name)
   end function rt_data_get_sval
 
 @ %def rt_data_get_lval
 @ %def rt_data_get_ival
 @ %def rt_data_get_rval
 @ %def rt_data_get_cval
 @ %def rt_data_get_pval
 @ %def rt_data_get_aval
 @ %def rt_data_get_sval
 @ Return true if the variable exists in the global list.
 <<RT data: rt data: TBP>>=
   procedure :: contains => rt_data_contains
 <<RT data: procedures>>=
   function rt_data_contains (global, name) result (lval)
     logical :: lval
     class(rt_data_t), intent(in) :: global
     type(string_t), intent(in) :: name
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     lval = var_list%contains (name)
   end function rt_data_contains
 
 @ %def rt_data_contains
 @
 \subsection{Further Content}
 Add a library (available via a pointer of type [[prclib_entry_t]]) to
 the stack and update the pointer and variable list to the current
 library.  The pointer association of [[prclib_entry]] will be discarded.
 <<RT data: rt data: TBP>>=
   procedure :: add_prclib => rt_data_add_prclib
 <<RT data: procedures>>=
   subroutine rt_data_add_prclib (global, prclib_entry)
     class(rt_data_t), intent(inout) :: global
     type(prclib_entry_t), intent(inout), pointer :: prclib_entry
     call global%prclib_stack%push (prclib_entry)
     call global%update_prclib (global%prclib_stack%get_first_ptr ())
   end subroutine rt_data_add_prclib
 
 @ %def rt_data_add_prclib
 @ Given a pointer to a process library, make this the currently active
 library.
 <<RT data: rt data: TBP>>=
   procedure :: update_prclib => rt_data_update_prclib
 <<RT data: procedures>>=
   subroutine rt_data_update_prclib (global, lib)
     class(rt_data_t), intent(inout) :: global
     type(process_library_t), intent(in), target :: lib
     global%prclib => lib
     if (global%var_list%contains (&
          var_str ("$library_name"), follow_link = .false.)) then
        call global%var_list%set_string (var_str ("$library_name"), &
             global%prclib%get_name (), is_known=.true.)
     else
        call global%var_list%append_string ( &
             var_str ("$library_name"), global%prclib%get_name (), &
             intrinsic = .true.)
     end if
   end subroutine rt_data_update_prclib
 
 @ %def rt_data_update_prclib
 @
 \subsection{Miscellaneous}
 The helicity selection data are distributed among several parameters.  Here,
 we collect them in a single record.
 <<RT data: rt data: TBP>>=
   procedure :: get_helicity_selection => rt_data_get_helicity_selection
 <<RT data: procedures>>=
   function rt_data_get_helicity_selection (rt_data) result (helicity_selection)
     class(rt_data_t), intent(in) :: rt_data
     type(helicity_selection_t) :: helicity_selection
     associate (var_list => rt_data%var_list)
       helicity_selection%active = var_list%get_lval (&
            var_str ("?helicity_selection_active"))
       if (helicity_selection%active) then
          helicity_selection%threshold = var_list%get_rval (&
               var_str ("helicity_selection_threshold"))
          helicity_selection%cutoff = var_list%get_ival (&
               var_str ("helicity_selection_cutoff"))
       end if
     end associate
   end function rt_data_get_helicity_selection
 
 @ %def rt_data_get_helicity_selection
 @ Show the beam setup: beam structure and relevant global variables.
 <<RT data: rt data: TBP>>=
   procedure :: show_beams => rt_data_show_beams
 <<RT data: procedures>>=
   subroutine rt_data_show_beams (rt_data, unit)
     class(rt_data_t), intent(in) :: rt_data
     integer, intent(in), optional :: unit
     type(string_t) :: s
     integer :: u
     u = given_output_unit (unit)
     associate (beams => rt_data%beam_structure, var_list => rt_data%var_list)
       call beams%write (u)
       if (.not. beams%asymmetric () .and. beams%get_n_beam () == 2) then
          write (u, "(2x,A," // FMT_19 // ",1x,'GeV')") "sqrts =", &
               var_list%get_rval (var_str ("sqrts"))
       end if
       if (beams%contains ("pdf_builtin")) then
          s = var_list%get_sval (var_str ("$pdf_builtin_set"))
          if (s /= "") then
             write (u, "(2x,A,1x,3A)")  "PDF set =", '"', char (s), '"'
          else
             write (u, "(2x,A,1x,A)")  "PDF set =", "[undefined]"
          end if
       end if
       if (beams%contains ("lhapdf")) then
          s = var_list%get_sval (var_str ("$lhapdf_dir"))
          if (s /= "") then
             write (u, "(2x,A,1x,3A)")  "LHAPDF dir    =", '"', char (s), '"'
          end if
          s = var_list%get_sval (var_str ("$lhapdf_file"))
          if (s /= "") then
             write (u, "(2x,A,1x,3A)")  "LHAPDF file   =", '"', char (s), '"'
             write (u, "(2x,A,1x,I0)") "LHAPDF member =", &
                  var_list%get_ival (var_str ("lhapdf_member"))
          else
             write (u, "(2x,A,1x,A)")  "LHAPDF file   =", "[undefined]"
          end if
       end if
       if (beams%contains ("lhapdf_photon")) then
          s = var_list%get_sval (var_str ("$lhapdf_dir"))
          if (s /= "") then
             write (u, "(2x,A,1x,3A)")  "LHAPDF dir    =", '"', char (s), '"'
          end if
          s = var_list%get_sval (var_str ("$lhapdf_photon_file"))
          if (s /= "") then
             write (u, "(2x,A,1x,3A)")  "LHAPDF file   =", '"', char (s), '"'
             write (u, "(2x,A,1x,I0)") "LHAPDF member =", &
                  var_list%get_ival (var_str ("lhapdf_member"))
             write (u, "(2x,A,1x,I0)") "LHAPDF scheme =", &
                  var_list%get_ival (&
                  var_str ("lhapdf_photon_scheme"))
          else
             write (u, "(2x,A,1x,A)")  "LHAPDF file   =", "[undefined]"
          end if
       end if
       if (beams%contains ("isr")) then
          write (u, "(2x,A," // FMT_19 // ")") "ISR alpha        =", &
               var_list%get_rval (var_str ("isr_alpha"))
          write (u, "(2x,A," // FMT_19 // ")") "ISR Q max        =", &
               var_list%get_rval (var_str ("isr_q_max"))
          write (u, "(2x,A," // FMT_19 // ")") "ISR mass         =", &
               var_list%get_rval (var_str ("isr_mass"))
          write (u, "(2x,A,1x,I0)") "ISR order        =", &
               var_list%get_ival (var_str ("isr_order"))
          write (u, "(2x,A,1x,L1)") "ISR recoil       =", &
               var_list%get_lval (var_str ("?isr_recoil"))
          write (u, "(2x,A,1x,L1)") "ISR energy cons. =", &
               var_list%get_lval (var_str ("?isr_keep_energy"))
       end if
       if (beams%contains ("epa")) then
          write (u, "(2x,A," // FMT_19 // ")") "EPA alpha         =", &
               var_list%get_rval (var_str ("epa_alpha"))
          write (u, "(2x,A," // FMT_19 // ")") "EPA x min         =", &
               var_list%get_rval (var_str ("epa_x_min"))
          write (u, "(2x,A," // FMT_19 // ")") "EPA Q min         =", &
               var_list%get_rval (var_str ("epa_q_min"))
          write (u, "(2x,A," // FMT_19 // ")") "EPA E max         =", &
               var_list%get_rval (var_str ("epa_e_max"))
          write (u, "(2x,A," // FMT_19 // ")") "EPA mass          =", &
               var_list%get_rval (var_str ("epa_mass"))
          write (u, "(2x,A,1x,L1)") "EPA recoil        =", &
               var_list%get_lval (var_str ("?epa_recoil"))
          write (u, "(2x,A,1x,L1)") "EPA  energy cons. =", &
               var_list%get_lval (var_str ("?epa_keep_energy"))
       end if
       if (beams%contains ("ewa")) then
          write (u, "(2x,A," // FMT_19 // ")") "EWA x min       =", &
               var_list%get_rval (var_str ("ewa_x_min"))
          write (u, "(2x,A," // FMT_19 // ")") "EWA Pt max      =", &
               var_list%get_rval (var_str ("ewa_pt_max"))
          write (u, "(2x,A," // FMT_19 // ")") "EWA mass        =", &
               var_list%get_rval (var_str ("ewa_mass"))
          write (u, "(2x,A,1x,L1)") "EWA recoil       =", &
               var_list%get_lval (var_str ("?ewa_recoil"))
          write (u, "(2x,A,1x,L1)") "EWA energy cons. =", &
               var_list%get_lval (var_str ("ewa_keep_energy"))
       end if
       if (beams%contains ("circe1")) then
          write (u, "(2x,A,1x,I0)") "CIRCE1 version    =", &
               var_list%get_ival (var_str ("circe1_ver"))
          write (u, "(2x,A,1x,I0)") "CIRCE1 revision   =", &
               var_list%get_ival (var_str ("circe1_rev"))
          s = var_list%get_sval (var_str ("$circe1_acc"))
          write (u, "(2x,A,1x,A)") "CIRCE1 acceler.   =", char (s)
          write (u, "(2x,A,1x,I0)") "CIRCE1 chattin.   =", &
               var_list%get_ival (var_str ("circe1_chat"))
          write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 sqrts      =", &
               var_list%get_rval (var_str ("circe1_sqrts"))
          write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 epsil.     =", &
               var_list%get_rval (var_str ("circe1_eps"))
          write (u, "(2x,A,1x,L1)") "CIRCE1 phot. 1  =", &
               var_list%get_lval (var_str ("?circe1_photon1"))
          write (u, "(2x,A,1x,L1)") "CIRCE1 phot. 2  =", &
               var_list%get_lval (var_str ("?circe1_photon2"))
          write (u, "(2x,A,1x,L1)") "CIRCE1 generat. =", &
               var_list%get_lval (var_str ("?circe1_generate"))
          write (u, "(2x,A,1x,L1)") "CIRCE1 mapping  =", &
               var_list%get_lval (var_str ("?circe1_map"))
          write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 map. slope =", &
               var_list%get_rval (var_str ("circe1_mapping_slope"))
          write (u, "(2x,A,1x,L1)") "CIRCE recoil photon =", &
               var_list%get_lval (var_str ("?circe1_with_radiation"))
       end if
       if (beams%contains ("circe2")) then
          s = var_list%get_sval (var_str ("$circe2_design"))
          write (u, "(2x,A,1x,A)") "CIRCE2 design   =", char (s)
          s = var_list%get_sval (var_str ("$circe2_file"))
          write (u, "(2x,A,1x,A)") "CIRCE2 file     =", char (s)
          write (u, "(2x,A,1x,L1)") "CIRCE2 polarized =", &
               var_list%get_lval (var_str ("?circe2_polarized"))
       end if
       if (beams%contains ("gaussian")) then
          write (u, "(2x,A,1x," // FMT_12 // ")") "Gaussian spread 1    =", &
               var_list%get_rval (var_str ("gaussian_spread1"))
          write (u, "(2x,A,1x," // FMT_12 // ")") "Gaussian spread 2    =", &
               var_list%get_rval (var_str ("gaussian_spread2"))
       end if
       if (beams%contains ("beam_events")) then
          s = var_list%get_sval (var_str ("$beam_events_file"))
          write (u, "(2x,A,1x,A)") "Beam events file     =", char (s)
          write (u, "(2x,A,1x,L1)") "Beam events EOF warn =", &
               var_list%get_lval (var_str ("?beam_events_warn_eof"))
       end if
     end associate
   end subroutine rt_data_show_beams
 
 @ %def rt_data_show_beams
 @ Return the collision energy as determined by the current beam
 settings.  Without beam setup, this is the [[sqrts]] variable.
 
 If the value is meaningless for a setup, the function returns zero.
 <<RT data: rt data: TBP>>=
   procedure :: get_sqrts => rt_data_get_sqrts
 <<RT data: procedures>>=
   function rt_data_get_sqrts (rt_data) result (sqrts)
     class(rt_data_t), intent(in) :: rt_data
     real(default) :: sqrts
     sqrts = rt_data%var_list%get_rval (var_str ("sqrts"))
   end function rt_data_get_sqrts
 
 @ %def rt_data_get_sqrts
 @ For testing purposes, the [[rt_data_t]] contents can be pacified to
 suppress numerical fluctuations in (constant) test matrix elements.
 <<RT data: rt data: TBP>>=
   procedure :: pacify => rt_data_pacify
 <<RT data: procedures>>=
   subroutine rt_data_pacify (rt_data, efficiency_reset, error_reset)
     class(rt_data_t), intent(inout) :: rt_data
     logical, intent(in), optional :: efficiency_reset, error_reset
     type(process_entry_t), pointer :: process
     process => rt_data%process_stack%first
     do while (associated (process))
        call process%pacify (efficiency_reset, error_reset)
        process => process%next
     end do
   end subroutine rt_data_pacify
 
 @ %def rt_data_pacify
 @
 <<RT data: rt data: TBP>>=
   procedure :: set_event_callback => rt_data_set_event_callback
 <<RT data: procedures>>=
   subroutine rt_data_set_event_callback (global, callback)
     class(rt_data_t), intent(inout) :: global
     class(event_callback_t), intent(in) :: callback
     if (allocated (global%event_callback))  deallocate (global%event_callback)
     allocate (global%event_callback, source = callback)
   end subroutine rt_data_set_event_callback
 
 @ %def rt_data_set_event_callback
 @
 <<RT data: rt data: TBP>>=
   procedure :: has_event_callback => rt_data_has_event_callback
   procedure :: get_event_callback => rt_data_get_event_callback
 <<RT data: procedures>>=
   function rt_data_has_event_callback (global) result (flag)
     class(rt_data_t), intent(in) :: global
     logical :: flag
     flag = allocated (global%event_callback)
   end function rt_data_has_event_callback
 
   function rt_data_get_event_callback (global) result (callback)
     class(rt_data_t), intent(in) :: global
     class(event_callback_t), allocatable :: callback
     if (allocated (global%event_callback)) then
        allocate (callback, source = global%event_callback)
     end if
   end function rt_data_get_event_callback
 
 @ %def rt_data_has_event_callback
 @ %def rt_data_get_event_callback
 @ Force system-dependent objects to well-defined values.  Some of the
 variables are locked and therefore must be addressed directly.
 
 This is, of course, only required for testing purposes. In principle,
 the [[real_specimen]] variables could be set to their values in
 [[rt_data_t]], but this depends on the precision again, so we set
 them to some dummy values.
 <<RT data: public>>=
   public :: fix_system_dependencies
 <<RT data: procedures>>=
   subroutine fix_system_dependencies (global)
     class(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
 
     var_list => global%get_var_list_ptr ()
     call var_list%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true., force=.true.)
     call var_list%set_log (var_str ("?openmp_is_active"), &
          .false., is_known = .true., force=.true.)
     call var_list%set_int (var_str ("openmp_num_threads_default"), &
          1, is_known = .true., force=.true.)
     call var_list%set_int (var_str ("openmp_num_threads"), &
          1, is_known = .true., force=.true.)
     call var_list%set_int (var_str ("real_range"), &
          307, is_known = .true., force=.true.)
     call var_list%set_int (var_str ("real_precision"), &
          15, is_known = .true., force=.true.)
     call var_list%set_real (var_str ("real_epsilon"), &
          1.e-16_default, is_known = .true., force=.true.)
     call var_list%set_real (var_str ("real_tiny"), &
          1.e-300_default, is_known = .true., force=.true.)
 
     global%os_data%fc = "Fortran-compiler"
     global%os_data%fcflags = "Fortran-flags"
 
   end subroutine fix_system_dependencies
 
 @ %def fix_system_dependencies
 @
 <<RT data: public>>=
   public :: show_description_of_string
 <<RT data: procedures>>=
   subroutine show_description_of_string (string)
     type(string_t), intent(in) :: string
     type(rt_data_t), target :: global
     call global%global_init ()
     call global%show_description_of_string (string, ascii_output=.true.)
   end subroutine show_description_of_string
 
 @ %def show_description_of_string
 @
 <<RT data: public>>=
   public :: show_tex_descriptions
 <<RT data: procedures>>=
   subroutine show_tex_descriptions ()
     type(rt_data_t), target :: global
     call global%global_init ()
     call fix_system_dependencies (global)
     call global%set_int (var_str ("seed"), 0, is_known=.true.)
     call global%var_list%sort ()
     call global%write_var_descriptions ()
   end subroutine show_tex_descriptions
 
 @ %def show_tex_descriptions
 @
 \subsection{Unit Tests}
 Test module, followed by the corresponding implementation module.
 <<[[rt_data_ut.f90]]>>=
 <<File header>>
 
 module rt_data_ut
   use unit_tests
   use rt_data_uti
 
 <<Standard module head>>
 
 <<RT data: public test>>
 
 contains
 
 <<RT data: test driver>>
 
 end module rt_data_ut
 @ %def rt_data_ut
 @
 <<[[rt_data_uti.f90]]>>=
 <<File header>>
 
 module rt_data_uti
 
 <<Use kinds>>
 <<Use strings>>
   use format_defs, only: FMT_19
   use ifiles
   use lexers
   use parser
   use flavors
   use variables, only: var_list_t, var_entry_t, var_entry_init_int
   use eval_trees
   use models
   use prclib_stacks
 
   use rt_data
 
 <<Standard module head>>
 
 <<RT data: test declarations>>
 
 contains
 
 <<RT data: test auxiliary>>
 
 <<RT data: tests>>
 
 end module rt_data_uti
 @ %def rt_data_ut
 @ API: driver for the unit tests below.
 <<RT data: public test>>=
   public :: rt_data_test
 <<RT data: test driver>>=
   subroutine rt_data_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<RT data: execute tests>>
   end subroutine rt_data_test
 
 @ %def rt_data_test
 @
 \subsubsection{Initial content}
 @
 Display the RT data in the state just after (global) initialization.
 <<RT data: execute tests>>=
   call test (rt_data_1, "rt_data_1", &
        "initialize", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_1
 <<RT data: tests>>=
   subroutine rt_data_1 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: rt_data_1"
     write (u, "(A)")  "*   Purpose: initialize global runtime data"
     write (u, "(A)")
 
     call global%global_init (logfile = var_str ("rt_data.log"))
     call fix_system_dependencies (global)
 
     call global%set_int (var_str ("seed"), 0, is_known=.true.)
 
     call global%it_list%init ([2, 3], [5000, 20000])
 
     call global%write (u)
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_1"
 
   end subroutine rt_data_1
 
 @ %def rt_data_1
 @
 \subsubsection{Fill values}
 Fill in empty slots in the runtime data block.
 <<RT data: execute tests>>=
   call test (rt_data_2, "rt_data_2", &
        "fill", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_2
 <<RT data: tests>>=
   subroutine rt_data_2 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(flavor_t), dimension(2) :: flv
     type(string_t) :: cut_expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: parse_tree
 
     write (u, "(A)")  "* Test output: rt_data_2"
     write (u, "(A)")  "*   Purpose: initialize global runtime data &
          &and fill contents"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call fix_system_dependencies (global)
 
     call global%select_model (var_str ("Test"))
 
     call global%set_real (var_str ("sqrts"), &
          1000._default, is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
     call flv%init ([25,25], global%model)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("run1"), is_known = .true.)
     call global%set_real (var_str ("luminosity"), &
          33._default, is_known = .true.)
 
     call syntax_pexpr_init ()
     cut_expr_text = "all Pt > 100 [s]"
     call ifile_append (ifile, cut_expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (parse_tree, stream, .true.)
     global%pn%cuts_lexpr => parse_tree%get_root_ptr ()
 
     allocate (global%sample_fmt (2))
     global%sample_fmt(1) = "foo_fmt"
     global%sample_fmt(2) = "bar_fmt"
 
     call global%write (u)
 
     call parse_tree_final (parse_tree)
     call stream_final (stream)
     call ifile_final (ifile)
     call syntax_pexpr_final ()
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_2"
 
   end subroutine rt_data_2
 
 @ %def rt_data_2
 @
 \subsubsection{Save and restore}
 Set up a local runtime data block, change some contents, restore the
 global block.
 <<RT data: execute tests>>=
   call test (rt_data_3, "rt_data_3", &
        "save/restore", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_3
 <<RT data: tests>>=
   subroutine rt_data_3 (u)
     use event_base, only: event_callback_nop_t
     integer, intent(in) :: u
     type(rt_data_t), target :: global, local
     type(flavor_t), dimension(2) :: flv
     type(string_t) :: cut_expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: parse_tree
     type(prclib_entry_t), pointer :: lib
     type(event_callback_nop_t) :: event_callback_nop
 
     write (u, "(A)")  "* Test output: rt_data_3"
     write (u, "(A)")  "*   Purpose: initialize global runtime data &
          &and fill contents;"
     write (u, "(A)")  "*            copy to local block and back"
     write (u, "(A)")
 
     write (u, "(A)")  "* Init global data"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call fix_system_dependencies (global)
 
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%select_model (var_str ("Test"))
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call flv%init ([25,25], global%model)
 
     call global%beam_structure%init_sf (flv%get_name (), [1])
     call global%beam_structure%set_sf (1, 1, var_str ("pdf_builtin"))
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("run1"), is_known = .true.)
     call global%set_real (var_str ("luminosity"), &
          33._default, is_known = .true.)
 
     call syntax_pexpr_init ()
     cut_expr_text = "all Pt > 100 [s]"
     call ifile_append (ifile, cut_expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (parse_tree, stream, .true.)
     global%pn%cuts_lexpr => parse_tree%get_root_ptr ()
 
     allocate (global%sample_fmt (2))
     global%sample_fmt(1) = "foo_fmt"
     global%sample_fmt(2) = "bar_fmt"
 
     allocate (lib)
     call lib%init (var_str ("library_1"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "* Init and modify local data"
     write (u, "(A)")
 
     call local%local_init (global)
     call local%append_string (var_str ("$integration_method"), intrinsic=.true.)
     call local%append_string (var_str ("$phs_method"), intrinsic=.true.)
 
     call local%activate ()
 
     write (u, "(1x,A,L1)")  "model associated   = ", associated (local%model)
     write (u, "(1x,A,L1)")  "library associated = ", associated (local%prclib)
     write (u, *)
 
     call local%model_set_real (var_str ("ms"), 150._default)
     call local%set_string (var_str ("$integration_method"), &
          var_str ("midpoint"), is_known = .true.)
     call local%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
 
     local%os_data%fc = "Local compiler"
 
     allocate (lib)
     call lib%init (var_str ("library_2"))
     call local%add_prclib (lib)
 
     call local%set_event_callback (event_callback_nop)
 
     call local%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Restore global data"
     write (u, "(A)")
 
     call local%deactivate (global)
 
     write (u, "(1x,A,L1)")  "model associated   = ", associated (global%model)
     write (u, "(1x,A,L1)")  "library associated = ", associated (global%prclib)
     write (u, *)
 
     call global%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call parse_tree_final (parse_tree)
     call stream_final (stream)
     call ifile_final (ifile)
     call syntax_pexpr_final ()
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_3"
 
   end subroutine rt_data_3
 
 @ %def rt_data_3
 @
 \subsubsection{Show variables}
 Display selected variables in the global record.
 <<RT data: execute tests>>=
   call test (rt_data_4, "rt_data_4", &
        "show variables", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_4
 <<RT data: tests>>=
   subroutine rt_data_4 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     type(string_t), dimension(0) :: empty_string_array
 
     write (u, "(A)")  "* Test output: rt_data_4"
     write (u, "(A)")  "*   Purpose: display selected variables"
     write (u, "(A)")
 
     call global%global_init ()
 
     write (u, "(A)")  "* No variables:"
     write (u, "(A)")
 
     call global%write_vars (u, empty_string_array)
 
     write (u, "(A)")  "* Two variables:"
     write (u, "(A)")
 
     call global%write_vars (u, &
          [var_str ("?unweighted"), var_str ("$phs_method")])
 
     write (u, "(A)")
     write (u, "(A)")  "* Display whole record with selected variables"
     write (u, "(A)")
 
     call global%write (u, &
          vars = [var_str ("?unweighted"), var_str ("$phs_method")])
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_4"
 
   end subroutine rt_data_4
 
 @ %def rt_data_4
 @
 \subsubsection{Show parts}
 Display only selected parts in the state just after (global) initialization.
 <<RT data: execute tests>>=
   call test (rt_data_5, "rt_data_5", &
        "show parts", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_5
 <<RT data: tests>>=
   subroutine rt_data_5 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: rt_data_5"
     write (u, "(A)")  "*   Purpose: display parts of rt data"
     write (u, "(A)")
 
     call global%global_init ()
     call global%write_libraries (u)
 
     write (u, "(A)")
 
     call global%write_beams (u)
 
     write (u, "(A)")
 
     call global%write_process_stack (u)
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_5"
 
   end subroutine rt_data_5
 
 @ %def rt_data_5
 @
 \subsubsection{Local Model}
 Locally modify a model and restore the global one.  We need an auxiliary
 function to determine the status of a model particle:
 <<RT data: test auxiliary>>=
   function is_stable (pdg, global) result (flag)
     integer, intent(in) :: pdg
     type(rt_data_t), intent(in) :: global
     logical :: flag
     type(flavor_t) :: flv
     call flv%init (pdg, global%model)
     flag = flv%is_stable ()
   end function is_stable
 
   function is_polarized (pdg, global) result (flag)
     integer, intent(in) :: pdg
     type(rt_data_t), intent(in) :: global
     logical :: flag
     type(flavor_t) :: flv
     call flv%init (pdg, global%model)
     flag = flv%is_polarized ()
   end function is_polarized
 
 @ %def is_stable is_polarized
 <<RT data: execute tests>>=
   call test (rt_data_6, "rt_data_6", &
        "local model", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_6
 <<RT data: tests>>=
   subroutine rt_data_6 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global, local
     type(var_list_t), pointer :: model_vars
     type(string_t) :: var_name
 
     write (u, "(A)")  "* Test output: rt_data_6"
     write (u, "(A)")  "*   Purpose: apply and keep local modifications to model"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%select_model (var_str ("Test"))
 
     write (u, "(A)")  "* Original model"
     write (u, "(A)")
 
     call global%write_model_list (u)
     write (u, *)
     write (u, "(A,L1)")  "s is stable    = ", is_stable (25, global)
     write (u, "(A,L1)")  "f is polarized = ", is_polarized (6, global)
 
     write (u, *)
 
     var_name = "ff"
 
     write (u, "(A)", advance="no")  "Global model variable: "
     model_vars => global%model%get_var_list_ptr ()
     call model_vars%write_var (var_name, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Apply local modifications: unstable"
     write (u, "(A)")
 
     call local%local_init (global)
     call local%activate ()
 
     call local%model_set_real (var_name, 0.4_default)
     call local%modify_particle (25, stable = .false., decay = [var_str ("d1")])
     call local%modify_particle (6, stable = .false., &
          decay = [var_str ("f1")], isotropic_decay = .true.)
     call local%modify_particle (-6, stable = .false., &
          decay = [var_str ("f2"), var_str ("f3")], diagonal_decay = .true.)
 
     call local%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Further modifications"
     write (u, "(A)")
 
     call local%modify_particle (6, stable = .false., &
          decay = [var_str ("f1")], &
          diagonal_decay = .true., isotropic_decay = .false.)
     call local%modify_particle (-6, stable = .false., &
          decay = [var_str ("f2"), var_str ("f3")], &
          diagonal_decay = .false., isotropic_decay = .true.)
     call local%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Further modifications: f stable but polarized"
     write (u, "(A)")
 
     call local%modify_particle (6, stable = .true., polarized = .true.)
     call local%modify_particle (-6, stable = .true.)
     call local%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Global model"
     write (u, "(A)")
 
     call global%model%write (u)
     write (u, *)
     write (u, "(A,L1)")  "s is stable    = ", is_stable (25, global)
     write (u, "(A,L1)")  "f is polarized = ", is_polarized (6, global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Local model"
     write (u, "(A)")
 
     call local%model%write (u)
     write (u, *)
     write (u, "(A,L1)")  "s is stable    = ", is_stable (25, local)
     write (u, "(A,L1)")  "f is polarized = ", is_polarized (6, local)
 
     write (u, *)
 
     write (u, "(A)", advance="no")  "Global model variable: "
     model_vars => global%model%get_var_list_ptr ()
     call model_vars%write_var (var_name, u)
 
     write (u, "(A)", advance="no")  "Local model variable: "
     associate (model_var_list_ptr => local%model%get_var_list_ptr())
        call model_var_list_ptr%write_var (var_name, u)
     end associate
 
     write (u, "(A)")
     write (u, "(A)")  "* Restore global"
 
     call local%deactivate (global, keep_local = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Global model"
     write (u, "(A)")
 
     call global%model%write (u)
     write (u, *)
     write (u, "(A,L1)")  "s is stable    = ", is_stable (25, global)
     write (u, "(A,L1)")  "f is polarized = ", is_polarized (6, global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Local model"
     write (u, "(A)")
 
     call local%model%write (u)
     write (u, *)
     write (u, "(A,L1)")  "s is stable    = ", is_stable (25, local)
     write (u, "(A,L1)")  "f is polarized = ", is_polarized (6, local)
 
     write (u, *)
 
     write (u, "(A)", advance="no")  "Global model variable: "
     model_vars => global%model%get_var_list_ptr ()
     call model_vars%write_var (var_name, u)
 
     write (u, "(A)", advance="no")  "Local model variable: "
     associate (model_var_list_ptr => local%model%get_var_list_ptr())
        call model_var_list_ptr%write_var (var_name, u)
     end associate
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call local%model%final ()
     deallocate (local%model)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_6"
 
   end subroutine rt_data_6
 
 @ %def rt_data_6
 @
 \subsubsection{Result variables}
 Initialize result variables and check that they are accessible via the
 global variable list.
 <<RT data: execute tests>>=
   call test (rt_data_7, "rt_data_7", &
        "result variables", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_7
 <<RT data: tests>>=
   subroutine rt_data_7 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: rt_data_7"
     write (u, "(A)")  "*   Purpose: set and access result variables"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process variables"
     write (u, "(A)")
 
     call global%global_init ()
     call global%process_stack%init_result_vars (var_str ("testproc"))
 
     call global%var_list%write_var (&
          var_str ("integral(testproc)"), u, defined=.true.)
     call global%var_list%write_var (&
          var_str ("error(testproc)"), u, defined=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_7"
 
   end subroutine rt_data_7
 
 @ %def rt_data_7
 @
 \subsubsection{Beam energy}
 If beam parameters are set, the variable [[sqrts]] is not necessarily
 the collision energy.  The method [[get_sqrts]] fetches the correct value.
 <<RT data: execute tests>>=
   call test (rt_data_8, "rt_data_8", &
        "beam energy", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_8
 <<RT data: tests>>=
   subroutine rt_data_8 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: rt_data_8"
     write (u, "(A)")  "*   Purpose: get correct collision energy"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize"
     write (u, "(A)")
 
     call global%global_init ()
 
     write (u, "(A)")  "* Set sqrts"
     write (u, "(A)")
 
     call global%set_real (var_str ("sqrts"), &
          1000._default, is_known = .true.)
     write (u, "(1x,A," // FMT_19 // ")")  "sqrts =", global%get_sqrts ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_8"
 
   end subroutine rt_data_8
 
 @ %def rt_data_8
 @
 \subsubsection{Local variable modifications}
 <<RT data: execute tests>>=
   call test (rt_data_9, "rt_data_9", &
        "local variables", &
        u, results)
 <<RT data: test declarations>>=
   public :: rt_data_9
 <<RT data: tests>>=
   subroutine rt_data_9 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global, local
     type(var_list_t), pointer :: var_list
 
     write (u, "(A)")  "* Test output: rt_data_9"
     write (u, "(A)")  "*   Purpose: handle local variables"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     write (u, "(A)")  "* Initialize global record and set some variables"
     write (u, "(A)")
 
     call global%global_init ()
     call global%select_model (var_str ("Test"))
 
     call global%set_real (var_str ("sqrts"), 17._default, is_known = .true.)
     call global%set_real (var_str ("luminosity"), 2._default, is_known = .true.)
     call global%model_set_real (var_str ("ff"), 0.5_default)
     call global%model_set_real (var_str ("gy"), 1.2_default)
 
     var_list => global%get_var_list_ptr ()
 
     call var_list%write_var (var_str ("sqrts"), u, defined=.true.)
     call var_list%write_var (var_str ("luminosity"), u, defined=.true.)
     call var_list%write_var (var_str ("ff"), u, defined=.true.)
     call var_list%write_var (var_str ("gy"), u, defined=.true.)
     call var_list%write_var (var_str ("mf"), u, defined=.true.)
     call var_list%write_var (var_str ("x"), u, defined=.true.)
 
     write (u, "(A)")
 
     write (u, "(1x,A,1x,F5.2)")  "sqrts      = ", &
          global%get_rval (var_str ("sqrts"))
     write (u, "(1x,A,1x,F5.2)")  "luminosity = ", &
          global%get_rval (var_str ("luminosity"))
     write (u, "(1x,A,1x,F5.2)")  "ff         = ", &
          global%get_rval (var_str ("ff"))
     write (u, "(1x,A,1x,F5.2)")  "gy         = ", &
          global%get_rval (var_str ("gy"))
     write (u, "(1x,A,1x,F5.2)")  "mf         = ", &
          global%get_rval (var_str ("mf"))
     write (u, "(1x,A,1x,F5.2)")  "x          = ", &
          global%get_rval (var_str ("x"))
 
     write (u, "(A)")
     write (u, "(A)")  "* Create local record with local variables"
     write (u, "(A)")
 
     call local%local_init (global)
 
     call local%append_real (var_str ("luminosity"), intrinsic = .true.)
     call local%append_real (var_str ("x"), user = .true.)
 
     call local%activate ()
 
     var_list => local%get_var_list_ptr ()
 
     call var_list%write_var (var_str ("sqrts"), u)
     call var_list%write_var (var_str ("luminosity"), u)
     call var_list%write_var (var_str ("ff"), u)
     call var_list%write_var (var_str ("gy"), u)
     call var_list%write_var (var_str ("mf"), u)
     call var_list%write_var (var_str ("x"), u, defined=.true.)
 
     write (u, "(A)")
 
     write (u, "(1x,A,1x,F5.2)")  "sqrts      = ", &
          local%get_rval (var_str ("sqrts"))
     write (u, "(1x,A,1x,F5.2)")  "luminosity = ", &
          local%get_rval (var_str ("luminosity"))
     write (u, "(1x,A,1x,F5.2)")  "ff         = ", &
          local%get_rval (var_str ("ff"))
     write (u, "(1x,A,1x,F5.2)")  "gy         = ", &
          local%get_rval (var_str ("gy"))
     write (u, "(1x,A,1x,F5.2)")  "mf         = ", &
          local%get_rval (var_str ("mf"))
     write (u, "(1x,A,1x,F5.2)")  "x          = ", &
          local%get_rval (var_str ("x"))
 
     write (u, "(A)")
     write (u, "(A)")  "* Modify some local variables"
     write (u, "(A)")
 
     call local%set_real (var_str ("luminosity"), 42._default, is_known=.true.)
     call local%set_real (var_str ("x"), 6.66_default, is_known=.true.)
     call local%model_set_real (var_str ("ff"), 0.7_default)
 
     var_list => local%get_var_list_ptr ()
 
     call var_list%write_var (var_str ("sqrts"), u)
     call var_list%write_var (var_str ("luminosity"), u)
     call var_list%write_var (var_str ("ff"), u)
     call var_list%write_var (var_str ("gy"), u)
     call var_list%write_var (var_str ("mf"), u)
     call var_list%write_var (var_str ("x"), u, defined=.true.)
 
     write (u, "(A)")
 
     write (u, "(1x,A,1x,F5.2)")  "sqrts      = ", &
          local%get_rval (var_str ("sqrts"))
     write (u, "(1x,A,1x,F5.2)")  "luminosity = ", &
          local%get_rval (var_str ("luminosity"))
     write (u, "(1x,A,1x,F5.2)")  "ff         = ", &
          local%get_rval (var_str ("ff"))
     write (u, "(1x,A,1x,F5.2)")  "gy         = ", &
          local%get_rval (var_str ("gy"))
     write (u, "(1x,A,1x,F5.2)")  "mf         = ", &
          local%get_rval (var_str ("mf"))
     write (u, "(1x,A,1x,F5.2)")  "x          = ", &
          local%get_rval (var_str ("x"))
 
     write (u, "(A)")
     write (u, "(A)")  "* Restore globals"
     write (u, "(A)")
 
     call local%deactivate (global)
 
     var_list => global%get_var_list_ptr ()
 
     call var_list%write_var (var_str ("sqrts"), u)
     call var_list%write_var (var_str ("luminosity"), u)
     call var_list%write_var (var_str ("ff"), u)
     call var_list%write_var (var_str ("gy"), u)
     call var_list%write_var (var_str ("mf"), u)
     call var_list%write_var (var_str ("x"), u, defined=.true.)
 
     write (u, "(A)")
 
     write (u, "(1x,A,1x,F5.2)")  "sqrts      = ", &
          global%get_rval (var_str ("sqrts"))
     write (u, "(1x,A,1x,F5.2)")  "luminosity = ", &
          global%get_rval (var_str ("luminosity"))
     write (u, "(1x,A,1x,F5.2)")  "ff         = ", &
          global%get_rval (var_str ("ff"))
     write (u, "(1x,A,1x,F5.2)")  "gy         = ", &
          global%get_rval (var_str ("gy"))
     write (u, "(1x,A,1x,F5.2)")  "mf         = ", &
          global%get_rval (var_str ("mf"))
     write (u, "(1x,A,1x,F5.2)")  "x          = ", &
          global%get_rval (var_str ("x"))
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call local%local_final ()
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_9"
 
   end subroutine rt_data_9
 
 @ %def rt_data_9
 @
 \subsubsection{Descriptions}
 <<RT data: execute tests>>=
   call test(rt_data_10, "rt_data_10", &
             "descriptions", u, results)
 <<RT data: test declarations>>=
   public :: rt_data_10
 <<RT data: tests>>=
   subroutine rt_data_10 (u)
     integer, intent(in) :: u
     type(rt_data_t) :: global
     ! type(var_list_t) :: var_list
     write (u, "(A)")  "* Test output: rt_data_10"
     write (u, "(A)")  "*   Purpose: display descriptions"
     write (u, "(A)")
 
     call global%var_list%append_real (var_str ("sqrts"), &
           intrinsic=.true., &
           description=var_str ('Real variable in order to set the center-of-mass ' // &
           'energy for the collisions.'))
     call global%var_list%append_real (var_str ("luminosity"), 0._default, &
           intrinsic=.true., &
           description=var_str ('This specifier \ttt{luminosity = {\em ' // &
           '<num>}} sets the integrated luminosity (in inverse femtobarns, ' // &
           'fb${}^{-1}$) for the event generation of the processes in the ' // &
           '\sindarin\ input files.'))
     call global%var_list%append_int (var_str ("seed"), 1234, &
           intrinsic=.true., &
           description=var_str ('Integer variable \ttt{seed = {\em <num>}} ' // &
           'that allows to set a specific random seed \ttt{num}.'))
     call global%var_list%append_string (var_str ("$method"), var_str ("omega"), &
          intrinsic=.true., &
          description=var_str ('This string variable specifies the method ' // &
          'for the matrix elements to be used in the evaluation.'))
     call global%var_list%append_log (var_str ("?read_color_factors"), .true., &
           intrinsic=.true., &
           description=var_str ('This flag decides whether to read QCD ' // &
           'color factors from the matrix element provided by each method, ' // &
           'or to try and calculate the color factors in \whizard\ internally.'))
 
     call global%var_list%sort ()
 
     call global%write_var_descriptions (u)
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_10"
   end subroutine rt_data_10
 
 @ %def rt_data_10
 @
 \subsubsection{Export objects}
 Export objects are variables or other data that should be copied or otherwise
 applied to corresponding objects in the outer scope.
 
 We test appending and retrieval for the export list.
 <<RT data: execute tests>>=
   call test(rt_data_11, "rt_data_11", &
             "export objects", u, results)
 <<RT data: test declarations>>=
   public :: rt_data_11
 <<RT data: tests>>=
   subroutine rt_data_11 (u)
     integer, intent(in) :: u
     type(rt_data_t) :: global
     type(string_t), dimension(:), allocatable :: exports
     integer :: i
 
     write (u, "(A)")  "* Test output: rt_data_11"
     write (u, "(A)")  "*   Purpose: handle export object list"
     write (u, "(A)")
 
     write (u, "(A)")  "* Empty export list"
     write (u, "(A)")
     
     call global%write_exports (u)
 
     write (u, "(A)")  "* Add an entry"
     write (u, "(A)")
     
     allocate (exports (1))
     exports(1) = var_str ("results")
     do i = 1, size (exports)
        write (u, "('+ ',A)")  char (exports(i))
     end do
     write (u, *)
     
     call global%append_exports (exports)
     call global%write_exports (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Add more entries, including doubler"
     write (u, "(A)")
     
     deallocate (exports)
     allocate (exports (3))
     exports(1) = var_str ("foo")
     exports(2) = var_str ("results")
     exports(3) = var_str ("bar")
     do i = 1, size (exports)
        write (u, "('+ ',A)")  char (exports(i))
     end do
     write (u, *)
 
     call global%append_exports (exports)
     call global%write_exports (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
     
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: rt_data_11"
   end subroutine rt_data_11
 
 @ %def rt_data_11
 @
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Select implementations}
 For abstract types (process core, integrator, phase space, etc.), we need a
 way to dynamically select a concrete type, using either data given by the user
 or a previous selection of a concrete type.  This is done by subroutines in
 the current module.
 
 We would like to put this in the [[me_methods]] folder but it also
 depends on [[gosam]] and [[openloops]], so it is unclear where to put
 it.
 <<[[dispatch_me_methods.f90]]>>=
 <<File header>>
 
 module dispatch_me_methods
 
 <<Use strings>>
   use physics_defs, only: BORN
   use diagnostics
   use sm_qcd
   use variables, only: var_list_t
   use models
   use model_data
 
   use prc_core_def
   use prc_core
   use prc_test_core
   use prc_template_me
   use prc_test
   use prc_omega
   use prc_user_defined
   use prc_gosam
   use prc_openloops
   use prc_recola
   use prc_threshold
 
 <<Standard module head>>
 
 <<Dispatch me methods: public>>
 
 contains
 
 <<Dispatch me methods: procedures>>
 
 end module dispatch_me_methods
 @ %def dispatch_me_methods
 \subsection{Process Core Definition}
 The [[prc_core_def_t]] abstract type can be instantiated by providing a
 [[$method]] string variable.
 
 Note: [[core_def]] has intent(inout) because gfortran 4.7.1 crashes for
 intent(out).
 <<Dispatch me methods: public>>=
   public :: dispatch_core_def
 <<Dispatch me methods: procedures>>=
   subroutine dispatch_core_def (core_def, prt_in, prt_out, &
        model, var_list, id, nlo_type, method)
     class(prc_core_def_t), allocatable, intent(inout) :: core_def
     type(string_t), dimension(:), intent(in) :: prt_in
     type(string_t), dimension(:), intent(in) :: prt_out
     type(model_t), pointer, intent(in) :: model
     type(var_list_t), intent(in) :: var_list
     type(string_t), intent(in), optional :: id
     integer, intent(in), optional :: nlo_type
     type(string_t), intent(in), optional :: method
     type(string_t) :: model_name, meth
     type(string_t) :: ufo_path
     type(string_t) :: restrictions
     logical :: ufo
     logical :: cms_scheme
     logical :: openmp_support
     logical :: report_progress
     logical :: diags, diags_color
     logical :: write_phs_output
     type(string_t) :: extra_options
     integer :: nlo
     integer :: alpha_power
     integer :: alphas_power
     if (present (method)) then
        meth = method
     else
        meth = var_list%get_sval (var_str ("$method"))
     end if
     call msg_debug2 (D_CORE, "dispatch_core_def")
     if (associated (model)) then
        model_name = model%get_name ()
        cms_scheme = model%get_scheme () == "Complex_Mass_Scheme"
        ufo = model%is_ufo_model ()
        ufo_path = model%get_ufo_path ()
     else
        model_name = ""
        cms_scheme = .false.
        ufo = .false.
     end if
     restrictions = var_list%get_sval (&
          var_str ("$restrictions"))
     diags = var_list%get_lval (&
          var_str ("?vis_diags"))
     diags_color = var_list%get_lval (&
          var_str ("?vis_diags_color"))
     openmp_support = var_list%get_lval (&
          var_str ("?omega_openmp"))
     report_progress = var_list%get_lval (&
          var_str ("?report_progress"))
     write_phs_output = var_list%get_lval (&
          var_str ("?omega_write_phs_output"))
     extra_options = var_list%get_sval (&
          var_str ("$omega_flags"))
     nlo = BORN;  if (present (nlo_type))  nlo = nlo_type
     alpha_power = var_list%get_ival (var_str ("alpha_power"))
     alphas_power = var_list%get_ival (var_str ("alphas_power"))
     call msg_debug2 (D_CORE, "dispatching core method: ", meth)
     select case (char (meth))
     case ("unit_test")
        allocate (prc_test_def_t :: core_def)
        select type (core_def)
        type is (prc_test_def_t)
           call core_def%init (model_name, prt_in, prt_out)
        end select
     case ("template")
        allocate (template_me_def_t :: core_def)
        select type (core_def)
        type is (template_me_def_t)
           call core_def%init (model, prt_in, prt_out, unity = .false.)
        end select
     case ("template_unity")
        allocate (template_me_def_t :: core_def)
        select type (core_def)
        type is (template_me_def_t)
           call core_def%init (model, prt_in, prt_out, unity = .true.)
        end select
     case ("omega")
        allocate (omega_def_t :: core_def)
        select type (core_def)
        type is (omega_def_t)
           call core_def%init (model_name, prt_in, prt_out, &
                .false., ufo, ufo_path, &
                restrictions, cms_scheme, &
                openmp_support, report_progress, write_phs_output, &
                extra_options, diags, diags_color)
        end select
     case ("ovm")
        allocate (omega_def_t :: core_def)
        select type (core_def)
        type is (omega_def_t)
           call core_def%init (model_name, prt_in, prt_out, &
                .true., .false., var_str (""), &
                restrictions, cms_scheme, &
                openmp_support, report_progress, write_phs_output, &
                extra_options, diags, diags_color)
        end select
     case ("gosam")
       allocate (gosam_def_t :: core_def)
       select type (core_def)
       type is (gosam_def_t)
         if (present (id)) then
            call core_def%init (id, model_name, prt_in, &
                 prt_out, nlo, var_list)
         else
            call msg_fatal ("Dispatch GoSam def: No id!")
         end if
       end select
     case ("openloops")
        allocate (openloops_def_t :: core_def)
        select type (core_def)
        type is (openloops_def_t)
           if (present (id)) then
              call core_def%init (id, model_name, prt_in, &
                   prt_out, nlo, var_list)
           else
              call msg_fatal ("Dispatch OpenLoops def: No id!")
           end if
        end select
     case ("recola")
        call abort_if_recola_not_active ()
        allocate (recola_def_t :: core_def)
        select type (core_def)
        type is (recola_def_t)
           if (present (id)) then
              call core_def%init (id, model_name, prt_in, &
                 prt_out, nlo, alpha_power, alphas_power)
           else
              call msg_fatal ("Dispatch RECOLA def: No id!")
           end if
        end select
     case ("dummy")
        allocate (user_defined_test_def_t :: core_def)
        select type (core_def)
        type is (user_defined_test_def_t)
           if (present (id)) then
              call core_def%init (id, model_name, prt_in, prt_out)
           else
              call msg_fatal ("Dispatch User-Defined Test def: No id!")
           end if
        end select
     case ("threshold")
        allocate (threshold_def_t :: core_def)
        select type (core_def)
        type is (threshold_def_t)
           if (present (id)) then
              call core_def%init (id, model_name, prt_in, prt_out, &
                   nlo, restrictions)
           else
              call msg_fatal ("Dispatch Threshold def: No id!")
           end if
        end select
     case default
        call msg_fatal ("Process configuration: method '" &
             // char (meth) // "' not implemented")
     end select
   end subroutine dispatch_core_def
 
 @ %def dispatch_core_def
 @
 \subsection{Process core allocation}
 Here we allocate an object of abstract type [[prc_core_t]] with a concrete
 type that matches a process definition.  The [[prc_omega_t]] extension
 will require the current parameter set, so we take the opportunity to
 grab it from the model.
 <<Dispatch me methods: public>>=
   public :: dispatch_core
 <<Dispatch me methods: procedures>>=
   subroutine dispatch_core (core, core_def, model, &
        helicity_selection, qcd, use_color_factors)
     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
     select type (core_def)
     type is (prc_test_def_t)
        allocate (test_t :: core)
     type is (template_me_def_t)
        allocate (prc_template_me_t :: core)
        select type (core)
        type is (prc_template_me_t)
           call core%set_parameters (model)
        end select
     class is (omega_def_t)
        if (.not. allocated (core)) allocate (prc_omega_t :: core)
        select type (core)
        type is (prc_omega_t)
           call core%set_parameters (model, &
                helicity_selection, qcd, use_color_factors)
        end select
     type is (gosam_def_t)
       if (.not. allocated (core)) allocate (prc_gosam_t :: core)
       select type (core)
       type is (prc_gosam_t)
         call core%set_parameters (qcd)
       end select
     type is (openloops_def_t)
       if (.not. allocated (core)) allocate (prc_openloops_t :: core)
       select type (core)
       type is (prc_openloops_t)
          call core%set_parameters (qcd)
       end select
     type is (recola_def_t)
       if (.not. allocated (core)) allocate (prc_recola_t :: core)
       select type (core)
       type is (prc_recola_t)
          call core%set_parameters (qcd, model)
       end select
     type is (user_defined_test_def_t)
       if (.not. allocated (core)) allocate (prc_user_defined_test_t :: core)
       select type (core)
       type is (prc_user_defined_test_t)
          call core%set_parameters (qcd, model)
       end select
     type is (threshold_def_t)
       if (.not. allocated (core)) allocate (prc_threshold_t :: core)
       select type (core)
       type is (prc_threshold_t)
          call core%set_parameters (qcd, model)
       end select
     class default
        call msg_bug ("Process core: unexpected process definition type")
     end select
   end subroutine dispatch_core
 
 @ %def dispatch_core
 @
 \subsection{Process core update and restoration}
 Here we take an existing object of abstract type [[prc_core_t]] and
 update the parameters as given by the current state of [[model]].
 Optionally, we can save the previous state as [[saved_core]].  The
 second routine restores the original from the save.
 
 (In the test case, there is no possible update.)
 <<Dispatch me methods: public>>=
   public :: dispatch_core_update
   public :: dispatch_core_restore
 <<Dispatch me methods: procedures>>=
   subroutine dispatch_core_update &
        (core, model, helicity_selection, qcd, saved_core)
 
     class(prc_core_t), allocatable, intent(inout) :: core
     class(model_data_t), intent(in), optional, target :: model
     type(helicity_selection_t), intent(in), optional :: helicity_selection
     type(qcd_t), intent(in), optional :: qcd
     class(prc_core_t), allocatable, intent(inout), optional :: saved_core
 
     if (present (saved_core)) then
        allocate (saved_core, source = core)
     end if
     select type (core)
     type is (test_t)
     type is (prc_omega_t)
        call core%set_parameters (model, helicity_selection, qcd)
        call core%activate_parameters ()
     class is (prc_user_defined_base_t)
       call msg_message ("Updating user defined cores is not implemented yet.")
     class default
        call msg_bug ("Process core update: unexpected process definition type")
     end select
   end subroutine dispatch_core_update
 
   subroutine dispatch_core_restore (core, saved_core)
 
     class(prc_core_t), allocatable, intent(inout) :: core
     class(prc_core_t), allocatable, intent(inout) :: saved_core
 
     call move_alloc (from = saved_core, to = core)
     select type (core)
     type is (test_t)
     type is (prc_omega_t)
        call core%activate_parameters ()
     class default
        call msg_bug ("Process core restore: unexpected process definition type")
     end select
   end subroutine dispatch_core_restore
 
 @ %def dispatch_core_update dispatch_core_restore
 @
 \subsection{Unit Tests}
 Test module, followed by the corresponding implementation module.
 <<[[dispatch_ut.f90]]>>=
 <<File header>>
 
 module dispatch_ut
   use unit_tests
   use dispatch_uti
 
 <<Standard module head>>
 
 <<Dispatch: public test>>
 
 <<Dispatch: public test auxiliary>>
 
 contains
 
 <<Dispatch: test driver>>
 
 end module dispatch_ut
 @ %def dispatch_ut
 @
 <<[[dispatch_uti.f90]]>>=
 <<File header>>
 
 module dispatch_uti
 <<Use kinds>>
 <<Use strings>>
   use os_interface, only: os_data_t, os_data_init
   use physics_defs, only: ELECTRON, PROTON
   use sm_qcd, only: qcd_t
   use flavors, only: flavor_t
   use interactions, only: reset_interaction_counter
   use pdg_arrays, only: pdg_array_t, assignment(=)
   use prc_core_def, only: prc_core_def_t
   use prc_test_core, only: test_t
   use prc_core, only: prc_core_t
   use prc_test, only: prc_test_def_t
   use prc_omega, only: omega_def_t, prc_omega_t
   use sf_mappings, only: sf_channel_t
   use sf_base, only: sf_data_t, sf_config_t
   use phs_base, only: phs_channel_collection_t
   use variables, only: var_list_t
   use model_data, only: model_data_t
   use models, only: syntax_model_file_init, syntax_model_file_final
   use rt_data, only: rt_data_t
 
   use dispatch_phase_space, only: dispatch_sf_channels
   use dispatch_beams, only: sf_prop_t, dispatch_qcd
   use dispatch_beams, only: dispatch_sf_config, dispatch_sf_data
   use dispatch_me_methods, only: dispatch_core_def, dispatch_core
   use dispatch_me_methods, only: dispatch_core_update, dispatch_core_restore
 
   use sf_base_ut, only: sf_test_data_t
 
 <<Standard module head>>
 
 <<Dispatch: public test auxiliary>>
 
 <<Dispatch: test declarations>>
 
 contains
 
 <<Dispatch: tests>>
 
 <<Dispatch: test auxiliary>>
 
 end module dispatch_uti
 
 @ %def dispatch_uti
 @ API: driver for the unit tests below.
 <<Dispatch: public test>>=
   public :: dispatch_test
 <<Dispatch: test driver>>=
   subroutine dispatch_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Dispatch: execute tests>>
   end subroutine dispatch_test
 
 @ %def dispatch_test
 @
 \subsubsection{Select type: process definition}
 <<Dispatch: execute tests>>=
   call test (dispatch_1, "dispatch_1", &
        "process configuration method", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_1
 <<Dispatch: tests>>=
   subroutine dispatch_1 (u)
     integer, intent(in) :: u
     type(string_t), dimension(2) :: prt_in, prt_out
     type(rt_data_t), target :: global
     class(prc_core_def_t), allocatable :: core_def
 
     write (u, "(A)")  "* Test output: dispatch_1"
     write (u, "(A)")  "*   Purpose: select process configuration method"
     write (u, "(A)")
 
     call global%global_init ()
 
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     prt_in = [var_str ("a"), var_str ("b")]
     prt_out = [var_str ("c"), var_str ("d")]
 
     write (u, "(A)")  "* Allocate core_def as prc_test_def"
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
     select type (core_def)
     type is (prc_test_def_t)
        call core_def%write (u)
     end select
 
     deallocate (core_def)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate core_def as omega_def"
     write (u, "(A)")
 
     call global%set_string (var_str ("$method"), &
          var_str ("omega"), is_known = .true.)
     call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
     select type (core_def)
     type is (omega_def_t)
        call core_def%write (u)
     end select
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_1"
 
   end subroutine dispatch_1
 
 @ %def dispatch_1
 @
 \subsubsection{Select type: process core}
 <<Dispatch: execute tests>>=
   call test (dispatch_2, "dispatch_2", &
        "process core", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_2
 <<Dispatch: tests>>=
   subroutine dispatch_2 (u)
     integer, intent(in) :: u
     type(string_t), dimension(2) :: prt_in, prt_out
     type(rt_data_t), target :: global
     class(prc_core_def_t), allocatable :: core_def
     class(prc_core_t), allocatable :: core
 
     write (u, "(A)")  "* Test output: dispatch_2"
     write (u, "(A)")  "*   Purpose: select process configuration method"
     write (u, "(A)")  "             and allocate process core"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
 
     prt_in = [var_str ("a"), var_str ("b")]
     prt_out = [var_str ("c"), var_str ("d")]
 
     write (u, "(A)")  "* Allocate core as test_t"
     write (u, "(A)")
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
     call dispatch_core (core, core_def)
     select type (core)
     type is (test_t)
        call core%write (u)
     end select
 
     deallocate (core)
     deallocate (core_def)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate core as prc_omega_t"
     write (u, "(A)")
 
     call global%set_string (var_str ("$method"), &
          var_str ("omega"), is_known = .true.)
     call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
 
     call global%select_model (var_str ("Test"))
 
     call global%set_log (&
          var_str ("?helicity_selection_active"), &
          .true., is_known = .true.)
     call global%set_real (&
          var_str ("helicity_selection_threshold"), &
          1e9_default, is_known = .true.)
     call global%set_int (&
          var_str ("helicity_selection_cutoff"), &
          10, is_known = .true.)
 
     call dispatch_core (core, core_def, &
          global%model, &
          global%get_helicity_selection ())
     call core_def%allocate_driver (core%driver, var_str (""))
 
     select type (core)
     type is (prc_omega_t)
        call core%write (u)
     end select
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_2"
 
   end subroutine dispatch_2
 
 @ %def dispatch_2
 @
 \subsubsection{Select type: structure-function data}
 This is an extra dispatcher that enables the test structure
 functions.  This procedure should be assigned to the
 [[dispatch_sf_data_extra]] hook before any tests are executed.
 <<Dispatch: public test auxiliary>>=
   public :: dispatch_sf_data_test
 <<Dispatch: test auxiliary>>=
   subroutine dispatch_sf_data_test (data, sf_method, i_beam, sf_prop, &
        var_list, var_list_global, model, os_data, sqrts, pdg_in, pdg_prc, polarized)
     class(sf_data_t), allocatable, intent(inout) :: data
     type(string_t), intent(in) :: sf_method
     integer, dimension(:), intent(in) :: i_beam
     type(var_list_t), intent(in) :: var_list
     type(var_list_t), intent(inout) :: var_list_global
     class(model_data_t), target, intent(in) :: model
     type(os_data_t), intent(in) :: os_data
     real(default), intent(in) :: sqrts
     type(pdg_array_t), dimension(:), intent(inout) :: pdg_in
     type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
     type(sf_prop_t), intent(inout) :: sf_prop
     logical, intent(in) :: polarized
     select case (char (sf_method))
     case ("sf_test_0", "sf_test_1")
        allocate (sf_test_data_t :: data)
        select type (data)
        type is (sf_test_data_t)
           select case (char (sf_method))
           case ("sf_test_0");  call data%init (model, pdg_in(i_beam(1)))
           case ("sf_test_1");  call data%init (model, pdg_in(i_beam(1)),&
                mode = 1)
           end select
        end select
     end select
   end subroutine dispatch_sf_data_test
 
 @ %def dispatch_sf_data_test
 @ The actual test. We can't move this to [[beams]] as it depends on
 [[model_features]] for the [[model_list_t]].
 <<Dispatch: execute tests>>=
   call test (dispatch_7, "dispatch_7", &
        "structure-function data", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_7
 <<Dispatch: tests>>=
   subroutine dispatch_7 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(os_data_t) :: os_data
     type(string_t) :: prt, sf_method
     type(sf_prop_t) :: sf_prop
     class(sf_data_t), allocatable :: data
     type(pdg_array_t), dimension(1) :: pdg_in
     type(pdg_array_t), dimension(1,1) :: pdg_prc
     type(pdg_array_t), dimension(1) :: pdg_out
     integer, dimension(:), allocatable :: pdg1
 
     write (u, "(A)")  "* Test output: dispatch_7"
     write (u, "(A)")  "*   Purpose: select and configure &
          &structure function data"
     write (u, "(A)")
 
     call global%global_init ()
 
     call os_data_init (os_data)
     call syntax_model_file_init ()
     call global%select_model (var_str ("QCD"))
 
     call reset_interaction_counter ()
     call global%set_real (var_str ("sqrts"), &
          14000._default, is_known = .true.)
     prt = "p"
     call global%beam_structure%init_sf ([prt, prt], [1])
     pdg_in = 2212
 
     write (u, "(A)")  "* Allocate data as sf_pdf_builtin_t"
     write (u, "(A)")
 
     sf_method = "pdf_builtin"
     call dispatch_sf_data (data, sf_method, [1], sf_prop, &
          global%get_var_list_ptr (), global%var_list, &
          global%model, global%os_data, global%get_sqrts (), &
          pdg_in, pdg_prc, .false.)
     call data%write (u)
 
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     write (u, "(A)")
     write (u, "(1x,A,99(1x,I0))")  "PDG(out) = ", pdg1
 
     deallocate (data)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate data for different PDF set"
     write (u, "(A)")
 
     pdg_in = 2212
 
     call global%set_string (var_str ("$pdf_builtin_set"), &
          var_str ("CTEQ6M"), is_known = .true.)
     sf_method = "pdf_builtin"
     call dispatch_sf_data (data, sf_method, [1], sf_prop, &
          global%get_var_list_ptr (), global%var_list, &
          global%model, global%os_data, global%get_sqrts (), &
          pdg_in, pdg_prc, .false.)
     call data%write (u)
 
     call data%get_pdg_out (pdg_out)
     pdg1 = pdg_out(1)
     write (u, "(A)")
     write (u, "(1x,A,99(1x,I0))")  "PDG(out) = ", pdg1
 
     deallocate (data)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_7"
 
   end subroutine dispatch_7
 
 @ %def dispatch_7
 @
 \subsubsection{Beam structure}
 The actual test. We can't move this to [[beams]] as it depends on
 [[model_features]] for the [[model_list_t]].
 <<Dispatch: execute tests>>=
   call test (dispatch_8, "dispatch_8", &
        "beam structure", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_8
 <<Dispatch: tests>>=
   subroutine dispatch_8 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(os_data_t) :: os_data
     type(flavor_t), dimension(2) :: flv
     type(sf_config_t), dimension(:), allocatable :: sf_config
     type(sf_prop_t) :: sf_prop
     type(sf_channel_t), dimension(:), allocatable :: sf_channel
     type(phs_channel_collection_t) :: coll
     type(string_t) :: sf_string
     integer :: i
     type(pdg_array_t), dimension (2,1) :: pdg_prc
 
     write (u, "(A)")  "* Test output: dispatch_8"
     write (u, "(A)")  "*   Purpose: configure a structure-function chain"
     write (u, "(A)")
 
     call global%global_init ()
 
     call os_data_init (os_data)
     call syntax_model_file_init ()
     call global%select_model (var_str ("QCD"))
 
     write (u, "(A)")  "* Allocate LHC beams with PDF builtin"
     write (u, "(A)")
 
     call flv(1)%init (PROTON, global%model)
     call flv(2)%init (PROTON, global%model)
 
     call reset_interaction_counter ()
     call global%set_real (var_str ("sqrts"), &
          14000._default, is_known = .true.)
 
     call global%beam_structure%init_sf (flv%get_name (), [1])
     call global%beam_structure%set_sf (1, 1, var_str ("pdf_builtin"))
 
     call dispatch_sf_config (sf_config, sf_prop, global%beam_structure, &
          global%get_var_list_ptr (), global%var_list, &
          global%model, global%os_data, global%get_sqrts (), pdg_prc)
     do i = 1, size (sf_config)
        call sf_config(i)%write (u)
     end do
 
     call dispatch_sf_channels (sf_channel, sf_string, sf_prop, coll, &
          global%var_list, global%get_sqrts(), global%beam_structure)
     write (u, "(1x,A)")  "Mapping configuration:"
     do i = 1, size (sf_channel)
        write (u, "(2x)", advance = "no")
        call sf_channel(i)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate ILC beams with CIRCE1"
     write (u, "(A)")
 
     call global%select_model (var_str ("QED"))
     call flv(1)%init ( ELECTRON, global%model)
     call flv(2)%init (-ELECTRON, global%model)
 
     call reset_interaction_counter ()
     call global%set_real (var_str ("sqrts"), &
          500._default, is_known = .true.)
     call global%set_log (var_str ("?circe1_generate"), &
          .false., is_known = .true.)
 
     call global%beam_structure%init_sf (flv%get_name (), [1])
     call global%beam_structure%set_sf (1, 1, var_str ("circe1"))
 
     call dispatch_sf_config (sf_config, sf_prop, global%beam_structure, &
          global%get_var_list_ptr (), global%var_list, &
          global%model, global%os_data, global%get_sqrts (), pdg_prc)
     do i = 1, size (sf_config)
        call sf_config(i)%write (u)
     end do
 
     call dispatch_sf_channels (sf_channel, sf_string, sf_prop, coll, &
          global%var_list, global%get_sqrts(), global%beam_structure)
     write (u, "(1x,A)")  "Mapping configuration:"
     do i = 1, size (sf_channel)
        write (u, "(2x)", advance = "no")
        call sf_channel(i)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_8"
 
   end subroutine dispatch_8
 
 @ %def dispatch_8
 @
 \subsubsection{Update process core parameters}
 This test dispatches a process core, temporarily modifies parameters,
 then restores the original.
 <<Dispatch: execute tests>>=
   call test (dispatch_10, "dispatch_10", &
        "process core update", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_10
 <<Dispatch: tests>>=
   subroutine dispatch_10 (u)
     integer, intent(in) :: u
     type(string_t), dimension(2) :: prt_in, prt_out
     type(rt_data_t), target :: global
     class(prc_core_def_t), allocatable :: core_def
     class(prc_core_t), allocatable :: core, saved_core
     type(var_list_t), pointer :: model_vars
 
     write (u, "(A)")  "* Test output: dispatch_10"
     write (u, "(A)")  "*   Purpose: select process configuration method,"
     write (u, "(A)")  "             allocate process core,"
     write (u, "(A)")  "             temporarily reset parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
 
     prt_in = [var_str ("a"), var_str ("b")]
     prt_out = [var_str ("c"), var_str ("d")]
 
     write (u, "(A)")  "* Allocate core as prc_omega_t"
     write (u, "(A)")
 
     call global%set_string (var_str ("$method"), &
          var_str ("omega"), is_known = .true.)
     call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
 
     call global%select_model (var_str ("Test"))
 
     call dispatch_core (core, core_def, global%model)
     call core_def%allocate_driver (core%driver, var_str (""))
 
     select type (core)
     type is (prc_omega_t)
        call core%write (u)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Update core with modified model and helicity selection"
     write (u, "(A)")
 
     model_vars => global%model%get_var_list_ptr ()
 
     call model_vars%set_real (var_str ("gy"), 2._default, &
          is_known = .true.)
     call global%model%update_parameters ()
 
     call global%set_log (&
          var_str ("?helicity_selection_active"), &
          .true., is_known = .true.)
     call global%set_real (&
          var_str ("helicity_selection_threshold"), &
          2e10_default, is_known = .true.)
     call global%set_int (&
          var_str ("helicity_selection_cutoff"), &
          5, is_known = .true.)
 
     call dispatch_core_update (core, &
          global%model, &
          global%get_helicity_selection (), &
          saved_core = saved_core)
     select type (core)
     type is (prc_omega_t)
        call core%write (u)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Restore core from save"
     write (u, "(A)")
 
     call dispatch_core_restore (core, saved_core)
     select type (core)
     type is (prc_omega_t)
        call core%write (u)
     end select
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_10"
 
   end subroutine dispatch_10
 
 @ %def dispatch_10
 @
 \subsubsection{QCD Coupling}
 This test dispatches an [[qcd]] object, which is used to compute the
 (running) coupling by one of several possible methods.
 
 We can't move this to [[beams]] as it depends on
 [[model_features]] for the [[model_list_t]].
 <<Dispatch: execute tests>>=
   call test (dispatch_11, "dispatch_11", &
        "QCD coupling", &
        u, results)
 <<Dispatch: test declarations>>=
   public :: dispatch_11
 <<Dispatch: tests>>=
   subroutine dispatch_11 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(qcd_t) :: qcd
     type(var_list_t), pointer :: model_vars
 
     write (u, "(A)")  "* Test output: dispatch_11"
     write (u, "(A)")  "*   Purpose: select QCD coupling formula"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
     call global%select_model (var_str ("SM"))
     model_vars => global%get_var_list_ptr ()
 
     write (u, "(A)")  "* Allocate alpha_s as fixed"
     write (u, "(A)")
 
     call global%set_log (var_str ("?alphas_is_fixed"), &
          .true., is_known = .true.)
     call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
     call qcd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate alpha_s as running (built-in)"
     write (u, "(A)")
 
     call global%set_log (var_str ("?alphas_is_fixed"), &
          .false., is_known = .true.)
     call global%set_log (var_str ("?alphas_from_mz"), &
          .true., is_known = .true.)
     call global%set_int &
          (var_str ("alphas_order"), 1, is_known = .true.)
     call model_vars%set_real (var_str ("alphas"), 0.1234_default, &
           is_known=.true.)
     call model_vars%set_real (var_str ("mZ"), 91.234_default, &
           is_known=.true.)
     call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
     call qcd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate alpha_s as running (built-in, Lambda defined)"
     write (u, "(A)")
 
     call global%set_log (var_str ("?alphas_from_mz"), &
          .false., is_known = .true.)
     call global%set_log (&
          var_str ("?alphas_from_lambda_qcd"), &
          .true., is_known = .true.)
     call global%set_real &
          (var_str ("lambda_qcd"), 250.e-3_default, &
           is_known=.true.)
     call global%set_int &
          (var_str ("alphas_order"), 2, is_known = .true.)
     call global%set_int &
          (var_str ("alphas_nf"), 4, is_known = .true.)
     call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
     call qcd%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate alpha_s as running (using builtin PDF set)"
     write (u, "(A)")
 
     call global%set_log (&
          var_str ("?alphas_from_lambda_qcd"), &
          .false., is_known = .true.)
     call global%set_log &
          (var_str ("?alphas_from_pdf_builtin"), &
          .true., is_known = .true.)
     call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
     call qcd%write (u)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_11"
 
   end subroutine dispatch_11
 
 @ %def dispatch_11
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Process Configuration}
 This module communicates between the toplevel command structure with
 its runtime data set and the process-library handling modules which
 collect the definition of individual processes.  Its primary purpose
 is to select from the available matrix-element generating methods and
 configure the entry in the process library accordingly.
 <<[[process_configurations.f90]]>>=
 <<File header>>
 
 module process_configurations
 
 <<Use strings>>
   use diagnostics
   use io_units
   use physics_defs, only: BORN, NLO_VIRTUAL, NLO_REAL, NLO_DGLAP, &
        NLO_SUBTRACTION, NLO_MISMATCH
   use models
   use prc_core_def
   use particle_specifiers
   use process_libraries
   use rt_data
   use variables, only: var_list_t
 
   use dispatch_me_methods, only: dispatch_core_def
   use prc_user_defined, only: user_defined_def_t
 
 <<Standard module head>>
 
 <<Process configurations: public>>
 
 <<Process configurations: types>>
 
 contains
 
 <<Process configurations: procedures>>
 
 end module process_configurations
 @ %def process_configurations
 @
 \subsection{Data Type}
 <<Process configurations: public>>=
   public :: process_configuration_t
 <<Process configurations: types>>=
   type :: process_configuration_t
      type(process_def_entry_t), pointer :: entry => null ()
      type(string_t) :: id
      integer :: num_id = 0
    contains
    <<Process configurations: process configuration: TBP>>
   end type process_configuration_t
 
 @ %def process_configuration_t
 @ Output (for unit tests).
 <<Process configurations: process configuration: TBP>>=
   procedure :: write => process_configuration_write
 <<Process configurations: procedures>>=
   subroutine process_configuration_write (config, unit)
     class(process_configuration_t), intent(in) :: config
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(A)")  "Process configuration:"
     if (associated (config%entry)) then
        call config%entry%write (u)
     else
        write (u, "(1x,3A)")  "ID    = '", char (config%id), "'"
        write (u, "(1x,A,1x,I0)")  "num ID =", config%num_id
        write (u, "(2x,A)")  "[no entry]"
     end if
   end subroutine process_configuration_write
 
 @ %def process_configuration_write
 @ Initialize a process.  We only need the name, the number of incoming
 particles, and the number of components.
 <<Process configurations: process configuration: TBP>>=
   procedure :: init => process_configuration_init
 <<Process configurations: procedures>>=
   subroutine process_configuration_init &
        (config, prc_name, n_in, n_components, model, var_list, nlo_process)
     class(process_configuration_t), intent(out) :: config
     type(string_t), intent(in) :: prc_name
     integer, intent(in) :: n_in
     integer, intent(in) :: n_components
     type(model_t), intent(in), pointer :: model
     type(var_list_t), intent(in) :: var_list
     logical, intent(in), optional :: nlo_process
     logical :: nlo_proc
     logical :: requires_resonances
     call msg_debug (D_CORE, "process_configuration_init")
     config%id = prc_name
     if (present (nlo_process)) then
        nlo_proc = nlo_process
     else
        nlo_proc = .false.
     end if
     requires_resonances = var_list%get_lval (var_str ("?resonance_history"))
 
     call msg_debug (D_CORE, "nlo_process", nlo_proc)
     allocate (config%entry)
     if (var_list%is_known (var_str ("process_num_id"))) then
        config%num_id = &
             var_list%get_ival (var_str ("process_num_id"))
        call config%entry%init (prc_name, &
             model = model, n_in = n_in, n_components = n_components, &
             num_id = config%num_id, &
             nlo_process = nlo_proc, &
             requires_resonances = requires_resonances)
     else
        call config%entry%init (prc_name, &
             model = model, n_in = n_in, n_components = n_components, &
             nlo_process = nlo_proc, &
             requires_resonances = requires_resonances)
     end if
   end subroutine process_configuration_init
 
 @ %def process_configuration_init
 @ Initialize a process component.  The details depend on the process method,
 which determines the type of the process component core.  We set the incoming
 and outgoing particles (as strings, to be interpreted by the process driver).
 All other information is taken from the variable list.
 
 The dispatcher gets only the names of the particles.  The process
 component definition gets the complete specifiers which contains a
 polarization flag and names of decay processes, where applicable.
 <<Process configurations: process configuration: TBP>>=
   procedure :: setup_component => process_configuration_setup_component
 <<Process configurations: procedures>>=
   subroutine process_configuration_setup_component &
        (config, i_component, prt_in, prt_out, model, var_list, &
         nlo_type, can_be_integrated)
     class(process_configuration_t), intent(inout) :: config
     integer, intent(in) :: i_component
     type(prt_spec_t), dimension(:), intent(in) :: prt_in
     type(prt_spec_t), dimension(:), intent(in) :: prt_out
     type(model_t), pointer, intent(in) :: model
     type(var_list_t), intent(in) :: var_list
     integer, intent(in), optional :: nlo_type
     logical, intent(in), optional :: can_be_integrated
     type(string_t), dimension(:), allocatable :: prt_str_in
     type(string_t), dimension(:), allocatable :: prt_str_out
     class(prc_core_def_t), allocatable :: core_def
     type(string_t) :: method
     type(string_t) :: born_me_method
     type(string_t) :: real_tree_me_method
     type(string_t) :: loop_me_method
     type(string_t) :: correlation_me_method
     type(string_t) :: dglap_me_method
     integer :: i
     call msg_debug2 (D_CORE, "process_configuration_setup_component")
     allocate (prt_str_in  (size (prt_in)))
     allocate (prt_str_out (size (prt_out)))
     forall (i = 1:size (prt_in))  prt_str_in(i)  = prt_in(i)% get_name ()
     forall (i = 1:size (prt_out)) prt_str_out(i) = prt_out(i)%get_name ()
 
     method = var_list%get_sval (var_str ("$method"))
     if (present (nlo_type)) then
        select case (nlo_type)
        case (BORN)
           born_me_method = var_list%get_sval (var_str ("$born_me_method"))
           if (born_me_method /= var_str ("")) then
              method = born_me_method
           end if
        case (NLO_VIRTUAL)
           loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
           if (loop_me_method /= var_str ("")) then
              method = loop_me_method
           end if
        case (NLO_REAL)
           real_tree_me_method = &
                var_list%get_sval (var_str ("$real_tree_me_method"))
           if (real_tree_me_method /= var_str ("")) then
              method = real_tree_me_method
           end if
        case (NLO_DGLAP)
           dglap_me_method = &
                var_list%get_sval (var_str ("$dglap_me_method"))
           if (dglap_me_method /= var_str ("")) then
              method = dglap_me_method
           end if
        case (NLO_SUBTRACTION,NLO_MISMATCH)
           correlation_me_method = &
                var_list%get_sval (var_str ("$correlation_me_method"))
           if (correlation_me_method /= var_str ("")) then
              method = correlation_me_method
           end if
        case default
        end select
     end if
     call dispatch_core_def (core_def, prt_str_in, prt_str_out, &
          model, var_list, config%id, nlo_type, method)
     select type (core_def)
     class is (user_defined_def_t)
        if (present (can_be_integrated)) then
           call core_def%set_active_writer (can_be_integrated)
        else
           call msg_fatal ("Cannot decide if user-defined core is integrated!")
        end if
     end select
 
     call msg_debug2 (D_CORE, "import_component with method ", method)
     call config%entry%import_component (i_component, &
          n_out = size (prt_out), &
          prt_in = prt_in, &
          prt_out = prt_out, &
          method = method, &
          variant = core_def, &
          nlo_type = nlo_type, &
          can_be_integrated = can_be_integrated)
   end subroutine process_configuration_setup_component
 
 @ %def process_configuration_setup_component
 @
 <<Process configurations: process configuration: TBP>>=
   procedure :: set_fixed_emitter => process_configuration_set_fixed_emitter
 <<Process configurations: procedures>>=
   subroutine process_configuration_set_fixed_emitter (config, i, emitter)
      class(process_configuration_t), intent(inout) :: config
      integer, intent(in) :: i, emitter
      call config%entry%set_fixed_emitter (i, emitter)
   end subroutine process_configuration_set_fixed_emitter
 
 @ %def process_configuration_set_fixed_emitter
 @
 <<Process configurations: process configuration: TBP>>=
   procedure :: set_coupling_powers => process_configuration_set_coupling_powers
 <<Process configurations: procedures>>=
   subroutine process_configuration_set_coupling_powers (config, alpha_power, alphas_power)
     class(process_configuration_t), intent(inout) :: config
     integer, intent(in) :: alpha_power, alphas_power
     call config%entry%set_coupling_powers (alpha_power, alphas_power)
   end subroutine process_configuration_set_coupling_powers
 
 @ %def process_configuration_set_coupling_powers
 @
 <<Process configurations: process configuration: TBP>>=
   procedure :: set_component_associations => &
        process_configuration_set_component_associations
 <<Process configurations: procedures>>=
   subroutine process_configuration_set_component_associations &
          (config, i_list, remnant, use_real_finite, mismatch)
     class(process_configuration_t), intent(inout) :: config
     integer, dimension(:), intent(in) :: i_list
     logical, intent(in) :: remnant, use_real_finite, mismatch
     integer :: i_component
     do i_component = 1, config%entry%get_n_components ()
        if (any (i_list == i_component)) then
           call config%entry%set_associated_components (i_component, &
                i_list, remnant, use_real_finite, mismatch)
        end if
     end do
   end subroutine process_configuration_set_component_associations
 
 @ %def process_configuration_set_component_associations
 @ Record a process configuration: append it to the currently selected process
 definition library.
 <<Process configurations: process configuration: TBP>>=
   procedure :: record => process_configuration_record
 <<Process configurations: procedures>>=
   subroutine process_configuration_record (config, global)
     class(process_configuration_t), intent(inout) :: config
     type(rt_data_t), intent(inout) :: global
     if (associated (global%prclib)) then
        call global%prclib%open ()
        call global%prclib%append (config%entry)
        if (config%num_id /= 0) then
           write (msg_buffer, "(5A,I0,A)") "Process library '", &
                char (global%prclib%get_name ()), &
                "': recorded process '", char (config%id), "' (", &
                config%num_id, ")"
        else
           write (msg_buffer, "(5A)") "Process library '", &
                char (global%prclib%get_name ()), &
                "': recorded process '", char (config%id), "'"
        end if
        call msg_message ()
     else
        call msg_fatal ("Recording process '" // char (config%id) &
             // "': active process library undefined")
     end if
   end subroutine process_configuration_record
 
 @ %def process_configuration_record
 @
 \subsection{Unit Tests}
 Test module, followed by the corresponding implementation module.
 <<[[process_configurations_ut.f90]]>>=
 <<File header>>
 
 module process_configurations_ut
   use unit_tests
   use process_configurations_uti
 
 <<Standard module head>>
 
 <<Process configurations: public test>>
 
 <<Process configurations: public test auxiliary>>
 
 contains
 
 <<Process configurations: test driver>>
 
 end module process_configurations_ut
 @ %def process_configurations_ut
 @
 <<[[process_configurations_uti.f90]]>>=
 <<File header>>
 
 module process_configurations_uti
 
 <<Use strings>>
   use particle_specifiers, only: new_prt_spec
   use prclib_stacks
   use models
   use rt_data
 
   use process_configurations
 
 <<Standard module head>>
 
 <<Process configurations: test declarations>>
 
 <<Process configurations: public test auxiliary>>
 
 contains
 
 <<Process configurations: test auxiliary>>
 
 <<Process configurations: tests>>
 
 end module process_configurations_uti
 
 @ %def process_configurations_uti
 @ API: driver for the unit tests below.
 <<Process configurations: public test>>=
   public :: process_configurations_test
 <<Process configurations: test driver>>=
   subroutine process_configurations_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Process configurations: execute tests>>
   end subroutine process_configurations_test
 
 @ %def process_configurations_test
 @
 \subsubsection{Minimal setup}
 The workflow for setting up a minimal process configuration with the
 test matrix element method.
 
 We wrap this in a public procedure, so we can reuse it in later modules.
 The procedure prepares a process definition list for two processes
 (one [[prc_test]] and one [[omega]] type) and appends this to the
 process library stack in the global data set.
 
 The [[mode]] argument determines which processes to build.
 
 The [[procname]] argument replaces the predefined procname(s).
 
 This is re-exported by the UT module.
 <<Process configurations: public test auxiliary>>=
   public :: prepare_test_library
 <<Process configurations: test auxiliary>>=
   subroutine prepare_test_library (global, libname, mode, procname)
     type(rt_data_t), intent(inout), target :: global
     type(string_t), intent(in) :: libname
     integer, intent(in) :: mode
     type(string_t), intent(in), dimension(:), optional :: procname
     type(prclib_entry_t), pointer :: lib
     type(string_t) :: prc_name
     type(string_t), dimension(:), allocatable :: prt_in, prt_out
     integer :: n_components
     type(process_configuration_t) :: prc_config
 
     if (.not. associated (global%prclib_stack%get_first_ptr ())) then
        allocate (lib)
        call lib%init (libname)
        call global%add_prclib (lib)
     end if
 
     if (btest (mode, 0)) then
 
        call global%select_model (var_str ("Test"))
 
        if (present (procname)) then
           prc_name = procname(1)
        else
           prc_name = "prc_config_a"
        end if
        n_components = 1
        allocate (prt_in (2), prt_out (2))
        prt_in = [var_str ("s"), var_str ("s")]
        prt_out = [var_str ("s"), var_str ("s")]
 
        call global%set_string (var_str ("$method"),&
             var_str ("unit_test"), is_known = .true.)
 
        call prc_config%init (prc_name, &
             size (prt_in), n_components, &
             global%model, global%var_list)
        call prc_config%setup_component (1, &
             new_prt_spec (prt_in), new_prt_spec (prt_out), &
             global%model, global%var_list)
        call prc_config%record (global)
 
        deallocate (prt_in, prt_out)
 
     end if
 
     if (btest (mode, 1)) then
 
        call global%select_model (var_str ("QED"))
 
        if (present (procname)) then
           prc_name = procname(2)
        else
           prc_name = "prc_config_b"
        end if
        n_components = 1
        allocate (prt_in (2), prt_out (2))
        prt_in = [var_str ("e+"), var_str ("e-")]
        prt_out = [var_str ("m+"), var_str ("m-")]
 
        call global%set_string (var_str ("$method"),&
             var_str ("omega"), is_known = .true.)
 
        call prc_config%init (prc_name, &
             size (prt_in), n_components, &
             global%model, global%var_list)
        call prc_config%setup_component (1, &
             new_prt_spec (prt_in), new_prt_spec (prt_out), &
             global%model, global%var_list)
        call prc_config%record (global)
 
        deallocate (prt_in, prt_out)
 
     end if
 
     if (btest (mode, 2)) then
 
        call global%select_model (var_str ("Test"))
 
        if (present (procname)) then
           prc_name = procname(1)
        else
           prc_name = "prc_config_a"
        end if
        n_components = 1
        allocate (prt_in (1), prt_out (2))
        prt_in = [var_str ("s")]
        prt_out = [var_str ("f"), var_str ("fbar")]
 
        call global%set_string (var_str ("$method"),&
             var_str ("unit_test"), is_known = .true.)
 
        call prc_config%init (prc_name, &
             size (prt_in), n_components, &
             global%model, global%var_list)
        call prc_config%setup_component (1, &
             new_prt_spec (prt_in), new_prt_spec (prt_out), &
             global%model, global%var_list)
        call prc_config%record (global)
 
        deallocate (prt_in, prt_out)
 
     end if
 
   end subroutine prepare_test_library
 
 @ %def prepare_test_library
 @ The actual test: the previous procedure with some prelude and postlude.
 In the global variable list, just before printing we reset the
 variables where the value may depend on the system and run environment.
 <<Process configurations: execute tests>>=
   call test (process_configurations_1, "process_configurations_1", &
        "test processes", &
        u, results)
 <<Process configurations: test declarations>>=
   public :: process_configurations_1
 <<Process configurations: tests>>=
   subroutine process_configurations_1 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: process_configurations_1"
     write (u, "(A)")  "*   Purpose: configure test processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     write (u, "(A)")  "* Configure processes as prc_test, model Test"
     write (u, "(A)")  "*                     and omega, model QED"
     write (u, *)
 
     call global%set_int (var_str ("process_num_id"), &
          42, is_known = .true.)
     call prepare_test_library (global, var_str ("prc_config_lib_1"), 3)
 
     global%os_data%fc = "Fortran-compiler"
     global%os_data%fcflags = "Fortran-flags"
 
     call global%write_libraries (u)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: process_configurations_1"
 
   end subroutine process_configurations_1
 
 @ %def process_configurations_1
 @
 \subsubsection{\oMega\ options}
 Slightly extended example where we pass \oMega\ options to the
 library.  The [[prepare_test_library]] contents are spelled out.
 <<Process configurations: execute tests>>=
   call test (process_configurations_2, "process_configurations_2", &
        "omega options", &
        u, results)
 <<Process configurations: test declarations>>=
   public :: process_configurations_2
 <<Process configurations: tests>>=
   subroutine process_configurations_2 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
 
     type(string_t) :: libname
     type(prclib_entry_t), pointer :: lib
     type(string_t) :: prc_name
     type(string_t), dimension(:), allocatable :: prt_in, prt_out
     integer :: n_components
     type(process_configuration_t) :: prc_config
 
     write (u, "(A)")  "* Test output: process_configurations_2"
     write (u, "(A)")  "*   Purpose: configure test processes with options"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     write (u, "(A)")  "* Configure processes as omega, model QED"
     write (u, *)
 
     libname = "prc_config_lib_2"
 
     allocate (lib)
     call lib%init (libname)
     call global%add_prclib (lib)
 
     call global%select_model (var_str ("QED"))
 
     prc_name = "prc_config_c"
     n_components = 2
     allocate (prt_in (2), prt_out (2))
     prt_in = [var_str ("e+"), var_str ("e-")]
     prt_out = [var_str ("m+"), var_str ("m-")]
 
     call global%set_string (var_str ("$method"),&
          var_str ("omega"), is_known = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     call prc_config%init (prc_name, size (prt_in), n_components, &
          global%model, global%var_list)
 
     call global%set_log (var_str ("?report_progress"), &
          .true., is_known = .true.)
     call prc_config%setup_component (1, &
          new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)
 
     call global%set_log (var_str ("?report_progress"), &
          .false., is_known = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .true., is_known = .true.)
     call global%set_string (var_str ("$restrictions"),&
          var_str ("3+4~A"), is_known = .true.)
     call global%set_string (var_str ("$omega_flags"), &
          var_str ("-fusion:progress_file omega_prc_config.log"), &
          is_known = .true.)
     call prc_config%setup_component (2, &
          new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)
 
     call prc_config%record (global)
 
     deallocate (prt_in, prt_out)
 
     global%os_data%fc = "Fortran-compiler"
     global%os_data%fcflags = "Fortran-flags"
 
     call global%write_vars (u, [ &
          var_str ("$model_name"), &
          var_str ("$method"), &
          var_str ("?report_progress"), &
          var_str ("$restrictions"), &
          var_str ("$omega_flags")])
     write (u, "(A)")
     call global%write_libraries (u)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: process_configurations_2"
 
   end subroutine process_configurations_2
 
 @ %def process_configurations_2
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Compilation}
 This module manages compilation and loading of of process libraries.  It is
 needed as a separate module because integration depends on it.
 <<[[compilations.f90]]>>=
 <<File header>>
 
 module compilations
 
 <<Use strings>>
   use io_units
   use system_defs, only: TAB
   use diagnostics
   use os_interface
   use variables, only: var_list_t
   use model_data
   use process_libraries
   use prclib_stacks
   use rt_data
 
 <<Standard module head>>
 
 <<Compilations: public>>
 
 <<Compilations: types>>
 
 <<Compilations: parameters>>
 
 contains
 
 <<Compilations: procedures>>
 
 end module compilations
 @ %def compilations
 @
 \subsection{The data type}
 The compilation item handles the compilation and loading of a single
 process library.
 <<Compilations: public>>=
   public :: compilation_item_t
 <<Compilations: types>>=
   type :: compilation_item_t
      private
      type(string_t) :: libname
      type(string_t) :: static_external_tag
      type(process_library_t), pointer :: lib => null ()
      logical :: recompile_library = .false.
      logical :: verbose = .false.
      logical :: use_workspace = .false.
      type(string_t) :: workspace
    contains
    <<Compilations: compilation item: TBP>>
   end type compilation_item_t
 
 @ %def compilation_item_t
 @ Initialize.
 
 Set flags and global properties of the library.  Establish the workspace name,
 if defined.
 <<Compilations: compilation item: TBP>>=
   procedure :: init => compilation_item_init
 <<Compilations: procedures>>=
   subroutine compilation_item_init (comp, libname, stack, var_list)
     class(compilation_item_t), intent(out) :: comp
     type(string_t), intent(in) :: libname
     type(prclib_stack_t), intent(inout) :: stack
     type(var_list_t), intent(in) :: var_list
     comp%libname = libname
     comp%lib => stack%get_library_ptr (comp%libname)
     if (.not. associated (comp%lib)) then
        call msg_fatal ("Process library '" // char (comp%libname) &
             // "' has not been declared.")
     end if
     comp%recompile_library = &
          var_list%get_lval (var_str ("?recompile_library"))
     comp%verbose = &
          var_list%get_lval (var_str ("?me_verbose"))
     comp%use_workspace = &
          var_list%is_known (var_str ("$compile_workspace"))
     if (comp%use_workspace) then
        comp%workspace = &
             var_list%get_sval (var_str ("$compile_workspace"))
        if (comp%workspace == "")  comp%use_workspace = .false.
     else
        comp%workspace = ""
     end if
   end subroutine compilation_item_init
 
 @ %def compilation_item_init
 @ Compile the current library.  The [[force]] flag has the
 effect that we first delete any previous files, as far as accessible
 by the current makefile.  It also guarantees that previous files not
 accessible by a makefile will be overwritten.
 <<Compilations: compilation item: TBP>>=
   procedure :: compile => compilation_item_compile
 <<Compilations: procedures>>=
   subroutine compilation_item_compile (comp, model, os_data, force, recompile)
     class(compilation_item_t), intent(inout) :: comp
     class(model_data_t), intent(in), target :: model
     type(os_data_t), intent(in) :: os_data
     logical, intent(in) :: force, recompile
     if (associated (comp%lib)) then
        if (comp%use_workspace)  call setup_workspace (comp%workspace, os_data)
        call msg_message ("Process library '" &
             // char (comp%libname) // "': compiling ...")
        call comp%lib%configure (os_data)
        if (signal_is_pending ())  return
        call comp%lib%compute_md5sum (model)
        call comp%lib%write_makefile &
             (os_data, force, verbose=comp%verbose, workspace=comp%workspace)
        if (signal_is_pending ())  return
        if (force) then
           call comp%lib%clean &
                (os_data, distclean = .false., workspace=comp%workspace)
           if (signal_is_pending ())  return
        end if
        call comp%lib%write_driver (force, workspace=comp%workspace)
        if (signal_is_pending ())  return
        if (recompile) then
           call comp%lib%load &
                (os_data, keep_old_source = .true., workspace=comp%workspace)
           if (signal_is_pending ())  return
        end if
        call comp%lib%update_status (os_data, workspace=comp%workspace)
     end if
   end subroutine compilation_item_compile
 
 @ %def compilation_item_compile
 @ The workspace directory is created if it does not exist.  (Applies only if
 the use has set the workspace directory.)
 <<Compilations: parameters>>=
   character(*), parameter :: ALLOWED_IN_DIRNAME = &
        "abcdefghijklmnopqrstuvwxyz&
        &ABCDEFGHIJKLMNOPQRSTUVWXYZ&
        &1234567890&
        &.,_-+="
 @ %def ALLOWED_IN_DIRNAME
 <<Compilations: procedures>>=
   subroutine setup_workspace (workspace, os_data)
     type(string_t), intent(in) :: workspace
     type(os_data_t), intent(in) :: os_data
     if (verify (workspace, ALLOWED_IN_DIRNAME) == 0) then
        call msg_message ("Compile: preparing workspace directory '" &
             // char (workspace) // "'")
        call os_system_call ("mkdir -p '" // workspace // "'")
     else
        call msg_fatal ("compile: workspace name '" &
             // char (workspace) // "' contains illegal characters")
     end if
   end subroutine setup_workspace
 
 @ %def setup_workspace
 @ Load the current library, just after compiling it.
 <<Compilations: compilation item: TBP>>=
   procedure :: load => compilation_item_load
 <<Compilations: procedures>>=
   subroutine compilation_item_load (comp, os_data)
     class(compilation_item_t), intent(inout) :: comp
     type(os_data_t), intent(in) :: os_data
     if (associated (comp%lib)) then
        call comp%lib%load (os_data, workspace=comp%workspace)
     end if
   end subroutine compilation_item_load
 
 @ %def compilation_item_load
 @ Message as a separate call:
 <<Compilations: compilation item: TBP>>=
   procedure :: success => compilation_item_success
 <<Compilations: procedures>>=
   subroutine compilation_item_success (comp)
     class(compilation_item_t), intent(in) :: comp
     if (associated (comp%lib)) then
        call msg_message ("Process library '" // char (comp%libname) &
             // "': ... success.")
     else
        call msg_fatal ("Process library '" // char (comp%libname) &
             // "': ... failure.")
     end if
   end subroutine compilation_item_success
 
 @ %def compilation_item_success
 @ %def compilation_item_failure
 @
 \subsection{API for library compilation and loading}
 This is a shorthand for compiling and loading a single library.  The
 [[compilation_item]] object is used only internally.
 
 The [[global]] data set may actually be local to the caller.  The
 compilation affects the library specified by its name if it is on the
 stack, but it does not reset the currently selected library.
 <<Compilations: public>>=
   public :: compile_library
 <<Compilations: procedures>>=
   subroutine compile_library (libname, global)
     type(string_t), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: global
     type(compilation_item_t) :: comp
     logical :: force, recompile
     force = &
          global%var_list%get_lval (var_str ("?rebuild_library"))
     recompile = &
          global%var_list%get_lval (var_str ("?recompile_library"))
     if (associated (global%model)) then
        call comp%init (libname, global%prclib_stack, global%var_list)
        call comp%compile (global%model, global%os_data, force, recompile)
        if (signal_is_pending ())  return
        call comp%load (global%os_data)
        if (signal_is_pending ())  return
     else
        call msg_fatal ("Process library compilation: " &
             // " model is undefined.")
     end if
     call comp%success ()
   end subroutine compile_library
 
 @ %def compile_library
 @
 \subsection{Compiling static executable}
 This object handles the creation of a static executable which should
 contain a set of static process libraries.
 <<Compilations: public>>=
   public :: compilation_t
 <<Compilations: types>>=
   type :: compilation_t
      private
      type(string_t) :: exe_name
      type(string_t), dimension(:), allocatable :: lib_name
    contains
    <<Compilations: compilation: TBP>>
   end type compilation_t
 
 @ %def compilation_t
 @ Output.
 <<Compilations: compilation: TBP>>=
   procedure :: write => compilation_write
 <<Compilations: procedures>>=
   subroutine compilation_write (object, unit)
     class(compilation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Compilation object:"
     write (u, "(3x,3A)")  "executable        = '", &
          char (object%exe_name), "'"
     write (u, "(3x,A)", advance="no")  "process libraries ="
     do i = 1, size (object%lib_name)
        write (u, "(1x,3A)", advance="no")  "'", char (object%lib_name(i)), "'"
     end do
     write (u, *)
   end subroutine compilation_write
 
 @ %def compilation_write
 @ Initialize: we know the names of the executable and of the libraries.
 Optionally, we may provide a workspace directory.
 <<Compilations: compilation: TBP>>=
   procedure :: init => compilation_init
 <<Compilations: procedures>>=
   subroutine compilation_init (compilation, exe_name, lib_name)
     class(compilation_t), intent(out) :: compilation
     type(string_t), intent(in) :: exe_name
     type(string_t), dimension(:), intent(in) :: lib_name
     compilation%exe_name = exe_name
     allocate (compilation%lib_name (size (lib_name)))
     compilation%lib_name = lib_name
   end subroutine compilation_init
 
 @ %def compilation_init
 @ Write the dispatcher subroutine for the compiled libraries.  Also
 write a subroutine which returns the names of the compiled libraries.
 <<Compilations: compilation: TBP>>=
   procedure :: write_dispatcher => compilation_write_dispatcher
 <<Compilations: procedures>>=
   subroutine compilation_write_dispatcher (compilation)
     class(compilation_t), intent(in) :: compilation
     type(string_t) :: file
     integer :: u, i
     file = compilation%exe_name // "_prclib_dispatcher.f90"
     call msg_message ("Static executable '" // char (compilation%exe_name) &
          // "': writing library dispatcher")
     u = free_unit ()
     open (u, file = char (file), status="replace", action="write")
     write (u, "(3A)")  "! Whizard: process libraries for executable '", &
          char (compilation%exe_name), "'"
     write (u, "(A)")  "! Automatically generated file, do not edit"
     write (u, "(A)")  "subroutine dispatch_prclib_static " // &
          "(driver, basename, modellibs_ldflags)"
     write (u, "(A)")  "  use iso_varying_string, string_t => varying_string"
     write (u, "(A)")  "  use prclib_interfaces"
     do i = 1, size (compilation%lib_name)
        associate (lib_name => compilation%lib_name(i))
          write (u, "(A)")  "  use " // char (lib_name) // "_driver"
        end associate
     end do
     write (u, "(A)")  "  implicit none"
     write (u, "(A)")  "  class(prclib_driver_t), intent(inout), allocatable &
          &:: driver"
     write (u, "(A)")  "  type(string_t), intent(in) :: basename"
     write (u, "(A)")  "  logical, intent(in), optional :: " // &
          "modellibs_ldflags"
     write (u, "(A)")  "  select case (char (basename))"
     do i = 1, size (compilation%lib_name)
        associate (lib_name => compilation%lib_name(i))
          write (u, "(3A)")  "  case ('", char (lib_name), "')"
          write (u, "(3A)")  "     allocate (", char (lib_name), "_driver_t &
               &:: driver)"
        end associate
     end do
     write (u, "(A)")  "  end select"
     write (u, "(A)")  "end subroutine dispatch_prclib_static"
     write (u, *)
     write (u, "(A)")  "subroutine get_prclib_static (libname)"
     write (u, "(A)")  "  use iso_varying_string, string_t => varying_string"
     write (u, "(A)")  "  implicit none"
     write (u, "(A)")  "  type(string_t), dimension(:), intent(inout), &
          &allocatable :: libname"
     write (u, "(A,I0,A)")  "  allocate (libname (", &
          size (compilation%lib_name), "))"
     do i = 1, size (compilation%lib_name)
        associate (lib_name => compilation%lib_name(i))
          write (u, "(A,I0,A,A,A)")  "  libname(", i, ") = '", &
               char (lib_name), "'"
        end associate
     end do
     write (u, "(A)")  "end subroutine get_prclib_static"
     close (u)
   end subroutine compilation_write_dispatcher
 
 @ %def compilation_write_dispatcher
 @ Write the Makefile subroutine for the compiled libraries.
 <<Compilations: compilation: TBP>>=
   procedure :: write_makefile => compilation_write_makefile
 <<Compilations: procedures>>=
   subroutine compilation_write_makefile &
        (compilation, os_data, ext_libtag, verbose)
     class(compilation_t), intent(in) :: compilation
     type(os_data_t), intent(in) :: os_data
     logical, intent(in) :: verbose
     type(string_t), intent(in), optional :: ext_libtag
     type(string_t) :: file, ext_tag
     integer :: u, i
     if (present (ext_libtag)) then
        ext_tag = ext_libtag
     else
        ext_tag = ""
     end if
     file = compilation%exe_name // ".makefile"
     call msg_message ("Static executable '" // char (compilation%exe_name) &
          // "': writing makefile")
     u = free_unit ()
     open (u, file = char (file), status="replace", action="write")
     write (u, "(3A)")  "# WHIZARD: Makefile for executable '", &
          char (compilation%exe_name), "'"
     write (u, "(A)")  "# Automatically generated file, do not edit"
     write (u, "(A)") ""
     write (u, "(A)") "# Executable name"
     write (u, "(A)") "EXE = " // char (compilation%exe_name)
     write (u, "(A)") ""
     write (u, "(A)") "# Compiler"
     write (u, "(A)") "FC = " // char (os_data%fc)
     write (u, "(A)") ""
     write (u, "(A)") "# Included libraries"
     write (u, "(A)") "FCINCL = " // char (os_data%whizard_includes)
     write (u, "(A)") ""
     write (u, "(A)") "# Compiler flags"
     write (u, "(A)") "FCFLAGS = " // char (os_data%fcflags)
     write (u, "(A)") "LDFLAGS = " // char (os_data%ldflags)
     write (u, "(A)") "LDFLAGS_STATIC = " // char (os_data%ldflags_static)
     write (u, "(A)") "LDFLAGS_HEPMC = " // char (os_data%ldflags_hepmc)
     write (u, "(A)") "LDFLAGS_LCIO = " // char (os_data%ldflags_lcio)
     write (u, "(A)") "LDFLAGS_HOPPET = " // char (os_data%ldflags_hoppet)
     write (u, "(A)") "LDFLAGS_LOOPTOOLS = " // char (os_data%ldflags_looptools)
     write (u, "(A)") "LDWHIZARD = " // char (os_data%whizard_ldflags)
     write (u, "(A)") ""
     write (u, "(A)") "# Libtool"
     write (u, "(A)") "LIBTOOL = " // char (os_data%whizard_libtool)
     if (verbose) then
        write (u, "(A)") "FCOMPILE = $(LIBTOOL) --tag=FC --mode=compile"
        write (u, "(A)") "LINK = $(LIBTOOL) --tag=FC --mode=link"
     else
        write (u, "(A)") "FCOMPILE = @$(LIBTOOL) --silent --tag=FC --mode=compile"
        write (u, "(A)") "LINK = @$(LIBTOOL) --silent --tag=FC --mode=link"
     end if
     write (u, "(A)") ""
     write (u, "(A)") "# Compile commands (default)"
     write (u, "(A)") "LTFCOMPILE = $(FCOMPILE) $(FC) -c $(FCINCL) $(FCFLAGS)"
     write (u, "(A)") ""
     write (u, "(A)") "# Default target"
     write (u, "(A)") "all: link"
     write (u, "(A)") ""
     write (u, "(A)") "# Libraries"
     do i = 1, size (compilation%lib_name)
        associate (lib_name => compilation%lib_name(i))
          write (u, "(A)") "LIBRARIES += " // char (lib_name) // ".la"
          write (u, "(A)") char (lib_name) // ".la:"
          write (u, "(A)") TAB // "$(MAKE) -f " // char (lib_name) // ".makefile"
        end associate
     end do
     write (u, "(A)") ""
     write (u, "(A)") "# Library dispatcher"
     write (u, "(A)") "DISP = $(EXE)_prclib_dispatcher"
     write (u, "(A)") "$(DISP).lo: $(DISP).f90 $(LIBRARIES)"
     if (.not. verbose) then
        write (u, "(A)")  TAB // '@echo  "  FC       " $@'
     end if
     write (u, "(A)") TAB // "$(LTFCOMPILE) $<"
     write (u, "(A)") ""
     write (u, "(A)") "# Executable"
     write (u, "(A)") "$(EXE): $(DISP).lo $(LIBRARIES)"
     if (.not. verbose) then
        write (u, "(A)")  TAB // '@echo  "  FCLD     " $@'
     end if
     write (u, "(A)") TAB // "$(LINK) $(FC) -static-libtool-libs $(FCFLAGS) \"
     write (u, "(A)") TAB // "   $(LDWHIZARD) $(LDFLAGS) \"
     write (u, "(A)") TAB // "   -o $(EXE) $^ \"
     write (u, "(A)") TAB // "   $(LDFLAGS_HEPMC) $(LDFLAGS_LCIO) $(LDFLAGS_HOPPET) \"
     write (u, "(A)") TAB // "   $(LDFLAGS_LOOPTOOLS) $(LDFLAGS_STATIC)" // char (ext_tag)
     write (u, "(A)") ""
     write (u, "(A)") "# Main targets"
     write (u, "(A)") "link: compile $(EXE)"
     write (u, "(A)") "compile: $(LIBRARIES) $(DISP).lo"
     write (u, "(A)") ".PHONY: link compile"
     write (u, "(A)") ""
     write (u, "(A)") "# Cleanup targets"
     write (u, "(A)") "clean-exe:"
     write (u, "(A)") TAB // "rm -f $(EXE)"
     write (u, "(A)") "clean-objects:"
     write (u, "(A)") TAB // "rm -f $(DISP).lo"
     write (u, "(A)") "clean-source:"
     write (u, "(A)") TAB // "rm -f $(DISP).f90"
     write (u, "(A)") "clean-makefile:"
     write (u, "(A)") TAB // "rm -f $(EXE).makefile"
     write (u, "(A)") ""
     write (u, "(A)") "clean: clean-exe clean-objects clean-source"
     write (u, "(A)") "distclean: clean clean-makefile"
     write (u, "(A)") ".PHONY: clean distclean"
     close (u)
   end subroutine compilation_write_makefile
 
 @ %def compilation_write_makefile
 @ Compile the dispatcher source code.
 <<Compilations: compilation: TBP>>=
   procedure :: make_compile => compilation_make_compile
 <<Compilations: procedures>>=
   subroutine compilation_make_compile (compilation, os_data)
     class(compilation_t), intent(in) :: compilation
     type(os_data_t), intent(in) :: os_data
     call os_system_call ("make compile " // os_data%makeflags &
          // " -f " // compilation%exe_name // ".makefile")
   end subroutine compilation_make_compile
 
 @ %def compilation_make_compile
 @ Link the dispatcher together with all matrix-element code and the
 \whizard\ and \oMega\ main libraries, to generate a static executable.
 <<Compilations: compilation: TBP>>=
   procedure :: make_link => compilation_make_link
 <<Compilations: procedures>>=
   subroutine compilation_make_link (compilation, os_data)
     class(compilation_t), intent(in) :: compilation
     type(os_data_t), intent(in) :: os_data
     call os_system_call ("make link " // os_data%makeflags &
          // " -f " // compilation%exe_name // ".makefile")
   end subroutine compilation_make_link
 
 @ %def compilation_make_link
 @ Cleanup.
 <<Compilations: compilation: TBP>>=
   procedure :: make_clean_exe => compilation_make_clean_exe
 <<Compilations: procedures>>=
   subroutine compilation_make_clean_exe (compilation, os_data)
     class(compilation_t), intent(in) :: compilation
     type(os_data_t), intent(in) :: os_data
     call os_system_call ("make clean-exe " // os_data%makeflags &
          // " -f " // compilation%exe_name // ".makefile")
   end subroutine compilation_make_clean_exe
 
 @ %def compilation_make_clean_exe
 @
 \subsection{API for executable compilation}
 This is a shorthand for compiling and loading an executable, including
 the enclosed libraries.  The [[compilation]] object is used only internally.
 
 The [[global]] data set may actually be local to the caller.  The
 compilation affects the library specified by its name if it is on the
 stack, but it does not reset the currently selected library.
 <<Compilations: public>>=
   public :: compile_executable
 <<Compilations: procedures>>=
   subroutine compile_executable (exename, libname, global)
     type(string_t), intent(in) :: exename
     type(string_t), dimension(:), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: global
     type(compilation_t) :: compilation
     type(compilation_item_t) :: item
     type(string_t) :: ext_libtag
     logical :: force, recompile, verbose
     integer :: i
     ext_libtag = ""
     force = &
          global%var_list%get_lval (var_str ("?rebuild_library"))
     recompile = &
          global%var_list%get_lval (var_str ("?recompile_library"))
     verbose = &
          global%var_list%get_lval (var_str ("?me_verbose"))
     call compilation%init (exename, [libname])
     if (signal_is_pending ())  return
     call compilation%write_dispatcher ()
     if (signal_is_pending ())  return
     do i = 1, size (libname)
        call item%init (libname(i), global%prclib_stack, global%var_list)
        call item%compile (global%model, global%os_data, &
             force=force, recompile=recompile)
        ext_libtag = "" // item%lib%get_static_modelname (global%os_data)
        if (signal_is_pending ())  return
        call item%success ()
     end do
     call compilation%write_makefile &
          (global%os_data, ext_libtag=ext_libtag, verbose=verbose)
     if (signal_is_pending ())  return
     call compilation%make_compile (global%os_data)
     if (signal_is_pending ())  return
     call compilation%make_link (global%os_data)
   end subroutine compile_executable
 
 @ %def compile_executable
 @
 \subsection{Unit Tests}
 Test module, followed by the stand-alone unit-test procedures.
 <<[[compilations_ut.f90]]>>=
 <<File header>>
 
 module compilations_ut
   use unit_tests
   use compilations_uti
 
 <<Standard module head>>
 
 <<Compilations: public test>>
 
 contains
 
 <<Compilations: test driver>>
 
 end module compilations_ut
 @ %def compilations_ut
 @
 <<[[compilations_uti.f90]]>>=
 <<File header>>
 
 module compilations_uti
 
 <<Use strings>>
   use io_units
   use models
   use rt_data
   use process_configurations_ut, only: prepare_test_library
 
   use compilations
 
 <<Standard module head>>
 
 <<Compilations: test declarations>>
 
 contains
 
 <<Compilations: tests>>
 
 end module compilations_uti
 
 @ %def compilations_uti
 @ API: driver for the unit tests below.
 <<Compilations: public test>>=
   public :: compilations_test
 <<Compilations: test driver>>=
   subroutine compilations_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Compilations: execute tests>>
 end subroutine compilations_test
 
 @ %def compilations_test
 @
 \subsubsection{Intrinsic Matrix Element}
 Compile an intrinsic test matrix element ([[prc_test]] type).
 
 Note: In this and the following test, we reset the Fortran compiler and flag
 variables immediately before they are printed, so the test is portable.
 <<Compilations: execute tests>>=
   call test (compilations_1, "compilations_1", &
        "intrinsic test processes", &
        u, results)
 <<Compilations: test declarations>>=
   public :: compilations_1
 <<Compilations: tests>>=
   subroutine compilations_1 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: compilations_1"
     write (u, "(A)")  "*   Purpose: configure and compile test process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     libname = "compilation_1"
     procname = "prc_comp_1"
     call prepare_test_library (global, libname, 1, [procname])
 
     call compile_library (libname, global)
 
     call global%write_libraries (u)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: compilations_1"
 
   end subroutine compilations_1
 
 @ %def compilations_1
 @
 \subsubsection{External Matrix Element}
 Compile an external test matrix element ([[omega]] type)
 <<Compilations: execute tests>>=
   call test (compilations_2, "compilations_2", &
        "external process (omega)", &
        u, results)
 <<Compilations: test declarations>>=
   public :: compilations_2
 <<Compilations: tests>>=
   subroutine compilations_2 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: compilations_2"
     write (u, "(A)")  "*   Purpose: configure and compile test process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     libname = "compilation_2"
     procname = "prc_comp_2"
     call prepare_test_library (global, libname, 2, [procname,procname])
 
     call compile_library (libname, global)
 
     call global%write_libraries (u, libpath = .false.)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: compilations_2"
 
   end subroutine compilations_2
 
 @ %def compilations_2
 @
 \subsubsection{External Matrix Element}
 Compile an external test matrix element ([[omega]] type) and
 create driver files for a static executable.
 <<Compilations: execute tests>>=
   call test (compilations_3, "compilations_3", &
        "static executable: driver", &
        u, results)
 <<Compilations: test declarations>>=
   public :: compilations_3
 <<Compilations: tests>>=
   subroutine compilations_3 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname, exename
     type(rt_data_t), target :: global
     type(compilation_t) :: compilation
     integer :: u_file
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: compilations_3"
     write (u, "(A)")  "*   Purpose: make static executable"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize library"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     libname = "compilations_3_lib"
     procname = "prc_comp_3"
     exename = "compilations_3"
 
     call prepare_test_library (global, libname, 2, [procname,procname])
 
     call compilation%init (exename, [libname])
     call compilation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write dispatcher"
     write (u, "(A)")
 
     call compilation%write_dispatcher ()
 
     u_file = free_unit ()
     open (u_file, file = char (exename) // "_prclib_dispatcher.f90", &
          status = "old", action = "read")
     do
        read (u_file, "(A)", end = 1)  buffer
        write (u, "(A)")  trim (buffer)
     end do
 1   close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write Makefile"
     write (u, "(A)")
 
     associate (os_data => global%os_data)
       os_data%fc = "fortran-compiler"
       os_data%whizard_includes = "my-includes"
       os_data%fcflags = "my-fcflags"
       os_data%ldflags = "my-ldflags"
       os_data%ldflags_static = "my-ldflags-static"
       os_data%ldflags_hepmc = "my-ldflags-hepmc"
       os_data%ldflags_lcio = "my-ldflags-lcio"
       os_data%ldflags_hoppet = "my-ldflags-hoppet"
       os_data%ldflags_looptools = "my-ldflags-looptools"
       os_data%whizard_ldflags = "my-ldwhizard"
       os_data%whizard_libtool = "my-libtool"
     end associate
 
     call compilation%write_makefile (global%os_data, verbose = .true.)
 
     open (u_file, file = char (exename) // ".makefile", &
          status = "old", action = "read")
     do
        read (u_file, "(A)", end = 2)  buffer
        write (u, "(A)")  trim (buffer)
     end do
 2   close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: compilations_3"
 
   end subroutine compilations_3
 
 @ %def compilations_3
 @
 \subsection{Test static build}
 The tests for building a static executable are separate, since they
 should be skipped if the \whizard\ build itself has static libraries
 disabled.
 <<Compilations: public test>>=
   public :: compilations_static_test
 <<Compilations: test driver>>=
   subroutine compilations_static_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Compilations: static tests>>
 end subroutine compilations_static_test
 
 @ %def compilations_static_test
 @
 \subsubsection{External Matrix Element}
 Compile an external test matrix element ([[omega]] type) and
 incorporate this in a new static WHIZARD executable.
 <<Compilations: static tests>>=
   call test (compilations_static_1, "compilations_static_1", &
        "static executable: compilation", &
        u, results)
 <<Compilations: test declarations>>=
   public :: compilations_static_1
 <<Compilations: tests>>=
   subroutine compilations_static_1 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname, exename
     type(rt_data_t), target :: global
     type(compilation_item_t) :: item
     type(compilation_t) :: compilation
     logical :: exist
 
     write (u, "(A)")  "* Test output: compilations_static_1"
     write (u, "(A)")  "*   Purpose: make static executable"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize library"
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     libname = "compilations_static_1_lib"
     procname = "prc_comp_stat_1"
     exename = "compilations_static_1"
 
     call prepare_test_library (global, libname, 2, [procname,procname])
 
     call compilation%init (exename, [libname])
 
     write (u, "(A)")
     write (u, "(A)")  "* Write dispatcher"
 
     call compilation%write_dispatcher ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Write Makefile"
 
     call compilation%write_makefile (global%os_data, verbose = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build libraries"
 
     call item%init (libname, global%prclib_stack, global%var_list)
     call item%compile &
          (global%model, global%os_data, force=.true., recompile=.false.)
     call item%success ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Check executable (should be absent)"
     write (u, "(A)")
 
     call compilation%make_clean_exe (global%os_data)
     inquire (file = char (exename), exist = exist)
     write (u, "(A,A,L1)")  char (exename), " exists = ", exist
 
     write (u, "(A)")
     write (u, "(A)")  "* Build executable"
     write (u, "(A)")
 
     call compilation%make_compile (global%os_data)
     call compilation%make_link (global%os_data)
 
     write (u, "(A)")  "* Check executable (should be present)"
     write (u, "(A)")
 
     inquire (file = char (exename), exist = exist)
     write (u, "(A,A,L1)")  char (exename), " exists = ", exist
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call compilation%make_clean_exe (global%os_data)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: compilations_static_1"
 
   end subroutine compilations_static_1
 
 @ %def compilations_static_1
 @
 \subsubsection{External Matrix Element}
 Compile an external test matrix element ([[omega]] type) and
 incorporate this in a new static WHIZARD executable.  In this version,
 we use the wrapper [[compile_executable]] procedure.
 <<Compilations: static tests>>=
   call test (compilations_static_2, "compilations_static_2", &
        "static executable: shortcut", &
        u, results)
 <<Compilations: test declarations>>=
   public :: compilations_static_2
 <<Compilations: tests>>=
   subroutine compilations_static_2 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname, exename
     type(rt_data_t), target :: global
     logical :: exist
     integer :: u_file
 
     write (u, "(A)")  "* Test output: compilations_static_2"
     write (u, "(A)")  "*   Purpose: make static executable"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize library and compile"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     libname = "compilations_static_2_lib"
     procname = "prc_comp_stat_2"
     exename = "compilations_static_2"
 
     call prepare_test_library (global, libname, 2, [procname,procname])
 
     call compile_executable (exename, [libname], global)
 
     write (u, "(A)")  "* Check executable (should be present)"
     write (u, "(A)")
 
     inquire (file = char (exename), exist = exist)
     write (u, "(A,A,L1)")  char (exename), " exists = ", exist
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     u_file = free_unit ()
     open (u_file, file = char (exename), status = "old", action = "write")
     close (u_file, status = "delete")
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: compilations_static_2"
 
   end subroutine compilations_static_2
 
 @ %def compilations_static_2
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Integration}
 This module manages phase space setup, matrix-element evaluation and
 integration, as far as it is not done by lower-level routines, in particular
 in the [[processes]] module.
 <<[[integrations.f90]]>>=
 <<File header>>
 
 module integrations
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use diagnostics
   use os_interface
   use cputime
   use sm_qcd
   use physics_defs
   use model_data
   use pdg_arrays
   use variables, only: var_list_t
   use eval_trees
   use sf_mappings
   use sf_base
   use phs_base
   use mappings
   use phs_forests, only: phs_parameters_t
   use rng_base
   use mci_base
   use process_libraries
   use prc_core
   use process_config, only: COMP_MASTER, COMP_REAL_FIN, &
        COMP_MISMATCH, COMP_PDF, COMP_REAL, COMP_SUB, COMP_VIRT, &
        COMP_REAL_SING
   use process
   use pcm_base, only: pcm_t
   use instances
   use process_stacks
   use models
   use iterations
   use rt_data
 
   use dispatch_rng, only: dispatch_rng_factory
   use dispatch_me_methods, only: dispatch_core
   use dispatch_beams, only: dispatch_qcd, sf_prop_t, dispatch_sf_config
   use dispatch_phase_space, only: dispatch_sf_channels
   use dispatch_phase_space, only: dispatch_phs
   use dispatch_mci, only: dispatch_mci_s
   use dispatch_transforms, only: dispatch_evt_shower_hook
 
   use compilations, only: compile_library
 
   use dispatch_fks, only: dispatch_fks_s
   use blha_olp_interfaces
   use nlo_data
 <<Use mpi f08>>
 
 <<Standard module head>>
 
 <<Integrations: public>>
 
 <<Integrations: types>>
 
 contains
 
 <<Integrations: procedures>>
 
 end module integrations
 @ %def integrations
 @
 \subsection{The integration type}
 This type holds all relevant data, the integration methods operates on this.
 In contrast to the [[simulation_t]] introduced later, the [[integration_t]]
 applies to a single process.
 <<Integrations: public>>=
   public :: integration_t
 <<Integrations: types>>=
   type :: integration_t
     private
     type(string_t) :: process_id
     type(string_t) :: run_id
     type(process_t), pointer :: process => null ()
     type(var_list_t), pointer :: model_vars => null ()
     type(qcd_t) :: qcd
     logical :: rebuild_phs = .false.
     logical :: ignore_phs_mismatch = .false.
     logical :: phs_only = .false.
     logical :: process_has_me = .true.
     integer :: n_calls_test = 0
     logical :: vis_history = .true.
     type(string_t) :: history_filename
     type(string_t) :: log_filename
     logical :: combined_integration = .false.
     type(iteration_multipliers_t) :: iteration_multipliers
     type(nlo_settings_t) :: nlo_settings
    contains
    <<Integrations: integration: TBP>>
   end type integration_t
 
 @ %def integration_t
 @
 @
 \subsection{Initialization}
 Initialization, first part: Create a process entry.
 Push it on the stack if the [[global]] environment is supplied.
 <<Integrations: integration: TBP>>=
   procedure :: create_process => integration_create_process
 <<Integrations: procedures>>=
   subroutine integration_create_process (intg, process_id, global)
     class(integration_t), intent(out) :: intg
     type(rt_data_t), intent(inout), optional, target :: global
     type(string_t), intent(in) :: process_id
     type(process_entry_t), pointer :: process_entry
     call msg_debug (D_CORE, "integration_create_process")
     intg%process_id = process_id
     if (present (global)) then
        allocate (process_entry)
        intg%process => process_entry%process_t
        call global%process_stack%push (process_entry)
     else
        allocate (process_t :: intg%process)
     end if
     intg%model_vars => null ()
   end subroutine integration_create_process
 
 @ %def integration_create_process
 @ Initialization, second part: Initialize the process object, using the local
 environment.  We allocate a RNG factory and a QCD object.
 We also fetch a pointer to the model that the process uses.  The
 process initializer will create a snapshot of that model.
 
 This procedure
 does not modify the [[local]] stack directly.  The intent(inout) attribute for
 the [[local]] data set is due to the random generator seed which may be
 incremented during initialization.
 
 NOTE: Changes to model parameters within the current context are respected
 only if the process model coincides with the current model.  This is the usual
 case.  If not, we read
 the model from the global model library, which has default parameters.  To
 become more flexible, we should implement a local model library which records
 local changes to currently inactive models.
 <<Integrations: integration: TBP>>=
   procedure :: init_process => integration_init_process
 <<Integrations: procedures>>=
   subroutine integration_init_process (intg, local)
     class(integration_t), intent(inout) :: intg
     type(rt_data_t), intent(inout), target :: local
     type(string_t) :: model_name
     type(model_t), pointer :: model
     class(model_data_t), pointer :: model_instance
     class(rng_factory_t), allocatable :: rng_factory
     call msg_debug (D_CORE, "integration_init_process")
     if (.not. local%prclib%contains (intg%process_id)) then
        call msg_fatal ("Process '" // char (intg%process_id) // "' not found" &
             // " in library '" // char (local%prclib%get_name ()) // "'")
        return
     end if
     intg%run_id = local%var_list%get_sval (var_str ("$run_id"))
     call dispatch_qcd (intg%qcd, local%get_var_list_ptr (), local%os_data)
     call dispatch_rng_factory (rng_factory, local%var_list)
     model_name = local%prclib%get_model_name (intg%process_id)
     if (local%get_sval (var_str ("$model_name")) == model_name) then
        model => local%model
     else
        model => local%model_list%get_model_ptr (model_name)
     end if
     allocate (model_t :: model_instance)
     select type (model_instance)
     type is (model_t)
        call model_instance%init_instance (model)
        intg%model_vars => model_instance%get_var_list_ptr ()
     end select
     call intg%process%init (intg%process_id, intg%run_id, &
          local%prclib, &
          local%os_data, intg%qcd, rng_factory, model_instance)
   end subroutine integration_init_process
 
 @ %def integration_init_process
 @ Initialization, third part: complete process configuration.
 <<Integrations: integration: TBP>>=
   procedure :: setup_process => integration_setup_process
 <<Integrations: procedures>>=
   subroutine integration_setup_process (intg, local, verbose, init_only)
     class(integration_t), intent(inout) :: intg
     type(rt_data_t), intent(inout), target :: local
     logical, intent(in), optional :: verbose
     logical, intent(in), optional :: init_only
     type(var_list_t), pointer :: var_list
     class(prc_core_t), allocatable :: core_template
     class(prc_core_t), pointer :: core => null ()
     class(phs_config_t), allocatable :: phs_config_template
     type(phs_parameters_t) :: phs_par
     type(mapping_defaults_t) :: mapping_defs
     class(mci_t), allocatable :: mci_template
     integer :: n_components, i_component
     type(process_component_def_t), pointer :: config
     type(helicity_selection_t) :: helicity_selection
     logical :: use_color_factors
     type(sf_config_t), dimension(:), allocatable :: sf_config
     type(sf_prop_t) :: sf_prop
     type(sf_channel_t), dimension(:), allocatable :: sf_channel
     type(phs_channel_collection_t) :: phs_channel_collection
     logical :: sf_trace
     logical :: verb, initialize_only
     type(blha_template_t) :: blha_template
     type(fks_template_t) :: fks_template
     type(string_t) :: sf_string
     class(phs_config_t), allocatable :: phs_config_template_other
     type(string_t) :: workspace
     integer :: i_real
     integer :: i_core
     integer :: i_core_born, i_core_real
     logical :: first_real_component, has_pdfs
     integer :: nlo_type_fetched
     class(pcm_t), pointer :: pcm => null ()
     i_real = 0
     verb = .true.; if (present (verbose))  verb = verbose
     initialize_only = .false.;  if (present (init_only))  initialize_only = init_only
     call intg%process%set_var_list (local%get_var_list_ptr ())
     var_list => intg%process%get_var_list_ptr ()
 
     call setup_phase_space ()
 
     intg%n_calls_test = &
          var_list%get_ival (var_str ("n_calls_test"))
 
     call setup_log_and_history ()
 
     call dispatch_mci_s (mci_template, local%get_var_list_ptr (), &
          intg%process_id, &
          intg%process%is_nlo_calculation ())
 
     call display_init_message (verb)
 
     n_components = intg%process%get_n_components ()
 
     intg%combined_integration = var_list%get_lval &
        (var_str ('?combined_nlo_integration')) .and. &
         intg%process%is_nlo_calculation ()
 
     helicity_selection = local%get_helicity_selection ()
     use_color_factors = var_list%get_lval &
          (var_str ("?read_color_factors"))
     do i_component = 1, n_components
        config => intg%process%get_component_def_ptr (i_component)
        call intg%process%core_manager_register &
             (config%get_nlo_type (), i_component, &
             config%get_def_type_string ())
     end do
     call intg%process%allocate_cm_arrays (n_components)
     do i_core = 1, intg%process%get_n_cores ()
        i_component = intg%process%get_core_manager_index (i_core)
        config => intg%process%get_component_def_ptr (i_component)
        call dispatch_core (core_template, config%get_core_def_ptr (), &
             intg%process%get_model_ptr (), &
             helicity_selection, intg%qcd, &
             use_color_factors)
        call intg%process%allocate_core (i_core, core_template)
        deallocate (core_template)
     end do
 
     call intg%process%init_cores ()
     first_real_component = .true.
 
     pcm => intg%process%get_pcm_ptr ()
     pcm%has_pdfs = local%beam_structure%has_pdf ()
 
     do i_component = 1, n_components
        config => intg%process%get_component_def_ptr (i_component)
        nlo_type_fetched = config%get_nlo_type ()
        if (nlo_type_fetched == NLO_MISMATCH)  nlo_type_fetched = NLO_SUBTRACTION
        core => intg%process%get_core_from_md5sum ( &
             intg%process%get_md5sum_constants (i_component, &
             config%get_def_type_string (), nlo_type_fetched))
        select case (config%get_nlo_type ())
        case (NLO_VIRTUAL)
           call setup_virtual_component ()
        case (NLO_REAL)
           call setup_real_component ()
           if (intg%process%get_component_type (i_component) /= COMP_REAL_FIN) &
                i_real = i_component
        case (NLO_MISMATCH)
           call setup_mismatch_component ()
        case (NLO_DGLAP)
           call setup_dglap_component ()
        case (BORN)
           call setup_born_component ()
        case (NLO_SUBTRACTION)
           call setup_subtraction_component ()
        case (GKS)
           call intg%process%init_component (i_component, &
                core%has_matrix_element (), mci_template, &
                phs_config_template)
        case default
           call msg_fatal ("setup_process: NLO type not implemented!")
        end select
        if (allocated (phs_config_template_other)) &
             deallocate (phs_config_template_other)
     end do
 
     intg%process_has_me = intg%process%has_matrix_element ()
     if (.not. intg%process_has_me) then
        call msg_warning ("Process '" &
             // char (intg%process_id) // "': matrix element vanishes")
     end if
 
     call setup_beams ()
     call setup_structure_functions ()
 
     workspace = var_list%get_sval (var_str ("$integrate_workspace"))
     if (workspace == "") then
        call intg%process%configure_phs &
             (intg%rebuild_phs, intg%ignore_phs_mismatch, &
             combined_integration = intg%combined_integration)
     else
        call intg%process%configure_phs &
             (intg%rebuild_phs, intg%ignore_phs_mismatch, &
             combined_integration = intg%combined_integration, &
             subdir = workspace)
     end if
 
     if (intg%process%is_nlo_calculation ()) then
        call dispatch_fks_s (fks_template, local%var_list)
        call intg%process%init_nlo_settings (var_list, fks_template)
        call intg%process%check_if_threshold_method ()
        i_core_real = intg%process%get_i_core_nlo_type (NLO_REAL)
        i_core_born = intg%process%get_i_core_nlo_type (BORN)
        call intg%process%setup_region_data (i_real, &
             intg%process%get_constants(i_core_born), &
             intg%process%get_constants(i_core_real))
        if (var_list%get_lval (var_str ("?nlo_use_real_partition"))) then
           call intg%process%setup_real_partition &
                (var_list%get_rval (var_str ("real_partition_scale")))
        end if
     end if
 
     if (intg%process%needs_extra_code ()) then
        call blha_template%init (local%beam_structure%has_polarized_beams(), &
             var_list%get_lval (var_str ("?openloops_switch_off_muon_yukawa")), &
             var_list%get_rval (var_str ("blha_top_yukawa")), &
             var_list%get_sval (var_str ("$blha_ew_scheme")))
        call intg%process%init_blha_cores (blha_template, var_list)
        call intg%process%create_and_load_extra_libraries &
             (local%beam_structure, var_list, local%os_data)
     end if
 
     call intg%process%setup_terms (with_beams = local%beam_structure%has_polarized_beams ())
 
     if (verb) then
        call intg%process%write (screen = .true.)
        call intg%process%print_phs_startup_message ()
     end if
 
     if (intg%process_has_me) then
        if (size (sf_config) > 0) then
           call intg%process%collect_channels (phs_channel_collection)
        else if (.not. initialize_only &
             .and. intg%process%contains_trivial_component ()) then
           call msg_fatal ("Integrate: 2 -> 1 process can't be handled &
                &with fixed-energy beams")
        end if
        call dispatch_sf_channels &
             (sf_channel, sf_string, sf_prop, phs_channel_collection, &
             local%var_list, local%get_sqrts(), local%beam_structure)
        if (allocated (sf_channel)) then
           if (size (sf_channel) > 0) then
              call intg%process%set_sf_channel (sf_channel)
           end if
        end if
        call phs_channel_collection%final ()
        if (verb)  call intg%process%sf_startup_message (sf_string)
     end if
 
     call intg%setup_process_mci ()
 
     call setup_expressions ()
 
     call intg%process%compute_md5sum ()
   contains
     subroutine setup_phase_space ()
       intg%rebuild_phs = &
            var_list%get_lval (var_str ("?rebuild_phase_space"))
       intg%ignore_phs_mismatch = &
            .not. var_list%get_lval (var_str ("?check_phs_file"))
       intg%phs_only = &
            var_list%get_lval (var_str ("?phs_only"))
       phs_par%m_threshold_s = &
            var_list%get_rval (var_str ("phs_threshold_s"))
       phs_par%m_threshold_t = &
            var_list%get_rval (var_str ("phs_threshold_t"))
       phs_par%off_shell = &
            var_list%get_ival (var_str ("phs_off_shell"))
       phs_par%keep_nonresonant = &
            var_list%get_lval (var_str ("?phs_keep_nonresonant"))
       phs_par%t_channel = &
            var_list%get_ival (var_str ("phs_t_channel"))
       mapping_defs%energy_scale = &
            var_list%get_rval (var_str ("phs_e_scale"))
       mapping_defs%invariant_mass_scale = &
            var_list%get_rval (var_str ("phs_m_scale"))
       mapping_defs%momentum_transfer_scale = &
            var_list%get_rval (var_str ("phs_q_scale"))
       mapping_defs%step_mapping = &
            var_list%get_lval (var_str ("?phs_step_mapping"))
       mapping_defs%step_mapping_exp = &
            var_list%get_lval (var_str ("?phs_step_mapping_exp"))
       mapping_defs%enable_s_mapping = &
            var_list%get_lval (var_str ("?phs_s_mapping"))
 
       call dispatch_phs (phs_config_template, local%var_list, &
            local%os_data, intg%process_id, mapping_defs, phs_par)
     end subroutine setup_phase_space
 
     subroutine setup_log_and_history ()
        !!! We avoid two dots in the filename due to a bug in certain MetaPost versions.
        if (intg%run_id /= "") then
           intg%history_filename = intg%process_id // "." // intg%run_id &
                // ".history"
           intg%log_filename = intg%process_id // "." // intg%run_id // ".log"
        else
           intg%history_filename = intg%process_id // ".history"
           intg%log_filename = intg%process_id // ".log"
        end if
        intg%vis_history = &
           var_list%get_lval (var_str ("?vis_history"))
     end subroutine setup_log_and_history
 
     subroutine display_init_message (verb)
       logical, intent(in) :: verb
       if (verb) then
          call msg_message ("Initializing integration for process " &
               // char (intg%process_id) // ":")
          if (intg%run_id /= "") &
               call msg_message ("Run ID = " // '"' // char (intg%run_id) // '"')
       end if
     end subroutine display_init_message
 
     subroutine setup_born_component ()
       call intg%process%init_component (i_component, &
            core%has_matrix_element (), mci_template, phs_config_template)
       call intg%process%set_component_type (i_component, COMP_MASTER)
     end subroutine setup_born_component
 
     subroutine setup_virtual_component ()
       call intg%process%init_component (i_component, &
            core%has_matrix_element (), mci_template, phs_config_template)
       call intg%process%set_component_type (i_component, COMP_VIRT)
     end subroutine setup_virtual_component
 
     subroutine setup_real_component ()
       logical :: use_finite_real
       use_finite_real = var_list%get_lval (var_str ("?nlo_use_real_partition"))
       if (first_real_component) then
          call dispatch_phs (phs_config_template_other, local%var_list, &
               local%os_data, intg%process_id, mapping_defs, phs_par, &
               var_str ('fks'))
       else
          call dispatch_phs (phs_config_template_other, local%var_list, &
               local%os_data, intg%process_id, mapping_defs, phs_par, &
               var_str ('wood'))
       end if
       call intg%process%init_component (i_component, &
            core%has_matrix_element (), mci_template, phs_config_template_other)
       if (use_finite_real) then
          if (first_real_component) then
             call intg%process%set_component_type (i_component, COMP_REAL_SING)
             first_real_component = .false.
          else
             call intg%process%set_component_type (i_component, COMP_REAL_FIN)
          end if
       else
          call intg%process%set_component_type (i_component, COMP_REAL)
       end if
     end subroutine setup_real_component
 
     subroutine setup_mismatch_component ()
       call dispatch_phs (phs_config_template_other, local%var_list, &
            local%os_data, intg%process_id, mapping_defs, phs_par, var_str ('fks'))
       call intg%process%init_component (i_component, &
            core%has_matrix_element (), mci_template, phs_config_template_other)
       if (intg%combined_integration) &
            call intg%process%set_component_type (i_component, COMP_MISMATCH)
     end subroutine setup_mismatch_component
 
     subroutine setup_dglap_component ()
       call dispatch_phs (phs_config_template_other, local%var_list, local%os_data, &
            intg%process_id, mapping_defs, phs_par, var_str ('fks'))
       call intg%process%init_component (i_component, &
            core%has_matrix_element (), mci_template, phs_config_template_other)
       if (intg%combined_integration) &
            call intg%process%set_component_type (i_component, COMP_PDF)
     end subroutine setup_dglap_component
 
     subroutine setup_subtraction_component ()
       call intg%process%init_component (i_component, .false., &
            mci_template, phs_config_template)
       if (intg%combined_integration) &
            call intg%process%set_component_type (i_component, COMP_SUB)
     end subroutine setup_subtraction_component
 
     subroutine setup_beams ()
       real(default) :: sqrts
       logical :: decay_rest_frame
       sqrts = local%get_sqrts ()
       decay_rest_frame = &
            var_list%get_lval (var_str ("?decay_rest_frame"))
       if (intg%process_has_me) then
          call intg%process%setup_beams_beam_structure &
               (local%beam_structure, sqrts, decay_rest_frame)
       end if
       call intg%process%check_masses ()
       if (verb .and. intg%process_has_me) then
          call intg%process%beams_startup_message &
               (beam_structure = local%beam_structure)
       end if
     end subroutine setup_beams
 
     subroutine setup_structure_functions ()
       integer :: n_in
       type(pdg_array_t), dimension(:,:), allocatable :: pdg_prc
       type(string_t) :: sf_trace_file
       if (intg%process_has_me) then
          call intg%process%get_pdg_in (pdg_prc)
       else
          n_in = intg%process%get_n_in ()
          allocate (pdg_prc (n_in, n_components))
          pdg_prc = 0
       end if
       call dispatch_sf_config (sf_config, sf_prop, local%beam_structure, &
            local%get_var_list_ptr (), local%var_list, &
            local%model, local%os_data, local%get_sqrts (), pdg_prc)
 
       sf_trace = &
            var_list%get_lval (var_str ("?sf_trace"))
       sf_trace_file = &
            var_list%get_sval (var_str ("$sf_trace_file"))
       if (sf_trace) then
          call intg%process%init_sf_chain (sf_config, sf_trace_file)
       else
          call intg%process%init_sf_chain (sf_config)
       end if
     end subroutine setup_structure_functions
 
     subroutine setup_expressions ()
       type(eval_tree_factory_t) :: expr_factory
       if (associated (local%pn%cuts_lexpr)) then
          if (verb)  call msg_message ("Applying user-defined cuts.")
          call expr_factory%init (local%pn%cuts_lexpr)
          call intg%process%set_cuts (expr_factory)
       else
          if (verb)  call msg_warning ("No cuts have been defined.")
       end if
       if (associated (local%pn%scale_expr)) then
          if (verb) call msg_message ("Using user-defined general scale.")
          call expr_factory%init (local%pn%scale_expr)
          call intg%process%set_scale (expr_factory)
       end if
       if (associated (local%pn%fac_scale_expr)) then
          if (verb) call msg_message ("Using user-defined factorization scale.")
          call expr_factory%init (local%pn%fac_scale_expr)
          call intg%process%set_fac_scale (expr_factory)
       end if
       if (associated (local%pn%ren_scale_expr)) then
          if (verb) call msg_message ("Using user-defined renormalization scale.")
          call expr_factory%init (local%pn%ren_scale_expr)
          call intg%process%set_ren_scale (expr_factory)
       end if
       if (associated (local%pn%weight_expr)) then
          if (verb) call msg_message ("Using user-defined reweighting factor.")
          call expr_factory%init (local%pn%weight_expr)
          call intg%process%set_weight (expr_factory)
       end if
     end subroutine setup_expressions
   end subroutine integration_setup_process
 
 @ %def integration_setup_process
 @
 \subsection{Integration}
 Integrate: do the final integration.  Here, we do a multi-iteration
 integration.  Again, we skip iterations that are already on file.
 Record the results in the global variable list.
 <<Integrations: integration: TBP>>=
   procedure :: evaluate => integration_evaluate
 <<Integrations: procedures>>=
   subroutine integration_evaluate &
        (intg, process_instance, i_mci, pass, it_list, pacify)
     class(integration_t), intent(inout) :: intg
     type(process_instance_t), intent(inout), target :: process_instance
     integer, intent(in) :: i_mci
     integer, intent(in) :: pass
     type(iterations_list_t), intent(in) :: it_list
     logical, intent(in), optional :: pacify
     integer :: n_calls, n_it
     logical :: adapt_grids, adapt_weights, final
     n_it = it_list%get_n_it (pass)
     n_calls = it_list%get_n_calls (pass)
     adapt_grids = it_list%adapt_grids (pass)
     adapt_weights = it_list%adapt_weights (pass)
     final = pass == it_list%get_n_pass ()
     call process_instance%integrate ( &
          i_mci, n_it, n_calls, adapt_grids, adapt_weights, &
          final, pacify)
   end subroutine integration_evaluate
 
 @ %def integration_evaluate
 @ In case the user has not provided a list of iterations, make a
 reasonable default.  This can depend on the process.  The usual
 approach is to define two distinct passes, one for adaptation and one
 for integration.
 <<Integrations: integration: TBP>>=
   procedure :: make_iterations_list => integration_make_iterations_list
 <<Integrations: procedures>>=
   subroutine integration_make_iterations_list (intg, it_list)
     class(integration_t), intent(in) :: intg
     type(iterations_list_t), intent(out) :: it_list
     integer :: pass, n_pass
     integer, dimension(:), allocatable :: n_it, n_calls
     logical, dimension(:), allocatable :: adapt_grids, adapt_weights
     n_pass = intg%process%get_n_pass_default ()
     allocate (n_it (n_pass), n_calls (n_pass))
     allocate (adapt_grids (n_pass), adapt_weights (n_pass))
     do pass = 1, n_pass
        n_it(pass)          = intg%process%get_n_it_default (pass)
        n_calls(pass)       = intg%process%get_n_calls_default (pass)
        adapt_grids(pass)   = intg%process%adapt_grids_default (pass)
        adapt_weights(pass) = intg%process%adapt_weights_default (pass)
     end do
     call it_list%init (n_it, n_calls, &
          adapt_grids = adapt_grids, adapt_weights = adapt_weights)
   end subroutine integration_make_iterations_list
 
 @ %def integration_make_iterations_list
 @ In NLO calculations, the individual components might scale very differently
 with the number of calls. This especially applies to the real-subtracted
 component, which usually fluctuates more than the Born and virtual
 component, making it a bottleneck of the calculation. Thus, the calculation
 is throttled twice, first by the number of calls for the real component,
 second by the number of surplus calls of computation-intense virtual
 matrix elements. Therefore, we want to set a different number of calls
 for each component, which is done by the subroutine [[integration_apply_call_multipliers]].
 <<Integrations: integration: TBP>>=
   procedure :: init_iteration_multipliers => integration_init_iteration_multipliers
 <<Integrations: procedures>>=
   subroutine integration_init_iteration_multipliers (intg, local)
     class(integration_t), intent(inout) :: intg
     type(rt_data_t), intent(in) :: local
     integer :: n_pass, pass
     type(iterations_list_t) :: it_list
     n_pass = local%it_list%get_n_pass ()
     if (n_pass == 0) then
        call intg%make_iterations_list (it_list)
        n_pass = it_list%get_n_pass ()
     end if
     associate (it_multipliers => intg%iteration_multipliers)
        allocate (it_multipliers%n_calls0 (n_pass))
        do pass = 1, n_pass
           it_multipliers%n_calls0(pass) = local%it_list%get_n_calls (pass)
        end do
        it_multipliers%mult_real = local%var_list%get_rval &
            (var_str ("mult_call_real"))
        it_multipliers%mult_virt = local%var_list%get_rval &
            (var_str ("mult_call_virt"))
        it_multipliers%mult_dglap = local%var_list%get_rval &
            (var_str ("mult_call_dglap"))
     end associate
   end subroutine integration_init_iteration_multipliers
 
 @ %def integration_init_iteration_multipliers
 @
 <<Integrations: integration: TBP>>=
   procedure :: apply_call_multipliers => integration_apply_call_multipliers
 <<Integrations: procedures>>=
   subroutine integration_apply_call_multipliers (intg, n_pass, i_component, it_list)
     class(integration_t), intent(in) :: intg
     integer, intent(in) :: n_pass, i_component
     type(iterations_list_t), intent(inout) :: it_list
     integer :: nlo_type
     integer :: n_calls0, n_calls
     integer :: pass
     real(default) :: multiplier
     nlo_type = intg%process%get_component_nlo_type (i_component)
     do pass = 1, n_pass
        associate (multipliers => intg%iteration_multipliers)
          select case (nlo_type)
          case (NLO_REAL)
             multiplier = multipliers%mult_real
          case (NLO_VIRTUAL)
             multiplier = multipliers%mult_virt
          case (NLO_DGLAP)
             multiplier = multipliers%mult_dglap
          case default
             return
          end select
        end associate
        if (n_pass <= size (intg%iteration_multipliers%n_calls0)) then
           n_calls0 = intg%iteration_multipliers%n_calls0 (pass)
           n_calls = floor (multiplier * n_calls0)
           call it_list%set_n_calls (pass, n_calls)
        end if
     end do
   end subroutine integration_apply_call_multipliers
 
 @ %def integration_apply_call_multipliers
 @
 \subsection{API for integration objects}
 This initializer does everything except assigning cuts/scale/weight
 expressions.
 <<Integrations: integration: TBP>>=
   procedure :: init => integration_init
 <<Integrations: procedures>>=
   subroutine integration_init &
        (intg, process_id, local, global, local_stack, init_only)
     class(integration_t), intent(out) :: intg
     type(string_t), intent(in) :: process_id
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     logical, intent(in), optional :: init_only
     logical, intent(in), optional :: local_stack
     logical :: use_local
     use_local = .false.;  if (present (local_stack))  use_local = local_stack
     if (present (global)) then
        call intg%create_process (process_id, global)
     else if (use_local) then
        call intg%create_process (process_id, local)
     else
        call intg%create_process (process_id)
     end if
     call intg%init_process (local)
     call intg%setup_process (local, init_only = init_only)
     call intg%init_iteration_multipliers (local)
   end subroutine integration_init
 
 @ %def integration_init
 @ Do the integration for a single process, both warmup and final evaluation.
 The [[eff_reset]] flag is to suppress numerical noise in the graphical output
 of the integration history.
 <<Integrations: integration: TBP>>=
   procedure :: integrate => integration_integrate
 <<Integrations: procedures>>=
   subroutine integration_integrate (intg, local, eff_reset)
     class(integration_t), intent(inout) :: intg
     type(rt_data_t), intent(in), target :: local
     logical, intent(in), optional :: eff_reset
     type(string_t) :: log_filename
     type(var_list_t), pointer :: var_list
     type(process_instance_t), allocatable, target :: process_instance
     type(iterations_list_t) :: it_list
     logical :: pacify
     integer :: pass, i_mci, n_mci, n_pass
     integer :: i_component
     integer :: nlo_type
     logical :: display_summed
     logical :: nlo_active
     type(string_t) :: component_output
 
     allocate (process_instance)
     call process_instance%init (intg%process)
 
     var_list => intg%process%get_var_list_ptr ()
     call openmp_set_num_threads_verbose &
          (var_list%get_ival (var_str ("openmp_num_threads")), &
           var_list%get_lval (var_str ("?openmp_logging")))
     pacify = var_list%get_lval (var_str ("?pacify"))
 
     display_summed = .true.
     n_mci = intg%process%get_n_mci ()
     if (n_mci == 1) then
        write (msg_buffer, "(A,A,A)") &
             "Starting integration for process '", &
             char (intg%process%get_id ()), "'"
        call msg_message ()
     end if
 
     call setup_hooks ()
 
     nlo_active = any (intg%process%get_component_nlo_type &
          ([(i_mci, i_mci = 1, n_mci)]) /= BORN)
     do i_mci = 1, n_mci
        i_component = intg%process%get_master_component (i_mci)
        nlo_type = intg%process%get_component_nlo_type (i_component)
        if (intg%process%component_can_be_integrated (i_component)) then
           if (n_mci > 1) then
              if (nlo_active) then
                 if (intg%combined_integration .and. nlo_type == BORN) then
                    component_output = var_str ("Combined")
                 else
                    component_output = component_status (nlo_type)
                 end if
                 write (msg_buffer, "(A,A,A,A,A)") &
                      "Starting integration for process '", &
                      char (intg%process%get_id ()), "' part '", &
                      char (component_output), "'"
              else
                 write (msg_buffer, "(A,A,A,I0)") &
                      "Starting integration for process '", &
                      char (intg%process%get_id ()), "' part ", i_mci
              end if
              call msg_message ()
           end if
           n_pass = local%it_list%get_n_pass ()
           if (n_pass == 0) then
              call msg_message ("Integrate: iterations not specified, &
                   &using default")
              call intg%make_iterations_list (it_list)
              n_pass = it_list%get_n_pass ()
           else
              it_list = local%it_list
           end if
           call intg%apply_call_multipliers (n_pass, i_mci, it_list)
           call msg_message ("Integrate: " // char (it_list%to_string ()))
           do pass = 1, n_pass
              call intg%evaluate (process_instance, i_mci, pass, it_list, pacify)
              if (signal_is_pending ())  return
           end do
           call intg%process%final_integration (i_mci)
           if (intg%vis_history) then
              call intg%process%display_integration_history &
                   (i_mci, intg%history_filename, local%os_data, eff_reset)
           end if
           if (local%logfile == intg%log_filename) then
              if (intg%run_id /= "") then
                 log_filename = intg%process_id // "." // intg%run_id // &
                      ".var.log"
              else
                 log_filename = intg%process_id // ".var.log"
              end if
              call msg_message ("Name clash for global logfile and process log: ", &
                   arr =[var_str ("| Renaming log file from ") // local%logfile, &
                         var_str ("|   to ") // log_filename // var_str (" .")])
           else
              log_filename = intg%log_filename
           end if
           call intg%process%write_logfile (i_mci, log_filename)
        end if
     end do
 
     if (n_mci > 1 .and. display_summed) then
        call msg_message ("Integrate: sum of all components")
        call intg%process%display_summed_results (pacify)
     end if
 
     call process_instance%final ()
     deallocate (process_instance)
   contains
     subroutine setup_hooks ()
       class(process_instance_hook_t), pointer :: hook
       call dispatch_evt_shower_hook (hook, var_list, process_instance)
       if (associated (hook)) then
          call process_instance%append_after_hook (hook)
       end if
     end subroutine setup_hooks
   end subroutine integration_integrate
 
 @ %def integration_integrate
 @
 <<Integrations: integration: TBP>>=
   procedure :: setup_process_mci => integration_setup_process_mci
 <<Integrations: procedures>>=
   subroutine integration_setup_process_mci (intg)
     class(integration_t), intent(inout) :: intg
     call intg%process%setup_mci (intg%combined_integration)
   end subroutine integration_setup_process_mci
 
 @ %def integration_setup_process_mci@
 @ Do a dummy integration for a process which could not be initialized (e.g.,
 has no matrix element).  The result is zero.
 <<Integrations: integration: TBP>>=
   procedure :: integrate_dummy => integration_integrate_dummy
 <<Integrations: procedures>>=
   subroutine integration_integrate_dummy (intg)
     class(integration_t), intent(inout) :: intg
     call intg%process%integrate_dummy ()
   end subroutine integration_integrate_dummy
 
 @ %def integration_integrate_dummy
 @ Just sample the matrix element under realistic conditions (but no
 cuts); throw away the results.
 <<Integrations: integration: TBP>>=
   procedure :: sampler_test => integration_sampler_test
 <<Integrations: procedures>>=
   subroutine integration_sampler_test (intg)
     class(integration_t), intent(inout) :: intg
     type(process_instance_t), allocatable, target :: process_instance
     integer :: n_mci, i_mci
     type(timer_t) :: timer_mci, timer_tot
     real(default) :: t_mci, t_tot
     allocate (process_instance)
     call process_instance%init (intg%process)
     n_mci = intg%process%get_n_mci ()
     if (n_mci == 1) then
        write (msg_buffer, "(A,A,A)") &
             "Test: probing process '", &
             char (intg%process%get_id ()), "'"
        call msg_message ()
     end if
     call timer_tot%start ()
     do i_mci = 1, n_mci
        if (n_mci > 1) then
           write (msg_buffer, "(A,A,A,I0)") &
                "Test: probing process '", &
                char (intg%process%get_id ()), "' part ", i_mci
           call msg_message ()
        end if
        call timer_mci%start ()
        call process_instance%sampler_test (i_mci, intg%n_calls_test)
        call timer_mci%stop ()
        t_mci = timer_mci
        write (msg_buffer, "(A,ES12.5)")  "Test: " &
             // "time in seconds (wallclock): ", t_mci
        call msg_message ()
     end do
     call timer_tot%stop ()
     t_tot = timer_tot
     if (n_mci > 1) then
        write (msg_buffer, "(A,ES12.5)")  "Test: " &
             // "total time      (wallclock): ", t_tot
        call msg_message ()
     end if
     call process_instance%final ()
   end subroutine integration_sampler_test
 
 @ %def integration_sampler_test
 @ Return the process pointer (needed by simulate):
 <<Integrations: integration: TBP>>=
   procedure :: get_process_ptr => integration_get_process_ptr
 <<Integrations: procedures>>=
   function integration_get_process_ptr (intg) result (ptr)
     class(integration_t), intent(in) :: intg
     type(process_t), pointer :: ptr
     ptr => intg%process
   end function integration_get_process_ptr
 
 @ %def integration_get_process_ptr
 @ Simply integrate, do a dummy integration if necessary.  The [[integration]]
 object exists only internally.
 
 If the [[global]] environment is provided, the process object is appended to
 the global stack.  Otherwise, if [[local_stack]] is set, we append to the
 local process stack.  If this is unset, the [[process]] object is not recorded
 permanently.
 
 The [[init_only]] flag can be used to skip the actual integration part.  We
 will end up with a process object that is completely initialized, including
 phase space configuration.
 
 The [[eff_reset]] flag is to suppress numerical noise in the visualization
 of the integration history.
 <<Integrations: public>>=
   public :: integrate_process
 <<Integrations: procedures>>=
   subroutine integrate_process (process_id, local, global, local_stack, init_only, eff_reset)
     type(string_t), intent(in) :: process_id
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     logical, intent(in), optional :: local_stack, init_only, eff_reset
     type(string_t) :: prclib_name
     type(integration_t) :: intg
     character(32) :: buffer
   <<Integrations: integrate process: variables>>
   <<Integrations: integrate process: init>>
     if (.not. associated (local%prclib)) then
        call msg_fatal ("Integrate: current process library is undefined")
        return
     end if
 
     if (.not. local%prclib%is_active ()) then
        call msg_message ("Integrate: current process library needs compilation")
        prclib_name = local%prclib%get_name ()
        call compile_library (prclib_name, local)
        if (signal_is_pending ())  return
        call msg_message ("Integrate: compilation done")
     end if
 
     call intg%init (process_id, local, global, local_stack, init_only)
     if (signal_is_pending ())  return
 
     if (present (init_only)) then
        if (init_only) return
     end if
 
     if (intg%n_calls_test > 0) then
        write (buffer, "(I0)")  intg%n_calls_test
        call msg_message ("Integrate: test (" // trim (buffer) // " calls) ...")
        call intg%sampler_test ()
        call msg_message ("Integrate: ... test complete.")
        if (signal_is_pending ())  return
     end if
   <<Integrations: integrate process: end init>>
 
     if (intg%phs_only) then
        call msg_message ("Integrate: phase space only, skipping integration")
     else
        if (intg%process_has_me) then
           call intg%integrate (local, eff_reset)
        else
           call intg%integrate_dummy ()
        end if
     end if
   end subroutine integrate_process
 
 @ %def integrate_process
 <<Integrations: integrate process: variables>>=
 @
 <<Integrations: integrate process: init>>=
 @
 <<Integrations: integrate process: end init>>=
 @
 @ The parallelization leads to undefined behavior while writing simultaneously to one file.
 The master worker has to initialize single-handed the corresponding library files and the phase space file.
 The slave worker will wait with a blocking [[MPI_BCAST]] until they receive a logical flag.
 <<MPI: Integrations: integrate process: variables>>=
   type(var_list_t), pointer :: var_list
   logical :: mpi_logging, process_init
   integer :: rank, n_size
 <<MPI: Integrations: integrate process: init>>=
   call msg_debug (D_MPI, "integrate_process")
   var_list => local%get_var_list_ptr ()
   process_init = .false.
   call mpi_get_comm_id (n_size, rank)
   mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) .and. &
        & (n_size > 1)) .or. var_list%get_lval (var_str ("?mpi_logging")))
   call msg_debug (D_MPI, "n_size", rank)
   call msg_debug (D_MPI, "rank", rank)
   call msg_debug (D_MPI, "mpi_logging", mpi_logging)
   if (rank /= 0) then
      if (mpi_logging) then
         call msg_message ("MPI: wait for master to finish process initialization ...")
      end if
      call MPI_bcast (process_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
   else
      process_init = .true.
   end if
 
   if (process_init) then
 <<MPI: Integrations: integrate process: end init>>=
   if (rank == 0) then
      if (mpi_logging) then
         call msg_message ("MPI: finish process initialization, load slaves ...")
      end if
      call MPI_bcast (process_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
   end if
 end if
 call MPI_barrier (MPI_COMM_WORLD)
 call mpi_set_logging (mpi_logging)
 @ %def integrate_process_mpi
 @
 \subsection{Unit Tests}
 Test module, followed by the stand-alone unit-test procedures.
 <<[[integrations_ut.f90]]>>=
 <<File header>>
 
 module integrations_ut
   use unit_tests
   use integrations_uti
 
 <<Standard module head>>
 
 <<Integrations: public test>>
 
 contains
 
 <<Integrations: test driver>>
 
 end module integrations_ut
 @ %def integrations_ut
 @
 <<[[integrations_uti.f90]]>>=
 <<File header>>
 
 module integrations_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use ifiles
   use lexers
   use parser
   use io_units
   use flavors
   use interactions, only: reset_interaction_counter
   use phs_forests
   use eval_trees
   use models
   use rt_data
   use process_configurations_ut, only: prepare_test_library
   use compilations, only: compile_library
 
   use integrations
 
   use phs_wood_ut, only: write_test_phs_file
 
 <<Standard module head>>
 
 <<Integrations: test declarations>>
 
 contains
 
 <<Integrations: tests>>
 
 end module integrations_uti
 
 @ %def integrations_uti
 @ API: driver for the unit tests below.
 <<Integrations: public test>>=
   public :: integrations_test
 <<Integrations: test driver>>=
   subroutine integrations_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Integrations: execute tests>>
   end subroutine integrations_test
 
 @ %def integrations_test
 @
 <<Integrations: public test>>=
   public :: integrations_history_test
 <<Integrations: test driver>>=
   subroutine integrations_history_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Integrations: execute history tests>>
   end subroutine integrations_history_test
 
 @ %def integrations_history_test
 @
 \subsubsection{Integration of test process}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type).  The phase-space implementation is [[phs_single]]
 (single-particle phase space), the integrator is [[mci_midpoint]].
 
 The cross section for the $2\to 2$ process $ss\to ss$ with its
 constant matrix element is given by
 \begin{equation}
   \sigma = c\times f\times \Phi_2 \times |M|^2.
 \end{equation}
 $c$ is the conversion constant
 \begin{equation}
   c = 0.3894\times 10^{12}\;\mathrm{fb}\,\mathrm{GeV}^2.
 \end{equation}
 $f$ is the flux of the incoming particles with mass
 $m=125\,\mathrm{GeV}$ and energy $\sqrt{s}=1000\,\mathrm{GeV}$
 \begin{equation}
   f = \frac{(2\pi)^4}{2\lambda^{1/2}(s,m^2,m^2)}
     = \frac{(2\pi)^4}{2\sqrt{s}\,\sqrt{s - 4m^2}}
     = 8.048\times 10^{-4}\;\mathrm{GeV}^{-2}
 \end{equation}
 $\Phi_2$ is the volume of the two-particle phase space
 \begin{equation}
   \Phi_2 = \frac{1}{4(2\pi)^5} = 2.5529\times 10^{-5}.
 \end{equation}
 The squared matrix element $|M|^2$ is unity.
 Combining everything, we obtain
 \begin{equation}
   \sigma = 8000\;\mathrm{fb}
 \end{equation}
 This number should appear as the final result.
 
 Note: In this and the following test, we reset the Fortran compiler and flag
 variables immediately before they are printed, so the test is portable.
 <<Integrations: execute tests>>=
   call test (integrations_1, "integrations_1", &
        "intrinsic test process", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_1
 <<Integrations: tests>>=
   subroutine integrations_1 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: integrations_1"
     write (u, "(A)")  "*   Purpose: integrate test process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     libname = "integration_1"
     procname = "prc_config_a"
 
     call prepare_test_library (global, libname, 1)
     call compile_library (libname, global)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("integrations1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%write (u, vars = [ &
          var_str ("$method"), &
          var_str ("sqrts"), &
          var_str ("$integration_method"), &
          var_str ("$phs_method"), &
          var_str ("$run_id")])
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_1"
 
   end subroutine integrations_1
 
 @ %def integrations_1
 @
 \subsubsection{Integration with cuts}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) with cuts set.
 <<Integrations: execute tests>>=
   call test (integrations_2, "integrations_2", &
        "intrinsic test process with cut", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_2
 <<Integrations: tests>>=
   subroutine integrations_2 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     type(string_t) :: cut_expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: parse_tree
 
     type(string_t), dimension(0) :: empty_string_array
 
     write (u, "(A)")  "* Test output: integrations_2"
     write (u, "(A)")  "*   Purpose: integrate test process with cut"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     write (u, "(A)")  "* Prepare a cut expression"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
     cut_expr_text = "all Pt > 100 [s]"
     call ifile_append (ifile, cut_expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (parse_tree, stream, .true.)
     global%pn%cuts_lexpr => parse_tree%get_root_ptr ()
 
     write (u, "(A)")  "* Build and initialize a test process"
     write (u, "(A)")
 
     libname = "integration_3"
     procname = "prc_config_a"
 
     call prepare_test_library (global, libname, 1)
     call compile_library (libname, global)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("integrations1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%write (u, vars = empty_string_array)
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_2"
 
   end subroutine integrations_2
 
 @ %def integrations_2
 @
 \subsubsection{Standard phase space}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the default ([[phs_wood]]) phase-space implementation.  We
 use an explicit phase-space configuration file with a single channel
 and integrate by [[mci_midpoint]].
 <<Integrations: execute tests>>=
   call test (integrations_3, "integrations_3", &
        "standard phase space", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_3
 <<Integrations: tests>>=
   subroutine integrations_3 (u)
   <<Use kinds>>
   <<Use strings>>
     use interactions, only: reset_interaction_counter
     use models
     use rt_data
     use process_configurations_ut, only: prepare_test_library
     use compilations, only: compile_library
     use integrations
 
     implicit none
 
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
     integer :: u_phs
 
     write (u, "(A)")  "* Test output: integrations_3"
     write (u, "(A)")  "*   Purpose: integrate test process"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
 
     libname = "integration_3"
     procname = "prc_config_a"
 
     call prepare_test_library (global, libname, 1)
     call compile_library (libname, global)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("integrations1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("default"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?phs_s_mapping"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     write (u, "(A)")  "* Create a scratch phase-space file"
     write (u, "(A)")
 
     u_phs = free_unit ()
     open (u_phs, file = "integrations_3.phs", &
          status = "replace", action = "write")
     call write_test_phs_file (u_phs, var_str ("prc_config_a_i1"))
     close (u_phs)
 
     call global%set_string (var_str ("$phs_file"),&
          var_str ("integrations_3.phs"), is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%write (u, vars = [ &
          var_str ("$phs_method"), &
          var_str ("$phs_file")])
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_3"
 
   end subroutine integrations_3
 
 @ %def integrations_3
 @
 \subsubsection{VAMP integration}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the single-channel ([[phs_single]]) phase-space
 implementation.  The integration method is [[vamp]].
 <<Integrations: execute tests>>=
   call test (integrations_4, "integrations_4", &
        "VAMP integration (one iteration)", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_4
 <<Integrations: tests>>=
   subroutine integrations_4 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: integrations_4"
     write (u, "(A)")  "*   Purpose: integrate test process using VAMP"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     libname = "integrations_4_lib"
     procname = "integrations_4"
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%pacify (efficiency_reset = .true., error_reset = .true.)
     call global%write (u, vars = [var_str ("$integration_method")], &
             pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_4"
 
   end subroutine integrations_4
 
 @ %def integrations_4
 @
 \subsubsection{Multiple iterations integration}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the single-channel ([[phs_single]]) phase-space
 implementation.  The integration method is [[vamp]].  We launch three
 iterations.
 <<Integrations: execute tests>>=
   call test (integrations_5, "integrations_5", &
        "VAMP integration (three iterations)", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_5
 <<Integrations: tests>>=
   subroutine integrations_5 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     write (u, "(A)")  "* Test output: integrations_5"
     write (u, "(A)")  "*   Purpose: integrate test process using VAMP"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     libname = "integrations_5_lib"
     procname = "integrations_5"
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([3], [1000])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%pacify (efficiency_reset = .true., error_reset = .true.)
     call global%write (u, vars = [var_str ("$integration_method")], &
             pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_5"
 
   end subroutine integrations_5
 
 @ %def integrations_5
 @
 \subsubsection{Multiple passes integration}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the single-channel ([[phs_single]]) phase-space
 implementation.  The integration method is [[vamp]].  We launch three
 passes with three iterations each.
 <<Integrations: execute tests>>=
   call test (integrations_6, "integrations_6", &
        "VAMP integration (three passes)", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_6
 <<Integrations: tests>>=
   subroutine integrations_6 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: no_vars
 
     write (u, "(A)")  "* Test output: integrations_6"
     write (u, "(A)")  "*   Purpose: integrate test process using VAMP"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     libname = "integrations_6_lib"
     procname = "integrations_6"
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([3, 3, 3], [1000, 1000, 1000], &
          adapt = [.true., .true., .false.], &
          adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%pacify (efficiency_reset = .true., error_reset = .true.)
     call global%write (u, vars = no_vars, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_6"
 
   end subroutine integrations_6
 
 @ %def integrations_6
 @
 \subsubsection{VAMP and default phase space}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the default ([[phs_wood]]) phase-space
 implementation.  The integration method is [[vamp]].  We launch three
 passes with three iterations each.  We enable channel equivalences and
 groves.
 <<Integrations: execute tests>>=
   call test (integrations_7, "integrations_7", &
        "VAMP integration with wood phase space", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_7
 <<Integrations: tests>>=
   subroutine integrations_7 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: no_vars
     integer :: iostat, u_phs
     character(95) :: buffer
     type(string_t) :: phs_file
     logical :: exist
 
     write (u, "(A)")  "* Test output: integrations_7"
     write (u, "(A)")  "*   Purpose: integrate test process using VAMP"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
 
     libname = "integrations_7_lib"
     procname = "integrations_7"
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?phs_s_mapping"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([3, 3, 3], [1000, 1000, 1000], &
          adapt = [.true., .true., .false.], &
          adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%pacify (efficiency_reset = .true., error_reset = .true.)
     call global%write (u, vars = no_vars, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Generated phase-space file"
     write (u, "(A)")
 
     phs_file = procname // ".r1.i1.phs"
     inquire (file = char (phs_file), exist = exist)
     if (exist) then
        u_phs = free_unit ()
        open (u_phs, file = char (phs_file), action = "read", status = "old")
        iostat = 0
        do while (iostat == 0)
           read (u_phs, "(A)", iostat = iostat)  buffer
           if (iostat == 0)  write (u, "(A)")  trim (buffer)
        end do
        close (u_phs)
     else
        write (u, "(A)")  "[file is missing]"
     end if
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_7"
 
   end subroutine integrations_7
 
 @ %def integrations_7
 @
 \subsubsection{Structure functions}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type) using the default ([[phs_wood]]) phase-space
 implementation.  The integration method is [[vamp]].  There is a structure
 function of type [[unit_test]].
 
 We use a test structure function $f(x)=x$ for both beams.  Together with the
 $1/x_1x_2$ factor from the phase-space flux and a unit matrix element, we
 should get the same result as previously for the process without structure
 functions.  There is a slight correction due to the $m_s$ mass which we set to
 zero here.
 <<Integrations: execute tests>>=
   call test (integrations_8, "integrations_8", &
        "integration with structure function", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_8
 <<Integrations: tests>>=
   subroutine integrations_8 (u)
   <<Use kinds>>
   <<Use strings>>
     use interactions, only: reset_interaction_counter
     use phs_forests
     use models
     use rt_data
     use process_configurations_ut, only: prepare_test_library
     use compilations, only: compile_library
     use integrations
 
     implicit none
 
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
     type(flavor_t) :: flv
     type(string_t) :: name
 
     write (u, "(A)")  "* Test output: integrations_8"
     write (u, "(A)")  "*   Purpose: integrate test process using VAMP &
          &with structure function"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
 
     libname = "integrations_8_lib"
     procname = "integrations_8"
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?phs_s_mapping"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), 0._default)
 
     call reset_interaction_counter ()
 
     call flv%init (25, global%model)
 
     name = flv%get_name ()
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call global%it_list%init ([1], [1000])
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%write (u, vars = [var_str ("ms")])
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_8"
 
   end subroutine integrations_8
 
 @ %def integrations_8
 @
 \subsubsection{Integration with sign change}
 Compile and integrate an intrinsic test matrix element ([[prc_test]]
 type).  The phase-space implementation is [[phs_single]]
 (single-particle phase space), the integrator is [[mci_midpoint]].
 The weight that is applied changes the sign in half of phase space.
 The weight is $-3$ and $1$, respectively, so the total result is equal
 to the original, but negative sign.
 
 The efficiency should (approximately) become the average of $1$ and
 $1/3$, that is $2/3$.
 <<Integrations: execute tests>>=
   call test (integrations_9, "integrations_9", &
        "handle sign change", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_9
 <<Integrations: tests>>=
   subroutine integrations_9 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
 
     type(string_t) :: wgt_expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: parse_tree
 
     write (u, "(A)")  "* Test output: integrations_9"
     write (u, "(A)")  "*   Purpose: integrate test process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
 
     write (u, "(A)")  "* Prepare a weight expression"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
     wgt_expr_text = "eval 2 * sgn (Pz) - 1 [s]"
     call ifile_append (ifile, wgt_expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (parse_tree, stream, .true.)
     global%pn%weight_expr => parse_tree%get_root_ptr ()
 
     write (u, "(A)")  "* Build and evaluate a test process"
     write (u, "(A)")
 
     libname = "integration_9"
     procname = "prc_config_a"
 
     call prepare_test_library (global, libname, 1)
     call compile_library (libname, global)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("integrations1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true.)
 
     call global%write (u, vars = [ &
          var_str ("$method"), &
          var_str ("sqrts"), &
          var_str ("$integration_method"), &
          var_str ("$phs_method"), &
          var_str ("$run_id")])
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_9"
 
   end subroutine integrations_9
 
 @ %def integrations_9
 @
 \subsubsection{Integration history for VAMP integration with default
   phase space}
 This test is only run when event analysis can be done.
 <<Integrations: execute history tests>>=
   call test (integrations_history_1, "integrations_history_1", &
        "Test integration history files", &
        u, results)
 <<Integrations: test declarations>>=
   public :: integrations_history_1
 <<Integrations: tests>>=
   subroutine integrations_history_1 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: no_vars
     integer :: iostat, u_his
     character(91) :: buffer
     type(string_t) :: his_file, ps_file, pdf_file
     logical :: exist, exist_ps, exist_pdf
 
     write (u, "(A)")  "* Test output: integrations_history_1"
     write (u, "(A)")  "*   Purpose: test integration history files"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and parameters"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
 
     libname = "integrations_history_1_lib"
     procname = "integrations_history_1"
 
     call global%set_log (var_str ("?vis_history"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?phs_s_mapping"),&
          .false., is_known = .true.)
 
     call prepare_test_library (global, libname, 1, [procname])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_real (var_str ("error_threshold"),&
          5E-6_default, is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known=.true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([2, 2, 2], [1000, 1000, 1000], &
          adapt = [.true., .true., .false.], &
          adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call integrate_process (procname, global, local_stack=.true., &
          eff_reset = .true.)
 
     call global%pacify (efficiency_reset = .true., error_reset = .true.)
     call global%write (u, vars = no_vars, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generated history files"
     write (u, "(A)")
 
     his_file = procname // ".r1.history.tex"
     ps_file  = procname // ".r1.history.ps"
     pdf_file = procname // ".r1.history.pdf"
     inquire (file = char (his_file), exist = exist)
     if (exist) then
        u_his = free_unit ()
        open (u_his, file = char (his_file), action = "read", status = "old")
        iostat = 0
        do while (iostat == 0)
           read (u_his, "(A)", iostat = iostat)  buffer
           if (iostat == 0)  write (u, "(A)")  trim (buffer)
        end do
        close (u_his)
     else
        write (u, "(A)")  "[History LaTeX file is missing]"
     end if
     inquire (file = char (ps_file), exist = exist_ps)
     if (exist_ps) then
        write (u, "(A)")  "[History Postscript file exists and is nonempty]"
     else
        write (u, "(A)")  "[History Postscript file is missing/non-regular]"
     end if
     inquire (file = char (pdf_file), exist = exist_pdf)
     if (exist_pdf) then
        write (u, "(A)")  "[History PDF file exists and is nonempty]"
     else
        write (u, "(A)")  "[History PDF file is missing/non-regular]"
     end if
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integrations_history_1"
 
   end subroutine integrations_history_1
 
 @ %def integrations_history_1
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Event Streams}
 This module manages I/O from/to multiple concurrent event streams.
 Usually, there is at most one input stream, but several output
 streams.  For the latter, we set up an array which can hold [[eio_t]]
 (event I/O) objects of different dynamic types simultaneously.  One of
 them may be marked as an input channel.
 <<[[event_streams.f90]]>>=
 <<File header>>
 
 module event_streams
 
 <<Use strings>>
   use io_units
   use diagnostics
   use events
   use eio_data
   use eio_base
   use rt_data
 
   use dispatch_transforms, only: dispatch_eio
 
 <<Standard module head>>
 
 <<Event streams: public>>
 
 <<Event streams: types>>
 
 contains
 
 <<Event streams: procedures>>
 
 end module event_streams
 @ %def event_streams
 @
 \subsection{Event Stream Array}
 Each entry is an [[eio_t]] object.  Since the type is dynamic, we need
 a wrapper:
 <<Event streams: types>>=
   type :: event_stream_entry_t
      class(eio_t), allocatable :: eio
   end type event_stream_entry_t
 
 @ %def event_stream_entry_t
 @ An array of event-stream entry objects.  If one of the entries is an
 input channel, [[i_in]] is the corresponding index.
 <<Event streams: public>>=
   public :: event_stream_array_t
 <<Event streams: types>>=
   type :: event_stream_array_t
      type(event_stream_entry_t), dimension(:), allocatable :: entry
      integer :: i_in = 0
    contains
    <<Event streams: event stream array: TBP>>
   end type event_stream_array_t
 
 @ %def event_stream_array_t
 @ Output.
 <<Event streams: event stream array: TBP>>=
   procedure :: write => event_stream_array_write
 <<Event streams: procedures>>=
   subroutine event_stream_array_write (object, unit)
     class(event_stream_array_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Event stream array:"
     if (allocated (object%entry)) then
        select case (size (object%entry))
        case (0)
           write (u, "(3x,A)")  "[empty]"
        case default
           do i = 1, size (object%entry)
              if (i == object%i_in)  write (u, "(1x,A)")  "Input stream:"
              call object%entry(i)%eio%write (u)
           end do
        end select
     else
        write (u, "(3x,A)")  "[undefined]"
     end if
   end subroutine event_stream_array_write
 
 @ %def event_stream_array_write
 @ Finalize all streams.
 <<Event streams: event stream array: TBP>>=
   procedure :: final => event_stream_array_final
 <<Event streams: procedures>>=
   subroutine event_stream_array_final (es_array)
     class(event_stream_array_t), intent(inout) :: es_array
     integer :: i
     do i = 1, size (es_array%entry)
        call es_array%entry(i)%eio%final ()
     end do
   end subroutine event_stream_array_final
 
 @ %def event_stream_array_final
 @ Initialization.  We use a generic [[sample]] name, open event I/O
 objects for all provided stream types (using the [[dispatch_eio]]
 routine), and initialize for the given list of process pointers.  If
 there is an [[input]] argument, this channel is initialized as an input
 channel and appended to the array.
 
 The [[input_data]] or, if not present, [[data]] may be modified.  This
 happens if we open a stream for reading and get new information there.
 <<Event streams: event stream array: TBP>>=
   procedure :: init => event_stream_array_init
 <<Event streams: procedures>>=
   subroutine event_stream_array_init &
        (es_array, sample, stream_fmt, global, &
        data, input, input_sample, input_data, allow_switch, &
        checkpoint, callback, &
        error)
     class(event_stream_array_t), intent(out) :: es_array
     type(string_t), intent(in) :: sample
     type(string_t), dimension(:), intent(in) :: stream_fmt
     type(rt_data_t), intent(in) :: global
     type(event_sample_data_t), intent(inout), optional :: data
     type(string_t), intent(in), optional :: input
     type(string_t), intent(in), optional :: input_sample
     type(event_sample_data_t), intent(inout), optional :: input_data
     logical, intent(in), optional :: allow_switch
     integer, intent(in), optional :: checkpoint
     integer, intent(in), optional :: callback
     logical, intent(out), optional :: error
     type(string_t) :: sample_in
     integer :: n, i, n_output, i_input, i_checkpoint, i_callback
     logical :: success, switch
     if (present (input_sample)) then
        sample_in = input_sample
     else
        sample_in = sample
     end if
     if (present (allow_switch)) then
        switch = allow_switch
     else
        switch = .true.
     end if
     if (present (error)) then
        error = .false.
     end if
     n = size (stream_fmt)
     n_output = n
     if (present (input)) then
        n = n + 1
        i_input = n
     else
        i_input = 0
     end if
     if (present (checkpoint)) then
        n = n + 1
        i_checkpoint = n
     else
        i_checkpoint = 0
     end if
     if (present (callback)) then
        n = n + 1
        i_callback = n
     else
        i_callback = 0
     end if
     allocate (es_array%entry (n))
     if (i_checkpoint > 0) then
        call dispatch_eio &
             (es_array%entry(i_checkpoint)%eio, var_str ("checkpoint"), &
             global%var_list, global%fallback_model, &
             global%event_callback)
        call es_array%entry(i_checkpoint)%eio%init_out (sample, data)
     end if
     if (i_callback > 0) then
        call dispatch_eio &
             (es_array%entry(i_callback)%eio, var_str ("callback"), &
             global%var_list, global%fallback_model, &
             global%event_callback)
        call es_array%entry(i_callback)%eio%init_out (sample, data)
     end if
     if (i_input > 0) then
        call dispatch_eio (es_array%entry(i_input)%eio, input, &
             global%var_list, global%fallback_model, &
             global%event_callback)
        if (present (input_data)) then
           call es_array%entry(i_input)%eio%init_in &
                (sample_in, input_data, success)
        else
           call es_array%entry(i_input)%eio%init_in &
                (sample_in, data, success)
        end if
        if (success) then
           es_array%i_in = i_input
        else if (present (input_sample)) then
           if (present (error)) then
              error = .true.
           else
              call msg_fatal ("Events: &
                   &parameter mismatch in input, aborting")
           end if
        else
           call msg_message ("Events: &
                &parameter mismatch, discarding old event set")
           call es_array%entry(i_input)%eio%final ()
           if (switch) then
              call msg_message ("Events: generating new events")
              call es_array%entry(i_input)%eio%init_out (sample, data)
           end if
        end if
     end if
     do i = 1, n_output
        call dispatch_eio (es_array%entry(i)%eio, stream_fmt(i), &
             global%var_list, global%fallback_model, &
             global%event_callback)
        call es_array%entry(i)%eio%init_out (sample, data)
     end do
   end subroutine event_stream_array_init
 
 @ %def event_stream_array_init
 @ Switch the (only) input channel to an output channel, so further
 events are appended to the respective stream.
 <<Event streams: event stream array: TBP>>=
   procedure :: switch_inout => event_stream_array_switch_inout
 <<Event streams: procedures>>=
   subroutine event_stream_array_switch_inout (es_array)
     class(event_stream_array_t), intent(inout) :: es_array
     integer :: n
     if (es_array%has_input ()) then
        n = es_array%i_in
        call es_array%entry(n)%eio%switch_inout ()
        es_array%i_in = 0
     else
        call msg_bug ("Reading events: switch_inout: no input stream selected")
     end if
   end subroutine event_stream_array_switch_inout
 
 @ %def event_stream_array_switch_inout
 @ Output an event (with given process number) to all output streams.
 If there is no output stream, do nothing.
 <<Event streams: event stream array: TBP>>=
   procedure :: output => event_stream_array_output
 <<Event streams: procedures>>=
   subroutine event_stream_array_output (es_array, event, i_prc, &
                                         event_index, passed, pacify)
     class(event_stream_array_t), intent(inout) :: es_array
     type(event_t), intent(in), target :: event
     integer, intent(in) :: i_prc, event_index
     logical, intent(in), optional :: passed, pacify
     logical :: increased
     integer :: i
     do i = 1, size (es_array%entry)
        if (i /= es_array%i_in) then
           associate (eio => es_array%entry(i)%eio)
             if (eio%split) then
                if (eio%split_n_evt > 0 .and. event_index > 1) then
                   if (mod (event_index, eio%split_n_evt) == 1) then
                      call eio%split_out ()
                   end if
                else if (eio%split_n_kbytes > 0) then
                   call eio%update_split_count (increased)
                   if (increased)  call eio%split_out ()
                end if
             end if
             call eio%output (event, i_prc, reading = es_array%i_in /= 0, &
                  passed = passed, &
                  pacify = pacify)
           end associate
        end if
     end do
   end subroutine event_stream_array_output
 
 @ %def event_stream_array_output
 @ Input the [[i_prc]] index which selects the process for the current
 event.  This is separated from reading the event, because it
 determines which event record to read.  [[iostat]] may indicate an
 error or an EOF condition, as usual.
 <<Event streams: event stream array: TBP>>=
   procedure :: input_i_prc => event_stream_array_input_i_prc
 <<Event streams: procedures>>=
   subroutine event_stream_array_input_i_prc (es_array, i_prc, iostat)
     class(event_stream_array_t), intent(inout) :: es_array
     integer, intent(out) :: i_prc
     integer, intent(out) :: iostat
     integer :: n
     if (es_array%has_input ()) then
        n = es_array%i_in
        call es_array%entry(n)%eio%input_i_prc (i_prc, iostat)
     else
        call msg_fatal ("Reading events: no input stream selected")
     end if
   end subroutine event_stream_array_input_i_prc
 
 @ %def event_stream_array_input_i_prc
 @ Input an event from the selected input stream.  [[iostat]] may indicate an
 error or an EOF condition, as usual.
 <<Event streams: event stream array: TBP>>=
   procedure :: input_event => event_stream_array_input_event
 <<Event streams: procedures>>=
   subroutine event_stream_array_input_event (es_array, event, iostat)
     class(event_stream_array_t), intent(inout) :: es_array
     type(event_t), intent(inout), target :: event
     integer, intent(out) :: iostat
     integer :: n
     if (es_array%has_input ()) then
        n = es_array%i_in
        call es_array%entry(n)%eio%input_event (event, iostat)
     else
        call msg_fatal ("Reading events: no input stream selected")
     end if
   end subroutine event_stream_array_input_event
 
 @ %def event_stream_array_input_event
 @ Skip an entry of eio\_t. Used to synchronize the event read-in for
 NLO events.
 <<Event streams: event stream array: TBP>>=
   procedure :: skip_eio_entry => event_stream_array_skip_eio_entry
 <<Event streams: procedures>>=
   subroutine event_stream_array_skip_eio_entry (es_array, iostat)
     class(event_stream_array_t), intent(inout) :: es_array
     integer, intent(out) :: iostat
     integer :: n
     if (es_array%has_input ()) then
        n = es_array%i_in
        call es_array%entry(n)%eio%skip (iostat)
     else
        call msg_fatal ("Reading events: no input stream selected")
     end if
   end subroutine event_stream_array_skip_eio_entry
 
 @ %def event_stream_array_skip_eio_entry
 @ Return true if there is an input channel among the event streams.
 <<Event streams: event stream array: TBP>>=
   procedure :: has_input => event_stream_array_has_input
 <<Event streams: procedures>>=
   function event_stream_array_has_input (es_array) result (flag)
     class(event_stream_array_t), intent(in) :: es_array
     logical :: flag
     flag = es_array%i_in /= 0
   end function event_stream_array_has_input
 
 @ %def event_stream_array_has_input
 @
 \subsection{Unit Tests}
 Test module, followed by the stand-alone unit-test procedures.
 <<[[event_streams_ut.f90]]>>=
 <<File header>>
 
 module event_streams_ut
   use unit_tests
   use event_streams_uti
 
 <<Standard module head>>
 
 <<Event streams: public test>>
 
 contains
 
 <<Event streams: test driver>>
 
 end module event_streams_ut
 @
 <<[[event_streams_uti.f90]]>>=
 <<File header>>
 
 module event_streams_uti
 
 <<Use kinds>>
 <<Use strings>>
   use model_data
   use eio_data
   use process, only: process_t
   use instances, only: process_instance_t
   use models
   use rt_data
   use events
 
   use event_streams
 
 <<Standard module head>>
 
 <<Event streams: test declarations>>
 
 contains
 
 <<Event streams: tests>>
 
 end module event_streams_uti
 
 @ %def event_streams_uti
 @ API: driver for the unit tests below.
 <<Event streams: public test>>=
   public :: event_streams_test
 <<Event streams: test driver>>=
   subroutine event_streams_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Event streams: execute tests>>
   end subroutine event_streams_test
 
 @ %def event_streams_test
 @
 \subsubsection{Empty event stream}
 This should set up an empty event output stream array, including
 initialization, output, and finalization (which are all no-ops).
 <<Event streams: execute tests>>=
   call test (event_streams_1, "event_streams_1", &
        "empty event stream array", &
        u, results)
 <<Event streams: test declarations>>=
   public :: event_streams_1
 <<Event streams: tests>>=
   subroutine event_streams_1 (u)
     integer, intent(in) :: u
     type(event_stream_array_t) :: es_array
     type(rt_data_t) :: global
     type(event_t) :: event
     type(string_t) :: sample
     type(string_t), dimension(0) :: empty_string_array
 
     write (u, "(A)")  "* Test output: event_streams_1"
     write (u, "(A)")  "*   Purpose: handle empty event stream array"
     write (u, "(A)")
 
     sample = "event_streams_1"
 
     call es_array%init (sample, empty_string_array, global)
     call es_array%output (event, 42, 1)
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: event_streams_1"
 
   end subroutine event_streams_1
 
 @ %def event_streams_1
 @
 \subsubsection{Nontrivial event stream}
 Here we generate a trivial event and choose [[raw]] output as an entry in
 the stream array.
 <<Event streams: execute tests>>=
   call test (event_streams_2, "event_streams_2", &
        "nontrivial event stream array", &
        u, results)
 <<Event streams: test declarations>>=
   public :: event_streams_2
 <<Event streams: tests>>=
   subroutine event_streams_2 (u)
     use processes_ut, only: prepare_test_process
     integer, intent(in) :: u
     type(event_stream_array_t) :: es_array
     type(rt_data_t) :: global
     type(model_data_t), target :: model
     type(event_t), allocatable, target :: event
     type(process_t), allocatable, target :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(string_t) :: sample
     type(string_t), dimension(0) :: empty_string_array
     integer :: i_prc, iostat
 
     write (u, "(A)")  "* Test output: event_streams_2"
     write (u, "(A)")  "*   Purpose: handle empty event stream array"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call model%init_test ()
 
     write (u, "(A)")  "* Generate test process event"
     write (u, "(A)")
 
     allocate (process)
     allocate (process_instance)
     call prepare_test_process (process, process_instance, model)
     call process_instance%setup_event_data ()
 
     allocate (event)
     call event%basic_init ()
     call event%connect (process_instance, process%get_model_ptr ())
     call event%generate (1, [0.4_default, 0.4_default])
     call event%set_index (42)
     call event%evaluate_expressions ()
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Allocate raw eio stream and write event to file"
     write (u, "(A)")
 
     sample = "event_streams_2"
 
     call es_array%init (sample, [var_str ("raw")], global)
     call es_array%output (event, 1, 1)
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)") "* Reallocate raw eio stream for reading"
     write (u, "(A)")
 
     sample = "foo"
     call es_array%init (sample, empty_string_array, global, &
          input = var_str ("raw"), input_sample = var_str ("event_streams_2"))
     call es_array%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Reread event"
     write (u, "(A)")
 
     call es_array%input_i_prc (i_prc, iostat)
 
     write (u, "(1x,A,I0)")  "i_prc = ", i_prc
     write (u, "(A)")
     call es_array%input_event (event, iostat)
     call es_array%final ()
 
     call event%write (u)
 
     call global%final ()
 
     call model%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: event_streams_2"
 
   end subroutine event_streams_2
 
 @ %def event_streams_2
 @
 \subsubsection{Switch in/out}
 Here we generate an event file and test switching from writing to
 reading when the file is exhausted.
 <<Event streams: execute tests>>=
   call test (event_streams_3, "event_streams_3", &
        "switch input/output", &
        u, results)
 <<Event streams: test declarations>>=
   public :: event_streams_3
 <<Event streams: tests>>=
   subroutine event_streams_3 (u)
     use processes_ut, only: prepare_test_process
     integer, intent(in) :: u
     type(event_stream_array_t) :: es_array
     type(rt_data_t) :: global
     type(model_data_t), target :: model
     type(event_t), allocatable, target :: event
     type(process_t), allocatable, target :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(string_t) :: sample
     type(string_t), dimension(0) :: empty_string_array
     integer :: i_prc, iostat
 
     write (u, "(A)")  "* Test output: event_streams_3"
     write (u, "(A)")  "*   Purpose: handle in/out switching"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call model%init_test ()
 
     write (u, "(A)")  "* Generate test process event"
     write (u, "(A)")
 
     allocate (process)
     allocate (process_instance)
     call prepare_test_process (process, process_instance, model)
     call process_instance%setup_event_data ()
 
     allocate (event)
     call event%basic_init ()
     call event%connect (process_instance, process%get_model_ptr ())
     call event%generate (1, [0.4_default, 0.4_default])
     call event%increment_index ()
     call event%evaluate_expressions ()
 
     write (u, "(A)") "* Allocate raw eio stream and write event to file"
     write (u, "(A)")
 
     sample = "event_streams_3"
 
     call es_array%init (sample, [var_str ("raw")], global)
     call es_array%output (event, 1, 1)
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)") "* Reallocate raw eio stream for reading"
     write (u, "(A)")
 
     call es_array%init (sample, empty_string_array, global, &
          input = var_str ("raw"))
     call es_array%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Reread event"
     write (u, "(A)")
 
     call es_array%input_i_prc (i_prc, iostat)
     call es_array%input_event (event, iostat)
 
     write (u, "(A)") "* Attempt to read another event (fail), then generate"
     write (u, "(A)")
 
     call es_array%input_i_prc (i_prc, iostat)
     if (iostat < 0) then
        call es_array%switch_inout ()
        call event%generate (1, [0.3_default, 0.3_default])
        call event%increment_index ()
        call event%evaluate_expressions ()
        call es_array%output (event, 1, 2)
     end if
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Reallocate raw eio stream for reading"
     write (u, "(A)")
 
     call es_array%init (sample, empty_string_array, global, &
          input = var_str ("raw"))
     call es_array%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Reread two events and display 2nd event"
     write (u, "(A)")
 
     call es_array%input_i_prc (i_prc, iostat)
     call es_array%input_event (event, iostat)
     call es_array%input_i_prc (i_prc, iostat)
 
     call es_array%input_event (event, iostat)
     call es_array%final ()
 
     call event%write (u)
 
     call global%final ()
 
     call model%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: event_streams_3"
 
   end subroutine event_streams_3
 
 @ %def event_streams_3
 @
 \subsubsection{Checksum}
 Here we generate an event file and repeat twice, once with identical
 parameters and once with modified parameters.
 <<Event streams: execute tests>>=
   call test (event_streams_4, "event_streams_4", &
        "check MD5 sum", &
        u, results)
 <<Event streams: test declarations>>=
   public :: event_streams_4
 <<Event streams: tests>>=
   subroutine event_streams_4 (u)
     integer, intent(in) :: u
     type(event_stream_array_t) :: es_array
     type(rt_data_t) :: global
     type(process_t), allocatable, target :: process
     type(string_t) :: sample
     type(string_t), dimension(0) :: empty_string_array
     type(event_sample_data_t) :: data
 
     write (u, "(A)")  "* Test output: event_streams_4"
     write (u, "(A)")  "*   Purpose: handle in/out switching"
     write (u, "(A)")
 
     write (u, "(A)")  "* Generate test process event"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%set_log (var_str ("?check_event_file"), &
          .true., is_known = .true.)
 
     allocate (process)
 
     write (u, "(A)") "* Allocate raw eio stream for writing"
     write (u, "(A)")
 
     sample = "event_streams_4"
     data%md5sum_cfg = "1234567890abcdef1234567890abcdef"
 
     call es_array%init (sample, [var_str ("raw")], global, data)
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)") "* Reallocate raw eio stream for reading"
     write (u, "(A)")
 
     call es_array%init (sample, empty_string_array, global, &
          data, input = var_str ("raw"))
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)") "* Reallocate modified raw eio stream for reading (fail)"
     write (u, "(A)")
 
     data%md5sum_cfg = "1234567890______1234567890______"
     call es_array%init (sample, empty_string_array, global, &
          data, input = var_str ("raw"))
     call es_array%write (u)
     call es_array%final ()
 
     write (u, "(A)")
     write (u, "(A)") "* Repeat ignoring checksum"
     write (u, "(A)")
 
     call global%set_log (var_str ("?check_event_file"), &
          .false., is_known = .true.)
     call es_array%init (sample, empty_string_array, global, &
          data, input = var_str ("raw"))
     call es_array%write (u)
     call es_array%final ()
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: event_streams_4"
 
   end subroutine event_streams_4
 
 @ %def event_streams_4
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Restricted Subprocesses}
 This module provides an automatic means to construct restricted subprocesses
 of a current process object.  A restricted subprocess has the same initial and
 final state as the current process, but a restricted set of Feynman graphs.
 
 The actual application extracts the set of resonance histories that apply to
 the process and uses this to construct subprocesses that are restricted to one
 of those histories, respectively.  The resonance histories are derived from
 the phase-space setup.  This implies that the method is tied to the OMega
 matrix element generator and to the wood phase space method.
 
 The processes are collected in a new process library that is generated
 on-the-fly.
 
 The [[resonant_subprocess_t]] object is intended as a component of the event
 record, which manages all operations regarding resonance handling.
 
 The run-time calculations are delegated to an event transform
 ([[evt_resonance_t]]), as a part of the event transform chain.  The transform
 selects one (or none) of the resonance histories, given the momentum
 configuration, computes matrix elements and inserts resonances into the
 particle set.
 <<[[restricted_subprocesses.f90]]>>=
 <<File header>>
 
 module restricted_subprocesses
 
 <<Use kinds>>
 <<Use strings>>
   use diagnostics, only: msg_message, msg_fatal, msg_bug
   use diagnostics, only: signal_is_pending
   use io_units, only: given_output_unit
   use format_defs, only: FMT_14, FMT_19
   use string_utils, only: str
   use lorentz, only: vector4_t
   use particle_specifiers, only: prt_spec_t
   use particles, only: particle_set_t
   use resonances, only: resonance_history_t, resonance_history_set_t
   use variables, only: var_list_t
   use models, only: model_t
   use process_libraries, only: process_component_def_t
   use process_libraries, only: process_library_t
   use process_libraries, only: STAT_ACTIVE
   use prclib_stacks, only: prclib_entry_t
   use event_transforms, only: evt_t
   use resonance_insertion, only: evt_resonance_t
   use rt_data, only: rt_data_t
   use compilations, only: compile_library
   use process_configurations, only: process_configuration_t
   use process, only: process_t, process_ptr_t
   use instances, only: process_instance_t, process_instance_ptr_t
   use integrations, only: integrate_process
 
 <<Use mpi f08>>
 
 <<Standard module head>>
 
 <<Restricted subprocesses: public>>
 
 <<Restricted subprocesses: types>>
 
 <<Restricted subprocesses: interfaces>>
 
 contains
 
 <<Restricted subprocesses: procedures>>
 
 end module restricted_subprocesses
 @ %def restricted_subprocesses
 @
 \subsection{Process configuration}
 We extend the [[process_configuration_t]] by another method for initialization
 that takes into account a resonance history.
 <<Restricted subprocesses: public>>=
   public :: restricted_process_configuration_t
 <<Restricted subprocesses: types>>=
   type, extends (process_configuration_t) :: restricted_process_configuration_t
      private
    contains
    <<Restricted subprocesses: restricted process configuration: TBP>>
   end type restricted_process_configuration_t
 
 @ %def restricted_process_configuration_t
 @
 Resonance history as an argument.  We use it to override the [[restrictions]]
 setting in a local variable list.  Since we can construct the restricted
 process only by using OMega, we enforce it as the ME method.  Other settings
 are taken from the variable list.  The model will most likely be set, but we
 insert a safeguard just in case.
 
 Also, the resonant subprocess should not itself spawn resonant
 subprocesses, so we unset [[?resonance_history]].
 
 We have to create a local copy of the model here, via pointer
 allocation.  The reason is that the model as stored (via pointer) in
 the base type will be finalized and deallocated.
 
 The current implementation will generate a LO process, the optional
 [[nlo_process]] is unset.  (It is not obvious
 whether the construction makes sense beyond LO.)
 <<Restricted subprocesses: restricted process configuration: TBP>>=
   procedure :: init_resonant_process
 <<Restricted subprocesses: procedures>>=
   subroutine init_resonant_process &
        (prc_config, prc_name, prt_in, prt_out, res_history, model, var_list)
     class(restricted_process_configuration_t), intent(out) :: prc_config
     type(string_t), intent(in) :: prc_name
     type(prt_spec_t), dimension(:), intent(in) :: prt_in
     type(prt_spec_t), dimension(:), intent(in) :: prt_out
     type(resonance_history_t), intent(in) :: res_history
     type(model_t), intent(in), target :: model
     type(var_list_t), intent(in), target :: var_list
     type(model_t), pointer :: local_model
     type(var_list_t) :: local_var_list
     allocate (local_model)
     call local_model%init_instance (model)
     call local_var_list%link (var_list)
     call local_var_list%append_string (var_str ("$model_name"), &
          sval = local_model%get_name (), &
          intrinsic=.true.)
     call local_var_list%append_string (var_str ("$method"), &
          sval = var_str ("omega"), &
          intrinsic=.true.)
     call local_var_list%append_string (var_str ("$restrictions"), &
          sval = res_history%as_omega_string (size (prt_in)), &
          intrinsic = .true.)
     call local_var_list%append_log (var_str ("?resonance_history"), &
          lval = .false., &
          intrinsic = .true.)
     call prc_config%init (prc_name, size (prt_in), 1, &
          local_model, local_var_list)
     call prc_config%setup_component (1, &
          prt_in, prt_out, &
          local_model, local_var_list)
   end subroutine init_resonant_process
 
 @ %def init_resonant_process
 @
 \subsection{Resonant-subprocess set manager}
 This data type enables generation of a library of resonant subprocesses for a
 given master process, and it allows for convenient access.  The matrix
 elements from the subprocesses can be used as channel weights to activate a
 selector, which then returns a preferred channel via some random number
 generator.
 <<Restricted subprocesses: public>>=
   public :: resonant_subprocess_set_t
 <<Restricted subprocesses: types>>=
   type :: resonant_subprocess_set_t
      private
      integer, dimension(:), allocatable :: n_history
      type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
      logical :: lib_active = .false.
      type(string_t) :: libname
      type(string_t), dimension(:), allocatable :: proc_id
      type(process_ptr_t), dimension(:), allocatable :: subprocess
      type(process_instance_ptr_t), dimension(:), allocatable :: instance
      logical :: filled = .false.
      type(evt_resonance_t), pointer :: evt => null ()
    contains
    <<Restricted subprocesses: resonant subprocess set: TBP>>
   end type resonant_subprocess_set_t
 
 @ %def resonant_subprocess_set_t
 @ Output
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: write => resonant_subprocess_set_write
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_write (prc_set, unit, testflag)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     logical :: truncate
     integer :: u, i
     u = given_output_unit (unit)
     truncate = .false.;  if (present (testflag))  truncate = testflag
     write (u, "(1x,A)")  "Resonant subprocess set:"
     if (allocated (prc_set%n_history)) then
        if (any (prc_set%n_history > 0)) then
           do i = 1, size (prc_set%n_history)
              if (prc_set%n_history(i) > 0) then
                 write (u, "(1x,A,I0)")  "Component #", i
                 call prc_set%res_history_set(i)%write (u, indent=1)
              end if
           end do
           if (prc_set%lib_active) then
              write (u, "(3x,A,A,A)")  "Process library = '", &
                   char (prc_set%libname), "'"
           else
              write (u, "(3x,A)")  "Process library: [inactive]"
           end if
           if (associated (prc_set%evt)) then
              if (truncate) then
                 write (u, "(3x,A,1x," // FMT_14 // ")") &
                      "Process sqme =", prc_set%get_master_sqme ()
              else
                 write (u, "(3x,A,1x," // FMT_19 // ")") &
                      "Process sqme =", prc_set%get_master_sqme ()
              end if
           end if
           if (associated (prc_set%evt)) then
              write (u, "(3x,A)")  "Event transform: associated"
              write (u, "(2x)", advance="no")
              call prc_set%evt%write_selector (u, testflag)
           else
              write (u, "(3x,A)")  "Event transform: not associated"
           end if
        else
           write (u, "(2x,A)")  "[empty]"
        end if
     else
        write (u, "(3x,A)")  "[not allocated]"
     end if
   end subroutine resonant_subprocess_set_write
 
 @ %def resonant_subprocess_set_write
 @
 \subsection{Resonance history set}
 Initialize subprocess set with an array of pre-created resonance
 history sets.
 
 Safeguard: if there are no resonances in the input, initialize the local set
 as empty, but complete.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: init => resonant_subprocess_set_init
   procedure :: fill_resonances => resonant_subprocess_set_fill_resonances
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_init (prc_set, n_component)
     class(resonant_subprocess_set_t), intent(out) :: prc_set
     integer, intent(in) :: n_component
     allocate (prc_set%res_history_set (n_component))
     allocate (prc_set%n_history (n_component), source = 0)
   end subroutine resonant_subprocess_set_init
 
   subroutine resonant_subprocess_set_fill_resonances (prc_set, &
        res_history_set, i_component)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     type(resonance_history_set_t), intent(in) :: res_history_set
     integer, intent(in) :: i_component
     prc_set%n_history(i_component) = res_history_set%get_n_history ()
     if (prc_set%n_history(i_component) > 0) then
        prc_set%res_history_set(i_component) = res_history_set
     else
        call prc_set%res_history_set(i_component)%init (initial_size = 0)
        call prc_set%res_history_set(i_component)%freeze ()
     end if
   end subroutine resonant_subprocess_set_fill_resonances
 
 @ %def resonant_subprocess_set_init
 @ %def resonant_subprocess_set_fill_resonances
 @ Return the resonance history set.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: get_resonance_history_set &
        => resonant_subprocess_set_get_resonance_history_set
 <<Restricted subprocesses: procedures>>=
   function resonant_subprocess_set_get_resonance_history_set (prc_set) &
        result (res_history_set)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
     res_history_set = prc_set%res_history_set
   end function resonant_subprocess_set_get_resonance_history_set
 
 @ %def resonant_subprocess_set_get_resonance_history_set
 @
 \subsection{Library for the resonance history set}
 The recommended library name: append [[_R]] to the process name.
 <<Restricted subprocesses: public>>=
   public :: get_libname_res
 <<Restricted subprocesses: procedures>>=
   elemental function get_libname_res (proc_id) result (libname)
     type(string_t), intent(in) :: proc_id
     type(string_t) :: libname
     libname = proc_id // "_R"
   end function get_libname_res
 
 @ %def get_libname_res
 @ Here we scan the global process library whether any
 processes require resonant subprocesses to be constructed.  If yes,
 create process objects with phase space and construct the process
 libraries as usual.  Then append the library names to the array.
 
 The temporary integration objects should carry the [[phs_only]]
 flag.  We set this in the local environment.
 
 Once a process object with resonance histories (derived from phase
 space) has been created, we extract the resonance histories and use
 them, together with the process definition, to create the new library.
 
 Finally, compile the library.
 <<Restricted subprocesses: public>>=
   public :: spawn_resonant_subprocess_libraries
 <<Restricted subprocesses: procedures>>=
   subroutine spawn_resonant_subprocess_libraries &
        (libname, local, global, libname_res)
     type(string_t), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), target :: global
     type(string_t), dimension(:), allocatable, intent(inout) :: libname_res
     type(process_library_t), pointer :: lib
     type(string_t), dimension(:), allocatable :: process_id_res
     type(process_t), pointer :: process
     type(resonance_history_set_t) :: res_history_set
     type(process_component_def_t), pointer :: process_component_def
     logical :: phs_only_saved, exist
     integer :: i_proc, i_component
     lib => global%prclib_stack%get_library_ptr (libname)
     call lib%get_process_id_req_resonant (process_id_res)
     if (size (process_id_res) > 0) then
        call msg_message ("Creating resonant-subprocess libraries &
             &for library '" // char (libname) // "'")
        libname_res = get_libname_res (process_id_res)
        phs_only_saved = local%var_list%get_lval (var_str ("?phs_only"))
        call local%var_list%set_log &
             (var_str ("?phs_only"), .true., is_known=.true.)
        do i_proc = 1, size (process_id_res)
           associate (proc_id => process_id_res (i_proc))
             call msg_message ("Process '" // char (proc_id) // "': &
                  &constructing phase space for resonance structure")
             call integrate_process (proc_id, local, global)
             process => global%process_stack%get_process_ptr (proc_id)
             call create_library (libname_res(i_proc), global, exist)
             if (.not. exist) then
                do i_component = 1, process%get_n_components ()
                   call process%extract_resonance_history_set &
                        (res_history_set, i_component = i_component)
                   process_component_def &
                        => process%get_component_def_ptr (i_component)
                   call add_to_library (libname_res(i_proc), &
                        res_history_set, &
                        process_component_def%get_prt_spec_in (), &
                        process_component_def%get_prt_spec_out (), &
                        global)
                end do
                call msg_message ("Process library '" &
                     // char (libname_res(i_proc)) &
                     // "': created")
             end if
             call global%update_prclib (lib)
           end associate
        end do
        call local%var_list%set_log &
             (var_str ("?phs_only"), phs_only_saved, is_known=.true.)
     end if
   end subroutine spawn_resonant_subprocess_libraries
     
 @ %def spawn_resonant_subprocess_libraries
 @ This is another version of the library constructor, bound to a
 restricted-subprocess set object.  Create the appropriate
 process library, add processes, and close the library.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: create_library => resonant_subprocess_set_create_library
   procedure :: add_to_library => resonant_subprocess_set_add_to_library
   procedure :: freeze_library => resonant_subprocess_set_freeze_library
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_create_library (prc_set, &
        libname, global, exist)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     type(string_t), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: global
     logical, intent(out) :: exist
     prc_set%libname = libname
     call create_library (prc_set%libname, global, exist)
   end subroutine resonant_subprocess_set_create_library
 
   subroutine resonant_subprocess_set_add_to_library (prc_set, &
        i_component, prt_in, prt_out, global)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     integer, intent(in) :: i_component
     type(prt_spec_t), dimension(:), intent(in) :: prt_in
     type(prt_spec_t), dimension(:), intent(in) :: prt_out
     type(rt_data_t), intent(inout), target :: global
     call add_to_library (prc_set%libname, &
          prc_set%res_history_set(i_component), &
          prt_in, prt_out, global)
   end subroutine resonant_subprocess_set_add_to_library
 
   subroutine resonant_subprocess_set_freeze_library (prc_set, global)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     type(rt_data_t), intent(inout), target :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     lib => global%prclib_stack%get_library_ptr (prc_set%libname)
     call lib%get_process_id_list (prc_set%proc_id)
     prc_set%lib_active = .true.
   end subroutine resonant_subprocess_set_freeze_library
 
 @ %def resonant_subprocess_set_create_library
 @ %def resonant_subprocess_set_add_to_library
 @ %def resonant_subprocess_set_freeze_library
 @ The common parts of the procedures above: (i) create a new process
 library or recover it, (ii) for each history, create a
 process configuration and record it.
 <<Restricted subprocesses: procedures>>=
   subroutine create_library (libname, global, exist)
     type(string_t), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: global
     logical, intent(out) :: exist
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     type(resonance_history_t) :: res_history
     type(string_t), dimension(:), allocatable :: proc_id
     type(restricted_process_configuration_t) :: prc_config
     integer :: i
     lib => global%prclib_stack%get_library_ptr (libname)
     exist = associated (lib)
     if (.not. exist) then
        call msg_message ("Creating library for resonant subprocesses '" &
             // char (libname) // "'")
        allocate (lib_entry)
        call lib_entry%init (libname)
        lib => lib_entry%process_library_t
        call global%add_prclib (lib_entry)
     else
        call msg_message ("Using library for resonant subprocesses '" &
             // char (libname) // "'")
        call global%update_prclib (lib)
     end if
   end subroutine create_library
   
   subroutine add_to_library (libname, res_history_set, prt_in, prt_out, global)
     type(string_t), intent(in) :: libname
     type(resonance_history_set_t), intent(in) :: res_history_set
     type(prt_spec_t), dimension(:), intent(in) :: prt_in
     type(prt_spec_t), dimension(:), intent(in) :: prt_out
     type(rt_data_t), intent(inout), target :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     type(resonance_history_t) :: res_history
     type(string_t), dimension(:), allocatable :: proc_id
     type(restricted_process_configuration_t) :: prc_config
     integer :: n0, i
     lib => global%prclib_stack%get_library_ptr (libname)
     if (associated (lib)) then
        n0 = lib%get_n_processes ()
        allocate (proc_id (res_history_set%get_n_history ()))
        do i = 1, size (proc_id)
           proc_id(i) = libname // str (n0 + i)
           res_history = res_history_set%get_history(i)
           call prc_config%init_resonant_process (proc_id(i), &
                prt_in, prt_out, &
                res_history, &
                global%model, global%var_list)
           call msg_message ("Resonant subprocess #" &
                // char (str(n0+i)) // ": " &
                // char (res_history%as_omega_string (size (prt_in))))
           call prc_config%record (global)
           if (signal_is_pending ())  return
        end do
     else
        call msg_bug ("Adding subprocesses: library '" &
             // char (libname) // "' not found")
     end if
   end subroutine add_to_library
   
 @ %def create_library
 @ %def add_to_library
 @ Compile the generated library, required settings taken from the
 [[global]] data set.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: compile_library => resonant_subprocess_set_compile_library
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_compile_library (prc_set, global)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     type(rt_data_t), intent(inout), target :: global
     type(process_library_t), pointer :: lib
     lib => global%prclib_stack%get_library_ptr (prc_set%libname)
     if (lib%get_status () < STAT_ACTIVE) then
        call compile_library (prc_set%libname, global)
     end if
   end subroutine resonant_subprocess_set_compile_library
 
 @ %def resonant_subprocess_set_compile_library
 @ Check if the library has been created / the process has been evaluated.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: is_active => resonant_subprocess_set_is_active
 <<Restricted subprocesses: procedures>>=
   function resonant_subprocess_set_is_active (prc_set) result (flag)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     logical :: flag
     flag = prc_set%lib_active
   end function resonant_subprocess_set_is_active
 
 @ %def resonant_subprocess_set_is_active
 @ Return number of generated process objects, library, and process IDs.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: get_n_process => resonant_subprocess_set_get_n_process
   procedure :: get_libname => resonant_subprocess_set_get_libname
   procedure :: get_proc_id => resonant_subprocess_set_get_proc_id
 <<Restricted subprocesses: procedures>>=
   function resonant_subprocess_set_get_n_process (prc_set) result (n)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     integer :: n
     if (prc_set%lib_active) then
        n = size (prc_set%proc_id)
     else
        n = 0
     end if
   end function resonant_subprocess_set_get_n_process
 
   function resonant_subprocess_set_get_libname (prc_set) result (libname)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     type(string_t) :: libname
     if (prc_set%lib_active) then
        libname = prc_set%libname
     else
        libname = ""
     end if
   end function resonant_subprocess_set_get_libname
 
   function resonant_subprocess_set_get_proc_id (prc_set, i) result (proc_id)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     integer, intent(in) :: i
     type(string_t) :: proc_id
     if (allocated (prc_set%proc_id)) then
        proc_id = prc_set%proc_id(i)
     else
        proc_id = ""
     end if
   end function resonant_subprocess_set_get_proc_id
 
 @ %def resonant_subprocess_set_get_n_process
 @ %def resonant_subprocess_set_get_libname
 @ %def resonant_subprocess_set_get_proc_id
 @
 \subsection{Process objects and instances}
 Prepare process objects for all entries in the resonant-subprocesses
 library.  The process objects are appended to the global process
 stack.  A local environment can be used where we place temporary
 variable settings that affect process-object generation.  We
 initialize the processes, such that we can evaluate matrix elements,
 but we do not need to integrate them.
 
 The internal procedure [[prepare_process]] is an abridged version of
 the procedure with this name in the [[simulations]] module.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: prepare_process_objects &
        => resonant_subprocess_set_prepare_process_objects
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_prepare_process_objects &
        (prc_set, local, global)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     type(rt_data_t), pointer :: current
     type(process_library_t), pointer :: lib
     type(string_t) :: proc_id, libname_cur, libname_res
     integer :: i, n
     if (.not. prc_set%is_active ())  return
     if (present (global)) then
        current => global
     else
        current => local
     end if
     libname_cur = current%prclib%get_name ()
     libname_res = prc_set%get_libname ()
     lib => current%prclib_stack%get_library_ptr (libname_res)
     if (associated (lib))  call current%update_prclib (lib)
     call local%set_string (var_str ("$phs_method"), &
             var_str ("none"), is_known = .true.)
     call local%set_string (var_str ("$integration_method"), &
             var_str ("none"), is_known = .true.)
     n = prc_set%get_n_process ()
     allocate (prc_set%subprocess (n))
     do i = 1, n
        proc_id = prc_set%get_proc_id (i)
        call prepare_process (prc_set%subprocess(i)%p, proc_id)
        if (signal_is_pending ())  return
     end do
     lib => current%prclib_stack%get_library_ptr (libname_cur)
     if (associated (lib))  call current%update_prclib (lib)
   contains
     subroutine prepare_process (process, process_id)
       type(process_t), pointer, intent(out) :: process
       type(string_t), intent(in) :: process_id
       call msg_message ("Simulate: initializing resonant subprocess '" &
                // char (process_id) // "'")
       if (present (global)) then
          call integrate_process (process_id, local, global, &
               init_only = .true.)
       else
          call integrate_process (process_id, local, local_stack = .true., &
               init_only = .true.)
       end if
       process => current%process_stack%get_process_ptr (process_id)
       if (.not. associated (process)) then
          call msg_fatal ("Simulate: resonant subprocess '" &
                // char (process_id) // "' could not be initialized: aborting")
       end if
     end subroutine prepare_process
   end subroutine resonant_subprocess_set_prepare_process_objects
 
 @ %def resonant_subprocess_set_prepare_process_objects
 @ Workspace for the resonant subprocesses.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: prepare_process_instances &
        => resonant_subprocess_set_prepare_process_instances
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_prepare_process_instances (prc_set, global)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     type(rt_data_t), intent(in), target :: global
     integer :: i, n
     if (.not. prc_set%is_active ())  return
     n = size (prc_set%subprocess)
     allocate (prc_set%instance (n))
     do i = 1, n
        allocate (prc_set%instance(i)%p)
        call prc_set%instance(i)%p%init (prc_set%subprocess(i)%p)
        call prc_set%instance(i)%p%setup_event_data (global%model)
     end do
   end subroutine resonant_subprocess_set_prepare_process_instances
 
 @ %def resonant_subprocess_set_prepare_process_instances
 @
 \subsection{Event transform connection}
 The idea is that the resonance-insertion event transform has been
 allocated somewhere (namely, in the standard event-transform chain),
 but we maintain a link such that we can inject matrix-element results
 event by event.  The event transform holds a selector, to choose one
 of the resonance histories (or none), and it manages resonance
 insertion for the particle set.
 
 The data that the event transform requires can be provided here.  The
 resonance history set has already been assigned with the [[dispatch]]
 initializer.  Here, we supply the set of subprocess instances that we
 have generated (see above).  The master-process instance is set
 when we [[connect]] the transform by the standard method.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: connect_transform => &
        resonant_subprocess_set_connect_transform
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_connect_transform (prc_set, evt)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     class(evt_t), intent(in), target :: evt
     select type (evt)
     type is (evt_resonance_t)
        prc_set%evt => evt
        call prc_set%evt%set_subprocess_instances (prc_set%instance)
     class default
        call msg_bug ("Resonant subprocess set: event transform has wrong type")
     end select
   end subroutine resonant_subprocess_set_connect_transform
 
 @ %def resonant_subprocess_set_connect_transform
 @ Set the on-shell limit value in the connected transform.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: set_on_shell_limit => resonant_subprocess_set_on_shell_limit
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_on_shell_limit (prc_set, on_shell_limit)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     real(default), intent(in) :: on_shell_limit
     call prc_set%evt%set_on_shell_limit (on_shell_limit)
   end subroutine resonant_subprocess_set_on_shell_limit
 
 @ %def resonant_subprocess_set_on_shell_limit
 @ Set the Gaussian turnoff parameter in the connected transform.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: set_on_shell_turnoff => resonant_subprocess_set_on_shell_turnoff
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_on_shell_turnoff &
        (prc_set, on_shell_turnoff)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     real(default), intent(in) :: on_shell_turnoff
     call prc_set%evt%set_on_shell_turnoff (on_shell_turnoff)
   end subroutine resonant_subprocess_set_on_shell_turnoff
 
 @ %def resonant_subprocess_set_on_shell_turnoff
 @ Reweight (suppress) the background contribution probability, for the
 kinematics where a resonance history is active.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: set_background_factor &
        => resonant_subprocess_set_background_factor
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_background_factor &
        (prc_set, background_factor)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     real(default), intent(in) :: background_factor
     call prc_set%evt%set_background_factor (background_factor)
   end subroutine resonant_subprocess_set_background_factor
 
 @ %def resonant_subprocess_set_background_factor
 @
 \subsection{Wrappers for runtime calculations}
 All runtime calculations are delegated to the event transform.  The
 following procedures are essentially redundant wrappers.  We retain
 them for a unit test below.
 
 Debugging aid:
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: dump_instances => resonant_subprocess_set_dump_instances
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_dump_instances (prc_set, unit, testflag)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: i, n, u
     u = given_output_unit (unit)
     write (u, "(A)")  "*** Process instances of resonant subprocesses"
     write (u, *)
     n = size (prc_set%subprocess)
     do i = 1, n
        associate (instance => prc_set%instance(i)%p)
          call instance%write (u, testflag)
          write (u, *)
          write (u, *)
        end associate
     end do
   end subroutine resonant_subprocess_set_dump_instances
 
 @ %def resonant_subprocess_set_dump_instances
 @ Inject the current kinematics configuration, reading from the
 previous event transform or from the process instance.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: fill_momenta => resonant_subprocess_set_fill_momenta
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_fill_momenta (prc_set)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     integer :: i, n
     call prc_set%evt%fill_momenta ()
   end subroutine resonant_subprocess_set_fill_momenta
 
 @ %def resonant_subprocess_set_fill_momenta
 @ Determine the indices of the resonance histories that can be
 considered on-shell for the current kinematics.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: determine_on_shell_histories &
        => resonant_subprocess_set_determine_on_shell_histories
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_determine_on_shell_histories &
        (prc_set, i_component, index_array)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     integer, intent(in) :: i_component
     integer, dimension(:), allocatable, intent(out) :: index_array
     call prc_set%evt%determine_on_shell_histories (index_array)
   end subroutine resonant_subprocess_set_determine_on_shell_histories
 
 @ %def resonant_subprocess_set_determine_on_shell_histories
 @ Evaluate selected subprocesses.  (In actual operation, the ones that
 have been tagged as on-shell.)
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: evaluate_subprocess &
        => resonant_subprocess_set_evaluate_subprocess
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_evaluate_subprocess (prc_set, index_array)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     integer, dimension(:), intent(in) :: index_array
     call prc_set%evt%evaluate_subprocess (index_array)
   end subroutine resonant_subprocess_set_evaluate_subprocess
 
 @ %def resonant_subprocess_set_evaluate_subprocess
 @ Extract the matrix elements of the master process / the resonant
 subprocesses.  After the previous routine has been executed, they
 should be available and stored in the corresponding process instances.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: get_master_sqme &
        => resonant_subprocess_set_get_master_sqme
   procedure :: get_subprocess_sqme &
        => resonant_subprocess_set_get_subprocess_sqme
 <<Restricted subprocesses: procedures>>=
   function resonant_subprocess_set_get_master_sqme (prc_set) result (sqme)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     real(default) :: sqme
     sqme = prc_set%evt%get_master_sqme ()
   end function resonant_subprocess_set_get_master_sqme
 
   subroutine resonant_subprocess_set_get_subprocess_sqme (prc_set, sqme)
     class(resonant_subprocess_set_t), intent(in) :: prc_set
     real(default), dimension(:), intent(inout) :: sqme
     integer :: i
     call prc_set%evt%get_subprocess_sqme (sqme)
   end subroutine resonant_subprocess_set_get_subprocess_sqme
 
 @ %def resonant_subprocess_set_get_master_sqme
 @ %def resonant_subprocess_set_get_subprocess_sqme
 @ We use the calculations of resonant matrix elements to determine
 probabilities for all resonance configurations.
 <<Restricted subprocesses: resonant subprocess set: TBP>>=
   procedure :: compute_probabilities &
        => resonant_subprocess_set_compute_probabilities
 <<Restricted subprocesses: procedures>>=
   subroutine resonant_subprocess_set_compute_probabilities (prc_set, prob_array)
     class(resonant_subprocess_set_t), intent(inout) :: prc_set
     real(default), dimension(:), allocatable, intent(out) :: prob_array
     integer, dimension(:), allocatable :: index_array
     real(default) :: sqme, sqme_sum, sqme_bg
     real(default), dimension(:), allocatable :: sqme_res
     integer :: n
     n = size (prc_set%subprocess)
     allocate (prob_array (0:n), source = 0._default)
     call prc_set%evt%compute_probabilities ()
     call prc_set%evt%get_selector_weights (prob_array)
   end subroutine resonant_subprocess_set_compute_probabilities
 
 @ %def resonant_subprocess_set_compute_probabilities
 @
 \subsection{Unit tests}
 Test module, followed by the stand-alone unit-test procedures.
 <<[[restricted_subprocesses_ut.f90]]>>=
 <<File header>>
 
 module restricted_subprocesses_ut
   use unit_tests
   use restricted_subprocesses_uti
 
 <<Standard module head>>
 
 <<Restricted subprocesses: public test>>
 
 contains
 
 <<Restricted subprocesses: test driver>>
 
 end module restricted_subprocesses_ut
 @ %def restricted_subprocesses_ut
 @
 <<[[restricted_subprocesses_uti.f90]]>>=
 <<File header>>
 
 module restricted_subprocesses_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units, only: free_unit
   use format_defs, only: FMT_10, FMT_12
   use lorentz, only: vector4_t, vector3_moving, vector4_moving
   use particle_specifiers, only: new_prt_spec
   use process_libraries, only: process_library_t
   use resonances, only: resonance_info_t
   use resonances, only: resonance_history_t
   use resonances, only: resonance_history_set_t
   use sm_qcd, only: qcd_t
   use state_matrices, only: FM_IGNORE_HELICITY
   use particles, only: particle_set_t
   use model_data, only: model_data_t
   use models, only: syntax_model_file_init, syntax_model_file_final
   use models, only: model_t
   use rng_base, only: rng_factory_t
   use rng_base_ut, only: rng_test_factory_t
   use mci_base, only: mci_t
   use mci_none, only: mci_none_t
   use phs_base, only: phs_config_t
   use phs_forests, only: syntax_phs_forest_init, syntax_phs_forest_final
   use phs_wood, only: phs_wood_config_t
   use process_libraries, only: process_def_entry_t
   use process_libraries, only: process_component_def_t
   use prclib_stacks, only: prclib_entry_t
   use prc_core_def, only: prc_core_def_t
   use prc_omega, only: omega_def_t
   use process, only: process_t
   use instances, only: process_instance_t
   use process_stacks, only: process_entry_t
   use event_transforms, only: evt_trivial_t
   use resonance_insertion, only: evt_resonance_t
   use integrations, only: integrate_process
   use rt_data, only: rt_data_t
 
   use restricted_subprocesses
 
 <<Standard module head>>
 
 <<Restricted subprocesses: test declarations>>
 
 <<Restricted subprocesses: test auxiliary types>>
 
 <<Restricted subprocesses: public test auxiliary>>
 
 contains
 
 <<Restricted subprocesses: tests>>
 
 <<Restricted subprocesses: test auxiliary>>
 
 end module restricted_subprocesses_uti
 
 @ %def restricted_subprocesses_uti
 @ API: driver for the unit tests below.
 <<Restricted subprocesses: public test>>=
   public :: restricted_subprocesses_test
 <<Restricted subprocesses: test driver>>=
   subroutine restricted_subprocesses_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Restricted subprocesses: execute tests>>
   end subroutine restricted_subprocesses_test
 
 @ %def restricted_subprocesses_test
 @
 \subsubsection{subprocess configuration}
 Initialize a [[restricted_subprocess_configuration_t]] object which represents
 a given process with a defined resonance history.
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_1, "restricted_subprocesses_1", &
        "single subprocess", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_1
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_1 (u)
     integer, intent(in) :: u
     type(rt_data_t) :: global
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(string_t) :: prc_name
     type(string_t), dimension(2) :: prt_in
     type(string_t), dimension(3) :: prt_out
     type(restricted_process_configuration_t) :: prc_config
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_1"
     write (u, "(A)")  "*   Purpose: create subprocess list from resonances"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%select_model (var_str ("SM"))
 
     write (u, "(A)")  "* Create resonance history"
     write (u, "(A)")
 
     call res_info%init (3, -24, global%model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Create process configuration"
     write (u, "(A)")
 
     prc_name = "restricted_subprocesses_1_p"
     prt_in(1) = "e-"
     prt_in(2) = "e+"
     prt_out(1) = "d"
     prt_out(2) = "u"
     prt_out(3) = "W+"
 
     call prc_config%init_resonant_process (prc_name, &
          new_prt_spec (prt_in), new_prt_spec (prt_out), &
          res_history, global%model, global%var_list)
 
     call prc_config%write (u)
 
     write (u, *)
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_1"
 
   end subroutine restricted_subprocesses_1
 
 @ %def restricted_subprocesses_1
 @
 \subsubsection{Subprocess library configuration}
 Create a process library that represents restricted subprocesses for a given
 set of resonance histories
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_2, "restricted_subprocesses_2", &
        "subprocess library", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_2
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_2 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(resonance_info_t) :: res_info
     type(resonance_history_t), dimension(2) :: res_history
     type(resonance_history_set_t) :: res_history_set
     type(string_t) :: libname
     type(string_t), dimension(2) :: prt_in
     type(string_t), dimension(3) :: prt_out
     type(resonant_subprocess_set_t) :: prc_set
     type(process_library_t), pointer :: lib
     logical :: exist
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_2"
     write (u, "(A)")  "*   Purpose: create subprocess library from resonances"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%select_model (var_str ("SM"))
 
     write (u, "(A)")  "* Create resonance histories"
     write (u, "(A)")
 
     call res_info%init (3, -24, global%model, 5)
     call res_history(1)%add_resonance (res_info)
     call res_history(1)%write (u)
 
     call res_info%init (7, 23, global%model, 5)
     call res_history(2)%add_resonance (res_info)
     call res_history(2)%write (u)
 
     call res_history_set%init ()
     call res_history_set%enter (res_history(1))
     call res_history_set%enter (res_history(2))
     call res_history_set%freeze ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Empty restricted subprocess set"
     write (u, "(A)")
 
     write (u, "(A,1x,L1)")  "active =", prc_set%is_active ()
     write (u, "(A)")
 
     call prc_set%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Fill restricted subprocess set"
     write (u, "(A)")
 
     libname = "restricted_subprocesses_2_p_R"
     prt_in(1) = "e-"
     prt_in(2) = "e+"
     prt_out(1) = "d"
     prt_out(2) = "u"
     prt_out(3) = "W+"
 
     call prc_set%init (1)
     call prc_set%fill_resonances (res_history_set, 1)
     call prc_set%create_library (libname, global, exist)
     if (.not. exist) then
        call prc_set%add_to_library (1, &
             new_prt_spec (prt_in), new_prt_spec (prt_out), &
             global)
     end if
     call prc_set%freeze_library (global)
 
     write (u, "(A,1x,L1)")  "active =", prc_set%is_active ()
     write (u, "(A)")
 
     call prc_set%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Queries"
     write (u, "(A)")
 
     write (u, "(A,1x,I0)")  "n_process =", prc_set%get_n_process ()
     write (u, "(A)")
     write (u, "(A,A,A)")  "libname = '", char (prc_set%get_libname ()), "'"
     write (u, "(A)")
     write (u, "(A,A,A)")  "proc_id(1) = '", char (prc_set%get_proc_id (1)), "'"
     write (u, "(A,A,A)")  "proc_id(2) = '", char (prc_set%get_proc_id (2)), "'"
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Process library"
     write (u, "(A)")
 
     call prc_set%compile_library (global)
 
     lib => global%prclib_stack%get_library_ptr (libname)
     if (associated (lib))  call lib%write (u, libpath=.false.)
 
     write (u, *)
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_2"
 
   end subroutine restricted_subprocesses_2
 
 @ %def restricted_subprocesses_2
 @
 \subsubsection{Auxiliary: Test processes}
 Auxiliary subroutine that constructs the process library for the above test.
 This parallels a similar subroutine in [[processes_uti]], but this time we
 want an \oMega\ process.
 <<Restricted subprocesses: public test auxiliary>>=
   public :: prepare_resonance_test_library
 <<Restricted subprocesses: test auxiliary>>=
   subroutine prepare_resonance_test_library &
        (lib, libname, procname, model, global, u)
     type(process_library_t), target, intent(out) :: lib
     type(string_t), intent(in) :: libname
     type(string_t), intent(in) :: procname
     class(model_data_t), intent(in), pointer :: model
     type(rt_data_t), intent(in), target :: global
     integer, intent(in) :: u
     type(string_t), dimension(:), allocatable :: prt_in, prt_out
     class(prc_core_def_t), allocatable :: def
     type(process_def_entry_t), pointer :: entry
 
     call lib%init (libname)
 
     allocate (prt_in (2), prt_out (3))
     prt_in = [var_str ("e+"), var_str ("e-")]
     prt_out = [var_str ("d"), var_str ("ubar"), var_str ("W+")]
 
     allocate (omega_def_t :: def)
     select type (def)
     type is (omega_def_t)
        call def%init (model%get_name (), prt_in, prt_out, &
             ovm=.false., ufo=.false.)
     end select
     allocate (entry)
     call entry%init (procname, &
          model_name = model%get_name (), &
          n_in = 2, n_components = 1, &
          requires_resonances = .true.)
     call entry%import_component (1, n_out = size (prt_out), &
          prt_in  = new_prt_spec (prt_in), &
          prt_out = new_prt_spec (prt_out), &
          method  = var_str ("omega"), &
          variant = def)
     call entry%write (u)
 
     call lib%append (entry)
 
     call lib%configure (global%os_data)
     call lib%write_makefile (global%os_data, force = .true., verbose = .false.)
     call lib%clean (global%os_data, distclean = .false.)
     call lib%write_driver (force = .true.)
     call lib%load (global%os_data)
 
   end subroutine prepare_resonance_test_library
 
 @ %def prepare_resonance_test_library
 @
 \subsubsection{Kinematics and resonance selection}
 Prepare an actual process with resonant subprocesses.  Insert
 kinematics and apply the resonance selector in an associated event
 transform.
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_3, "restricted_subprocesses_3", &
        "resonance kinematics and probability", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_3
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_3 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(string_t) :: libname, libname_res
     type(string_t) :: procname
     type(process_component_def_t), pointer :: process_component_def
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     logical :: exist
     type(process_t), pointer :: process
     type(process_instance_t), target :: process_instance
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(resonant_subprocess_set_t) :: prc_set
     type(particle_set_t) :: pset
     real(default) :: sqrts, mw, pp
     real(default), dimension(3) :: p3
     type(vector4_t), dimension(:), allocatable :: p
     real(default), dimension(:), allocatable :: m
     integer, dimension(:), allocatable :: pdg
     real(default), dimension(:), allocatable :: sqme
     logical, dimension(:), allocatable :: mask
     real(default) :: on_shell_limit
     integer, dimension(:), allocatable :: i_array
     real(default), dimension(:), allocatable :: prob_array
     type(evt_resonance_t), target :: evt_resonance
     integer :: i, u_dump
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_3"
     write (u, "(A)")  "*   Purpose: handle process and resonance kinematics"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
 
     call global%select_model (var_str ("SM"))
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     libname = "restricted_subprocesses_3_lib"
     libname_res = "restricted_subprocesses_3_lib_res"
     procname = "restricted_subprocesses_3_p"
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     call integrate_process (procname, global, &
          local_stack = .true., init_only = .true.)
 
     process => global%process_stack%get_process_ptr (procname)
 
     call process_instance%init (process)
     call process_instance%setup_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract resonance history set"
     write (u, "(A)")
 
     call process%extract_resonance_history_set &
          (res_history_set(1), include_trivial=.true., i_component=1)
     call res_history_set(1)%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build resonant-subprocess library"
     write (u, "(A)")
 
     call prc_set%init (1)
     call prc_set%fill_resonances (res_history_set(1), 1)
 
     process_component_def => process%get_component_def_ptr (1)
     call prc_set%create_library (libname_res, global, exist)
     if (.not. exist) then
        call prc_set%add_to_library (1, &
             process_component_def%get_prt_spec_in (), &
             process_component_def%get_prt_spec_out (), &
             global)
     end if
     call prc_set%freeze_library (global)
     call prc_set%compile_library (global)
     call prc_set%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build particle set"
     write (u, "(A)")
 
     sqrts = global%get_rval (var_str ("sqrts"))
     mw = 80._default   ! deliberately slightly different from true mw
     pp = sqrt (sqrts**2 - 4 * mw**2) / 2
 
     allocate (pdg (5), p (5), m (5))
     pdg(1) = -11
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     m(1) = 0
     pdg(2) = 11
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     m(2) = 0
     pdg(3) = 1
     p3(1) = pp/2
     p3(2) = mw/2
     p3(3) = 0
     p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(3) = 0
     p3(2) = -mw/2
     pdg(4) = -2
     p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(4) = 0
     pdg(5) = 24
     p(5) = vector4_moving (sqrts/2,-pp, 1)
     m(5) = mw
 
     call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
     call pset%set_momentum (p, m**2)
     call pset%write (u, testflag=.true.)
 
      write (u, "(A)")
      write (u, "(A)")  "* Fill process instance"
 
     ! workflow from event_recalculate
     call process_instance%choose_mci (1)
     call process_instance%set_trace (pset, 1)
     call process_instance%recover &
          (1, 1, update_sqme=.true., recover_phs=.false.)
     call process_instance%evaluate_event_data (weight = 1._default)
 
     write (u, "(A)")
     write (u, "(A)")  "* Prepare resonant subprocesses"
 
     call prc_set%prepare_process_objects (global)
     call prc_set%prepare_process_instances (global)
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call prc_set%connect_transform (evt_resonance)
     call evt_resonance%connect (process_instance, model)
 
     call prc_set%fill_momenta ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Show squared matrix element of master process,"
     write (u, "(A)")  "  should coincide with 2nd subprocess sqme"
     write (u, "(A)")
 
     write (u, "(1x,I0,1x," // FMT_12 // ")")  0, prc_set%get_master_sqme ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute squared matrix elements &
          &of selected resonant subprocesses [1,2]"
     write (u, "(A)")
 
     call prc_set%evaluate_subprocess ([1,2])
 
     allocate (sqme (3), source = 0._default)
     call prc_set%get_subprocess_sqme (sqme)
     do i = 1, size (sqme)
        write (u, "(1x,I0,1x," // FMT_12 // ")")  i, sqme(i)
     end do
     deallocate (sqme)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute squared matrix elements &
          &of all resonant subprocesses"
     write (u, "(A)")
 
     call prc_set%evaluate_subprocess ([1,2,3])
 
     allocate (sqme (3), source = 0._default)
     call prc_set%get_subprocess_sqme (sqme)
     do i = 1, size (sqme)
        write (u, "(1x,I0,1x," // FMT_12 // ")")  i, sqme(i)
     end do
     deallocate (sqme)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write process instances to file &
          &restricted_subprocesses_3_lib_res.dat"
 
     u_dump = free_unit ()
     open (unit = u_dump, file = "restricted_subprocesses_3_lib_res.dat", &
          action = "write", status = "replace")
     call prc_set%dump_instances (u_dump)
     close (u_dump)
 
     write (u, "(A)")
     write (u, "(A)")  "* Determine on-shell resonant subprocesses"
     write (u, "(A)")
 
     on_shell_limit = 0
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     write (u, "(1x,A,9(1x,I0))")  "resonant =", i_array
 
     on_shell_limit = 0.1_default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     write (u, "(1x,A,9(1x,I0))")  "resonant =", i_array
 
     on_shell_limit = 10._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     write (u, "(1x,A,9(1x,I0))")  "resonant =", i_array
 
     on_shell_limit = 10000._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     write (u, "(1x,A,9(1x,I0))")  "resonant =", i_array
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute probabilities for applicable resonances"
     write (u, "(A)")  "  and initialize the process selector"
     write (u, "(A)")  "  (The first number is the probability for background)"
     write (u, "(A)")
 
     on_shell_limit = 0
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     call prc_set%compute_probabilities (prob_array)
     write (u, "(1x,A,9(1x,"// FMT_12 // "))")  "resonant =", prob_array
     call prc_set%write (u, testflag=.true.)
     write (u, *)
 
     on_shell_limit = 10._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     call prc_set%compute_probabilities (prob_array)
     write (u, "(1x,A,9(1x,"// FMT_12 // "))")  "resonant =", prob_array
     call prc_set%write (u, testflag=.true.)
     write (u, *)
 
     on_shell_limit = 10000._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call prc_set%set_on_shell_limit (on_shell_limit)
     call prc_set%determine_on_shell_histories (1, i_array)
     call prc_set%compute_probabilities (prob_array)
     write (u, "(1x,A,9(1x,"// FMT_12 // "))")  "resonant =", prob_array
     write (u, *)
     call prc_set%write (u, testflag=.true.)
     write (u, *)
 
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_3"
 
   end subroutine restricted_subprocesses_3
 
 @ %def restricted_subprocesses_3
 @
 \subsubsection{Event transform}
 Prepare an actual process with resonant subprocesses.  Prepare the
 resonance selector for a fixed event and apply the resonance-insertion
 event transform.
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_4, "restricted_subprocesses_4", &
        "event transform", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_4
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_4 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(string_t) :: libname, libname_res
     type(string_t) :: procname
     type(process_component_def_t), pointer :: process_component_def
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     logical :: exist
     type(process_t), pointer :: process
     type(process_instance_t), target :: process_instance
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(resonant_subprocess_set_t) :: prc_set
     type(particle_set_t) :: pset
     real(default) :: sqrts, mw, pp
     real(default), dimension(3) :: p3
     type(vector4_t), dimension(:), allocatable :: p
     real(default), dimension(:), allocatable :: m
     integer, dimension(:), allocatable :: pdg
     real(default) :: on_shell_limit
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     real(default) :: probability
     integer :: i
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_4"
     write (u, "(A)")  "*   Purpose: employ event transform"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
 
     call global%select_model (var_str ("SM"))
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     libname = "restricted_subprocesses_4_lib"
     libname_res = "restricted_subprocesses_4_lib_res"
     procname = "restricted_subprocesses_4_p"
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     call integrate_process (procname, global, &
          local_stack = .true., init_only = .true.)
 
     process => global%process_stack%get_process_ptr (procname)
 
     call process_instance%init (process)
     call process_instance%setup_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract resonance history set"
 
     call process%extract_resonance_history_set &
          (res_history_set(1), include_trivial=.false., i_component=1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build resonant-subprocess library"
 
     call prc_set%init (1)
     call prc_set%fill_resonances (res_history_set(1), 1)
 
     process_component_def => process%get_component_def_ptr (1)
     call prc_set%create_library (libname_res, global, exist)
     if (.not. exist) then
        call prc_set%add_to_library (1, &
             process_component_def%get_prt_spec_in (), &
             process_component_def%get_prt_spec_out (), &
             global)
     end if
     call prc_set%freeze_library (global)
     call prc_set%compile_library (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build particle set"
     write (u, "(A)")
 
     sqrts = global%get_rval (var_str ("sqrts"))
     mw = 80._default   ! deliberately slightly different from true mw
     pp = sqrt (sqrts**2 - 4 * mw**2) / 2
 
     allocate (pdg (5), p (5), m (5))
     pdg(1) = -11
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     m(1) = 0
     pdg(2) = 11
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     m(2) = 0
     pdg(3) = 1
     p3(1) = pp/2
     p3(2) = mw/2
     p3(3) = 0
     p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(3) = 0
     p3(2) = -mw/2
     pdg(4) = -2
     p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(4) = 0
     pdg(5) = 24
     p(5) = vector4_moving (sqrts/2,-pp, 1)
     m(5) = mw
 
     call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
     call pset%set_momentum (p, m**2)
 
     write (u, "(A)")  "* Fill process instance"
     write (u, "(A)")
 
     ! workflow from event_recalculate
     call process_instance%choose_mci (1)
     call process_instance%set_trace (pset, 1)
     call process_instance%recover &
          (1, 1, update_sqme=.true., recover_phs=.false.)
     call process_instance%evaluate_event_data (weight = 1._default)
 
     write (u, "(A)")  "* Prepare resonant subprocesses"
     write (u, "(A)")
 
     call prc_set%prepare_process_objects (global)
     call prc_set%prepare_process_instances (global)
 
     write (u, "(A)")  "* Fill trivial event transform (deliberately w/o color)"
     write (u, "(A)")
 
     call evt_trivial%connect (process_instance, model)
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize resonance-insertion event transform"
     write (u, "(A)")
 
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call evt_resonance%connect (process_instance, model)
     call prc_set%connect_transform (evt_resonance)
     call evt_resonance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute probabilities for applicable resonances"
     write (u, "(A)")  "  and initialize the process selector"
     write (u, "(A)")
 
     on_shell_limit = 10._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit =", on_shell_limit
     call evt_resonance%set_on_shell_limit (on_shell_limit)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate resonance-insertion event transform"
     write (u, "(A)")
 
     call evt_resonance%prepare_new_event (1, 1)
     call evt_resonance%generate_weighted (probability)
     call evt_resonance%make_particle_set (1, .false.)
 
     call evt_resonance%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_4"
 
   end subroutine restricted_subprocesses_4
 
 @ %def restricted_subprocesses_4
 @
 \subsubsection{Gaussian turnoff}
 Identical to the previous process, except that we apply a Gaussian
 turnoff to the resonance kinematics, which affects the subprocess selector.
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_5, "restricted_subprocesses_5", &
        "event transform with gaussian turnoff", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_5
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_5 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(string_t) :: libname, libname_res
     type(string_t) :: procname
     type(process_component_def_t), pointer :: process_component_def
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     logical :: exist
     type(process_t), pointer :: process
     type(process_instance_t), target :: process_instance
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(resonant_subprocess_set_t) :: prc_set
     type(particle_set_t) :: pset
     real(default) :: sqrts, mw, pp
     real(default), dimension(3) :: p3
     type(vector4_t), dimension(:), allocatable :: p
     real(default), dimension(:), allocatable :: m
     integer, dimension(:), allocatable :: pdg
     real(default) :: on_shell_limit
     real(default) :: on_shell_turnoff
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     real(default) :: probability
     integer :: i
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_5"
     write (u, "(A)")  "*   Purpose: employ event transform &
          &with gaussian turnoff"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
 
     call global%select_model (var_str ("SM"))
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     libname = "restricted_subprocesses_5_lib"
     libname_res = "restricted_subprocesses_5_lib_res"
     procname = "restricted_subprocesses_5_p"
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     call integrate_process (procname, global, &
          local_stack = .true., init_only = .true.)
 
     process => global%process_stack%get_process_ptr (procname)
 
     call process_instance%init (process)
     call process_instance%setup_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract resonance history set"
 
     call process%extract_resonance_history_set &
          (res_history_set(1), include_trivial=.false., i_component=1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build resonant-subprocess library"
 
     call prc_set%init (1)
     call prc_set%fill_resonances (res_history_set(1), 1)
 
     process_component_def => process%get_component_def_ptr (1)
     call prc_set%create_library (libname_res, global, exist)
     if (.not. exist) then
        call prc_set%add_to_library (1, &
             process_component_def%get_prt_spec_in (), &
             process_component_def%get_prt_spec_out (), &
             global)
     end if
     call prc_set%freeze_library (global)
     call prc_set%compile_library (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build particle set"
     write (u, "(A)")
 
     sqrts = global%get_rval (var_str ("sqrts"))
     mw = 80._default   ! deliberately slightly different from true mw
     pp = sqrt (sqrts**2 - 4 * mw**2) / 2
 
     allocate (pdg (5), p (5), m (5))
     pdg(1) = -11
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     m(1) = 0
     pdg(2) = 11
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     m(2) = 0
     pdg(3) = 1
     p3(1) = pp/2
     p3(2) = mw/2
     p3(3) = 0
     p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(3) = 0
     p3(2) = -mw/2
     pdg(4) = -2
     p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(4) = 0
     pdg(5) = 24
     p(5) = vector4_moving (sqrts/2,-pp, 1)
     m(5) = mw
 
     call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
     call pset%set_momentum (p, m**2)
 
     write (u, "(A)")  "* Fill process instance"
     write (u, "(A)")
 
     ! workflow from event_recalculate
     call process_instance%choose_mci (1)
     call process_instance%set_trace (pset, 1)
     call process_instance%recover &
          (1, 1, update_sqme=.true., recover_phs=.false.)
     call process_instance%evaluate_event_data (weight = 1._default)
 
     write (u, "(A)")  "* Prepare resonant subprocesses"
     write (u, "(A)")
 
     call prc_set%prepare_process_objects (global)
     call prc_set%prepare_process_instances (global)
 
     write (u, "(A)")  "* Fill trivial event transform (deliberately w/o color)"
     write (u, "(A)")
 
     call evt_trivial%connect (process_instance, model)
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize resonance-insertion event transform"
     write (u, "(A)")
 
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call evt_resonance%connect (process_instance, model)
     call prc_set%connect_transform (evt_resonance)
     call evt_resonance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute probabilities for applicable resonances"
     write (u, "(A)")  "  and initialize the process selector"
     write (u, "(A)")
 
     on_shell_limit = 10._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_limit   =", &
          on_shell_limit
     call evt_resonance%set_on_shell_limit (on_shell_limit)
 
     on_shell_turnoff = 1._default
     write (u, "(1x,A,1x," // FMT_10 // ")")  "on_shell_turnoff =", &
          on_shell_turnoff
     call evt_resonance%set_on_shell_turnoff (on_shell_turnoff)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate resonance-insertion event transform"
     write (u, "(A)")
 
     call evt_resonance%prepare_new_event (1, 1)
     call evt_resonance%generate_weighted (probability)
     call evt_resonance%make_particle_set (1, .false.)
 
     call evt_resonance%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_5"
 
   end subroutine restricted_subprocesses_5
 
 @ %def restricted_subprocesses_5
 @
 \subsubsection{Event transform}
 The same process and event again.  This time, switch off the background
 contribution, so the selector becomes trivial.
 <<Restricted subprocesses: execute tests>>=
   call test (restricted_subprocesses_6, "restricted_subprocesses_6", &
        "event transform with background switched off", &
        u, results)
 <<Restricted subprocesses: test declarations>>=
   public :: restricted_subprocesses_6
 <<Restricted subprocesses: tests>>=
   subroutine restricted_subprocesses_6 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(string_t) :: libname, libname_res
     type(string_t) :: procname
     type(process_component_def_t), pointer :: process_component_def
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     logical :: exist
     type(process_t), pointer :: process
     type(process_instance_t), target :: process_instance
     type(resonance_history_set_t), dimension(1) :: res_history_set
     type(resonant_subprocess_set_t) :: prc_set
     type(particle_set_t) :: pset
     real(default) :: sqrts, mw, pp
     real(default), dimension(3) :: p3
     type(vector4_t), dimension(:), allocatable :: p
     real(default), dimension(:), allocatable :: m
     integer, dimension(:), allocatable :: pdg
     real(default) :: on_shell_limit
     real(default) :: background_factor
     type(evt_trivial_t), target :: evt_trivial
     type(evt_resonance_t), target :: evt_resonance
     real(default) :: probability
     integer :: i
 
     write (u, "(A)")  "* Test output: restricted_subprocesses_6"
     write (u, "(A)")  "*   Purpose: employ event transform &
          &with background switched off"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
 
     call global%select_model (var_str ("SM"))
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     libname = "restricted_subprocesses_6_lib"
     libname_res = "restricted_subprocesses_6_lib_res"
     procname = "restricted_subprocesses_6_p"
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     call integrate_process (procname, global, &
          local_stack = .true., init_only = .true.)
 
     process => global%process_stack%get_process_ptr (procname)
 
     call process_instance%init (process)
     call process_instance%setup_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract resonance history set"
 
     call process%extract_resonance_history_set &
          (res_history_set(1), include_trivial=.false., i_component=1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build resonant-subprocess library"
 
     call prc_set%init (1)
     call prc_set%fill_resonances (res_history_set(1), 1)
 
     process_component_def => process%get_component_def_ptr (1)
     call prc_set%create_library (libname_res, global, exist)
     if (.not. exist) then
        call prc_set%add_to_library (1, &
             process_component_def%get_prt_spec_in (), &
             process_component_def%get_prt_spec_out (), &
             global)
     end if
     call prc_set%freeze_library (global)
     call prc_set%compile_library (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build particle set"
     write (u, "(A)")
 
     sqrts = global%get_rval (var_str ("sqrts"))
     mw = 80._default   ! deliberately slightly different from true mw
     pp = sqrt (sqrts**2 - 4 * mw**2) / 2
 
     allocate (pdg (5), p (5), m (5))
     pdg(1) = -11
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     m(1) = 0
     pdg(2) = 11
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     m(2) = 0
     pdg(3) = 1
     p3(1) = pp/2
     p3(2) = mw/2
     p3(3) = 0
     p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(3) = 0
     p3(2) = -mw/2
     pdg(4) = -2
     p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(4) = 0
     pdg(5) = 24
     p(5) = vector4_moving (sqrts/2,-pp, 1)
     m(5) = mw
 
     call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
     call pset%set_momentum (p, m**2)
 
     write (u, "(A)")  "* Fill process instance"
     write (u, "(A)")
 
     ! workflow from event_recalculate
     call process_instance%choose_mci (1)
     call process_instance%set_trace (pset, 1)
     call process_instance%recover &
          (1, 1, update_sqme=.true., recover_phs=.false.)
     call process_instance%evaluate_event_data (weight = 1._default)
 
     write (u, "(A)")  "* Prepare resonant subprocesses"
     write (u, "(A)")
 
     call prc_set%prepare_process_objects (global)
     call prc_set%prepare_process_instances (global)
 
     write (u, "(A)")  "* Fill trivial event transform (deliberately w/o color)"
     write (u, "(A)")
 
     call evt_trivial%connect (process_instance, model)
     call evt_trivial%set_particle_set (pset, 1, 1)
     call evt_trivial%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize resonance-insertion event transform"
     write (u, "(A)")
 
     evt_trivial%next => evt_resonance
     evt_resonance%previous => evt_trivial
 
     call evt_resonance%set_resonance_data (res_history_set)
     call evt_resonance%select_component (1)
     call evt_resonance%connect (process_instance, model)
     call prc_set%connect_transform (evt_resonance)
     call evt_resonance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute probabilities for applicable resonances"
     write (u, "(A)")  "  and initialize the process selector"
     write (u, "(A)")
 
     on_shell_limit = 10._default
     write (u, "(1x,A,1x," // FMT_10 // ")") &
          "on_shell_limit    =", on_shell_limit
     call evt_resonance%set_on_shell_limit (on_shell_limit)
 
     background_factor = 0
     write (u, "(1x,A,1x," // FMT_10 // ")") &
          "background_factor =", background_factor
     call evt_resonance%set_background_factor (background_factor)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate resonance-insertion event transform"
     write (u, "(A)")
 
     call evt_resonance%prepare_new_event (1, 1)
     call evt_resonance%generate_weighted (probability)
     call evt_resonance%make_particle_set (1, .false.)
 
     call evt_resonance%write (u, testflag=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
     call syntax_phs_forest_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: restricted_subprocesses_6"
 
   end subroutine restricted_subprocesses_6
 
 @ %def restricted_subprocesses_6
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Simulation}
 This module manages simulation: event generation and reading/writing of event
 files.  The [[simulation]] object is intended to be used (via a pointer)
 outside of \whizard, if events are generated individually by an external
 driver.
 <<[[simulations.f90]]>>=
 <<File header>>
 
 module simulations
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_utils, only: write_separator
   use format_defs, only: FMT_15, FMT_19
   use os_interface
   use numeric_utils
   use string_utils, only: str
   use diagnostics
   use lorentz, only: vector4_t
   use sm_qcd
   use md5
   use variables, only: var_list_t
   use eval_trees
   use model_data
   use flavors
   use particles
   use state_matrices, only: FM_IGNORE_HELICITY
   use beam_structures, only: beam_structure_t
   use beams
   use rng_base
   use rng_stream, only: rng_stream_t
   use selectors
   use resonances, only: resonance_history_set_t
   use process_libraries, only: process_library_t
   use process_libraries, only: process_component_def_t
   use prc_core
   !  TODO: (bcn 2016-09-13) should be ideally only pcm_base
   use pcm, only: pcm_nlo_t, pcm_instance_nlo_t
   !  TODO: (bcn 2016-09-13) details of process config should not be necessary here
   use process_config, only: COMP_REAL_FIN
   use process
   use instances
   use event_base
   use events
   use event_transforms
   use shower
   use eio_data
   use eio_base
   use rt_data
 
   use dispatch_beams, only: dispatch_qcd
   use dispatch_rng, only: dispatch_rng_factory
   use dispatch_me_methods, only: dispatch_core_update, dispatch_core_restore
   use dispatch_transforms, only: dispatch_evt_isr_epa_handler
   use dispatch_transforms, only: dispatch_evt_resonance
   use dispatch_transforms, only: dispatch_evt_decay
   use dispatch_transforms, only: dispatch_evt_shower
   use dispatch_transforms, only: dispatch_evt_hadrons
   use dispatch_transforms, only: dispatch_evt_nlo
 
   use integrations
   use event_streams
   use restricted_subprocesses, only: resonant_subprocess_set_t
   use restricted_subprocesses, only: get_libname_res
 
   use evt_nlo
 
 <<Use mpi f08>>
 
 <<Standard module head>>
 
 <<Simulations: public>>
 
 <<Simulations: types>>
 
 <<Simulations: interfaces>>
 
 contains
 
 <<Simulations: procedures>>
 
 end module simulations
 @ %def simulations
 @
 \subsection{Event counting}
 In this object we collect statistical information about an event
 sample or sub-sample.
 <<Simulations: types>>=
   type :: counter_t
      integer :: total = 0
      integer :: generated = 0
      integer :: read = 0
      integer :: positive = 0
      integer :: negative = 0
      integer :: zero = 0
      integer :: excess = 0
      real(default) :: max_excess = 0
      real(default) :: sum_excess = 0
      logical :: reproduce_xsection = .false.
      real(default) :: mean = 0
      real(default) :: varsq = 0
      integer :: nlo_weight_counter = 0
    contains
    <<Simulations: counter: TBP>>
   end type counter_t
 
 @ %def simulation_counter_t
 @ Output.
 <<Simulations: counter: TBP>>=
   procedure :: write => counter_write
 <<Simulations: procedures>>=
   subroutine counter_write (counter, unit)
     class(counter_t), intent(in) :: counter
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
 1   format (3x,A,I0)
 2   format (5x,A,I0)
 3   format (5x,A,ES19.12)
     write (u, 1)  "Events total      = ", counter%total
     write (u, 2)  "generated       = ", counter%generated
     write (u, 2)  "read            = ", counter%read
     write (u, 2)  "positive weight = ", counter%positive
     write (u, 2)  "negative weight = ", counter%negative
     write (u, 2)  "zero weight     = ", counter%zero
     write (u, 2)  "excess weight   = ", counter%excess
     if (counter%excess /= 0) then
        write (u, 3)  "max excess      = ", counter%max_excess
        write (u, 3)  "avg excess      = ", counter%sum_excess / counter%total
     end if
   end subroutine counter_write
 
 @ %def counter_write
 @ This is a screen message: if there was an excess, display statistics.
 <<Simulations: counter: TBP>>=
   procedure :: show_excess => counter_show_excess
 <<Simulations: procedures>>=
   subroutine counter_show_excess (counter)
     class(counter_t), intent(in) :: counter
     if (counter%excess > 0) then
        write (msg_buffer, "(A,1x,I0,1x,A,1x,'(',F7.3,' %)')") &
             "Encountered events with excess weight:", counter%excess, &
             "events", 100 * counter%excess / real (counter%total)
        call msg_warning ()
        write (msg_buffer, "(A,ES10.3)") &
             "Maximum excess weight =", counter%max_excess
        call msg_message ()
        write (msg_buffer, "(A,ES10.3)") &
             "Average excess weight =", counter%sum_excess / counter%total
        call msg_message ()
     end if
   end subroutine counter_show_excess
 
 @ %def counter_show_excess
 @
 <<Simulations: counter: TBP>>=
   procedure :: show_mean_and_variance => counter_show_mean_and_variance
 <<Simulations: procedures>>=
   subroutine counter_show_mean_and_variance (counter)
     class(counter_t), intent(in) :: counter
     if (counter%reproduce_xsection .and. counter%nlo_weight_counter > 1) then
        print *,  "Reconstructed cross-section from event weights: "
        print *,  counter%mean, '+-', sqrt (counter%varsq / (counter%nlo_weight_counter - 1))
     end if
   end subroutine counter_show_mean_and_variance
 
 @ %def counter_show_mean_and_variance
 @ Count an event.  The weight and event source are optional; by
 default we assume that the event has been generated and has positive
 weight.
 <<Simulations: counter: TBP>>=
   procedure :: record => counter_record
 <<Simulations: procedures>>=
   subroutine counter_record (counter, weight, excess, from_file)
     class(counter_t), intent(inout) :: counter
     real(default), intent(in), optional :: weight, excess
     logical, intent(in), optional :: from_file
     counter%total = counter%total + 1
     if (present (from_file)) then
        if (from_file) then
           counter%read = counter%read + 1
        else
           counter%generated = counter%generated + 1
        end if
     else
        counter%generated = counter%generated + 1
     end if
     if (present (weight)) then
        if (weight > 0) then
           counter%positive = counter%positive + 1
        else if (weight < 0) then
           counter%negative = counter%negative + 1
        else
           counter%zero = counter%zero + 1
        end if
     else
        counter%positive = counter%positive + 1
     end if
     if (present (excess)) then
        if (excess > 0) then
           counter%excess = counter%excess + 1
           counter%max_excess = max (counter%max_excess, excess)
           counter%sum_excess = counter%sum_excess + excess
        end if
     end if
   end subroutine counter_record
 
 @ %def counter_record
 @
 <<Simulations: counter: TBP>>=
   procedure :: record_mean_and_variance => &
      counter_record_mean_and_variance
 <<Simulations: procedures>>=
   subroutine counter_record_mean_and_variance (counter, weight, i_nlo)
     class(counter_t), intent(inout) :: counter
     real(default), intent(in) :: weight
     integer, intent(in) :: i_nlo
     real(default), save :: weight_buffer = 0._default
     integer, save :: nlo_count = 1
     if (.not. counter%reproduce_xsection) return
     if (i_nlo == 1) then
        call flush_weight_buffer (weight_buffer, nlo_count)
        weight_buffer = weight
        nlo_count = 1
     else
        weight_buffer = weight_buffer + weight
        nlo_count = nlo_count + 1
     end if
   contains
     subroutine flush_weight_buffer (w, n_nlo)
       real(default), intent(in) :: w
       integer, intent(in) :: n_nlo
       integer :: n
       real(default) :: mean_new
       counter%nlo_weight_counter = counter%nlo_weight_counter + 1
       !!! Minus 1 to take into account offset from initialization
       n = counter%nlo_weight_counter - 1
       if (n > 0) then
          mean_new = counter%mean + (w / n_nlo - counter%mean) / n
          if (n > 1) &
             counter%varsq = counter%varsq - counter%varsq / (n - 1) + &
                n * (mean_new - counter%mean)**2
          counter%mean = mean_new
       end if
     end subroutine flush_weight_buffer
   end subroutine counter_record_mean_and_variance
 
 @ %def counter_record_mean_and_variance
 @
 \subsection{Simulation: component sets}
 For each set of process components that share a MCI entry in the
 process configuration, we keep a separate event record.
 <<Simulations: types>>=
   type :: mci_set_t
      private
      integer :: n_components = 0
      integer, dimension(:), allocatable :: i_component
      type(string_t), dimension(:), allocatable :: component_id
      logical :: has_integral = .false.
      real(default) :: integral = 0
      real(default) :: error = 0
      real(default) :: weight_mci = 0
      type(counter_t) :: counter
    contains
    <<Simulations: mci set: TBP>>
   end type mci_set_t
 
 @ %def mci_set_t
 @ Output.
 <<Simulations: mci set: TBP>>=
   procedure :: write => mci_set_write
 <<Simulations: procedures>>=
   subroutine mci_set_write (object, unit, pacified)
     class(mci_set_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacified
     logical :: pacify
     integer :: u, i
     u = given_output_unit (unit)
     pacify = .false.;  if (present (pacified))  pacify = pacified
     write (u, "(3x,A)")  "Components:"
     do i = 1, object%n_components
        write (u, "(5x,I0,A,A,A)")  object%i_component(i), &
             ": '", char (object%component_id(i)), "'"
     end do
     if (object%has_integral) then
        if (pacify) then
           write (u, "(3x,A," // FMT_15 // ")")  "Integral  = ", object%integral
           write (u, "(3x,A," // FMT_15 // ")")  "Error     = ", object%error
           write (u, "(3x,A,F9.6)")  "Weight    =", object%weight_mci
        else
           write (u, "(3x,A," // FMT_19 // ")")  "Integral  = ", object%integral
           write (u, "(3x,A," // FMT_19 // ")")  "Error     = ", object%error
           write (u, "(3x,A,F13.10)")  "Weight    =", object%weight_mci
        end if
     else
        write (u, "(3x,A)")  "Integral  = [undefined]"
     end if
     call object%counter%write (u)
   end subroutine mci_set_write
 
 @ %def mci_set_write
 @ Initialize: Get the indices and names for the process components
 that will contribute to this set.
 <<Simulations: mci set: TBP>>=
   procedure :: init => mci_set_init
 <<Simulations: procedures>>=
   subroutine mci_set_init (object, i_mci, process)
     class(mci_set_t), intent(out) :: object
     integer, intent(in) :: i_mci
     type(process_t), intent(in), target :: process
     integer :: i
     call process%get_i_component (i_mci, object%i_component)
     object%n_components = size (object%i_component)
     allocate (object%component_id (object%n_components))
     do i = 1, size (object%component_id)
        object%component_id(i) = &
             process%get_component_id (object%i_component(i))
     end do
     if (process%has_integral (i_mci)) then
        object%integral = process%get_integral (i_mci)
        object%error = process%get_error (i_mci)
        object%has_integral = .true.
     end if
   end subroutine mci_set_init
 
 @ %def mci_set_init
 @
 \subsection{Process-core Safe}
 This is an object that temporarily holds a process core object.  We
 need this while rescanning a process with modified parameters.  After
 the rescan, we want to restore the original state.
 <<Simulations: types>>=
   type :: core_safe_t
      class(prc_core_t), allocatable :: core
   end type core_safe_t
 
 @ %def core_safe_t
 @
 \subsection{Process Object}
 The simulation works on process objects.  This subroutine makes a
 process object available for simulation.  The process is in the
 process stack.  [[use_process]] implies that the process should
 already exist as an object in the process stack.  If integration is
 not yet done, do it.  Any generated process object should be put on
 the global stack, if it is separate from the local one.
 <<Simulations: procedures>>=
   subroutine prepare_process &
        (process, process_id, use_process, integrate, local, global)
     type(process_t), pointer, intent(out) :: process
     type(string_t), intent(in) :: process_id
     logical, intent(in) :: use_process, integrate
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     type(rt_data_t), pointer :: current
     call msg_debug (D_CORE, "prepare_process")
     call msg_debug (D_CORE, "global present", present (global))
     if (present (global)) then
        current => global
     else
        current => local
     end if
     process => current%process_stack%get_process_ptr (process_id)
     call msg_debug (D_CORE, "use_process", use_process)
     call msg_debug (D_CORE, "associated process", associated (process))
     if (use_process .and. .not. associated (process)) then
        if (integrate) then
           call msg_message ("Simulate: process '" &
                // char (process_id) // "' needs integration")
        else
           call msg_message ("Simulate: process '" &
                // char (process_id) // "' needs initialization")
        end if
        if (present (global)) then
           call integrate_process (process_id, local, global, &
             init_only = .not. integrate)
        else
           call integrate_process (process_id, local, &
                local_stack = .true., init_only = .not. integrate)
        end if
        if (signal_is_pending ())  return
        process => current%process_stack%get_process_ptr (process_id)
        if (associated (process)) then
           if (integrate) then
              call msg_message ("Simulate: integration done")
              call current%process_stack%fill_result_vars (process_id)
           else
              call msg_message ("Simulate: process initialization done")
           end if
        else
           call msg_fatal ("Simulate: process '" &
                // char (process_id) // "' could not be initialized: aborting")
        end if
     else if (.not. associated (process)) then
        if (present (global)) then
           call integrate_process (process_id, local, global, &
                init_only = .true.)
        else
           call integrate_process (process_id, local, &
                local_stack = .true., init_only = .true.)
        end if
        process => current%process_stack%get_process_ptr (process_id)
        call msg_message &
             ("Simulate: process '" &
                // char (process_id) // "': enabled for rescan only")
     end if
   end subroutine prepare_process
 
 @ %def prepare_process
 @
 \subsection{Simulation entry}
 For each process that we consider for event generation, we need a
 separate entry.  The entry separately records the process ID and run ID.  The
 [[weight_mci]] array is used for selecting a component set (which
 shares a MCI record inside the process container) when generating an
 event for the current process.
 
 The simulation entry is an extension of the [[event_t]] event record.
 This core object contains configuration data, pointers to the process
 and process instance, the expressions, flags and values that are
 evaluated at runtime, and the resulting particle set.
 
 The entry explicitly allocate the [[process_instance]], which becomes
 the process-specific workspace for the event record.
 
 If entries with differing environments are present simultaneously, we
 may need to switch QCD parameters and/or the model event by event.  In
 this case, the [[qcd]] and/or [[model]] components are present.\\
 For the puropose of NLO events, [[entry_t]] contains a pointer list
 to other simulation-entries. This is due to the fact that we have to
 associate an event for each component of the fixed order simulation,
 i.e. one $N$-particle event and $N_\alpha$ $N+1$-particle events.
 However, all entries share the same event transforms.
 <<Simulations: types>>=
   type, extends (event_t) :: entry_t
      private
      type(string_t) :: process_id
      type(string_t) :: library
      type(string_t) :: run_id
      logical :: has_integral = .false.
      real(default) :: integral = 0
      real(default) :: error = 0
      real(default) :: process_weight = 0
      logical :: valid = .false.
      type(counter_t) :: counter
      integer :: n_in = 0
      integer :: n_mci = 0
      type(mci_set_t), dimension(:), allocatable :: mci_sets
      type(selector_t) :: mci_selector
      logical :: has_resonant_subprocess_set = .false.
      type(resonant_subprocess_set_t) :: resonant_subprocess_set
      type(core_safe_t), dimension(:), allocatable :: core_safe
      class(model_data_t), pointer :: model => null ()
      type(qcd_t) :: qcd
      type(entry_t), pointer :: first => null ()
      type(entry_t), pointer :: next => null ()
      class(evt_t), pointer :: evt_powheg => null ()
    contains
    <<Simulations: entry: TBP>>
   end type entry_t
 
 @ %def entry_t
 @ Output.  Write just the configuration, the event is written by a
 separate routine.
 
 The [[verbose]] option is unused, it is required by the interface of
 the base-object method.
 <<Simulations: entry: TBP>>=
   procedure :: write_config => entry_write_config
 <<Simulations: procedures>>=
   subroutine entry_write_config (object, unit, pacified)
     class(entry_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacified
     logical :: pacify
     integer :: u, i
     u = given_output_unit (unit)
     pacify = .false.;  if (present (pacified))  pacify = pacified
     write (u, "(3x,A,A,A)")  "Process   = '", char (object%process_id), "'"
     write (u, "(3x,A,A,A)")  "Library   = '", char (object%library), "'"
     write (u, "(3x,A,A,A)")  "Run       = '", char (object%run_id), "'"
     write (u, "(3x,A,L1)")   "is valid  = ", object%valid
     if (object%has_integral) then
        if (pacify) then
           write (u, "(3x,A," // FMT_15 // ")")  "Integral  = ", object%integral
           write (u, "(3x,A," // FMT_15 // ")")  "Error     = ", object%error
           write (u, "(3x,A,F9.6)")  "Weight    =", object%process_weight
        else
           write (u, "(3x,A," // FMT_19 // ")")  "Integral  = ", object%integral
           write (u, "(3x,A," // FMT_19 // ")")  "Error     = ", object%error
           write (u, "(3x,A,F13.10)")  "Weight    =", object%process_weight
        end if
     else
        write (u, "(3x,A)")  "Integral  = [undefined]"
     end if
     write (u, "(3x,A,I0)")   "MCI sets  = ", object%n_mci
     call object%counter%write (u)
     do i = 1, size (object%mci_sets)
        write (u, "(A)")
        write (u, "(1x,A,I0,A)")  "MCI set #", i, ":"
        call object%mci_sets(i)%write (u, pacified)
     end do
     if (object%resonant_subprocess_set%is_active ()) then
        write (u, "(A)")
        call object%write_resonant_subprocess_data (u)
     end if
     if (allocated (object%core_safe)) then
        do i = 1, size (object%core_safe)
           write (u, "(1x,A,I0,A)")  "Saved process-component core #", i, ":"
           call object%core_safe(i)%core%write (u)
        end do
     end if
   end subroutine entry_write_config
 
 @ %def entry_write_config
 @ Finalizer.  The [[instance]] pointer component of the [[event_t]]
 base type points to a target which we did explicitly allocate in the
 [[entry_init]] procedure.  Therefore, we finalize and explicitly
 deallocate it here.  Then we call the finalizer of the base type.
 <<Simulations: entry: TBP>>=
   procedure :: final => entry_final
 <<Simulations: procedures>>=
   subroutine entry_final (object)
     class(entry_t), intent(inout) :: object
     integer :: i
     if (associated (object%instance)) then
        do i = 1, object%n_mci
           call object%instance%final_simulation (i)
        end do
        call object%instance%final ()
        deallocate (object%instance)
     end if
     call object%event_t%final ()
   end subroutine entry_final
 
 @ %def entry_final
 @ Copy the content of an entry into another one, except for the next-pointer
 <<Simulations: entry: TBP>>=
   procedure :: copy_entry => entry_copy_entry
 <<Simulations: procedures>>=
   subroutine entry_copy_entry (entry1, entry2)
     class(entry_t), intent(in), target :: entry1
     type(entry_t), intent(inout), target :: entry2
     call entry1%event_t%clone (entry2%event_t)
     entry2%process_id = entry1%process_id
     entry2%library = entry1%library
     entry2%run_id = entry1%run_id
     entry2%has_integral = entry1%has_integral
     entry2%integral = entry1%integral
     entry2%error = entry1%error
     entry2%process_weight = entry1%process_weight
     entry2%valid = entry1%valid
     entry2%counter = entry1%counter
     entry2%n_in = entry1%n_in
     entry2%n_mci = entry1%n_mci
     if (allocated (entry1%mci_sets)) then
        allocate (entry2%mci_sets (size (entry1%mci_sets)))
        entry2%mci_sets = entry1%mci_sets
     end if
     entry2%mci_selector = entry1%mci_selector
     if (allocated (entry1%core_safe)) then
        allocate (entry2%core_safe (size (entry1%core_safe)))
        entry2%core_safe = entry1%core_safe
     end if
     entry2%model => entry1%model
     entry2%qcd = entry1%qcd
   end subroutine entry_copy_entry
 
 @ %def entry_copy_entry
 @ Initialization.  Search for a process entry and allocate a process
 instance as an anonymous object, temporarily accessible via the
 [[process_instance]] pointer.  Assign data by looking at the process
 object and at the environment.
 
 If [[n_alt]] is set, we prepare for additional alternate sqme and weight
 entries.
 
 The [[compile]] flag is only false if we don't need the Whizard
 process at all, just its definition.  In that case, we skip process
 initialization.
 
 Otherwise, and if the process object is not found initially: if
 [[integrate]] is set, attempt an integration pass and try again.
 Otherwise, just initialize the object.
 
 If [[generate]] is set, prepare the MCI objects for generating new events.
 For pure rescanning, this is not necessary.
 
 If [[resonance_history]] is set, we create a separate process library
 which contains all possible restricted subprocesses with distinct
 resonance histories.  These processes will not be integrated, but
 their matrix element codes are used for determining probabilities of
 resonance histories.  Note that this can work only if the process
 method is OMega, and the phase-space method is 'wood'.
 
 When done, we assign the [[instance]] and [[process]] pointers of the
 base type by the [[connect]] method, so we can reference them later.
 <<Simulations: entry: TBP>>=
   procedure :: init => entry_init
 <<Simulations: procedures>>=
   subroutine entry_init &
        (entry, process_id, &
        use_process, integrate, generate, update_sqme, &
        support_resonance_history, &
        local, global, n_alt)
     class(entry_t), intent(inout), target :: entry
     type(string_t), intent(in) :: process_id
     logical, intent(in) :: use_process, integrate, generate, update_sqme
     logical, intent(in) :: support_resonance_history
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     integer, intent(in), optional :: n_alt
     type(process_t), pointer :: process, master_process
     type(process_instance_t), pointer :: process_instance
     type(process_library_t), pointer :: prclib_saved
     integer :: i
     logical :: res_include_trivial
     logical :: combined_integration
     integer :: selected_mci
     selected_mci = 0
     call msg_debug (D_CORE, "entry_init")
     call msg_debug (D_CORE, "process_id", process_id)
     call prepare_process &
          (master_process, process_id, use_process, integrate, local, global)
     if (signal_is_pending ())  return
 
     if (associated (master_process)) then
        if (.not. master_process%has_matrix_element ()) then
           entry%has_integral = .true.
           entry%process_id = process_id
           entry%valid = .false.
           return
        end if
     else
        call entry%basic_init (local%var_list)
        entry%has_integral = .false.
        entry%process_id = process_id
        call entry%import_process_def_characteristics (local%prclib, process_id)
        entry%valid = .true.
        return
     end if
 
     call entry%basic_init (local%var_list, n_alt)
 
     entry%process_id = process_id
     if (generate .or. integrate) then
        entry%run_id = master_process%get_run_id ()
        process => master_process
     else
        call local%set_log (var_str ("?rebuild_phase_space"), &
             .false., is_known = .true.)
        call local%set_log (var_str ("?check_phs_file"), &
             .false., is_known = .true.)
        call local%set_log (var_str ("?rebuild_grids"), &
             .false., is_known = .true.)
        entry%run_id = &
             local%var_list%get_sval (var_str ("$run_id"))
        if (update_sqme) then
           call prepare_local_process (process, process_id, local)
        else
           process => master_process
        end if
     end if
 
     call entry%import_process_characteristics (process)
 
     allocate (entry%mci_sets (entry%n_mci))
     do i = 1, size (entry%mci_sets)
        call entry%mci_sets(i)%init (i, master_process)
     end do
 
     call entry%import_process_results (master_process)
     call entry%prepare_expressions (local)
 
     if (process%is_nlo_calculation ()) call process%init_nlo_settings (global%var_list)
     combined_integration = local%get_lval (var_str ("?combined_nlo_integration"))
     if (.not. combined_integration &
          .and. local%get_lval (var_str ("?fixed_order_nlo_events"))) &
               selected_mci = process%extract_active_component_mci ()
     call prepare_process_instance (process_instance, process, local%model, &
          local = local)
 
     if (generate) then
        if (selected_mci > 0) then
           call process%prepare_simulation (selected_mci)
           call process_instance%init_simulation (selected_mci, entry%config%safety_factor, &
                local%get_lval (var_str ("?keep_failed_events")))
        else
           do i = 1, entry%n_mci
              call process%prepare_simulation (i)
              call process_instance%init_simulation (i, entry%config%safety_factor, &
                   local%get_lval (var_str ("?keep_failed_events")))
           end do
       end if
     end if
 
     if (support_resonance_history) then
        prclib_saved => local%prclib
        call entry%setup_resonant_subprocesses (local, process)
        if (entry%has_resonant_subprocess_set) then
           if (signal_is_pending ())  return
           call entry%compile_resonant_subprocesses (local)
           if (signal_is_pending ())  return
           call entry%prepare_resonant_subprocesses (local, global)
           if (signal_is_pending ())  return
           call entry%prepare_resonant_subprocess_instances (local)
        end if
        if (signal_is_pending ())  return
        if (associated (prclib_saved))  call local%update_prclib (prclib_saved)
     end if
 
     call entry%setup_event_transforms (process, local)
 
     call dispatch_qcd (entry%qcd, local%get_var_list_ptr (), local%os_data)
 
     call entry%connect_qcd ()
 
     select type (pcm => process_instance%pcm)
     class is (pcm_instance_nlo_t)
         select type (config => pcm%config)
         type is (pcm_nlo_t)
            if (config%settings%fixed_order_nlo) &
                 call pcm%set_fixed_order_event_mode ()
        end select
     end select
 
     if (present (global)) then
        call entry%connect (process_instance, local%model, global%process_stack)
     else
        call entry%connect (process_instance, local%model, local%process_stack)
     end if
     call entry%setup_expressions ()
 
     entry%model => process%get_model_ptr ()
 
     entry%valid = .true.
 
   end subroutine entry_init
 
 @ %def entry_init
 @
 <<Simulations: entry: TBP>>=
   procedure :: set_active_real_components => entry_set_active_real_components
 <<Simulations: procedures>>=
   subroutine entry_set_active_real_components (entry)
     class(entry_t), intent(inout) :: entry
     integer :: i_active_real
     select type (pcm => entry%instance%pcm)
     class is (pcm_instance_nlo_t)
        i_active_real = entry%instance%get_real_of_mci ()
        call msg_debug2 (D_CORE, "i_active_real", i_active_real)
        if (associated (entry%evt_powheg)) then
           select type (evt => entry%evt_powheg)
           type is (evt_shower_t)
              if (entry%process%get_component_type(i_active_real) == COMP_REAL_FIN) then
                 call msg_debug (D_CORE, "Disabling Powheg matching for ", i_active_real)
                 call evt%disable_powheg_matching ()
              else
                 call msg_debug (D_CORE, "Enabling Powheg matching for ", i_active_real)
                 call evt%enable_powheg_matching ()
              end if
           class default
              call msg_fatal ("powheg-evt should be evt_shower_t!")
           end select
        end if
     end select
   end subroutine entry_set_active_real_components
 
 @ %def entry_set_active_real_components
 @ Part of simulation-entry initialization: set up a process object for
 local use.
 <<Simulations: procedures>>=
   subroutine prepare_local_process (process, process_id, local)
     type(process_t), pointer, intent(inout) :: process
     type(string_t), intent(in) :: process_id
     type(rt_data_t), intent(inout), target :: local
     type(integration_t) :: intg
     call intg%create_process (process_id)
     call intg%init_process (local)
     call intg%setup_process (local, verbose=.false.)
     process => intg%get_process_ptr ()
   end subroutine prepare_local_process
 
 @ %def prepare_local_process
 @ Part of simulation-entry initialization: set up a process instance
 matching the selected process object.
 
 The model that we can provide as an extra argument can modify particle
 settings (polarization) in the density matrices that will be constructed.  It
 does not affect parameters.
 <<Simulations: procedures>>=
   subroutine prepare_process_instance &
     (process_instance, process, model, local)
     type(process_instance_t), pointer, intent(inout) :: process_instance
     type(process_t), intent(inout), target :: process
     class(model_data_t), intent(in), optional :: model
     type(rt_data_t), intent(in), optional, target :: local
     allocate (process_instance)
     call process_instance%init (process)
     if (process%is_nlo_calculation ()) then
        select type (pcm => process_instance%pcm)
        type is (pcm_instance_nlo_t)
           select type (config => pcm%config)
           type is (pcm_nlo_t)
              if (.not. config%settings%combined_integration) &
                   call pcm%set_radiation_event ()
           end select
        end select
        if (process%needs_extra_code () .and. present (local)) then
              call process%create_and_load_extra_libraries &
                   (local%beam_structure, process%get_var_list_ptr (), &
                   local%os_data)
        end if
     end if
     call process_instance%setup_event_data (model)
   end subroutine prepare_process_instance
 
 @ %def prepare_process_instance
 @ Part of simulation-entry initialization: query the
 process for basic information.
 <<Simulations: entry: TBP>>=
   procedure, private :: import_process_characteristics &
        => entry_import_process_characteristics
 <<Simulations: procedures>>=
   subroutine entry_import_process_characteristics (entry, process)
     class(entry_t), intent(inout) :: entry
     type(process_t), intent(in), target :: process
     entry%library = process%get_library_name ()
     entry%n_in = process%get_n_in ()
     entry%n_mci = process%get_n_mci ()
   end subroutine entry_import_process_characteristics
 
 @ %def entry_import_process_characteristics
 @ This is the alternative form which applies if there is no process
 entry, but just a process definition which we take from the provided
 [[prclib]] definition library.
 <<Simulations: entry: TBP>>=
   procedure, private :: import_process_def_characteristics &
        => entry_import_process_def_characteristics
 <<Simulations: procedures>>=
   subroutine entry_import_process_def_characteristics (entry, prclib, id)
     class(entry_t), intent(inout) :: entry
     type(process_library_t), intent(in), target :: prclib
     type(string_t), intent(in) :: id
     entry%library = prclib%get_name ()
     entry%n_in = prclib%get_n_in (id)
   end subroutine entry_import_process_def_characteristics
 
 @ %def entry_import_process_def_characteristics
 @ Part of simulation-entry initialization: query the
 process for integration results.
 <<Simulations: entry: TBP>>=
   procedure, private :: import_process_results &
        => entry_import_process_results
 <<Simulations: procedures>>=
   subroutine entry_import_process_results (entry, process)
     class(entry_t), intent(inout) :: entry
     type(process_t), intent(in), target :: process
     if (process%has_integral ()) then
        entry%integral = process%get_integral ()
        entry%error = process%get_error ()
        call entry%set_sigma (entry%integral)
        entry%has_integral = .true.
     end if
   end subroutine entry_import_process_results
 
 @ %def entry_import_process_characteristics
 @ Part of simulation-entry initialization: create expression factory
 objects and store them.
 <<Simulations: entry: TBP>>=
   procedure, private :: prepare_expressions &
        => entry_prepare_expressions
 <<Simulations: procedures>>=
   subroutine entry_prepare_expressions (entry, local)
     class(entry_t), intent(inout) :: entry
     type(rt_data_t), intent(in), target :: local
     type(eval_tree_factory_t) :: expr_factory
     call expr_factory%init (local%pn%selection_lexpr)
     call entry%set_selection (expr_factory)
     call expr_factory%init (local%pn%reweight_expr)
     call entry%set_reweight (expr_factory)
     call expr_factory%init (local%pn%analysis_lexpr)
     call entry%set_analysis (expr_factory)
   end subroutine entry_prepare_expressions
 
 @ %def entry_prepare_expressions
 @ Initializes the list of additional NLO entries.  The routine gets the
 information about how many entries to associate from [[region_data]].
 <<Simulations: entry: TBP>>=
   procedure :: setup_additional_entries => entry_setup_additional_entries
 <<Simulations: procedures>>=
   subroutine entry_setup_additional_entries (entry)
     class(entry_t), intent(inout), target :: entry
     type(entry_t), pointer :: current_entry
     integer :: i, n_phs
     type(evt_nlo_t), pointer :: evt
     integer :: mode
     evt => null ()
     select type (pcm => entry%instance%pcm)
     class is (pcm_instance_nlo_t)
        select type (config => pcm%config)
        type is (pcm_nlo_t)
           n_phs = config%region_data%n_phs
        end select
     end select
     select type (entry)
     type is (entry_t)
        current_entry => entry
        current_entry%first => entry
        call get_nlo_evt_ptr (current_entry, evt, mode)
        if (mode > EVT_NLO_SEPARATE_BORNLIKE) then
           allocate (evt%particle_set_radiated (n_phs + 1))
           evt%event_deps%n_phs = n_phs
           evt%qcd => entry%qcd
           do i = 1, n_phs
              allocate (current_entry%next)
              current_entry%next%first => current_entry%first
              current_entry => current_entry%next
              call entry%copy_entry (current_entry)
              current_entry%i_event = i
           end do
        else
           allocate (evt%particle_set_radiated (1))
        end if
     end select
   contains
     subroutine get_nlo_evt_ptr (entry, evt, mode)
       type(entry_t), intent(in), target :: entry
       type(evt_nlo_t), intent(out), pointer :: evt
       integer, intent(out) :: mode
       class(evt_t), pointer :: current_evt
       evt => null ()
       current_evt => entry%transform_first
       do
          select type (current_evt)
          type is (evt_nlo_t)
             evt => current_evt
             mode = evt%mode
             exit
          end select
          if (associated (current_evt%next)) then
             current_evt => current_evt%next
          else
             call msg_fatal ("evt_nlo not in list of event transforms")
          end if
       end do
     end subroutine get_nlo_evt_ptr
   end subroutine entry_setup_additional_entries
 
 @ %def entry_setup_additional_entries
 @
 <<Simulations: entry: TBP>>=
   procedure :: get_first => entry_get_first
 <<Simulations: procedures>>=
   function entry_get_first (entry) result (entry_out)
     class(entry_t), intent(in), target :: entry
     type(entry_t), pointer :: entry_out
     entry_out => null ()
     select type (entry)
     type is (entry_t)
        if (entry%is_nlo ()) then
           entry_out => entry%first
        else
           entry_out => entry
        end if
     end select
   end function entry_get_first
 
 @ %def entry_get_first
 @
 <<Simulations: entry: TBP>>=
   procedure :: get_next => entry_get_next
 <<Simulations: procedures>>=
   function entry_get_next (entry) result (next_entry)
      class(entry_t), intent(in) :: entry
      type(entry_t), pointer :: next_entry
      next_entry => null ()
      if (associated (entry%next)) then
         next_entry => entry%next
      else
         call msg_fatal ("Get next entry: No next entry")
      end if
   end function entry_get_next
 
 @ %def entry_get_next
 @
 <<Simulations: entry: TBP>>=
   procedure :: count_nlo_entries => entry_count_nlo_entries
 <<Simulations: procedures>>=
   function entry_count_nlo_entries (entry) result (n)
     class(entry_t), intent(in), target :: entry
     integer :: n
     type(entry_t), pointer :: current_entry
     n = 1
     if (.not. associated (entry%next)) then
        return
     else
        current_entry => entry%next
        do
           n = n + 1
           if (.not. associated (current_entry%next)) exit
           current_entry => current_entry%next
        end do
     end if
   end function entry_count_nlo_entries
 
 @ %def entry_count_nlo_entries
 @
 <<Simulations: entry: TBP>>=
   procedure :: reset_nlo_counter => entry_reset_nlo_counter
 <<Simulations: procedures>>=
   subroutine entry_reset_nlo_counter (entry)
     class(entry_t), intent(inout) :: entry
     class(evt_t), pointer :: evt
     evt => entry%transform_first
     do
        select type (evt)
        type is (evt_nlo_t)
           evt%i_evaluation = 0
           exit
        end select
        if (associated (evt%next)) evt => evt%next
    end do
   end subroutine entry_reset_nlo_counter
 
 @ %def entry_reset_nlo_counter
 @
 <<Simulations: entry: TBP>>=
   procedure :: determine_if_powheg_matching => entry_determine_if_powheg_matching
 <<Simulations: procedures>>=
   subroutine entry_determine_if_powheg_matching (entry)
      class(entry_t), intent(inout) :: entry
      class(evt_t), pointer :: current_transform
      if (associated (entry%transform_first)) then
         current_transform => entry%transform_first
         do
            select type (current_transform)
            type is (evt_shower_t)
               if (current_transform%contains_powheg_matching ()) &
                   entry%evt_powheg => current_transform
               exit
            end select
            if (associated (current_transform%next)) then
               current_transform => current_transform%next
            else
               exit
            end if
         end do
      end if
   end subroutine entry_determine_if_powheg_matching
 
 @ %def entry_determine_if_powheg_matching
 @ Part of simulation-entry initialization: dispatch event transforms
 (decay, shower) as requested.  If a transform is not applicable or
 switched off via some variable, it will be skipped.
 
 Regarding resonances/decays: these two transforms are currently mutually
 exclusive.  Resonance insertion will not be applied if there is an
 unstable particle in the game.
 <<Simulations: entry: TBP>>=
   procedure, private :: setup_event_transforms &
        => entry_setup_event_transforms
 <<Simulations: procedures>>=
   subroutine entry_setup_event_transforms (entry, process, local)
     class(entry_t), intent(inout) :: entry
     type(process_t), intent(inout), target :: process
     type(rt_data_t), intent(in), target :: local
     class(evt_t), pointer :: evt
     type(var_list_t), pointer :: var_list
     logical :: enable_isr_handler
     logical :: enable_epa_handler
     logical :: enable_fixed_order
     logical :: enable_shower
     var_list => local%get_var_list_ptr ()
     enable_isr_handler = local%get_lval (var_str ("?isr_handler"))
     enable_epa_handler = local%get_lval (var_str ("?epa_handler"))
     if (enable_isr_handler .or. enable_epa_handler) then
        call dispatch_evt_isr_epa_handler (evt, local%var_list)
        if (associated (evt))  call entry%import_transform (evt)
     end if
     if (process%contains_unstable (local%model)) then
        call dispatch_evt_decay (evt, local%var_list)
        if (associated (evt))  call entry%import_transform (evt)
     else if (entry%resonant_subprocess_set%is_active ()) then
        call dispatch_evt_resonance (evt, local%var_list, &
             entry%resonant_subprocess_set%get_resonance_history_set (), &
             entry%resonant_subprocess_set%get_libname ())
        if (associated (evt)) then
           call entry%resonant_subprocess_set%connect_transform (evt)
           call entry%resonant_subprocess_set%set_on_shell_limit &
                (local%get_rval (var_str ("resonance_on_shell_limit")))
           call entry%resonant_subprocess_set%set_on_shell_turnoff &
                (local%get_rval (var_str ("resonance_on_shell_turnoff")))
           call entry%resonant_subprocess_set%set_background_factor &
                (local%get_rval (var_str ("resonance_background_factor")))
           call entry%import_transform (evt)
        end if
     end if
     enable_fixed_order = local%get_lval (var_str ("?fixed_order_nlo_events"))
     if (enable_fixed_order) then
        if (local%get_lval (var_str ("?unweighted"))) &
           call msg_fatal ("NLO Fixed Order events have to be generated with &
                           &?unweighted = false")
        call dispatch_evt_nlo (evt, local%get_lval (var_str ("?keep_failed_events")))
        call entry%import_transform (evt)
     end if
     enable_shower = local%get_lval (var_str ("?allow_shower")) .and. &
             (local%get_lval (var_str ("?ps_isr_active")) &
             .or. local%get_lval (var_str ("?ps_fsr_active")) &
             .or. local%get_lval (var_str ("?muli_active")) &
             .or. local%get_lval (var_str ("?mlm_matching")) &
             .or. local%get_lval (var_str ("?ckkw_matching")) &
             .or. local%get_lval (var_str ("?powheg_matching")))
     if (enable_shower) then
        call dispatch_evt_shower (evt, var_list, local%model, &
             local%fallback_model, local%os_data, local%beam_structure, &
             process)
        call entry%import_transform (evt)
     end if
     if (local%get_lval (var_str ("?hadronization_active"))) then
        call dispatch_evt_hadrons (evt, var_list, local%fallback_model)
        call entry%import_transform (evt)
     end if
   end subroutine entry_setup_event_transforms
 
 @ %def entry_setup_event_transforms
 @ Compute weights.  The integral in the argument is the sum of integrals for
 all processes in the sample.  After computing the process weights, we repeat
 the normalization procedure for the process components.
 <<Simulations: entry: TBP>>=
   procedure :: init_mci_selector => entry_init_mci_selector
 <<Simulations: procedures>>=
   subroutine entry_init_mci_selector (entry, negative_weights)
     class(entry_t), intent(inout), target :: entry
     logical, intent(in), optional :: negative_weights
     type(entry_t), pointer :: current_entry
     integer :: i, j, k
     call msg_debug (D_CORE, "entry_init_mci_selector")
     if (entry%has_integral) then
        select type (entry)
        type is (entry_t)
           current_entry => entry
           do j = 1, current_entry%count_nlo_entries ()
              if (j > 1) current_entry => current_entry%get_next ()
              do k = 1, size(current_entry%mci_sets%integral)
                 call msg_debug (D_CORE, "current_entry%mci_sets(k)%integral", &
                      current_entry%mci_sets(k)%integral)
              end do
              call current_entry%mci_selector%init &
                   (current_entry%mci_sets%integral, negative_weights)
              do i = 1, current_entry%n_mci
                 current_entry%mci_sets(i)%weight_mci = &
                    current_entry%mci_selector%get_weight (i)
              end do
           end do
        end select
     end if
   end subroutine entry_init_mci_selector
 
 @ %def entry_init_mci_selector
 @ Select a MCI entry, using the embedded random-number generator.
 <<Simulations: entry: TBP>>=
   procedure :: select_mci => entry_select_mci
 <<Simulations: procedures>>=
   function entry_select_mci (entry) result (i_mci)
     class(entry_t), intent(inout) :: entry
     integer :: i_mci
     call msg_debug2 (D_CORE, "entry_select_mci")
     i_mci = entry%process%extract_active_component_mci ()
     if (i_mci == 0) call entry%mci_selector%generate (entry%rng, i_mci)
     call msg_debug2 (D_CORE, "i_mci", i_mci)
   end function entry_select_mci
 
 @ %def entry_select_mci
 @ Record an event for this entry, i.e., increment the appropriate counters.
 <<Simulations: entry: TBP>>=
   procedure :: record => entry_record
 <<Simulations: procedures>>=
   subroutine entry_record (entry, i_mci, from_file)
     class(entry_t), intent(inout) :: entry
     integer, intent(in) :: i_mci
     logical, intent(in), optional :: from_file
     real(default) :: weight, excess
     weight = entry%get_weight_prc ()
     excess = entry%get_excess_prc ()
     call entry%counter%record (weight, excess, from_file)
     if (i_mci > 0) then
        call entry%mci_sets(i_mci)%counter%record (weight, excess)
     end if
   end subroutine entry_record
 
 @ %def entry_record
 @ Update and restore the process core that this entry accesses, when
 parameters change.  If explicit arguments [[model]], [[qcd]], or
 [[helicity_selection]] are provided, use those.  Otherwise use the
 parameters stored in the process object.
 <<Simulations: entry: TBP>>=
   procedure :: update_process => entry_update_process
   procedure :: restore_process => entry_restore_process
 <<Simulations: procedures>>=
   subroutine entry_update_process &
        (entry, model, qcd, helicity_selection)
     class(entry_t), intent(inout) :: entry
     class(model_data_t), intent(in), optional, target :: model
     type(qcd_t), intent(in), optional :: qcd
     type(helicity_selection_t), intent(in), optional :: helicity_selection
     type(process_t), pointer :: process
     class(prc_core_t), allocatable :: core
     integer :: i, n_terms
     class(model_data_t), pointer :: model_local
     type(qcd_t) :: qcd_local
     if (present (model)) then
        model_local => model
     else
        model_local => entry%model
     end if
     if (present (qcd)) then
        qcd_local = qcd
     else
        qcd_local = entry%qcd
     end if
     process => entry%get_process_ptr ()
 
     n_terms = process%get_n_terms ()
     allocate (entry%core_safe (n_terms))
     do i = 1, n_terms
        if (process%has_matrix_element (i, is_term_index = .true.)) then
           call process%extract_core (i, core)
           call dispatch_core_update (core, &
                model_local, helicity_selection, qcd_local, &
                entry%core_safe(i)%core)
           call process%restore_core (i, core)
        end if
     end do
   end subroutine entry_update_process
 
   subroutine entry_restore_process (entry)
     class(entry_t), intent(inout) :: entry
     type(process_t), pointer :: process
     class(prc_core_t), allocatable :: core
     integer :: i, n_terms
     process => entry%get_process_ptr ()
     n_terms = process%get_n_terms ()
     do i = 1, n_terms
        if (process%has_matrix_element (i, is_term_index = .true.)) then
           call process%extract_core (i, core)
           call dispatch_core_restore (core, entry%core_safe(i)%core)
           call process%restore_core (i, core)
        end if
     end do
     deallocate (entry%core_safe)
   end subroutine entry_restore_process
 
 @ %def entry_update_process
 @ %def entry_restore_process
 <<Simulations: entry: TBP>>=
   procedure :: connect_qcd => entry_connect_qcd
 <<Simulations: procedures>>=
   subroutine entry_connect_qcd (entry)
     class(entry_t), intent(inout), target :: entry
     class(evt_t), pointer :: evt
     evt => entry%transform_first
     do while (associated (evt))
        select type (evt)
        type is (evt_shower_t)
           evt%qcd => entry%qcd
           if (allocated (evt%matching)) then
              evt%matching%qcd => entry%qcd
           end if
        end select
        evt => evt%next
     end do
   end subroutine entry_connect_qcd
 
 @ %def entry_connect_qcd
 @
 \subsection{Handling resonant subprocesses}
 Resonant subprocesses are required if we want to determine resonance histories
 when generating events.  The feature is optional, to be switched on by
 the user.
 
 This procedure initializes a new, separate process library that
 contains copies of the current process, restricted to the relevant
 resonance histories.  (If this library exists already, it is just
 kept.)  The histories can be extracted from the process object.
 
 The code has to match the assignments in
 [[create_resonant_subprocess_library]].  The library may already
 exist -- in that case, here it will be recovered without recompilation.
 <<Simulations: entry: TBP>>=
   procedure :: setup_resonant_subprocesses &
        => entry_setup_resonant_subprocesses
 <<Simulations: procedures>>=
   subroutine entry_setup_resonant_subprocesses (entry, global, process)
     class(entry_t), intent(inout) :: entry
     type(rt_data_t), intent(inout), target :: global
     type(process_t), intent(in), target :: process
     type(string_t) :: libname
     type(resonance_history_set_t) :: res_history_set
     type(process_library_t), pointer :: lib
     type(process_component_def_t), pointer :: process_component_def
     logical :: req_resonant, library_exist
     integer :: i_component
     libname = process%get_library_name ()
     lib => global%prclib_stack%get_library_ptr (libname)
     entry%has_resonant_subprocess_set = lib%req_resonant (process%get_id ())
     if (entry%has_resonant_subprocess_set) then
        libname = get_libname_res (process%get_id ())
        call entry%resonant_subprocess_set%init (process%get_n_components ())
        call entry%resonant_subprocess_set%create_library &
             (libname, global, library_exist)
        do i_component = 1, process%get_n_components ()
           call process%extract_resonance_history_set &
                (res_history_set, i_component = i_component)
           call entry%resonant_subprocess_set%fill_resonances &
                (res_history_set, i_component)
           if (.not. library_exist) then
              process_component_def &
                   => process%get_component_def_ptr (i_component)
              call entry%resonant_subprocess_set%add_to_library &
                   (i_component, &
                   process_component_def%get_prt_spec_in (), &
                   process_component_def%get_prt_spec_out (), &
                   global)
           end if
        end do
        call entry%resonant_subprocess_set%freeze_library (global)
     end if
   end subroutine entry_setup_resonant_subprocesses
 
 @ %def entry_setup_resonant_subprocesses
 @ Compile the resonant-subprocesses library.  The library is assumed
 to be the current library in the [[global]] object.  This is a simple wrapper.
 <<Simulations: entry: TBP>>=
   procedure :: compile_resonant_subprocesses &
        => entry_compile_resonant_subprocesses
 <<Simulations: procedures>>=
   subroutine entry_compile_resonant_subprocesses (entry, global)
     class(entry_t), intent(inout) :: entry
     type(rt_data_t), intent(inout), target :: global
     call entry%resonant_subprocess_set%compile_library (global)
   end subroutine entry_compile_resonant_subprocesses
 
 @ %def entry_compile_resonant_subprocesses
 @ Prepare process objects for the resonant-subprocesses library.  The
 process objects are appended to the global process stack.  We
 initialize the processes, such that we can evaluate matrix elements,
 but we do not need to integrate them.
 <<Simulations: entry: TBP>>=
   procedure :: prepare_resonant_subprocesses &
        => entry_prepare_resonant_subprocesses
 <<Simulations: procedures>>=
   subroutine entry_prepare_resonant_subprocesses (entry, local, global)
     class(entry_t), intent(inout) :: entry
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     call entry%resonant_subprocess_set%prepare_process_objects (local, global)
   end subroutine entry_prepare_resonant_subprocesses
 
 @ %def entry_prepare_resonant_subprocesses
 @ Prepare process instances.  They are linked to their corresponding process
 objects.  Both, process and instance objects, are allocated as anonymous
 targets inside the [[resonant_subprocess_set]] component.
 
 NOTE: those anonymous object are likely forgotten during finalization of the
 parent [[event_t]] (extended as [[entry_t]]) object.  This should be checked!
 The memory leak is probably harmless as long as the event object is created
 once per run, not once per event.
 <<Simulations: entry: TBP>>=
   procedure :: prepare_resonant_subprocess_instances &
        => entry_prepare_resonant_subprocess_instances
 <<Simulations: procedures>>=
   subroutine entry_prepare_resonant_subprocess_instances (entry, global)
     class(entry_t), intent(inout) :: entry
     type(rt_data_t), intent(in), target :: global
     call entry%resonant_subprocess_set%prepare_process_instances (global)
   end subroutine entry_prepare_resonant_subprocess_instances
 
 @ %def entry_prepare_resonant_subprocess_instances
 @ Display the resonant subprocesses.  This includes, upon request, the
 resonance set that defines those subprocess, and a short or long account of the
 process objects themselves.
 <<Simulations: entry: TBP>>=
   procedure :: write_resonant_subprocess_data &
        => entry_write_resonant_subprocess_data
 <<Simulations: procedures>>=
   subroutine entry_write_resonant_subprocess_data (entry, unit)
     class(entry_t), intent(in) :: entry
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit)
     call entry%resonant_subprocess_set%write (unit)
     write (u, "(1x,A,I0)")  "Resonant subprocesses refer to &
             &process component #", 1
   end subroutine entry_write_resonant_subprocess_data
 
 @ %def entry_write_resonant_subprocess_data
 @ Display of the master process for the current event, for diagnostics.
 <<Simulations: entry: TBP>>=
   procedure :: write_process_data => entry_write_process_data
 <<Simulations: procedures>>=
   subroutine entry_write_process_data &
        (entry, unit, show_process, show_instance, verbose)
     class(entry_t), intent(in) :: entry
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: show_process
     logical, intent(in), optional :: show_instance
     logical, intent(in), optional :: verbose
     integer :: u, i
     logical :: s_proc, s_inst, verb
     type(process_t), pointer :: process
     type(process_instance_t), pointer :: instance
     u = given_output_unit (unit)
     s_proc = .false.;  if (present (show_process))  s_proc = show_process
     s_inst = .false.;  if (present (show_instance))  s_inst = show_instance
     verb = .false.;  if (present (verbose))  verb = verbose
     if (s_proc .or. s_inst) then
        write (u, "(1x,A,':')")  "Process data"
        if (s_proc) then
           process => entry%process
           if (associated (process)) then
              if (verb) then
                 call write_separator (u, 2)
                 call process%write (.false., u)
              else
                 call process%show (u, verbose=.false.)
              end if
           else
              write (u, "(3x,A)")  "[not associated]"
           end if
        end if
        if (s_inst) then
           instance => entry%instance
           if (associated (instance)) then
              if (verb) then
                 call instance%write (u)
              else
                 call instance%write_header (u)
              end if
           else
              write (u, "(3x,A)")  "Process instance: [not associated]"
           end if
        end if
     end if
   end subroutine entry_write_process_data
 
 @ %def entry_write_process_data
 @
 \subsection{Entries for alternative environment}
 Entries for alternate environments.  [No additional components
 anymore, so somewhat redundant.]
 <<Simulations: types>>=
   type, extends (entry_t) :: alt_entry_t
    contains
    <<Simulations: alt entry: TBP>>
   end type alt_entry_t
 
 @ %def alt_entry_t
  The alternative entries are there to re-evaluate the event, given
 momenta, in a different context.
 
 Therefore, we allocate a local process object and use this as the
 reference for the local process instance, when initializing the entry.
 We temporarily import the [[process]] object into an [[integration_t]]
 wrapper, to take advantage of the associated methods.  The local
 process object is built in the context of the current environment,
 here called [[global]].  Then, we initialize the process instance.
 
 The [[master_process]] object contains the integration results to which we
 refer when recalculating an event.  Therefore, we use this object instead of
 the locally built [[process]] when we extract the integration results.
 
 The locally built [[process]] object should be finalized when done.  It
 remains accessible via the [[event_t]] base object of [[entry]], which
 contains pointers to the process and instance.
 <<Simulations: alt entry: TBP>>=
   procedure :: init_alt => alt_entry_init
 <<Simulations: procedures>>=
   subroutine alt_entry_init (entry, process_id, master_process, local)
     class(alt_entry_t), intent(inout), target :: entry
     type(string_t), intent(in) :: process_id
     type(process_t), intent(in), target :: master_process
     type(rt_data_t), intent(inout), target :: local
     type(process_t), pointer :: process
     type(process_instance_t), pointer :: process_instance
     type(string_t) :: run_id
     integer :: i
 
     call msg_message ("Simulate: initializing alternate process setup ...")
 
     run_id = &
          local%var_list%get_sval (var_str ("$run_id"))
     call local%set_log (var_str ("?rebuild_phase_space"), &
          .false., is_known = .true.)
     call local%set_log (var_str ("?check_phs_file"), &
          .false., is_known = .true.)
     call local%set_log (var_str ("?rebuild_grids"), &
          .false., is_known = .true.)
 
     call entry%basic_init (local%var_list)
 
     call prepare_local_process (process, process_id, local)
     entry%process_id = process_id
     entry%run_id = run_id
 
     call entry%import_process_characteristics (process)
 
     allocate (entry%mci_sets (entry%n_mci))
     do i = 1, size (entry%mci_sets)
        call entry%mci_sets(i)%init (i, master_process)
     end do
 
     call entry%import_process_results (master_process)
     call entry%prepare_expressions (local)
 
     call prepare_process_instance (process_instance, process, local%model)
     call entry%setup_event_transforms (process, local)
 
     call entry%connect (process_instance, local%model, local%process_stack)
     call entry%setup_expressions ()
 
     entry%model => process%get_model_ptr ()
 
     call msg_message ("...  alternate process setup complete.")
 
   end subroutine alt_entry_init
 
 @ %def alt_entry_init
 @ Copy the particle set from the master entry to the alternate entry.
 This is the particle set of the hard process.
 <<Simulations: alt entry: TBP>>=
   procedure :: fill_particle_set => entry_fill_particle_set
 <<Simulations: procedures>>=
   subroutine entry_fill_particle_set (alt_entry, entry)
     class(alt_entry_t), intent(inout) :: alt_entry
     class(entry_t), intent(in), target :: entry
     type(particle_set_t) :: pset
     call entry%get_hard_particle_set (pset)
     call alt_entry%set_hard_particle_set (pset)
     call pset%final ()
   end subroutine entry_fill_particle_set
 
 @ %def particle_set_copy_prt
 @
 \subsection{The simulation type}
 Each simulation object corresponds to an event sample, identified by
 the [[sample_id]].
 
 The simulation may cover several processes simultaneously.  All
 process-specific data, including the event records, are stored in the
 [[entry]] subobjects.  The [[current]] index indicates which record
 was selected last. [[version]] is foreseen to contain a tag on the \whizard\
 event file version. It can be
 <<Simulations: public>>=
   public :: simulation_t
 <<Simulations: types>>=
   type :: simulation_t
      private
      type(rt_data_t), pointer :: local => null ()
      type(string_t) :: sample_id
      logical :: unweighted = .true.
      logical :: negative_weights = .false.
      logical :: support_resonance_history = .false.
      logical :: respect_selection = .true.
      integer :: norm_mode = NORM_UNDEFINED
      logical :: update_sqme = .false.
      logical :: update_weight = .false.
      logical :: update_event = .false.
      logical :: recover_beams = .false.
      logical :: pacify = .false.
      integer :: n_max_tries = 10000
      integer :: n_prc = 0
      integer :: n_alt = 0
      logical :: has_integral = .false.
      logical :: valid = .false.
      real(default) :: integral = 0
      real(default) :: error = 0
      integer :: version = 1
      character(32) :: md5sum_prc = ""
      character(32) :: md5sum_cfg = ""
      character(32), dimension(:), allocatable :: md5sum_alt
      type(entry_t), dimension(:), allocatable :: entry
      type(alt_entry_t), dimension(:,:), allocatable :: alt_entry
      type(selector_t) :: process_selector
      integer :: n_evt_requested = 0
      integer :: event_index_offset = 0
      logical :: event_index_set = .false.
      integer :: event_index = 0
      integer :: split_n_evt = 0
      integer :: split_n_kbytes = 0
      integer :: split_index = 0
      type(counter_t) :: counter
      class(rng_t), allocatable :: rng
      integer :: i_prc = 0
      integer :: i_mci = 0
      real(default) :: weight = 0
      real(default) :: excess = 0
    contains
    <<Simulations: simulation: TBP>>
   end type simulation_t
 
 @ %def simulation_t
 @ Output.  [[write_config]] writes just the configuration.  [[write]]
 as a method of the base type [[event_t]]
 writes the current event and process instance, depending on options.
 <<Simulations: simulation: TBP>>=
   procedure :: write => simulation_write
 <<Simulations: procedures>>=
   subroutine simulation_write (object, unit, testflag)
     class(simulation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     logical :: pacified
     integer :: u, i
     u = given_output_unit (unit)
     pacified = object%pacify;  if (present (testflag))  pacified = testflag
     call write_separator (u, 2)
     write (u, "(1x,A,A,A)")  "Event sample: '", char (object%sample_id), "'"
     write (u, "(3x,A,I0)")  "Processes    = ", object%n_prc
     if (object%n_alt > 0) then
        write (u, "(3x,A,I0)")  "Alt.wgts     = ", object%n_alt
     end if
     write (u, "(3x,A,L1)")  "Unweighted   = ", object%unweighted
     write (u, "(3x,A,A)")   "Event norm   = ", &
          char (event_normalization_string (object%norm_mode))
     write (u, "(3x,A,L1)")  "Neg. weights = ", object%negative_weights
     write (u, "(3x,A,L1)")  "Res. history = ", object%support_resonance_history
     write (u, "(3x,A,L1)")  "Respect sel. = ", object%respect_selection
     write (u, "(3x,A,L1)")  "Update sqme  = ", object%update_sqme
     write (u, "(3x,A,L1)")  "Update wgt   = ", object%update_weight
     write (u, "(3x,A,L1)")  "Update event = ", object%update_event
     write (u, "(3x,A,L1)")  "Recov. beams = ", object%recover_beams
     write (u, "(3x,A,L1)")  "Pacify       = ", object%pacify
     write (u, "(3x,A,I0)")  "Max. tries   = ", object%n_max_tries
     if (object%has_integral) then
        if (pacified) then
           write (u, "(3x,A," // FMT_15 // ")")  &
                "Integral     = ", object%integral
           write (u, "(3x,A," // FMT_15 // ")")  &
                "Error        = ", object%error
        else
           write (u, "(3x,A," // FMT_19 // ")")  &
                "Integral     = ", object%integral
           write (u, "(3x,A," // FMT_19 // ")")  &
                "Error        = ", object%error
        end if
     else
        write (u, "(3x,A)")  "Integral     = [undefined]"
     end if
     write (u, "(3x,A,L1)")  "Sim. valid   = ", object%valid
     write (u, "(3x,A,I0)")  "Ev.file ver. = ", object%version
     if (object%md5sum_prc /= "") then
        write (u, "(3x,A,A,A)")  "MD5 sum (proc)   = '", object%md5sum_prc, "'"
     end if
     if (object%md5sum_cfg /= "") then
        write (u, "(3x,A,A,A)")  "MD5 sum (config) = '", object%md5sum_cfg, "'"
     end if
     write (u, "(3x,A,I0)")  "Events requested  = ", object%n_evt_requested
     if (object%event_index_offset /= 0) then
        write (u, "(3x,A,I0)")  "Event index offset= ", object%event_index_offset
     end if
     if (object%event_index_set) then
        write (u, "(3x,A,I0)")  "Event index       = ", object%event_index
     end if
     if (object%split_n_evt > 0 .or. object%split_n_kbytes > 0) then
        write (u, "(3x,A,I0)")  "Events per file   = ", object%split_n_evt
        write (u, "(3x,A,I0)")  "KBytes per file   = ", object%split_n_kbytes
        write (u, "(3x,A,I0)")  "First file index  = ", object%split_index
     end if
     call object%counter%write (u)
     call write_separator (u)
     if (object%i_prc /= 0) then
        write (u, "(1x,A)")  "Current event:"
        write (u, "(3x,A,I0,A,A)")  "Process #", &
             object%i_prc, ": ", &
             char (object%entry(object%i_prc)%process_id)
        write (u, "(3x,A,I0)")  "MCI set #", object%i_mci
        write (u, "(3x,A," // FMT_19 // ")")  "Weight    = ", object%weight
        if (.not. vanishes (object%excess)) &
             write (u, "(3x,A," // FMT_19 // ")")  "Excess    = ", object%excess
     else
        write (u, "(1x,A,I0,A,A)")  "Current event: [undefined]"
     end if
     call write_separator (u)
     if (allocated (object%rng)) then
        call object%rng%write (u)
     else
        write (u, "(3x,A)")  "Random-number generator: [undefined]"
     end if
     if (allocated (object%entry)) then
        do i = 1, size (object%entry)
           if (i == 1) then
              call write_separator (u, 2)
           else
              call write_separator (u)
           end if
           write (u, "(1x,A,I0,A)") "Process #", i, ":"
           call object%entry(i)%write_config (u, pacified)
        end do
     end if
     call write_separator (u, 2)
   end subroutine simulation_write
 
 @ %def simulation_write
 @ Write the current event record.  If an explicit index is given,
 write that event record.
 
 We implement writing to [[unit]] (event contents / debugging format)
 and writing to an [[eio]] event stream (storage). We include a [[testflag]]
 in order to suppress numerical noise in the testsuite.
 <<Simulations: simulation: TBP>>=
   generic :: write_event => write_event_unit
   procedure :: write_event_unit => simulation_write_event_unit
 <<Simulations: procedures>>=
   subroutine simulation_write_event_unit &
        (object, unit, i_prc, verbose, testflag)
     class(simulation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer, intent(in), optional :: i_prc
     logical, intent(in), optional :: testflag
     logical :: pacified
     integer :: current
     pacified = .false.;  if (present(testflag)) pacified = testflag
     pacified = pacified .or. object%pacify
     if (present (i_prc)) then
        current = i_prc
     else
        current = object%i_prc
     end if
     if (current > 0) then
        call object%entry(current)%write (unit, verbose = verbose, &
             testflag = pacified)
     else
        call msg_fatal ("Simulation: write event: no process selected")
     end if
   end subroutine simulation_write_event_unit
 
 @ %def simulation_write_event
 @ This writes one of the alternate events, if allocated.
 <<Simulations: simulation: TBP>>=
   procedure :: write_alt_event => simulation_write_alt_event
 <<Simulations: procedures>>=
   subroutine simulation_write_alt_event (object, unit, j_alt, i_prc, &
        verbose, testflag)
     class(simulation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: j_alt
     integer, intent(in), optional :: i_prc
     logical, intent(in), optional :: verbose
     logical, intent(in), optional :: testflag
     integer :: i, j
     if (present (j_alt)) then
        j = j_alt
     else
        j = 1
     end if
     if (present (i_prc)) then
        i = i_prc
     else
        i = object%i_prc
     end if
     if (i > 0) then
        if (j> 0 .and. j <= object%n_alt) then
           call object%alt_entry(i,j)%write (unit, verbose = verbose, &
                testflag = testflag)
        else
           call msg_fatal ("Simulation: write alternate event: out of range")
        end if
     else
        call msg_fatal ("Simulation: write alternate event: no process selected")
     end if
   end subroutine simulation_write_alt_event
 
 @ %def simulation_write_alt_event
 @ This writes the contents of the resonant subprocess set in the current event
 record.
 <<Simulations: simulation: TBP>>=
   procedure :: write_resonant_subprocess_data &
        => simulation_write_resonant_subprocess_data
 <<Simulations: procedures>>=
   subroutine simulation_write_resonant_subprocess_data (object, unit, i_prc)
     class(simulation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: i_prc
     integer :: i
     if (present (i_prc)) then
        i = i_prc
     else
        i = object%i_prc
     end if
     call object%entry(i)%write_resonant_subprocess_data (unit)
   end subroutine simulation_write_resonant_subprocess_data
 
 @ %def simulation_write_resonant_subprocess_data
 @ The same for the master process, as an additional debugging aid.
 <<Simulations: simulation: TBP>>=
   procedure :: write_process_data &
        => simulation_write_process_data
 <<Simulations: procedures>>=
   subroutine simulation_write_process_data &
        (object, unit, i_prc, &
        show_process, show_instance, verbose)
     class(simulation_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: i_prc
     logical, intent(in), optional :: show_process
     logical, intent(in), optional :: show_instance
     logical, intent(in), optional :: verbose
     integer :: i
     if (present (i_prc)) then
        i = i_prc
     else
        i = object%i_prc
     end if
     call object%entry(i)%write_process_data &
          (unit, show_process, show_instance, verbose)
   end subroutine simulation_write_process_data
 
 @ %def simulation_write_process_data
 @ Finalizer.
 <<Simulations: simulation: TBP>>=
   procedure :: final => simulation_final
 <<Simulations: procedures>>=
   subroutine simulation_final (object)
     class(simulation_t), intent(inout) :: object
     integer :: i, j
     if (allocated (object%entry)) then
        do i = 1, size (object%entry)
           call object%entry(i)%final ()
        end do
     end if
     if (allocated (object%alt_entry)) then
        do j = 1, size (object%alt_entry, 2)
           do i = 1, size (object%alt_entry, 1)
              call object%alt_entry(i,j)%final ()
           end do
        end do
     end if
     if (allocated (object%rng))  call object%rng%final ()
   end subroutine simulation_final
 
 @ %def simulation_final
 @ Initialization.  We can deduce all data from the given list of
 process IDs and the global data set.  The process objects are taken
 from the stack.  Once the individual integrals are known, we add them (and the
 errors), to get the sample integral.
 
 If there are alternative environments, we suspend initialization for
 setting up alternative process objects, then restore the master
 process and its parameters.  The generator or rescanner can then
 switch rapidly between processes.
 
 If [[integrate]] is set, we make sure that all affected processes are
 integrated before simulation.  This is necessary if we want to actually
 generate events.  If [[integrate]] is unset, we don't need the integral
 because we just rescan existing events.  In that case, we just need compiled
 matrix elements.
 
 If [[generate]] is set, we prepare for actually generating events.  Otherwise,
 we may only read and rescan events.
 <<Simulations: simulation: TBP>>=
   procedure :: init => simulation_init
 <<Simulations: procedures>>=
   subroutine simulation_init (simulation, &
        process_id, integrate, generate, local, global, alt_env)
     class(simulation_t), intent(out), target :: simulation
     type(string_t), dimension(:), intent(in) :: process_id
     logical, intent(in) :: integrate, generate
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), optional, target :: global
     type(rt_data_t), dimension(:), intent(inout), optional, target :: alt_env
     class(rng_factory_t), allocatable :: rng_factory
     type(string_t) :: norm_string, version_string
     logical :: use_process
     integer :: i, j
     type(string_t) :: sample_suffix
   <<Simulations: simulation init: variables>>
     sample_suffix = ""
   <<Simulations: simulation init: init>>
     simulation%local => local
     simulation%sample_id = &
          local%get_sval (var_str ("$sample")) // sample_suffix
     simulation%unweighted = &
          local%get_lval (var_str ("?unweighted"))
     simulation%negative_weights = &
          local%get_lval (var_str ("?negative_weights"))
     simulation%support_resonance_history = &
          local%get_lval (var_str ("?resonance_history"))
     simulation%respect_selection = &
          local%get_lval (var_str ("?sample_select"))
     version_string = &
          local%get_sval (var_str ("$event_file_version"))
     norm_string = &
          local%get_sval (var_str ("$sample_normalization"))
     simulation%norm_mode = &
          event_normalization_mode (norm_string, simulation%unweighted)
     simulation%pacify = &
          local%get_lval (var_str ("?sample_pacify"))
     simulation%event_index_offset = &
          local%get_ival (var_str ("event_index_offset"))
     simulation%n_max_tries = &
          local%get_ival (var_str ("sample_max_tries"))
     simulation%split_n_evt = &
          local%get_ival (var_str ("sample_split_n_evt"))
     simulation%split_n_kbytes = &
          local%get_ival (var_str ("sample_split_n_kbytes"))
     simulation%split_index = &
          local%get_ival (var_str ("sample_split_index"))
     simulation%update_sqme = &
          local%get_lval (var_str ("?update_sqme"))
     simulation%update_weight = &
          local%get_lval (var_str ("?update_weight"))
     simulation%update_event = &
          local%get_lval (var_str ("?update_event"))
     simulation%recover_beams = &
          local%get_lval (var_str ("?recover_beams"))
     simulation%counter%reproduce_xsection = &
          local%get_lval (var_str ("?check_event_weights_against_xsection"))
     use_process = &
          integrate .or. generate &
          .or. simulation%update_sqme &
          .or. simulation%update_weight &
          .or. simulation%update_event &
          .or. present (alt_env)
     select case (size (process_id))
     case (0)
        call msg_error ("Simulation: no process selected")
     case (1)
        write (msg_buffer, "(A,A,A)") &
             "Starting simulation for process '", &
             char (process_id(1)), "'"
        call msg_message ()
     case default
        write (msg_buffer, "(A,A,A)") &
             "Starting simulation for processes '", &
             char (process_id(1)), "' etc."
        call msg_message ()
     end select
     select case (char (version_string))
     case ("", "2.2.4")
        simulation%version = 2
     case ("2.2")
        simulation%version = 1
     case default
        simulation%version = 0
     end select
     if (simulation%version == 0) then
        call msg_fatal ("Event file format '" &
             // char (version_string) &
             // "' is not compatible with this version.")
     end if
     simulation%n_prc = size (process_id)
     allocate (simulation%entry (simulation%n_prc))
     if (present (alt_env)) then
        simulation%n_alt = size (alt_env)
        do i = 1, simulation%n_prc
           call simulation%entry(i)%init (process_id(i), &
                use_process, integrate, generate, &
                simulation%update_sqme, &
                simulation%support_resonance_history, &
                local, global, simulation%n_alt)
           if (signal_is_pending ())  return
        end do
        simulation%valid = any (simulation%entry%valid)
        if (.not. simulation%valid) then
           call msg_error ("Simulate: no process has a valid matrix element.")
           return
        end if
        call simulation%update_processes ()
        allocate (simulation%alt_entry (simulation%n_prc, simulation%n_alt))
        allocate (simulation%md5sum_alt (simulation%n_alt))
        simulation%md5sum_alt = ""
        do j = 1, simulation%n_alt
           do i = 1, simulation%n_prc
              call simulation%alt_entry(i,j)%init_alt (process_id(i), &
                   simulation%entry(i)%get_process_ptr (), alt_env(j))
              if (signal_is_pending ())  return
           end do
        end do
        call simulation%restore_processes ()
     else
        do i = 1, simulation%n_prc
           call simulation%entry(i)%init &
                (process_id(i), &
                use_process, integrate, generate, &
                simulation%update_sqme, &
                simulation%support_resonance_history, &
                local, global)
           call simulation%entry(i)%determine_if_powheg_matching ()
           if (signal_is_pending ())  return
           if (simulation%entry(i)%is_nlo ()) &
                call simulation%entry(i)%setup_additional_entries ()
        end do
        simulation%valid = any (simulation%entry%valid)
        if (.not. simulation%valid) then
           call msg_error ("Simulate: " &
                // "no process has a valid matrix element.")
           return
        end if
     end if
 !!! if this becomes conditional, some ref files will need update (seed change)
 !    if (generate) then
        call dispatch_rng_factory (rng_factory, local%var_list)
        call rng_factory%make (simulation%rng)
 !    end if
     if (all (simulation%entry%has_integral)) then
        simulation%integral = sum (simulation%entry%integral)
        simulation%error = sqrt (sum (simulation%entry%error ** 2))
        simulation%has_integral = .true.
        if (integrate .and. generate) then
           do i = 1, simulation%n_prc
              if (simulation%entry(i)%integral < 0 .and. .not. &
                   simulation%negative_weights) then
                 call msg_fatal ("Integral of process '" // &
                      char (process_id (i)) // "'is negative.")
              end if
           end do
        end if
     else
        if (integrate .and. generate) &
             call msg_error ("Simulation contains undefined integrals.")
     end if
     if (simulation%integral > 0 .or. &
          (simulation%integral < 0 .and. simulation%negative_weights)) then
        simulation%valid = .true.
     else if (generate) then
        call msg_error ("Simulate: " &
             // "sum of process integrals must be positive; skipping.")
        simulation%valid = .false.
     else
        simulation%valid = .true.
     end if
     if (simulation%valid)  call simulation%compute_md5sum ()
   end subroutine simulation_init
 
 @ %def simulation_init
 @
 <<MPI: Simulations: simulation init: variables>>=
   integer :: rank, n_size
 @
 <<MPI: Simulations: simulation init: init>>=
   call mpi_get_comm_id (n_size, rank)
   if (n_size > 1) then
      sample_suffix = var_str ("_") // str (rank)
   end if
 @
 @ The number of events that we want to simulate is determined by the
 settings of [[n_events]], [[luminosity]], and [[?unweighted]].  For
 weighted events, we take [[n_events]] at face value as the number of
 matrix element calls.  For unweighted events, if the process is a
 decay, [[n_events]] is the number of unweighted events.  In these
 cases, the luminosity setting is ignored.
 
 For unweighted events with a scattering process, we calculate the
 event number that corresponds to the luminosity, given the current
 value of the integral.  We then compare this with [[n_events]] and
 choose the larger number.
 <<Simulations: simulation: TBP>>=
   procedure :: compute_n_events => simulation_compute_n_events
 <<Simulations: procedures>>=
   subroutine simulation_compute_n_events (simulation, n_events, var_list)
     class(simulation_t), intent(in) :: simulation
     integer, intent(out) :: n_events
     type(var_list_t) :: var_list
     real(default) :: lumi, x_events_lumi
     integer :: n_events_lumi
     logical :: is_scattering
     n_events = &
          var_list%get_ival (var_str ("n_events"))
     lumi = &
          var_list%get_rval (var_str ("luminosity"))
     if (simulation%unweighted) then
        is_scattering = simulation%entry(1)%n_in == 2
        if (is_scattering) then
           x_events_lumi = abs (simulation%integral * lumi)
           if (x_events_lumi < huge (n_events)) then
              n_events_lumi = nint (x_events_lumi)
           else
              call msg_message ("Simulation: luminosity too large, &
                   &limiting number of events")
              n_events_lumi = huge (n_events)
           end if
           if (n_events_lumi > n_events) then
              call msg_message ("Simulation: using n_events as computed from &
                   &luminosity value")
              n_events = n_events_lumi
           else
              write (msg_buffer, "(A,1x,I0)") &
                   "Simulation: requested number of events =", n_events
              call msg_message ()
              if (.not. vanishes (simulation%integral)) then
                 write (msg_buffer, "(A,1x,ES11.4)") &
                      "            corr. to luminosity [fb-1] = ", &
                      n_events / simulation%integral
                 call msg_message ()
              end if
           end if
        end if
     end if
   end subroutine simulation_compute_n_events
 
 @ %def simulation_compute_n_events
 @ Write the actual efficiency of the simulation run.  We get the total
 number of events stored in the simulation counter and compare this
 with the total number of calls stored in the event entries.
 
 In order not to miscount samples that are partly read from file, use
 the [[generated]] counter, not the [[total]] counter.
 <<Simulations: simulation: TBP>>=
   procedure :: show_efficiency => simulation_show_efficiency
 <<Simulations: procedures>>=
   subroutine simulation_show_efficiency (simulation)
     class(simulation_t), intent(inout) :: simulation
     integer :: n_events, n_calls
     real(default) :: eff
     n_events = simulation%counter%generated
     n_calls = sum (simulation%entry%get_actual_calls_total ())
     if (n_calls > 0) then
        eff = real (n_events, kind=default) / n_calls
        write (msg_buffer, "(A,1x,F6.2,1x,A)") &
             "Events: actual unweighting efficiency =", 100 * eff, "%"
        call msg_message ()
     end if
   end subroutine simulation_show_efficiency
 
 @ %def simulation_show_efficiency
 @
 <<Simulations: simulation: TBP>>=
   procedure :: get_n_nlo_entries => simulation_get_n_nlo_entries
 <<Simulations: procedures>>=
   function simulation_get_n_nlo_entries (simulation, i_prc) result (n_extra)
     class(simulation_t), intent(in) :: simulation
     integer, intent(in) :: i_prc
     integer :: n_extra
     n_extra = simulation%entry(i_prc)%count_nlo_entries ()
   end function simulation_get_n_nlo_entries
 
 @ %def simulation_get_n_nlo_entries
 @ Compute the checksum of the process set.  We retrieve the MD5 sums
 of all processes.  This depends only on the process definitions, while
 parameters are not considered.  The configuration checksum is
 retrieved from the MCI records in the process objects and furthermore
 includes beams, parameters, integration results, etc., so matching the
 latter should guarantee identical physics.
 <<Simulations: simulation: TBP>>=
   procedure :: compute_md5sum => simulation_compute_md5sum
 <<Simulations: procedures>>=
   subroutine simulation_compute_md5sum (simulation)
     class(simulation_t), intent(inout) :: simulation
     type(process_t), pointer :: process
     type(string_t) :: buffer
     integer :: j, i, n_mci, i_mci, n_component, i_component
     if (simulation%md5sum_prc == "") then
        buffer = ""
        do i = 1, simulation%n_prc
           if (.not. simulation%entry(i)%valid) cycle
           process => simulation%entry(i)%get_process_ptr ()
           if (associated (process)) then
              n_component = process%get_n_components ()
              do i_component = 1, n_component
                 if (process%has_matrix_element (i_component)) then
                    buffer = buffer // process%get_md5sum_prc (i_component)
                 end if
              end do
           end if
        end do
        simulation%md5sum_prc = md5sum (char (buffer))
     end if
     if (simulation%md5sum_cfg == "") then
        buffer = ""
        do i = 1, simulation%n_prc
           if (.not. simulation%entry(i)%valid) cycle
           process => simulation%entry(i)%get_process_ptr ()
           if (associated (process)) then
              n_mci = process%get_n_mci ()
              do i_mci = 1, n_mci
                 buffer = buffer // process%get_md5sum_mci (i_mci)
              end do
           end if
        end do
        simulation%md5sum_cfg = md5sum (char (buffer))
     end if
     do j = 1, simulation%n_alt
        if (simulation%md5sum_alt(j) == "") then
           buffer = ""
           do i = 1, simulation%n_prc
              process => simulation%alt_entry(i,j)%get_process_ptr ()
              if (associated (process)) then
                 buffer = buffer // process%get_md5sum_cfg ()
              end if
           end do
           simulation%md5sum_alt(j) = md5sum (char (buffer))
        end if
     end do
   end subroutine simulation_compute_md5sum
 
 @ %def simulation_compute_md5sum
 @ Initialize the process selector, using the entry integrals as process
 weights.
 <<Simulations: simulation: TBP>>=
   procedure :: init_process_selector => simulation_init_process_selector
 <<Simulations: procedures>>=
   subroutine simulation_init_process_selector (simulation)
     class(simulation_t), intent(inout) :: simulation
     integer :: i
     if (simulation%has_integral) then
        call simulation%process_selector%init (simulation%entry%integral, &
             negative_weights = simulation%negative_weights)
        do i = 1, simulation%n_prc
           associate (entry => simulation%entry(i))
             if (.not. entry%valid) then
                call msg_warning ("Process '" // char (entry%process_id) // &
                     "': matrix element vanishes, no events can be generated.")
                cycle
             end if
             call entry%init_mci_selector (simulation%negative_weights)
             entry%process_weight = simulation%process_selector%get_weight (i)
           end associate
        end do
     end if
   end subroutine simulation_init_process_selector
 
 @ %def simulation_init_process_selector
 @ Select a process, using the random-number generator.
 <<Simulations: simulation: TBP>>=
   procedure :: select_prc => simulation_select_prc
 <<Simulations: procedures>>=
   function simulation_select_prc (simulation) result (i_prc)
     class(simulation_t), intent(inout) :: simulation
     integer :: i_prc
     call simulation%process_selector%generate (simulation%rng, i_prc)
   end function simulation_select_prc
 
 @ %def simulation_select_prc
 @ Select a MCI set for the selected process.
 <<Simulations: simulation: TBP>>=
   procedure :: select_mci => simulation_select_mci
 <<Simulations: procedures>>=
   function simulation_select_mci (simulation) result (i_mci)
     class(simulation_t), intent(inout) :: simulation
     integer :: i_mci
     i_mci = 0
     if (simulation%i_prc /= 0) then
        i_mci = simulation%entry(simulation%i_prc)%select_mci ()
     end if
   end function simulation_select_mci
 
 @ %def simulation_select_mci
 @ Generate a predefined number of events.  First select a process and
 a component set, then generate an event for that process and factorize
 the quantum state.  The pair of random numbers can be used for
 factorization.
 
 When generating events, we drop all configurations where the event is
 marked as incomplete.  This happens if the event fails cuts.  In fact,
 such events are dropped already by the sampler if unweighting is in
 effect, so this can happen only for weighted events.  By setting a
 limit given by [[sample_max_tries]] (user parameter), we can avoid an
 endless loop.
 
 NB: When reading from file, event transforms can't be applied because the
 process instance will not be complete.  This should be fixed.
 <<Simulations: simulation: TBP>>=
   procedure :: generate => simulation_generate
 <<Simulations: procedures>>=
   subroutine simulation_generate (simulation, n, es_array)
     class(simulation_t), intent(inout), target :: simulation
     integer, intent(in) :: n
     type(event_stream_array_t), intent(inout), optional :: es_array
     type(string_t) :: str1, str2, str3
     logical :: generate_new, passed
     integer :: i, j, k
     type(entry_t), pointer :: current_entry
     integer :: n_events
   <<Simulations: simulation generate: variables>>
     simulation%n_evt_requested = n
     n_events = n * simulation%get_n_nlo_entries (1)
     call simulation%entry%set_n (n)
     if (simulation%n_alt > 0)  call simulation%alt_entry%set_n (n)
     str1 = "Events: generating"
     if (present (es_array)) then
        if (es_array%has_input ())  str1 = "Events: reading"
     end if
     if (simulation%entry(1)%config%unweighted) then
        str2 = "unweighted"
     else
        str2 = "weighted"
     end if
     if (simulation%entry(1)%config%factorization_mode == &
          FM_IGNORE_HELICITY) then
        str3 = ", unpolarized"
     else
        str3 = ", polarized"
     end if
     if (n_events == n) then
        write (msg_buffer, "(A,1x,I0,1x,A,1x,A)")  char (str1), n, &
             char (str2) // char(str3), "events ..."
     else
        write (msg_buffer, "(A,1x,I0,1x,A,1x,A)") char (str1), n_events, &
             char (str2) // char(str3), "NLO events ..."
     end if
     call msg_message ()
     write (msg_buffer, "(A,1x,A)") "Events: event normalization mode", &
          char (event_normalization_string (simulation%norm_mode))
     call msg_message ()
     call simulation%init_event_index ()
   <<Simulations: simulation generate: init>>
     do i = start_it, end_it
        call simulation%increment_event_index ()
        if (present (es_array)) then
           call simulation%read_event (es_array, .true., generate_new)
        else
           generate_new = .true.
        end if
        if (generate_new) then
           simulation%i_prc = simulation%select_prc ()
           simulation%i_mci = simulation%select_mci ()
           associate (entry => simulation%entry(simulation%i_prc))
             entry%instance%i_mci = simulation%i_mci
             call entry%set_active_real_components ()
             current_entry => entry%get_first ()
             do k = 1, current_entry%count_nlo_entries ()
                if (k > 1) then
                   current_entry => current_entry%get_next ()
                   current_entry%particle_set => current_entry%first%particle_set
                   current_entry%particle_set_is_valid &
                      = current_entry%first%particle_set_is_valid
                end if
                do j = 1, simulation%n_max_tries
                   if (.not. current_entry%valid)  call msg_warning &
                           ("Process '" // char (current_entry%process_id) // "': " // &
                           "matrix element vanishes, no events can be generated.")
                   call current_entry%generate (simulation%i_mci, i_nlo = k)
                   if (signal_is_pending ()) return
                   call simulation%counter%record_mean_and_variance &
                        (current_entry%weight_prc, k)
                   if (current_entry%has_valid_particle_set ()) exit
                end do
             end do
             if (entry%is_nlo ()) call entry%reset_nlo_counter ()
             if (.not. entry%has_valid_particle_set ()) then
                write (msg_buffer, "(A,I0,A)")  "Simulation: failed to &
                     &generate valid event after ", &
                     simulation%n_max_tries, " tries (sample_max_tries)"
                call msg_fatal ()
             end if
             current_entry => entry%get_first ()
             do k = 1, current_entry%count_nlo_entries ()
                if (k > 1) current_entry => current_entry%get_next ()
                call current_entry%set_index (simulation%get_event_index ())
                call current_entry%evaluate_expressions ()
             end do
             if (signal_is_pending ()) return
             if (entry%passed_selection ()) then
                simulation%weight = entry%get_weight_ref ()
                simulation%excess = entry%get_excess_prc ()
             end if
             call simulation%counter%record &
                  (simulation%weight, simulation%excess)
             call entry%record (simulation%i_mci)
           end associate
        else
           associate (entry => simulation%entry(simulation%i_prc))
             call simulation%set_event_index (entry%get_index ())
             call entry%accept_sqme_ref ()
             call entry%accept_weight_ref ()
             call entry%check ()
             call entry%evaluate_expressions ()
             if (signal_is_pending ()) return
             if (entry%passed_selection ()) then
                simulation%weight = entry%get_weight_ref ()
                simulation%excess = entry%get_excess_prc ()
             end if
             call simulation%counter%record &
                  (simulation%weight, simulation%excess, from_file=.true.)
             call entry%record (simulation%i_mci, from_file=.true.)
           end associate
        end if
        call simulation%calculate_alt_entries ()
        if (signal_is_pending ()) return
        if (simulation%pacify)  call pacify (simulation)
        if (simulation%respect_selection) then
           passed = simulation%entry(simulation%i_prc)%passed_selection ()
        else
           passed = .true.
        end if
        if (present (es_array)) then
           call simulation%write_event (es_array, passed)
        end if
     end do
   <<Simulations: simulation generate: finalize>>
     call msg_message ("        ... event sample complete.")
     if (simulation%unweighted)  call simulation%show_efficiency ()
     call simulation%counter%show_excess ()
     call simulation%counter%show_mean_and_variance ()
   end subroutine simulation_generate
 
 @ %def simulation_generate
 @
 <<Simulations: simulation generate: variables>>=
   integer :: start_it, end_it
 @
 <<Simulations: simulation generate: init>>=
   start_it = 1
   end_it = n
 @
 <<Simulations: simulation generate: finalize>>=
 @
 <<MPI: Simulations: simulation generate: variables>>=
   integer :: n_size, rank
   integer :: worker_n_events, root_n_events
 <<MPI: Simulations: simulation generate: init>>=
   call mpi_get_comm_id (n_size, rank)
   if (n_size > 1) then
      start_it = start_it + nint (rank * (real (n) / n_size))
      end_it = min (nint ((rank + 1) * (real (n) / n_size)), n)
      write (msg_buffer, "(A,I0,A,I0,A)") &
           & "MPI: generate events [", start_it, ":", end_it, "]"
      call msg_message ()
      do i = 1, rank + 1
         select type (rng => simulation%rng)
         type is (rng_stream_t)
            call rng%next_substream ()
         end select
      end do
   end if
 @
 <<MPI: Simulations: simulation generate: finalize>>=
   call MPI_Barrier (MPI_COMM_WORLD)
   if (n_size > 1) then
      worker_n_events = end_it - start_it + 1
      call MPI_Reduce (worker_n_events, root_n_events, 1, MPI_INTEGER, MPI_SUM,&
           & 0, MPI_COMM_WORLD)
      if (rank == 0) then
         write (msg_buffer, "(A,I0)") "MPI: Number of generated events in world = ", root_n_events
         call msg_message ()
      end if
   end if
 @
 @ Compute the event matrix element and weight for all alternative
 environments, given the current event and selected process.  We first
 copy the particle set, then temporarily update the process core with
 local parameters, recalculate everything, and restore the process
 core.
 
 The event weight is obtained by rescaling the original event weight with the
 ratio of the new and old [[sqme]] values.  (In particular, if the old
 value was zero, the weight will stay zero.)
 
 Note: this may turn out to be inefficient because we always replace
 all parameters and recalculate everything, once for each event and
 environment.  However, a more fine-grained control requires more
 code.  In any case, while we may keep multiple process cores (which
 stay constant for a simulation run), we still have to update the
 external matrix element parameters event by event.  The matrix element
 ``object'' is present only once.
 <<Simulations: simulation: TBP>>=
   procedure :: calculate_alt_entries => simulation_calculate_alt_entries
 <<Simulations: procedures>>=
   subroutine simulation_calculate_alt_entries (simulation)
     class(simulation_t), intent(inout) :: simulation
     real(default) :: factor
     real(default), dimension(:), allocatable :: sqme_alt, weight_alt
     integer :: n_alt, i, j
     i = simulation%i_prc
     n_alt = simulation%n_alt
     if (n_alt == 0)  return
     allocate (sqme_alt (n_alt), weight_alt (n_alt))
     associate (entry => simulation%entry(i))
       do j = 1, n_alt
          if (signal_is_pending ())  return
          factor = entry%get_kinematical_weight ()
          associate (alt_entry => simulation%alt_entry(i,j))
            call alt_entry%update_process ()
            call alt_entry%select &
                 (entry%get_i_mci (), entry%get_i_term (), entry%get_channel ())
            call alt_entry%fill_particle_set (entry)
            call alt_entry%recalculate &
                 (update_sqme = .true., weight_factor = factor)
            if (signal_is_pending ())  return
            call alt_entry%accept_sqme_prc ()
            call alt_entry%update_normalization ()
            call alt_entry%accept_weight_prc ()
            call alt_entry%check ()
            call alt_entry%set_index (simulation%get_event_index ())
            call alt_entry%evaluate_expressions ()
            if (signal_is_pending ())  return
            call alt_entry%restore_process ()
            sqme_alt(j) = alt_entry%get_sqme_ref ()
            if (alt_entry%passed_selection ()) then
               weight_alt(j) = alt_entry%get_weight_ref ()
            end if
          end associate
       end do
       call entry%set (sqme_alt = sqme_alt, weight_alt = weight_alt)
       call entry%check ()
       call entry%store_alt_values ()
     end associate
   end subroutine simulation_calculate_alt_entries
 
 @ %def simulation_calculate_alt_entries
 @ Rescan an undefined number of events.
 
 If [[update_event]] or [[update_sqme]] is set, we have to recalculate the
 event, starting from the particle set.  If the latter is set, this includes
 the squared matrix element (i.e., the amplitude is evaluated).  Otherwise,
 only kinematics and observables derived from it are recovered.
 
 If any of the update flags is set, we will come up with separate
 [[sqme_prc]] and [[weight_prc]] values.  (The latter is only distinct
 if [[update_weight]] is set.)  Otherwise, we accept the reference values.
 <<Simulations: simulation: TBP>>=
   procedure :: rescan => simulation_rescan
 <<Simulations: procedures>>=
   subroutine simulation_rescan (simulation, n, es_array, global)
     class(simulation_t), intent(inout) :: simulation
     integer, intent(in) :: n
     type(event_stream_array_t), intent(inout) :: es_array
     type(rt_data_t), intent(inout) :: global
     type(qcd_t) :: qcd
     type(string_t) :: str1, str2, str3
     logical :: complete
     str1 = "Rescanning"
     if (simulation%entry(1)%config%unweighted) then
        str2 = "unweighted"
     else
        str2 = "weighted"
     end if
     simulation%n_evt_requested = n
     call simulation%entry%set_n (n)
     if (simulation%update_sqme .or. simulation%update_weight) then
        call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
        call simulation%update_processes &
             (global%model, qcd, global%get_helicity_selection ())
        str3 = "(process parameters updated) "
     else
        str3 = ""
     end if
     write (msg_buffer, "(A,1x,A,1x,A,A,A)")  char (str1), char (str2), &
          "events ", char (str3), "..."
     call msg_message ()
     call simulation%init_event_index ()
     do
        call simulation%increment_event_index ()
        call simulation%read_event (es_array, .false., complete)
        if (complete)  exit
        if (simulation%update_event &
             .or. simulation%update_sqme &
             .or. simulation%update_weight) then
           call simulation%recalculate ()
           if (signal_is_pending ())  return
           associate (entry => simulation%entry(simulation%i_prc))
             call entry%update_normalization ()
             if (simulation%update_event) then
                call entry%evaluate_transforms ()
             end if
             call entry%check ()
             call entry%evaluate_expressions ()
             if (signal_is_pending ())  return
             simulation%weight = entry%get_weight_prc ()
             call simulation%counter%record (simulation%weight, from_file=.true.)
             call entry%record (simulation%i_mci, from_file=.true.)
           end associate
        else
           associate (entry => simulation%entry(simulation%i_prc))
             call entry%accept_sqme_ref ()
             call entry%accept_weight_ref ()
             call entry%check ()
             call entry%evaluate_expressions ()
             if (signal_is_pending ())  return
             simulation%weight = entry%get_weight_ref ()
             call simulation%counter%record (simulation%weight, from_file=.true.)
             call entry%record (simulation%i_mci, from_file=.true.)
           end associate
        end if
        call simulation%calculate_alt_entries ()
        if (signal_is_pending ())  return
        call simulation%write_event (es_array)
     end do
     if (simulation%update_sqme .or. simulation%update_weight) then
        call simulation%restore_processes ()
     end if
   end subroutine simulation_rescan
 
 @ %def simulation_rescan
 @ Here we handle the event index that is kept in the simulation record.  The
 event index is valid for the current sample.  When generating or reading
 events, we initialize the index with the offset that the user provides (if any)
 and increment it for each event that is generated or read from file.  The event
 index is stored in the event-entry that is current for the event.  If an
 event on file comes with its own index, that index overwrites the predefined
 one and also resets the index within the simulation record.
 
 The event index is not connected to the [[counter]] object.  The counter is
 supposed to collect statistical information.  The event index is a user-level
 object that is visible in event records and analysis expressions.
 <<Simulations: simulation: TBP>>=
   procedure :: init_event_index => simulation_init_event_index
   procedure :: increment_event_index => simulation_increment_event_index
   procedure :: set_event_index => simulation_set_event_index
   procedure :: get_event_index => simulation_get_event_index
 <<Simulations: procedures>>=
   subroutine simulation_init_event_index (simulation)
     class(simulation_t), intent(inout) :: simulation
     call simulation%set_event_index (simulation%event_index_offset)
   end subroutine simulation_init_event_index
 
   subroutine simulation_increment_event_index (simulation)
     class(simulation_t), intent(inout) :: simulation
     if (simulation%event_index_set) then
        simulation%event_index = simulation%event_index + 1
     end if
   end subroutine simulation_increment_event_index
 
   subroutine simulation_set_event_index (simulation, i)
     class(simulation_t), intent(inout) :: simulation
     integer, intent(in) :: i
     simulation%event_index = i
     simulation%event_index_set = .true.
   end subroutine simulation_set_event_index
 
   function simulation_get_event_index (simulation) result (i)
     class(simulation_t), intent(in) :: simulation
     integer :: i
     if (simulation%event_index_set) then
        i = simulation%event_index
     else
        i = 0
     end if
   end function simulation_get_event_index
 
 @ %def simulation_init_event_index
 @ %def simulation_increment_event_index
 @ %def simulation_set_event_index
 @ %def simulation_get_event_index
 @ 
 @ These routines take care of temporary parameter redefinitions that
 we want to take effect while recalculating the matrix elements.  We
 extract the core(s) of the processes that we are simulating, apply the
 changes, and make sure that the changes are actually used.  This is
 the duty of [[dispatch_core_update]].  When done, we restore the
 original versions using [[dispatch_core_restore]].
 <<Simulations: simulation: TBP>>=
   procedure :: update_processes => simulation_update_processes
   procedure :: restore_processes => simulation_restore_processes
 <<Simulations: procedures>>=
   subroutine simulation_update_processes (simulation, &
        model, qcd, helicity_selection)
     class(simulation_t), intent(inout) :: simulation
     class(model_data_t), intent(in), optional, target :: model
     type(qcd_t), intent(in), optional :: qcd
     type(helicity_selection_t), intent(in), optional :: helicity_selection
     integer :: i
     do i = 1, simulation%n_prc
        call simulation%entry(i)%update_process &
             (model, qcd, helicity_selection)
     end do
   end subroutine simulation_update_processes
 
   subroutine simulation_restore_processes (simulation)
     class(simulation_t), intent(inout) :: simulation
     integer :: i
     do i = 1, simulation%n_prc
        call simulation%entry(i)%restore_process ()
     end do
   end subroutine simulation_restore_processes
 
 @ %def simulation_update_processes
 @ %def simulation_restore_processes
 @
 \subsection{Event Stream I/O}
 Write an event to a generic [[eio]] event stream.  The process index
 must be selected, or the current index must be available.
 <<Simulations: simulation: TBP>>=
   generic :: write_event => write_event_eio
   procedure :: write_event_eio => simulation_write_event_eio
 <<Simulations: procedures>>=
   subroutine simulation_write_event_eio (object, eio, i_prc)
     class(simulation_t), intent(in) :: object
     class(eio_t), intent(inout) :: eio
     integer, intent(in), optional :: i_prc
     logical :: increased
     integer :: current
     if (present (i_prc)) then
        current = i_prc
     else
        current = object%i_prc
     end if
     if (current > 0) then
        if (object%split_n_evt > 0 .and. object%counter%total > 1) then
           if (mod (object%counter%total, object%split_n_evt) == 1) then
              call eio%split_out ()
           end if
        else if (object%split_n_kbytes > 0) then
           call eio%update_split_count (increased)
           if (increased)  call eio%split_out ()
        end if
        call eio%output (object%entry(current)%event_t, current, pacify = object%pacify)
     else
        call msg_fatal ("Simulation: write event: no process selected")
     end if
   end subroutine simulation_write_event_eio
 
 @ %def simulation_write_event
 @
 Read an event from a generic [[eio]] event stream.  The event stream element
 must specify the process within the sample ([[i_prc]]), the MC group for this
 process ([[i_mci]]), the selected term ([[i_term]]), the selected MC
 integration [[channel]], and the particle set of the event.
 
 We may encounter EOF, which we indicate by storing 0 for the process index
 [[i_prc]].  An I/O error will be reported, and we also abort reading.
 <<Simulations: simulation: TBP>>=
   generic :: read_event => read_event_eio
   procedure :: read_event_eio => simulation_read_event_eio
 <<Simulations: procedures>>=
   subroutine simulation_read_event_eio (object, eio)
     class(simulation_t), intent(inout) :: object
     class(eio_t), intent(inout) :: eio
     integer :: iostat, current
     call eio%input_i_prc (current, iostat)
     select case (iostat)
     case (0)
        object%i_prc = current
        call eio%input_event (object%entry(current)%event_t, iostat)
     end select
     select case (iostat)
     case (:-1)
        object%i_prc = 0
        object%i_mci = 0
     case (1:)
        call msg_error ("Reading events: I/O error, aborting read")
        object%i_prc = 0
        object%i_mci = 0
     case default
        object%i_mci = object%entry(current)%get_i_mci ()
     end select
   end subroutine simulation_read_event_eio
 
 @ %def simulation_read_event
 @
 \subsection{Event Stream Array}
 Write an event using an array of event I/O streams.
 The process index must be selected, or the current index must be
 available.
 <<Simulations: simulation: TBP>>=
   generic :: write_event => write_event_es_array
   procedure :: write_event_es_array => simulation_write_event_es_array
 <<Simulations: procedures>>=
   subroutine simulation_write_event_es_array (object, es_array, passed)
     class(simulation_t), intent(in), target :: object
     class(event_stream_array_t), intent(inout) :: es_array
     logical, intent(in), optional :: passed
     integer :: i_prc, event_index
     integer :: i
     type(entry_t), pointer :: current_entry
     i_prc = object%i_prc
     if (i_prc > 0) then
        event_index = object%counter%total
        current_entry => object%entry(i_prc)%get_first ()
        do i = 1, current_entry%count_nlo_entries ()
           if (i > 1) current_entry => current_entry%get_next ()
           call es_array%output (current_entry%event_t, i_prc, &
              event_index, passed = passed, pacify = object%pacify)
        end do
     else
        call msg_fatal ("Simulation: write event: no process selected")
     end if
   end subroutine simulation_write_event_es_array
 
 @ %def simulation_write_event
 @ Read an event using an array of event I/O streams.  Reading is
 successful if there is an input stream within the array, and if a
 valid event can be read from that stream.  If there is a stream, but
 EOF is passed when reading the first item, we switch the channel to
 output and return failure but no error message, such that new events
 can be appended to that stream.
 <<Simulations: simulation: TBP>>=
   generic :: read_event => read_event_es_array
   procedure :: read_event_es_array => simulation_read_event_es_array
 <<Simulations: procedures>>=
   subroutine simulation_read_event_es_array (object, es_array, enable_switch, &
        fail)
     class(simulation_t), intent(inout), target :: object
     class(event_stream_array_t), intent(inout), target :: es_array
     logical, intent(in) :: enable_switch
     logical, intent(out) :: fail
     integer :: iostat, i_prc
     type(entry_t), pointer :: current_entry => null ()
     integer :: i
     if (es_array%has_input ()) then
        fail = .false.
        call es_array%input_i_prc (i_prc, iostat)
        select case (iostat)
        case (0)
           object%i_prc = i_prc
           current_entry => object%entry(i_prc)
           do i = 1, current_entry%count_nlo_entries ()
              if (i > 1) then
                 call es_array%skip_eio_entry (iostat)
                 current_entry => current_entry%get_next ()
              end if
              call current_entry%set_index (object%get_event_index ())
              call es_array%input_event (current_entry%event_t, iostat)
           end do
        case (:-1)
           write (msg_buffer, "(A,1x,I0,1x,A)")  &
                "... event file terminates after", &
                object%counter%read, "events."
           call msg_message ()
           if (enable_switch) then
              call es_array%switch_inout ()
              write (msg_buffer, "(A,1x,I0,1x,A)")  &
                   "Generating remaining ", &
                   object%n_evt_requested - object%counter%read, "events ..."
              call msg_message ()
           end if
           fail = .true.
           return
        end select
        select case (iostat)
        case (0)
           object%i_mci = object%entry(i_prc)%get_i_mci ()
        case default
           write (msg_buffer, "(A,1x,I0,1x,A)")  &
                "Reading events: I/O error, aborting read after", &
                object%counter%read, "events."
           call msg_error ()
           object%i_prc = 0
           object%i_mci = 0
           fail = .true.
        end select
     else
        fail = .true.
     end if
   end subroutine simulation_read_event_es_array
 
 @ %def simulation_read_event
 @
 \subsection{Recover event}
 Recalculate the process instance contents, given an event with known particle
 set.  The indices for MC, term, and channel must be already set.  The
 [[recalculate]] method of the selected entry will import the result
 into [[sqme_prc]] and [[weight_prc]].
 
 If [[recover_phs]] is set (and false), do not attempt any phase-space
 calculation.  Useful if we need only matrix elements (esp. testing); this flag
 is not stored in the simulation record.
 <<Simulations: simulation: TBP>>=
   procedure :: recalculate => simulation_recalculate
 <<Simulations: procedures>>=
   subroutine simulation_recalculate (simulation, recover_phs)
     class(simulation_t), intent(inout) :: simulation
     logical, intent(in), optional :: recover_phs
     integer :: i_prc
     i_prc = simulation%i_prc
     associate (entry => simulation%entry(i_prc))
       if (simulation%update_weight) then
          call entry%recalculate &
               (update_sqme = simulation%update_sqme, &
               recover_beams = simulation%recover_beams, &
               recover_phs = recover_phs, &
               weight_factor = entry%get_kinematical_weight ())
       else
          call entry%recalculate &
               (update_sqme = simulation%update_sqme, &
               recover_beams = simulation%recover_beams, &
               recover_phs = recover_phs)
       end if
     end associate
   end subroutine simulation_recalculate
 
 @ %def simulation_recalculate
 @
 \subsection{Extract contents}
 Return the MD5 sum that summarizes configuration and integration
 (but not the event file).  Used for initializing the event streams.
 <<Simulations: simulation: TBP>>=
   procedure :: get_md5sum_prc => simulation_get_md5sum_prc
   procedure :: get_md5sum_cfg => simulation_get_md5sum_cfg
   procedure :: get_md5sum_alt => simulation_get_md5sum_alt
 <<Simulations: procedures>>=
   function simulation_get_md5sum_prc (simulation) result (md5sum)
     class(simulation_t), intent(in) :: simulation
     character(32) :: md5sum
     md5sum = simulation%md5sum_prc
   end function simulation_get_md5sum_prc
 
   function simulation_get_md5sum_cfg (simulation) result (md5sum)
     class(simulation_t), intent(in) :: simulation
     character(32) :: md5sum
     md5sum = simulation%md5sum_cfg
   end function simulation_get_md5sum_cfg
 
   function simulation_get_md5sum_alt (simulation, i) result (md5sum)
     class(simulation_t), intent(in) :: simulation
     integer, intent(in) :: i
     character(32) :: md5sum
     md5sum = simulation%md5sum_alt(i)
   end function simulation_get_md5sum_alt
 
 @ %def simulation_get_md5sum_prc
 @ %def simulation_get_md5sum_cfg
 @ Return data that may be useful for writing event files.
 
 Usually we can refer to a previously integrated process, for which we
 can fetch a process pointer.  Occasionally, we don't have this because
 we're just rescanning an externally generated file without
 calculation.  For that situation, we generate our local beam data object
 using the current enviroment, or, in simple cases, just fetch the
 necessary data from the process definition and environment.
 <<Simulations: simulation: TBP>>=
   procedure :: get_data => simulation_get_data
 <<Simulations: procedures>>=
   function simulation_get_data (simulation, alt) result (sdata)
     class(simulation_t), intent(in) :: simulation
     logical, intent(in), optional :: alt
     type(event_sample_data_t) :: sdata
     type(process_t), pointer :: process
     type(beam_data_t), pointer :: beam_data
     type(beam_structure_t), pointer :: beam_structure
     type(flavor_t), dimension(:), allocatable :: flv
     integer :: n, i
     logical :: enable_alt, construct_beam_data
     real(default) :: sqrts
     class(model_data_t), pointer :: model
     logical :: decay_rest_frame
     type(string_t) :: process_id
     enable_alt = .true.;  if (present (alt))  enable_alt = alt
     call msg_debug (D_CORE, "simulation_get_data")
     call msg_debug (D_CORE, "alternative setup", enable_alt)
     if (enable_alt) then
        call sdata%init (simulation%n_prc, simulation%n_alt)
        do i = 1, simulation%n_alt
           sdata%md5sum_alt(i) = simulation%get_md5sum_alt (i)
        end do
     else
        call sdata%init (simulation%n_prc)
     end if
     sdata%unweighted = simulation%unweighted
     sdata%negative_weights = simulation%negative_weights
     sdata%norm_mode = simulation%norm_mode
     process => simulation%entry(1)%get_process_ptr ()
     if (associated (process)) then
        beam_data => process%get_beam_data_ptr ()
        construct_beam_data = .false.
     else
        n = simulation%entry(1)%n_in
        sqrts = simulation%local%get_sqrts ()
        beam_structure => simulation%local%beam_structure
        call beam_structure%check_against_n_in (n, construct_beam_data)
        if (construct_beam_data) then
           allocate (beam_data)
           model => simulation%local%model
           decay_rest_frame = &
                simulation%local%get_lval (var_str ("?decay_rest_frame"))
           call beam_data%init_structure (beam_structure, &
                sqrts, model, decay_rest_frame)
        else
           beam_data => null ()
        end if
     end if
     if (associated (beam_data)) then
        n = beam_data%get_n_in ()
        sdata%n_beam = n
        allocate (flv (n))
        flv = beam_data%get_flavor ()
        sdata%pdg_beam(:n) = flv%get_pdg ()
        sdata%energy_beam(:n) = beam_data%get_energy ()
        if (construct_beam_data)  deallocate (beam_data)
     else
        n = simulation%entry(1)%n_in
        sdata%n_beam = n
        process_id = simulation%entry(1)%process_id
        call simulation%local%prclib%get_pdg_in_1 &
             (process_id, sdata%pdg_beam(:n))
        sdata%energy_beam(:n) = sqrts / n
     end if
     do i = 1, simulation%n_prc
        if (.not. simulation%entry(i)%valid) cycle
        process => simulation%entry(i)%get_process_ptr ()
        if (associated (process)) then
           sdata%proc_num_id(i) = process%get_num_id ()
        else
           process_id = simulation%entry(i)%process_id
           sdata%proc_num_id(i) = simulation%local%prclib%get_num_id (process_id)
        end if
        if (sdata%proc_num_id(i) == 0)  sdata%proc_num_id(i) = i
        if (simulation%entry(i)%has_integral) then
           sdata%cross_section(i) = simulation%entry(i)%integral
           sdata%error(i) = simulation%entry(i)%error
        end if
     end do
     sdata%total_cross_section = sum (sdata%cross_section)
     sdata%md5sum_prc = simulation%get_md5sum_prc ()
     sdata%md5sum_cfg = simulation%get_md5sum_cfg ()
     if (simulation%split_n_evt > 0 .or. simulation%split_n_kbytes > 0) then
        sdata%split_n_evt = simulation%split_n_evt
        sdata%split_n_kbytes = simulation%split_n_kbytes
        sdata%split_index = simulation%split_index
     end if
   end function simulation_get_data
 
 @ %def simulation_get_data
 @ Return a default name for the current event sample.  This is the
 process ID of the first process.
 <<Simulations: simulation: TBP>>=
   procedure :: get_default_sample_name => simulation_get_default_sample_name
 <<Simulations: procedures>>=
   function simulation_get_default_sample_name (simulation) result (sample)
     class(simulation_t), intent(in) :: simulation
     type(string_t) :: sample
     type(process_t), pointer :: process
     sample = "whizard"
     if (simulation%n_prc > 0) then
        process => simulation%entry(1)%get_process_ptr ()
        if (associated (process)) then
           sample = process%get_id ()
        end if
     end if
   end function simulation_get_default_sample_name
 
 @ %def simulation_get_default_sample_name
 @
 <<Simulations: simulation: TBP>>=
   procedure :: is_valid => simulation_is_valid
 <<Simulations: procedures>>=
   function simulation_is_valid (simulation) result (valid)
     class(simulation_t), intent(inout) :: simulation
     logical :: valid
     valid = simulation%valid
   end function simulation_is_valid
 
 @ %def simulation_is_valid
 @
 Return the hard-interaction particle set for event entry [[i_prc]].
 <<Simulations: simulation: TBP>>=
   procedure :: get_hard_particle_set => simulation_get_hard_particle_set
 <<Simulations: procedures>>=
   function simulation_get_hard_particle_set (simulation, i_prc) result (pset)
     class(simulation_t), intent(in) :: simulation
     integer, intent(in) :: i_prc
     type(particle_set_t) :: pset
     call simulation%entry(i_prc)%get_hard_particle_set (pset)
   end function simulation_get_hard_particle_set
 
 @ %def simulation_get_hard_particle_set
 @
 \subsection{Auxiliary}
 Call pacify: eliminate numerical noise.
 <<Simulations: public>>=
   public :: pacify
 <<Simulations: interfaces>>=
   interface pacify
      module procedure pacify_simulation
   end interface
 <<Simulations: procedures>>=
   subroutine pacify_simulation (simulation)
     class(simulation_t), intent(inout) :: simulation
     integer :: i, j
     i = simulation%i_prc
     if (i > 0) then
        call pacify (simulation%entry(i))
        do j = 1, simulation%n_alt
           call pacify (simulation%alt_entry(i,j))
        end do
     end if
   end subroutine pacify_simulation
 
 @ %def pacify_simulation
 @ Manually evaluate expressions for the currently selected process.
 This is used only in the unit tests.
 <<Simulations: simulation: TBP>>=
   procedure :: evaluate_expressions => simulation_evaluate_expressions
 <<Simulations: procedures>>=
   subroutine simulation_evaluate_expressions (simulation)
     class(simulation_t), intent(inout) :: simulation
     call simulation%entry(simulation%i_prc)%evaluate_expressions ()
   end subroutine simulation_evaluate_expressions
 
 @ %def simulation_evaluate_expressions
 @ Manually evaluate event transforms for the currently selected
 process.  This is used only in the unit tests.
 <<Simulations: simulation: TBP>>=
   procedure :: evaluate_transforms => simulation_evaluate_transforms
 <<Simulations: procedures>>=
   subroutine simulation_evaluate_transforms (simulation)
     class(simulation_t), intent(inout) :: simulation
     associate (entry => simulation%entry(simulation%i_prc))
       call entry%evaluate_transforms ()
     end associate
   end subroutine simulation_evaluate_transforms
 
 @ %def simulation_evaluate_transforms
 @
 \subsection{Unit tests}
 Test module, followed by the stand-alone unit-test procedures.
 <<[[simulations_ut.f90]]>>=
 <<File header>>
 
 module simulations_ut
   use unit_tests
   use simulations_uti
 
 <<Standard module head>>
 
 <<Simulations: public test>>
 
 contains
 
 <<Simulations: test driver>>
 
 end module simulations_ut
 @ %def simulations_ut
 @
 <<[[simulations_uti.f90]]>>=
 <<File header>>
 
 module simulations_uti
 
   <<Use kinds>>
     use kinds, only: i64
   <<Use strings>>
     use io_units
     use format_defs, only: FMT_10, FMT_12
     use ifiles
     use lexers
     use parser
     use lorentz
     use flavors
     use interactions, only: reset_interaction_counter
     use process_libraries, only: process_library_t
     use prclib_stacks
     use phs_forests
     use event_base, only: generic_event_t
     use event_base, only: event_callback_t
     use particles, only: particle_set_t
     use eio_data
     use eio_base
     use eio_direct, only: eio_direct_t
     use eio_raw
     use eio_ascii
     use eio_dump
     use eio_callback
     use eval_trees
     use model_data, only: model_data_t
     use models
     use rt_data
     use event_streams
     use decays_ut, only: prepare_testbed
     use process, only: process_t
     use process_stacks, only: process_entry_t
     use process_configurations_ut, only: prepare_test_library
     use compilations, only: compile_library
     use integrations, only: integrate_process
 
     use simulations
 
     use restricted_subprocesses_uti, only: prepare_resonance_test_library
 
 <<Standard module head>>
 
 <<Simulations: test declarations>>
 
 <<Simulations: test auxiliary types>>
 
 contains
 
 <<Simulations: tests>>
 
 <<Simulations: test auxiliary>>
 
 end module simulations_uti
 
 @ %def simulations_uti
 @ API: driver for the unit tests below.
 <<Simulations: public test>>=
   public :: simulations_test
 <<Simulations: test driver>>=
   subroutine simulations_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Simulations: execute tests>>
   end subroutine simulations_test
 
 @ %def simulations_test
 @
 \subsubsection{Initialization}
 Initialize a [[simulation_t]] object, including the embedded event records.
 <<Simulations: execute tests>>=
   call test (simulations_1, "simulations_1", &
        "initialization", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_1
 <<Simulations: tests>>=
   subroutine simulations_1 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, procname2
     type(rt_data_t), target :: global
     type(simulation_t), target :: simulation
 
     write (u, "(A)")  "* Test output: simulations_1"
     write (u, "(A)")  "*   Purpose: initialize simulation"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_1a"
     procname1 = "simulation_1p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     procname2 = "sim_extra"
 
     call prepare_test_library (global, libname, 1, [procname2])
     call compile_library (libname, global)
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations2"), is_known = .true.)
 
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_string (var_str ("$sample"), &
          var_str ("sim1"), is_known = .true.)
     call integrate_process (procname2, global, local_stack=.true.)
 
     call simulation%init ([procname1, procname2], .false., .true., global)
     call simulation%init_process_selector ()
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the first process"
     write (u, "(A)")
 
     call simulation%write_event (u, i_prc = 1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_1"
 
   end subroutine simulations_1
 
 @ %def simulations_1
 @
 \subsubsection{Weighted events}
 Generate events for a single process.
 <<Simulations: execute tests>>=
   call test (simulations_2, "simulations_2", &
        "weighted events", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_2
 <<Simulations: tests>>=
   subroutine simulations_2 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1
     type(rt_data_t), target :: global
     type(simulation_t), target :: simulation
     type(event_sample_data_t) :: data
 
     write (u, "(A)")  "* Test output: simulations_2"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_2a"
     procname1 = "simulation_2p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     data = simulation%get_data ()
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate three events"
     write (u, "(A)")
 
     call simulation%generate (3)
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the last event"
     write (u, "(A)")
 
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_2"
 
   end subroutine simulations_2
 
 @ %def simulations_2
 @
 \subsubsection{Unweighted events}
 Generate events for a single process.
 <<Simulations: execute tests>>=
   call test (simulations_3, "simulations_3", &
        "unweighted events", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_3
 <<Simulations: tests>>=
   subroutine simulations_3 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1
     type(rt_data_t), target :: global
     type(simulation_t), target :: simulation
     type(event_sample_data_t) :: data
 
     write (u, "(A)")  "* Test output: simulations_3"
     write (u, "(A)")  "*   Purpose: generate unweighted events &
          &for a single process"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_3a"
     procname1 = "simulation_3p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     data = simulation%get_data ()
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate three events"
     write (u, "(A)")
 
     call simulation%generate (3)
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the last event"
     write (u, "(A)")
 
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_3"
 
   end subroutine simulations_3
 
 @ %def simulations_3
 @
 \subsubsection{Simulating process with structure functions}
 Generate events for a single process.
 <<Simulations: execute tests>>=
   call test (simulations_4, "simulations_4", &
        "process with structure functions", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_4
 <<Simulations: tests>>=
   subroutine simulations_4 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1
     type(rt_data_t), target :: global
     type(flavor_t) :: flv
     type(string_t) :: name
     type(simulation_t), target :: simulation
     type(event_sample_data_t) :: data
 
     write (u, "(A)")  "* Test output: simulations_4"
     write (u, "(A)")  "*   Purpose: generate events for a single process &
          &with structure functions"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_4a"
     procname1 = "simulation_4p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call reset_interaction_counter ()
 
     call flv%init (25, global%model)
     name = flv%get_name ()
 
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     call global%set_string (var_str ("$sample"), &
          var_str ("simulations4"), is_known = .true.)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     data = simulation%get_data ()
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate three events"
     write (u, "(A)")
 
     call simulation%generate (3)
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the last event"
     write (u, "(A)")
 
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_4"
 
   end subroutine simulations_4
 
 @ %def simulations_4
 @
 \subsubsection{Event I/O}
 Generate event for a test process, write to file and reread.
 <<Simulations: execute tests>>=
   call test (simulations_5, "simulations_5", &
        "raw event I/O", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_5
 <<Simulations: tests>>=
   subroutine simulations_5 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     class(eio_t), allocatable :: eio
     type(simulation_t), allocatable, target :: simulation
 
     write (u, "(A)")  "* Test output: simulations_5"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            write to file and reread"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_5a"
     procname1 = "simulation_5p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations5"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations5"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Initialize raw event file"
     write (u, "(A)")
 
     allocate (eio_raw_t :: eio)
     call eio%init_out (sample)
 
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1)
     call simulation%write_event (u)
     call simulation%write_event (eio)
 
     call eio%final ()
     deallocate (eio)
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read the event from file"
     write (u, "(A)")
 
     call global%set_log (var_str ("?update_sqme"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_weight"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
     allocate (eio_raw_t :: eio)
     call eio%init_in (sample)
 
     call simulation%read_event (eio)
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recalculate process instance"
     write (u, "(A)")
 
     call simulation%recalculate ()
     call simulation%evaluate_expressions ()
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_5"
 
   end subroutine simulations_5
 
 @ %def simulations_5
 @
 \subsubsection{Event I/O}
 Generate event for a real process with structure functions, write to file and
 reread.
 <<Simulations: execute tests>>=
   call test (simulations_6, "simulations_6", &
        "raw event I/O with structure functions", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_6
 <<Simulations: tests>>=
   subroutine simulations_6 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     class(eio_t), allocatable :: eio
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     type(string_t) :: name
 
     write (u, "(A)")  "* Test output: simulations_6"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            write to file and reread"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_6"
     procname1 = "simulation_6p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
 
     call flv%init (25, global%model)
     name = flv%get_name ()
 
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations6"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Initialize raw event file"
     write (u, "(A)")
 
     allocate (eio_raw_t :: eio)
     call eio%init_out (sample)
 
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1)
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true., testflag = .true.)
     call simulation%write_event (eio)
 
     call eio%final ()
     deallocate (eio)
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read the event from file"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?update_sqme"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_weight"), &
          .true., is_known = .true.)
 
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
     allocate (eio_raw_t :: eio)
     call eio%init_in (sample)
 
     call simulation%read_event (eio)
     call simulation%write_event (u, verbose = .true., testflag = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recalculate process instance"
     write (u, "(A)")
 
     call simulation%recalculate ()
     call simulation%evaluate_expressions ()
     call simulation%write_event (u, verbose = .true., testflag = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call eio%final ()
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_6"
 
   end subroutine simulations_6
 
 @ %def simulations_6
 @
 \subsubsection{Automatic Event I/O}
 Generate events with raw-format event file as cache: generate, reread,
 append.
 <<Simulations: execute tests>>=
   call test (simulations_7, "simulations_7", &
        "automatic raw event I/O", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_7
 <<Simulations: tests>>=
   subroutine simulations_7 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: empty_string_array
     type(event_sample_data_t) :: data
     type(event_stream_array_t) :: es_array
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     type(string_t) :: name
 
     write (u, "(A)")  "* Test output: simulations_7"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            write to file and reread"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_7"
     procname1 = "simulation_7p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
 
     call flv%init (25, global%model)
     name = flv%get_name ()
 
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations7"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Initialize raw event file"
     write (u, "(A)")
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = simulation%get_md5sum_cfg ()
     call es_array%init (sample, [var_str ("raw")], global, data)
 
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1, es_array)
 
     call es_array%final ()
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")  "* Re-read the event from file and generate another one"
     write (u, "(A)")
 
     call global%set_log (&
          var_str ("?rebuild_events"), .false., is_known = .true.)
 
     call reset_interaction_counter ()
 
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = simulation%get_md5sum_cfg ()
     call es_array%init (sample, empty_string_array, global, data, &
          input = var_str ("raw"))
 
     call simulation%generate (2, es_array)
 
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true.)
 
     call es_array%final ()
     call simulation%final ()
     deallocate (simulation)
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read both events from file"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = simulation%get_md5sum_cfg ()
     call es_array%init (sample, empty_string_array, global, data, &
          input = var_str ("raw"))
 
     call simulation%generate (2, es_array)
 
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call es_array%final ()
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_7"
 
   end subroutine simulations_7
 
 @ %def simulations_7
 @
 \subsubsection{Rescanning Events}
 Generate events and rescan the resulting raw event file.
 <<Simulations: execute tests>>=
   call test (simulations_8, "simulations_8", &
        "rescan raw event file", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_8
 <<Simulations: tests>>=
   subroutine simulations_8 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: empty_string_array
     type(event_sample_data_t) :: data
     type(event_stream_array_t) :: es_array
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     type(string_t) :: name
 
     write (u, "(A)")  "* Test output: simulations_8"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            write to file and rescan"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_8"
     procname1 = "simulation_8p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
 
     call flv%init (25, global%model)
     name = flv%get_name ()
 
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations8"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Initialize raw event file"
     write (u, "(A)")
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = simulation%get_md5sum_cfg ()
     write (u, "(1x,A,A,A)")  "MD5 sum (proc)   = '", data%md5sum_prc, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (config) = '", data%md5sum_cfg, "'"
     call es_array%init (sample, [var_str ("raw")], global, &
          data)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1, es_array)
 
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true., testflag = .true.)
 
     call es_array%final ()
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read the event from file"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     allocate (simulation)
     call simulation%init ([procname1], .false., .false., global)
     call simulation%init_process_selector ()
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = ""
     write (u, "(1x,A,A,A)")  "MD5 sum (proc)   = '", data%md5sum_prc, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (config) = '", data%md5sum_cfg, "'"
     call es_array%init (sample, empty_string_array, global, data, &
          input = var_str ("raw"), input_sample = sample, allow_switch = .false.)
 
     call simulation%rescan (1, es_array, global = global)
 
     write (u, "(A)")
 
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true., testflag = .true.)
 
     call es_array%final ()
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-read again and recalculate"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?update_sqme"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_event"), &
          .true., is_known = .true.)
 
     allocate (simulation)
     call simulation%init ([procname1], .false., .false., global)
     call simulation%init_process_selector ()
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = ""
     write (u, "(1x,A,A,A)")  "MD5 sum (proc)   = '", data%md5sum_prc, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (config) = '", data%md5sum_cfg, "'"
     call es_array%init (sample, empty_string_array, global, data, &
          input = var_str ("raw"), input_sample = sample, allow_switch = .false.)
 
     call simulation%rescan (1, es_array, global = global)
 
     write (u, "(A)")
 
     call pacify (simulation)
     call simulation%write_event (u, verbose = .true., testflag = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call es_array%final ()
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_8"
 
   end subroutine simulations_8
 
 @ %def simulations_8
 @
 \subsubsection{Rescanning Check}
 Generate events and rescan with process mismatch.
 <<Simulations: execute tests>>=
   call test (simulations_9, "simulations_9", &
        "rescan mismatch", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_9
 <<Simulations: tests>>=
   subroutine simulations_9 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     type(string_t), dimension(0) :: empty_string_array
     type(event_sample_data_t) :: data
     type(event_stream_array_t) :: es_array
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     type(string_t) :: name
     logical :: error
 
     write (u, "(A)")  "* Test output: simulations_9"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            write to file and rescan"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_9"
     procname1 = "simulation_9p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("vamp"), is_known = .true.)
     call global%set_log (var_str ("?use_vamp_equivalences"),&
          .true., is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
 
     call flv%init (25, global%model)
     name = flv%get_name ()
 
     call global%beam_structure%init_sf ([name, name], [1])
     call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations9"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize raw event file"
     write (u, "(A)")
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = simulation%get_md5sum_cfg ()
     write (u, "(1x,A,A,A)")  "MD5 sum (proc)   = '", data%md5sum_prc, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (config) = '", data%md5sum_cfg, "'"
     call es_array%init (sample, [var_str ("raw")], global, &
          data)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1, es_array)
 
     call es_array%final ()
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")  "* Initialize event generation for different parameters"
     write (u, "(A)")
 
     call reset_interaction_counter ()
 
     allocate (simulation)
     call simulation%init ([procname1, procname1], .false., .false., global)
     call simulation%init_process_selector ()
 
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Attempt to re-read the events (should fail)"
     write (u, "(A)")
 
     data%md5sum_prc = simulation%get_md5sum_prc ()
     data%md5sum_cfg = ""
     write (u, "(1x,A,A,A)")  "MD5 sum (proc)   = '", data%md5sum_prc, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (config) = '", data%md5sum_cfg, "'"
     call es_array%init (sample, empty_string_array, global, data, &
          input = var_str ("raw"), input_sample = sample, &
          allow_switch = .false., error = error)
 
     write (u, "(1x,A,L1)")  "error = ", error
 
     call simulation%rescan (1, es_array, global = global)
 
     call es_array%final ()
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_9"
 
   end subroutine simulations_9
 
 @ %def simulations_9
 @
 \subsubsection{Alternative weights}
 Generate an event for a single process and reweight it in a
 simultaneous calculation.
 <<Simulations: execute tests>>=
   call test (simulations_10, "simulations_10", &
        "alternative weight", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_10
 <<Simulations: tests>>=
   subroutine simulations_10 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, expr_text
     type(rt_data_t), target :: global
     type(rt_data_t), dimension(1), target :: alt_env
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: pt_weight
     type(simulation_t), target :: simulation
     type(event_sample_data_t) :: data
 
     write (u, "(A)")  "* Test output: simulations_10"
     write (u, "(A)")  "*   Purpose: reweight event"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_pexpr_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_10a"
     procname1 = "simulation_10p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("simulations1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize alternative environment with custom weight"
     write (u, "(A)")
 
     call alt_env(1)%local_init (global)
     call alt_env(1)%activate ()
 
     expr_text = "2"
     write (u, "(A,A)")  "weight = ", char (expr_text)
     write (u, *)
 
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_weight, stream, .true.)
     call stream_final (stream)
     alt_env(1)%pn%weight_expr => pt_weight%get_root_ptr ()
     call alt_env(1)%write_expr (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     call simulation%init ([procname1], .true., .true., global, alt_env=alt_env)
     call simulation%init_process_selector ()
 
     data = simulation%get_data ()
     call data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate an event"
     write (u, "(A)")
 
     call simulation%generate (1)
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the last event"
     write (u, "(A)")
 
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write the event record for the alternative setup"
     write (u, "(A)")
 
     call simulation%write_alt_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     call syntax_model_file_final ()
     call syntax_pexpr_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_10"
 
   end subroutine simulations_10
 
 @ %def simulations_10
 @
 \subsubsection{Decays}
 Generate an event with subsequent partonic decays.
 <<Simulations: execute tests>>=
   call test (simulations_11, "simulations_11", &
        "decay", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_11
 <<Simulations: tests>>=
   subroutine simulations_11 (u)
     integer, intent(in) :: u
     type(rt_data_t), target :: global
     type(prclib_entry_t), pointer :: lib
     type(string_t) :: prefix, procname1, procname2
     type(simulation_t), target :: simulation
 
     write (u, "(A)")  "* Test output: simulations_11"
     write (u, "(A)")  "*   Purpose: apply decay"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize processes"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     allocate (lib)
     call global%add_prclib (lib)
 
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     prefix = "simulation_11"
     procname1 = prefix // "_p"
     procname2 = prefix // "_d"
     call prepare_testbed &
          (global%prclib, global%process_stack, &
          prefix, global%os_data, &
          scattering=.true., decay=.true.)
 
     call global%select_model (var_str ("Test"))
     call global%model%set_par (var_str ("ff"), 0.4_default)
     call global%model%set_par (var_str ("mf"), &
          global%model%get_real (var_str ("ff")) &
          * global%model%get_real (var_str ("ms")))
     call global%model%set_unstable (25, [procname2])
 
     write (u, "(A)")  "* Initialize simulation object"
     write (u, "(A)")
 
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Generate event"
     write (u, "(A)")
 
     call simulation%generate (1)
     call simulation%write (u)
 
     write (u, *)
 
     call simulation%write_event (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
     write (u, "(A)")
 
     call simulation%final ()
     call global%final ()
 
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_11"
 
   end subroutine simulations_11
 
 @ %def simulations_11
 @
 \subsubsection{Split Event Files}
 Generate event for a real process with structure functions and write to file,
 accepting a limit for the number of events per file.
 <<Simulations: execute tests>>=
   call test (simulations_12, "simulations_12", &
        "split event files", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_12
 <<Simulations: tests>>=
   subroutine simulations_12 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     class(eio_t), allocatable :: eio
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     integer :: i_evt
 
     write (u, "(A)")  "* Test output: simulations_12"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            and write to split event files"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_12"
     procname1 = "simulation_12p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%model_set_real (var_str ("ms"), &
          0._default)
 
     call flv%init (25, global%model)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations_12"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
     call global%set_int (var_str ("sample_split_n_evt"), &
          2, is_known = .true.)
     call global%set_int (var_str ("sample_split_index"), &
          42, is_known = .true.)
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     call simulation%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize ASCII event file"
     write (u, "(A)")
 
     allocate (eio_ascii_short_t :: eio)
     select type (eio)
     class is (eio_ascii_t);  call eio%set_parameters ()
     end select
     call eio%init_out (sample, data = simulation%get_data ())
 
     write (u, "(A)")  "* Generate 5 events, distributed among three files"
 
     do i_evt = 1, 5
        call simulation%generate (1)
        call simulation%write_event (eio)
     end do
 
     call eio%final ()
     deallocate (eio)
     call simulation%final ()
     deallocate (simulation)
 
     write (u, *)
     call display_file ("simulations_12.42.short.evt", u)
     write (u, *)
     call display_file ("simulations_12.43.short.evt", u)
     write (u, *)
     call display_file ("simulations_12.44.short.evt", u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_12"
 
   end subroutine simulations_12
 
 @ %def simulations_12
 @ Auxiliary: display file contents.
 <<Simulations: public test auxiliary>>=
   public :: display_file
 <<Simulations: test auxiliary>>=
   subroutine display_file (file, u)
     use io_units, only: free_unit
     character(*), intent(in) :: file
     integer, intent(in) :: u
     character(256) :: buffer
     integer :: u_file
     write (u, "(3A)")  "* Contents of file '", file, "':"
     write (u, *)
     u_file = free_unit ()
     open (u_file, file = file, action = "read", status = "old")
     do
        read (u_file, "(A)", end = 1)  buffer
        write (u, "(A)")  trim (buffer)
     end do
 1   continue
   end subroutine display_file
 
 @ %def display_file
 @
 \subsubsection{Callback}
 Generate events and execute a callback in place of event I/O.
 <<Simulations: execute tests>>=
   call test (simulations_13, "simulations_13", &
        "callback", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_13
 <<Simulations: tests>>=
   subroutine simulations_13 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, procname1, sample
     type(rt_data_t), target :: global
     class(eio_t), allocatable :: eio
     type(simulation_t), allocatable, target :: simulation
     type(flavor_t) :: flv
     integer :: i_evt
     type(simulations_13_callback_t) :: event_callback
 
     write (u, "(A)")  "* Test output: simulations_13"
     write (u, "(A)")  "*   Purpose: generate events for a single process"
     write (u, "(A)")  "*            and execute callback"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize process and integrate"
     write (u, "(A)")
 
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
 
     libname = "simulation_13"
     procname1 = "simulation_13p"
 
     call prepare_test_library (global, libname, 1, [procname1])
     call compile_library (libname, global)
 
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
 
     call global%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known = .true.)
     call global%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call global%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known = .true.)
     call global%set_log (var_str ("?vis_history"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
 
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
 
     call flv%init (25, global%model)
 
     call global%it_list%init ([1], [1000])
 
     call global%set_string (var_str ("$run_id"), &
          var_str ("r1"), is_known = .true.)
     call integrate_process (procname1, global, local_stack=.true.)
 
     write (u, "(A)")  "* Initialize event generation"
     write (u, "(A)")
 
     call global%set_log (var_str ("?unweighted"), &
          .false., is_known = .true.)
     sample = "simulations_13"
     call global%set_string (var_str ("$sample"), &
          sample, is_known = .true.)
 
     allocate (simulation)
     call simulation%init ([procname1], .true., .true., global)
     call simulation%init_process_selector ()
 
     write (u, "(A)")  "* Prepare callback object"
     write (u, "(A)")
 
     event_callback%u = u
     call global%set_event_callback (event_callback)
 
     write (u, "(A)")  "* Initialize callback I/O object"
     write (u, "(A)")
 
     allocate (eio_callback_t :: eio)
     select type (eio)
     class is (eio_callback_t)
        call eio%set_parameters (callback = event_callback, &
             count_interval = 3)
     end select
     call eio%init_out (sample, data = simulation%get_data ())
 
     write (u, "(A)")  "* Generate 7 events, with callback every 3 events"
     write (u, "(A)")
 
     do i_evt = 1, 7
        call simulation%generate (1)
        call simulation%write_event (eio)
     end do
 
     call eio%final ()
     deallocate (eio)
     call simulation%final ()
     deallocate (simulation)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_13"
 
   end subroutine simulations_13
 
 @ %def simulations_13
 @ The callback object and procedure.  In the type extension, we can
 store the output channel [[u]] so we know where to write into.
 <<Simulations: test auxiliary types>>=
   type, extends (event_callback_t) :: simulations_13_callback_t
      integer :: u
    contains
      procedure :: write => simulations_13_callback_write
      procedure :: proc => simulations_13_callback
   end type simulations_13_callback_t
 
 @ %def simulations_13_callback_t
 <<Simulations: test auxiliary>>=
   subroutine simulations_13_callback_write (event_callback, unit)
     class(simulations_13_callback_t), intent(in) :: event_callback
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Hello"
   end subroutine simulations_13_callback_write
 
   subroutine simulations_13_callback (event_callback, i, event)
     class(simulations_13_callback_t), intent(in) :: event_callback
     integer(i64), intent(in) :: i
     class(generic_event_t), intent(in) :: event
     write (event_callback%u, "(A,I0)")  "hello event #", i
   end subroutine simulations_13_callback
 
 @ %def simulations_13_callback_write
 @ %def simulations_13_callback
 @
 \subsubsection{Resonant subprocess setup}
 Prepare a process with resonances and enter resonant subprocesses in
 the simulation object.  Select a kinematics configuration and compute
 probabilities for resonant subprocesses.
 
 The process and its initialization is taken from [[processes_18]], but
 we need a complete \oMega\ matrix element here.
 <<Simulations: execute tests>>=
   call test (simulations_14, "simulations_14", &
        "resonant subprocesses evaluation", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_14
 <<Simulations: tests>>=
   subroutine simulations_14 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, libname_generated
     type(string_t) :: procname
     type(string_t) :: model_name
     type(rt_data_t), target :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(simulation_t), target :: simulation
     type(particle_set_t) :: pset
     type(eio_direct_t) :: eio_in
     type(eio_dump_t) :: eio_out
     real(default) :: sqrts, mw, pp
     real(default), dimension(3) :: p3
     type(vector4_t), dimension(:), allocatable :: p
     real(default), dimension(:), allocatable :: m
     integer :: u_verbose, i
     real(default) :: sqme_proc
     real(default), dimension(:), allocatable :: sqme
     real(default) :: on_shell_limit
     integer, dimension(:), allocatable :: i_array
     real(default), dimension(:), allocatable :: prob_array
 
     write (u, "(A)")  "* Test output: simulations_14"
     write (u, "(A)")  "*   Purpose: construct resonant subprocesses &
          &in the simulation object"
     write (u, "(A)")
 
     write (u, "(A)")  "* Build and load a test library with one process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     libname = "simulations_14_lib"
     procname = "simulations_14_p"
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
     call global%set_log (var_str ("?update_sqme"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_weight"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_event"), &
          .true., is_known = .true.)
 
     model_name = "SM"
     call global%select_model (model_name)
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize simulation object &
          &with resonant subprocesses"
     write (u, "(A)")
 
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
     call global%set_real (var_str ("resonance_on_shell_limit"), &
          10._default, is_known = .true.)
 
     call simulation%init ([procname], &
          integrate=.false., generate=.false., local=global)
 
     call simulation%write_resonant_subprocess_data (u, 1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Resonant subprocesses: generated library"
     write (u, "(A)")
 
     libname_generated = procname // "_R"
     lib => global%prclib_stack%get_library_ptr (libname_generated)
     if (associated (lib))  call lib%write (u, libpath=.false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generated process stack"
     write (u, "(A)")
 
     call global%process_stack%show (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Particle set"
     write (u, "(A)")
 
     pset = simulation%get_hard_particle_set (1)
     call pset%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize object for direct access"
     write (u, "(A)")
 
     call eio_in%init_direct &
          (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 3, &
          pdg = [-11, 11, 1, -2, 24], model=global%model)
     call eio_in%set_selection_indices (1, 1, 1, 1)
 
     sqrts = global%get_rval (var_str ("sqrts"))
     mw = 80._default   ! deliberately slightly different from true mw
     pp = sqrt (sqrts**2 - 4 * mw**2) / 2
 
     allocate (p (5), m (5))
     p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
     m(1) = 0
     p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
     m(2) = 0
     p3(1) = pp/2
     p3(2) = mw/2
     p3(3) = 0
     p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(3) = 0
     p3(2) = -mw/2
     p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
     m(4) = 0
     p(5) = vector4_moving (sqrts/2,-pp, 1)
     m(5) = mw
     call eio_in%set_momentum (p, m**2)
 
     call eio_in%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Transfer and show particle set"
     write (u, "(A)")
 
     call simulation%read_event (eio_in)
     pset = simulation%get_hard_particle_set (1)
     call pset%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* (Re)calculate matrix element"
     write (u, "(A)")
 
     call simulation%recalculate (recover_phs = .false.)
     call simulation%evaluate_transforms ()
 
     write (u, "(A)")  "* Show event with sqme"
     write (u, "(A)")
 
     call eio_out%set_parameters (unit = u, &
          weights = .true., pacify = .true., compressed = .true.)
     call eio_out%init_out (var_str (""))
     call simulation%write_event (eio_out)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write event to separate file &
          &'simulations_14_event_verbose.log'"
 
     u_verbose = free_unit ()
     open (unit = u_verbose, file = "simulations_14_event_verbose.log", &
          status = "replace", action = "write")
     call simulation%write (u_verbose)
     write (u_verbose, *)
     call simulation%write_event (u_verbose, verbose =.true., testflag = .true.)
     close (u_verbose)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_14"
 
   end subroutine simulations_14
 
 @ %def simulations_14
 @
 \subsubsection{Resonant subprocess simulation}
 Prepare a process with resonances and enter resonant subprocesses in
 the simulation object.  Simulate events with selection of resonance
 histories.
 
 The process and its initialization is taken from [[processes_18]], but
 we need a complete \oMega\ matrix element here.
 <<Simulations: execute tests>>=
   call test (simulations_15, "simulations_15", &
        "resonant subprocesses in simulation", &
        u, results)
 <<Simulations: test declarations>>=
   public :: simulations_15
 <<Simulations: tests>>=
   subroutine simulations_15 (u)
     integer, intent(in) :: u
     type(string_t) :: libname, libname_generated
     type(string_t) :: procname
     type(string_t) :: model_name
     type(rt_data_t), target :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     class(model_t), pointer :: model
     class(model_data_t), pointer :: model_data
     type(simulation_t), target :: simulation
     real(default) :: sqrts
     type(eio_dump_t) :: eio_out
     integer :: u_verbose
 
     write (u, "(A)")  "* Test output: simulations_15"
     write (u, "(A)")  "*   Purpose: generate event with resonant subprocess"
     write (u, "(A)")
 
     write (u, "(A)")  "* Build and load a test library with one process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
 
     libname = "simulations_15_lib"
     procname = "simulations_15_p"
 
     call global%global_init ()
     call global%append_log (&
          var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_grids"), .true., intrinsic = .true.)
     call global%append_log (&
          var_str ("?rebuild_events"), .true., intrinsic = .true.)
     call global%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     call global%set_int (var_str ("seed"), &
          0, is_known = .true.)
     call global%set_real (var_str ("sqrts"),&
          1000._default, is_known = .true.)
     call global%set_log (var_str ("?recover_beams"), &
          .false., is_known = .true.)
     call global%set_log (var_str ("?update_sqme"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_weight"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?update_event"), &
          .true., is_known = .true.)
     call global%set_log (var_str ("?resonance_history"), &
          .true., is_known = .true.)
     call global%set_real (var_str ("resonance_on_shell_limit"), &
          10._default, is_known = .true.)
 
     model_name = "SM"
     call global%select_model (model_name)
     allocate (model)
     call model%init_instance (global%model)
     model_data => model
 
     write (u, "(A)")  "* Initialize process library and process"
     write (u, "(A)")
 
     allocate (lib_entry)
     call lib_entry%init (libname)
     lib => lib_entry%process_library_t
     call global%add_prclib (lib_entry)
 
     call prepare_resonance_test_library &
          (lib, libname, procname, model_data, global, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize simulation object &
          &with resonant subprocesses"
     write (u, "(A)")
 
     call global%it_list%init ([1], [1000])
     call simulation%init ([procname], &
          integrate=.true., generate=.true., local=global)
 
     call simulation%write_resonant_subprocess_data (u, 1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate event"
     write (u, "(A)")
 
     call simulation%init_process_selector ()
     call simulation%generate (1)
 
     call eio_out%set_parameters (unit = u, &
          weights = .true., pacify = .true., compressed = .true.)
     call eio_out%init_out (var_str (""))
     call simulation%write_event (eio_out)
 
     write (u, "(A)")
     write (u, "(A)")  "* Write event to separate file &
          &'simulations_15_event_verbose.log'"
 
     u_verbose = free_unit ()
     open (unit = u_verbose, file = "simulations_15_event_verbose.log", &
          status = "replace", action = "write")
     call simulation%write (u_verbose)
     write (u_verbose, *)
     call simulation%write_event (u_verbose, verbose =.true., testflag = .true.)
     close (u_verbose)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call simulation%final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: simulations_15"
 
   end subroutine simulations_15
 
 @ %def simulations_15
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{More Unit Tests}
 
 This chapter collects some procedures for testing that can't be
 provided at the point where the corresponding modules are defined,
 because they use other modules of a different level.
 
 (We should move them back, collecting the high-level functionality in
 init/final hooks that we can set at runtime.)
 
 
 \section{Expression Testing}
 
 Expression objects are part of process and event objects, but the
 process and event object modules should not depend on the
 implementation of expressions.  Here, we collect unit tests that
 depend on expression implementation.
 <<[[expr_tests_ut.f90]]>>=
 <<File header>>
 module expr_tests_ut
 
   use unit_tests
   use expr_tests_uti
 
 <<Standard module head>>
 
 <<Expr tests: public test>>
 
 contains
 
 <<Expr tests: test driver>>
 
 end module expr_tests_ut
 @ %def expr_tests_ut
 @
 <<[[expr_tests_uti.f90]]>>=
 <<File header>>
 
 module expr_tests_uti
 
   <<Use kinds>>
   <<Use strings>>
     use format_defs, only: FMT_12
     use format_utils, only: write_separator
     use os_interface
     use sm_qcd
     use lorentz
     use ifiles
     use lexers
     use parser
     use model_data
     use interactions, only: reset_interaction_counter
     use process_libraries
     use subevents
     use subevt_expr
     use rng_base
     use mci_base
     use phs_base
     use variables, only: var_list_t
     use eval_trees
     use models
     use prc_core
     use prc_test
     use process, only: process_t
     use instances, only: process_instance_t
     use events
 
     use rng_base_ut, only: rng_test_factory_t
     use phs_base_ut, only: phs_test_config_t
 
 <<Standard module head>>
 
 <<Expr tests: test declarations>>
 
 contains
 
 <<Expr tests: tests>>
 
 end module expr_tests_uti
 
 @ %def expr_tests_uti
 @
 \subsection{Test}
 This is the master for calling self-test procedures.
 <<Expr tests: public test>>=
   public :: subevt_expr_test
 <<Expr tests: test driver>>=
   subroutine subevt_expr_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Expr tests: execute tests>>
 end subroutine subevt_expr_test
 
 @ %def subevt_expr_test
 @
 \subsubsection{Parton-event expressions}
 <<Expr tests: execute tests>>=
   call test (subevt_expr_1, "subevt_expr_1", &
        "parton-event expressions", &
        u, results)
 <<Expr tests: test declarations>>=
   public :: subevt_expr_1
 <<Expr tests: tests>>=
   subroutine subevt_expr_1 (u)
     integer, intent(in) :: u
     type(string_t) :: expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: pt_cuts, pt_scale, pt_fac_scale, pt_ren_scale
     type(parse_tree_t) :: pt_weight
     type(parse_node_t), pointer :: pn_cuts, pn_scale, pn_fac_scale, pn_ren_scale
     type(parse_node_t), pointer :: pn_weight
     type(eval_tree_factory_t) :: expr_factory
     type(os_data_t) :: os_data
     type(model_t), target :: model
     type(parton_expr_t), target :: expr
     real(default) :: E, Ex, m
     type(vector4_t), dimension(6) :: p
     integer :: i, pdg
     logical :: passed
     real(default) :: scale, fac_scale, ren_scale, weight
 
     write (u, "(A)")  "* Test output: subevt_expr_1"
     write (u, "(A)")  "*   Purpose: Set up a subevt and associated &
          &process-specific expressions"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
 
     call syntax_model_file_init ()
     call os_data_init (os_data)
     call model%read (var_str ("Test.mdl"), os_data)
 
     write (u, "(A)")  "* Expression texts"
     write (u, "(A)")
 
 
     expr_text = "all Pt > 100 [s]"
     write (u, "(A,A)")  "cuts = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (pt_cuts, stream, .true.)
     call stream_final (stream)
     pn_cuts => pt_cuts%get_root_ptr ()
 
     expr_text = "sqrts"
     write (u, "(A,A)")  "scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_scale, stream, .true.)
     call stream_final (stream)
     pn_scale => pt_scale%get_root_ptr ()
 
     expr_text = "sqrts_hat"
     write (u, "(A,A)")  "fac_scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_fac_scale, stream, .true.)
     call stream_final (stream)
     pn_fac_scale => pt_fac_scale%get_root_ptr ()
 
     expr_text = "100"
     write (u, "(A,A)")  "ren_scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_ren_scale, stream, .true.)
     call stream_final (stream)
     pn_ren_scale => pt_ren_scale%get_root_ptr ()
 
     expr_text = "n_tot - n_in - n_out"
     write (u, "(A,A)")  "weight = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_weight, stream, .true.)
     call stream_final (stream)
     pn_weight => pt_weight%get_root_ptr ()
 
     call ifile_final (ifile)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize process expr"
     write (u, "(A)")
 
     call expr%setup_vars (1000._default)
     call expr%var_list%append_real (var_str ("tolerance"), 0._default)
     call expr%link_var_list (model%get_var_list_ptr ())
 
     call expr_factory%init (pn_cuts)
     call expr%setup_selection (expr_factory)
     call expr_factory%init (pn_scale)
     call expr%setup_scale (expr_factory)
     call expr_factory%init (pn_fac_scale)
     call expr%setup_fac_scale (expr_factory)
     call expr_factory%init (pn_ren_scale)
     call expr%setup_ren_scale (expr_factory)
     call expr_factory%init (pn_weight)
     call expr%setup_weight (expr_factory)
 
     call write_separator (u)
     call expr%write (u)
     call write_separator (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Fill subevt and evaluate expressions"
     write (u, "(A)")
 
     call subevt_init (expr%subevt_t, 6)
     E = 500._default
     Ex = 400._default
     m = 125._default
     pdg = 25
     p(1) = vector4_moving (E, sqrt (E**2 - m**2), 3)
     p(2) = vector4_moving (E, -sqrt (E**2 - m**2), 3)
     p(3) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 3)
     p(4) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 3)
     p(5) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 1)
     p(6) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 1)
 
     call expr%reset_contents ()
     do i = 1, 2
        call subevt_set_beam (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     do i = 3, 4
        call subevt_set_incoming (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     do i = 5, 6
        call subevt_set_outgoing (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
     expr%n_in = 2
     expr%n_out = 2
     expr%n_tot = 4
     expr%subevt_filled = .true.
 
     call expr%evaluate (passed, scale, fac_scale, ren_scale, weight)
 
     write (u, "(A,L1)")      "Event has passed      = ", passed
     write (u, "(A," // FMT_12 // ")")  "Scale                 = ", scale
     write (u, "(A," // FMT_12 // ")")  "Factorization scale   = ", fac_scale
     write (u, "(A," // FMT_12 // ")")  "Renormalization scale = ", ren_scale
     write (u, "(A," // FMT_12 // ")")  "Weight                = ", weight
     write (u, "(A)")
 
     call write_separator (u)
     call expr%write (u)
     call write_separator (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call expr%final ()
 
     call model%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: subevt_expr_1"
 
   end subroutine subevt_expr_1
 
 @ %def subevt_expr_1
 @
 \subsubsection{Parton-event expressions}
 <<Expr tests: execute tests>>=
   call test (subevt_expr_2, "subevt_expr_2", &
        "parton-event expressions", &
        u, results)
 <<Expr tests: test declarations>>=
   public :: subevt_expr_2
 <<Expr tests: tests>>=
   subroutine subevt_expr_2 (u)
     integer, intent(in) :: u
     type(string_t) :: expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: pt_selection
     type(parse_tree_t) :: pt_reweight, pt_analysis
     type(parse_node_t), pointer :: pn_selection
     type(parse_node_t), pointer :: pn_reweight, pn_analysis
     type(os_data_t) :: os_data
     type(model_t), target :: model
     type(eval_tree_factory_t) :: expr_factory
     type(event_expr_t), target :: expr
     real(default) :: E, Ex, m
     type(vector4_t), dimension(6) :: p
     integer :: i, pdg
     logical :: passed
     real(default) :: reweight
     logical :: analysis_flag
 
     write (u, "(A)")  "* Test output: subevt_expr_2"
     write (u, "(A)")  "*   Purpose: Set up a subevt and associated &
          &process-specific expressions"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
 
     call syntax_model_file_init ()
     call os_data_init (os_data)
     call model%read (var_str ("Test.mdl"), os_data)
 
     write (u, "(A)")  "* Expression texts"
     write (u, "(A)")
 
 
     expr_text = "all Pt > 100 [s]"
     write (u, "(A,A)")  "selection = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (pt_selection, stream, .true.)
     call stream_final (stream)
     pn_selection => pt_selection%get_root_ptr ()
 
     expr_text = "n_tot - n_in - n_out"
     write (u, "(A,A)")  "reweight = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_reweight, stream, .true.)
     call stream_final (stream)
     pn_reweight => pt_reweight%get_root_ptr ()
 
     expr_text = "true"
     write (u, "(A,A)")  "analysis = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (pt_analysis, stream, .true.)
     call stream_final (stream)
     pn_analysis => pt_analysis%get_root_ptr ()
 
     call ifile_final (ifile)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize process expr"
     write (u, "(A)")
 
     call expr%setup_vars (1000._default)
     call expr%link_var_list (model%get_var_list_ptr ())
     call expr%var_list%append_real (var_str ("tolerance"), 0._default)
 
     call expr_factory%init (pn_selection)
     call expr%setup_selection (expr_factory)
     call expr_factory%init (pn_analysis)
     call expr%setup_analysis (expr_factory)
     call expr_factory%init (pn_reweight)
     call expr%setup_reweight (expr_factory)
 
     call write_separator (u)
     call expr%write (u)
     call write_separator (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Fill subevt and evaluate expressions"
     write (u, "(A)")
 
     call subevt_init (expr%subevt_t, 6)
     E = 500._default
     Ex = 400._default
     m = 125._default
     pdg = 25
     p(1) = vector4_moving (E, sqrt (E**2 - m**2), 3)
     p(2) = vector4_moving (E, -sqrt (E**2 - m**2), 3)
     p(3) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 3)
     p(4) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 3)
     p(5) = vector4_moving (Ex, sqrt (Ex**2 - m**2), 1)
     p(6) = vector4_moving (Ex, -sqrt (Ex**2 - m**2), 1)
 
     call expr%reset_contents ()
     do i = 1, 2
        call subevt_set_beam (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     do i = 3, 4
        call subevt_set_incoming (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     do i = 5, 6
        call subevt_set_outgoing (expr%subevt_t, i, pdg, p(i), m**2)
     end do
     expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
     expr%n_in = 2
     expr%n_out = 2
     expr%n_tot = 4
     expr%subevt_filled = .true.
 
     call expr%evaluate (passed, reweight, analysis_flag)
 
     write (u, "(A,L1)")      "Event has passed      = ", passed
     write (u, "(A," // FMT_12 // ")")  "Reweighting factor    = ", reweight
     write (u, "(A,L1)")      "Analysis flag         = ", analysis_flag
     write (u, "(A)")
 
     call write_separator (u)
     call expr%write (u)
     call write_separator (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call expr%final ()
 
     call model%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: subevt_expr_2"
 
   end subroutine subevt_expr_2
 
 @ %def subevt_expr_2
 @
 \subsubsection{Processes: handle partonic cuts}
 Initialize a process and process instance, choose a sampling point and
 fill the process instance, evaluating a given cut configuration.
 
 We use the same trivial process as for the previous test.  All
 momentum and state dependence is trivial, so we just test basic
 functionality.
 <<Expr tests: execute tests>>=
   call test (processes_5, "processes_5", &
        "handle cuts (partonic event)", &
        u, results)
 <<Expr tests: test declarations>>=
   public :: processes_5
 <<Expr tests: tests>>=
   subroutine processes_5 (u)
     integer, intent(in) :: u
     type(string_t) :: cut_expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: parse_tree
     type(eval_tree_factory_t) :: expr_factory
     type(process_library_t), target :: lib
     type(string_t) :: libname
     type(string_t) :: procname
     type(string_t) :: run_id
     type(os_data_t) :: os_data
     type(qcd_t) :: qcd
     class(rng_factory_t), allocatable :: rng_factory
     type(model_t), pointer :: model_tmp
     class(model_data_t), pointer :: model
     type(var_list_t), target :: var_list
     type(process_t), allocatable, target :: process
     class(mci_t), allocatable :: mci_template
     class(phs_config_t), allocatable :: phs_config_template
     real(default) :: sqrts
     type(process_instance_t), allocatable, target :: process_instance
 
     write (u, "(A)")  "* Test output: processes_5"
     write (u, "(A)")  "*   Purpose: create a process &
          &and fill a process instance"
     write (u, "(A)")
 
     write (u, "(A)")  "* Prepare a cut expression"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
     cut_expr_text = "all Pt > 100 [s]"
     call ifile_append (ifile, cut_expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (parse_tree, stream, .true.)
 
     write (u, "(A)")  "* Build and initialize a test process"
     write (u, "(A)")
 
     libname = "processes5"
     procname = libname
     run_id = "run5"
     call os_data_init (os_data)
     allocate (rng_test_factory_t :: rng_factory)
     call prc_test_create_library (libname, lib)
 
     call syntax_model_file_init ()
     allocate (model_tmp)
     call model_tmp%read (var_str ("Test.mdl"), os_data)
     call var_list%init_snapshot (model_tmp%get_var_list_ptr ())
     model => model_tmp
 
     call reset_interaction_counter ()
 
     allocate (process)
     call process%init (procname, run_id, &
          lib, os_data, qcd, rng_factory, model)
 
     call var_list%append_real (var_str ("tolerance"), 0._default)
     call process%set_var_list (var_list)
     call var_list%final ()
 
     allocate (phs_test_config_t :: phs_config_template)
     call process%setup_test_cores ()
     call process%init_component &
        (1, .true., mci_template, phs_config_template)
 
     write (u, "(A)")  "* Prepare a trivial beam setup"
     write (u, "(A)")
 
     sqrts = 1000
     call process%setup_beams_sqrts (sqrts, i_core = 1)
     call process%configure_phs ()
     call process%setup_mci ()
 
     write (u, "(A)")  "* Complete process initialization and set cuts"
     write (u, "(A)")
 
     call process%setup_terms ()
     call expr_factory%init (parse_tree%get_root_ptr ())
     call process%set_cuts (expr_factory)
     call process%write (.false., u, show_var_list=.true., show_expressions=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Create a process instance"
     write (u, "(A)")
 
     allocate (process_instance)
     call process_instance%init (process)
 
     write (u, "(A)")
     write (u, "(A)")  "* Inject a set of random numbers"
     write (u, "(A)")
 
     call process_instance%choose_mci (1)
     call process_instance%set_mcpar ([0._default, 0._default])
 
     write (u, "(A)")
     write (u, "(A)")  "* Set up kinematics and subevt, check cuts (should fail)"
     write (u, "(A)")
 
     call process_instance%select_channel (1)
     call process_instance%compute_seed_kinematics ()
     call process_instance%compute_hard_kinematics ()
     call process_instance%compute_eff_kinematics ()
     call process_instance%evaluate_expressions ()
     call process_instance%compute_other_channels ()
 
     call process_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for another set (should succeed)"
     write (u, "(A)")
 
     call process_instance%reset ()
     call process_instance%set_mcpar ([0.5_default, 0.125_default])
     call process_instance%select_channel (1)
     call process_instance%compute_seed_kinematics ()
     call process_instance%compute_hard_kinematics ()
     call process_instance%compute_eff_kinematics ()
     call process_instance%evaluate_expressions ()
     call process_instance%compute_other_channels ()
     call process_instance%evaluate_trace ()
 
     call process_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for another set using convenience procedure &
          &(failure)"
     write (u, "(A)")
 
     call process_instance%evaluate_sqme (1, [0.0_default, 0.2_default])
 
     call process_instance%write_header (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for another set using convenience procedure &
          &(success)"
     write (u, "(A)")
 
     call process_instance%evaluate_sqme (1, [0.1_default, 0.2_default])
 
     call process_instance%write_header (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call process_instance%final ()
     deallocate (process_instance)
 
     call process%final ()
     deallocate (process)
 
     call parse_tree_final (parse_tree)
     call stream_final (stream)
     call ifile_final (ifile)
     call syntax_pexpr_final ()
 
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: processes_5"
 
   end subroutine processes_5
 
 @ %def processes_5
 @
 \subsubsection{Processes: scales and such}
 Initialize a process and process instance, choose a sampling point and
 fill the process instance, evaluating a given cut configuration.
 
 We use the same trivial process as for the previous test.  All
 momentum and state dependence is trivial, so we just test basic
 functionality.
 <<Expr tests: execute tests>>=
   call test (processes_6, "processes_6", &
        "handle scales and weight (partonic event)", &
        u, results)
 <<Expr tests: test declarations>>=
   public :: processes_6
 <<Expr tests: tests>>=
   subroutine processes_6 (u)
     integer, intent(in) :: u
     type(string_t) :: expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: pt_scale, pt_fac_scale, pt_ren_scale, pt_weight
     type(process_library_t), target :: lib
     type(string_t) :: libname
     type(string_t) :: procname
     type(string_t) :: run_id
     type(os_data_t) :: os_data
     type(qcd_t) :: qcd
     class(rng_factory_t), allocatable :: rng_factory
     type(model_t), pointer :: model_tmp
     class(model_data_t), pointer :: model
     type(var_list_t), target :: var_list
     type(process_t), allocatable, target :: process
     class(mci_t), allocatable :: mci_template
     class(phs_config_t), allocatable :: phs_config_template
     real(default) :: sqrts
     type(process_instance_t), allocatable, target :: process_instance
     type(eval_tree_factory_t) :: expr_factory
 
     write (u, "(A)")  "* Test output: processes_6"
     write (u, "(A)")  "*   Purpose: create a process &
          &and fill a process instance"
     write (u, "(A)")
 
     write (u, "(A)")  "* Prepare expressions"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
 
     expr_text = "sqrts - 100 GeV"
     write (u, "(A,A)")  "scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_scale, stream, .true.)
     call stream_final (stream)
 
     expr_text = "sqrts_hat"
     write (u, "(A,A)")  "fac_scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_fac_scale, stream, .true.)
     call stream_final (stream)
 
     expr_text = "eval sqrt (M2) [collect [s]]"
     write (u, "(A,A)")  "ren_scale = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_ren_scale, stream, .true.)
     call stream_final (stream)
 
     expr_text = "n_tot * n_in * n_out * (eval Phi / pi [s])"
     write (u, "(A,A)")  "weight = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_weight, stream, .true.)
     call stream_final (stream)
 
     call ifile_final (ifile)
 
     write (u, "(A)")
     write (u, "(A)")  "* Build and initialize a test process"
     write (u, "(A)")
 
     libname = "processes4"
     procname = libname
     run_id = "run4"
     call os_data_init (os_data)
     allocate (rng_test_factory_t :: rng_factory)
     call prc_test_create_library (libname, lib)
 
     call syntax_model_file_init ()
     allocate (model_tmp)
     call model_tmp%read (var_str ("Test.mdl"), os_data)
     call var_list%init_snapshot (model_tmp%get_var_list_ptr ())
     model => model_tmp
 
     call reset_interaction_counter ()
 
     allocate (process)
     call process%init (procname, run_id, &
          lib, os_data, qcd, rng_factory, model)
 
     call process%set_var_list (var_list)
     call var_list%final ()
 
     call process%setup_test_cores ()
     allocate (phs_test_config_t :: phs_config_template)
     call process%init_component &
        (1, .true., mci_template, phs_config_template)
 
     write (u, "(A)")  "* Prepare a trivial beam setup"
     write (u, "(A)")
 
     sqrts = 1000
     call process%setup_beams_sqrts (sqrts, i_core = 1)
     call process%configure_phs ()
     call process%setup_mci ()
 
     write (u, "(A)")  "* Complete process initialization and set cuts"
     write (u, "(A)")
 
     call process%setup_terms ()
     call expr_factory%init (pt_scale%get_root_ptr ())
     call process%set_scale (expr_factory)
     call expr_factory%init (pt_fac_scale%get_root_ptr ())
     call process%set_fac_scale (expr_factory)
     call expr_factory%init (pt_ren_scale%get_root_ptr ())
     call process%set_ren_scale (expr_factory)
     call expr_factory%init (pt_weight%get_root_ptr ())
     call process%set_weight (expr_factory)
     call process%write (.false., u, show_expressions=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Create a process instance and evaluate"
     write (u, "(A)")
 
     allocate (process_instance)
     call process_instance%init (process)
     call process_instance%choose_mci (1)
     call process_instance%evaluate_sqme (1, [0.5_default, 0.125_default])
 
     call process_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call process_instance%final ()
     deallocate (process_instance)
 
     call process%final ()
     deallocate (process)
 
     call parse_tree_final (pt_scale)
     call parse_tree_final (pt_fac_scale)
     call parse_tree_final (pt_ren_scale)
     call parse_tree_final (pt_weight)
     call syntax_pexpr_final ()
 
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: processes_6"
 
   end subroutine processes_6
 
 @ %def processes_6
 @
 \subsubsection{Event expressions}
 After generating an event, fill the [[subevt]] and evaluate expressions for
 selection, reweighting, and analysis.
 <<Expr tests: execute tests>>=
   call test (events_3, "events_3", &
        "expression evaluation", &
        u, results)
 <<Expr tests: test declarations>>=
   public :: events_3
 <<Expr tests: tests>>=
   subroutine events_3 (u)
     use processes_ut, only: prepare_test_process, cleanup_test_process
     integer, intent(in) :: u
     type(string_t) :: expr_text
     type(ifile_t) :: ifile
     type(stream_t) :: stream
     type(parse_tree_t) :: pt_selection, pt_reweight, pt_analysis
     type(eval_tree_factory_t) :: expr_factory
     type(event_t), allocatable, target :: event
     type(process_t), allocatable, target :: process
     type(process_instance_t), allocatable, target :: process_instance
     type(os_data_t) :: os_data
     type(model_t), pointer :: model
     type(var_list_t), target :: var_list
 
     write (u, "(A)")  "* Test output: events_3"
     write (u, "(A)")  "*   Purpose: generate an event and evaluate expressions"
     write (u, "(A)")
 
     call syntax_pexpr_init ()
 
     write (u, "(A)")  "* Expression texts"
     write (u, "(A)")
 
     expr_text = "all Pt > 100 [s]"
     write (u, "(A,A)")  "selection = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (pt_selection, stream, .true.)
     call stream_final (stream)
 
     expr_text = "1 + sqrts_hat / sqrts"
     write (u, "(A,A)")  "reweight = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_expr (pt_reweight, stream, .true.)
     call stream_final (stream)
 
     expr_text = "true"
     write (u, "(A,A)")  "analysis = ", char (expr_text)
     call ifile_clear (ifile)
     call ifile_append (ifile, expr_text)
     call stream_init (stream, ifile)
     call parse_tree_init_lexpr (pt_analysis, stream, .true.)
     call stream_final (stream)
 
     call ifile_final (ifile)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize test process event"
 
     call os_data_init (os_data)
 
     call syntax_model_file_init ()
     allocate (model)
     call model%read (var_str ("Test.mdl"), os_data)
     call var_list%init_snapshot (model%get_var_list_ptr ())
 
     allocate (process)
     allocate (process_instance)
     call prepare_test_process (process, process_instance, model)
 
     call process%set_var_list (var_list)
     call var_list%final ()
 
     call process_instance%setup_event_data ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize event object and set expressions"
 
     allocate (event)
     call event%basic_init ()
 
     call expr_factory%init (pt_selection%get_root_ptr ())
     call event%set_selection (expr_factory)
     call expr_factory%init (pt_reweight%get_root_ptr ())
     call event%set_reweight (expr_factory)
     call expr_factory%init (pt_analysis%get_root_ptr ())
     call event%set_analysis (expr_factory)
 
     call event%connect (process_instance, process%get_model_ptr ())
     call event%expr%var_list%append_real (var_str ("tolerance"), 0._default)
     call event%setup_expressions ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate test process event"
 
     call process_instance%generate_weighted_event (1)
 
     write (u, "(A)")
     write (u, "(A)")  "* Fill event object and evaluate expressions"
     write (u, "(A)")
 
     call event%generate (1, [0.4_default, 0.4_default])
     call event%set_index (42)
     call event%evaluate_expressions ()
     call event%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call event%final ()
     deallocate (event)
 
     call cleanup_test_process (process, process_instance)
     deallocate (process_instance)
     deallocate (process)
 
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: events_3"
 
   end subroutine events_3
 
 @ %def events_3
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Top Level}
 
 The top level consists of
 \begin{description}
 \item[commands]
   Defines generic command-list and command objects, and all specific
   implementations.  Each command type provides a specific
   functionality.  Together with the modules that provide expressions
   and variables, this module defines the Sindarin language.
 \item[whizard]
   This module interprets streams of various kind in terms of the
   command language.  It also contains the unit-test feature.  We also
   define the externally visible procedures here, for the \whizard\ as
   a library.
 \item[main]
   The driver for \whizard\ as a stand-alone program.  Contains the
   command-line interpreter.
 \item[whizard\_c\_interface]
   Alternative top-level procedures, for use in the context of a
   C-compatible caller program.
 \end{description}
 
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Commands}
 This module defines the command language of the main input file.
 <<[[commands.f90]]>>=
 <<File header>>
 
 module commands
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use string_utils, only: lower_case, split_string, str
   use format_utils, only: write_indent
   use format_defs, only: FMT_14, FMT_19
   use diagnostics
 
   use physics_defs
   use sorting
   use sf_lhapdf, only: lhapdf_global_reset
   use os_interface
   use ifiles
   use lexers
   use syntax_rules
   use parser
   use analysis
   use pdg_arrays
   use variables, only: var_list_t, V_NONE, V_LOG, V_INT, V_REAL, V_CMPLX, V_STR, V_PDG
   use observables, only: var_list_check_observable
   use observables, only: var_list_check_result_var
   use eval_trees
   use models
   use auto_components
   use flavors
   use polarizations
   use particle_specifiers
   use process_libraries
   use process
   use instances
   use prclib_stacks
   use slha_interface
   use user_files
   use eio_data
   use rt_data
 
   use process_configurations
   use compilations, only: compile_library, compile_executable
   use integrations, only: integrate_process
   use restricted_subprocesses, only: get_libname_res
   use restricted_subprocesses, only: spawn_resonant_subprocess_libraries
   use event_streams
   use simulations
 
   use radiation_generator
 
 <<Use mpi f08>>
 
 <<Standard module head>>
 
 <<Commands: public>>
 
 <<Commands: types>>
 
 <<Commands: variables>>
 
 <<Commands: parameters>>
 
 <<Commands: interfaces>>
 
 contains
 
 <<Commands: procedures>>
 
 end module commands
 @ %def commands
 @
 \subsection{The command type}
 The command type is a generic type that holds any command, compiled
 for execution.
 
 Each command may come with its own local environment.  The command list that
 determines this environment is allocated as [[options]], if necessary.  (It
 has to be allocated as a pointer because the type definition is recursive.) The
 local environment is available as a pointer which either points to the global
 environment, or is explicitly allocated and initialized.
 <<Commands: types>>=
   type, abstract :: command_t
      type(parse_node_t), pointer :: pn => null ()
      class(command_t), pointer :: next => null ()
      type(parse_node_t), pointer :: pn_opt => null ()
      type(command_list_t), pointer :: options => null ()
      type(rt_data_t), pointer :: local => null ()
    contains
    <<Commands: command: TBP>>
   end type command_t
 
 @ %def command_t
 @ Finalizer: If there is an option list, finalize the option list and
 deallocate.  If not, the local environment is just a pointer.
 <<Commands: command: TBP>>=
   procedure :: final => command_final
 <<Commands: procedures>>=
   recursive subroutine command_final (cmd)
     class(command_t), intent(inout) :: cmd
     if (associated (cmd%options)) then
        call cmd%options%final ()
        deallocate (cmd%options)
        call cmd%local%local_final ()
        deallocate (cmd%local)
     else
        cmd%local => null ()
     end if
   end subroutine command_final
 
 @ %def command_final
 @ Allocate a command with the appropriate concrete type.  Store the
 parse node pointer in the command object, so we can reference to it
 when compiling.
 <<Commands: procedures>>=
   subroutine dispatch_command (command, pn)
     class(command_t), intent(inout), pointer :: command
     type(parse_node_t), intent(in), target :: pn
     select case (char (parse_node_get_rule_key (pn)))
     case ("cmd_model")
        allocate (cmd_model_t :: command)
     case ("cmd_library")
        allocate (cmd_library_t :: command)
     case ("cmd_process")
        allocate (cmd_process_t :: command)
     case ("cmd_nlo")
        allocate (cmd_nlo_t :: command)
     case ("cmd_compile")
        allocate (cmd_compile_t :: command)
     case ("cmd_exec")
        allocate (cmd_exec_t :: command)
      case ("cmd_num", "cmd_complex", "cmd_real", "cmd_int", &
            "cmd_log_decl", "cmd_log", "cmd_string", "cmd_string_decl", &
            "cmd_alias", "cmd_result")
        allocate (cmd_var_t :: command)
     case ("cmd_slha")
        allocate (cmd_slha_t :: command)
     case ("cmd_show")
        allocate (cmd_show_t :: command)
     case ("cmd_clear")
        allocate (cmd_clear_t :: command)
     case ("cmd_expect")
        allocate (cmd_expect_t :: command)
     case ("cmd_beams")
        allocate (cmd_beams_t :: command)
     case ("cmd_beams_pol_density")
        allocate (cmd_beams_pol_density_t :: command)
     case ("cmd_beams_pol_fraction")
        allocate (cmd_beams_pol_fraction_t :: command)
     case ("cmd_beams_momentum")
        allocate (cmd_beams_momentum_t :: command)
     case ("cmd_beams_theta")
        allocate (cmd_beams_theta_t :: command)
     case ("cmd_beams_phi")
        allocate (cmd_beams_phi_t :: command)
     case ("cmd_cuts")
        allocate (cmd_cuts_t :: command)
     case ("cmd_scale")
        allocate (cmd_scale_t :: command)
     case ("cmd_fac_scale")
        allocate (cmd_fac_scale_t :: command)
     case ("cmd_ren_scale")
        allocate (cmd_ren_scale_t :: command)
     case ("cmd_weight")
        allocate (cmd_weight_t :: command)
     case ("cmd_selection")
        allocate (cmd_selection_t :: command)
     case ("cmd_reweight")
        allocate (cmd_reweight_t :: command)
     case ("cmd_iterations")
        allocate (cmd_iterations_t :: command)
     case ("cmd_integrate")
        allocate (cmd_integrate_t :: command)
     case ("cmd_observable")
        allocate (cmd_observable_t :: command)
     case ("cmd_histogram")
        allocate (cmd_histogram_t :: command)
     case ("cmd_plot")
        allocate (cmd_plot_t :: command)
     case ("cmd_graph")
        allocate (cmd_graph_t :: command)
     case ("cmd_record")
        allocate (cmd_record_t :: command)
     case ("cmd_analysis")
        allocate (cmd_analysis_t :: command)
     case ("cmd_alt_setup")
        allocate (cmd_alt_setup_t :: command)
     case ("cmd_unstable")
        allocate (cmd_unstable_t :: command)
     case ("cmd_stable")
        allocate (cmd_stable_t :: command)
     case ("cmd_polarized")
        allocate (cmd_polarized_t :: command)
     case ("cmd_unpolarized")
        allocate (cmd_unpolarized_t :: command)
     case ("cmd_sample_format")
        allocate (cmd_sample_format_t :: command)
     case ("cmd_simulate")
        allocate (cmd_simulate_t :: command)
     case ("cmd_rescan")
        allocate (cmd_rescan_t :: command)
     case ("cmd_write_analysis")
        allocate (cmd_write_analysis_t :: command)
     case ("cmd_compile_analysis")
        allocate (cmd_compile_analysis_t :: command)
     case ("cmd_open_out")
        allocate (cmd_open_out_t :: command)
     case ("cmd_close_out")
        allocate (cmd_close_out_t :: command)
     case ("cmd_printf")
        allocate (cmd_printf_t :: command)
     case ("cmd_scan")
        allocate (cmd_scan_t :: command)
     case ("cmd_if")
        allocate (cmd_if_t :: command)
     case ("cmd_include")
        allocate (cmd_include_t :: command)
     case ("cmd_export")
        allocate (cmd_export_t :: command)
     case ("cmd_quit")
        allocate (cmd_quit_t :: command)
     case default
        print *, char (parse_node_get_rule_key (pn))
        call msg_bug ("Command not implemented")
     end select
     command%pn => pn
   end subroutine dispatch_command
 
 @ %def dispatch_command
 @ Output.  We allow for indentation so we can display a command tree.
 <<Commands: command: TBP>>=
   procedure (command_write), deferred :: write
 <<Commands: interfaces>>=
   abstract interface
      subroutine command_write (cmd, unit, indent)
        import
        class(command_t), intent(in) :: cmd
        integer, intent(in), optional :: unit, indent
      end subroutine command_write
   end interface
 
 @ %def command_write
 @ Compile a command.  The command type is already fixed, so this is a
 deferred type-bound procedure.
 <<Commands: command: TBP>>=
   procedure (command_compile), deferred :: compile
 <<Commands: interfaces>>=
   abstract interface
      subroutine command_compile (cmd, global)
        import
        class(command_t), intent(inout) :: cmd
        type(rt_data_t), intent(inout), target :: global
      end subroutine command_compile
   end interface
 
 @ %def command_compile
 @ Execute a command.  This will use and/or modify the runtime data
 set.  If the [[quit]] flag is set, the caller should terminate command
 execution.
 <<Commands: command: TBP>>=
   procedure (command_execute), deferred :: execute
 <<Commands: interfaces>>=
   abstract interface
      subroutine command_execute (cmd, global)
        import
        class(command_t), intent(inout) :: cmd
        type(rt_data_t), intent(inout), target :: global
      end subroutine command_execute
   end interface
 
 @ %def command_execute
 @
 \subsection{Options}
 The [[options]] command list is allocated, initialized, and executed, if the
 command is associated with an option text in curly braces.  If present, a
 separate local runtime data set [[local]] will be allocated and initialized;
 otherwise, [[local]] becomes a pointer to the global dataset.
 
 For output, we indent the options list.
 <<Commands: command: TBP>>=
   procedure :: write_options => command_write_options
 <<Commands: procedures>>=
   recursive subroutine command_write_options (cmd, unit, indent)
     class(command_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: ind
     ind = 1;  if (present (indent))  ind = indent + 1
     if (associated (cmd%options))  call cmd%options%write (unit, ind)
   end subroutine command_write_options
 
 @ %def command_write_options
 @ Compile the options list, if any.  This implies initialization of the local
 environment.  Should be done once the [[pn_opt]] node has been assigned (if
 applicable), but before the actual command compilation.
 <<Commands: command: TBP>>=
   procedure :: compile_options => command_compile_options
 <<Commands: procedures>>=
   recursive subroutine command_compile_options (cmd, global)
     class(command_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (associated (cmd%pn_opt)) then
        allocate (cmd%local)
        call cmd%local%local_init (global)
        call global%copy_globals (cmd%local)
        allocate (cmd%options)
        call cmd%options%compile (cmd%pn_opt, cmd%local)
        call global%restore_globals (cmd%local)
        call cmd%local%deactivate ()
     else
        cmd%local => global
     end if
   end subroutine command_compile_options
 
 @ %def command_compile_options
 @ Execute options.  First prepare the local environment, then execute the
 command list.
 <<Commands: command: TBP>>=
   procedure :: execute_options => cmd_execute_options
 <<Commands: procedures>>=
   recursive subroutine cmd_execute_options (cmd, global)
     class(command_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (associated (cmd%options)) then
        call cmd%local%activate ()
        call cmd%options%execute (cmd%local)
     end if
   end subroutine cmd_execute_options
 
 @ %def cmd_execute_options
 @ This must be called after the parent command has been executed, to undo
 temporary modifications to the environment.  Note that some modifications to
 [[global]] can become permanent.
 <<Commands: command: TBP>>=
   procedure :: reset_options => cmd_reset_options
 <<Commands: procedures>>=
   subroutine cmd_reset_options (cmd, global)
     class(command_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (associated (cmd%options)) then
        call cmd%local%deactivate (global)
     end if
   end subroutine cmd_reset_options
 
 @ %def cmd_reset_options
 @
 \subsection{Specific command types}
 \subsubsection{Model configuration}
 The command declares a model, looks for the specified file and loads
 it.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_model_t
      private
      type(string_t) :: name
      type(string_t) :: scheme
      logical :: ufo_model = .false.
      logical :: ufo_path_set = .false.
      type(string_t) :: ufo_path
    contains
    <<Commands: cmd model: TBP>>
   end type cmd_model_t
 
 @ %def cmd_model_t
 @ Output
 <<Commands: cmd model: TBP>>=
   procedure :: write => cmd_model_write
 <<Commands: procedures>>=
   subroutine cmd_model_write (cmd, unit, indent)
     class(cmd_model_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,'""',A,'""')", advance="no")  "model =", char (cmd%name)
     if (cmd%ufo_model) then
        if (cmd%ufo_path_set) then
           write (u, "(1x,A,A,A)")  "(ufo (", char (cmd%ufo_path), "))"
        else
           write (u, "(1x,A)")  "(ufo)"
        end if
     else if (cmd%scheme /= "") then
        write (u, "(1x,'(',A,')')")  char (cmd%scheme)
     else
        write (u, *)
     end if
   end subroutine cmd_model_write
 
 @ %def cmd_model_write
 @ Compile.  Get the model name and read the model from file, so it is
 readily available when the command list is executed.  If the model has a
 scheme argument, take this into account.
 
 Assign the model pointer in the [[global]] record, so it can be used for
 (read-only) variable lookup while compiling further commands.
 <<Commands: cmd model: TBP>>=
   procedure :: compile => cmd_model_compile
 <<Commands: procedures>>=
   subroutine cmd_model_compile (cmd, global)
     class(cmd_model_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_name, pn_arg, pn_scheme
     type(parse_node_t), pointer :: pn_ufo_arg, pn_path
     type(model_t), pointer :: model
     type(string_t) :: scheme
     pn_name => cmd%pn%get_sub_ptr (3)
     pn_arg => pn_name%get_next_ptr ()
     if (associated (pn_arg)) then
        pn_scheme => pn_arg%get_sub_ptr ()
     else
        pn_scheme => null ()
     end if
     cmd%name = pn_name%get_string ()
     if (associated (pn_scheme)) then
        select case (char (pn_scheme%get_rule_key ()))
        case ("ufo_spec")
           cmd%ufo_model = .true.
           pn_ufo_arg => pn_scheme%get_sub_ptr (2)
           if (associated (pn_ufo_arg)) then
              pn_path => pn_ufo_arg%get_sub_ptr ()
              cmd%ufo_path_set = .true.
              cmd%ufo_path = pn_path%get_string ()
           end if
        case default
           scheme = pn_scheme%get_string ()
     select case (char (lower_case (scheme)))
     case ("ufo");  cmd%ufo_model = .true.
           case default;  cmd%scheme = scheme
           end select
        end select
        if (cmd%ufo_model) then
           if (cmd%ufo_path_set) then
              call preload_ufo_model (model, cmd%name, cmd%ufo_path)
           else
              call preload_ufo_model (model, cmd%name)
           end if
        else
           call preload_model (model, cmd%name, cmd%scheme)
        end if
     else
        cmd%scheme = ""
        call preload_model (model, cmd%name)
     end if
     global%model => model
     if (associated (global%model)) then
        call global%model%link_var_list (global%var_list)
     end if
   contains
     subroutine preload_model (model, name, scheme)
       type(model_t), pointer, intent(out) :: model
       type(string_t), intent(in) :: name
       type(string_t), intent(in), optional :: scheme
       model => null ()
       if (associated (global%model)) then
          if (global%model%matches (name, scheme)) then
             model => global%model
          end if
       end if
       if (.not. associated (model)) then
          if (global%model_list%model_exists (name, scheme)) then
             model => global%model_list%get_model_ptr (name, scheme)
          else
             call global%read_model (name, model, scheme)
          end if
       end if
     end subroutine preload_model
     subroutine preload_ufo_model (model, name, ufo_path)
       type(model_t), pointer, intent(out) :: model
       type(string_t), intent(in) :: name
       type(string_t), intent(in), optional :: ufo_path
       model => null ()
       if (associated (global%model)) then
          if (global%model%matches (name, ufo=.true., ufo_path=ufo_path)) then
             model => global%model
          end if
       end if
       if (.not. associated (model)) then
          if (global%model_list%model_exists (name, &
               ufo=.true., ufo_path=ufo_path)) then
             model => global%model_list%get_model_ptr (name, &
                  ufo=.true., ufo_path=ufo_path)
          else
             call global%read_ufo_model (name, model, ufo_path=ufo_path)
          end if
       end if
     end subroutine preload_ufo_model
   end subroutine cmd_model_compile
 
 @ %def cmd_model_compile
 @ Execute: Insert a pointer into the global data record and reassign
 the variable list.
 <<Commands: cmd model: TBP>>=
   procedure :: execute => cmd_model_execute
 <<Commands: procedures>>=
   subroutine cmd_model_execute (cmd, global)
     class(cmd_model_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (cmd%ufo_model) then
        if (cmd%ufo_path_set) then
           call global%select_model (cmd%name, ufo=.true., ufo_path=cmd%ufo_path)
        else
           call global%select_model (cmd%name, ufo=.true.)
        end if
     else if (cmd%scheme /= "") then
        call global%select_model (cmd%name, cmd%scheme)
     else
        call global%select_model (cmd%name)
     end if
     if (.not. associated (global%model)) &
          call msg_fatal ("Switching to model '" &
          // char (cmd%name) // "': model not found")
   end subroutine cmd_model_execute
 
 @ %def cmd_model_execute
 @
 \subsubsection{Library configuration}
 We configure a process library that should hold the subsequently
 defined processes.  If the referenced library exists already, just
 make it the currently active one.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_library_t
      private
      type(string_t) :: name
    contains
    <<Commands: cmd library: TBP>>
   end type cmd_library_t
 
 @ %def cmd_library_t
 @ Output.
 <<Commands: cmd library: TBP>>=
   procedure :: write => cmd_library_write
 <<Commands: procedures>>=
   subroutine cmd_library_write (cmd, unit, indent)
     class(cmd_library_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit)
     call write_indent (u, indent)
     write (u, "(1x,A,1x,'""',A,'""')")  "library =", char (cmd%name)
   end subroutine cmd_library_write
 
 @ %def cmd_library_write
 @ Compile.  Get the library name.
 <<Commands: cmd library: TBP>>=
   procedure :: compile => cmd_library_compile
 <<Commands: procedures>>=
   subroutine cmd_library_compile (cmd, global)
     class(cmd_library_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_name
     pn_name => parse_node_get_sub_ptr (cmd%pn, 3)
     cmd%name = parse_node_get_string (pn_name)
   end subroutine cmd_library_compile
 
 @ %def cmd_library_compile
 @ Execute: Initialize a new library and push it on the library stack
 (if it does not yet exist).   Insert a pointer to the library into the
 global data record.  Then, try to load the library unless the
 [[rebuild]] flag is set.
 <<Commands: cmd library: TBP>>=
   procedure :: execute => cmd_library_execute
 <<Commands: procedures>>=
   subroutine cmd_library_execute (cmd, global)
     class(cmd_library_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     logical :: rebuild_library
     lib => global%prclib_stack%get_library_ptr (cmd%name)
     rebuild_library = &
          global%var_list%get_lval (var_str ("?rebuild_library"))
     if (.not. (associated (lib))) then
        allocate (lib_entry)
        call lib_entry%init (cmd%name)
        lib => lib_entry%process_library_t
        call global%add_prclib (lib_entry)
     else
        call global%update_prclib (lib)
     end if
     if (associated (lib) .and. .not. rebuild_library) then
        call lib%update_status (global%os_data)
     end if
   end subroutine cmd_library_execute
 
 @ %def cmd_library_execute
 @
 \subsubsection{Process configuration}
 We define a process-configuration command as a specific type.  The
 incoming and outgoing particles are given evaluation-trees which we
 transform to PDG-code arrays.  For transferring to \oMega, they are
 reconverted to strings.
 
 For the incoming particles, we store parse nodes individually.  We do
 not yet resolve the outgoing state, so we store just a single parse
 node.
 
 This also includes the choice of method for the corresponding process:
 [[omega]] for \oMega\ matrix elements as Fortran code, [[ovm]] for
 \oMega\ matrix elements as a bytecode virtual machine, [[test]] for
 special processes, [[unit_test]] for internal test matrix elements
 generated by \whizard, [[template]] and [[template_unity]] for test
 matrix elements generated by \whizard\ as Fortran code similar to the
 \oMega\ code. If the one-loop program (OLP) \gosam\ is linked, also
 matrix elements from there (at leading and next-to-leading order) can
 be generated via [[gosam]].
 <<Commands: types>>=
   type, extends (command_t) :: cmd_process_t
      private
      type(string_t) :: id
      integer :: n_in  = 0
      type(parse_node_p), dimension(:), allocatable :: pn_pdg_in
      type(parse_node_t), pointer :: pn_out => null ()
    contains
    <<Commands: cmd process: TBP>>
   end type cmd_process_t
 
 @ %def cmd_process_t
 @ Output.  The particle expressions are not resolved, so we just list the
 number of incoming particles.
 <<Commands: cmd process: TBP>>=
   procedure :: write => cmd_process_write
 <<Commands: procedures>>=
   subroutine cmd_process_write (cmd, unit, indent)
     class(cmd_process_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A,A,I0,A)")  "process: ", char (cmd%id), " (", &
          size (cmd%pn_pdg_in), " -> X)"
     call cmd%write_options (u, indent)
   end subroutine cmd_process_write
 
 @ %def cmd_process_write
 @ Compile.  Find and assign the parse nodes.
 <<Commands: cmd process: TBP>>=
   procedure :: compile => cmd_process_compile
 <<Commands: procedures>>=
   subroutine cmd_process_compile (cmd, global)
     class(cmd_process_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_id, pn_in, pn_codes
     integer :: i
     pn_id => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_in  => parse_node_get_next_ptr (pn_id, 2)
     cmd%pn_out => parse_node_get_next_ptr (pn_in, 2)
     cmd%pn_opt => parse_node_get_next_ptr (cmd%pn_out)
     call cmd%compile_options (global)
     cmd%id = parse_node_get_string (pn_id)
     cmd%n_in  = parse_node_get_n_sub (pn_in)
     pn_codes => parse_node_get_sub_ptr (pn_in)
     allocate (cmd%pn_pdg_in (cmd%n_in))
     do i = 1, cmd%n_in
        cmd%pn_pdg_in(i)%ptr => pn_codes
        pn_codes => parse_node_get_next_ptr (pn_codes)
     end do
   end subroutine cmd_process_compile
 
 @ %def cmd_process_compile
 @ Command execution.  Evaluate the subevents, transform PDG codes
 into strings, and add the current process configuration to the
 process library.
 
 The initial state will be unique (one or two particles).  For the final state,
 we allow for expressions.  The expressions will be expanded until we have a
 sum of final states.  Each distinct final state will get its own process
 component.
 
 To identify equivalent final states, we transform the final state into
 an array of PDG codes, which we sort and compare.  If a particle entry
 is actually a PDG array, only the first entry in the array is used for
 the comparison. The user should make sure that there is no overlap
 between different particles or arrays which would make the expansion
 ambiguous. 
 
 There are two possibilities that a process contains more than
 component: by an explicit component statement by the user for
 inclusive processes, or by having one process at NLO level. The first
 option is determined in the routine [[scan_components]], and
 determines [[n_components]].
 <<Commands: cmd process: TBP>>=
   procedure :: execute => cmd_process_execute
 <<Commands: procedures>>=
   subroutine cmd_process_execute (cmd, global)
     class(cmd_process_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(pdg_array_t) :: pdg_in, pdg_out
     type(pdg_array_t), dimension(:), allocatable :: pdg_out_tab
     type(string_t), dimension(:), allocatable :: prt_in
     type(string_t) :: prt_out, prt_out1
     type(process_configuration_t) :: prc_config
     type(prt_expr_t) :: prt_expr_out
     type(prt_spec_t), dimension(:), allocatable :: prt_spec_in
     type(prt_spec_t), dimension(:), allocatable :: prt_spec_out
     type(var_list_t), pointer :: var_list
     integer, dimension(:), allocatable :: pdg
     integer, dimension(:), allocatable :: i_term
     integer, dimension(:), allocatable :: nlo_comp
     integer :: i, j, n_in, n_out, n_terms, n_components
     logical :: nlo_fixed_order
     logical :: qcd_corr, qed_corr
     type(string_t), dimension(:), allocatable :: prt_in_nlo, prt_out_nlo
     type(radiation_generator_t) :: radiation_generator
     type(pdg_list_t) :: pl_in, pl_out, pl_excluded_gauge_splittings
     type(string_t) :: method, born_me_method, loop_me_method, &
          correlation_me_method, real_tree_me_method, dglap_me_method
     integer, dimension(:), allocatable :: i_list
     logical :: use_real_finite
     logical :: gks_active
     logical :: initial_state_colored
     integer :: comp_mult
     integer :: gks_multiplicity
     integer :: n_components_init
     integer :: alpha_power, alphas_power
     logical :: requires_soft_mismatch, requires_dglap_remnants
     call msg_debug (D_CORE, "cmd_process_execute")
     var_list => cmd%local%get_var_list_ptr ()
 
     n_in = size (cmd%pn_pdg_in)
     allocate (prt_in (n_in), prt_spec_in (n_in))
     do i = 1, n_in
        pdg_in = &
             eval_pdg_array (cmd%pn_pdg_in(i)%ptr, var_list)
        prt_in(i) = make_flavor_string (pdg_in, cmd%local%model)
        prt_spec_in(i) = new_prt_spec (prt_in(i))
     end do
     call compile_prt_expr &
          (prt_expr_out, cmd%pn_out, var_list, cmd%local%model)
     call prt_expr_out%expand ()
     call scan_components ()
     allocate (nlo_comp (n_components))
     
     nlo_fixed_order = cmd%local%nlo_fixed_order
     gks_multiplicity = var_list%get_ival (var_str ('gks_multiplicity'))
     gks_active = gks_multiplicity > 2
     call check_for_nlo_corrections ()
 
     method = var_list%get_sval (var_str ("$method"))
     born_me_method = var_list%get_sval (var_str ("$born_me_method"))
     if (born_me_method == var_str (""))  born_me_method = method
     use_real_finite = var_list%get_lval (var_str ('?nlo_use_real_partition'))
     if (nlo_fixed_order) then
        real_tree_me_method = &
             var_list%get_sval (var_str ("$real_tree_me_method"))
        if (real_tree_me_method == var_str ("")) &
             real_tree_me_method = method
        loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
        if (loop_me_method == var_str ("")) &
             loop_me_method = method
        correlation_me_method = &
             var_list%get_sval (var_str ("$correlation_me_method"))
        if (correlation_me_method == var_str ("")) &
             correlation_me_method = method
        dglap_me_method = var_list%get_sval (var_str ("$dglap_me_method"))
        if (dglap_me_method == var_str ("")) &
             dglap_me_method = method
        call check_nlo_options (cmd%local)
     end if
 
     call determine_needed_components ()
     call prc_config%init (cmd%id, n_in, n_components_init, &
          cmd%local%model, cmd%local%var_list, &
          nlo_process = nlo_fixed_order)
 
     alpha_power = var_list%get_ival (var_str ("alpha_power"))
     alphas_power = var_list%get_ival (var_str ("alphas_power"))
     call prc_config%set_coupling_powers (alpha_power, alphas_power)
 
     call setup_components ()
     call prc_config%record (cmd%local)
 
   contains
 
   <<Commands: cmd process execute procedures>>
 
   end subroutine cmd_process_execute
 
 @ %def cmd_process_execute
 @
 <<Commands: cmd process execute procedures>>=
   elemental function is_threshold (method)
     logical :: is_threshold
     type(string_t), intent(in) :: method
     is_threshold = method == var_str ("threshold")
   end function is_threshold
 
   subroutine check_threshold_consistency ()
     if (nlo_fixed_order .and. is_threshold (born_me_method)) then
        if (.not. (is_threshold (real_tree_me_method) .and. is_threshold (loop_me_method) &
             .and. is_threshold (correlation_me_method))) then
             print *, 'born: ', char (born_me_method)
             print *, 'real: ', char (real_tree_me_method)
             print *, 'loop: ', char (loop_me_method)
             print *, 'correlation: ', char (correlation_me_method)
             call msg_fatal ("Inconsistent methods: All components need to be threshold")
        end if
     end if
   end subroutine check_threshold_consistency
 
 @ %def check_threshold_consistency
 <<Commands: cmd process execute procedures>>=
   subroutine check_for_nlo_corrections ()
     type(string_t) :: nlo_correction_type
     type(pdg_array_t), dimension(:), allocatable :: pdg
     if (nlo_fixed_order .or. gks_active) then
        nlo_correction_type = &
             var_list%get_sval (var_str ('$nlo_correction_type'))
        select case (char(nlo_correction_type))
        case ("QCD")
           qcd_corr = .true.; qed_corr = .false.
        case ("QED")
           qcd_corr = .false.; qed_corr = .true.
        case ("Full")
           qcd_corr =.true.; qed_corr = .true.
        case default
           call msg_fatal ("Invalid NLO correction type! " // &
                "Valid inputs are: QCD, QED, Full (default: QCD)")
        end select
        call check_for_excluded_gauge_boson_splitting_partners ()
        call setup_radiation_generator ()
     end if
     if (nlo_fixed_order) then
        call radiation_generator%find_splittings ()
        if (debug2_active (D_CORE)) then
           print *, ''
           print *, 'Found (pdg) splittings: '
           do i = 1, radiation_generator%if_table%get_length ()
              call radiation_generator%if_table%get_pdg_out (i, pdg)
              call pdg_array_write_set (pdg)
              print *, '----------------'
           end do
        end if
 
        nlo_fixed_order = radiation_generator%contains_emissions ()
        if (.not. nlo_fixed_order) call msg_warning &
             (arr = [var_str ("No NLO corrections found for process ") // &
             cmd%id // var_str("."), var_str ("Proceed with usual " // &
             "leading-order integration and simulation")])
     end if
   end subroutine check_for_nlo_corrections
 
 @ %def check_for_nlo_corrections
 @
 <<Commands: cmd process execute procedures>>=
   subroutine check_for_excluded_gauge_boson_splitting_partners ()
     type(string_t) :: str_excluded_partners
     type(string_t), dimension(:), allocatable :: excluded_partners
     type(pdg_list_t) :: pl_tmp, pl_anti
     integer :: i, n_anti
     str_excluded_partners = var_list%get_sval &
          (var_str ("$exclude_gauge_splittings"))
     if (str_excluded_partners == "") then
        return
     else
        call split_string (str_excluded_partners, &
             var_str (":"), excluded_partners)
        call pl_tmp%init (size (excluded_partners))
        do i = 1, size (excluded_partners)
           call pl_tmp%set (i, &
                cmd%local%model%get_pdg (excluded_partners(i), .true.))
        end do
        call pl_tmp%create_antiparticles (pl_anti, n_anti)
        call pl_excluded_gauge_splittings%init (pl_tmp%get_size () + n_anti)
        do i = 1, pl_tmp%get_size ()
           call pl_excluded_gauge_splittings%set (i, pl_tmp%get(i))
        end do
        do i = 1, n_anti
           j = i + pl_tmp%get_size ()
           call pl_excluded_gauge_splittings%set (j, pl_anti%get(i))
        end do
     end if
   end subroutine check_for_excluded_gauge_boson_splitting_partners
 
 @ %def check_for_excluded_gauge_boson_splitting_partners
 @
 <<Commands: cmd process execute procedures>>=
   subroutine determine_needed_components ()
     type(string_t) :: fks_method
     comp_mult = 1
     if (nlo_fixed_order) then
        fks_method = var_list%get_sval (var_str ('$fks_mapping_type'))
        call check_threshold_consistency ()
        requires_soft_mismatch = fks_method == var_str ('resonances')
        comp_mult = needed_extra_components (requires_dglap_remnants, &
             use_real_finite, requires_soft_mismatch)
        allocate (i_list (comp_mult))
     else if (gks_active) then
        call radiation_generator%generate_multiple &
             (gks_multiplicity, cmd%local%model)
        comp_mult = radiation_generator%get_n_gks_states () + 1
     end if
     n_components_init = n_components * comp_mult
   end subroutine determine_needed_components
 
 @ %def determine_needed_components
 @
 <<Commands: cmd process execute procedures>>=
   subroutine setup_radiation_generator ()
     call split_prt (prt_spec_in, n_in, pl_in)
     call split_prt (prt_spec_out, n_out, pl_out)
     call radiation_generator%init (pl_in, pl_out, &
          pl_excluded_gauge_splittings, qcd = qcd_corr, qed = qed_corr)
     call radiation_generator%set_n (n_in, n_out, 0)
     initial_state_colored = pdg_in%has_colored_particles ()
     if ((n_in == 2 .and. initial_state_colored) .or. qed_corr) then
         requires_dglap_remnants = n_in == 2 .and. initial_state_colored
         call radiation_generator%set_initial_state_emissions ()
     else
        requires_dglap_remnants = .false.
     end if
     call radiation_generator%set_constraints (.false., .false., .true., .true.)
     call radiation_generator%setup_if_table (cmd%local%model)
   end subroutine setup_radiation_generator
 
 @ %def setup_radiation_generator
 @
 <<Commands: cmd process execute procedures>>=
   subroutine scan_components ()
     n_terms = prt_expr_out%get_n_terms ()
     allocate (pdg_out_tab (n_terms))
     allocate (i_term (n_terms), source = 0)
     n_components = 0
     SCAN: do i = 1, n_terms
        if (allocated (pdg))  deallocate (pdg)
        call prt_expr_out%term_to_array (prt_spec_out, i)
        n_out = size (prt_spec_out)
        allocate (pdg (n_out))
        do j = 1, n_out
           prt_out = prt_spec_out(j)%to_string ()
           call split (prt_out, prt_out1, ":")
           pdg(j) = cmd%local%model%get_pdg (prt_out1)
        end do
        pdg_out = sort (pdg)
        do j = 1, n_components
           if (pdg_out == pdg_out_tab(j))  cycle SCAN
        end do
        n_components = n_components + 1
        i_term(n_components) = i
        pdg_out_tab(n_components) = pdg_out
     end do SCAN
   end subroutine scan_components
 
 @
 <<Commands: cmd process execute procedures>>=
   subroutine split_prt (prt, n_out, pl)
     type(prt_spec_t), intent(in), dimension(:), allocatable :: prt
     integer, intent(in) :: n_out
     type(pdg_list_t), intent(out) :: pl
     type(pdg_array_t) :: pdg
     type(string_t) :: prt_string, prt_tmp
     integer, parameter :: max_particle_number = 25
     integer, dimension(max_particle_number) :: i_particle
     integer :: i, j, n
     i_particle = 0
     call pl%init (n_out)
     do i = 1, n_out
        n = 1
        prt_string = prt(i)%to_string ()
        do
          call split (prt_string, prt_tmp, ":")
          if (prt_tmp /= "") then
            i_particle(n) = cmd%local%model%get_pdg (prt_tmp)
            n = n + 1
          else
            exit
          end if
        end do
        call pdg_array_init (pdg, n - 1)
        do j = 1, n - 1
          call pdg%set (j, i_particle(j))
        end do
        call pl%set (i, pdg)
        call pdg_array_delete (pdg)
     end do
   end subroutine split_prt
 
 @ %def split_prt
 @
 <<Commands: cmd process execute procedures>>=
   subroutine setup_components()
     integer :: k, i_comp, add_index
     i_comp = 0
     add_index = 0
     call msg_debug (D_CORE, "setup_components")
     do i = 1, n_components
        call prt_expr_out%term_to_array (prt_spec_out, i_term(i))
        if (nlo_fixed_order) then
           associate (selected_nlo_parts => cmd%local%selected_nlo_parts)
              call msg_debug (D_CORE, "Setting up this NLO component:", &
                   i_comp + 1)
              call prc_config%setup_component (i_comp + 1, &
                   prt_spec_in, prt_spec_out, &
                   cmd%local%model, var_list, BORN, &
                   can_be_integrated = selected_nlo_parts (BORN))
              call radiation_generator%generate_real_particle_strings &
                   (prt_in_nlo, prt_out_nlo)
              call msg_debug (D_CORE, "Setting up this NLO component:", &
                   i_comp + 2)
              call prc_config%setup_component (i_comp + 2, &
                   new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
                   cmd%local%model, var_list, NLO_REAL, &
                   can_be_integrated = selected_nlo_parts (NLO_REAL))
              call msg_debug (D_CORE, "Setting up this NLO component:", &
                   i_comp + 3)
              call prc_config%setup_component (i_comp + 3, &
                   prt_spec_in, prt_spec_out, &
                   cmd%local%model, var_list, NLO_VIRTUAL, &
                   can_be_integrated = selected_nlo_parts (NLO_VIRTUAL))
              call msg_debug (D_CORE, "Setting up this NLO component:", &
                   i_comp + 4)
              call prc_config%setup_component (i_comp + 4, &
                   prt_spec_in, prt_spec_out, &
                   cmd%local%model, var_list, NLO_SUBTRACTION, &
                   can_be_integrated = selected_nlo_parts (NLO_SUBTRACTION))
              do k = 1, 4
                 i_list(k) = i_comp + k
              end do
              if (requires_dglap_remnants) then
                 call msg_debug (D_CORE, "Setting up this NLO component:", &
                      i_comp + 5)
                 call prc_config%setup_component (i_comp + 5, &
                      prt_spec_in, prt_spec_out, &
                      cmd%local%model, var_list, NLO_DGLAP, &
                      can_be_integrated = selected_nlo_parts (NLO_DGLAP))
                 i_list(5) = i_comp + 5
                 add_index = add_index + 1
              end if
              if (use_real_finite) then
                 call msg_debug (D_CORE, "Setting up this NLO component:", &
                      i_comp + 5 + add_index)
                 call prc_config%setup_component (i_comp + 5 + add_index, &
                      new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
                      cmd%local%model, var_list, NLO_REAL, &
                      can_be_integrated = selected_nlo_parts (NLO_REAL))
                 i_list(5 + add_index) = i_comp + 5 + add_index
                 add_index = add_index + 1
              end if
              if (requires_soft_mismatch) then
                 call msg_debug (D_CORE, "Setting up this NLO component:", &
                      i_comp + 5 + add_index)
                 call prc_config%setup_component (i_comp + 5 + add_index, &
                    prt_spec_in, prt_spec_out, &
                    cmd%local%model, var_list, NLO_MISMATCH, &
                    can_be_integrated = selected_nlo_parts (NLO_MISMATCH))
                 i_list(5 + add_index) = i_comp + 5 + add_index
              end if
              call prc_config%set_component_associations (i_list, &
                   requires_dglap_remnants, use_real_finite, &
                   requires_soft_mismatch)
           end associate
        else if (gks_active) then
           call prc_config%setup_component (i_comp + 1, prt_spec_in, &
                prt_spec_out, cmd%local%model, var_list, BORN, &
                can_be_integrated = .true.)
           call radiation_generator%reset_queue ()
           do j = 1, comp_mult
              prt_out_nlo =  radiation_generator%get_next_state ()
              call prc_config%setup_component (i_comp + 1 + j, &
                 new_prt_spec (prt_in), new_prt_spec (prt_out_nlo), &
                 cmd%local%model, var_list, GKS, can_be_integrated = .false.)
           end do
        else
           call prc_config%setup_component (i, &
                prt_spec_in, prt_spec_out, &
                cmd%local%model, var_list, can_be_integrated = .true.)
        end if
        i_comp = i_comp + comp_mult
     end do
   end subroutine setup_components
 
 @
 @ These three functions should be bundled with the logicals they depend
 on into an object (the pcm?).
 <<Commands: procedures>>=
   subroutine check_nlo_options (local)
     type(rt_data_t), intent(in) :: local
     type(var_list_t), pointer :: var_list => null ()
     logical :: nlo, combined, powheg
     logical :: case_lo_but_any_other
     logical :: case_nlo_powheg_but_not_combined
     logical :: vamp_equivalences_enabled
     logical :: fixed_order_nlo_events
     var_list => local%get_var_list_ptr ()
     nlo = local%nlo_fixed_order
     combined = var_list%get_lval (var_str ('?combined_nlo_integration'))
     powheg = var_list%get_lval (var_str ('?powheg_matching'))
     case_lo_but_any_other = .not. nlo .and. any ([combined, powheg])
     case_nlo_powheg_but_not_combined = &
          nlo .and. powheg .and. .not. combined
     if (case_lo_but_any_other) then
        call msg_fatal ("Option mismatch: Leading order process is selected &
             &but either powheg_matching or combined_nlo_integration &
             &is set to true.")
     else if (case_nlo_powheg_but_not_combined) then
        call msg_fatal ("POWHEG requires the 'combined_nlo_integration'-option &
             &to be set to true.")
     end if
     fixed_order_nlo_events = &
          var_list%get_lval (var_str ('?fixed_order_nlo_events'))
     if (fixed_order_nlo_events .and. .not. combined .and. &
          all (local%selected_nlo_parts)) &
        call msg_fatal ("Option mismatch: Fixed order NLO events of the full ", &
             [var_str ("process are requested, but ?combined_nlo_integration"), &
             var_str ("is false. You can either switch to the combined NLO"), &
             var_str ("integration mode or choose one individual NLO component"), &
             var_str ("to generate events with.")])
     vamp_equivalences_enabled = var_list%get_lval &
          (var_str ('?use_vamp_equivalences'))
     if (nlo .and. vamp_equivalences_enabled) &
          call msg_warning ("You have not disabled VAMP equivalences. ", &
               [var_str ("   Note that they are automatically switched off "), &
                var_str ("   for NLO calculations.")])
   end subroutine check_nlo_options
 
 @ %def check_nlo_options
 @ There are four components for a general NLO process, namely Born,
 real, virtual and subtraction. There will be additional components for
 DGLAP remnant, in case real contributions are split into singular and
 finite pieces, and for resonance-aware FKS subtraction for the needed
 soft mismatch component.
 <<Commands: procedures>>=
   pure function needed_extra_components (requires_dglap_remnant, &
          use_real_finite, requires_soft_mismatch) result (n)
     integer :: n
     logical, intent(in) :: requires_dglap_remnant, &
          use_real_finite, requires_soft_mismatch
     n = 4
     if (requires_dglap_remnant)  n = n + 1
     if (use_real_finite)  n = n + 1
     if (requires_soft_mismatch)  n = n + 1
   end function needed_extra_components
 
 @ %def needed_extra_components
 @ This is a method of the eval tree, but cannot be coded inside the
 [[expressions]] module since it uses the [[model]] and [[flv]] types
 which are not available there.
 <<Commands: procedures>>=
   function make_flavor_string (aval, model) result (prt)
     type(string_t) :: prt
     type(pdg_array_t), intent(in) :: aval
     type(model_t), intent(in), target :: model
     integer, dimension(:), allocatable :: pdg
     type(flavor_t), dimension(:), allocatable :: flv
     integer :: i
     pdg = aval
     allocate (flv (size (pdg)))
     call flv%init (pdg, model)
     if (size (pdg) /= 0) then
        prt = flv(1)%get_name ()
        do i = 2, size (flv)
           prt = prt // ":" // flv(i)%get_name ()
        end do
     else
        prt = "?"
     end if
   end function make_flavor_string
 
 @ %def make_flavor_string
 @ Create a pdg array from a particle-specification array
 <<Commands: procedures>>=
   function make_pdg_array (prt, model) result (pdg_array)
     type(prt_spec_t), intent(in), dimension(:) :: prt
     type(model_t), intent(in) :: model
     integer, dimension(:), allocatable :: aval
     type(pdg_array_t) :: pdg_array
     type(flavor_t) :: flv
     integer :: k
     allocate (aval (size (prt)))
     do k = 1, size (prt)
       call flv%init (prt(k)%to_string (), model)
       aval (k) = flv%get_pdg ()
     end do
     pdg_array = aval
   end function make_pdg_array
 
 @ %def make_pdg_array
 @ Compile a (possible nested) expression, to obtain a
 particle-specifier expression which we can process further.
 <<Commands: procedures>>=
   recursive subroutine compile_prt_expr (prt_expr, pn, var_list, model)
     type(prt_expr_t), intent(out) :: prt_expr
     type(parse_node_t), intent(in), target :: pn
     type(var_list_t), intent(in), target :: var_list
     type(model_t), intent(in), target :: model
     type(parse_node_t), pointer :: pn_entry, pn_term, pn_addition
     type(pdg_array_t) :: pdg
     type(string_t) :: prt_string
     integer :: n_entry, n_term, i
     select case (char (parse_node_get_rule_key (pn)))
     case ("prt_state_list")
        n_entry = parse_node_get_n_sub (pn)
        pn_entry => parse_node_get_sub_ptr (pn)
        if (n_entry == 1) then
           call compile_prt_expr (prt_expr, pn_entry, var_list, model)
        else
           call prt_expr%init_list (n_entry)
           select type (x => prt_expr%x)
           type is (prt_spec_list_t)
              do i = 1, n_entry
                 call compile_prt_expr (x%expr(i), pn_entry, var_list, model)
                 pn_entry => parse_node_get_next_ptr (pn_entry)
              end do
           end select
        end if
     case ("prt_state_sum")
        n_term = parse_node_get_n_sub (pn)
        pn_term => parse_node_get_sub_ptr (pn)
        pn_addition => pn_term
        if (n_term == 1) then
           call compile_prt_expr (prt_expr, pn_term, var_list, model)
        else
           call prt_expr%init_sum (n_term)
           select type (x => prt_expr%x)
           type is (prt_spec_sum_t)
              do i = 1, n_term
                 call compile_prt_expr (x%expr(i), pn_term, var_list, model)
                 pn_addition => parse_node_get_next_ptr (pn_addition)
                 if (associated (pn_addition)) &
                      pn_term => parse_node_get_sub_ptr (pn_addition, 2)
              end do
           end select
        end if
     case ("cexpr")
        pdg = eval_pdg_array (pn, var_list)
        prt_string = make_flavor_string (pdg, model)
        call prt_expr%init_spec (new_prt_spec (prt_string))
     case default
        call parse_node_write_rec (pn)
        call msg_bug ("compile prt expr: impossible syntax rule")
     end select
   end subroutine compile_prt_expr
 
 @ %def compile_prt_expr
 @
 \subsubsection{Initiating a NLO calculation}
 <<Commands: types>>=
   type, extends (command_t) :: cmd_nlo_t
     private
     integer, dimension(:), allocatable :: nlo_component
   contains
     <<Commands: cmd nlo: TBP>>
   end type cmd_nlo_t
 
 @ %def cmd_nlo_t
 @
 <<Commands: cmd nlo: TBP>>=
   procedure :: write => cmd_nlo_write
 <<Commands: procedures>>=
   subroutine cmd_nlo_write (cmd, unit, indent)
     class(cmd_nlo_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
   end subroutine cmd_nlo_write
 
 @ %def cmd_nlo_write
 @ As it is, the NLO calculation is switched on by putting {nlo} behind the process definition. This should be made nicer in the future.
 <<Commands: cmd nlo: TBP>>=
   procedure :: compile => cmd_nlo_compile
 <<Commands: procedures>>=
   subroutine cmd_nlo_compile (cmd, global)
     class(cmd_nlo_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_comp
     integer :: i, n_comp
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
     if (associated (pn_arg)) then
        n_comp = parse_node_get_n_sub (pn_arg)
        allocate (cmd%nlo_component (n_comp))
        pn_comp => parse_node_get_sub_ptr (pn_arg)
        i = 0
        do while (associated (pn_comp))
           i = i + 1
           cmd%nlo_component(i) = component_status &
                (parse_node_get_rule_key (pn_comp))
           pn_comp => parse_node_get_next_ptr (pn_comp)
        end do
     else
        allocate (cmd%nlo_component (0))
     end if
   end subroutine cmd_nlo_compile
 
 @ %def cmd_nlo_compile
 @
 <<Commands: cmd nlo: TBP>>=
   procedure :: execute => cmd_nlo_execute
 <<Commands: procedures>>=
   subroutine cmd_nlo_execute (cmd, global)
     class(cmd_nlo_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(string_t) :: string
     integer :: n, i, j
     logical, dimension(0:5) :: selected_nlo_parts
     call msg_debug (D_CORE, "cmd_nlo_execute")
     selected_nlo_parts = .false.
     if (allocated (cmd%nlo_component)) then
        n = size (cmd%nlo_component)
     else
        n = 0
     end if
     do i = 1, n
        select case (cmd%nlo_component (i))
        case (BORN, NLO_VIRTUAL, NLO_MISMATCH, NLO_DGLAP, NLO_REAL)
           selected_nlo_parts(cmd%nlo_component (i)) = .true.
        case (NLO_FULL)
           selected_nlo_parts = .true.
           selected_nlo_parts (NLO_SUBTRACTION) = .false.
        case default
           string = var_str ("")
           do j = BORN, NLO_DGLAP
              string = string // component_status (j) // ", "
           end do
           string = string // component_status (NLO_FULL)
           call msg_fatal ("Invalid NLO mode. Valid modes are: " // &
                char (string))
        end select
     end do
     global%nlo_fixed_order = any (selected_nlo_parts)
     global%selected_nlo_parts = selected_nlo_parts
     allocate (global%nlo_component (size (cmd%nlo_component)))
     global%nlo_component = cmd%nlo_component
   end subroutine cmd_nlo_execute
 
 @ %def cmd_nlo_execute
 @
 \subsubsection{Process compilation}
 <<Commands: types>>=
   type, extends (command_t) :: cmd_compile_t
      private
      type(string_t), dimension(:), allocatable :: libname
      logical :: make_executable = .false.
      type(string_t) :: exec_name
    contains
    <<Commands: cmd compile: TBP>>
   end type cmd_compile_t
 
 @ %def cmd_compile_t
 @ Output: list all libraries to be compiled.
 <<Commands: cmd compile: TBP>>=
   procedure :: write => cmd_compile_write
 <<Commands: procedures>>=
   subroutine cmd_compile_write (cmd, unit, indent)
     class(cmd_compile_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "compile ("
     if (allocated (cmd%libname)) then
        do i = 1, size (cmd%libname)
           if (i > 1)  write (u, "(A,1x)", advance="no")  ","
           write (u, "('""',A,'""')", advance="no")  char (cmd%libname(i))
        end do
     end if
     write (u, "(A)")  ")"
   end subroutine cmd_compile_write
 
 @ %def cmd_compile_write
 @ Compile the libraries specified in the argument.  If the argument is
 empty, compile all libraries which can be found in the process library stack.
 <<Commands: cmd compile: TBP>>=
   procedure :: compile => cmd_compile_compile
 <<Commands: procedures>>=
   subroutine cmd_compile_compile (cmd, global)
     class(cmd_compile_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_cmd, pn_clause, pn_arg, pn_lib
     type(parse_node_t), pointer :: pn_exec_name_spec, pn_exec_name
     integer :: n_lib, i
     pn_cmd => parse_node_get_sub_ptr (cmd%pn)
     pn_clause => parse_node_get_sub_ptr (pn_cmd)
     pn_exec_name_spec => parse_node_get_sub_ptr (pn_clause, 2)
     if (associated (pn_exec_name_spec)) then
        pn_exec_name => parse_node_get_sub_ptr (pn_exec_name_spec, 2)
     else
        pn_exec_name => null ()
     end if
     pn_arg => parse_node_get_next_ptr (pn_clause)
     cmd%pn_opt => parse_node_get_next_ptr (pn_cmd)
     call cmd%compile_options (global)
     if (associated (pn_arg)) then
        n_lib = parse_node_get_n_sub (pn_arg)
     else
        n_lib = 0
     end if
     if (n_lib > 0) then
        allocate (cmd%libname (n_lib))
        pn_lib => parse_node_get_sub_ptr (pn_arg)
        do i = 1, n_lib
           cmd%libname(i) = parse_node_get_string (pn_lib)
           pn_lib => parse_node_get_next_ptr (pn_lib)
        end do
     end if
     if (associated (pn_exec_name)) then
        cmd%make_executable = .true.
        cmd%exec_name = parse_node_get_string (pn_exec_name)
     end if
   end subroutine cmd_compile_compile
 
 @ %def cmd_compile_compile
 @ Command execution.  Generate code, write driver, compile and link.
 Do this for all libraries in the list.
 
 If no library names have been given and stored while compiling this
 command, we collect all libraries from the current stack and compile
 those.
 
 As a bonus, a compiled library may be able to spawn new process
 libraries.  For instance, a processes may ask for a set of resonant
 subprocesses which go into their own library, but this can be
 determined only after the process is available as a compiled object.
 Therefore, the compilation loop is implemented as a recursive internal
 subroutine.
 
 We can compile static libraries (which actually just loads them).  However, we
 can't incorporate in a generated executable.
 <<Commands: cmd compile: TBP>>=
   procedure :: execute => cmd_compile_execute
 <<Commands: procedures>>=
   subroutine cmd_compile_execute (cmd, global)
     class(cmd_compile_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(string_t), dimension(:), allocatable :: libname, libname_static
     integer :: i, n_lib
     <<Commands: cmd compile execute: variables>>
     <<Commands: cmd compile execute: init>>
     if (allocated (cmd%libname)) then
        allocate (libname (size (cmd%libname)))
        libname = cmd%libname
     else
        call cmd%local%prclib_stack%get_names (libname)
     end if
     n_lib = size (libname)
     if (cmd%make_executable) then
        call get_prclib_static (libname_static)
        do i = 1, n_lib
           if (any (libname_static == libname(i))) then
              call msg_fatal ("Compile: can't include static library '" &
                   // char (libname(i)) // "'")
           end if
        end do
        call compile_executable (cmd%exec_name, libname, cmd%local)
     else
        call compile_libraries (libname)
        call global%update_prclib &
             (global%prclib_stack%get_library_ptr (libname(n_lib)))
     end if
     <<Commands: cmd compile execute: end init>>
   contains
     recursive subroutine compile_libraries (libname)
       type(string_t), dimension(:), intent(in) :: libname
       integer :: i
       type(string_t), dimension(:), allocatable :: libname_extra
       type(process_library_t), pointer :: lib_saved
       do i = 1, size (libname)
          call compile_library (libname(i), cmd%local)
          lib_saved => global%prclib
          call spawn_extra_libraries &
               (libname(i), cmd%local, global, libname_extra)
          call compile_libraries (libname_extra)
          call global%update_prclib (lib_saved)
       end do
     end subroutine compile_libraries
   end subroutine cmd_compile_execute
 
 @ %def cmd_compile_execute
 <<Commands: cmd compile execute: variables>>=
 @
 <<Commands: cmd compile execute: init>>=
 @
 <<Commands: cmd compile execute: end init>>=
 @
 @ The parallelization leads to undefined behavior while writing simultaneously to one file.
 The master worker has to initialize single-handed the corresponding library files.
 The slave worker will wait with a blocking [[MPI_BCAST]] until they receive a logical flag.
 <<MPI: Commands: cmd compile execute: variables>>=
   logical :: compile_init
   integer :: rank, n_size
 <<MPI: Commands: cmd compile execute: init>>=
   call msg_debug (D_MPI, "cmd_compile_execute")
   compile_init = .false.
   call mpi_get_comm_id (n_size, rank)
   call msg_debug (D_MPI, "n_size", rank)
   call msg_debug (D_MPI, "rank", rank)
   if (rank /= 0) then
      call msg_debug (D_MPI, "wait for master")
      call MPI_bcast (compile_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
   else
      compile_init = .true.
   end if
 
   if (compile_init) then
 <<MPI: Commands: cmd compile execute: end init>>=
   if (rank == 0) then
      call msg_debug (D_MPI, "load slaves")
      call MPI_bcast (compile_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
   end if
 end if
 call MPI_barrier (MPI_COMM_WORLD)
 @ %def cmd_compile_execute_mpi
 @
 This is the interface to the external procedure which returns the
 names of all static libraries which are part of the executable.  (The
 default is none.)  The routine must allocate the array.
 <<Commands: public>>=
   public :: get_prclib_static
 <<Commands: interfaces>>=
   interface
      subroutine get_prclib_static (libname)
        import
        type(string_t), dimension(:), intent(inout), allocatable :: libname
      end subroutine get_prclib_static
   end interface
 
 @ %def get_prclib_static
 @
 Spawn extra libraries.  We can ask the processes within a compiled
 library, which we have available at this point, whether they need additional
 processes which should go into their own libraries.
 
 The current implementation only concerns resonant subprocesses.
 
 Note that the libraries should be created (source code), but not be
 compiled here.  This is done afterwards.
 <<Commands: procedures>>=
   subroutine spawn_extra_libraries (libname, local, global, libname_extra)
     type(string_t), intent(in) :: libname
     type(rt_data_t), intent(inout), target :: local
     type(rt_data_t), intent(inout), target :: global
     type(string_t), dimension(:), allocatable, intent(out) :: libname_extra
     type(string_t), dimension(:), allocatable :: libname_res
     allocate (libname_extra (0))
     call spawn_resonant_subprocess_libraries &
          (libname, local, global, libname_res)
     if (allocated (libname_res))  libname_extra = [libname_extra, libname_res]
   end subroutine spawn_extra_libraries
 
 @ %def spawn_extra_libraries
 @
 \subsubsection{Execute a shell command}
 The argument is a string expression.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_exec_t
      private
      type(parse_node_t), pointer :: pn_command => null ()
    contains
    <<Commands: cmd exec: TBP>>
   end type cmd_exec_t
 
 @ %def cmd_exec_t
 @ Simply tell the status.
 <<Commands: cmd exec: TBP>>=
   procedure :: write => cmd_exec_write
 <<Commands: procedures>>=
   subroutine cmd_exec_write (cmd, unit, indent)
     class(cmd_exec_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     if (associated (cmd%pn_command)) then
        write (u, "(1x,A)")  "exec: [command associated]"
     else
        write (u, "(1x,A)")  "exec: [undefined]"
     end if
   end subroutine cmd_exec_write
 
 @ %def cmd_exec_write
 @ Compile the exec command.
 <<Commands: cmd exec: TBP>>=
   procedure :: compile => cmd_exec_compile
 <<Commands: procedures>>=
   subroutine cmd_exec_compile (cmd, global)
     class(cmd_exec_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_command
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_command => parse_node_get_sub_ptr (pn_arg)
     cmd%pn_command => pn_command
   end subroutine cmd_exec_compile
 
 @ %def cmd_exec_compile
 @ Execute the specified shell command.
 <<Commands: cmd exec: TBP>>=
   procedure :: execute => cmd_exec_execute
 <<Commands: procedures>>=
   subroutine cmd_exec_execute (cmd, global)
     class(cmd_exec_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(string_t) :: command
     logical :: is_known
     integer :: status
     command = eval_string (cmd%pn_command, global%var_list, is_known=is_known)
     if (is_known) then
        if (command /= "") then
           call os_system_call (command, status, verbose=.true.)
           if (status /= 0) then
              write (msg_buffer, "(A,I0)")  "Return code = ", status
              call msg_message ()
              call msg_error ("System command returned with nonzero status code")
           end if
        end if
     end if
   end subroutine cmd_exec_execute
 
 @ %def cmd_exec_execute
 @
 \subsubsection{Variable declaration}
 A variable can have various types.  Hold the definition as an eval
 tree.
 
 There are intrinsic variables, user variables, and model variables.
 The latter are further divided in independent variables and dependent
 variables.
 
 Regarding model variables: When dealing with them, we always look at
 two variable lists in parallel.  The global (or local) variable list
 contains the user-visible values.  It includes variables that
 correspond to variables in the current model's list.  These, in turn,
 are pointers to the model's parameter list, so the model is always in
 sync, internally.  To keep the global variable list in sync with the
 model, the global variables carry the [[is_copy]] property and contain
 a separate pointer to the model variable.  (The pointer is reassigned
 whenever the model changes.)  Modifying the global variable changes
 two values simultaneously: the visible value and the model variable,
 via this extra pointer.  After each modification, we update dependent
 parameters in the model variable list and re-synchronize the global
 variable list (again, using these pointers) with the model variable
 this.  In the last step, modifications in the derived parameters
 become visible.
 
 When we integrate a process, we capture the current variable list of
 the current model in a separate model instance, which is stored in the
 process object.  Thus, the model parameters associated to this process
 at this time are preserved for the lifetime of the process object.
 
 When we generate or rescan events, we can again capture a local model
 variable list in a model instance.  This allows us to reweight event
 by event with different parameter sets simultaneously.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_var_t
      private
      type(string_t) :: name
      integer :: type = V_NONE
      type(parse_node_t), pointer :: pn_value => null ()
      logical :: is_intrinsic = .false.
      logical :: is_model_var = .false.
    contains
    <<Commands: cmd var: TBP>>
   end type cmd_var_t
 
 @ %def cmd_var_t
 @ Output.  We know name, type, and properties, but not the value.
 <<Commands: cmd var: TBP>>=
   procedure :: write => cmd_var_write
 <<Commands: procedures>>=
   subroutine cmd_var_write (cmd, unit, indent)
     class(cmd_var_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A,A)", advance="no")  "var: ", char (cmd%name), " ("
     select case (cmd%type)
     case (V_NONE)
        write (u, "(A)", advance="no")  "[unknown]"
     case (V_LOG)
        write (u, "(A)", advance="no")  "logical"
     case (V_INT)
        write (u, "(A)", advance="no")  "int"
     case (V_REAL)
        write (u, "(A)", advance="no")  "real"
     case (V_CMPLX)
        write (u, "(A)", advance="no")  "complex"
     case (V_STR)
        write (u, "(A)", advance="no")  "string"
     case (V_PDG)
        write (u, "(A)", advance="no")  "alias"
     end select
     if (cmd%is_intrinsic) then
        write (u, "(A)", advance="no")  ", intrinsic"
     end if
     if (cmd%is_model_var) then
        write (u, "(A)", advance="no")  ", model"
     end if
     write (u, "(A)")  ")"
   end subroutine cmd_var_write
 
 @ %def cmd_var_write
 @ Compile the lhs and determine the variable name and type.  Check whether
 this variable can be created or modified as requested, and append the value to
 the variable list, if appropriate.  The value is initially undefined.
 The rhs is assigned to a pointer, to be compiled and evaluated when the
 command is executed.
 <<Commands: cmd var: TBP>>=
   procedure :: compile => cmd_var_compile
 <<Commands: procedures>>=
   subroutine cmd_var_compile (cmd, global)
     class(cmd_var_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_var, pn_name
     type(parse_node_t), pointer :: pn_result, pn_proc
     type(string_t) :: var_name
     type(var_list_t), pointer :: model_vars
     integer :: type
     logical :: new
     pn_result => null ()
     new = .false.
     select case (char (parse_node_get_rule_key (cmd%pn)))
     case ("cmd_log_decl");    type = V_LOG
        pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
        if (.not. associated (pn_var)) then   ! handle masked syntax error
           cmd%type = V_NONE; return
        end if
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        new = .true.
     case ("cmd_log");         type = V_LOG
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
     case ("cmd_int");         type = V_INT
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
        new = .true.
     case ("cmd_real");        type = V_REAL
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
        new = .true.
     case ("cmd_complex");       type = V_CMPLX
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
        new = .true.
     case ("cmd_num");         type = V_NONE
        pn_name => parse_node_get_sub_ptr (cmd%pn)
     case ("cmd_string_decl"); type = V_STR
        pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
        if (.not. associated (pn_var)) then   ! handle masked syntax error
           cmd%type = V_NONE; return
        end if
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        new = .true.
     case ("cmd_string");      type = V_STR
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
     case ("cmd_alias");       type = V_PDG
        pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
        new = .true.
     case ("cmd_result");      type = V_REAL
        pn_name => parse_node_get_sub_ptr (cmd%pn)
        pn_result => parse_node_get_sub_ptr (pn_name)
        pn_proc => parse_node_get_next_ptr (pn_result)
     case default
        call parse_node_mismatch &
             ("logical|int|real|complex|?|$|alias|var_name", cmd%pn)  ! $
     end select
     if (.not. associated (pn_name)) then   ! handle masked syntax error
        cmd%type = V_NONE; return
     end if
     if (.not. associated (pn_result)) then
        var_name = parse_node_get_string (pn_name)
     else
        var_name = parse_node_get_key (pn_result) &
             // "(" // parse_node_get_string (pn_proc) // ")"
     end if
     select case (type)
     case (V_LOG);  var_name = "?" // var_name
     case (V_STR);  var_name = "$" // var_name    ! $
     end select
     if (associated (global%model)) then
        model_vars => global%model%get_var_list_ptr ()
     else
        model_vars => null ()
     end if
     call var_list_check_observable (global%var_list, var_name, type)
     call var_list_check_result_var (global%var_list, var_name, type)
     call global%var_list%check_user_var (var_name, type, new)
     cmd%name = var_name
     cmd%pn_value => parse_node_get_next_ptr (pn_name, 2)
     if (global%var_list%contains (cmd%name, follow_link = .false.)) then
        ! local variable
        cmd%is_intrinsic = &
             global%var_list%is_intrinsic (cmd%name, follow_link = .false.)
        cmd%type = &
             global%var_list%get_type (cmd%name, follow_link = .false.)
     else
        if (new)  cmd%type = type
        if (global%var_list%contains (cmd%name, follow_link = .true.)) then
           ! global variable
           cmd%is_intrinsic = &
                global%var_list%is_intrinsic (cmd%name, follow_link = .true.)
           if (cmd%type == V_NONE) then
              cmd%type = &
                   global%var_list%get_type (cmd%name, follow_link = .true.)
           end if
        else if (associated (model_vars)) then  ! check model variable
           cmd%is_model_var = &
                model_vars%contains (cmd%name)
           if (cmd%type == V_NONE) then
              cmd%type = &
                   model_vars%get_type (cmd%name)
           end if
        end if
        if (cmd%type == V_NONE) then
           call msg_fatal ("Variable '" // char (cmd%name) // "' " &
                // "set without declaration")
           cmd%type = V_NONE;  return
        end if
        if (cmd%is_model_var) then
           if (new) then
              call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
                   // "redeclared")
           else if (model_vars%is_locked (cmd%name)) then
              call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
                   // "is locked")
           end if
        else
           select case (cmd%type)
           case (V_LOG)
              call global%var_list%append_log (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           case (V_INT)
              call global%var_list%append_int (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           case (V_REAL)
              call global%var_list%append_real (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           case (V_CMPLX)
              call global%var_list%append_cmplx (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           case (V_PDG)
              call global%var_list%append_pdg_array (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           case (V_STR)
              call global%var_list%append_string (cmd%name, &
                   intrinsic=cmd%is_intrinsic, user=.true.)
           end select
        end if
     end if
   end subroutine cmd_var_compile
 
 @ %def cmd_var_compile
 @ Execute.  Evaluate the definition and assign the variable value.
 If the variable is a model variable, take a snapshot of the model if necessary
 and set the variable in the local model.
 <<Commands: cmd var: TBP>>=
   procedure :: execute => cmd_var_execute
 <<Commands: procedures>>=
   subroutine cmd_var_execute (cmd, global)
     class(cmd_var_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default) :: rval
     logical :: is_known, pacified
     var_list => global%get_var_list_ptr ()
     if (cmd%is_model_var) then
        pacified = var_list%get_lval (var_str ("?pacify"))
        rval = eval_real (cmd%pn_value, var_list, is_known=is_known)
        call global%model_set_real &
             (cmd%name, rval, verbose=.true., pacified=pacified)
     else if (cmd%type /= V_NONE) then
        call cmd%set_value (var_list, verbose=.true.)
     end if
   end subroutine cmd_var_execute
 
 @ %def cmd_var_execute
 @ Copy the value to the variable list, where the variable should already exist.
 <<Commands: cmd var: TBP>>=
   procedure :: set_value => cmd_var_set_value
 <<Commands: procedures>>=
   subroutine cmd_var_set_value (var, var_list, verbose, model_name)
     class(cmd_var_t), intent(inout) :: var
     type(var_list_t), intent(inout), target :: var_list
     logical, intent(in), optional :: verbose
     type(string_t), intent(in), optional :: model_name
     logical :: lval, pacified
     integer :: ival
     real(default) :: rval
     complex(default) :: cval
     type(pdg_array_t) :: aval
     type(string_t) :: sval
     logical :: is_known
     pacified = var_list%get_lval (var_str ("?pacify"))
     select case (var%type)
     case (V_LOG)
        lval = eval_log (var%pn_value, var_list, is_known=is_known)
        call var_list%set_log (var%name, &
             lval, is_known, verbose=verbose, model_name=model_name)
     case (V_INT)
        ival = eval_int (var%pn_value, var_list, is_known=is_known)
        call var_list%set_int (var%name, &
             ival, is_known, verbose=verbose, model_name=model_name)
     case (V_REAL)
        rval = eval_real (var%pn_value, var_list, is_known=is_known)
        call var_list%set_real (var%name, &
             rval, is_known, verbose=verbose, &
             model_name=model_name, pacified = pacified)
     case (V_CMPLX)
        cval = eval_cmplx (var%pn_value, var_list, is_known=is_known)
        call var_list%set_cmplx (var%name, &
             cval, is_known, verbose=verbose, &
             model_name=model_name, pacified = pacified)
     case (V_PDG)
        aval = eval_pdg_array (var%pn_value, var_list, is_known=is_known)
        call var_list%set_pdg_array (var%name, &
             aval, is_known, verbose=verbose, model_name=model_name)
     case (V_STR)
        sval = eval_string (var%pn_value, var_list, is_known=is_known)
        call var_list%set_string (var%name, &
             sval, is_known, verbose=verbose, model_name=model_name)
     end select
   end subroutine cmd_var_set_value
 
 @ %def cmd_var_set_value
 @
 \subsubsection{SLHA}
 Read a SLHA (SUSY Les Houches Accord) file to fill the appropriate
 model parameters.  We do not access the current variable record, but
 directly work on the appropriate SUSY model, which is loaded if
 necessary.
 
 We may be in read or write mode.  In the latter case, we may write
 just input parameters, or the complete spectrum, or the spectrum with
 all decays.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_slha_t
      private
      type(string_t) :: file
      logical :: write_mode = .false.
    contains
    <<Commands: cmd slha: TBP>>
   end type cmd_slha_t
 
 @ %def cmd_slha_t
 @ Output.
 <<Commands: cmd slha: TBP>>=
   procedure :: write => cmd_slha_write
 <<Commands: procedures>>=
   subroutine cmd_slha_write (cmd, unit, indent)
     class(cmd_slha_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A)")  "slha: file name  = ", char (cmd%file)
     write (u, "(1x,A,L1)") "slha: write mode = ", cmd%write_mode
   end subroutine cmd_slha_write
 
 @ %def cmd_slha_write
 @ Compile.  Read the filename and store it.
 <<Commands: cmd slha: TBP>>=
   procedure :: compile => cmd_slha_compile
 <<Commands: procedures>>=
   subroutine cmd_slha_compile (cmd, global)
     class(cmd_slha_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_key, pn_arg, pn_file
     pn_key => parse_node_get_sub_ptr (cmd%pn)
     pn_arg => parse_node_get_next_ptr (pn_key)
     pn_file => parse_node_get_sub_ptr (pn_arg)
     call cmd%compile_options (global)
     cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
     select case (char (parse_node_get_key (pn_key)))
     case ("read_slha")
        cmd%write_mode = .false.
     case ("write_slha")
        cmd%write_mode = .true.
     case default
        call parse_node_mismatch ("read_slha|write_slha",  cmd%pn)
     end select
     cmd%file = parse_node_get_string (pn_file)
   end subroutine cmd_slha_compile
 
 @ %def cmd_slha_compile
 @ Execute.  Read or write the specified SLHA file.  Behind the scenes,
 this will first read the WHIZARD model file, then read the SLHA file
 and assign the SLHA parameters as far as determined by
 [[dispatch_slha]].  Finally, the global variables are synchronized
 with the model.  This is similar to executing [[cmd_model]].
 <<Commands: cmd slha: TBP>>=
   procedure :: execute => cmd_slha_execute
 <<Commands: procedures>>=
   subroutine cmd_slha_execute (cmd, global)
     class(cmd_slha_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     logical :: input, spectrum, decays
     if (cmd%write_mode) then
        input = .true.
        spectrum = .false.
        decays = .false.
        if (.not. associated (cmd%local%model)) then
           call msg_fatal ("SLHA: local model not associated")
           return
        end if
        call slha_write_file &
             (cmd%file, cmd%local%model, &
              input = input, spectrum = spectrum, decays = decays)
     else
        if (.not. associated (global%model)) then
           call msg_fatal ("SLHA: global model not associated")
           return
        end if
        call dispatch_slha (cmd%local%var_list, &
             input = input, spectrum = spectrum, decays = decays)
        call global%ensure_model_copy ()
        call slha_read_file &
             (cmd%file, cmd%local%os_data, global%model, &
              input = input, spectrum = spectrum, decays = decays)
     end if
   end subroutine cmd_slha_execute
 
 @ %def cmd_slha_execute
 @
 \subsubsection{Show values}
 This command shows the current values of variables or other objects,
 in a suitably condensed form.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_show_t
      private
      type(string_t), dimension(:), allocatable :: name
    contains
    <<Commands: cmd show: TBP>>
   end type cmd_show_t
 
 @ %def cmd_show_t
 @ Output: list the object names, not values.
 <<Commands: cmd show: TBP>>=
   procedure :: write => cmd_show_write
 <<Commands: procedures>>=
   subroutine cmd_show_write (cmd, unit, indent)
     class(cmd_show_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "show: "
     if (allocated (cmd%name)) then
        do i = 1, size (cmd%name)
           write (u, "(1x,A)", advance="no")  char (cmd%name(i))
        end do
        write (u, *)
     else
        write (u, "(5x,A)")  "[undefined]"
     end if
   end subroutine cmd_show_write
 
 @ %def cmd_show_write
 @ Compile.  Allocate an array which is filled with the names of the
 variables to show.
 <<Commands: cmd show: TBP>>=
   procedure :: compile => cmd_show_compile
 <<Commands: procedures>>=
   subroutine cmd_show_compile (cmd, global)
     class(cmd_show_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
     type(string_t) :: key
     integer :: i, n_args
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (pn_arg)) then
        select case (char (parse_node_get_rule_key (pn_arg)))
        case ("show_arg")
           cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
        case default
           cmd%pn_opt => pn_arg
           pn_arg => null ()
        end select
     end if
     call cmd%compile_options (global)
     if (associated (pn_arg)) then
        n_args = parse_node_get_n_sub (pn_arg)
        allocate (cmd%name (n_args))
        pn_var => parse_node_get_sub_ptr (pn_arg)
        i = 0
        do while (associated (pn_var))
           i = i + 1
           select case (char (parse_node_get_rule_key (pn_var)))
           case ("model", "library", "beams", "iterations", &
                 "cuts", "weight", "int", "real", "complex", &
                 "scale", "factorization_scale", "renormalization_scale", &
                 "selection", "reweight", "analysis", "pdg", &
                 "stable", "unstable", "polarized", "unpolarized", &
                 "results", "expect", "intrinsic", "string", "logical")
              cmd%name(i) = parse_node_get_key (pn_var)
           case ("result_var")
              pn_prefix => parse_node_get_sub_ptr (pn_var)
              pn_name => parse_node_get_next_ptr (pn_prefix)
              if (associated (pn_name)) then
                 cmd%name(i) = parse_node_get_key (pn_prefix) &
                      // "(" // parse_node_get_string (pn_name) // ")"
              else
                 cmd%name(i) = parse_node_get_key (pn_prefix)
              end if
           case ("log_var", "string_var", "alias_var")
              pn_prefix => parse_node_get_sub_ptr (pn_var)
              pn_name => parse_node_get_next_ptr (pn_prefix)
              key = parse_node_get_key (pn_prefix)
              if (associated (pn_name)) then
                 select case (char (parse_node_get_rule_key (pn_name)))
                 case ("var_name")
                    select case (char (key))
                    case ("?", "$")  ! $ sign
                       cmd%name(i) = key // parse_node_get_string (pn_name)
                    case ("alias")
                       cmd%name(i) = parse_node_get_string (pn_name)
                    end select
                 case default
                    call parse_node_mismatch &
                         ("var_name",  pn_name)
                 end select
              else
                 cmd%name(i) = key
              end if
           case default
              cmd%name(i) = parse_node_get_string (pn_var)
           end select
           pn_var => parse_node_get_next_ptr (pn_var)
        end do
     else
        allocate (cmd%name (0))
     end if
   end subroutine cmd_show_compile
 
 @ %def cmd_show_compile
 @ Execute.  Scan the list of objects to show.
 <<Commands: parameters>>=
   integer, parameter, public :: SHOW_BUFFER_SIZE = 4096
 <<Commands: cmd show: TBP>>=
   procedure :: execute => cmd_show_execute
 <<Commands: procedures>>=
   subroutine cmd_show_execute (cmd, global)
     class(cmd_show_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list, model_vars
     type(model_t), pointer :: model
     type(string_t) :: name
     integer :: n, pdg
     type(flavor_t) :: flv
     type(process_library_t), pointer :: prc_lib
     type(process_t), pointer :: process
     logical :: pacified
     character(SHOW_BUFFER_SIZE) :: buffer
     type(string_t) :: out_file
     integer :: i, j, u, u_log, u_out, u_ext
     u = free_unit ()
     var_list => cmd%local%var_list
     if (associated (cmd%local%model)) then
        model_vars => cmd%local%model%get_var_list_ptr ()
     else
        model_vars => null ()
     end if
     pacified = var_list%get_lval (var_str ("?pacify"))
     out_file = var_list%get_sval (var_str ("$out_file"))
     if (file_list_is_open (global%out_files, out_file, action="write")) then
        call msg_message ("show: copying output to file '" &
             // char (out_file) // "'")
        u_ext = file_list_get_unit (global%out_files, out_file)
     else
        u_ext = -1
     end if
     open (u, status = "scratch", action = "readwrite")
     if (associated (cmd%local%model)) then
        name = cmd%local%model%get_name ()
     end if
     if (size (cmd%name) == 0) then
        if (associated (model_vars)) then
           call model_vars%write (model_name = name, &
                unit = u, pacified = pacified, follow_link = .false.)
        end if
        call var_list%write (unit = u, pacified = pacified)
     else
        do i = 1, size (cmd%name)
           select case (char (cmd%name(i)))
           case ("model")
              if (associated (cmd%local%model)) then
                 call cmd%local%model%show (u)
              else
                 write (u, "(A)")  "Model: [undefined]"
              end if
           case ("library")
              if (associated (cmd%local%prclib)) then
                 call cmd%local%prclib%show (u)
              else
                 write (u, "(A)")  "Process library: [undefined]"
              end if
           case ("beams")
              call cmd%local%show_beams (u)
           case ("iterations")
              call cmd%local%it_list%write (u)
           case ("results")
              call cmd%local%process_stack%show (u, fifo=.true.)
           case ("stable")
              call cmd%local%model%show_stable (u)
           case ("polarized")
              call cmd%local%model%show_polarized (u)
           case ("unpolarized")
              call cmd%local%model%show_unpolarized (u)
           case ("unstable")
              model => cmd%local%model
              call model%show_unstable (u)
              n = model%get_n_field ()
              do j = 1, n
                 pdg = model%get_pdg (j)
                 call flv%init (pdg, model)
                 if (.not. flv%is_stable ()) &
                      call show_unstable (cmd%local, pdg, u)
                 if (flv%has_antiparticle ()) then
                    associate (anti => flv%anti ())
                      if (.not. anti%is_stable ()) &
                           call show_unstable (cmd%local, -pdg, u)
                    end associate
                 end if
              end do
           case ("cuts", "weight", "scale", &
                "factorization_scale", "renormalization_scale", &
                "selection", "reweight", "analysis")
              call cmd%local%pn%show (cmd%name(i), u)
           case ("expect")
              call expect_summary (force = .true.)
           case ("intrinsic")
              call var_list%write (intrinsic=.true., unit=u, &
                   pacified = pacified)
           case ("logical")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_LOG, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (&
                   only_type=V_LOG, unit=u, pacified = pacified)
           case ("int")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_INT, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (only_type=V_INT, &
                   unit=u, pacified = pacified)
           case ("real")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_REAL, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (only_type=V_REAL, &
                   unit=u, pacified = pacified)
           case ("complex")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_CMPLX, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (only_type=V_CMPLX, &
                   unit=u, pacified = pacified)
           case ("pdg")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_PDG, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (only_type=V_PDG, &
                   unit=u, pacified = pacified)
           case ("string")
              if (associated (model_vars)) then
                 call model_vars%write (only_type=V_STR, &
                      model_name = name, unit=u, pacified = pacified, &
                      follow_link=.false.)
              end if
              call var_list%write (only_type=V_STR, &
                   unit=u, pacified = pacified)
           case default
              if (analysis_exists (cmd%name(i))) then
                 call analysis_write (cmd%name(i), u)
              else if (cmd%local%process_stack%exists (cmd%name(i))) then
                 process => cmd%local%process_stack%get_process_ptr (cmd%name(i))
                 call process%show (u)
              else if (associated (cmd%local%prclib_stack%get_library_ptr &
                   (cmd%name(i)))) then
                 prc_lib => cmd%local%prclib_stack%get_library_ptr (cmd%name(i))
                 call prc_lib%show (u)
              else if (associated (model_vars)) then
                 if (model_vars%contains (cmd%name(i), follow_link=.false.)) then
                    call model_vars%write_var (cmd%name(i), &
                         unit = u, model_name = name, pacified = pacified)
                 else if (var_list%contains (cmd%name(i))) then
                    call var_list%write_var (cmd%name(i), &
                         unit = u, pacified = pacified)
                 else
                    call msg_error ("show: object '" // char (cmd%name(i)) &
                         // "' not found")
                 end if
              else if (var_list%contains (cmd%name(i))) then
                 call var_list%write_var (cmd%name(i), &
                      unit = u, pacified = pacified)
              else
                 call msg_error ("show: object '" // char (cmd%name(i)) &
                      // "' not found")
              end if
           end select
        end do
     end if
     rewind (u)
     u_log = logfile_unit ()
     u_out = given_output_unit ()
     do
        read (u, "(A)", end = 1)  buffer
        if (u_log > 0)  write (u_log, "(A)")  trim (buffer)
        if (u_out > 0)  write (u_out, "(A)")  trim (buffer)
        if (u_ext > 0)  write (u_ext, "(A)")  trim (buffer)
     end do
 1   close (u)
     if (u_log > 0)  flush (u_log)
     if (u_out > 0)  flush (u_out)
     if (u_ext > 0)  flush (u_ext)
   end subroutine cmd_show_execute
 
 @ %def cmd_show_execute
 @
 \subsubsection{Clear values}
 This command clears the current values of variables or other objects,
 where this makes sense.  It parallels the [[show]] command.  The
 objects are cleared, but not deleted.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_clear_t
      private
      type(string_t), dimension(:), allocatable :: name
    contains
    <<Commands: cmd clear: TBP>>
   end type cmd_clear_t
 
 @ %def cmd_clear_t
 @ Output: list the names of the objects to be cleared.
 <<Commands: cmd clear: TBP>>=
   procedure :: write => cmd_clear_write
 <<Commands: procedures>>=
   subroutine cmd_clear_write (cmd, unit, indent)
     class(cmd_clear_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "clear: "
     if (allocated (cmd%name)) then
        do i = 1, size (cmd%name)
           write (u, "(1x,A)", advance="no")  char (cmd%name(i))
        end do
        write (u, *)
     else
        write (u, "(5x,A)")  "[undefined]"
     end if
   end subroutine cmd_clear_write
 
 @ %def cmd_clear_write
 @ Compile.  Allocate an array which is filled with the names of the
 objects to be cleared.
 
 Note: there is currently no need to account for options, but we
 prepare for that possibility.
 <<Commands: cmd clear: TBP>>=
   procedure :: compile => cmd_clear_compile
 <<Commands: procedures>>=
   subroutine cmd_clear_compile (cmd, global)
     class(cmd_clear_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
     type(string_t) :: key
     integer :: i, n_args
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (pn_arg)) then
        select case (char (parse_node_get_rule_key (pn_arg)))
        case ("clear_arg")
           cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
        case default
           cmd%pn_opt => pn_arg
           pn_arg => null ()
        end select
     end if
     call cmd%compile_options (global)
     if (associated (pn_arg)) then
        n_args = parse_node_get_n_sub (pn_arg)
        allocate (cmd%name (n_args))
        pn_var => parse_node_get_sub_ptr (pn_arg)
        i = 0
        do while (associated (pn_var))
           i = i + 1
           select case (char (parse_node_get_rule_key (pn_var)))
           case ("beams", "iterations", &
                 "cuts", "weight", &
                 "scale", "factorization_scale", "renormalization_scale", &
                 "selection", "reweight", "analysis", &
                 "unstable", "polarized", &
                 "expect")
              cmd%name(i) = parse_node_get_key (pn_var)
           case ("log_var", "string_var")
              pn_prefix => parse_node_get_sub_ptr (pn_var)
              pn_name => parse_node_get_next_ptr (pn_prefix)
              key = parse_node_get_key (pn_prefix)
              if (associated (pn_name)) then
                 select case (char (parse_node_get_rule_key (pn_name)))
                 case ("var_name")
                    select case (char (key))
                    case ("?", "$")  ! $ sign
                       cmd%name(i) = key // parse_node_get_string (pn_name)
                    end select
                 case default
                    call parse_node_mismatch &
                         ("var_name",  pn_name)
                 end select
              else
                 cmd%name(i) = key
              end if
           case default
              cmd%name(i) = parse_node_get_string (pn_var)
           end select
           pn_var => parse_node_get_next_ptr (pn_var)
        end do
     else
        allocate (cmd%name (0))
     end if
   end subroutine cmd_clear_compile
 
 @ %def cmd_clear_compile
 @ Execute.  Scan the list of objects to clear.
 
 Objects that can be shown but not cleared: model, library, results
 <<Commands: cmd clear: TBP>>=
   procedure :: execute => cmd_clear_execute
 <<Commands: procedures>>=
   subroutine cmd_clear_execute (cmd, global)
     class(cmd_clear_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     integer :: i
     logical :: success
     type(var_list_t), pointer :: model_vars
     if (size (cmd%name) == 0) then
        call msg_warning ("clear: no object specified")
     else
        do i = 1, size (cmd%name)
           success = .true.
           select case (char (cmd%name(i)))
           case ("beams")
              call cmd%local%clear_beams ()
           case ("iterations")
              call cmd%local%it_list%clear ()
           case ("polarized")
              call cmd%local%model%clear_polarized ()
           case ("unstable")
              call cmd%local%model%clear_unstable ()
           case ("cuts", "weight", "scale", &
                "factorization_scale", "renormalization_scale", &
                "selection", "reweight", "analysis")
              call cmd%local%pn%clear (cmd%name(i))
           case ("expect")
              call expect_clear ()
           case default
              if (analysis_exists (cmd%name(i))) then
                 call analysis_clear (cmd%name(i))
              else if (cmd%local%var_list%contains (cmd%name(i))) then
                 if (.not. cmd%local%var_list%is_locked (cmd%name(i))) then
                    call cmd%local%var_list%unset (cmd%name(i))
                 else
                    call msg_error ("clear: variable '" // char (cmd%name(i)) &
                         // "' is locked and can't be cleared")
                    success = .false.
                 end if
              else if (associated (cmd%local%model)) then
                 model_vars => cmd%local%model%get_var_list_ptr ()
                 if (model_vars%contains (cmd%name(i), follow_link=.false.)) then
                    call msg_error ("clear: variable '" // char (cmd%name(i)) &
                         // "' is a model variable and can't be cleared")
                 else
                    call msg_error ("clear: object '" // char (cmd%name(i)) &
                         // "' not found")
                 end if
                 success = .false.
              else
                 call msg_error ("clear: object '" // char (cmd%name(i)) &
                      // "' not found")
                 success = .false.
              end if
           end select
           if (success)  call msg_message ("cleared: " // char (cmd%name(i)))
        end do
     end if
   end subroutine cmd_clear_execute
 
 @ %def cmd_clear_execute
 @
 \subsubsection{Compare values of variables to expectation}
 The implementation is similar to the [[show]] command.  There are just
 two arguments: two values that should be compared.  For providing
 local values for the numerical tolerance, the command has a local
 argument list.
 
 If the expectation fails, an error condition is recorded.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_expect_t
      private
      type(parse_node_t), pointer :: pn_lexpr => null ()
    contains
    <<Commands: cmd expect: TBP>>
   end type cmd_expect_t
 
 @ %def cmd_expect_t
 @ Simply tell the status.
 <<Commands: cmd expect: TBP>>=
   procedure :: write => cmd_expect_write
 <<Commands: procedures>>=
   subroutine cmd_expect_write (cmd, unit, indent)
     class(cmd_expect_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     if (associated (cmd%pn_lexpr)) then
        write (u, "(1x,A)")  "expect: [expression associated]"
     else
        write (u, "(1x,A)")  "expect: [undefined]"
     end if
   end subroutine cmd_expect_write
 
 @ %def cmd_expect_write
 @ Compile.  This merely assigns the parse node, the actual compilation is done
 at execution.  This is necessary because the origin of variables
 (local/global) may change during execution.
 <<Commands: cmd expect: TBP>>=
   procedure :: compile => cmd_expect_compile
 <<Commands: procedures>>=
   subroutine cmd_expect_compile (cmd, global)
     class(cmd_expect_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
     cmd%pn_lexpr => parse_node_get_sub_ptr (pn_arg)
     call cmd%compile_options (global)
   end subroutine cmd_expect_compile
 
 @ %def cmd_expect_compile
 @ Execute.  Evaluate both arguments, print them and their difference
 (if numerical), and whether they agree.  Record the result.
 <<Commands: cmd expect: TBP>>=
   procedure :: execute => cmd_expect_execute
 <<Commands: procedures>>=
   subroutine cmd_expect_execute (cmd, global)
     class(cmd_expect_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     logical :: success, is_known
     var_list => cmd%local%get_var_list_ptr ()
     success = eval_log (cmd%pn_lexpr, var_list, is_known=is_known)
     if (is_known) then
        if (success) then
           call msg_message ("expect: success")
        else
           call msg_error ("expect: failure")
        end if
     else
        call msg_error ("expect: undefined result")
        success = .false.
     end if
     call expect_record (success)
   end subroutine cmd_expect_execute
 
 @ %def cmd_expect_execute
 @
 \subsubsection{Beams}
 The beam command includes both beam and structure-function
 definition.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_beams_t
      private
      integer :: n_in = 0
      type(parse_node_p), dimension(:), allocatable :: pn_pdg
      integer :: n_sf_record = 0
      integer, dimension(:), allocatable :: n_entry
      type(parse_node_p), dimension(:,:), allocatable :: pn_sf_entry
    contains
    <<Commands: cmd beams: TBP>>
   end type cmd_beams_t
 
 @ %def cmd_beams_t
 @ Output.  The particle expressions are not resolved.
 <<Commands: cmd beams: TBP>>=
   procedure :: write => cmd_beams_write
 <<Commands: procedures>>=
   subroutine cmd_beams_write (cmd, unit, indent)
     class(cmd_beams_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams: [undefined]"
     end select
     if (allocated (cmd%n_entry)) then
        if (cmd%n_sf_record > 0) then
           write (u, "(1x,A,99(1x,I0))")  "structure function entries:", &
                cmd%n_entry
        end if
     end if
   end subroutine cmd_beams_write
 
 @ %def cmd_beams_write
 @ Compile.  Find and assign the parse nodes.
 
 Note: local environments are not yet supported.
 <<Commands: cmd beams: TBP>>=
   procedure :: compile => cmd_beams_compile
 <<Commands: procedures>>=
   subroutine cmd_beams_compile (cmd, global)
     class(cmd_beams_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_beam_def, pn_beam_spec
     type(parse_node_t), pointer :: pn_beam_list
     type(parse_node_t), pointer :: pn_codes
     type(parse_node_t), pointer :: pn_strfun_seq, pn_strfun_pair
     type(parse_node_t), pointer :: pn_strfun_def
     integer :: i
     pn_beam_def => parse_node_get_sub_ptr (cmd%pn, 3)
     pn_beam_spec => parse_node_get_sub_ptr (pn_beam_def)
     pn_strfun_seq => parse_node_get_next_ptr (pn_beam_spec)
     pn_beam_list => parse_node_get_sub_ptr (pn_beam_spec)
     call cmd%compile_options (global)
     cmd%n_in = parse_node_get_n_sub (pn_beam_list)
     allocate (cmd%pn_pdg (cmd%n_in))
     pn_codes => parse_node_get_sub_ptr (pn_beam_list)
     do i = 1, cmd%n_in
        cmd%pn_pdg(i)%ptr => pn_codes
        pn_codes => parse_node_get_next_ptr (pn_codes)
     end do
     if (associated (pn_strfun_seq)) then
        cmd%n_sf_record = parse_node_get_n_sub (pn_beam_def) - 1
        allocate (cmd%n_entry (cmd%n_sf_record), source = 1)
        allocate (cmd%pn_sf_entry (2, cmd%n_sf_record))
        do i = 1, cmd%n_sf_record
           pn_strfun_pair => parse_node_get_sub_ptr (pn_strfun_seq, 2)
           pn_strfun_def => parse_node_get_sub_ptr (pn_strfun_pair)
           cmd%pn_sf_entry(1,i)%ptr => pn_strfun_def
           pn_strfun_def => parse_node_get_next_ptr (pn_strfun_def)
           cmd%pn_sf_entry(2,i)%ptr => pn_strfun_def
           if (associated (pn_strfun_def))  cmd%n_entry(i) = 2
           pn_strfun_seq => parse_node_get_next_ptr (pn_strfun_seq)
        end do
     else
        allocate (cmd%n_entry (0))
        allocate (cmd%pn_sf_entry (0, 0))
     end if
   end subroutine cmd_beams_compile
 
 @ %def cmd_beams_compile
 @ Command execution: Determine beam particles and structure-function
 names, if any.  The results are stored in the [[beam_structure]]
 component of the [[global]] data block.
 <<Commands: cmd beams: TBP>>=
   procedure :: execute => cmd_beams_execute
 <<Commands: procedures>>=
   subroutine cmd_beams_execute (cmd, global)
     class(cmd_beams_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(pdg_array_t) :: pdg_array
     integer, dimension(:), allocatable :: pdg
     type(flavor_t), dimension(:), allocatable :: flv
     type(parse_node_t), pointer :: pn_key
     type(string_t) :: sf_name
     integer :: i, j
     call lhapdf_global_reset ()
     var_list => cmd%local%get_var_list_ptr ()
     allocate (flv (cmd%n_in))
     do i = 1, cmd%n_in
        pdg_array = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
        pdg = pdg_array
        select case (size (pdg))
        case (1)
           call flv(i)%init ( pdg(1), cmd%local%model)
        case default
           call msg_fatal ("Beams: beam particles must be unique")
        end select
     end do
     select case (cmd%n_in)
     case (1)
        if (cmd%n_sf_record > 0) then
           call msg_fatal ("Beam setup: no structure functions allowed &
                &for decay")
        end if
        call global%beam_structure%init_sf (flv%get_name ())
     case (2)
        call global%beam_structure%init_sf (flv%get_name (), cmd%n_entry)
        do i = 1, cmd%n_sf_record
           do j = 1, cmd%n_entry(i)
              pn_key => parse_node_get_sub_ptr (cmd%pn_sf_entry(j,i)%ptr)
              sf_name = parse_node_get_key (pn_key)
              call global%beam_structure%set_sf (i, j, sf_name)
           end do
        end do
     end select
   end subroutine cmd_beams_execute
 
 @ %def cmd_beams_execute
 @
 \subsubsection{Density matrices for beam polarization}
 For holding beam polarization, we define a notation and a data
 structure for sparse matrices.  The entries (and the index
 expressions) are numerical expressions, so we use evaluation trees.
 
 Each entry in the sparse matrix is an n-tuple of expressions.  The first
 tuple elements represent index values, the last one is an arbitrary
 (complex) number.  Absent expressions are replaced by default-value rules.
 
 Note: Here, and in some other commands, we would like to store an evaluation
 tree, not just a parse node pointer.  However, the current expression handler
 wants all variables defined, so the evaluation tree can only be built by
 [[evaluate]], i.e., compiled just-in-time and evaluated immediately.
 <<Commands: types>>=
   type :: sentry_expr_t
      type(parse_node_p), dimension(:), allocatable :: expr
    contains
    <<Commands: sentry expr: TBP>>
   end type sentry_expr_t
 
 @ %def sentry_expr_t
 @ Compile parse nodes into evaluation trees.
 <<Commands: sentry expr: TBP>>=
   procedure :: compile => sentry_expr_compile
 <<Commands: procedures>>=
   subroutine sentry_expr_compile (sentry, pn)
     class(sentry_expr_t), intent(out) :: sentry
     type(parse_node_t), intent(in), target :: pn
     type(parse_node_t), pointer :: pn_expr, pn_extra
     integer :: n_expr, i
     n_expr = parse_node_get_n_sub (pn)
     allocate (sentry%expr (n_expr))
     if (n_expr > 0) then
        i = 0
        pn_expr => parse_node_get_sub_ptr (pn)
        pn_extra => parse_node_get_next_ptr (pn_expr)
        do i = 1, n_expr
           sentry%expr(i)%ptr => pn_expr
           if (associated (pn_extra)) then
              pn_expr => parse_node_get_sub_ptr (pn_extra, 2)
              pn_extra => parse_node_get_next_ptr (pn_extra)
           end if
        end do
     end if
   end subroutine sentry_expr_compile
 
 @ %def sentry_expr_compile
 @ Evaluate the expressions and return an index array of predefined
 length together with a complex value.  If the value (as the last expression)
 is undefined, set it to unity.  If index values are undefined, repeat
 the previous index value.
 <<Commands: sentry expr: TBP>>=
   procedure :: evaluate => sentry_expr_evaluate
 <<Commands: procedures>>=
   subroutine sentry_expr_evaluate (sentry, index, value, global)
     class(sentry_expr_t), intent(inout) :: sentry
     integer, dimension(:), intent(out) :: index
     complex(default), intent(out) :: value
     type(rt_data_t), intent(in), target :: global
     type(var_list_t), pointer :: var_list
     integer :: i, n_expr, n_index
     type(eval_tree_t) :: eval_tree
     var_list => global%get_var_list_ptr ()
     n_expr = size (sentry%expr)
     n_index = size (index)
     if (n_expr <= n_index + 1) then
        do i = 1, min (n_expr, n_index)
           associate (expr => sentry%expr(i))
             call eval_tree%init_expr (expr%ptr, var_list)
             call eval_tree%evaluate ()
             if (eval_tree%is_known ()) then
                index(i) = eval_tree%get_int ()
             else
                call msg_fatal ("Evaluating density matrix: undefined index")
             end if
           end associate
        end do
        do i = n_expr + 1, n_index
           index(i) = index(n_expr)
        end do
        if (n_expr == n_index + 1) then
           associate (expr => sentry%expr(n_expr))
             call eval_tree%init_expr (expr%ptr, var_list)
             call eval_tree%evaluate ()
             if (eval_tree%is_known ()) then
                value = eval_tree%get_cmplx ()
             else
                call msg_fatal ("Evaluating density matrix: undefined index")
             end if
             call eval_tree%final ()
           end associate
        else
           value = 1
        end if
     else
        call msg_fatal ("Evaluating density matrix: index expression too long")
     end if
   end subroutine sentry_expr_evaluate
 
 @ %def sentry_expr_evaluate
 @ The sparse matrix itself consists of an arbitrary number of entries.
 <<Commands: types>>=
   type :: smatrix_expr_t
      type(sentry_expr_t), dimension(:), allocatable :: entry
    contains
    <<Commands: smatrix expr: TBP>>
   end type smatrix_expr_t
 
 @ %def smatrix_expr_t
 @ Compile: assign sub-nodes to sentry-expressions and compile those.
 <<Commands: smatrix expr: TBP>>=
   procedure :: compile => smatrix_expr_compile
 <<Commands: procedures>>=
   subroutine smatrix_expr_compile (smatrix_expr, pn)
     class(smatrix_expr_t), intent(out) :: smatrix_expr
     type(parse_node_t), intent(in), target :: pn
     type(parse_node_t), pointer :: pn_arg, pn_entry
     integer :: n_entry, i
     pn_arg => parse_node_get_sub_ptr (pn, 2)
     if (associated (pn_arg)) then
        n_entry = parse_node_get_n_sub (pn_arg)
        allocate (smatrix_expr%entry (n_entry))
        pn_entry => parse_node_get_sub_ptr (pn_arg)
        do i = 1, n_entry
           call smatrix_expr%entry(i)%compile (pn_entry)
           pn_entry => parse_node_get_next_ptr (pn_entry)
        end do
     else
        allocate (smatrix_expr%entry (0))
     end if
   end subroutine smatrix_expr_compile
 
 @ %def smatrix_expr_compile
 @ Evaluate the entries and build a new [[smatrix]] object, which
 contains just the numerical results.
 <<Commands: smatrix expr: TBP>>=
   procedure :: evaluate => smatrix_expr_evaluate
 <<Commands: procedures>>=
   subroutine smatrix_expr_evaluate (smatrix_expr, smatrix, global)
     class(smatrix_expr_t), intent(inout) :: smatrix_expr
     type(smatrix_t), intent(out) :: smatrix
     type(rt_data_t), intent(in), target :: global
     integer, dimension(2) :: idx
     complex(default) :: value
     integer :: i, n_entry
     n_entry = size (smatrix_expr%entry)
     call smatrix%init (2, n_entry)
     do i = 1, n_entry
        call smatrix_expr%entry(i)%evaluate (idx, value, global)
        call smatrix%set_entry (i, idx, value)
     end do
   end subroutine smatrix_expr_evaluate
 
 @ %def smatrix_expr_evaluate
 @
 \subsubsection{Beam polarization density}
 
 The beam polarization command defines spin density matrix for one or
 two beams (scattering or decay).
 <<Commands: types>>=
   type, extends (command_t) :: cmd_beams_pol_density_t
      private
      integer :: n_in = 0
      type(smatrix_expr_t), dimension(:), allocatable :: smatrix
    contains
    <<Commands: cmd beams pol density: TBP>>
   end type cmd_beams_pol_density_t
 
 @ %def cmd_beams_pol_density_t
 @ Output.
 <<Commands: cmd beams pol density: TBP>>=
   procedure :: write => cmd_beams_pol_density_write
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_density_write (cmd, unit, indent)
     class(cmd_beams_pol_density_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams polarization setup: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams polarization setup: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams polarization setup: [undefined]"
     end select
   end subroutine cmd_beams_pol_density_write
 
 @ %def cmd_beams_pol_density_write
 @ Compile.  Find and assign the parse nodes.
 
 Note: local environments are not yet supported.
 <<Commands: cmd beams pol density: TBP>>=
   procedure :: compile => cmd_beams_pol_density_compile
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_density_compile (cmd, global)
     class(cmd_beams_pol_density_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_pol_spec, pn_smatrix
     integer :: i
     pn_pol_spec => parse_node_get_sub_ptr (cmd%pn, 3)
     call cmd%compile_options (global)
     cmd%n_in = parse_node_get_n_sub (pn_pol_spec)
     allocate (cmd%smatrix (cmd%n_in))
     pn_smatrix => parse_node_get_sub_ptr (pn_pol_spec)
     do i = 1, cmd%n_in
        call cmd%smatrix(i)%compile (pn_smatrix)
        pn_smatrix => parse_node_get_next_ptr (pn_smatrix)
     end do
   end subroutine cmd_beams_pol_density_compile
 
 @ %def cmd_beams_pol_density_compile
 @ Command execution: Fill polarization density matrices.  No check
 yet, the matrices are checked and normalized when the actual beam
 object is created, just before integration.  For intermediate storage,
 we use the [[beam_structure]] object in the [[global]] data set.
 <<Commands: cmd beams pol density: TBP>>=
   procedure :: execute => cmd_beams_pol_density_execute
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_density_execute (cmd, global)
     class(cmd_beams_pol_density_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(smatrix_t) :: smatrix
     integer :: i
     call global%beam_structure%init_pol (cmd%n_in)
     do i = 1, cmd%n_in
        call cmd%smatrix(i)%evaluate (smatrix, global)
        call global%beam_structure%set_smatrix (i, smatrix)
     end do
   end subroutine cmd_beams_pol_density_execute
 
 @ %def cmd_beams_pol_density_execute
 @
 \subsubsection{Beam polarization fraction}
 In addition to the polarization density matrix, we can independently
 specify the polarization fraction for one or both beams.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_beams_pol_fraction_t
      private
      integer :: n_in = 0
      type(parse_node_p), dimension(:), allocatable :: expr
    contains
    <<Commands: cmd beams pol fraction: TBP>>
   end type cmd_beams_pol_fraction_t
 
 @ %def cmd_beams_pol_fraction_t
 @ Output.
 <<Commands: cmd beams pol fraction: TBP>>=
   procedure :: write => cmd_beams_pol_fraction_write
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_fraction_write (cmd, unit, indent)
     class(cmd_beams_pol_fraction_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams polarization fraction: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams polarization fraction: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams polarization fraction: [undefined]"
     end select
   end subroutine cmd_beams_pol_fraction_write
 
 @ %def cmd_beams_pol_fraction_write
 @ Compile.  Find and assign the parse nodes.
 
 Note: local environments are not yet supported.
 <<Commands: cmd beams pol fraction: TBP>>=
   procedure :: compile => cmd_beams_pol_fraction_compile
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_fraction_compile (cmd, global)
     class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_frac_spec, pn_expr
     integer :: i
     pn_frac_spec => parse_node_get_sub_ptr (cmd%pn, 3)
     call cmd%compile_options (global)
     cmd%n_in = parse_node_get_n_sub (pn_frac_spec)
     allocate (cmd%expr (cmd%n_in))
     pn_expr => parse_node_get_sub_ptr (pn_frac_spec)
     do i = 1, cmd%n_in
        cmd%expr(i)%ptr => pn_expr
        pn_expr => parse_node_get_next_ptr (pn_expr)
     end do
   end subroutine cmd_beams_pol_fraction_compile
 
 @ %def cmd_beams_pol_fraction_compile
 @ Command execution: Retrieve the numerical values of the beam
 polarization fractions.  The results are stored in the
 [[beam_structure]] component of the [[global]] data block.
 <<Commands: cmd beams pol fraction: TBP>>=
   procedure :: execute => cmd_beams_pol_fraction_execute
 <<Commands: procedures>>=
   subroutine cmd_beams_pol_fraction_execute (cmd, global)
     class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default), dimension(:), allocatable :: pol_f
     type(eval_tree_t) :: expr
     integer :: i
     var_list => global%get_var_list_ptr ()
     allocate (pol_f (cmd%n_in))
     do i = 1, cmd%n_in
        call expr%init_expr (cmd%expr(i)%ptr, var_list)
        call expr%evaluate ()
        if (expr%is_known ()) then
           pol_f(i) = expr%get_real ()
        else
           call msg_fatal ("beams polarization fraction: undefined value")
        end if
        call expr%final ()
     end do
     call global%beam_structure%set_pol_f (pol_f)
   end subroutine cmd_beams_pol_fraction_execute
 
 @ %def cmd_beams_pol_fraction_execute
 @
 \subsubsection{Beam momentum}
 This is completely analogous to the previous command, hence we can use
 inheritance.
 <<Commands: types>>=
   type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_momentum_t
    contains
    <<Commands: cmd beams momentum: TBP>>
   end type cmd_beams_momentum_t
 
 @ %def cmd_beams_momentum_t
 @ Output.
 <<Commands: cmd beams momentum: TBP>>=
   procedure :: write => cmd_beams_momentum_write
 <<Commands: procedures>>=
   subroutine cmd_beams_momentum_write (cmd, unit, indent)
     class(cmd_beams_momentum_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams momentum: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams momentum: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams momentum: [undefined]"
     end select
   end subroutine cmd_beams_momentum_write
 
 @ %def cmd_beams_momentum_write
 @ Compile: inherited.
 
 Command execution: Not inherited, but just the error string and the final
 command are changed.
 <<Commands: cmd beams momentum: TBP>>=
   procedure :: execute => cmd_beams_momentum_execute
 <<Commands: procedures>>=
   subroutine cmd_beams_momentum_execute (cmd, global)
     class(cmd_beams_momentum_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default), dimension(:), allocatable :: p
     type(eval_tree_t) :: expr
     integer :: i
     var_list => global%get_var_list_ptr ()
     allocate (p (cmd%n_in))
     do i = 1, cmd%n_in
        call expr%init_expr (cmd%expr(i)%ptr, var_list)
        call expr%evaluate ()
        if (expr%is_known ()) then
           p(i) = expr%get_real ()
        else
           call msg_fatal ("beams momentum: undefined value")
        end if
        call expr%final ()
     end do
     call global%beam_structure%set_momentum (p)
   end subroutine cmd_beams_momentum_execute
 
 @ %def cmd_beams_momentum_execute
 @
 \subsubsection{Beam angles}
 Again, this is analogous.  There are two angles, polar angle $\theta$
 and azimuthal angle $\phi$, which can be set independently for both beams.
 <<Commands: types>>=
   type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_theta_t
    contains
    <<Commands: cmd beams theta: TBP>>
   end type cmd_beams_theta_t
 
   type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_phi_t
    contains
    <<Commands: cmd beams phi: TBP>>
   end type cmd_beams_phi_t
 
 @ %def cmd_beams_theta_t
 @ %def cmd_beams_phi_t
 @ Output.
 <<Commands: cmd beams theta: TBP>>=
   procedure :: write => cmd_beams_theta_write
 <<Commands: cmd beams phi: TBP>>=
   procedure :: write => cmd_beams_phi_write
 <<Commands: procedures>>=
   subroutine cmd_beams_theta_write (cmd, unit, indent)
     class(cmd_beams_theta_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams theta: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams theta: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams theta: [undefined]"
     end select
   end subroutine cmd_beams_theta_write
 
   subroutine cmd_beams_phi_write (cmd, unit, indent)
     class(cmd_beams_phi_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_in)
     case (1)
        write (u, "(1x,A)")  "beams phi: 1 [decay]"
     case (2)
        write (u, "(1x,A)")  "beams phi: 2 [scattering]"
     case default
        write (u, "(1x,A)")  "beams phi: [undefined]"
     end select
   end subroutine cmd_beams_phi_write
 
 @ %def cmd_beams_theta_write
 @ %def cmd_beams_phi_write
 @ Compile: inherited.
 
 Command execution: Not inherited, but just the error string and the final
 command are changed.
 <<Commands: cmd beams theta: TBP>>=
   procedure :: execute => cmd_beams_theta_execute
 <<Commands: cmd beams phi: TBP>>=
   procedure :: execute => cmd_beams_phi_execute
 <<Commands: procedures>>=
   subroutine cmd_beams_theta_execute (cmd, global)
     class(cmd_beams_theta_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default), dimension(:), allocatable :: theta
     type(eval_tree_t) :: expr
     integer :: i
     var_list => global%get_var_list_ptr ()
     allocate (theta (cmd%n_in))
     do i = 1, cmd%n_in
        call expr%init_expr (cmd%expr(i)%ptr, var_list)
        call expr%evaluate ()
        if (expr%is_known ()) then
           theta(i) = expr%get_real ()
        else
           call msg_fatal ("beams theta: undefined value")
        end if
        call expr%final ()
     end do
     call global%beam_structure%set_theta (theta)
   end subroutine cmd_beams_theta_execute
 
   subroutine cmd_beams_phi_execute (cmd, global)
     class(cmd_beams_phi_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default), dimension(:), allocatable :: phi
     type(eval_tree_t) :: expr
     integer :: i
     var_list => global%get_var_list_ptr ()
     allocate (phi (cmd%n_in))
     do i = 1, cmd%n_in
        call expr%init_expr (cmd%expr(i)%ptr, var_list)
        call expr%evaluate ()
        if (expr%is_known ()) then
           phi(i) = expr%get_real ()
        else
           call msg_fatal ("beams phi: undefined value")
        end if
        call expr%final ()
     end do
     call global%beam_structure%set_phi (phi)
   end subroutine cmd_beams_phi_execute
 
 @ %def cmd_beams_theta_execute
 @ %def cmd_beams_phi_execute
 @
 \subsubsection{Cuts}
 Define a cut expression.  We store the parse tree for the right-hand
 side instead of compiling it.  Compilation is deferred to the process
 environment where the cut expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_cuts_t
      private
      type(parse_node_t), pointer :: pn_lexpr => null ()
    contains
    <<Commands: cmd cuts: TBP>>
   end type cmd_cuts_t
 
 @ %def cmd_cuts_t
 @ Output.  Do not print the parse tree, since this may get cluttered.
 Just a message that cuts have been defined.
 <<Commands: cmd cuts: TBP>>=
   procedure :: write => cmd_cuts_write
 <<Commands: procedures>>=
   subroutine cmd_cuts_write (cmd, unit, indent)
     class(cmd_cuts_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "cuts: [defined]"
   end subroutine cmd_cuts_write
 
 @ %def cmd_cuts_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd cuts: TBP>>=
   procedure :: compile => cmd_cuts_compile
 <<Commands: procedures>>=
   subroutine cmd_cuts_compile (cmd, global)
     class(cmd_cuts_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_cuts_compile
 
 @ %def cmd_cuts_compile
 @ Instead of evaluating the cut expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd cuts: TBP>>=
   procedure :: execute => cmd_cuts_execute
 <<Commands: procedures>>=
   subroutine cmd_cuts_execute (cmd, global)
     class(cmd_cuts_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%cuts_lexpr => cmd%pn_lexpr
   end subroutine cmd_cuts_execute
 
 @ %def cmd_cuts_execute
 @
 \subsubsection{General, Factorization and Renormalization Scales}
 Define a scale expression for either the renormalization or the
 factorization scale.  We store the parse tree for the right-hand
 side instead of compiling it.  Compilation is deferred to the process
 environment where the expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_scale_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd scale: TBP>>
   end type cmd_scale_t
 
 @ %def cmd_scale_t
 <<Commands: types>>=
   type, extends (command_t) :: cmd_fac_scale_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd fac scale: TBP>>
   end type cmd_fac_scale_t
 
 @ %def cmd_fac_scale_t
 <<Commands: types>>=
   type, extends (command_t) :: cmd_ren_scale_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd ren scale: TBP>>
   end type cmd_ren_scale_t
 
 @ %def cmd_ren_scale_t
 @ Output. Do not print the parse tree, since this may get cluttered.
 Just a message that scale, renormalization and factorization have been
 defined, respectively.
 <<Commands: cmd scale: TBP>>=
   procedure :: write => cmd_scale_write
 <<Commands: procedures>>=
   subroutine cmd_scale_write (cmd, unit, indent)
     class(cmd_scale_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "scale: [defined]"
   end subroutine cmd_scale_write
 
 @ %def cmd_scale_write
 @
 <<Commands: cmd fac scale: TBP>>=
   procedure :: write => cmd_fac_scale_write
 <<Commands: procedures>>=
   subroutine cmd_fac_scale_write (cmd, unit, indent)
     class(cmd_fac_scale_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "factorization scale: [defined]"
   end subroutine cmd_fac_scale_write
 
 @ %def cmd_fac_scale_write
 @
 <<Commands: cmd ren scale: TBP>>=
   procedure :: write => cmd_ren_scale_write
 <<Commands: procedures>>=
   subroutine cmd_ren_scale_write (cmd, unit, indent)
     class(cmd_ren_scale_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "renormalization scale: [defined]"
   end subroutine cmd_ren_scale_write
 
 @ %def cmd_ren_scale_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd scale: TBP>>=
   procedure :: compile => cmd_scale_compile
 <<Commands: procedures>>=
   subroutine cmd_scale_compile (cmd, global)
     class(cmd_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_scale_compile
 
 @ %def cmd_scale_compile
 @
 <<Commands: cmd fac scale: TBP>>=
   procedure :: compile => cmd_fac_scale_compile
 <<Commands: procedures>>=
   subroutine cmd_fac_scale_compile (cmd, global)
     class(cmd_fac_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_fac_scale_compile
 
 @ %def cmd_fac_scale_compile
 @
 <<Commands: cmd ren scale: TBP>>=
   procedure :: compile => cmd_ren_scale_compile
 <<Commands: procedures>>=
   subroutine cmd_ren_scale_compile (cmd, global)
     class(cmd_ren_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_ren_scale_compile
 
 @ %def cmd_ren_scale_compile
 @ Instead of evaluating the scale expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd scale: TBP>>=
   procedure :: execute => cmd_scale_execute
 <<Commands: procedures>>=
   subroutine cmd_scale_execute (cmd, global)
     class(cmd_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%scale_expr => cmd%pn_expr
   end subroutine cmd_scale_execute
 
 @ %def cmd_scale_execute
 @
 <<Commands: cmd fac scale: TBP>>=
   procedure :: execute => cmd_fac_scale_execute
 <<Commands: procedures>>=
   subroutine cmd_fac_scale_execute (cmd, global)
     class(cmd_fac_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%fac_scale_expr => cmd%pn_expr
   end subroutine cmd_fac_scale_execute
 
 @ %def cmd_fac_scale_execute
 @
 <<Commands: cmd ren scale: TBP>>=
   procedure :: execute => cmd_ren_scale_execute
 <<Commands: procedures>>=
   subroutine cmd_ren_scale_execute (cmd, global)
     class(cmd_ren_scale_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%ren_scale_expr => cmd%pn_expr
   end subroutine cmd_ren_scale_execute
 
 @ %def cmd_ren_scale_execute
 @
 \subsubsection{Weight}
 Define a weight expression. The weight is applied to a process to be
 integrated, event by event. We store the parse tree for the right-hand
 side instead of compiling it. Compilation is deferred to the process
 environment where the expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_weight_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd weight: TBP>>
   end type cmd_weight_t
 
 @ %def cmd_weight_t
 @ Output. Do not print the parse tree, since this may get cluttered.
 Just a message that scale, renormalization and factorization have been
 defined, respectively.
 <<Commands: cmd weight: TBP>>=
   procedure :: write => cmd_weight_write
 <<Commands: procedures>>=
   subroutine cmd_weight_write (cmd, unit, indent)
     class(cmd_weight_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "weight expression: [defined]"
   end subroutine cmd_weight_write
 
 @ %def cmd_weight_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd weight: TBP>>=
   procedure :: compile => cmd_weight_compile
 <<Commands: procedures>>=
   subroutine cmd_weight_compile (cmd, global)
     class(cmd_weight_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_weight_compile
 
 @ %def cmd_weight_compile
 @ Instead of evaluating the expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd weight: TBP>>=
   procedure :: execute => cmd_weight_execute
 <<Commands: procedures>>=
   subroutine cmd_weight_execute (cmd, global)
     class(cmd_weight_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%weight_expr => cmd%pn_expr
   end subroutine cmd_weight_execute
 
 @ %def cmd_weight_execute
 @
 \subsubsection{Selection}
 Define a selection expression.  This is to be applied upon simulation or
 event-file rescanning, event by event.  We store the parse tree for the
 right-hand side instead of compiling it.  Compilation is deferred to the
 environment where the expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_selection_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd selection: TBP>>
   end type cmd_selection_t
 
 @ %def cmd_selection_t
 @ Output. Do not print the parse tree, since this may get cluttered.
 Just a message that scale, renormalization and factorization have been
 defined, respectively.
 <<Commands: cmd selection: TBP>>=
   procedure :: write => cmd_selection_write
 <<Commands: procedures>>=
   subroutine cmd_selection_write (cmd, unit, indent)
     class(cmd_selection_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "selection expression: [defined]"
   end subroutine cmd_selection_write
 
 @ %def cmd_selection_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd selection: TBP>>=
   procedure :: compile => cmd_selection_compile
 <<Commands: procedures>>=
   subroutine cmd_selection_compile (cmd, global)
     class(cmd_selection_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_selection_compile
 
 @ %def cmd_selection_compile
 @ Instead of evaluating the expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd selection: TBP>>=
   procedure :: execute => cmd_selection_execute
 <<Commands: procedures>>=
   subroutine cmd_selection_execute (cmd, global)
     class(cmd_selection_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%selection_lexpr => cmd%pn_expr
   end subroutine cmd_selection_execute
 
 @ %def cmd_selection_execute
 @
 \subsubsection{Reweight}
 Define a reweight expression.  This is to be applied upon simulation or
 event-file rescanning, event by event.  We store the parse tree for the
 right-hand side instead of compiling it.  Compilation is deferred to the
 environment where the expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_reweight_t
      private
      type(parse_node_t), pointer :: pn_expr => null ()
    contains
    <<Commands: cmd reweight: TBP>>
   end type cmd_reweight_t
 
 @ %def cmd_reweight_t
 @ Output. Do not print the parse tree, since this may get cluttered.
 Just a message that scale, renormalization and factorization have been
 defined, respectively.
 <<Commands: cmd reweight: TBP>>=
   procedure :: write => cmd_reweight_write
 <<Commands: procedures>>=
   subroutine cmd_reweight_write (cmd, unit, indent)
     class(cmd_reweight_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "reweight expression: [defined]"
   end subroutine cmd_reweight_write
 
 @ %def cmd_reweight_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd reweight: TBP>>=
   procedure :: compile => cmd_reweight_compile
 <<Commands: procedures>>=
   subroutine cmd_reweight_compile (cmd, global)
     class(cmd_reweight_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_reweight_compile
 
 @ %def cmd_reweight_compile
 @ Instead of evaluating the expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd reweight: TBP>>=
   procedure :: execute => cmd_reweight_execute
 <<Commands: procedures>>=
   subroutine cmd_reweight_execute (cmd, global)
     class(cmd_reweight_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%reweight_expr => cmd%pn_expr
   end subroutine cmd_reweight_execute
 
 @ %def cmd_reweight_execute
 @
 \subsubsection{Alternative Simulation Setups}
 Together with simulation, we can re-evaluate event weights in the context of
 alternative setups.  The [[cmd_alt_setup_t]] object is designed to hold these
 setups, which are brace-enclosed command lists.  Compilation is deferred to
 the simulation environment where the setup expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_alt_setup_t
      private
      type(parse_node_p), dimension(:), allocatable :: setup
    contains
    <<Commands: cmd alt setup: TBP>>
   end type cmd_alt_setup_t
 
 @ %def cmd_alt_setup_t
 @ Output.  Print just a message that the alternative setup list has been
 defined.
 <<Commands: cmd alt setup: TBP>>=
   procedure :: write => cmd_alt_setup_write
 <<Commands: procedures>>=
   subroutine cmd_alt_setup_write (cmd, unit, indent)
     class(cmd_alt_setup_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,I0,A)")  "alt_setup: ", size (cmd%setup), " entries"
   end subroutine cmd_alt_setup_write
 
 @ %def cmd_alt_setup_write
 @ Compile.  Store the parse sub-trees in an array.
 <<Commands: cmd alt setup: TBP>>=
   procedure :: compile => cmd_alt_setup_compile
 <<Commands: procedures>>=
   subroutine cmd_alt_setup_compile (cmd, global)
     class(cmd_alt_setup_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_list, pn_setup
     integer :: i
     pn_list => parse_node_get_sub_ptr (cmd%pn, 3)
     if (associated (pn_list)) then
        allocate (cmd%setup (parse_node_get_n_sub (pn_list)))
        i = 1
        pn_setup => parse_node_get_sub_ptr (pn_list)
        do while (associated (pn_setup))
           cmd%setup(i)%ptr => pn_setup
           i = i + 1
           pn_setup => parse_node_get_next_ptr (pn_setup)
        end do
     else
        allocate (cmd%setup (0))
     end if
   end subroutine cmd_alt_setup_compile
 
 @ %def cmd_alt_setup_compile
 @ Execute.  Transfer the array of command lists to the global environment.
 <<Commands: cmd alt setup: TBP>>=
   procedure :: execute => cmd_alt_setup_execute
 <<Commands: procedures>>=
   subroutine cmd_alt_setup_execute (cmd, global)
     class(cmd_alt_setup_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (allocated (global%pn%alt_setup))  deallocate (global%pn%alt_setup)
     allocate (global%pn%alt_setup (size (cmd%setup)))
     global%pn%alt_setup = cmd%setup
   end subroutine cmd_alt_setup_execute
 
 @ %def cmd_alt_setup_execute
 @
 \subsubsection{Integration}
 Integrate several processes, consecutively with identical parameters.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_integrate_t
      private
      integer :: n_proc = 0
      type(string_t), dimension(:), allocatable :: process_id
    contains
    <<Commands: cmd integrate: TBP>>
   end type cmd_integrate_t
 
 @ %def cmd_integrate_t
 @ Output: we know the process IDs.
 <<Commands: cmd integrate: TBP>>=
   procedure :: write => cmd_integrate_write
 <<Commands: procedures>>=
   subroutine cmd_integrate_write (cmd, unit, indent)
     class(cmd_integrate_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "integrate ("
     do i = 1, cmd%n_proc
        if (i > 1)  write (u, "(A,1x)", advance="no")  ","
        write (u, "(A)", advance="no")  char (cmd%process_id(i))
     end do
     write (u, "(A)")  ")"
   end subroutine cmd_integrate_write
 
 @ %def cmd_integrate_write
 @ Compile.
 <<Commands: cmd integrate: TBP>>=
   procedure :: compile => cmd_integrate_compile
 <<Commands: procedures>>=
   subroutine cmd_integrate_compile (cmd, global)
     class(cmd_integrate_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_proclist, pn_proc
     integer :: i
     pn_proclist => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
     call cmd%compile_options (global)
     cmd%n_proc = parse_node_get_n_sub (pn_proclist)
     allocate (cmd%process_id (cmd%n_proc))
     pn_proc => parse_node_get_sub_ptr (pn_proclist)
     do i = 1, cmd%n_proc
        cmd%process_id(i) = parse_node_get_string (pn_proc)
        call global%process_stack%init_result_vars (cmd%process_id(i))
        pn_proc => parse_node_get_next_ptr (pn_proc)
     end do
   end subroutine cmd_integrate_compile
 
 @ %def cmd_integrate_compile
 @ Command execution.  Integrate the process(es) with the predefined number
 of passes, iterations and calls.  For structure functions, cuts,
 weight and scale, use local definitions if present; by default, the local
 definitions are initialized with the global ones.
 
 The [[integrate]] procedure should take its input from the currently
 active local environment, but produce a process record in the stack of
 the global environment.
 
 Since the process acquires a snapshot of the variable list, so if the global
 list (or the local one) is deleted, this does no harm.  This implies that
 later changes of the variable list do not affect the stored process.
 <<Commands: cmd integrate: TBP>>=
   procedure :: execute => cmd_integrate_execute
 <<Commands: procedures>>=
   subroutine cmd_integrate_execute (cmd, global)
     class(cmd_integrate_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     integer :: i
     call msg_debug (D_CORE, "cmd_integrate_execute")
     do i = 1, cmd%n_proc
        call msg_debug (D_CORE, "cmd%process_id(i) ", cmd%process_id(i))
        call integrate_process (cmd%process_id(i), cmd%local, global)
        call global%process_stack%fill_result_vars (cmd%process_id(i))
        call global%process_stack%update_result_vars &
             (cmd%process_id(i), global%var_list)
        if (signal_is_pending ())  return
     end do
   end subroutine cmd_integrate_execute
 
 @ %def cmd_integrate_execute
 @
 \subsubsection{Observables}
 Declare an observable.  After the declaration, it can be used to
 record data, and at the end one can retrieve average and error.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_observable_t
      private
      type(string_t) :: id
    contains
    <<Commands: cmd observable: TBP>>
   end type cmd_observable_t
 
 @ %def cmd_observable_t
 @ Output.  We know the ID.
 <<Commands: cmd observable: TBP>>=
   procedure :: write => cmd_observable_write
 <<Commands: procedures>>=
   subroutine cmd_observable_write (cmd, unit, indent)
     class(cmd_observable_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A)")  "observable: ", char (cmd%id)
   end subroutine cmd_observable_write
 
 @ %def cmd_observable_write
 @ Compile.  Just record the observable ID.
 <<Commands: cmd observable: TBP>>=
   procedure :: compile => cmd_observable_compile
 <<Commands: procedures>>=
   subroutine cmd_observable_compile (cmd, global)
     class(cmd_observable_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_tag
     pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (pn_tag)) then
        cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
     end if
     call cmd%compile_options (global)
     select case (char (parse_node_get_rule_key (pn_tag)))
     case ("analysis_id")
        cmd%id = parse_node_get_string (pn_tag)
     case default
        call msg_bug ("observable: name expression not implemented (yet)")
     end select
   end subroutine cmd_observable_compile
 
 @ %def cmd_observable_compile
 @ Command execution.  This declares the observable and allocates it in
 the analysis store.
 <<Commands: cmd observable: TBP>>=
   procedure :: execute => cmd_observable_execute
 <<Commands: procedures>>=
   subroutine cmd_observable_execute (cmd, global)
     class(cmd_observable_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(graph_options_t) :: graph_options
     type(string_t) :: label, unit
     var_list => cmd%local%get_var_list_ptr ()
     label = var_list%get_sval (var_str ("$obs_label"))
     unit = var_list%get_sval (var_str ("$obs_unit"))
     call graph_options_init (graph_options)
     call set_graph_options (graph_options, var_list)
     call analysis_init_observable (cmd%id, label, unit, graph_options)
   end subroutine cmd_observable_execute
 
 @ %def cmd_observable_execute
 @
 \subsubsection{Histograms}
 Declare a histogram.  At minimum, we have to set lower and upper bound
 and bin width.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_histogram_t
      private
      type(string_t) :: id
      type(parse_node_t), pointer :: pn_lower_bound => null ()
      type(parse_node_t), pointer :: pn_upper_bound => null ()
      type(parse_node_t), pointer :: pn_bin_width => null ()
    contains
    <<Commands: cmd histogram: TBP>>
   end type cmd_histogram_t
 
 @ %def cmd_histogram_t
 @ Output.  Just print the ID.
 <<Commands: cmd histogram: TBP>>=
   procedure :: write => cmd_histogram_write
 <<Commands: procedures>>=
   subroutine cmd_histogram_write (cmd, unit, indent)
     class(cmd_histogram_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A)")  "histogram: ", char (cmd%id)
   end subroutine cmd_histogram_write
 
 @ %def cmd_histogram_write
 @ Compile.  Record the histogram ID and initialize lower, upper bound
 and bin width.
 <<Commands: cmd histogram: TBP>>=
   procedure :: compile => cmd_histogram_compile
 <<Commands: procedures>>=
   subroutine cmd_histogram_compile (cmd, global)
     class(cmd_histogram_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_tag, pn_args, pn_arg1, pn_arg2, pn_arg3
     character(*), parameter :: e_illegal_use = &
        "illegal usage of 'histogram': insufficient number of arguments"
     pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_args => parse_node_get_next_ptr (pn_tag)
     if (associated (pn_args)) then
        pn_arg1 => parse_node_get_sub_ptr (pn_args)
        if (.not. associated (pn_arg1)) call msg_fatal (e_illegal_use)
        pn_arg2 => parse_node_get_next_ptr (pn_arg1)
        if (.not. associated (pn_arg2)) call msg_fatal (e_illegal_use)
        pn_arg3 => parse_node_get_next_ptr (pn_arg2)
        cmd%pn_opt => parse_node_get_next_ptr (pn_args)
     end if
     call cmd%compile_options (global)
     select case (char (parse_node_get_rule_key (pn_tag)))
     case ("analysis_id")
        cmd%id = parse_node_get_string (pn_tag)
     case default
        call msg_bug ("histogram: name expression not implemented (yet)")
     end select
     cmd%pn_lower_bound => pn_arg1
     cmd%pn_upper_bound => pn_arg2
     cmd%pn_bin_width => pn_arg3
   end subroutine cmd_histogram_compile
 
 @ %def cmd_histogram_compile
 @ Command execution.  This declares the histogram and allocates it in
 the analysis store.
 <<Commands: cmd histogram: TBP>>=
   procedure :: execute => cmd_histogram_execute
 <<Commands: procedures>>=
   subroutine cmd_histogram_execute (cmd, global)
     class(cmd_histogram_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     real(default) :: lower_bound, upper_bound, bin_width
     integer :: bin_number
     logical :: bin_width_is_used, normalize_bins
     type(string_t) :: obs_label, obs_unit
     type(graph_options_t) :: graph_options
     type(drawing_options_t) :: drawing_options
 
     var_list => cmd%local%get_var_list_ptr ()
     lower_bound = eval_real (cmd%pn_lower_bound, var_list)
     upper_bound = eval_real (cmd%pn_upper_bound, var_list)
     if (associated (cmd%pn_bin_width)) then
        bin_width = eval_real (cmd%pn_bin_width, var_list)
        bin_width_is_used = .true.
     else if (var_list%is_known (var_str ("n_bins"))) then
        bin_number = &
             var_list%get_ival (var_str ("n_bins"))
        bin_width_is_used = .false.
     else
        call msg_error ("Cmd '" // char (cmd%id) // &
             "': neither bin width nor number is defined")
     end if
     normalize_bins = &
          var_list%get_lval (var_str ("?normalize_bins"))
     obs_label = &
          var_list%get_sval (var_str ("$obs_label"))
     obs_unit = &
          var_list%get_sval (var_str ("$obs_unit"))
 
     call graph_options_init (graph_options)
     call set_graph_options (graph_options, var_list)
     call drawing_options_init_histogram (drawing_options)
     call set_drawing_options (drawing_options, var_list)
 
     if (bin_width_is_used) then
        call analysis_init_histogram &
             (cmd%id, lower_bound, upper_bound, bin_width, &
              normalize_bins, &
              obs_label, obs_unit, &
              graph_options, drawing_options)
     else
        call analysis_init_histogram &
             (cmd%id, lower_bound, upper_bound, bin_number, &
              normalize_bins, &
              obs_label, obs_unit, &
              graph_options, drawing_options)
     end if
   end subroutine cmd_histogram_execute
 
 @ %def cmd_histogram_execute
 @ Set the graph options from a variable list.
 <<Commands: procedures>>=
   subroutine set_graph_options (gro, var_list)
     type(graph_options_t), intent(inout) :: gro
     type(var_list_t), intent(in) :: var_list
     call graph_options_set (gro, title = &
          var_list%get_sval (var_str ("$title")))
     call graph_options_set (gro, description = &
          var_list%get_sval (var_str ("$description")))
     call graph_options_set (gro, x_label = &
          var_list%get_sval (var_str ("$x_label")))
     call graph_options_set (gro, y_label = &
          var_list%get_sval (var_str ("$y_label")))
     call graph_options_set (gro, width_mm = &
          var_list%get_ival (var_str ("graph_width_mm")))
     call graph_options_set (gro, height_mm = &
          var_list%get_ival (var_str ("graph_height_mm")))
     call graph_options_set (gro, x_log = &
          var_list%get_lval (var_str ("?x_log")))
     call graph_options_set (gro, y_log = &
          var_list%get_lval (var_str ("?y_log")))
     if (var_list%is_known (var_str ("x_min"))) &
          call graph_options_set (gro, x_min = &
          var_list%get_rval (var_str ("x_min")))
     if (var_list%is_known (var_str ("x_max"))) &
          call graph_options_set (gro, x_max = &
          var_list%get_rval (var_str ("x_max")))
     if (var_list%is_known (var_str ("y_min"))) &
          call graph_options_set (gro, y_min = &
          var_list%get_rval (var_str ("y_min")))
     if (var_list%is_known (var_str ("y_max"))) &
          call graph_options_set (gro, y_max = &
          var_list%get_rval (var_str ("y_max")))
     call graph_options_set (gro, gmlcode_bg = &
          var_list%get_sval (var_str ("$gmlcode_bg")))
     call graph_options_set (gro, gmlcode_fg = &
          var_list%get_sval (var_str ("$gmlcode_fg")))
   end subroutine set_graph_options
 
 @ %def set_graph_options
 @ Set the drawing options from a variable list.
 <<Commands: procedures>>=
   subroutine set_drawing_options (dro, var_list)
     type(drawing_options_t), intent(inout) :: dro
     type(var_list_t), intent(in) :: var_list
     if (var_list%is_known (var_str ("?draw_histogram"))) then
        if (var_list%get_lval (var_str ("?draw_histogram"))) then
           call drawing_options_set (dro, with_hbars = .true.)
        else
           call drawing_options_set (dro, with_hbars = .false., &
                with_base = .false., fill = .false., piecewise = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?draw_base"))) then
        if (var_list%get_lval (var_str ("?draw_base"))) then
           call drawing_options_set (dro, with_base = .true.)
        else
           call drawing_options_set (dro, with_base = .false., fill = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?draw_piecewise"))) then
        if (var_list%get_lval (var_str ("?draw_piecewise"))) then
           call drawing_options_set (dro, piecewise = .true.)
        else
           call drawing_options_set (dro, piecewise = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?fill_curve"))) then
        if (var_list%get_lval (var_str ("?fill_curve"))) then
           call drawing_options_set (dro, fill = .true., with_base = .true.)
        else
           call drawing_options_set (dro, fill = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?draw_curve"))) then
        if (var_list%get_lval (var_str ("?draw_curve"))) then
           call drawing_options_set (dro, draw = .true.)
        else
           call drawing_options_set (dro, draw = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?draw_errors"))) then
        if (var_list%get_lval (var_str ("?draw_errors"))) then
           call drawing_options_set (dro, err = .true.)
        else
           call drawing_options_set (dro, err = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("?draw_symbols"))) then
        if (var_list%get_lval (var_str ("?draw_symbols"))) then
           call drawing_options_set (dro, symbols = .true.)
        else
           call drawing_options_set (dro, symbols = .false.)
        end if
     end if
     if (var_list%is_known (var_str ("$fill_options"))) then
        call drawing_options_set (dro, fill_options = &
             var_list%get_sval (var_str ("$fill_options")))
     end if
     if (var_list%is_known (var_str ("$draw_options"))) then
        call drawing_options_set (dro, draw_options = &
             var_list%get_sval (var_str ("$draw_options")))
     end if
     if (var_list%is_known (var_str ("$err_options"))) then
        call drawing_options_set (dro, err_options = &
             var_list%get_sval (var_str ("$err_options")))
     end if
     if (var_list%is_known (var_str ("$symbol"))) then
        call drawing_options_set (dro, symbol = &
             var_list%get_sval (var_str ("$symbol")))
     end if
     if (var_list%is_known (var_str ("$gmlcode_bg"))) then
        call drawing_options_set (dro, gmlcode_bg = &
             var_list%get_sval (var_str ("$gmlcode_bg")))
     end if
     if (var_list%is_known (var_str ("$gmlcode_fg"))) then
        call drawing_options_set (dro, gmlcode_fg = &
             var_list%get_sval (var_str ("$gmlcode_fg")))
     end if
   end subroutine set_drawing_options
 
 @ %def set_drawing_options
 @
 \subsubsection{Plots}
 Declare a plot.  No mandatory arguments, just options.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_plot_t
      private
      type(string_t) :: id
    contains
    <<Commands: cmd plot: TBP>>
   end type cmd_plot_t
 
 @ %def cmd_plot_t
 @ Output.  Just print the ID.
 <<Commands: cmd plot: TBP>>=
   procedure :: write => cmd_plot_write
 <<Commands: procedures>>=
   subroutine cmd_plot_write (cmd, unit, indent)
     class(cmd_plot_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A)")  "plot: ", char (cmd%id)
   end subroutine cmd_plot_write
 
 @ %def cmd_plot_write
 @ Compile.  Record the plot ID and initialize lower, upper bound
 and bin width.
 <<Commands: cmd plot: TBP>>=
   procedure :: compile => cmd_plot_compile
 <<Commands: procedures>>=
   subroutine cmd_plot_compile (cmd, global)
     class(cmd_plot_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_tag
     pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
     call cmd%init (pn_tag, global)
   end subroutine cmd_plot_compile
 
 @ %def cmd_plot_compile
 @ This init routine is separated because it is reused below for graph
 initialization.
 <<Commands: cmd plot: TBP>>=
   procedure :: init => cmd_plot_init
 <<Commands: procedures>>=
   subroutine cmd_plot_init (plot, pn_tag, global)
     class(cmd_plot_t), intent(inout) :: plot
     type(parse_node_t), intent(in), pointer :: pn_tag
     type(rt_data_t), intent(inout), target :: global
     call plot%compile_options (global)
     select case (char (parse_node_get_rule_key (pn_tag)))
     case ("analysis_id")
        plot%id = parse_node_get_string (pn_tag)
     case default
        call msg_bug ("plot: name expression not implemented (yet)")
     end select
   end subroutine cmd_plot_init
 
 @ %def cmd_plot_init
 @ Command execution.  This declares the plot and allocates it in
 the analysis store.
 <<Commands: cmd plot: TBP>>=
   procedure :: execute => cmd_plot_execute
 <<Commands: procedures>>=
   subroutine cmd_plot_execute (cmd, global)
     class(cmd_plot_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(graph_options_t) :: graph_options
     type(drawing_options_t) :: drawing_options
 
     var_list => cmd%local%get_var_list_ptr ()
     call graph_options_init (graph_options)
     call set_graph_options (graph_options, var_list)
     call drawing_options_init_plot (drawing_options)
     call set_drawing_options (drawing_options, var_list)
 
     call analysis_init_plot (cmd%id, graph_options, drawing_options)
   end subroutine cmd_plot_execute
 
 @ %def cmd_plot_execute
 @
 \subsubsection{Graphs}
 Declare a graph.  The graph is defined in terms of its contents.  Both the
 graph and its contents may carry options.
 
 The graph object contains its own ID as well as the IDs of its elements.  For
 the elements, we reuse the [[cmd_plot_t]] defined above.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_graph_t
      private
      type(string_t) :: id
      integer :: n_elements = 0
      type(cmd_plot_t), dimension(:), allocatable :: el
      type(string_t), dimension(:), allocatable :: element_id
    contains
    <<Commands: cmd graph: TBP>>
   end type cmd_graph_t
 
 @ %def cmd_graph_t
 @ Output.  Just print the ID.
 <<Commands: cmd graph: TBP>>=
   procedure :: write => cmd_graph_write
 <<Commands: procedures>>=
   subroutine cmd_graph_write (cmd, unit, indent)
     class(cmd_graph_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,A,A,I0,A)")  "graph: ", char (cmd%id), &
          " (", cmd%n_elements, " entries)"
   end subroutine cmd_graph_write
 
 @ %def cmd_graph_write
 @ Compile.  Record the graph ID and initialize lower, upper bound
 and bin width.  For compiling the graph element syntax, we use part of the
 [[cmd_plot_t]] compiler.
 
 Note: currently, we do not respect options, therefore just IDs on the RHS.
 <<Commands: cmd graph: TBP>>=
   procedure :: compile => cmd_graph_compile
 <<Commands: procedures>>=
   subroutine cmd_graph_compile (cmd, global)
     class(cmd_graph_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_term, pn_tag, pn_def, pn_app
     integer :: i
 
     pn_term => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_tag => parse_node_get_sub_ptr (pn_term)
     cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
     call cmd%compile_options (global)
     select case (char (parse_node_get_rule_key (pn_tag)))
     case ("analysis_id")
        cmd%id = parse_node_get_string (pn_tag)
     case default
        call msg_bug ("graph: name expression not implemented (yet)")
     end select
     pn_def => parse_node_get_next_ptr (pn_term, 2)
     cmd%n_elements = parse_node_get_n_sub (pn_def)
     allocate (cmd%element_id (cmd%n_elements))
     allocate (cmd%el (cmd%n_elements))
     pn_term => parse_node_get_sub_ptr (pn_def)
     pn_tag => parse_node_get_sub_ptr (pn_term)
     cmd%el(1)%pn_opt => parse_node_get_next_ptr (pn_tag)
     call cmd%el(1)%init (pn_tag, global)
     cmd%element_id(1) = parse_node_get_string (pn_tag)
     pn_app => parse_node_get_next_ptr (pn_term)
     do i = 2, cmd%n_elements
        pn_term => parse_node_get_sub_ptr (pn_app, 2)
        pn_tag => parse_node_get_sub_ptr (pn_term)
        cmd%el(i)%pn_opt => parse_node_get_next_ptr (pn_tag)
        call cmd%el(i)%init (pn_tag, global)
        cmd%element_id(i) = parse_node_get_string (pn_tag)
        pn_app => parse_node_get_next_ptr (pn_app)
     end do
 
   end subroutine cmd_graph_compile
 
 @ %def cmd_graph_compile
 @ Command execution.  This declares the graph, allocates it in
 the analysis store, and copies the graph elements.
 
 For the graph, we set graph and default drawing options.  For the elements, we
 reset individual drawing options.
 
 This accesses internals of the contained elements of type [[cmd_plot_t]], see
 above.  We might disentangle such an interdependency when this code is
 rewritten using proper type extension.
 <<Commands: cmd graph: TBP>>=
   procedure :: execute => cmd_graph_execute
 <<Commands: procedures>>=
   subroutine cmd_graph_execute (cmd, global)
     class(cmd_graph_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(graph_options_t) :: graph_options
     type(drawing_options_t) :: drawing_options
     integer :: i, type
 
     var_list => cmd%local%get_var_list_ptr ()
     call graph_options_init (graph_options)
     call set_graph_options (graph_options, var_list)
     call analysis_init_graph (cmd%id, cmd%n_elements, graph_options)
 
     do i = 1, cmd%n_elements
        if (associated (cmd%el(i)%options)) then
           call cmd%el(i)%options%execute (cmd%el(i)%local)
        end if
        type = analysis_store_get_object_type (cmd%element_id(i))
        select case (type)
        case (AN_HISTOGRAM)
           call drawing_options_init_histogram (drawing_options)
        case (AN_PLOT)
           call drawing_options_init_plot (drawing_options)
        end select
        call set_drawing_options (drawing_options, var_list)
        if (associated (cmd%el(i)%options)) then
           call set_drawing_options (drawing_options, cmd%el(i)%local%var_list)
        end if
        call analysis_fill_graph (cmd%id, i, cmd%element_id(i), drawing_options)
     end do
   end subroutine cmd_graph_execute
 
 @ %def cmd_graph_execute
 @
 \subsubsection{Analysis}
 Hold the analysis ID either as a string or as an expression:
 <<Commands: types>>=
   type :: analysis_id_t
     type(string_t) :: tag
     type(parse_node_t), pointer :: pn_sexpr => null ()
   end type analysis_id_t
 
 @ %def analysis_id_t
 @ Define the analysis expression.  We store the parse tree for the
 right-hand side instead of compiling it.  Compilation is deferred to
 the process environment where the analysis expression is used.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_analysis_t
      private
      type(parse_node_t), pointer :: pn_lexpr => null ()
    contains
    <<Commands: cmd analysis: TBP>>
   end type cmd_analysis_t
 
 @ %def cmd_analysis_t
 @ Output.  Print just a message that analysis has been defined.
 <<Commands: cmd analysis: TBP>>=
   procedure :: write => cmd_analysis_write
 <<Commands: procedures>>=
   subroutine cmd_analysis_write (cmd, unit, indent)
     class(cmd_analysis_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "analysis: [defined]"
   end subroutine cmd_analysis_write
 
 @ %def cmd_analysis_write
 @ Compile.  Simply store the parse (sub)tree.
 <<Commands: cmd analysis: TBP>>=
   procedure :: compile => cmd_analysis_compile
 <<Commands: procedures>>=
   subroutine cmd_analysis_compile (cmd, global)
     class(cmd_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 3)
   end subroutine cmd_analysis_compile
 
 @ %def cmd_analysis_compile
 @ Instead of evaluating the cut expression, link the parse tree to the
 global data set, such that it is compiled and executed in the
 appropriate process context.
 <<Commands: cmd analysis: TBP>>=
   procedure :: execute => cmd_analysis_execute
 <<Commands: procedures>>=
   subroutine cmd_analysis_execute (cmd, global)
     class(cmd_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     global%pn%analysis_lexpr => cmd%pn_lexpr
   end subroutine cmd_analysis_execute
 
 @ %def cmd_analysis_execute
 @
 \subsubsection{Write histograms and plots}
 The data type encapsulating the command:
 <<Commands: types>>=
   type, extends (command_t) :: cmd_write_analysis_t
      private
      type(analysis_id_t), dimension(:), allocatable :: id
      type(string_t), dimension(:), allocatable :: tag
    contains
    <<Commands: cmd write analysis: TBP>>
   end type cmd_write_analysis_t
 
 @ %def analysis_id_t
 @ %def cmd_write_analysis_t
 @ Output.  Just the keyword.
 <<Commands: cmd write analysis: TBP>>=
   procedure :: write => cmd_write_analysis_write
 <<Commands: procedures>>=
   subroutine cmd_write_analysis_write (cmd, unit, indent)
     class(cmd_write_analysis_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "write_analysis"
   end subroutine cmd_write_analysis_write
 
 @ %def cmd_write_analysis_write
 @ Compile.
 <<Commands: cmd write analysis: TBP>>=
   procedure :: compile => cmd_write_analysis_compile
 <<Commands: procedures>>=
   subroutine cmd_write_analysis_compile (cmd, global)
     class(cmd_write_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_clause, pn_args, pn_id
     integer :: n, i
     pn_clause => parse_node_get_sub_ptr (cmd%pn)
     pn_args => parse_node_get_sub_ptr (pn_clause, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_clause)
     call cmd%compile_options (global)
     if (associated (pn_args)) then
        n = parse_node_get_n_sub (pn_args)
        allocate (cmd%id (n))
        do i = 1, n
            pn_id => parse_node_get_sub_ptr (pn_args, i)
            if (char (parse_node_get_rule_key (pn_id)) == "analysis_id") then
               cmd%id(i)%tag = parse_node_get_string (pn_id)
            else
               cmd%id(i)%pn_sexpr => pn_id
            end if
        end do
     else
        allocate (cmd%id (0))
     end if
   end subroutine cmd_write_analysis_compile
 
 @ %def cmd_write_analysis_compile
 @ The output format for real data values:
 <<Commands: parameters>>=
   character(*), parameter, public :: &
        DEFAULT_ANALYSIS_FILENAME = "whizard_analysis.dat"
   character(len=1), dimension(2), parameter, public :: &
        FORBIDDEN_ENDINGS1 = [ "o", "a" ]
   character(len=2), dimension(6), parameter, public :: &
        FORBIDDEN_ENDINGS2 = [ "mp", "ps", "vg", "pg", "lo", "la" ]
   character(len=3), dimension(16), parameter, public :: &
        FORBIDDEN_ENDINGS3 = [ "aux", "dvi", "evt", "evx", "f03", "f90", &
           "f95", "log", "ltp", "mpx", "olc", "olp", "pdf", "phs", "sin", "tex" ]
 
 @ %def DEFAULT_ANALYSIS_FILENAME
 @ %def FORBIDDEN_ENDINGS1
 @ %def FORBIDDEN_ENDINGS2
 @ %def FORBIDDEN_ENDINGS3
 @ As this contains a lot of similar code to [[cmd_compile_analysis_execute]]
 we outsource the main code to a subroutine.
 <<Commands: cmd write analysis: TBP>>=
   procedure :: execute => cmd_write_analysis_execute
 <<Commands: procedures>>=
   subroutine cmd_write_analysis_execute (cmd, global)
     class(cmd_write_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     var_list => cmd%local%get_var_list_ptr ()
     call write_analysis_wrap (var_list, global%out_files, &
          cmd%id, tag = cmd%tag)
   end subroutine cmd_write_analysis_execute
 
 @ %def cmd_write_analysis_execute
 @ If the [[data_file]] optional argument is present, this is
 called from [[cmd_compile_analysis_execute]], which needs the file name for
 further processing, and requires the default format.  For the moment,
 parameters and macros for custom data processing are disabled.
 <<Commands: procedures>>=
   subroutine write_analysis_wrap (var_list, out_files, id, tag, data_file)
     type(var_list_t), intent(inout), target :: var_list
     type(file_list_t), intent(inout), target :: out_files
     type(analysis_id_t), dimension(:), intent(in), target :: id
     type(string_t), dimension(:), allocatable, intent(out) :: tag
     type(string_t), intent(out), optional :: data_file
     type(string_t) :: defaultfile, file
     integer :: i
     logical :: keep_open !, custom, header, columns
     type(string_t) :: extension !, comment_prefix, separator
 !!! JRR: WK please check (#542)
 !     integer :: type
 !     type(ifile_t) :: ifile
     logical :: one_file !, has_writer
 !     type(analysis_iterator_t) :: iterator
 !     type(rt_data_t), target :: sandbox
 !     type(command_list_t) :: writer
     defaultfile = var_list%get_sval (var_str ("$out_file"))
     if (present (data_file)) then
        if (defaultfile == "" .or. defaultfile == ".") then
           defaultfile = DEFAULT_ANALYSIS_FILENAME
        else
           if (scan (".", defaultfile) > 0) then
              call split (defaultfile, extension, ".", back=.true.)
              if (any (lower_case (char(extension)) == FORBIDDEN_ENDINGS1) .or. &
                  any (lower_case (char(extension)) == FORBIDDEN_ENDINGS2) .or. &
                  any (lower_case (char(extension)) == FORBIDDEN_ENDINGS3)) &
                  call msg_fatal ("The ending " // char(extension) // &
                  " is internal and not allowed as data file.")
              if (extension /= "") then
                 if (defaultfile /= "") then
                    defaultfile = defaultfile // "." // extension
                 else
                    defaultfile = "whizard_analysis." // extension
                 end if
              else
                 defaultfile = defaultfile // ".dat"
              endif
           else
              defaultfile = defaultfile // ".dat"
           end if
        end if
        data_file = defaultfile
     end if
     one_file = defaultfile /= ""
     if (one_file) then
        file = defaultfile
        keep_open = file_list_is_open (out_files, file, &
             action = "write")
        if (keep_open) then
           if (present (data_file)) then
              call msg_fatal ("Compiling analysis: File '" &
                   // char (data_file) &
                    // "' can't be used, it is already open.")
           else
              call msg_message ("Appending analysis data to file '" &
                   // char (file) // "'")
           end if
        else
           call file_list_open (out_files, file, &
                action = "write", status = "replace", position = "asis")
           call msg_message ("Writing analysis data to file '" &
                // char (file) // "'")
        end if
     end if
 
 !!! JRR: WK please check. Custom data output. Ticket #542
 !     if (present (data_file)) then
 !        custom = .false.
 !     else
 !        custom = var_list%get_lval (&
 !            var_str ("?out_custom"))
 !     end if
 !     comment_prefix = var_list%get_sval (&
 !          var_str ("$out_comment"))
 !     header = var_list%get_lval (&
 !          var_str ("?out_header"))
 !     write_yerr = var_list%get_lval (&
 !          var_str ("?out_yerr"))
 !     write_xerr = var_list%get_lval (&
 !          var_str ("?out_xerr"))
 
     call get_analysis_tags (tag, id, var_list)
     do i = 1, size (tag)
        call file_list_write_analysis &
             (out_files, file, tag(i))
     end do
     if (one_file .and. .not. keep_open) then
        call file_list_close (out_files, file)
     end if
 
   contains
 
     subroutine get_analysis_tags (analysis_tag, id, var_list)
       type(string_t), dimension(:), intent(out), allocatable :: analysis_tag
       type(analysis_id_t), dimension(:), intent(in) :: id
       type(var_list_t), intent(in), target :: var_list
       if (size (id) /= 0) then
          allocate (analysis_tag (size (id)))
          do i = 1, size (id)
             if (associated (id(i)%pn_sexpr)) then
                analysis_tag(i) = eval_string (id(i)%pn_sexpr, var_list)
             else
                analysis_tag(i) = id(i)%tag
             end if
          end do
       else
          call analysis_store_get_ids (tag)
       end if
     end subroutine get_analysis_tags
 
   end subroutine write_analysis_wrap
 
 @ %def write_analysis_wrap
 \subsubsection{Compile analysis results}
 This command writes files in a form suitable for GAMELAN and executes the
 appropriate commands to compile them.  The first part is identical to
 [[cmd_write_analysis]].
 <<Commands: types>>=
   type, extends (command_t) :: cmd_compile_analysis_t
      private
      type(analysis_id_t), dimension(:), allocatable :: id
      type(string_t), dimension(:), allocatable :: tag
    contains
    <<Commands: cmd compile analysis: TBP>>
   end type cmd_compile_analysis_t
 
 @ %def cmd_compile_analysis_t
 @ Output.  Just the keyword.
 <<Commands: cmd compile analysis: TBP>>=
   procedure :: write => cmd_compile_analysis_write
 <<Commands: procedures>>=
   subroutine cmd_compile_analysis_write (cmd, unit, indent)
     class(cmd_compile_analysis_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "compile_analysis"
   end subroutine cmd_compile_analysis_write
 
 @ %def cmd_compile_analysis_write
 @ Compile.
 <<Commands: cmd compile analysis: TBP>>=
   procedure :: compile => cmd_compile_analysis_compile
 <<Commands: procedures>>=
   subroutine cmd_compile_analysis_compile (cmd, global)
     class(cmd_compile_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_clause, pn_args, pn_id
     integer :: n, i
     pn_clause => parse_node_get_sub_ptr (cmd%pn)
     pn_args => parse_node_get_sub_ptr (pn_clause, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_clause)
     call cmd%compile_options (global)
     if (associated (pn_args)) then
        n = parse_node_get_n_sub (pn_args)
        allocate (cmd%id (n))
        do i = 1, n
            pn_id => parse_node_get_sub_ptr (pn_args, i)
            if (char (parse_node_get_rule_key (pn_id)) == "analysis_id") then
               cmd%id(i)%tag = parse_node_get_string (pn_id)
            else
               cmd%id(i)%pn_sexpr => pn_id
            end if
        end do
     else
        allocate (cmd%id (0))
     end if
   end subroutine cmd_compile_analysis_compile
 
 @ %def cmd_compile_analysis_compile
 @ First write the analysis data to file, then write a GAMELAN driver and
 produce MetaPost and \TeX\ output.
 <<Commands: cmd compile analysis: TBP>>=
   procedure :: execute => cmd_compile_analysis_execute
 <<Commands: procedures>>=
   subroutine cmd_compile_analysis_execute (cmd, global)
     class(cmd_compile_analysis_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(string_t) :: file, basename, extension, driver_file, &
          makefile
     integer :: u_driver, u_makefile
     logical :: has_gmlcode, only_file
     var_list => cmd%local%get_var_list_ptr ()
     call write_analysis_wrap (var_list, &
          global%out_files, cmd%id, tag = cmd%tag, &
             data_file = file)
     basename = file
     if (scan (".", basename) > 0) then
       call split (basename, extension, ".", back=.true.)
     else
       extension = ""
     end if
     driver_file = basename // ".tex"
     makefile = basename // "_ana.makefile"
     u_driver = free_unit ()
     open (unit=u_driver, file=char(driver_file), &
           action="write", status="replace")
     if (allocated (cmd%tag)) then
        call analysis_write_driver (file, cmd%tag, unit=u_driver)
        has_gmlcode = analysis_has_plots (cmd%tag)
     else
        call analysis_write_driver (file, unit=u_driver)
        has_gmlcode = analysis_has_plots ()
     end if
     close (u_driver)
     u_makefile = free_unit ()
     open (unit=u_makefile, file=char(makefile), &
          action="write", status="replace")
     call analysis_write_makefile (basename, u_makefile, &
          has_gmlcode, global%os_data)
     close (u_makefile)
     call msg_message ("Compiling analysis results display in '" &
          // char (driver_file) // "'")
     call msg_message ("Providing analysis steering makefile '" &
          // char (makefile) // "'")
     only_file = global%var_list%get_lval &
          (var_str ("?analysis_file_only"))
     if (.not. only_file)  call analysis_compile_tex &
          (basename, has_gmlcode, global%os_data)
   end subroutine cmd_compile_analysis_execute
 
 @ %def cmd_compile_analysis_execute
 @
 \subsection{User-controlled output to data files}
 
 \subsubsection{Open file (output)}
 Open a file for output.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_open_out_t
      private
      type(parse_node_t), pointer :: file_expr => null ()
    contains
    <<Commands: cmd open out: TBP>>
   end type cmd_open_out_t
 
 @ %def cmd_open_out
 @ Finalizer for the embedded eval tree.
 <<Commands: procedures>>=
   subroutine cmd_open_out_final (object)
     class(cmd_open_out_t), intent(inout) :: object
   end subroutine cmd_open_out_final
 
 @ %def cmd_open_out_final
 @ Output (trivial here).
 <<Commands: cmd open out: TBP>>=
   procedure :: write => cmd_open_out_write
 <<Commands: procedures>>=
   subroutine cmd_open_out_write (cmd, unit, indent)
     class(cmd_open_out_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "open_out: <filename>"
   end subroutine cmd_open_out_write
 
 @ %def cmd_open_out_write
 @ Compile: create an eval tree for the filename expression.
 <<Commands: cmd open out: TBP>>=
   procedure :: compile => cmd_open_out_compile
 <<Commands: procedures>>=
   subroutine cmd_open_out_compile (cmd, global)
     class(cmd_open_out_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     cmd%file_expr => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (cmd%file_expr)) then
        cmd%pn_opt => parse_node_get_next_ptr (cmd%file_expr)
     end if
     call cmd%compile_options (global)
   end subroutine cmd_open_out_compile
 
 @ %def cmd_open_out_compile
 @ Execute: append the file to the global list of open files.
 <<Commands: cmd open out: TBP>>=
   procedure :: execute => cmd_open_out_execute
 <<Commands: procedures>>=
   subroutine cmd_open_out_execute (cmd, global)
     class(cmd_open_out_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(eval_tree_t) :: file_expr
     type(string_t) :: file
     var_list => cmd%local%get_var_list_ptr ()
     call file_expr%init_sexpr (cmd%file_expr, var_list)
     call file_expr%evaluate ()
     if (file_expr%is_known ()) then
        file = file_expr%get_string ()
        call file_list_open (global%out_files, file, &
             action = "write", status = "replace", position = "asis")
     else
        call msg_fatal ("open_out: file name argument evaluates to unknown")
     end if
     call file_expr%final ()
   end subroutine cmd_open_out_execute
 
 @ %def cmd_open_out_execute
 
 \subsubsection{Open file (output)}
 Close an output file.  Except for the [[execute]] method, everything is
 analogous to the open command, so we can just inherit.
 <<Commands: types>>=
   type, extends (cmd_open_out_t) :: cmd_close_out_t
      private
    contains
    <<Commands: cmd close out: TBP>>
   end type cmd_close_out_t
 
 @ %def cmd_close_out
 @ Execute: remove the file from the global list of output files.
 <<Commands: cmd close out: TBP>>=
   procedure :: execute => cmd_close_out_execute
 <<Commands: procedures>>=
   subroutine cmd_close_out_execute (cmd, global)
     class(cmd_close_out_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(eval_tree_t) :: file_expr
     type(string_t) :: file
     var_list => cmd%local%var_list
     call file_expr%init_sexpr (cmd%file_expr, var_list)
     call file_expr%evaluate ()
     if (file_expr%is_known ()) then
        file = file_expr%get_string ()
        call file_list_close (global%out_files, file)
     else
        call msg_fatal ("close_out: file name argument evaluates to unknown")
     end if
     call file_expr%final ()
   end subroutine cmd_close_out_execute
 
 @ %def cmd_close_out_execute
 @
 \subsection{Print custom-formatted values}
 <<Commands: types>>=
   type, extends (command_t) :: cmd_printf_t
      private
      type(parse_node_t), pointer :: sexpr => null ()
      type(parse_node_t), pointer :: sprintf_fun => null ()
      type(parse_node_t), pointer :: sprintf_clause => null ()
      type(parse_node_t), pointer :: sprintf => null ()
    contains
    <<Commands: cmd printf: TBP>>
   end type cmd_printf_t
 
 @ %def cmd_printf_t
 @ Finalize.
 <<Commands: cmd printf: TBP>>=
   procedure :: final => cmd_printf_final
 <<Commands: procedures>>=
   subroutine cmd_printf_final (cmd)
     class(cmd_printf_t), intent(inout) :: cmd
     call parse_node_final (cmd%sexpr, recursive = .false.)
     deallocate (cmd%sexpr)
     call parse_node_final (cmd%sprintf_fun, recursive = .false.)
     deallocate (cmd%sprintf_fun)
     call parse_node_final (cmd%sprintf_clause, recursive = .false.)
     deallocate (cmd%sprintf_clause)
     call parse_node_final (cmd%sprintf, recursive = .false.)
     deallocate (cmd%sprintf)
   end subroutine cmd_printf_final
 
 @ %def cmd_printf_final
 @ Output.  Do not print the parse tree, since this may get cluttered.
 Just a message that cuts have been defined.
 <<Commands: cmd printf: TBP>>=
   procedure :: write => cmd_printf_write
 <<Commands: procedures>>=
   subroutine cmd_printf_write (cmd, unit, indent)
     class(cmd_printf_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "printf:"
   end subroutine cmd_printf_write
 
 @ %def cmd_printf_write
 @ Compile.  We create a fake parse node (subtree) with a [[sprintf]] command
 with identical arguments which can then be handled by the corresponding
 evaluation procedure.
 <<Commands: cmd printf: TBP>>=
   procedure :: compile => cmd_printf_compile
 <<Commands: procedures>>=
   subroutine cmd_printf_compile (cmd, global)
     class(cmd_printf_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_cmd, pn_clause, pn_args, pn_format
     pn_cmd => parse_node_get_sub_ptr (cmd%pn)
     pn_clause => parse_node_get_sub_ptr (pn_cmd)
     pn_format => parse_node_get_sub_ptr (pn_clause, 2)
     pn_args => parse_node_get_next_ptr (pn_clause)
     cmd%pn_opt => parse_node_get_next_ptr (pn_cmd)
     call cmd%compile_options (global)
     allocate (cmd%sexpr)
     call parse_node_create_branch (cmd%sexpr, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("sexpr")))
     allocate (cmd%sprintf_fun)
     call parse_node_create_branch (cmd%sprintf_fun, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf_fun")))
     allocate (cmd%sprintf_clause)
     call parse_node_create_branch (cmd%sprintf_clause, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf_clause")))
     allocate (cmd%sprintf)
     call parse_node_create_key (cmd%sprintf, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf")))
     call parse_node_append_sub (cmd%sprintf_clause, cmd%sprintf)
     call parse_node_append_sub (cmd%sprintf_clause, pn_format)
     call parse_node_freeze_branch (cmd%sprintf_clause)
     call parse_node_append_sub (cmd%sprintf_fun, cmd%sprintf_clause)
     if (associated (pn_args)) then
        call parse_node_append_sub (cmd%sprintf_fun, pn_args)
     end if
     call parse_node_freeze_branch (cmd%sprintf_fun)
     call parse_node_append_sub (cmd%sexpr, cmd%sprintf_fun)
     call parse_node_freeze_branch (cmd%sexpr)
   end subroutine cmd_printf_compile
 
 @ %def cmd_printf_compile
 @ Execute.  Evaluate the string (pretending this is a [[sprintf]] expression)
 and print it.
 <<Commands: cmd printf: TBP>>=
   procedure :: execute => cmd_printf_execute
 <<Commands: procedures>>=
   subroutine cmd_printf_execute (cmd, global)
     class(cmd_printf_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(string_t) :: string, file
     type(eval_tree_t) :: sprintf_expr
     logical :: advance
     var_list => cmd%local%get_var_list_ptr ()
     advance = var_list%get_lval (&
          var_str ("?out_advance"))
     file = var_list%get_sval (&
          var_str ("$out_file"))
     call sprintf_expr%init_sexpr (cmd%sexpr, var_list)
     call sprintf_expr%evaluate ()
     if (sprintf_expr%is_known ()) then
        string = sprintf_expr%get_string ()
        if (len (file) == 0) then
           call msg_result (char (string))
        else
           call file_list_write (global%out_files, file, string, advance)
        end if
     end if
   end subroutine cmd_printf_execute
 
 @ %def cmd_printf_execute
 @
 \subsubsection{Record data}
 The expression syntax already contains a [[record]] keyword; this evaluates to
 a logical which is always true, but it has the side-effect of recording data
 into analysis objects.  Here we define a command as an interface to this
 construct.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_record_t
      private
      type(parse_node_t), pointer :: pn_lexpr => null ()
    contains
    <<Commands: cmd record: TBP>>
   end type cmd_record_t
 
 @ %def cmd_record_t
 @ Output.  With the compile hack below, there is nothing of interest
 to print here.
 <<Commands: cmd record: TBP>>=
   procedure :: write => cmd_record_write
 <<Commands: procedures>>=
   subroutine cmd_record_write (cmd, unit, indent)
     class(cmd_record_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)")  "record"
   end subroutine cmd_record_write
 
 @ %def cmd_record_write
 @ Compile.  This is a hack which transforms the [[record]] command
 into a [[record]] expression, which we handle in the [[expressions]]
 module.
 <<Commands: cmd record: TBP>>=
   procedure :: compile => cmd_record_compile
 <<Commands: procedures>>=
   subroutine cmd_record_compile (cmd, global)
     class(cmd_record_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_lexpr, pn_lsinglet, pn_lterm, pn_record
     call parse_node_create_branch (pn_lexpr, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("lexpr")))
     call parse_node_create_branch (pn_lsinglet, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("lsinglet")))
     call parse_node_append_sub (pn_lexpr, pn_lsinglet)
     call parse_node_create_branch (pn_lterm, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("lterm")))
     call parse_node_append_sub (pn_lsinglet, pn_lterm)
     pn_record => parse_node_get_sub_ptr (cmd%pn)
     call parse_node_append_sub (pn_lterm, pn_record)
     cmd%pn_lexpr => pn_lexpr
   end subroutine cmd_record_compile
 
 @ %def cmd_record_compile
 @ Command execution.  Again, transfer this to the embedded expression
 and just forget the logical result.
 <<Commands: cmd record: TBP>>=
   procedure :: execute => cmd_record_execute
 <<Commands: procedures>>=
   subroutine cmd_record_execute (cmd, global)
     class(cmd_record_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     logical :: lval
     var_list => global%get_var_list_ptr ()
     lval = eval_log (cmd%pn_lexpr, var_list)
   end subroutine cmd_record_execute
 
 @ %def cmd_record_execute
 @
 \subsubsection{Unstable particles}
 Mark a particle as unstable.  For each unstable particle, we store a
 number of decay channels and compute their respective BRs.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_unstable_t
      private
      integer :: n_proc = 0
      type(string_t), dimension(:), allocatable :: process_id
      type(parse_node_t), pointer :: pn_prt_in => null ()
    contains
    <<Commands: cmd unstable: TBP>>
   end type cmd_unstable_t
 
 @ %def cmd_unstable_t
 @ Output: we know the process IDs.
 <<Commands: cmd unstable: TBP>>=
   procedure :: write => cmd_unstable_write
 <<Commands: procedures>>=
   subroutine cmd_unstable_write (cmd, unit, indent)
     class(cmd_unstable_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,I0,1x,A)", advance="no")  &
          "unstable:", 1, "("
     do i = 1, cmd%n_proc
        if (i > 1)  write (u, "(A,1x)", advance="no")  ","
        write (u, "(A)", advance="no")  char (cmd%process_id(i))
     end do
     write (u, "(A)")  ")"
   end subroutine cmd_unstable_write
 
 @ %def cmd_unstable_write
 @ Compile.  Initiate an eval tree for the decaying particle and
 determine the decay channel process IDs.
 <<Commands: cmd unstable: TBP>>=
   procedure :: compile => cmd_unstable_compile
 <<Commands: procedures>>=
   subroutine cmd_unstable_compile (cmd, global)
     class(cmd_unstable_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_list, pn_proc
     integer :: i
     cmd%pn_prt_in => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_list => parse_node_get_next_ptr (cmd%pn_prt_in)
     if (associated (pn_list)) then
        select case (char (parse_node_get_rule_key (pn_list)))
        case ("unstable_arg")
           cmd%n_proc = parse_node_get_n_sub (pn_list)
           cmd%pn_opt => parse_node_get_next_ptr (pn_list)
        case default
           cmd%n_proc = 0
           cmd%pn_opt => pn_list
           pn_list => null ()
        end select
     end if
     call cmd%compile_options (global)
     if (associated (pn_list)) then
        allocate (cmd%process_id (cmd%n_proc))
        pn_proc => parse_node_get_sub_ptr (pn_list)
        do i = 1, cmd%n_proc
           cmd%process_id(i) = parse_node_get_string (pn_proc)
           call cmd%local%process_stack%init_result_vars (cmd%process_id(i))
           pn_proc => parse_node_get_next_ptr (pn_proc)
        end do
     else
        allocate (cmd%process_id (0))
     end if
   end subroutine cmd_unstable_compile
 
 @ %def cmd_unstable_compile
 @ Command execution.  Evaluate the decaying particle and mark the decays in
 the current model object.
 <<Commands: cmd unstable: TBP>>=
   procedure :: execute => cmd_unstable_execute
 <<Commands: procedures>>=
   subroutine cmd_unstable_execute (cmd, global)
     class(cmd_unstable_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     logical :: auto_decays, auto_decays_radiative
     integer :: auto_decays_multiplicity
     logical :: isotropic_decay, diagonal_decay, polarized_decay
     integer :: decay_helicity
     type(pdg_array_t) :: pa_in
     integer :: pdg_in
     type(string_t) :: libname_cur, libname_dec
     type(string_t), dimension(:), allocatable :: auto_id, tmp_id
     integer :: n_proc_user
     integer :: i, u_tmp
     character(80) :: buffer
     var_list => cmd%local%get_var_list_ptr ()
     auto_decays = &
          var_list%get_lval (var_str ("?auto_decays"))
     if (auto_decays) then
        auto_decays_multiplicity = &
             var_list%get_ival (var_str ("auto_decays_multiplicity"))
        auto_decays_radiative = &
             var_list%get_lval (var_str ("?auto_decays_radiative"))
     end if
     isotropic_decay = &
          var_list%get_lval (var_str ("?isotropic_decay"))
     if (isotropic_decay) then
        diagonal_decay = .false.
        polarized_decay = .false.
     else
        diagonal_decay = &
             var_list%get_lval (var_str ("?diagonal_decay"))
        if (diagonal_decay) then
           polarized_decay = .false.
        else
           polarized_decay = &
                var_list%is_known (var_str ("decay_helicity"))
           if (polarized_decay) then
              decay_helicity = var_list%get_ival (var_str ("decay_helicity"))
           end if
        end if
     end if
     pa_in = eval_pdg_array (cmd%pn_prt_in, var_list)
     if (pdg_array_get_length (pa_in) /= 1) &
          call msg_fatal ("Unstable: decaying particle must be unique")
     pdg_in = pdg_array_get (pa_in, 1)
     n_proc_user = cmd%n_proc
     if (auto_decays) then
        call create_auto_decays (pdg_in, &
             auto_decays_multiplicity, auto_decays_radiative, &
             libname_dec, auto_id, cmd%local)
        allocate (tmp_id (cmd%n_proc + size (auto_id)))
        tmp_id(:cmd%n_proc) = cmd%process_id
        tmp_id(cmd%n_proc+1:) = auto_id
        call move_alloc (from = tmp_id, to = cmd%process_id)
        cmd%n_proc = size (cmd%process_id)
     end if
     libname_cur = cmd%local%prclib%get_name ()
     do i = 1, cmd%n_proc
        if (i == n_proc_user + 1) then
           call cmd%local%update_prclib &
                (cmd%local%prclib_stack%get_library_ptr (libname_dec))
        end if
        if (.not. global%process_stack%exists (cmd%process_id(i))) then
           call var_list%set_log &
                (var_str ("?decay_rest_frame"), .false., is_known = .true.)
           call integrate_process (cmd%process_id(i), cmd%local, global)
           call global%process_stack%fill_result_vars (cmd%process_id(i))
        end if
     end do
     call cmd%local%update_prclib &
          (cmd%local%prclib_stack%get_library_ptr (libname_cur))
     if (cmd%n_proc > 0) then
        if (polarized_decay) then
           call global%modify_particle (pdg_in, stable = .false., &
                decay = cmd%process_id, &
                isotropic_decay = .false., &
                diagonal_decay = .false., &
                decay_helicity = decay_helicity, &
                polarized = .false.)
        else
           call global%modify_particle (pdg_in, stable = .false., &
                decay = cmd%process_id, &
                isotropic_decay = isotropic_decay, &
                diagonal_decay = diagonal_decay, &
                polarized = .false.)
        end if
        u_tmp = free_unit ()
        open (u_tmp, status = "scratch", action = "readwrite")
        call show_unstable (global, pdg_in, u_tmp)
        rewind (u_tmp)
        do
           read (u_tmp, "(A)", end = 1)  buffer
           write (msg_buffer, "(A)")  trim (buffer)
           call msg_message ()
        end do
 1      continue
        close (u_tmp)
     else
        call err_unstable (global, pdg_in)
     end if
   end subroutine cmd_unstable_execute
 
 @ %def cmd_unstable_execute
 @ Show data for the current unstable particle.  This is called both by
 the [[unstable]] and by the [[show]] command.
 
 To determine decay branching rations, we look at the decay process IDs
 and inspect the corresponding [[integral()]] result variables.
 <<Commands: procedures>>=
   subroutine show_unstable (global, pdg, u)
     type(rt_data_t), intent(in), target :: global
     integer, intent(in) :: pdg, u
     type(flavor_t) :: flv
     type(string_t), dimension(:), allocatable :: decay
     real(default), dimension(:), allocatable :: br
     real(default) :: width
     type(process_t), pointer :: process
     type(process_component_def_t), pointer :: prc_def
     type(string_t), dimension(:), allocatable :: prt_out, prt_out_str
     integer :: i, j
     logical :: opened
     call flv%init (pdg, global%model)
     call flv%get_decays (decay)
     if (.not. allocated (decay))  return
     allocate (prt_out_str (size (decay)))
     allocate (br (size (decay)))
     do i = 1, size (br)
        process => global%process_stack%get_process_ptr (decay(i))
        prc_def => process%get_component_def_ptr (1)
        call prc_def%get_prt_out (prt_out)
        prt_out_str(i) = prt_out(1)
        do j = 2, size (prt_out)
           prt_out_str(i) = prt_out_str(i) // ", " // prt_out(j)
        end do
        br(i) = global%get_rval ("integral(" // decay(i) // ")")
     end do
     if (all (br >= 0)) then
        if (any (br > 0)) then
           width = sum (br)
           br = br / sum (br)
           write (u, "(A)") "Unstable particle " &
                // char (flv%get_name ()) &
                // ": computed branching ratios:"
           do i = 1, size (br)
              write (u, "(2x,A,':'," // FMT_14 // ",3x,A)") &
                   char (decay(i)), br(i), char (prt_out_str(i))
           end do
           write (u, "(2x,'Total width ='," // FMT_14 // ",' GeV (computed)')")  width
           write (u, "(2x,'            ='," // FMT_14 // ",' GeV (preset)')") &
                flv%get_width ()
           if (flv%decays_isotropically ()) then
              write (u, "(2x,A)")  "Decay options: isotropic"
           else if (flv%decays_diagonal ()) then
              write (u, "(2x,A)")  "Decay options: &
                   &projection on diagonal helicity states"
           else if (flv%has_decay_helicity ()) then
              write (u, "(2x,A,1x,I0)")  "Decay options: projection onto helicity =", &
                   flv%get_decay_helicity ()
           else
              write (u, "(2x,A)")  "Decay options: helicity treated exactly"
           end if
        else
           inquire (unit = u, opened = opened)
           if (opened .and. .not. mask_fatal_errors)  close (u)
           call msg_fatal ("Unstable particle " &
                // char (flv%get_name ()) &
                // ": partial width vanishes for all decay channels")
        end if
     else
        inquire (unit = u, opened = opened)
        if (opened .and. .not. mask_fatal_errors)  close (u)
        call msg_fatal ("Unstable particle " &
                // char (flv%get_name ()) &
                // ": partial width is negative")
     end if
   end subroutine show_unstable
 
 @ %def show_unstable
 @ If no decays have been found, issue a non-fatal error.
 <<Commands: procedures>>=
   subroutine err_unstable (global, pdg)
     type(rt_data_t), intent(in), target :: global
     integer, intent(in) :: pdg
     type(flavor_t) :: flv
     call flv%init (pdg, global%model)
     call msg_error ("Unstable: no allowed decays found for particle " &
          // char (flv%get_name ()) // ", keeping as stable")
   end subroutine err_unstable
 
 @ %def err_unstable
 @ Auto decays: create process IDs and make up process
 configurations, using the PDG codes generated by the [[ds_table]] make
 method.
 
 We allocate and use a self-contained process library that contains only the
 decay processes of the current particle.  When done, we revert the global
 library pointer to the original library but return the name of the new one.
 The new library becomes part of the global library stack and can thus be
 referred to at any time.
 <<Commands: procedures>>=
   subroutine create_auto_decays &
        (pdg_in, mult, rad, libname_dec, process_id, global)
     integer, intent(in) :: pdg_in
     integer, intent(in) :: mult
     logical, intent(in) :: rad
     type(string_t), intent(out) :: libname_dec
     type(string_t), dimension(:), allocatable, intent(out) :: process_id
     type(rt_data_t), intent(inout) :: global
     type(prclib_entry_t), pointer :: lib_entry
     type(process_library_t), pointer :: lib
     type(ds_table_t) :: ds_table
     type(split_constraints_t) :: constraints
     type(pdg_array_t), dimension(:), allocatable :: pa_out
     character(80) :: buffer
     character :: p_or_a
     type(string_t) :: process_string, libname_cur
     type(flavor_t) :: flv_in, flv_out
     type(string_t) :: prt_in
     type(string_t), dimension(:), allocatable :: prt_out
     type(process_configuration_t) :: prc_config
     integer :: i, j, k
     call flv_in%init (pdg_in, global%model)
     if (rad) then
        call constraints%init (2)
     else
        call constraints%init (3)
        call constraints%set (3, constrain_radiation ())
     end if
     call constraints%set (1, constrain_n_tot (mult))
     call constraints%set (2, &
          constrain_mass_sum (flv_in%get_mass (), margin = 0._default))
     call ds_table%make (global%model, pdg_in, constraints)
     prt_in = flv_in%get_name ()
     if (pdg_in > 0) then
        p_or_a = "p"
     else
        p_or_a = "a"
     end if
     if (ds_table%get_length () == 0) then
        call msg_warning ("Auto-decays: Particle " // char (prt_in) // ": " &
             // "no decays found")
        libname_dec = ""
        allocate (process_id (0))
     else
        call msg_message ("Creating decay process library for particle " &
             // char (prt_in))
        libname_cur = global%prclib%get_name ()
        write (buffer, "(A,A,I0)")  "_d", p_or_a, abs (pdg_in)
        libname_dec = libname_cur // trim (buffer)
        lib => global%prclib_stack%get_library_ptr (libname_dec)
        if (.not. (associated (lib))) then
           allocate (lib_entry)
           call lib_entry%init (libname_dec)
           lib => lib_entry%process_library_t
           call global%add_prclib (lib_entry)
        else
           call global%update_prclib (lib)
        end if
        allocate (process_id (ds_table%get_length ()))
        do i = 1, size (process_id)
           write (buffer, "(A,'_',A,I0,'_',I0)") &
                "decay", p_or_a, abs (pdg_in), i
           process_id(i) = trim (buffer)
           process_string = process_id(i) // ": " // prt_in // " =>"
           call ds_table%get_pdg_out (i, pa_out)
           allocate (prt_out (size (pa_out)))
           do j = 1, size (pa_out)
              do k = 1, pa_out(j)%get_length ()
                 call flv_out%init (pa_out(j)%get (k), global%model)
                 if (k == 1) then
                    prt_out(j) = flv_out%get_name ()
                 else
                    prt_out(j) = prt_out(j) // ":" // flv_out%get_name ()
                 end if
              end do
              process_string = process_string // " " // prt_out(j)
           end do
           call msg_message (char (process_string))
           call prc_config%init (process_id(i), 1, 1, &
                global%model, global%var_list, &
                nlo_process = global%nlo_fixed_order)
           !!! Causes runtime error with gfortran 4.9.1
           ! call prc_config%setup_component (1, &
           !      new_prt_spec ([prt_in]), new_prt_spec (prt_out), global%model, global%var_list)
           !!! Workaround:
           call prc_config%setup_component (1, &
                [new_prt_spec (prt_in)], new_prt_spec (prt_out), global%model, global%var_list)
           call prc_config%record (global)
           deallocate (prt_out)
           deallocate (pa_out)
        end do
        lib => global%prclib_stack%get_library_ptr (libname_cur)
        call global%update_prclib (lib)
     end if
     call ds_table%final ()
   end subroutine create_auto_decays
 
 @ %def create_auto_decays
 @
 \subsubsection{(Stable particles}
 Revert the unstable declaration for a list of particles.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_stable_t
      private
      type(parse_node_p), dimension(:), allocatable :: pn_pdg
    contains
    <<Commands: cmd stable: TBP>>
   end type cmd_stable_t
 
 @ %def cmd_stable_t
 @ Output: we know only the number of particles.
 <<Commands: cmd stable: TBP>>=
   procedure :: write => cmd_stable_write
 <<Commands: procedures>>=
   subroutine cmd_stable_write (cmd, unit, indent)
     class(cmd_stable_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,I0)")  "stable:", size (cmd%pn_pdg)
   end subroutine cmd_stable_write
 
 @ %def cmd_stable_write
 @ Compile.  Assign parse nodes for the particle IDs.
 <<Commands: cmd stable: TBP>>=
   procedure :: compile => cmd_stable_compile
 <<Commands: procedures>>=
   subroutine cmd_stable_compile (cmd, global)
     class(cmd_stable_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_list, pn_prt
     integer :: n, i
     pn_list => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_list)
     call cmd%compile_options (global)
     n = parse_node_get_n_sub (pn_list)
     allocate (cmd%pn_pdg (n))
     pn_prt => parse_node_get_sub_ptr (pn_list)
     i = 1
     do while (associated (pn_prt))
        cmd%pn_pdg(i)%ptr => pn_prt
        pn_prt  => parse_node_get_next_ptr (pn_prt)
        i = i + 1
     end do
   end subroutine cmd_stable_compile
 
 @ %def cmd_stable_compile
 @ Execute: apply the modifications to the current model.
 <<Commands: cmd stable: TBP>>=
   procedure :: execute => cmd_stable_execute
 <<Commands: procedures>>=
   subroutine cmd_stable_execute (cmd, global)
     class(cmd_stable_t), intent(inout) :: cmd
     type(rt_data_t), target, intent(inout) :: global
     type(var_list_t), pointer :: var_list
     type(pdg_array_t) :: pa
     integer :: pdg
     type(flavor_t) :: flv
     integer :: i
     var_list => cmd%local%get_var_list_ptr ()
     do i = 1, size (cmd%pn_pdg)
        pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
        if (pdg_array_get_length (pa) /= 1) &
             call msg_fatal ("Stable: listed particles must be unique")
        pdg = pdg_array_get (pa, 1)
        call global%modify_particle (pdg, stable = .true., &
          isotropic_decay = .false., &
          diagonal_decay = .false., &
          polarized = .false.)
        call flv%init (pdg, cmd%local%model)
        call msg_message ("Particle " &
             // char (flv%get_name ()) &
             // " declared as stable")
     end do
   end subroutine cmd_stable_execute
 
 @ %def cmd_stable_execute
 @
 \subsubsection{Polarized particles}
 These commands mark particles as (un)polarized, to be applied in
 subsequent simulation passes.  Since this is technically the same as
 the [[stable]] command, we take a shortcut and make this an extension,
 just overriding methods.
 <<Commands: types>>=
   type, extends (cmd_stable_t) :: cmd_polarized_t
    contains
    <<Commands: cmd polarized: TBP>>
   end type cmd_polarized_t
 
   type, extends (cmd_stable_t) :: cmd_unpolarized_t
    contains
    <<Commands: cmd unpolarized: TBP>>
   end type cmd_unpolarized_t
 
 @ %def cmd_polarized_t cmd_unpolarized_t
 @ Output: we know only the number of particles.
 <<Commands: cmd polarized: TBP>>=
   procedure :: write => cmd_polarized_write
 <<Commands: cmd unpolarized: TBP>>=
   procedure :: write => cmd_unpolarized_write
 <<Commands: procedures>>=
   subroutine cmd_polarized_write (cmd, unit, indent)
     class(cmd_polarized_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,I0)")  "polarized:", size (cmd%pn_pdg)
   end subroutine cmd_polarized_write
 
   subroutine cmd_unpolarized_write (cmd, unit, indent)
     class(cmd_unpolarized_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,I0)")  "unpolarized:", size (cmd%pn_pdg)
   end subroutine cmd_unpolarized_write
 
 @ %def cmd_polarized_write
 @ %def cmd_unpolarized_write
 @ Compile: accounted for by the base command.
 
 Execute: apply the modifications to the current model.
 <<Commands: cmd polarized: TBP>>=
   procedure :: execute => cmd_polarized_execute
 <<Commands: cmd unpolarized: TBP>>=
   procedure :: execute => cmd_unpolarized_execute
 <<Commands: procedures>>=
   subroutine cmd_polarized_execute (cmd, global)
     class(cmd_polarized_t), intent(inout) :: cmd
     type(rt_data_t), target, intent(inout) :: global
     type(var_list_t), pointer :: var_list
     type(pdg_array_t) :: pa
     integer :: pdg
     type(flavor_t) :: flv
     integer :: i
     var_list => cmd%local%get_var_list_ptr ()
     do i = 1, size (cmd%pn_pdg)
        pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
        if (pdg_array_get_length (pa) /= 1) &
             call msg_fatal ("Polarized: listed particles must be unique")
        pdg = pdg_array_get (pa, 1)
        call global%modify_particle (pdg, polarized = .true., &
             stable = .true., &
             isotropic_decay = .false., &
             diagonal_decay = .false.)
        call flv%init (pdg, cmd%local%model)
        call msg_message ("Particle " &
             // char (flv%get_name ()) &
             // " declared as polarized")
     end do
   end subroutine cmd_polarized_execute
 
   subroutine cmd_unpolarized_execute (cmd, global)
     class(cmd_unpolarized_t), intent(inout) :: cmd
     type(rt_data_t), target, intent(inout) :: global
     type(var_list_t), pointer :: var_list
     type(pdg_array_t) :: pa
     integer :: pdg
     type(flavor_t) :: flv
     integer :: i
     var_list => cmd%local%get_var_list_ptr ()
     do i = 1, size (cmd%pn_pdg)
        pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
        if (pdg_array_get_length (pa) /= 1) &
             call msg_fatal ("Unpolarized: listed particles must be unique")
        pdg = pdg_array_get (pa, 1)
        call global%modify_particle (pdg, polarized = .false., &
             stable = .true., &
             isotropic_decay = .false., &
             diagonal_decay = .false.)
        call flv%init (pdg, cmd%local%model)
        call msg_message ("Particle " &
             // char (flv%get_name ()) &
             // " declared as unpolarized")
     end do
   end subroutine cmd_unpolarized_execute
 
 @ %def cmd_polarized_execute
 @ %def cmd_unpolarized_execute
 @
 \subsubsection{Parameters: formats for event-sample output}
 Specify all event formats that are to be used for output files in the
 subsequent simulation run.  (The raw format is on by default and can be turned
 off here.)
 <<Commands: types>>=
   type, extends (command_t) :: cmd_sample_format_t
      private
      type(string_t), dimension(:), allocatable :: format
    contains
    <<Commands: cmd sample format: TBP>>
   end type cmd_sample_format_t
 
 @ %def cmd_sample_format_t
 @ Output: here, everything is known.
 <<Commands: cmd sample format: TBP>>=
   procedure :: write => cmd_sample_format_write
 <<Commands: procedures>>=
   subroutine cmd_sample_format_write (cmd, unit, indent)
     class(cmd_sample_format_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "sample_format = "
     do i = 1, size (cmd%format)
        if (i > 1)  write (u, "(A,1x)", advance="no")  ","
        write (u, "(A)", advance="no")  char (cmd%format(i))
     end do
     write (u, "(A)")
   end subroutine cmd_sample_format_write
 
 @ %def cmd_sample_format_write
 @ Compile.  Initialize evaluation trees.
 <<Commands: cmd sample format: TBP>>=
   procedure :: compile => cmd_sample_format_compile
 <<Commands: procedures>>=
   subroutine cmd_sample_format_compile (cmd, global)
     class(cmd_sample_format_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg
     type(parse_node_t), pointer :: pn_format
     integer :: i, n_format
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
     if (associated (pn_arg)) then
        n_format = parse_node_get_n_sub (pn_arg)
        allocate (cmd%format (n_format))
        pn_format => parse_node_get_sub_ptr (pn_arg)
        i = 0
        do while (associated (pn_format))
           i = i + 1
           cmd%format(i) = parse_node_get_string (pn_format)
           pn_format => parse_node_get_next_ptr (pn_format)
        end do
     else
        allocate (cmd%format (0))
     end if
   end subroutine cmd_sample_format_compile
 
 @ %def cmd_sample_format_compile
 @ Execute.  Transfer the list of format specifications to the
 corresponding array in the runtime data set.
 <<Commands: cmd sample format: TBP>>=
   procedure :: execute => cmd_sample_format_execute
 <<Commands: procedures>>=
   subroutine cmd_sample_format_execute (cmd, global)
     class(cmd_sample_format_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (allocated (global%sample_fmt))  deallocate (global%sample_fmt)
     allocate (global%sample_fmt (size (cmd%format)), source = cmd%format)
   end subroutine cmd_sample_format_execute
 
 @ %def cmd_sample_format_execute
 @
 \subsubsection{The simulate command}
 This is the actual SINDARIN command.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_simulate_t
      ! not private anymore as required by the whizard-c-interface
      integer :: n_proc = 0
      type(string_t), dimension(:), allocatable :: process_id
    contains
    <<Commands: cmd simulate: TBP>>
   end type cmd_simulate_t
 
 @ %def cmd_simulate_t
 @ Output: we know the process IDs.
 <<Commands: cmd simulate: TBP>>=
   procedure :: write => cmd_simulate_write
 <<Commands: procedures>>=
   subroutine cmd_simulate_write (cmd, unit, indent)
     class(cmd_simulate_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "simulate ("
     do i = 1, cmd%n_proc
        if (i > 1)  write (u, "(A,1x)", advance="no")  ","
        write (u, "(A)", advance="no")  char (cmd%process_id(i))
     end do
     write (u, "(A)")  ")"
   end subroutine cmd_simulate_write
 
 @ %def cmd_simulate_write
 @ Compile. In contrast to WHIZARD 1 the confusing option to give the
 number of unweighted events for weighted events as if unweighting were
 to take place has been abandoned. (We both use [[n_events]] for
 weighted and unweighted events, the variable [[n_calls]] from WHIZARD
 1 has been discarded.
 <<Commands: cmd simulate: TBP>>=
   procedure :: compile => cmd_simulate_compile
 <<Commands: procedures>>=
   subroutine cmd_simulate_compile (cmd, global)
     class(cmd_simulate_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_proclist, pn_proc
     integer :: i
     pn_proclist => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
     call cmd%compile_options (global)
     cmd%n_proc = parse_node_get_n_sub (pn_proclist)
     allocate (cmd%process_id (cmd%n_proc))
     pn_proc => parse_node_get_sub_ptr (pn_proclist)
     do i = 1, cmd%n_proc
        cmd%process_id(i) = parse_node_get_string (pn_proc)
        call global%process_stack%init_result_vars (cmd%process_id(i))
        pn_proc => parse_node_get_next_ptr (pn_proc)
     end do
   end subroutine cmd_simulate_compile
 
 @ %def cmd_simulate_compile
 @ Execute command:  Simulate events.  This is done via a [[simulation_t]]
 object and its associated methods.
 
 Signal handling: the [[generate]] method may exit abnormally if there is a
 pending signal.  The current logic ensures that the [[es_array]] output
 channels are closed before the [[execute]] routine returns.  The program will
 terminate then in [[command_list_execute]].
 <<Commands: cmd simulate: TBP>>=
   procedure :: execute => cmd_simulate_execute
 <<Commands: procedures>>=
   subroutine cmd_simulate_execute (cmd, global)
     class(cmd_simulate_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(rt_data_t), dimension(:), allocatable, target :: alt_env
     integer :: n_events, n_fmt
     type(string_t) :: sample, sample_suffix
     logical :: rebuild_events, read_raw, write_raw
     type(simulation_t), target :: sim
     type(string_t), dimension(:), allocatable :: sample_fmt
     type(event_stream_array_t) :: es_array
     type(event_sample_data_t) :: data
     integer :: i, checkpoint, callback
    <<Commands: cmd simulate execute: variables>>
     var_list => cmd%local%var_list
     if (allocated (cmd%local%pn%alt_setup)) then
        allocate (alt_env (size (cmd%local%pn%alt_setup)))
        do i = 1, size (alt_env)
           call build_alt_setup (alt_env(i), cmd%local, &
                cmd%local%pn%alt_setup(i)%ptr)
        end do
        call sim%init (cmd%process_id, .true., .true., cmd%local, global, &
             alt_env)
     else
        call sim%init (cmd%process_id, .true., .true., cmd%local, global)
     end if
     if (signal_is_pending ())  return
     if (sim%is_valid ()) then
        call sim%init_process_selector ()
        call openmp_set_num_threads_verbose &
             (var_list%get_ival (var_str ("openmp_num_threads")), &
             var_list%get_lval (var_str ("?openmp_logging")))
        call sim%compute_n_events (n_events, var_list)
        sample_suffix = ""
      <<Commands: cmd simulate execute: init>>
        sample = var_list%get_sval (var_str ("$sample"))
        if (sample == "")  then
           sample = sim%get_default_sample_name () // sample_suffix
        else
           sample = var_list%get_sval (var_str ("$sample")) // sample_suffix
        end if
        rebuild_events = &
             var_list%get_lval (var_str ("?rebuild_events"))
        read_raw = &
             var_list%get_lval (var_str ("?read_raw")) &
             .and. .not. rebuild_events
        write_raw = &
             var_list%get_lval (var_str ("?write_raw"))
        checkpoint = &
             var_list%get_ival (var_str ("checkpoint"))
        callback = &
             var_list%get_ival (var_str ("event_callback_interval"))
        if (read_raw) then
           inquire (file = char (sample) // ".evx", exist = read_raw)
        end if
        if (allocated (cmd%local%sample_fmt)) then
           n_fmt = size (cmd%local%sample_fmt)
        else
           n_fmt = 0
        end if
        data = sim%get_data ()
        data%n_evt = n_events
        data%nlo_multiplier = sim%get_n_nlo_entries (1)
        if (read_raw) then
           allocate (sample_fmt (n_fmt))
           if (n_fmt > 0)  sample_fmt = cmd%local%sample_fmt
           call es_array%init (sample, &
                sample_fmt, cmd%local, &
                data = data, &
                input = var_str ("raw"), &
                allow_switch = write_raw, &
                checkpoint = checkpoint, &
                callback = callback)
           call sim%generate (n_events, es_array)
           call es_array%final ()
        else if (write_raw) then
           allocate (sample_fmt (n_fmt + 1))
           if (n_fmt > 0)  sample_fmt(:n_fmt) = cmd%local%sample_fmt
           sample_fmt(n_fmt+1) = var_str ("raw")
           call es_array%init (sample, &
                sample_fmt, cmd%local, &
                data = data, &
                checkpoint = checkpoint, &
                callback = callback)
           call sim%generate (n_events, es_array)
           call es_array%final ()
        else if (allocated (cmd%local%sample_fmt) &
             .or. checkpoint > 0 &
             .or. callback > 0) then
           allocate (sample_fmt (n_fmt))
           if (n_fmt > 0)  sample_fmt = cmd%local%sample_fmt
           call es_array%init (sample, &
                sample_fmt, cmd%local, &
                data = data, &
                checkpoint = checkpoint, &
                callback = callback)
           call sim%generate (n_events, es_array)
           call es_array%final ()
        else
           call sim%generate (n_events)
        end if
        if (allocated (alt_env)) then
           do i = 1, size (alt_env)
              call alt_env(i)%local_final ()
           end do
        end if
     end if
     call sim%final ()
   end subroutine cmd_simulate_execute
 
 @ %def cmd_simulate_execute
 <<Commands: cmd simulate execute: variables>>=
 @
 <<Commands: cmd simulate execute: init>>=
 @
 <<MPI: Commands: cmd simulate execute: variables>>=
   logical :: mpi_logging
   integer :: rank, n_size
 @ Append rank id to sample name.
 <<MPI: Commands: cmd simulate execute: init>>=
   call mpi_get_comm_id (n_size, rank)
   if (n_size > 1) then
      sample_suffix = var_str ("_") // str (rank)
   end if
   mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) &
        & .and. (n_size > 1)) &
        & .or. var_list%get_lval (var_str ("?mpi_logging")))
   call mpi_set_logging (mpi_logging)
 @
 @ Build an alternative setup: the parse tree is stored in the global
 environment.  We create a temporary command list to compile and execute this;
 the result is an alternative local environment [[alt_env]] which we can hand
 over to the [[simulate]] command.
 <<Commands: procedures>>=
   recursive subroutine build_alt_setup (alt_env, global, pn)
     type(rt_data_t), intent(inout), target :: alt_env
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), intent(in), target :: pn
     type(command_list_t), allocatable :: alt_options
     allocate (alt_options)
     call alt_env%local_init (global)
     call alt_env%activate ()
     call alt_options%compile (pn, alt_env)
     call alt_options%execute (alt_env)
     call alt_env%deactivate (global, keep_local = .true.)
     call alt_options%final ()
   end subroutine build_alt_setup
 
 @ %def build_alt_setup
 @
 \subsubsection{The rescan command}
 This is the actual SINDARIN command.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_rescan_t
      ! private
      type(parse_node_t), pointer :: pn_filename => null ()
      integer :: n_proc = 0
      type(string_t), dimension(:), allocatable :: process_id
    contains
    <<Commands: cmd rescan: TBP>>
   end type cmd_rescan_t
 
 @ %def cmd_rescan_t
 @ Output: we know the process IDs.
 <<Commands: cmd rescan: TBP>>=
   procedure :: write => cmd_rescan_write
 <<Commands: procedures>>=
   subroutine cmd_rescan_write (cmd, unit, indent)
     class(cmd_rescan_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "rescan ("
     do i = 1, cmd%n_proc
        if (i > 1)  write (u, "(A,1x)", advance="no")  ","
        write (u, "(A)", advance="no")  char (cmd%process_id(i))
     end do
     write (u, "(A)")  ")"
   end subroutine cmd_rescan_write
 
 @ %def cmd_rescan_write
 @ Compile.  The command takes a suffix argument, namely the file name
 of requested event file.
 <<Commands: cmd rescan: TBP>>=
   procedure :: compile => cmd_rescan_compile
 <<Commands: procedures>>=
   subroutine cmd_rescan_compile (cmd, global)
     class(cmd_rescan_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_filename, pn_proclist, pn_proc
     integer :: i
     pn_filename => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_proclist => parse_node_get_next_ptr (pn_filename)
     cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
     call cmd%compile_options (global)
     cmd%pn_filename => pn_filename
     cmd%n_proc = parse_node_get_n_sub (pn_proclist)
     allocate (cmd%process_id (cmd%n_proc))
     pn_proc => parse_node_get_sub_ptr (pn_proclist)
     do i = 1, cmd%n_proc
        cmd%process_id(i) = parse_node_get_string (pn_proc)
        pn_proc => parse_node_get_next_ptr (pn_proc)
     end do
   end subroutine cmd_rescan_compile
 
 @ %def cmd_rescan_compile
 @ Execute command:  Rescan events.  This is done via a [[simulation_t]]
 object and its associated methods.
 <<Commands: cmd rescan: TBP>>=
   procedure :: execute => cmd_rescan_execute
 <<Commands: procedures>>=
   subroutine cmd_rescan_execute (cmd, global)
     class(cmd_rescan_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(rt_data_t), dimension(:), allocatable, target :: alt_env
     type(string_t) :: sample, sample_suffix
     logical :: exist, write_raw, update_event, update_sqme
     type(simulation_t), target :: sim
     type(event_sample_data_t) :: input_data, data
     type(string_t) :: input_sample
     integer :: n_fmt
     type(string_t), dimension(:), allocatable :: sample_fmt
     type(string_t) :: input_format, input_ext, input_file
     type(string_t) :: lhef_extension, extension_hepmc, extension_lcio
     type(event_stream_array_t) :: es_array
     integer :: i, n_events
   <<Commands: cmd rescan execute: variables>>
     var_list => cmd%local%var_list
     if (allocated (cmd%local%pn%alt_setup)) then
        allocate (alt_env (size (cmd%local%pn%alt_setup)))
        do i = 1, size (alt_env)
           call build_alt_setup (alt_env(i), cmd%local, &
                cmd%local%pn%alt_setup(i)%ptr)
        end do
        call sim%init (cmd%process_id, .false., .false., cmd%local, global, &
             alt_env)
     else
        call sim%init (cmd%process_id, .false., .false., cmd%local, global)
     end if
     call sim%compute_n_events (n_events, var_list)
     input_sample = eval_string (cmd%pn_filename, var_list)
     input_format = var_list%get_sval (&
          var_str ("$rescan_input_format"))
     sample_suffix = ""
   <<Commands: cmd rescan execute: init>>
     sample = var_list%get_sval (var_str ("$sample"))
     if (sample == "") then
        sample = sim%get_default_sample_name () // sample_suffix
     else
        sample = var_list%get_sval (var_str ("$sample")) // sample_suffix
     end if
     write_raw = var_list%get_lval (var_str ("?write_raw"))
     if (allocated (cmd%local%sample_fmt)) then
        n_fmt = size (cmd%local%sample_fmt)
     else
        n_fmt = 0
     end if
     if (write_raw) then
        if (sample == input_sample) then
           call msg_error ("Rescan: ?write_raw = true: " &
                // "suppressing raw event output (filename clashes with input)")
           allocate (sample_fmt (n_fmt))
           if (n_fmt > 0)  sample_fmt = cmd%local%sample_fmt
        else
           allocate (sample_fmt (n_fmt + 1))
           if (n_fmt > 0)  sample_fmt(:n_fmt) = cmd%local%sample_fmt
           sample_fmt(n_fmt+1) = var_str ("raw")
        end if
     else
        allocate (sample_fmt (n_fmt))
        if (n_fmt > 0)  sample_fmt = cmd%local%sample_fmt
     end if
     update_event = &
          var_list%get_lval (var_str ("?update_event"))
     update_sqme = &
          var_list%get_lval (var_str ("?update_sqme"))
     if (update_event .or. update_sqme) then
        call msg_message ("Recalculating observables")
        if (update_sqme) then
           call msg_message ("Recalculating squared matrix elements")
        end if
     end if
     lhef_extension = &
          var_list%get_sval (var_str ("$lhef_extension"))
     extension_hepmc = &
          var_list%get_sval (var_str ("$extension_hepmc"))
     extension_lcio = &
          var_list%get_sval (var_str ("$extension_lcio"))
     select case (char (input_format))
     case ("raw");  input_ext = "evx"
        call cmd%local%set_log &
             (var_str ("?recover_beams"), .false., is_known=.true.)
     case ("lhef"); input_ext = lhef_extension
     case ("hepmc"); input_ext = extension_hepmc
     case default
        call msg_fatal ("rescan: input sample format '" // char (input_format) &
             // "' not supported")
     end select
     input_file = input_sample // "." // input_ext
     inquire (file = char (input_file), exist = exist)
     if (exist) then
        input_data = sim%get_data (alt = .false.)
        input_data%n_evt = n_events
        data = sim%get_data ()
        data%n_evt = n_events
        input_data%md5sum_cfg = ""
        call es_array%init (sample, &
             sample_fmt, cmd%local, data, &
             input = input_format, input_sample = input_sample, &
             input_data = input_data, &
             allow_switch = .false.)
        call sim%rescan (n_events, es_array, global = cmd%local)
        call es_array%final ()
     else
        call msg_fatal ("Rescan: event file '" &
             // char (input_file) // "' not found")
     end if
     if (allocated (alt_env)) then
        do i = 1, size (alt_env)
           call alt_env(i)%local_final ()
        end do
     end if
     call sim%final ()
   end subroutine cmd_rescan_execute
 
 @ %def cmd_rescan_execute
 @
 <<Commands: cmd rescan execute: variables>>=
 @
 <<Commands: cmd rescan execute: init>>=
 @
 <<MPI: Commands: cmd rescan execute: variables>>=
   logical :: mpi_logging
   integer :: rank, n_size
 @ Append rank id to sample name.
 <<MPI: Commands: cmd rescan execute: init>>=
   call mpi_get_comm_id (n_size, rank)
   if (n_size > 1) then
      sample_suffix = var_str ("_") // str (rank)
   end if
   mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) &
        & .and. (n_size > 1)) &
        & .or. var_list%get_lval (var_str ("?mpi_logging")))
   call mpi_set_logging (mpi_logging)
 @
 \subsubsection{Parameters: number of iterations}
 Specify number of iterations and number of calls for one integration pass.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_iterations_t
      private
      integer :: n_pass = 0
      type(parse_node_p), dimension(:), allocatable :: pn_expr_n_it
      type(parse_node_p), dimension(:), allocatable :: pn_expr_n_calls
      type(parse_node_p), dimension(:), allocatable :: pn_sexpr_adapt
    contains
    <<Commands: cmd iterations: TBP>>
   end type cmd_iterations_t
 
 @ %def cmd_iterations_t
 @ Output.  Display the number of passes, which is known after compilation.
 <<Commands: cmd iterations: TBP>>=
   procedure :: write => cmd_iterations_write
 <<Commands: procedures>>=
   subroutine cmd_iterations_write (cmd, unit, indent)
     class(cmd_iterations_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     select case (cmd%n_pass)
     case (0)
        write (u, "(1x,A)")  "iterations: [empty]"
     case (1)
        write (u, "(1x,A,I0,A)")  "iterations: ", cmd%n_pass, " pass"
     case default
        write (u, "(1x,A,I0,A)")  "iterations: ", cmd%n_pass, " passes"
     end select
   end subroutine cmd_iterations_write
 
 @ %def cmd_iterations_write
 @ Compile.  Initialize evaluation trees.
 <<Commands: cmd iterations: TBP>>=
   procedure :: compile => cmd_iterations_compile
 <<Commands: procedures>>=
   subroutine cmd_iterations_compile (cmd, global)
     class(cmd_iterations_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_n_it, pn_n_calls, pn_adapt
     type(parse_node_t), pointer :: pn_it_spec, pn_calls_spec, pn_adapt_spec
     integer :: i
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
     if (associated (pn_arg)) then
        cmd%n_pass = parse_node_get_n_sub (pn_arg)
        allocate (cmd%pn_expr_n_it (cmd%n_pass))
        allocate (cmd%pn_expr_n_calls (cmd%n_pass))
        allocate (cmd%pn_sexpr_adapt (cmd%n_pass))
        pn_it_spec => parse_node_get_sub_ptr (pn_arg)
        i = 1
        do while (associated (pn_it_spec))
           pn_n_it => parse_node_get_sub_ptr (pn_it_spec)
           pn_calls_spec => parse_node_get_next_ptr (pn_n_it)
           pn_n_calls => parse_node_get_sub_ptr (pn_calls_spec, 2)
           pn_adapt_spec => parse_node_get_next_ptr (pn_calls_spec)
           if (associated (pn_adapt_spec)) then
              pn_adapt => parse_node_get_sub_ptr (pn_adapt_spec, 2)
           else
              pn_adapt => null ()
           end if
           cmd%pn_expr_n_it(i)%ptr => pn_n_it
           cmd%pn_expr_n_calls(i)%ptr => pn_n_calls
           cmd%pn_sexpr_adapt(i)%ptr => pn_adapt
           i = i + 1
           pn_it_spec => parse_node_get_next_ptr (pn_it_spec)
        end do
     else
        allocate (cmd%pn_expr_n_it (0))
        allocate (cmd%pn_expr_n_calls (0))
     end if
   end subroutine cmd_iterations_compile
 
 @ %def cmd_iterations_compile
 @ Execute.  Evaluate the trees and transfer the results to the iteration
 list in the runtime data set.
 <<Commands: cmd iterations: TBP>>=
   procedure :: execute => cmd_iterations_execute
 <<Commands: procedures>>=
   subroutine cmd_iterations_execute (cmd, global)
     class(cmd_iterations_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     integer, dimension(cmd%n_pass) :: n_it, n_calls
     logical, dimension(cmd%n_pass) :: custom_adapt
     type(string_t), dimension(cmd%n_pass) :: adapt_code
     integer :: i
     var_list => global%get_var_list_ptr ()
     do i = 1, cmd%n_pass
        n_it(i) = eval_int (cmd%pn_expr_n_it(i)%ptr, var_list)
        n_calls(i) = &
             eval_int (cmd%pn_expr_n_calls(i)%ptr, var_list)
        if (associated (cmd%pn_sexpr_adapt(i)%ptr)) then
           adapt_code(i) = &
                eval_string (cmd%pn_sexpr_adapt(i)%ptr, &
                             var_list, is_known = custom_adapt(i))
        else
           custom_adapt(i) = .false.
        end if
     end do
     call global%it_list%init (n_it, n_calls, custom_adapt, adapt_code)
   end subroutine cmd_iterations_execute
 
 @ %def cmd_iterations_execute
 @
 \subsubsection{Range expressions}
 We need a special type for storing and evaluating range expressions.
 <<Commands: parameters>>=
   integer, parameter :: STEP_NONE = 0
   integer, parameter :: STEP_ADD = 1
   integer, parameter :: STEP_SUB = 2
   integer, parameter :: STEP_MUL = 3
   integer, parameter :: STEP_DIV = 4
   integer, parameter :: STEP_COMP_ADD = 11
   integer, parameter :: STEP_COMP_MUL = 13
 @
 There is an abstract base type and two implementations: scan over integers and
 scan over reals.
 <<Commands: types>>=
   type, abstract :: range_t
      type(parse_node_t), pointer :: pn_expr => null ()
      type(parse_node_t), pointer :: pn_term => null ()
      type(parse_node_t), pointer :: pn_factor => null ()
      type(parse_node_t), pointer :: pn_value => null ()
      type(parse_node_t), pointer :: pn_literal => null ()
      type(parse_node_t), pointer :: pn_beg => null ()
      type(parse_node_t), pointer :: pn_end => null ()
      type(parse_node_t), pointer :: pn_step => null ()
      type(eval_tree_t) :: expr_beg
      type(eval_tree_t) :: expr_end
      type(eval_tree_t) :: expr_step
      integer :: step_mode = 0
      integer :: n_step = 0
    contains
    <<Commands: range: TBP>>
   end type range_t
 
 @ %def range_t
 @ These are the implementations:
 <<Commands: types>>=
   type, extends (range_t) :: range_int_t
      integer :: i_beg = 0
      integer :: i_end = 0
      integer :: i_step = 0
    contains
    <<Commands: range int: TBP>>
 end type range_int_t
 
   type, extends (range_t) :: range_real_t
      real(default) :: r_beg = 0
      real(default) :: r_end = 0
      real(default) :: r_step = 0
      real(default) :: lr_beg  = 0
      real(default) :: lr_end  = 0
      real(default) :: lr_step = 0
    contains
    <<Commands: range real: TBP>>
 end type range_real_t
 
 @ %def range_int_t range_real_t
 @ Finalize the allocated dummy node.  The other nodes are just pointers.
 <<Commands: range: TBP>>=
   procedure :: final => range_final
 <<Commands: procedures>>=
   subroutine range_final (object)
     class(range_t), intent(inout) :: object
     if (associated (object%pn_expr)) then
        call parse_node_final (object%pn_expr, recursive = .false.)
        call parse_node_final (object%pn_term, recursive = .false.)
        call parse_node_final (object%pn_factor, recursive = .false.)
        call parse_node_final (object%pn_value, recursive = .false.)
        call parse_node_final (object%pn_literal, recursive = .false.)
        deallocate (object%pn_expr)
        deallocate (object%pn_term)
        deallocate (object%pn_factor)
        deallocate (object%pn_value)
        deallocate (object%pn_literal)
     end if
   end subroutine range_final
 
 @ %def range_final
 @ Output.
 <<Commands: range: TBP>>=
   procedure (range_write), deferred :: write
   procedure :: base_write => range_write
 <<Commands: range int: TBP>>=
   procedure :: write => range_int_write
 <<Commands: range real: TBP>>=
   procedure :: write => range_real_write
 <<Commands: procedures>>=
   subroutine range_write (object, unit)
     class(range_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Range specification:"
     if (associated (object%pn_expr)) then
        write (u, "(1x,A)")  "Dummy value:"
        call parse_node_write_rec (object%pn_expr, u)
     end if
     if (associated (object%pn_beg)) then
        write (u, "(1x,A)")  "Initial value:"
        call parse_node_write_rec (object%pn_beg, u)
        call object%expr_beg%write (u)
        if (associated (object%pn_end)) then
           write (u, "(1x,A)")  "Final value:"
           call parse_node_write_rec (object%pn_end, u)
           call object%expr_end%write (u)
           if (associated (object%pn_step)) then
              write (u, "(1x,A)")  "Step value:"
              call parse_node_write_rec (object%pn_step, u)
              select case (object%step_mode)
              case (STEP_ADD);   write (u, "(1x,A)")  "Step mode: +"
              case (STEP_SUB);   write (u, "(1x,A)")  "Step mode: -"
              case (STEP_MUL);   write (u, "(1x,A)")  "Step mode: *"
              case (STEP_DIV);   write (u, "(1x,A)")  "Step mode: /"
              case (STEP_COMP_ADD);  write (u, "(1x,A)")  "Division mode: +"
              case (STEP_COMP_MUL);  write (u, "(1x,A)")  "Division mode: *"
              end select
           end if
        end if
     else
        write (u, "(1x,A)")  "Expressions: [undefined]"
     end if
   end subroutine range_write
 
   subroutine range_int_write (object, unit)
     class(range_int_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call object%base_write (unit)
     write (u, "(1x,A)")  "Range parameters:"
     write (u, "(3x,A,I0)")  "i_beg  = ", object%i_beg
     write (u, "(3x,A,I0)")  "i_end  = ", object%i_end
     write (u, "(3x,A,I0)")  "i_step = ", object%i_step
     write (u, "(3x,A,I0)")  "n_step = ", object%n_step
   end subroutine range_int_write
 
   subroutine range_real_write (object, unit)
     class(range_real_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call object%base_write (unit)
     write (u, "(1x,A)")  "Range parameters:"
     write (u, "(3x,A," // FMT_19 // ")")  "r_beg  = ", object%r_beg
     write (u, "(3x,A," // FMT_19 // ")")  "r_end  = ", object%r_end
     write (u, "(3x,A," // FMT_19 // ")")  "r_step = ", object%r_end
     write (u, "(3x,A,I0)")  "n_step = ", object%n_step
   end subroutine range_real_write
 
 @ %def range_write
 @ Initialize, given a range expression parse node.  This is common to the
 implementations.
 <<Commands: range: TBP>>=
   procedure :: init => range_init
 <<Commands: procedures>>=
   subroutine range_init (range, pn)
     class(range_t), intent(out) :: range
     type(parse_node_t), intent(in), target :: pn
     type(parse_node_t), pointer :: pn_spec, pn_end, pn_step_spec, pn_op
     select case (char (parse_node_get_rule_key (pn)))
     case ("expr")
     case ("range_expr")
        range%pn_beg => parse_node_get_sub_ptr (pn)
        pn_spec => parse_node_get_next_ptr (range%pn_beg)
        if (associated (pn_spec)) then
           pn_end => parse_node_get_sub_ptr (pn_spec, 2)
           range%pn_end => pn_end
           pn_step_spec => parse_node_get_next_ptr (pn_end)
           if (associated (pn_step_spec)) then
              pn_op => parse_node_get_sub_ptr (pn_step_spec)
              range%pn_step => parse_node_get_next_ptr (pn_op)
              select case (char (parse_node_get_rule_key (pn_op)))
              case ("/+");  range%step_mode = STEP_ADD
              case ("/-");  range%step_mode = STEP_SUB
              case ("/*");  range%step_mode = STEP_MUL
              case ("//");  range%step_mode = STEP_DIV
              case ("/+/");  range%step_mode = STEP_COMP_ADD
              case ("/*/");  range%step_mode = STEP_COMP_MUL
              case default
                 call range%write ()
                 call msg_bug ("Range: step mode not implemented")
              end select
           else
              range%step_mode = STEP_ADD
           end if
        else
           range%step_mode = STEP_NONE
        end if
        call range%create_value_node ()
     case default
        call msg_bug ("range expression: node type '" &
             // char (parse_node_get_rule_key (pn)) &
             // "' not implemented")
     end select
   end subroutine range_init
 
 @ %def range_init
 @ This method manually creates a parse node (actually, a cascade of parse
 nodes) that hold a constant value as a literal.  The idea is that this node is
 inserted as the right-hand side of a fake variable assignment, which is
 prepended to each scan iteration.  Before the variable
 assignment is compiled and executed, we can manually reset the value of the
 literal and thus pretend that the loop variable is assigned this value.
 <<Commands: range: TBP>>=
   procedure :: create_value_node => range_create_value_node
 <<Commands: procedures>>=
   subroutine range_create_value_node (range)
     class(range_t), intent(inout) :: range
     allocate (range%pn_literal)
     allocate (range%pn_value)
     select type (range)
     type is (range_int_t)
        call parse_node_create_value (range%pn_literal, &
             syntax_get_rule_ptr (syntax_cmd_list, var_str ("integer_literal")),&
             ival = 0)
        call parse_node_create_branch (range%pn_value, &
             syntax_get_rule_ptr (syntax_cmd_list, var_str ("integer_value")))
     type is (range_real_t)
        call parse_node_create_value (range%pn_literal, &
             syntax_get_rule_ptr (syntax_cmd_list, var_str ("real_literal")),&
             rval = 0._default)
        call parse_node_create_branch (range%pn_value, &
             syntax_get_rule_ptr (syntax_cmd_list, var_str ("real_value")))
     class default
        call msg_bug ("range: create value node: type not implemented")
     end select
     call parse_node_append_sub (range%pn_value, range%pn_literal)
     call parse_node_freeze_branch (range%pn_value)
     allocate (range%pn_factor)
     call parse_node_create_branch (range%pn_factor, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("factor")))
     call parse_node_append_sub (range%pn_factor, range%pn_value)
     call parse_node_freeze_branch (range%pn_factor)
     allocate (range%pn_term)
     call parse_node_create_branch (range%pn_term, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("term")))
     call parse_node_append_sub (range%pn_term, range%pn_factor)
     call parse_node_freeze_branch (range%pn_term)
     allocate (range%pn_expr)
     call parse_node_create_branch (range%pn_expr, &
          syntax_get_rule_ptr (syntax_cmd_list, var_str ("expr")))
     call parse_node_append_sub (range%pn_expr, range%pn_term)
     call parse_node_freeze_branch (range%pn_expr)
   end subroutine range_create_value_node
 
 @ %def range_create_value_node
 @ Compile, given an environment.
 <<Commands: range: TBP>>=
   procedure :: compile => range_compile
 <<Commands: procedures>>=
   subroutine range_compile (range, global)
     class(range_t), intent(inout) :: range
     type(rt_data_t), intent(in), target :: global
     type(var_list_t), pointer :: var_list
     var_list => global%get_var_list_ptr ()
     if (associated (range%pn_beg)) then
        call range%expr_beg%init_expr (range%pn_beg, var_list)
        if (associated (range%pn_end)) then
           call range%expr_end%init_expr (range%pn_end, var_list)
           if (associated (range%pn_step)) then
              call range%expr_step%init_expr (range%pn_step, var_list)
           end if
        end if
     end if
   end subroutine range_compile
 
 @ %def range_compile
 @ Evaluate: compute the actual bounds and parameters that determine the values
 that we can iterate.
 
 This is implementation-specific.
 <<Commands: range: TBP>>=
   procedure (range_evaluate), deferred :: evaluate
 <<Commands: interfaces>>=
   abstract interface
      subroutine range_evaluate (range)
        import
        class(range_t), intent(inout) :: range
      end subroutine range_evaluate
   end interface
 
 @ %def range_evaluate
 @ The version for an integer variable.  If the step is subtractive, we invert
 the sign and treat it as an additive step.  For a multiplicative step, the
 step must be greater than one, and the initial and final values must be of
 same sign and strictly ordered.  Analogously for a division step.
 <<Commands: range int: TBP>>=
   procedure :: evaluate => range_int_evaluate
 <<Commands: procedures>>=
   subroutine range_int_evaluate (range)
     class(range_int_t), intent(inout) :: range
     integer :: ival
     if (associated (range%pn_beg)) then
        call range%expr_beg%evaluate ()
        if (range%expr_beg%is_known ()) then
           range%i_beg = range%expr_beg%get_int ()
        else
           call range%write ()
           call msg_fatal &
                ("Range expression: initial value evaluates to unknown")
        end if
        if (associated (range%pn_end)) then
           call range%expr_end%evaluate ()
           if (range%expr_end%is_known ()) then
              range%i_end = range%expr_end%get_int ()
              if (associated (range%pn_step)) then
                 call range%expr_step%evaluate ()
                 if (range%expr_step%is_known ()) then
                    range%i_step = range%expr_step%get_int ()
                    select case (range%step_mode)
                    case (STEP_SUB);  range%i_step = - range%i_step
                    end select
                 else
                    call range%write ()
                    call msg_fatal &
                         ("Range expression: step value evaluates to unknown")
                 end if
              else
                 range%i_step = 1
              end if
           else
              call range%write ()
              call msg_fatal &
                   ("Range expression: final value evaluates to unknown")
           end if
        else
           range%i_end = range%i_beg
           range%i_step = 1
        end if
        select case (range%step_mode)
        case (STEP_NONE)
           range%n_step = 1
        case (STEP_ADD, STEP_SUB)
           if (range%i_step /= 0) then
              if (range%i_beg == range%i_end) then
                 range%n_step = 1
              else if (sign (1, range%i_end - range%i_beg) &
                   == sign (1, range%i_step)) then
                 range%n_step = (range%i_end - range%i_beg) / range%i_step + 1
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal ("range evaluation (add): step value is zero")
           end if
        case (STEP_MUL)
           if (range%i_step > 1) then
              if (range%i_beg == range%i_end) then
                 range%n_step = 1
              else if (range%i_beg == 0) then
                 call msg_fatal ("range evaluation (mul): initial value is zero")
              else if (sign (1, range%i_beg) == sign (1, range%i_end) &
                   .and. abs (range%i_beg) < abs (range%i_end)) then
                 range%n_step = 0
                 ival = range%i_beg
                 do while (abs (ival) <= abs (range%i_end))
                    range%n_step = range%n_step + 1
                    ival = ival * range%i_step
                 end do
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal &
                   ("range evaluation (mult): step value is one or less")
           end if
        case (STEP_DIV)
           if (range%i_step > 1) then
              if (range%i_beg == range%i_end) then
                 range%n_step = 1
              else if (sign (1, range%i_beg) == sign (1, range%i_end) &
                   .and. abs (range%i_beg) > abs (range%i_end)) then
                 range%n_step = 0
                 ival = range%i_beg
                 do while (abs (ival) >= abs (range%i_end))
                    range%n_step = range%n_step + 1
                    if (ival == 0)  exit
                    ival = ival / range%i_step
                 end do
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal &
                   ("range evaluation (div): step value is one or less")
           end if
        case (STEP_COMP_ADD)
           call msg_fatal ("range evaluation: &
                &step mode /+/ not allowed for integer variable")
        case (STEP_COMP_MUL)
           call msg_fatal ("range evaluation: &
                &step mode /*/ not allowed for integer variable")
        case default
           call range%write ()
           call msg_bug ("range evaluation: step mode not implemented")
        end select
     end if
   end subroutine range_int_evaluate
 
 @ %def range_int_evaluate
 @ The version for a real variable.
 <<Commands: range real: TBP>>=
   procedure :: evaluate => range_real_evaluate
 <<Commands: procedures>>=
   subroutine range_real_evaluate (range)
     class(range_real_t), intent(inout) :: range
     if (associated (range%pn_beg)) then
        call range%expr_beg%evaluate ()
        if (range%expr_beg%is_known ()) then
           range%r_beg = range%expr_beg%get_real ()
        else
           call range%write ()
           call msg_fatal &
                ("Range expression: initial value evaluates to unknown")
        end if
        if (associated (range%pn_end)) then
           call range%expr_end%evaluate ()
           if (range%expr_end%is_known ()) then
              range%r_end = range%expr_end%get_real ()
              if (associated (range%pn_step)) then
                 if (range%expr_step%is_known ()) then
                    select case (range%step_mode)
                    case (STEP_ADD, STEP_SUB, STEP_MUL, STEP_DIV)
                       call range%expr_step%evaluate ()
                       range%r_step = range%expr_step%get_real ()
                       select case (range%step_mode)
                       case (STEP_SUB);  range%r_step = - range%r_step
                       end select
                    case (STEP_COMP_ADD, STEP_COMP_MUL)
                       range%n_step = &
                            max (range%expr_step%get_int (), 0)
                    end select
                 else
                    call range%write ()
                    call msg_fatal &
                         ("Range expression: step value evaluates to unknown")
                 end if
              else
                 call range%write ()
                 call msg_fatal &
                      ("Range expression (real): step value must be provided")
              end if
           else
              call range%write ()
              call msg_fatal &
                   ("Range expression: final value evaluates to unknown")
           end if
        else
           range%r_end = range%r_beg
           range%r_step = 1
        end if
        select case (range%step_mode)
        case (STEP_NONE)
           range%n_step = 1
        case (STEP_ADD, STEP_SUB)
           if (range%r_step /= 0) then
              if (sign (1._default, range%r_end - range%r_beg) &
                   == sign (1._default, range%r_step)) then
                 range%n_step = &
                      nint ((range%r_end - range%r_beg) / range%r_step + 1)
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal ("range evaluation (add): step value is zero")
           end if
        case (STEP_MUL)
           if (range%r_step > 1) then
              if (range%r_beg == 0 .or. range%r_end == 0) then
                 call msg_fatal ("range evaluation (mul): bound is zero")
              else if (sign (1._default, range%r_beg) &
                   == sign (1._default, range%r_end) &
                   .and. abs (range%r_beg) <= abs (range%r_end)) then
                 range%lr_beg = log (abs (range%r_beg))
                 range%lr_end = log (abs (range%r_end))
                 range%lr_step = log (range%r_step)
                 range%n_step = nint &
                      (abs ((range%lr_end - range%lr_beg) / range%lr_step) + 1)
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal &
                   ("range evaluation (mult): step value is one or less")
           end if
        case (STEP_DIV)
           if (range%r_step > 1) then
              if (range%r_beg == 0 .or. range%r_end == 0) then
                 call msg_fatal ("range evaluation (div): bound is zero")
              else if (sign (1._default, range%r_beg) &
                   == sign (1._default, range%r_end) &
                   .and. abs (range%r_beg) >= abs (range%r_end)) then
                 range%lr_beg = log (abs (range%r_beg))
                 range%lr_end = log (abs (range%r_end))
                 range%lr_step = -log (range%r_step)
                 range%n_step = nint &
                      (abs ((range%lr_end - range%lr_beg) / range%lr_step) + 1)
              else
                 range%n_step = 0
              end if
           else
              call msg_fatal &
                   ("range evaluation (mult): step value is one or less")
           end if
        case (STEP_COMP_ADD)
           ! Number of steps already known
        case (STEP_COMP_MUL)
           ! Number of steps already known
           if (range%r_beg == 0 .or. range%r_end == 0) then
              call msg_fatal ("range evaluation (mul): bound is zero")
           else if (sign (1._default, range%r_beg) &
                == sign (1._default, range%r_end)) then
              range%lr_beg = log (abs (range%r_beg))
              range%lr_end = log (abs (range%r_end))
           else
              range%n_step = 0
           end if
        case default
           call range%write ()
           call msg_bug ("range evaluation: step mode not implemented")
        end select
     end if
   end subroutine range_real_evaluate
 
 @ %def range_real_evaluate
 @ Return the number of iterations:
 <<Commands: range: TBP>>=
   procedure :: get_n_iterations => range_get_n_iterations
 <<Commands: procedures>>=
   function range_get_n_iterations (range) result (n)
     class(range_t), intent(in) :: range
     integer :: n
     n = range%n_step
   end function range_get_n_iterations
 
 @ %def range_get_n_iterations
 @ Compute the value for iteration [[i]] and store it in the embedded token.
 <<Commands: range: TBP>>=
   procedure (range_set_value), deferred :: set_value
 <<Commands: interfaces>>=
   abstract interface
      subroutine range_set_value (range, i)
        import
        class(range_t), intent(inout) :: range
        integer, intent(in) :: i
      end subroutine range_set_value
   end interface
 
 @ %def range_set_value
 @ In the integer case, we compute the value directly for additive step.  For
 multiplicative step, we perform a loop in the same way as above, where the
 number of iteration was determined.
 <<Commands: range int: TBP>>=
   procedure :: set_value => range_int_set_value
 <<Commands: procedures>>=
   subroutine range_int_set_value (range, i)
     class(range_int_t), intent(inout) :: range
     integer, intent(in) :: i
     integer :: k, ival
     select case (range%step_mode)
     case (STEP_NONE)
        ival = range%i_beg
     case (STEP_ADD, STEP_SUB)
        ival = range%i_beg + (i - 1) * range%i_step
     case (STEP_MUL)
        ival = range%i_beg
        do k = 1, i - 1
           ival = ival * range%i_step
        end do
     case (STEP_DIV)
        ival = range%i_beg
        do k = 1, i - 1
           ival = ival / range%i_step
        end do
     case default
        call range%write ()
        call msg_bug ("range iteration: step mode not implemented")
     end select
     call parse_node_set_value (range%pn_literal, ival = ival)
   end subroutine range_int_set_value
 
 @ %def range_int_set_value
 @ In the integer case, we compute the value directly for additive step.  For
 multiplicative step, we perform a loop in the same way as above, where the
 number of iteration was determined.
 <<Commands: range real: TBP>>=
   procedure :: set_value => range_real_set_value
 <<Commands: procedures>>=
   subroutine range_real_set_value (range, i)
     class(range_real_t), intent(inout) :: range
     integer, intent(in) :: i
     real(default) :: rval, x
     select case (range%step_mode)
     case (STEP_NONE)
        rval = range%r_beg
     case (STEP_ADD, STEP_SUB, STEP_COMP_ADD)
        if (range%n_step > 1) then
           x = real (i - 1, default) / (range%n_step - 1)
        else
           x = 1._default / 2
        end if
        rval = x * range%r_end + (1 - x) * range%r_beg
     case (STEP_MUL, STEP_DIV, STEP_COMP_MUL)
        if (range%n_step > 1) then
           x = real (i - 1, default) / (range%n_step - 1)
        else
           x = 1._default / 2
        end if
        rval = sign &
             (exp (x * range%lr_end + (1 - x) * range%lr_beg), range%r_beg)
     case default
        call range%write ()
        call msg_bug ("range iteration: step mode not implemented")
     end select
     call parse_node_set_value (range%pn_literal, rval = rval)
   end subroutine range_real_set_value
 
 @ %def range_real_set_value
 @
 \subsubsection{Scan over parameters and other objects}
 The scan command allocates a new parse node for the variable
 assignment (the lhs).  The rhs of this parse node is assigned from the
 available rhs expressions in the scan list, one at a time, so the
 compiled parse node can be prepended to the scan body.
 
 Note: for the integer/real range array, the obvious implementation as a
 polymorphic array is suspended because in gfortran 4.7, polymorphic arrays are
 apparently broken.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_scan_t
      private
      type(string_t) :: name
      integer :: n_values = 0
      type(parse_node_p), dimension(:), allocatable :: scan_cmd
      !!! !!! gfortran 4.7.x memory corruption
      !!!  class(range_t), dimension(:), allocatable :: range
      type(range_int_t), dimension(:), allocatable :: range_int
      type(range_real_t), dimension(:), allocatable :: range_real
    contains
    <<Commands: cmd scan: TBP>>
   end type cmd_scan_t
 
 @ %def cmd_scan_t
 @ Finalizer.
 
 The auxiliary parse nodes that we have constructed have to be treated
 carefully: the embedded pointers all point to persistent objects
 somewhere else and should not be finalized, so we should not call the
 finalizer recursively.
 <<Commands: cmd scan: TBP>>=
   procedure :: final => cmd_scan_final
 <<Commands: procedures>>=
   recursive subroutine cmd_scan_final (cmd)
     class(cmd_scan_t), intent(inout) :: cmd
     type(parse_node_t), pointer :: pn_var_single, pn_decl_single
     type(string_t) :: key
     integer :: i
     if (allocated (cmd%scan_cmd)) then
        do i = 1, size (cmd%scan_cmd)
           pn_var_single => parse_node_get_sub_ptr (cmd%scan_cmd(i)%ptr)
           key = parse_node_get_rule_key (pn_var_single)
           select case (char (key))
           case ("scan_string_decl", "scan_log_decl")
              pn_decl_single => parse_node_get_sub_ptr (pn_var_single, 2)
              call parse_node_final (pn_decl_single, recursive=.false.)
              deallocate (pn_decl_single)
           end select
           call parse_node_final (pn_var_single, recursive=.false.)
           deallocate (pn_var_single)
        end do
        deallocate (cmd%scan_cmd)
     end if
     !!! !!! gfortran 4.7.x memory corruption
     !!!  if (allocated (cmd%range)) then
     !!!     do i = 1, size (cmd%range)
     !!!        call cmd%range(i)%final ()
     !!!     end do
     !!!  end if
     if (allocated (cmd%range_int)) then
        do i = 1, size (cmd%range_int)
           call cmd%range_int(i)%final ()
        end do
     end if
     if (allocated (cmd%range_real)) then
        do i = 1, size (cmd%range_real)
           call cmd%range_real(i)%final ()
        end do
     end if
   end subroutine cmd_scan_final
 
 @ %def cmd_scan_final
 @ Output.
 <<Commands: cmd scan: TBP>>=
   procedure :: write => cmd_scan_write
 <<Commands: procedures>>=
   subroutine cmd_scan_write (cmd, unit, indent)
     class(cmd_scan_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,1x,A,1x,'(',I0,')')")  "scan:", char (cmd%name), &
          cmd%n_values
   end subroutine cmd_scan_write
 
 @ %def cmd_scan_write
 @ Compile the scan command.  We construct a new parse node that
 implements the variable assignment for a single element on the rhs,
 instead of the whole list that we get from the original parse tree.
 By simply copying the node, we copy all pointers and inherit the
 targets from the original.  During execution, we should replace the
 rhs by the stored rhs pointers (the list elements), one by one, then
 (re)compile the redefined node.
 <<Commands: cmd scan: TBP>>=
   procedure :: compile => cmd_scan_compile
 <<Commands: procedures>>=
   recursive subroutine cmd_scan_compile (cmd, global)
     class(cmd_scan_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     type(parse_node_t), pointer :: pn_var, pn_body, pn_body_first
     type(parse_node_t), pointer :: pn_decl, pn_name
     type(parse_node_t), pointer :: pn_arg, pn_scan_cmd, pn_rhs
     type(parse_node_t), pointer :: pn_decl_single, pn_var_single
     type(syntax_rule_t), pointer :: var_rule_decl, var_rule
     type(string_t) :: key
     integer :: var_type
     integer :: i
     call msg_debug (D_CORE, "cmd_scan_compile")
     if (debug_active (D_CORE))  call parse_node_write_rec (cmd%pn)
     pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_body => parse_node_get_next_ptr (pn_var)
     if (associated (pn_body)) then
        pn_body_first => parse_node_get_sub_ptr (pn_body)
     else
        pn_body_first => null ()
     end if
     key = parse_node_get_rule_key (pn_var)
     select case (char (key))
     case ("scan_num")
        pn_name => parse_node_get_sub_ptr (pn_var)
        cmd%name = parse_node_get_string (pn_name)
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_num"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_int")
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_int"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_real")
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_real"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_complex")
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str("cmd_complex"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_alias")
        pn_name => parse_node_get_sub_ptr (pn_var, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_alias"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_string_decl")
        pn_decl => parse_node_get_sub_ptr (pn_var, 2)
        pn_name => parse_node_get_sub_ptr (pn_decl, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_string"))
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_string_decl"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_log_decl")
        pn_decl => parse_node_get_sub_ptr (pn_var, 2)
        pn_name => parse_node_get_sub_ptr (pn_decl, 2)
        cmd%name = parse_node_get_string (pn_name)
        var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_log"))
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_log_decl"))
        pn_arg => parse_node_get_next_ptr (pn_name, 2)
     case ("scan_cuts")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_cuts"))
        cmd%name = "cuts"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_weight")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_weight"))
        cmd%name = "weight"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_scale")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_scale"))
        cmd%name = "scale"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_ren_scale")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_ren_scale"))
        cmd%name = "renormalization_scale"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_fac_scale")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_fac_scale"))
        cmd%name = "factorization_scale"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_selection")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_selection"))
        cmd%name = "selection"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_reweight")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_reweight"))
        cmd%name = "reweight"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_analysis")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_analysis"))
        cmd%name = "analysis"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_model")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_model"))
        cmd%name = "model"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case ("scan_library")
        var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
             var_str ("cmd_library"))
        cmd%name = "library"
        pn_arg => parse_node_get_sub_ptr (pn_var, 3)
     case default
        call msg_bug ("scan: case '" // char (key) // "' not implemented")
     end select
     if (associated (pn_arg)) then
        cmd%n_values = parse_node_get_n_sub (pn_arg)
     end if
     var_list => global%get_var_list_ptr ()
     allocate (cmd%scan_cmd (cmd%n_values))
     select case (char (key))
     case ("scan_num")
        var_type = &
             var_list%get_type (cmd%name)
        select case (var_type)
        case (V_INT)
           !!! !!! gfortran 4.7.x memory corruption
           !!!  allocate (range_int_t :: cmd%range (cmd%n_values))
           allocate (cmd%range_int (cmd%n_values))
        case (V_REAL)
           !!! !!! gfortran 4.7.x memory corruption
           !!!  allocate (range_real_t :: cmd%range (cmd%n_values))
           allocate (cmd%range_real (cmd%n_values))
        case (V_CMPLX)
           call msg_fatal ("scan over complex variable not implemented")
        case (V_NONE)
           call msg_fatal ("scan: variable '" // char (cmd%name) //"' undefined")
        case default
           call msg_bug ("scan: impossible variable type")
        end select
     case ("scan_int")
        !!! !!! gfortran 4.7.x memory corruption
        !!!  allocate (range_int_t :: cmd%range (cmd%n_values))
        allocate (cmd%range_int (cmd%n_values))
     case ("scan_real")
        !!! !!! gfortran 4.7.x memory corruption
        !!!  allocate (range_real_t :: cmd%range (cmd%n_values))
        allocate (cmd%range_real (cmd%n_values))
     case ("scan_complex")
        call msg_fatal ("scan over complex variable not implemented")
     end select
     i = 1
     if (associated (pn_arg)) then
        pn_rhs => parse_node_get_sub_ptr (pn_arg)
     else
        pn_rhs => null ()
     end if
     do while (associated (pn_rhs))
        allocate (pn_scan_cmd)
        call parse_node_create_branch (pn_scan_cmd, &
             syntax_get_rule_ptr (syntax_cmd_list, var_str ("command_list")))
        allocate (pn_var_single)
        pn_var_single = pn_var
        call parse_node_replace_rule (pn_var_single, var_rule)
        select case (char (key))
        case ("scan_num", "scan_int", "scan_real", &
             "scan_complex", "scan_alias", &
             "scan_cuts", "scan_weight", &
             "scan_scale", "scan_ren_scale", "scan_fac_scale", &
             "scan_selection", "scan_reweight", "scan_analysis", &
             "scan_model", "scan_library")
           if (allocated (cmd%range_int)) then
              call cmd%range_int(i)%init (pn_rhs)
              !!! !!! gfortran 4.7.x memory corruption
              !!!  call cmd%range_int(i)%compile (global)
              call parse_node_replace_last_sub &
                   (pn_var_single, cmd%range_int(i)%pn_expr)
           else if (allocated (cmd%range_real)) then
              call cmd%range_real(i)%init (pn_rhs)
              !!! !!! gfortran 4.7.x memory corruption
              !!!  call cmd%range_real(i)%compile (global)
              call parse_node_replace_last_sub &
                   (pn_var_single, cmd%range_real(i)%pn_expr)
           else
              call parse_node_replace_last_sub (pn_var_single, pn_rhs)
           end if
        case ("scan_string_decl", "scan_log_decl")
           allocate (pn_decl_single)
           pn_decl_single = pn_decl
           call parse_node_replace_rule (pn_decl_single, var_rule_decl)
           call parse_node_replace_last_sub (pn_decl_single, pn_rhs)
           call parse_node_freeze_branch (pn_decl_single)
           call parse_node_replace_last_sub (pn_var_single, pn_decl_single)
        case default
           call msg_bug ("scan: case '" // char (key)  &
                // "' broken")
        end select
        call parse_node_freeze_branch (pn_var_single)
        call parse_node_append_sub (pn_scan_cmd, pn_var_single)
        call parse_node_append_sub (pn_scan_cmd, pn_body_first)
        call parse_node_freeze_branch (pn_scan_cmd)
        cmd%scan_cmd(i)%ptr => pn_scan_cmd
        i = i + 1
        pn_rhs => parse_node_get_next_ptr (pn_rhs)
     end do
     if (debug_active (D_CORE)) then
        do i = 1, cmd%n_values
           print *, "scan command ", i
           call parse_node_write_rec (cmd%scan_cmd(i)%ptr)
           if (allocated (cmd%range_int))  call cmd%range_int(i)%write ()
           if (allocated (cmd%range_real))  call cmd%range_real(i)%write ()
        end do
        print *, "original"
        call parse_node_write_rec (cmd%pn)
     end if
   end subroutine cmd_scan_compile
 
 @ %def cmd_scan_compile
 @ Execute the loop for all values in the step list.  We use the
 parse trees with single variable assignment that we have stored, to
 iteratively create a local environment, execute the stored commands, and
 destroy it again.  When we encounter a range object, we execute the commands
 for each value that this object provides.  Computing this value has the side
 effect of modifying the rhs of the variable assignment that heads the local
 command list, directly in the local parse tree.
 <<Commands: cmd scan: TBP>>=
   procedure :: execute => cmd_scan_execute
 <<Commands: procedures>>=
   recursive subroutine cmd_scan_execute (cmd, global)
     class(cmd_scan_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(rt_data_t), allocatable :: local
     integer :: i, j
     do i = 1, cmd%n_values
        if (allocated (cmd%range_int)) then
           call cmd%range_int(i)%compile (global)
           call cmd%range_int(i)%evaluate ()
           do j = 1, cmd%range_int(i)%get_n_iterations ()
              call cmd%range_int(i)%set_value (j)
              allocate (local)
              call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
              call local%local_final ()
              deallocate (local)
           end do
        else if (allocated (cmd%range_real)) then
           call cmd%range_real(i)%compile (global)
           call cmd%range_real(i)%evaluate ()
           do j = 1, cmd%range_real(i)%get_n_iterations ()
              call cmd%range_real(i)%set_value (j)
              allocate (local)
              call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
              call local%local_final ()
              deallocate (local)
           end do
        else
           allocate (local)
           call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
           call local%local_final ()
           deallocate (local)
        end if
     end do
   end subroutine cmd_scan_execute
 
 @ %def cmd_scan_execute
 @
 \subsubsection{Conditionals}
 Conditionals are implemented as a list that is compiled and evaluated
 recursively; this allows for a straightforward representation of
 [[else if]] constructs.  A [[cmd_if_t]] object can hold either an
 [[else_if]] clause which is another object of this type, or an
 [[else_body]], but not both.
 
 If- or else-bodies are no scoping units, so all data remain global and
 no copy-in copy-out is needed.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_if_t
      private
      type(parse_node_t), pointer :: pn_if_lexpr => null ()
      type(command_list_t), pointer :: if_body => null ()
      type(cmd_if_t), dimension(:), pointer :: elsif_cmd => null ()
      type(command_list_t), pointer :: else_body => null ()
    contains
    <<Commands: cmd if: TBP>>
   end type cmd_if_t
 
 @ %def cmd_if_t
 @ Finalizer.  There are no local options, therefore we can simply override
 the default finalizer.
 <<Commands: cmd if: TBP>>=
   procedure :: final => cmd_if_final
 <<Commands: procedures>>=
   recursive subroutine cmd_if_final (cmd)
     class(cmd_if_t), intent(inout) :: cmd
     integer :: i
     if (associated (cmd%if_body)) then
        call command_list_final (cmd%if_body)
        deallocate (cmd%if_body)
     end if
     if (associated (cmd%elsif_cmd)) then
        do i = 1, size (cmd%elsif_cmd)
           call cmd_if_final (cmd%elsif_cmd(i))
        end do
        deallocate (cmd%elsif_cmd)
     end if
     if (associated (cmd%else_body)) then
        call command_list_final (cmd%else_body)
        deallocate (cmd%else_body)
     end if
   end subroutine cmd_if_final
 
 @ %def cmd_if_final
 @ Output.  Recursively write the command lists.
 <<Commands: cmd if: TBP>>=
   procedure :: write => cmd_if_write
 <<Commands: procedures>>=
   subroutine cmd_if_write (cmd, unit, indent)
     class(cmd_if_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, ind, i
     u = given_output_unit (unit);  if (u < 0)  return
     ind = 0;  if (present (indent))  ind = indent
     call write_indent (u, indent)
     write (u, "(A)")  "if <expr> then"
     if (associated (cmd%if_body)) then
        call cmd%if_body%write (unit, ind + 1)
     end if
     if (associated (cmd%elsif_cmd)) then
        do i = 1, size (cmd%elsif_cmd)
           call write_indent (u, indent)
           write (u, "(A)")  "elsif <expr> then"
           if (associated (cmd%elsif_cmd(i)%if_body)) then
              call cmd%elsif_cmd(i)%if_body%write (unit, ind + 1)
           end if
        end do
     end if
     if (associated (cmd%else_body)) then
        call write_indent (u, indent)
        write (u, "(A)")  "else"
        call cmd%else_body%write (unit, ind + 1)
     end if
   end subroutine cmd_if_write
 
 @ %def cmd_if_write
 @ Compile the conditional.
 <<Commands: cmd if: TBP>>=
   procedure :: compile => cmd_if_compile
 <<Commands: procedures>>=
   recursive subroutine cmd_if_compile (cmd, global)
     class(cmd_if_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_lexpr, pn_body
     type(parse_node_t), pointer :: pn_elsif_clauses, pn_cmd_elsif
     type(parse_node_t), pointer :: pn_else_clause, pn_cmd_else
     integer :: i, n_elsif
     pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 2)
     cmd%pn_if_lexpr => pn_lexpr
     pn_body => parse_node_get_next_ptr (pn_lexpr, 2)
     select case (char (parse_node_get_rule_key (pn_body)))
     case ("command_list")
        allocate (cmd%if_body)
        call cmd%if_body%compile (pn_body, global)
        pn_elsif_clauses => parse_node_get_next_ptr (pn_body)
     case default
        pn_elsif_clauses => pn_body
     end select
     select case (char (parse_node_get_rule_key (pn_elsif_clauses)))
     case ("elsif_clauses")
        n_elsif = parse_node_get_n_sub (pn_elsif_clauses)
        allocate (cmd%elsif_cmd (n_elsif))
        pn_cmd_elsif => parse_node_get_sub_ptr (pn_elsif_clauses)
        do i = 1, n_elsif
           pn_lexpr => parse_node_get_sub_ptr (pn_cmd_elsif, 2)
           cmd%elsif_cmd(i)%pn_if_lexpr => pn_lexpr
           pn_body => parse_node_get_next_ptr (pn_lexpr, 2)
           if (associated (pn_body)) then
              allocate (cmd%elsif_cmd(i)%if_body)
              call cmd%elsif_cmd(i)%if_body%compile (pn_body, global)
           end if
           pn_cmd_elsif => parse_node_get_next_ptr (pn_cmd_elsif)
        end do
        pn_else_clause => parse_node_get_next_ptr (pn_elsif_clauses)
     case default
        pn_else_clause => pn_elsif_clauses
     end select
     select case (char (parse_node_get_rule_key (pn_else_clause)))
     case ("else_clause")
        pn_cmd_else => parse_node_get_sub_ptr (pn_else_clause)
        pn_body => parse_node_get_sub_ptr (pn_cmd_else, 2)
        if (associated (pn_body)) then
           allocate (cmd%else_body)
           call cmd%else_body%compile (pn_body, global)
        end if
     end select
   end subroutine cmd_if_compile
 
 @ %def global
 @ (Recursively) execute the condition.  Context remains global in all cases.
 <<Commands: cmd if: TBP>>=
   procedure :: execute => cmd_if_execute
 <<Commands: procedures>>=
   recursive subroutine cmd_if_execute (cmd, global)
     class(cmd_if_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     logical :: lval, is_known
     integer :: i
     var_list => global%get_var_list_ptr ()
     lval = eval_log (cmd%pn_if_lexpr, var_list, is_known=is_known)
     if (is_known) then
        if (lval) then
           if (associated (cmd%if_body)) then
              call cmd%if_body%execute (global)
           end if
           return
        end if
     else
        call error_undecided ()
        return
     end if
     if (associated (cmd%elsif_cmd)) then
        SCAN_ELSIF: do i = 1, size (cmd%elsif_cmd)
           lval = eval_log (cmd%elsif_cmd(i)%pn_if_lexpr, var_list, &
                 is_known=is_known)
           if (is_known) then
              if (lval) then
                 if (associated (cmd%elsif_cmd(i)%if_body)) then
                    call cmd%elsif_cmd(i)%if_body%execute (global)
                 end if
                 return
              end if
           else
              call error_undecided ()
              return
           end if
        end do SCAN_ELSIF
     end if
     if (associated (cmd%else_body)) then
        call cmd%else_body%execute (global)
     end if
   contains
     subroutine error_undecided ()
       call msg_error ("Undefined result of cmditional expression: " &
            // "neither branch will be executed")
     end subroutine error_undecided
   end subroutine cmd_if_execute
 
 @ %def cmd_if_execute
 @
 \subsubsection{Include another command-list file}
 The include command allocates a local parse tree.  This must not be
 deleted before the command object itself is deleted, since pointers
 may point to subobjects of it.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_include_t
      private
      type(string_t) :: file
      type(command_list_t), pointer :: command_list => null ()
      type(parse_tree_t) :: parse_tree
    contains
    <<Commands: cmd include: TBP>>
   end type cmd_include_t
 
 @ %def cmd_include_t
 @ Finalizer: delete the command list.  No options, so we can simply override
 the default finalizer.
 <<Commands: cmd include: TBP>>=
   procedure :: final => cmd_include_final
 <<Commands: procedures>>=
   subroutine cmd_include_final (cmd)
     class(cmd_include_t), intent(inout) :: cmd
     call parse_tree_final (cmd%parse_tree)
     if (associated (cmd%command_list)) then
        call cmd%command_list%final ()
        deallocate (cmd%command_list)
     end if
   end subroutine cmd_include_final
 
 @ %def cmd_include_final
 @ Write: display the command list as-is, if allocated.
 <<Commands: cmd include: TBP>>=
   procedure :: write => cmd_include_write
 <<Commands: procedures>>=
   subroutine cmd_include_write (cmd, unit, indent)
     class(cmd_include_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, ind
     u = given_output_unit (unit)
     ind = 0;  if (present (indent))  ind = indent
     call write_indent (u, indent)
     write (u, "(A,A,A,A)")  "include ", '"', char (cmd%file), '"'
     if (associated (cmd%command_list)) then
        call cmd%command_list%write (u, ind + 1)
     end if
   end subroutine cmd_include_write
 
 @ %def cmd_include_write
 @ Compile file contents: First parse the file, then immediately
 compile its contents.  Use the global data set.
 <<Commands: cmd include: TBP>>=
   procedure :: compile => cmd_include_compile
 <<Commands: procedures>>=
   subroutine cmd_include_compile (cmd, global)
     class(cmd_include_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_file
     type(string_t) :: file
     logical :: exist
     integer :: u
     type(stream_t), target :: stream
     type(lexer_t) :: lexer
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     pn_file => parse_node_get_sub_ptr (pn_arg)
     file = parse_node_get_string (pn_file)
     inquire (file=char(file), exist=exist)
     if (exist) then
        cmd%file = file
     else
        cmd%file = global%os_data%whizard_cutspath // "/" // file
        inquire (file=char(cmd%file), exist=exist)
        if (.not. exist) then
           call msg_error ("Include file '" // char (file) // "' not found")
           return
        end if
     end if
     u = free_unit ()
     call lexer_init_cmd_list (lexer, global%lexer)
     call stream_init (stream, char (cmd%file))
     call lexer_assign_stream (lexer, stream)
     call parse_tree_init (cmd%parse_tree, syntax_cmd_list, lexer)
     call stream_final (stream)
     call lexer_final (lexer)
     close (u)
     allocate (cmd%command_list)
     call cmd%command_list%compile (cmd%parse_tree%get_root_ptr (), &
          global)
   end subroutine cmd_include_compile
 
 @ %def cmd_include_compile
 @ Execute file contents in the global context.
 <<Commands: cmd include: TBP>>=
   procedure :: execute => cmd_include_execute
 <<Commands: procedures>>=
   subroutine cmd_include_execute (cmd, global)
     class(cmd_include_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     if (associated (cmd%command_list)) then
        call msg_message &
             ("Including Sindarin from '" // char (cmd%file) // "'")
        call cmd%command_list%execute (global)
        call msg_message &
             ("End of included '" // char (cmd%file) // "'")
     end if
   end subroutine cmd_include_execute
 
 @ %def cmd_include_execute
 @
 \subsubsection{Export values}
 This command exports the current values of variables or other objects to the
 surrounding scope.  By default, a scope enclosed by braces keeps all objects
 local to it.  The [[export]] command exports the values that are generated
 within the scope to the corresponding object in the outer scope.
 
 The allowed set of exportable objects is, in principle, the same as the set of
 objects that the [[show]] command supports.  This includes some convenience
 abbreviations.
 
 TODO: The initial implementation inherits syntax from [[show]], but supports
 only the [[results]] pseudo-object.  The results (i.e., the process stack) is
 appended to the outer process stack instead of being discarded.  The behavior
 of the [[export]] command for other object kinds is to be defined on a
 case-by-case basis.  It may involve replacing the outer value or, instead,
 doing some sort of appending or reduction.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_export_t
      private
      type(string_t), dimension(:), allocatable :: name
    contains
    <<Commands: cmd export: TBP>>
   end type cmd_export_t
 
 @ %def cmd_export_t
 @ Output: list the object names, not values.
 <<Commands: cmd export: TBP>>=
   procedure :: write => cmd_export_write
 <<Commands: procedures>>=
   subroutine cmd_export_write (cmd, unit, indent)
     class(cmd_export_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A)", advance="no")  "export: "
     if (allocated (cmd%name)) then
        do i = 1, size (cmd%name)
           write (u, "(1x,A)", advance="no")  char (cmd%name(i))
        end do
        write (u, *)
     else
        write (u, "(5x,A)")  "[undefined]"
     end if
   end subroutine cmd_export_write
 
 @ %def cmd_export_write
 @ Compile.  Allocate an array which is filled with the names of the
 variables to export.
 <<Commands: cmd export: TBP>>=
   procedure :: compile => cmd_export_compile
 <<Commands: procedures>>=
   subroutine cmd_export_compile (cmd, global)
     class(cmd_export_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
     type(string_t) :: key
     integer :: i, n_args
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (pn_arg)) then
        select case (char (parse_node_get_rule_key (pn_arg)))
        case ("show_arg")
           cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
        case default
           cmd%pn_opt => pn_arg
           pn_arg => null ()
        end select
     end if
     call cmd%compile_options (global)
     if (associated (pn_arg)) then
        n_args = parse_node_get_n_sub (pn_arg)
        allocate (cmd%name (n_args))
        pn_var => parse_node_get_sub_ptr (pn_arg)
        i = 0
        do while (associated (pn_var))
           i = i + 1
           select case (char (parse_node_get_rule_key (pn_var)))
           case ("model", "library", "beams", "iterations", &
                 "cuts", "weight", "int", "real", "complex", &
                 "scale", "factorization_scale", "renormalization_scale", &
                 "selection", "reweight", "analysis", "pdg", &
                 "stable", "unstable", "polarized", "unpolarized", &
                 "results", "expect", "intrinsic", "string", "logical")
              cmd%name(i) = parse_node_get_key (pn_var)
           case ("result_var")
              pn_prefix => parse_node_get_sub_ptr (pn_var)
              pn_name => parse_node_get_next_ptr (pn_prefix)
              if (associated (pn_name)) then
                 cmd%name(i) = parse_node_get_key (pn_prefix) &
                      // "(" // parse_node_get_string (pn_name) // ")"
              else
                 cmd%name(i) = parse_node_get_key (pn_prefix)
              end if
           case ("log_var", "string_var", "alias_var")
              pn_prefix => parse_node_get_sub_ptr (pn_var)
              pn_name => parse_node_get_next_ptr (pn_prefix)
              key = parse_node_get_key (pn_prefix)
              if (associated (pn_name)) then
                 select case (char (parse_node_get_rule_key (pn_name)))
                 case ("var_name")
                    select case (char (key))
                    case ("?", "$")  ! $ sign
                       cmd%name(i) = key // parse_node_get_string (pn_name)
                    case ("alias")
                       cmd%name(i) = parse_node_get_string (pn_name)
                    end select
                 case default
                    call parse_node_mismatch &
                         ("var_name",  pn_name)
                 end select
              else
                 cmd%name(i) = key
              end if
           case default
              cmd%name(i) = parse_node_get_string (pn_var)
           end select
           !!! restriction imposed by current lack of implementation
           select case (char (parse_node_get_rule_key (pn_var)))
           case ("results")
           case default
              call msg_fatal ("export: object (type) '" &
                   // char (parse_node_get_rule_key (pn_var)) &
                   // "' not supported yet")
           end select
           pn_var => parse_node_get_next_ptr (pn_var)
        end do
     else
        allocate (cmd%name (0))
     end if
   end subroutine cmd_export_compile
 
 @ %def cmd_export_compile
 @ Execute.  Scan the list of objects to export.
 <<Commands: cmd export: TBP>>=
   procedure :: execute => cmd_export_execute
 <<Commands: procedures>>=
   subroutine cmd_export_execute (cmd, global)
     class(cmd_export_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     call global%append_exports (cmd%name)
   end subroutine cmd_export_execute
 
 @ %def cmd_export_execute
 @
 \subsubsection{Quit command execution}
 The code is the return code of the whole program if it is terminated
 by this command.
 <<Commands: types>>=
   type, extends (command_t) :: cmd_quit_t
      private
      logical :: has_code = .false.
      type(parse_node_t), pointer :: pn_code_expr => null ()
    contains
    <<Commands: cmd quit: TBP>>
   end type cmd_quit_t
 
 @ %def cmd_quit_t
 @ Output.
 <<Commands: cmd quit: TBP>>=
   procedure :: write => cmd_quit_write
 <<Commands: procedures>>=
   subroutine cmd_quit_write (cmd, unit, indent)
     class(cmd_quit_t), intent(in) :: cmd
     integer, intent(in), optional :: unit, indent
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write (u, "(1x,A,L1)")  "quit: has_code = ", cmd%has_code
   end subroutine cmd_quit_write
 
 @ %def cmd_quit_write
 @ Compile: allocate a [[quit]] object which serves as a placeholder.
 <<Commands: cmd quit: TBP>>=
   procedure :: compile => cmd_quit_compile
 <<Commands: procedures>>=
   subroutine cmd_quit_compile (cmd, global)
     class(cmd_quit_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_arg
     pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
     if (associated (pn_arg)) then
        cmd%pn_code_expr => parse_node_get_sub_ptr (pn_arg)
        cmd%has_code = .true.
     end if
   end subroutine cmd_quit_compile
 
 @ %def cmd_quit_compile
 @ Execute: The quit command does not execute anything, it just stops
 command execution.  This is achieved by setting quit flag and quit
 code in the global variable list.  However, the return code, if
 present, is an expression which has to be evaluated.
 <<Commands: cmd quit: TBP>>=
   procedure :: execute => cmd_quit_execute
 <<Commands: procedures>>=
   subroutine cmd_quit_execute (cmd, global)
     class(cmd_quit_t), intent(inout) :: cmd
     type(rt_data_t), intent(inout), target :: global
     type(var_list_t), pointer :: var_list
     logical :: is_known
     var_list => global%get_var_list_ptr ()
     if (cmd%has_code) then
        global%quit_code = eval_int (cmd%pn_code_expr, var_list, &
             is_known=is_known)
        if (.not. is_known) then
           call msg_error ("Undefined return code of quit/exit command")
        end if
     end if
     global%quit = .true.
   end subroutine cmd_quit_execute
 
 @ %def cmd_quit_execute
 @
 \subsection{The command list}
 The command list holds a list of commands and relevant global data.
 <<Commands: public>>=
   public :: command_list_t
 <<Commands: types>>=
   type :: command_list_t
      ! not private anymore as required by the whizard-c-interface
      class(command_t), pointer :: first => null ()
      class(command_t), pointer :: last => null ()
    contains
    <<Commands: command list: TBP>>
   end type command_list_t
 
 @ %def command_list_t
 @ Output.
 <<Commands: command list: TBP>>=
   procedure :: write => command_list_write
 <<Commands: procedures>>=
   recursive subroutine command_list_write (cmd_list, unit, indent)
     class(command_list_t), intent(in) :: cmd_list
     integer, intent(in), optional :: unit, indent
     class(command_t), pointer :: cmd
     cmd => cmd_list%first
     do while (associated (cmd))
        call cmd%write (unit, indent)
        cmd => cmd%next
     end do
   end subroutine command_list_write
 
 @ %def command_list_write
 @ Append a new command to the list and free the original pointer.
 <<Commands: command list: TBP>>=
   procedure :: append => command_list_append
 <<Commands: procedures>>=
   subroutine command_list_append (cmd_list, command)
     class(command_list_t), intent(inout) :: cmd_list
     class(command_t), intent(inout), pointer :: command
     if (associated (cmd_list%last)) then
        cmd_list%last%next => command
     else
        cmd_list%first => command
     end if
     cmd_list%last => command
     command => null ()
   end subroutine command_list_append
 
 @ %def command_list_append
 @ Finalize.
 <<Commands: command list: TBP>>=
   procedure :: final => command_list_final
 <<Commands: procedures>>=
   recursive subroutine command_list_final (cmd_list)
     class(command_list_t), intent(inout) :: cmd_list
     class(command_t), pointer :: command
     do while (associated (cmd_list%first))
        command => cmd_list%first
        cmd_list%first => cmd_list%first%next
        call command%final ()
        deallocate (command)
     end do
     cmd_list%last => null ()
   end subroutine command_list_final
 
 @ %def command_list_final
 @
 \subsection{Compiling the parse tree}
 Transform a parse tree into a command list.  Initialization is assumed
 to be done.
 
 After each command, we set a breakpoint.
 <<Commands: command list: TBP>>=
   procedure :: compile => command_list_compile
 <<Commands: procedures>>=
   recursive subroutine command_list_compile (cmd_list, pn, global)
     class(command_list_t), intent(inout), target :: cmd_list
     type(parse_node_t), intent(in), target :: pn
     type(rt_data_t), intent(inout), target :: global
     type(parse_node_t), pointer :: pn_cmd
     class(command_t), pointer :: command
     integer :: i
     pn_cmd => parse_node_get_sub_ptr (pn)
     do i = 1, parse_node_get_n_sub (pn)
        call dispatch_command (command, pn_cmd)
        call command%compile (global)
        call cmd_list%append (command)
        call terminate_now_if_signal ()
        pn_cmd => parse_node_get_next_ptr (pn_cmd)
     end do
   end subroutine command_list_compile
 
 @ %def command_list_compile
 @
 \subsection{Executing the command list}
 Before executing a command we should execute its options (if any).  After
 that, reset the options, i.e., remove temporary effects from the global
 state.
 
 Also here, after each command we set a breakpoint.
 <<Commands: command list: TBP>>=
   procedure :: execute => command_list_execute
 <<Commands: procedures>>=
   recursive subroutine command_list_execute (cmd_list, global)
     class(command_list_t), intent(in) :: cmd_list
     type(rt_data_t), intent(inout), target :: global
     class(command_t), pointer :: command
     command => cmd_list%first
     COMMAND_COND: do while (associated (command))
        call command%execute_options (global)
        call command%execute (global)
        call command%reset_options (global)
        call terminate_now_if_signal ()
        if (global%quit)  exit COMMAND_COND
        command => command%next
     end do COMMAND_COND
   end subroutine command_list_execute
 
 @ %def command_list_execute
 @
 \subsection{Command list syntax}
 <<Commands: public>>=
   public :: syntax_cmd_list
 <<Commands: variables>>=
   type(syntax_t), target, save :: syntax_cmd_list
 
 @ %def syntax_cmd_list
 <<Commands: public>>=
   public :: syntax_cmd_list_init
 <<Commands: procedures>>=
   subroutine syntax_cmd_list_init ()
     type(ifile_t) :: ifile
     call define_cmd_list_syntax (ifile)
     call syntax_init (syntax_cmd_list, ifile)
     call ifile_final (ifile)
   end subroutine syntax_cmd_list_init
 
 @ %def syntax_cmd_list_init
 <<Commands: public>>=
   public :: syntax_cmd_list_final
 <<Commands: procedures>>=
   subroutine syntax_cmd_list_final ()
     call syntax_final (syntax_cmd_list)
   end subroutine syntax_cmd_list_final
 
 @ %def syntax_cmd_list_final
 <<Commands: public>>=
   public :: syntax_cmd_list_write
 <<Commands: procedures>>=
   subroutine syntax_cmd_list_write (unit)
     integer, intent(in), optional :: unit
     call syntax_write (syntax_cmd_list, unit)
   end subroutine syntax_cmd_list_write
 
 @ %def syntax_cmd_list_write
 <<Commands: procedures>>=
   subroutine define_cmd_list_syntax (ifile)
     type(ifile_t), intent(inout) :: ifile
     call ifile_append (ifile, "SEQ command_list = command*")
     call ifile_append (ifile, "ALT command = " &
          // "cmd_model | cmd_library | cmd_iterations | cmd_sample_format | " &
          // "cmd_var | cmd_slha | " &
          // "cmd_show | cmd_clear | " &
          // "cmd_expect | " &
          // "cmd_cuts | cmd_scale | cmd_fac_scale | cmd_ren_scale | " &
          // "cmd_weight | cmd_selection | cmd_reweight | " &
          // "cmd_beams | cmd_beams_pol_density | cmd_beams_pol_fraction | " &
          // "cmd_beams_momentum | cmd_beams_theta | cmd_beams_phi | " &
          // "cmd_integrate | " &
          // "cmd_observable | cmd_histogram | cmd_plot | cmd_graph | " &
          // "cmd_record | " &
          // "cmd_analysis | cmd_alt_setup | " &
          // "cmd_unstable | cmd_stable | cmd_simulate | cmd_rescan | " &
          // "cmd_process | cmd_compile | cmd_exec | " &
          // "cmd_scan | cmd_if | cmd_include | cmd_quit | " &
          // "cmd_export | " &
          // "cmd_polarized | cmd_unpolarized | " &
          // "cmd_open_out | cmd_close_out | cmd_printf | " &
          // "cmd_write_analysis | cmd_compile_analysis | cmd_nlo | cmd_components")
     call ifile_append (ifile, "GRO options = '{' local_command_list '}'")
     call ifile_append (ifile, "SEQ local_command_list = local_command*")
     call ifile_append (ifile, "ALT local_command = " &
          // "cmd_model | cmd_library | cmd_iterations | cmd_sample_format | " &
          // "cmd_var | cmd_slha | " &
          // "cmd_show | " &
          // "cmd_expect | " &
          // "cmd_cuts | cmd_scale | cmd_fac_scale | cmd_ren_scale | " &
          // "cmd_weight | cmd_selection | cmd_reweight | " &
          // "cmd_beams | cmd_beams_pol_density | cmd_beams_pol_fraction | " &
          // "cmd_beams_momentum | cmd_beams_theta | cmd_beams_phi | " &
          // "cmd_observable | cmd_histogram | cmd_plot | cmd_graph | " &
          // "cmd_clear | cmd_record | " &
          // "cmd_analysis | cmd_alt_setup | " &
          // "cmd_open_out | cmd_close_out | cmd_printf | " &
          // "cmd_write_analysis | cmd_compile_analysis | cmd_nlo | cmd_components")
     call ifile_append (ifile, "SEQ cmd_model = model '=' model_name model_arg?")
     call ifile_append (ifile, "KEY model")
     call ifile_append (ifile, "ALT model_name = model_id | string_literal")
     call ifile_append (ifile, "IDE model_id")
     call ifile_append (ifile, "ARG model_arg = ( model_scheme? )")
     call ifile_append (ifile, "ALT model_scheme = " &
          // "ufo_spec | scheme_id | string_literal")
     call ifile_append (ifile, "SEQ ufo_spec = ufo ufo_arg?")
     call ifile_append (ifile, "KEY ufo")
     call ifile_append (ifile, "ARG ufo_arg = ( string_literal )")
     call ifile_append (ifile, "IDE scheme_id")
     call ifile_append (ifile, "SEQ cmd_library = library '=' lib_name")
     call ifile_append (ifile, "KEY library")
     call ifile_append (ifile, "ALT lib_name = lib_id | string_literal")
     call ifile_append (ifile, "IDE lib_id")
     call ifile_append (ifile, "ALT cmd_var = " &
          // "cmd_log_decl | cmd_log | " &
          // "cmd_int | cmd_real | cmd_complex | cmd_num | " &
          // "cmd_string_decl | cmd_string | cmd_alias | " &
          // "cmd_result")
     call ifile_append (ifile, "SEQ cmd_log_decl = logical cmd_log")
     call ifile_append (ifile, "SEQ cmd_log = '?' var_name '=' lexpr")
     call ifile_append (ifile, "SEQ cmd_int = int var_name '=' expr")
     call ifile_append (ifile, "SEQ cmd_real = real var_name '=' expr")
     call ifile_append (ifile, "SEQ cmd_complex = complex var_name '=' expr")
     call ifile_append (ifile, "SEQ cmd_num = var_name '=' expr")
     call ifile_append (ifile, "SEQ cmd_string_decl = string cmd_string")
     call ifile_append (ifile, "SEQ cmd_string = " &
          // "'$' var_name '=' sexpr") ! $
     call ifile_append (ifile, "SEQ cmd_alias = alias var_name '=' cexpr")
     call ifile_append (ifile, "SEQ cmd_result = result '=' expr")
     call ifile_append (ifile, "SEQ cmd_slha = slha_action slha_arg options?")
     call ifile_append (ifile, "ALT slha_action = " &
          // "read_slha | write_slha")
     call ifile_append (ifile, "KEY read_slha")
     call ifile_append (ifile, "KEY write_slha")
     call ifile_append (ifile, "ARG slha_arg = ( string_literal )")
     call ifile_append (ifile, "SEQ cmd_show = show show_arg options?")
     call ifile_append (ifile, "KEY show")
     call ifile_append (ifile, "ARG show_arg = ( showable* )")
     call ifile_append (ifile, "ALT showable = " &
          // "model | library | beams | iterations | " &
          // "cuts | weight | logical | string | pdg | " &
          // "scale | factorization_scale | renormalization_scale | " &
    // "selection | reweight | analysis | " &
          // "stable | unstable | polarized | unpolarized | " &
          // "expect | intrinsic | int | real | complex | " &
          // "alias_var | string | results | result_var | " &
          // "log_var | string_var | var_name")
     call ifile_append (ifile, "KEY results")
     call ifile_append (ifile, "KEY intrinsic")
     call ifile_append (ifile, "SEQ alias_var = alias var_name")
     call ifile_append (ifile, "SEQ result_var = result_key result_arg?")
     call ifile_append (ifile, "SEQ log_var = '?' var_name")
     call ifile_append (ifile, "SEQ string_var = '$' var_name")  ! $
     call ifile_append (ifile, "SEQ cmd_clear = clear clear_arg options?")
     call ifile_append (ifile, "KEY clear")
     call ifile_append (ifile, "ARG clear_arg = ( clearable* )")
     call ifile_append (ifile, "ALT clearable = " &
          // "beams | iterations | " &
          // "cuts | weight | " &
          // "scale | factorization_scale | renormalization_scale | " &
    // "selection | reweight | analysis | " &
          // "unstable | polarized | " &
          // "expect | " &
          // "log_var | string_var | var_name")
     call ifile_append (ifile, "SEQ cmd_expect = expect expect_arg options?")
     call ifile_append (ifile, "KEY expect")
     call ifile_append (ifile, "ARG expect_arg = ( lexpr )")
     call ifile_append (ifile, "SEQ cmd_cuts = cuts '=' lexpr")
     call ifile_append (ifile, "SEQ cmd_scale = scale '=' expr")
     call ifile_append (ifile, "SEQ cmd_fac_scale = " &
          // "factorization_scale '=' expr")
     call ifile_append (ifile, "SEQ cmd_ren_scale = " &
          // "renormalization_scale '=' expr")
     call ifile_append (ifile, "SEQ cmd_weight = weight '=' expr")
     call ifile_append (ifile, "SEQ cmd_selection = selection '=' lexpr")
     call ifile_append (ifile, "SEQ cmd_reweight = reweight '=' expr")
     call ifile_append (ifile, "KEY cuts")
     call ifile_append (ifile, "KEY scale")
     call ifile_append (ifile, "KEY factorization_scale")
     call ifile_append (ifile, "KEY renormalization_scale")
     call ifile_append (ifile, "KEY weight")
     call ifile_append (ifile, "KEY selection")
     call ifile_append (ifile, "KEY reweight")
     call ifile_append (ifile, "SEQ cmd_process = process process_id '=' " &
          // "process_prt '=>' prt_state_list options?")
     call ifile_append (ifile, "KEY process")
     call ifile_append (ifile, "KEY '=>'")
     call ifile_append (ifile, "LIS process_prt = cexpr+")
     call ifile_append (ifile, "LIS prt_state_list = prt_state_sum+")
     call ifile_append (ifile, "SEQ prt_state_sum = " &
          // "prt_state prt_state_addition*")
     call ifile_append (ifile, "SEQ prt_state_addition = '+' prt_state")
     call ifile_append (ifile, "ALT prt_state = grouped_prt_state_list | cexpr")
     call ifile_append (ifile, "GRO grouped_prt_state_list = " &
          // "( prt_state_list )")
     call ifile_append (ifile, "SEQ cmd_compile = compile_cmd options?")
     call ifile_append (ifile, "SEQ compile_cmd = compile_clause compile_arg?")
     call ifile_append (ifile, "SEQ compile_clause = compile exec_name_spec?")
     call ifile_append (ifile, "KEY compile")
     call ifile_append (ifile, "SEQ exec_name_spec = as exec_name")
     call ifile_append (ifile, "KEY as")
     call ifile_append (ifile, "ALT exec_name = exec_id | string_literal")
     call ifile_append (ifile, "IDE exec_id")
     call ifile_append (ifile, "ARG compile_arg = ( lib_name* )")
     call ifile_append (ifile, "SEQ cmd_exec = exec exec_arg")
     call ifile_append (ifile, "KEY exec")
     call ifile_append (ifile, "ARG exec_arg = ( sexpr )")
     call ifile_append (ifile, "SEQ cmd_beams = beams '=' beam_def")
     call ifile_append (ifile, "KEY beams")
     call ifile_append (ifile, "SEQ beam_def = beam_spec strfun_seq*")
     call ifile_append (ifile, "SEQ beam_spec = beam_list")
     call ifile_append (ifile, "LIS beam_list = cexpr, cexpr?")
     call ifile_append (ifile, "SEQ cmd_beams_pol_density = " &
          // "beams_pol_density '=' beams_pol_spec")
     call ifile_append (ifile, "KEY beams_pol_density")
     call ifile_append (ifile, "LIS beams_pol_spec = smatrix, smatrix?")
     call ifile_append (ifile, "SEQ smatrix = '@' smatrix_arg")
     ! call ifile_append (ifile, "KEY '@'")     !!! Key already exists
     call ifile_append (ifile, "ARG smatrix_arg = ( sentry* )")
     call ifile_append (ifile, "SEQ sentry = expr extra_sentry*")
     call ifile_append (ifile, "SEQ extra_sentry = ':' expr")
     call ifile_append (ifile, "SEQ cmd_beams_pol_fraction = " &
          // "beams_pol_fraction '=' beams_par_spec")
     call ifile_append (ifile, "KEY beams_pol_fraction")
     call ifile_append (ifile, "SEQ cmd_beams_momentum = " &
          // "beams_momentum '=' beams_par_spec")
     call ifile_append (ifile, "KEY beams_momentum")
     call ifile_append (ifile, "SEQ cmd_beams_theta = " &
          // "beams_theta '=' beams_par_spec")
     call ifile_append (ifile, "KEY beams_theta")
     call ifile_append (ifile, "SEQ cmd_beams_phi = " &
          // "beams_phi '=' beams_par_spec")
     call ifile_append (ifile, "KEY beams_phi")
     call ifile_append (ifile, "LIS beams_par_spec = expr, expr?")
     call ifile_append (ifile, "SEQ strfun_seq = '=>' strfun_pair")
     call ifile_append (ifile, "LIS strfun_pair = strfun_def, strfun_def?")
     call ifile_append (ifile, "SEQ strfun_def = strfun_id")
     call ifile_append (ifile, "ALT strfun_id = " &
           // "none | lhapdf | lhapdf_photon | pdf_builtin | pdf_builtin_photon | " &
           // "isr | epa | ewa | circe1 | circe2 | energy_scan | " &
           // "gaussian | beam_events")
     call ifile_append (ifile, "KEY none")
     call ifile_append (ifile, "KEY lhapdf")
     call ifile_append (ifile, "KEY lhapdf_photon")
     call ifile_append (ifile, "KEY pdf_builtin")
     call ifile_append (ifile, "KEY pdf_builtin_photon")
     call ifile_append (ifile, "KEY isr")
     call ifile_append (ifile, "KEY epa")
     call ifile_append (ifile, "KEY ewa")
     call ifile_append (ifile, "KEY circe1")
     call ifile_append (ifile, "KEY circe2")
     call ifile_append (ifile, "KEY energy_scan")
     call ifile_append (ifile, "KEY gaussian")
     call ifile_append (ifile, "KEY beam_events")
     call ifile_append (ifile, "SEQ cmd_integrate = " &
          // "integrate proc_arg options?")
     call ifile_append (ifile, "KEY integrate")
     call ifile_append (ifile, "ARG proc_arg = ( proc_id* )")
     call ifile_append (ifile, "IDE proc_id")
     call ifile_append (ifile, "SEQ cmd_iterations = " &
          // "iterations '=' iterations_list")
     call ifile_append (ifile, "KEY iterations")
     call ifile_append (ifile, "LIS iterations_list = iterations_spec+")
     call ifile_append (ifile, "ALT iterations_spec = it_spec")
     call ifile_append (ifile, "SEQ it_spec = expr calls_spec adapt_spec?")
     call ifile_append (ifile, "SEQ calls_spec = ':' expr")
     call ifile_append (ifile, "SEQ adapt_spec = ':' sexpr")
     call ifile_append (ifile, "SEQ cmd_components = " &
          // "active '=' component_list")
     call ifile_append (ifile, "KEY active")
     call ifile_append (ifile, "LIS component_list = sexpr+")
     call ifile_append (ifile, "SEQ cmd_sample_format = " &
          // "sample_format '=' event_format_list")
     call ifile_append (ifile, "KEY sample_format")
     call ifile_append (ifile, "LIS event_format_list = event_format+")
     call ifile_append (ifile, "IDE event_format")
     call ifile_append (ifile, "SEQ cmd_observable = " &
          // "observable analysis_tag options?")
     call ifile_append (ifile, "KEY observable")
     call ifile_append (ifile, "SEQ cmd_histogram = " &
          // "histogram analysis_tag histogram_arg " &
          // "options?")
     call ifile_append (ifile, "KEY histogram")
     call ifile_append (ifile, "ARG histogram_arg = (expr, expr, expr?)")
     call ifile_append (ifile, "SEQ cmd_plot = plot analysis_tag options?")
     call ifile_append (ifile, "KEY plot")
     call ifile_append (ifile, "SEQ cmd_graph = graph graph_term '=' graph_def")
     call ifile_append (ifile, "KEY graph")
     call ifile_append (ifile, "SEQ graph_term = analysis_tag options?")
     call ifile_append (ifile, "SEQ graph_def = graph_term graph_append*")
     call ifile_append (ifile, "SEQ graph_append = '&' graph_term")
     call ifile_append (ifile, "SEQ cmd_analysis = analysis '=' lexpr")
     call ifile_append (ifile, "KEY analysis")
     call ifile_append (ifile, "SEQ cmd_alt_setup = " &
          // "alt_setup '=' option_list_expr")
     call ifile_append (ifile, "KEY alt_setup")
     call ifile_append (ifile, "ALT option_list_expr = " &
          // "grouped_option_list | option_list")
     call ifile_append (ifile, "GRO grouped_option_list = ( option_list_expr )")
     call ifile_append (ifile, "LIS option_list = options+")
     call ifile_append (ifile, "SEQ cmd_open_out = open_out open_arg options?")
     call ifile_append (ifile, "SEQ cmd_close_out = close_out open_arg options?")
     call ifile_append (ifile, "KEY open_out")
     call ifile_append (ifile, "KEY close_out")
     call ifile_append (ifile, "ARG open_arg = (sexpr)")
     call ifile_append (ifile, "SEQ cmd_printf = printf_cmd options?")
     call ifile_append (ifile, "SEQ printf_cmd = printf_clause sprintf_args?")
     call ifile_append (ifile, "SEQ printf_clause = printf sexpr")
     call ifile_append (ifile, "KEY printf")
     call ifile_append (ifile, "SEQ cmd_record = record_cmd")
     call ifile_append (ifile, "SEQ cmd_unstable = " &
          // "unstable cexpr unstable_arg options?")
     call ifile_append (ifile, "KEY unstable")
     call ifile_append (ifile, "ARG unstable_arg = ( proc_id* )")
     call ifile_append (ifile, "SEQ cmd_stable = stable stable_list options?")
     call ifile_append (ifile, "KEY stable")
     call ifile_append (ifile, "LIS stable_list = cexpr+")
     call ifile_append (ifile, "KEY polarized")
     call ifile_append (ifile, "SEQ cmd_polarized = polarized polarized_list options?")
     call ifile_append (ifile, "LIS polarized_list = cexpr+")
     call ifile_append (ifile, "KEY unpolarized")
     call ifile_append (ifile, "SEQ cmd_unpolarized = unpolarized unpolarized_list options?")
     call ifile_append (ifile, "LIS unpolarized_list = cexpr+")
     call ifile_append (ifile, "SEQ cmd_simulate = " &
          // "simulate proc_arg options?")
     call ifile_append (ifile, "KEY simulate")
     call ifile_append (ifile, "SEQ cmd_rescan = " &
          // "rescan sexpr proc_arg options?")
     call ifile_append (ifile, "KEY rescan")
     call ifile_append (ifile, "SEQ cmd_scan = scan scan_var scan_body?")
     call ifile_append (ifile, "KEY scan")
     call ifile_append (ifile, "ALT scan_var = " &
          // "scan_log_decl | scan_log | " &
          // "scan_int | scan_real | scan_complex | scan_num | " &
          // "scan_string_decl | scan_string | scan_alias | " &
          // "scan_cuts | scan_weight | " &
          // "scan_scale | scan_ren_scale | scan_fac_scale | " &
          // "scan_selection | scan_reweight | scan_analysis | " &
          // "scan_model | scan_library")
     call ifile_append (ifile, "SEQ scan_log_decl = logical scan_log")
     call ifile_append (ifile, "SEQ scan_log = '?' var_name '=' scan_log_arg")
     call ifile_append (ifile, "ARG scan_log_arg = ( lexpr* )")
     call ifile_append (ifile, "SEQ scan_int = int var_name '=' scan_num_arg")
     call ifile_append (ifile, "SEQ scan_real = real var_name '=' scan_num_arg")
     call ifile_append (ifile, "SEQ scan_complex = " &
          // "complex var_name '=' scan_num_arg")
     call ifile_append (ifile, "SEQ scan_num = var_name '=' scan_num_arg")
     call ifile_append (ifile, "ARG scan_num_arg = ( range* )")
     call ifile_append (ifile, "ALT range = grouped_range | range_expr")
     call ifile_append (ifile, "GRO grouped_range = ( range_expr )")
     call ifile_append (ifile, "SEQ range_expr = expr range_spec?")
     call ifile_append (ifile, "SEQ range_spec = '=>' expr step_spec?")
     call ifile_append (ifile, "SEQ step_spec = step_op expr")
     call ifile_append (ifile, "ALT step_op = " &
          // "'/+' | '/-' | '/*' | '//' | '/+/' | '/*/'")
     call ifile_append (ifile, "KEY '/+'")
     call ifile_append (ifile, "KEY '/-'")
     call ifile_append (ifile, "KEY '/*'")
     call ifile_append (ifile, "KEY '//'")
     call ifile_append (ifile, "KEY '/+/'")
     call ifile_append (ifile, "KEY '/*/'")
     call ifile_append (ifile, "SEQ scan_string_decl = string scan_string")
     call ifile_append (ifile, "SEQ scan_string = " &
          // "'$' var_name '=' scan_string_arg")
     call ifile_append (ifile, "ARG scan_string_arg = ( sexpr* )")
     call ifile_append (ifile, "SEQ scan_alias = " &
          // "alias var_name '=' scan_alias_arg")
     call ifile_append (ifile, "ARG scan_alias_arg = ( cexpr* )")
     call ifile_append (ifile, "SEQ scan_cuts = cuts '=' scan_lexpr_arg")
     call ifile_append (ifile, "ARG scan_lexpr_arg = ( lexpr* )")
     call ifile_append (ifile, "SEQ scan_scale = scale '=' scan_expr_arg")
     call ifile_append (ifile, "ARG scan_expr_arg = ( expr* )")
     call ifile_append (ifile, "SEQ scan_fac_scale = " &
          // "factorization_scale '=' scan_expr_arg")
     call ifile_append (ifile, "SEQ scan_ren_scale = " &
          // "renormalization_scale '=' scan_expr_arg")
     call ifile_append (ifile, "SEQ scan_weight = weight '=' scan_expr_arg")
     call ifile_append (ifile, "SEQ scan_selection = selection '=' scan_lexpr_arg")
     call ifile_append (ifile, "SEQ scan_reweight = reweight '=' scan_expr_arg")
     call ifile_append (ifile, "SEQ scan_analysis = analysis '=' scan_lexpr_arg")
     call ifile_append (ifile, "SEQ scan_model = model '=' scan_model_arg")
     call ifile_append (ifile, "ARG scan_model_arg = ( model_name* )")
     call ifile_append (ifile, "SEQ scan_library = library '=' scan_library_arg")
     call ifile_append (ifile, "ARG scan_library_arg = ( lib_name* )")
     call ifile_append (ifile, "GRO scan_body = '{' command_list '}'")
     call ifile_append (ifile, "SEQ cmd_if = " &
          // "if lexpr then command_list elsif_clauses else_clause endif")
     call ifile_append (ifile, "SEQ elsif_clauses = cmd_elsif*")
     call ifile_append (ifile, "SEQ cmd_elsif = elsif lexpr then command_list")
     call ifile_append (ifile, "SEQ else_clause = cmd_else?")
     call ifile_append (ifile, "SEQ cmd_else = else command_list")
     call ifile_append (ifile, "SEQ cmd_include = include include_arg")
     call ifile_append (ifile, "KEY include")
     call ifile_append (ifile, "ARG include_arg = ( string_literal )")
     call ifile_append (ifile, "SEQ cmd_quit = quit_cmd quit_arg?")
     call ifile_append (ifile, "ALT quit_cmd = quit | exit")
     call ifile_append (ifile, "KEY quit")
     call ifile_append (ifile, "KEY exit")
     call ifile_append (ifile, "ARG quit_arg = ( expr )")
     call ifile_append (ifile, "SEQ cmd_export = export show_arg options?")
     call ifile_append (ifile, "KEY export")
     call ifile_append (ifile, "SEQ cmd_write_analysis = " &
          // "write_analysis_clause options?")
     call ifile_append (ifile, "SEQ cmd_compile_analysis = " &
          // "compile_analysis_clause options?")
     call ifile_append (ifile, "SEQ write_analysis_clause = " &
          // "write_analysis write_analysis_arg?")
     call ifile_append (ifile, "SEQ compile_analysis_clause = " &
          // "compile_analysis write_analysis_arg?")
     call ifile_append (ifile, "KEY write_analysis")
     call ifile_append (ifile, "KEY compile_analysis")
     call ifile_append (ifile, "ARG write_analysis_arg = ( analysis_tag* )")
     call ifile_append (ifile, "SEQ cmd_nlo = " &
                        // "nlo_calculation '=' nlo_calculation_list")
     call ifile_append (ifile, "KEY nlo_calculation")
     call ifile_append (ifile, "LIS nlo_calculation_list = nlo_comp+")
     call ifile_append (ifile, "ALT nlo_comp = " // &
          "full | born | real | virtual | dglap | subtraction | " // &
          "mismatch | GKS")
     call ifile_append (ifile, "KEY full")
     call ifile_append (ifile, "KEY born")
     call ifile_append (ifile, "KEY virtual")
     call ifile_append (ifile, "KEY dglap")
     call ifile_append (ifile, "KEY subtraction")
     call ifile_append (ifile, "KEY mismatch")
     call ifile_append (ifile, "KEY GKS")
     call define_expr_syntax (ifile, particles=.true., analysis=.true.)
   end subroutine define_cmd_list_syntax
 
 @ %def define_cmd_list_syntax
 <<Commands: public>>=
   public :: lexer_init_cmd_list
 <<Commands: procedures>>=
   subroutine lexer_init_cmd_list (lexer, parent_lexer)
     type(lexer_t), intent(out) :: lexer
     type(lexer_t), intent(in), optional, target :: parent_lexer
     call lexer_init (lexer, &
          comment_chars = "#!", &
          quote_chars = '"', &
          quote_match = '"', &
          single_chars = "()[]{},;:&%?$@", &
          special_class = [ "+-*/^", "<>=~ " ] , &
          keyword_list = syntax_get_keyword_list_ptr (syntax_cmd_list), &
          parent = parent_lexer)
   end subroutine lexer_init_cmd_list
 
 @ %def lexer_init_cmd_list
 @
 \subsection{Unit Tests}
 Test module, followed by the corresponding implementation module.
 <<[[commands_ut.f90]]>>=
 <<File header>>
 
 module commands_ut
   use unit_tests
   use commands_uti
 
 <<Standard module head>>
 
 <<Commands: public test>>
 
 contains
 
 <<Commands: test driver>>
 
 end module commands_ut
 @ %def commands_ut
 @
 <<[[commands_uti.f90]]>>=
 <<File header>>
 
 module commands_uti
 
   <<Use kinds>>
     use kinds, only: i64
   <<Use strings>>
     use io_units
     use ifiles
     use parser
     use interactions, only: reset_interaction_counter
     use prclib_stacks
     use analysis
     use variables, only: var_list_t
     use models
     use slha_interface
     use rt_data
     use event_base, only: generic_event_t, event_callback_t
 
     use commands
 
 <<Standard module head>>
 
 <<Commands: test declarations>>
 
 <<Commands: test auxiliary types>>
 
 contains
 
 <<Commands: tests>>
 
 <<Commands: test auxiliary>>
 
 end module commands_uti
 
 @ %def commands_uti
 @ API: driver for the unit tests below.
 <<Commands: public test>>=
   public :: commands_test
 <<Commands: test driver>>=
   subroutine commands_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Commands: execute tests>>
   end subroutine commands_test
 
 @ %def commands_test
 @
 \subsubsection{Prepare Sindarin code}
 This routine parses an internal file, prints the parse tree, and
 returns a parse node to the root.  We use the routine in the tests
 below.
 <<Commands: public test auxiliary>>=
   public :: parse_ifile
 <<Commands: test auxiliary>>=
   subroutine parse_ifile (ifile, pn_root, u)
     use ifiles
     use lexers
     use parser
     use commands
     type(ifile_t), intent(in) :: ifile
     type(parse_node_t), pointer, intent(out) :: pn_root
     integer, intent(in), optional :: u
     type(stream_t), target :: stream
     type(lexer_t), target :: lexer
     type(parse_tree_t) :: parse_tree
 
     call lexer_init_cmd_list (lexer)
     call stream_init (stream, ifile)
     call lexer_assign_stream (lexer, stream)
 
     call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
     if (present (u))  call parse_tree_write (parse_tree, u)
     pn_root => parse_tree%get_root_ptr ()
 
     call stream_final (stream)
     call lexer_final (lexer)
   end subroutine parse_ifile
 
 @ %def parse_ifile
 @
 \subsubsection{Empty command list}
 Compile and execute an empty command list.  Should do nothing but
 test the integrity of the workflow.
 <<Commands: execute tests>>=
   call test (commands_1, "commands_1", &
        "empty command list", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_1
 <<Commands: tests>>=
   subroutine commands_1 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_1"
     write (u, "(A)")  "*   Purpose: compile and execute empty command list"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Parse empty file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
 
     if (associated (pn_root)) then
        call command_list%compile (pn_root, global)
     end if
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
 
     call global%activate ()
     call command_list%execute (global)
     call global%deactivate ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call syntax_cmd_list_final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_1"
 
   end subroutine commands_1
 
 @ %def commands_1
 @
 \subsubsection{Read model}
 Execute a [[model]] assignment.
 <<Commands: execute tests>>=
   call test (commands_2, "commands_2", &
        "model", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_2
 <<Commands: tests>>=
   subroutine commands_2 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_2"
     write (u, "(A)")  "*   Purpose: set model"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_2"
 
   end subroutine commands_2
 
 @ %def commands_2
 @
 \subsubsection{Declare Process}
 Read a model, then declare a process.  The process library is allocated
 explicitly.  For the process definition, We take the default ([[omega]])
 method.  Since we do not compile, \oMega\ is not actually called.
 <<Commands: execute tests>>=
   call test (commands_3, "commands_3", &
        "process declaration", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_3
 <<Commands: tests>>=
   subroutine commands_3 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_3"
     write (u, "(A)")  "*   Purpose: define process"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%var_list%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd3"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process t3 = s, s => s, s')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%prclib_stack%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_3"
 
   end subroutine commands_3
 
 @ %def commands_3
 @
 \subsubsection{Compile Process}
 Read a model, then declare a process and compile the library.  The process
 library is allocated explicitly.  For the process definition, We take the
 default ([[unit_test]]) method.  There is no external code, so compilation of
 the library is merely a formal status change.
 <<Commands: execute tests>>=
   call test (commands_4, "commands_4", &
        "compilation", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_4
 <<Commands: tests>>=
   subroutine commands_4 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_4"
     write (u, "(A)")  "*   Purpose: define process and compile library"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd4"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process t4 = s, s => s, s')
     call ifile_append (ifile, 'compile ("lib_cmd4")')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%prclib_stack%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_4"
 
   end subroutine commands_4
 
 @ %def commands_4
 @
 \subsubsection{Integrate Process}
 Read a model, then declare a process, compile the library, and
 integrate over phase space.  We take the
 default ([[unit_test]]) method and use the simplest methods of
 phase-space parameterization and integration.
 <<Commands: execute tests>>=
   call test (commands_5, "commands_5", &
        "integration", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_5
 <<Commands: tests>>=
   subroutine commands_5 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_5"
     write (u, "(A)")  "*   Purpose: define process, iterations, and integrate"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
     call global%var_list%set_int (var_str ("seed"), 0, is_known=.true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd5"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process t5 = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (t5)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call reset_interaction_counter ()
     call command_list%execute (global)
 
     call global%it_list%write (u)
     write (u, "(A)")
     call global%process_stack%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_5"
 
   end subroutine commands_5
 
 @ %def commands_5
 @
 \subsubsection{Variables}
 Set intrinsic and user-defined variables.
 <<Commands: execute tests>>=
   call test (commands_6, "commands_6", &
        "variables", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_6
 <<Commands: tests>>=
   subroutine commands_6 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_6"
     write (u, "(A)")  "*   Purpose: define and set variables"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
     call global%write_vars (u, [ &
          var_str ("$run_id"), &
          var_str ("?unweighted"), &
          var_str ("sqrts")])
 
     write (u, "(A)")
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$run_id = "run1"')
     call ifile_append (ifile, '?unweighted = false')
     call ifile_append (ifile, 'sqrts = 1000')
     call ifile_append (ifile, 'int j = 10')
     call ifile_append (ifile, 'real x = 1000.')
     call ifile_append (ifile, 'complex z = 5')
     call ifile_append (ifile, 'string $text = "abcd"')
     call ifile_append (ifile, 'logical ?flag = true')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_vars (u, [ &
          var_str ("$run_id"), &
          var_str ("?unweighted"), &
          var_str ("sqrts"), &
          var_str ("j"), &
          var_str ("x"), &
          var_str ("z"), &
          var_str ("$text"), &
          var_str ("?flag")])
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call syntax_cmd_list_final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_6"
 
   end subroutine commands_6
 
 @ %def commands_6
 @
 \subsubsection{Process library}
 Open process libraries explicitly.
 <<Commands: execute tests>>=
   call test (commands_7, "commands_7", &
        "process library", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_7
 <<Commands: tests>>=
   subroutine commands_7 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_7"
     write (u, "(A)")  "*   Purpose: declare process libraries"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
     call global%var_list%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
     global%os_data%fc = "Fortran-compiler"
     global%os_data%fcflags = "Fortran-flags"
 
     write (u, "(A)")
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'library = "lib_cmd7_1"')
     call ifile_append (ifile, 'library = "lib_cmd7_2"')
     call ifile_append (ifile, 'library = "lib_cmd7_1"')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_libraries (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call syntax_cmd_list_final ()
     call global%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_7"
 
   end subroutine commands_7
 
 @ %def commands_7
 @
 \subsubsection{Generate events}
 Read a model, then declare a process, compile the library, and
 generate weighted events.  We take the
 default ([[unit_test]]) method and use the simplest methods of
 phase-space parameterization and integration.
 <<Commands: execute tests>>=
   call test (commands_8, "commands_8", &
        "event generation", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_8
 <<Commands: tests>>=
   subroutine commands_8 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_8"
     write (u, "(A)")  "*   Purpose: define process, integrate, generate events"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd8"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_8_p = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (commands_8_p)')
     call ifile_append (ifile, '?unweighted = false')
     call ifile_append (ifile, 'n_events = 3')
     call ifile_append (ifile, '?read_raw = false')
     call ifile_append (ifile, 'simulate (commands_8_p)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
 
     call command_list%execute (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_8"
 
   end subroutine commands_8
 
 @ %def commands_8
 @
 \subsubsection{Define cuts}
 Declare a cut expression.
 <<Commands: execute tests>>=
   call test (commands_9, "commands_9", &
        "cuts", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_9
 <<Commands: tests>>=
   subroutine commands_9 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(string_t), dimension(0) :: no_vars
 
     write (u, "(A)")  "* Test output: commands_9"
     write (u, "(A)")  "*   Purpose: define cuts"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'cuts = all Pt > 0 [particle]')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write (u, vars = no_vars)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_9"
 
   end subroutine commands_9
 
 @ %def commands_9
 @
 \subsubsection{Beams}
 Define beam setup.
 <<Commands: execute tests>>=
   call test (commands_10, "commands_10", &
        "beams", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_10
 <<Commands: tests>>=
   subroutine commands_10 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_10"
     write (u, "(A)")  "*   Purpose: define beams"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = QCD')
     call ifile_append (ifile, 'sqrts = 1000')
     call ifile_append (ifile, 'beams = p, p')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_beams (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_10"
 
   end subroutine commands_10
 
 @ %def commands_10
 @
 \subsubsection{Structure functions}
 Define beam setup with structure functions
 <<Commands: execute tests>>=
   call test (commands_11, "commands_11", &
        "structure functions", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_11
 <<Commands: tests>>=
   subroutine commands_11 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_11"
     write (u, "(A)")  "*   Purpose: define beams with structure functions"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = QCD')
     call ifile_append (ifile, 'sqrts = 1100')
     call ifile_append (ifile, 'beams = p, p => lhapdf => pdf_builtin, isr')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_beams (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_11"
 
   end subroutine commands_11
 
 @ %def commands_11
 @
 \subsubsection{Rescan events}
 Read a model, then declare a process, compile the library, and
 generate weighted events.  We take the
 default ([[unit_test]]) method and use the simplest methods of
 phase-space parameterization and integration.  Then, rescan the
 generated event sample.
 <<Commands: execute tests>>=
   call test (commands_12, "commands_12", &
        "event rescanning", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_12
 <<Commands: tests>>=
   subroutine commands_12 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_12"
     write (u, "(A)")  "*   Purpose: generate events and rescan"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
 
     call global%global_init ()
     call global%var_list%append_log (&
          var_str ("?rebuild_phase_space"), .false., &
          intrinsic=.true.)
     call global%var_list%append_log (&
          var_str ("?rebuild_grids"), .false., &
          intrinsic=.true.)
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd12"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_12_p = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (commands_12_p)')
     call ifile_append (ifile, '?unweighted = false')
     call ifile_append (ifile, 'n_events = 3')
     call ifile_append (ifile, '?read_raw = false')
     call ifile_append (ifile, 'simulate (commands_12_p)')
     call ifile_append (ifile, '?write_raw = false')
     call ifile_append (ifile, 'rescan "commands_12_p" (commands_12_p)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
 
     call command_list%execute (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_12"
 
   end subroutine commands_12
 
 @ %def commands_12
 @
 \subsubsection{Event Files}
 Set output formats for event files.
 <<Commands: execute tests>>=
   call test (commands_13, "commands_13", &
        "event output formats", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_13
 <<Commands: tests>>=
   subroutine commands_13 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
     logical :: exist
 
     write (u, "(A)")  "* Test output: commands_13"
     write (u, "(A)")  "*   Purpose: generate events and rescan"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd13"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_13_p = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (commands_13_p)')
     call ifile_append (ifile, '?unweighted = false')
     call ifile_append (ifile, 'n_events = 1')
     call ifile_append (ifile, '?read_raw = false')
     call ifile_append (ifile, 'sample_format = weight_stream')
     call ifile_append (ifile, 'simulate (commands_13_p)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
 
     call command_list%execute (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Verify output files"
     write (u, "(A)")
 
     inquire (file = "commands_13_p.evx", exist = exist)
     if (exist)  write (u, "(1x,A)")  "raw"
 
     inquire (file = "commands_13_p.weights.dat", exist = exist)
     if (exist)  write (u, "(1x,A)")  "weight_stream"
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_13"
 
   end subroutine commands_13
 
 @ %def commands_13
 @
 \subsubsection{Compile Empty Libraries}
 (This is a regression test:)  Declare two empty libraries and compile them.
 <<Commands: execute tests>>=
   call test (commands_14, "commands_14", &
        "empty libraries", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_14
 <<Commands: tests>>=
   subroutine commands_14 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_14"
     write (u, "(A)")  "*   Purpose: define and compile empty libraries"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_cmd_list_init ()
 
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'library = "lib1"')
     call ifile_append (ifile, 'library = "lib2"')
     call ifile_append (ifile, 'compile ()')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%prclib_stack%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
 
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_14"
 
   end subroutine commands_14
 
 @ %def commands_14
 @
 \subsubsection{Compile Process}
 Read a model, then declare a process and compile the library.  The process
 library is allocated explicitly.  For the process definition, We take the
 default ([[unit_test]]) method.  There is no external code, so compilation of
 the library is merely a formal status change.
 <<Commands: execute tests>>=
   call test (commands_15, "commands_15", &
        "compilation", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_15
 <<Commands: tests>>=
   subroutine commands_15 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_15"
     write (u, "(A)")  "*   Purpose: define process and compile library"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd15"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process t15 = s, s => s, s')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (t15)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%prclib_stack%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_15"
 
   end subroutine commands_15
 
 @ %def commands_15
 @
 \subsubsection{Observable}
 Declare an observable, fill it and display.
 <<Commands: execute tests>>=
   call test (commands_16, "commands_16", &
        "observables", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_16
 <<Commands: tests>>=
   subroutine commands_16 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_16"
     write (u, "(A)")  "*   Purpose: declare an observable"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$obs_label = "foo"')
     call ifile_append (ifile, '$obs_unit = "cm"')
     call ifile_append (ifile, '$title = "Observable foo"')
     call ifile_append (ifile, '$description = "This is observable foo"')
     call ifile_append (ifile, 'observable foo')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Record two data items"
     write (u, "(A)")
 
     call analysis_record_data (var_str ("foo"), 1._default)
     call analysis_record_data (var_str ("foo"), 3._default)
 
     write (u, "(A)")  "* Display analysis store"
     write (u, "(A)")
 
     call analysis_write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_16"
 
   end subroutine commands_16
 
 @ %def commands_16
 @
 \subsubsection{Histogram}
 Declare a histogram, fill it and display.
 <<Commands: execute tests>>=
   call test (commands_17, "commands_17", &
        "histograms", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_17
 <<Commands: tests>>=
   subroutine commands_17 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(string_t), dimension(3) :: name
     integer :: i
 
     write (u, "(A)")  "* Test output: commands_17"
     write (u, "(A)")  "*   Purpose: declare histograms"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$obs_label = "foo"')
     call ifile_append (ifile, '$obs_unit = "cm"')
     call ifile_append (ifile, '$title = "Histogram foo"')
     call ifile_append (ifile, '$description = "This is histogram foo"')
     call ifile_append (ifile, 'histogram foo (0,5,1)')
     call ifile_append (ifile, '$title = "Histogram bar"')
     call ifile_append (ifile, '$description = "This is histogram bar"')
     call ifile_append (ifile, 'n_bins = 2')
     call ifile_append (ifile, 'histogram bar (0,5)')
     call ifile_append (ifile, '$title = "Histogram gee"')
     call ifile_append (ifile, '$description = "This is histogram gee"')
     call ifile_append (ifile, '?normalize_bins = true')
     call ifile_append (ifile, 'histogram gee (0,5)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Record two data items"
     write (u, "(A)")
 
     name(1) = "foo"
     name(2) = "bar"
     name(3) = "gee"
 
     do i = 1, 3
        call analysis_record_data (name(i), 0.1_default, &
             weight = 0.25_default)
        call analysis_record_data (name(i), 3.1_default)
        call analysis_record_data (name(i), 4.1_default, &
             excess = 0.5_default)
        call analysis_record_data (name(i), 7.1_default)
     end do
 
     write (u, "(A)")  "* Display analysis store"
     write (u, "(A)")
 
     call analysis_write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_17"
 
   end subroutine commands_17
 
 @ %def commands_17
 @
 \subsubsection{Plot}
 Declare a plot, fill it and display contents.
 <<Commands: execute tests>>=
   call test (commands_18, "commands_18", &
        "plots", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_18
 <<Commands: tests>>=
   subroutine commands_18 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_18"
     write (u, "(A)")  "*   Purpose: declare a plot"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$obs_label = "foo"')
     call ifile_append (ifile, '$obs_unit = "cm"')
     call ifile_append (ifile, '$title = "Plot foo"')
     call ifile_append (ifile, '$description = "This is plot foo"')
     call ifile_append (ifile, '$x_label = "x axis"')
     call ifile_append (ifile, '$y_label = "y axis"')
     call ifile_append (ifile, '?x_log = false')
     call ifile_append (ifile, '?y_log = true')
     call ifile_append (ifile, 'x_min = -1')
     call ifile_append (ifile, 'x_max = 1')
     call ifile_append (ifile, 'y_min = 0.1')
     call ifile_append (ifile, 'y_max = 1000')
     call ifile_append (ifile, 'plot foo')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Record two data items"
     write (u, "(A)")
 
     call analysis_record_data (var_str ("foo"), 0._default, 20._default, &
          xerr = 0.25_default)
     call analysis_record_data (var_str ("foo"), 0.5_default, 0.2_default, &
          yerr = 0.07_default)
     call analysis_record_data (var_str ("foo"), 3._default, 2._default)
 
     write (u, "(A)")  "* Display analysis store"
     write (u, "(A)")
 
     call analysis_write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_18"
 
   end subroutine commands_18
 
 @ %def commands_18
 @
 \subsubsection{Graph}
 Combine two (empty) plots to a graph.
 <<Commands: execute tests>>=
   call test (commands_19, "commands_19", &
        "graphs", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_19
 <<Commands: tests>>=
   subroutine commands_19 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_19"
     write (u, "(A)")  "*   Purpose: combine two plots to a graph"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'plot a')
     call ifile_append (ifile, 'plot b')
     call ifile_append (ifile, '$title = "Graph foo"')
     call ifile_append (ifile, '$description = "This is graph foo"')
     call ifile_append (ifile, 'graph foo = a & b')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Display analysis object"
     write (u, "(A)")
 
     call analysis_write (var_str ("foo"), u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_19"
 
   end subroutine commands_19
 
 @ %def commands_19
 @
 \subsubsection{Record Data}
 Record data in previously allocated analysis objects.
 <<Commands: execute tests>>=
   call test (commands_20, "commands_20", &
        "record data", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_20
 <<Commands: tests>>=
   subroutine commands_20 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_20"
     write (u, "(A)")  "*   Purpose: record data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization: create observable, histogram, plot"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     call analysis_init_observable (var_str ("o"))
     call analysis_init_histogram (var_str ("h"), 0._default, 1._default, 3, &
          normalize_bins = .false.)
     call analysis_init_plot (var_str ("p"))
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'record o (1.234)')
     call ifile_append (ifile, 'record h (0.5)')
     call ifile_append (ifile, 'record p (1, 2)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Display analysis object"
     write (u, "(A)")
 
     call analysis_write (u, verbose = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_20"
 
   end subroutine commands_20
 
 @ %def commands_20
 @
 \subsubsection{Analysis}
 Declare an analysis expression and use it to fill an observable during
 event generation.
 <<Commands: execute tests>>=
   call test (commands_21, "commands_21", &
        "analysis expression", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_21
 <<Commands: tests>>=
   subroutine commands_21 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_21"
     write (u, "(A)")  "*   Purpose: create and use analysis expression"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization: create observable"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd8"))
     call global%add_prclib (lib)
 
     call analysis_init_observable (var_str ("m"))
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_21_p = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:100')
     call ifile_append (ifile, 'integrate (commands_21_p)')
     call ifile_append (ifile, '?unweighted = true')
     call ifile_append (ifile, 'n_events = 3')
     call ifile_append (ifile, '?read_raw = false')
     call ifile_append (ifile, 'observable m')
     call ifile_append (ifile, 'analysis = record m (eval M [s])')
     call ifile_append (ifile, 'simulate (commands_21_p)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Display analysis object"
     write (u, "(A)")
 
     call analysis_write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_21"
 
   end subroutine commands_21
 
 @ %def commands_21
 @
 \subsubsection{Write Analysis}
 Write accumulated analysis data to file.
 <<Commands: execute tests>>=
   call test (commands_22, "commands_22", &
        "write analysis", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_22
 <<Commands: tests>>=
   subroutine commands_22 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     integer :: u_file, iostat
     logical :: exist
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: commands_22"
     write (u, "(A)")  "*   Purpose: write analysis data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization: create observable"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     call analysis_init_observable (var_str ("m"))
     call analysis_record_data (var_str ("m"), 125._default)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$out_file = "commands_22.dat"')
     call ifile_append (ifile, 'write_analysis')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Display analysis data"
     write (u, "(A)")
 
     inquire (file = "commands_22.dat", exist = exist)
     if (.not. exist) then
        write (u, "(A)")  "ERROR: File commands_22.dat not found"
        return
     end if
 
     u_file = free_unit ()
     open (u_file, file = "commands_22.dat", &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_22"
 
   end subroutine commands_22
 
 @ %def commands_22
 @
 \subsubsection{Compile Analysis}
 Write accumulated analysis data to file and compile.
 <<Commands: execute tests>>=
   call test (commands_23, "commands_23", &
        "compile analysis", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_23
 <<Commands: tests>>=
   subroutine commands_23 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     integer :: u_file, iostat
     character(256) :: buffer
     logical :: exist
     type(graph_options_t) :: graph_options
 
     write (u, "(A)")  "* Test output: commands_23"
     write (u, "(A)")  "*   Purpose: write and compile analysis data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization: create and fill histogram"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     call graph_options_init (graph_options)
     call graph_options_set (graph_options, &
          title = var_str ("Histogram for test: commands 23"), &
          description = var_str ("This is a test."), &
          width_mm = 125, height_mm = 85)
     call analysis_init_histogram (var_str ("h"), &
          0._default, 10._default, 2._default, .false., &
          graph_options = graph_options)
     call analysis_record_data (var_str ("h"), 1._default)
     call analysis_record_data (var_str ("h"), 1._default)
     call analysis_record_data (var_str ("h"), 1._default)
     call analysis_record_data (var_str ("h"), 1._default)
     call analysis_record_data (var_str ("h"), 3._default)
     call analysis_record_data (var_str ("h"), 3._default)
     call analysis_record_data (var_str ("h"), 3._default)
     call analysis_record_data (var_str ("h"), 5._default)
     call analysis_record_data (var_str ("h"), 7._default)
     call analysis_record_data (var_str ("h"), 7._default)
     call analysis_record_data (var_str ("h"), 7._default)
     call analysis_record_data (var_str ("h"), 7._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
     call analysis_record_data (var_str ("h"), 9._default)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$out_file = "commands_23.dat"')
     call ifile_append (ifile, 'compile_analysis')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Delete Postscript output"
     write (u, "(A)")
 
     inquire (file = "commands_23.ps", exist = exist)
     if (exist) then
        u_file = free_unit ()
        open (u_file, file = "commands_23.ps", action = "write", status = "old")
        close (u_file, status = "delete")
     end if
     inquire (file = "commands_23.ps", exist = exist)
     write (u, "(1x,A,L1)")  "Postcript output exists = ", exist
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* TeX file"
     write (u, "(A)")
 
     inquire (file = "commands_23.tex", exist = exist)
     if (.not. exist) then
        write (u, "(A)")  "ERROR: File commands_23.tex not found"
        return
     end if
 
     u_file = free_unit ()
     open (u_file, file = "commands_23.tex", &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
     close (u_file)
     write (u, *)
 
     inquire (file = "commands_23.ps", exist = exist)
     write (u, "(1x,A,L1)")  "Postcript output exists = ", exist
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_23"
 
   end subroutine commands_23
 
 @ %def commands_23
 @
 \subsubsection{Histogram}
 Declare a histogram, fill it and display.
 <<Commands: execute tests>>=
   call test (commands_24, "commands_24", &
        "drawing options", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_24
 <<Commands: tests>>=
   subroutine commands_24 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_24"
     write (u, "(A)")  "*   Purpose: check graph and drawing options"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, '$title = "Title"')
     call ifile_append (ifile, '$description = "Description"')
     call ifile_append (ifile, '$x_label = "X Label"')
     call ifile_append (ifile, '$y_label = "Y Label"')
     call ifile_append (ifile, 'graph_width_mm = 111')
     call ifile_append (ifile, 'graph_height_mm = 222')
     call ifile_append (ifile, 'x_min = -11')
     call ifile_append (ifile, 'x_max = 22')
     call ifile_append (ifile, 'y_min = -33')
     call ifile_append (ifile, 'y_max = 44')
     call ifile_append (ifile, '$gmlcode_bg = "GML Code BG"')
     call ifile_append (ifile, '$gmlcode_fg = "GML Code FG"')
     call ifile_append (ifile, '$fill_options = "Fill Options"')
     call ifile_append (ifile, '$draw_options = "Draw Options"')
     call ifile_append (ifile, '$err_options = "Error Options"')
     call ifile_append (ifile, '$symbol = "Symbol"')
     call ifile_append (ifile, 'histogram foo (0,1)')
     call ifile_append (ifile, 'plot bar')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Display analysis store"
     write (u, "(A)")
 
     call analysis_write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_24"
 
   end subroutine commands_24
 
 @ %def commands_24
 @
 \subsubsection{Local Environment}
 Declare a local environment.
 <<Commands: execute tests>>=
   call test (commands_25, "commands_25", &
        "local process environment", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_25
 <<Commands: tests>>=
   subroutine commands_25 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_25"
     write (u, "(A)")  "*   Purpose: declare local environment for process"
     write (u, "(A)")
 
     call syntax_model_file_init ()
     call syntax_cmd_list_init ()
     call global%global_init ()
     call global%var_list%set_log (var_str ("?omega_openmp"), &
          .false., is_known = .true.)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'library = "commands_25_lib"')
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_25_p1 = g, g => g, g &
          &{ model = "QCD" }')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
     call global%write_libraries (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_25"
 
   end subroutine commands_25
 
 @ %def commands_25
 @
 \subsubsection{Alternative Setups}
 Declare a list of alternative setups.
 <<Commands: execute tests>>=
   call test (commands_26, "commands_26", &
        "alternative setups", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_26
 <<Commands: tests>>=
   subroutine commands_26 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_26"
     write (u, "(A)")  "*   Purpose: declare alternative setups for simulation"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'int i = 0')
     call ifile_append (ifile, 'alt_setup = ({ i = 1 }, { i = 2 })')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_expr (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_26"
 
   end subroutine commands_26
 
 @ %def commands_26
 @
 \subsubsection{Unstable Particle}
 Define decay processes and declare a particle as unstable.  Also check
 the commands stable, polarized, unpolarized.
 <<Commands: execute tests>>=
   call test (commands_27, "commands_27", &
        "unstable and polarized particles", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_27
 <<Commands: tests>>=
   subroutine commands_27 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
 
     write (u, "(A)")  "* Test output: commands_27"
     write (u, "(A)")  "*   Purpose: modify particle properties"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call global%global_init ()
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
 
     allocate (lib)
     call lib%init (var_str ("commands_27_lib"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'ff = 0.4')
     call ifile_append (ifile, 'process d1 = s => f, fbar')
     call ifile_append (ifile, 'unstable s (d1)')
     call ifile_append (ifile, 'polarized f, fbar')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Show model"
     write (u, "(A)")
 
     call global%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extra Input"
     write (u, "(A)")
 
     call ifile_final (ifile)
     call ifile_append (ifile, '?diagonal_decay = true')
     call ifile_append (ifile, 'unstable s (d1)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%final ()
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Show model"
     write (u, "(A)")
 
     call global%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extra Input"
     write (u, "(A)")
 
     call ifile_final (ifile)
     call ifile_append (ifile, '?isotropic_decay = true')
     call ifile_append (ifile, 'unstable s (d1)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%final ()
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Show model"
     write (u, "(A)")
 
     call global%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extra Input"
     write (u, "(A)")
 
     call ifile_final (ifile)
     call ifile_append (ifile, 'stable s')
     call ifile_append (ifile, 'unpolarized f')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%final ()
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Show model"
     write (u, "(A)")
 
     call global%model%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_model_file_init ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_27"
 
   end subroutine commands_27
 
 @ %def commands_27
 @
 \subsubsection{Quit the program}
 Quit the program.
 <<Commands: execute tests>>=
   call test (commands_28, "commands_28", &
        "quit", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_28
 <<Commands: tests>>=
   subroutine commands_28 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root1, pn_root2
     type(string_t), dimension(0) :: no_vars
 
     write (u, "(A)")  "* Test output: commands_28"
     write (u, "(A)")  "*   Purpose: quit the program"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file: quit without code"
     write (u, "(A)")
 
     call ifile_append (ifile, 'quit')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root1, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root1, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write (u, vars = no_vars)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Input file: quit with code"
     write (u, "(A)")
 
     call ifile_final (ifile)
     call command_list%final ()
     call ifile_append (ifile, 'quit ( 3 + 4 )')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root2, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root2, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write (u, vars = no_vars)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_28"
 
   end subroutine commands_28
 
 @ %def commands_28
 @
 \subsubsection{SLHA interface}
 Testing commands steering the SLHA interface.
 <<Commands: execute tests>>=
   call test (commands_29, "commands_29", &
        "SLHA interface", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_29
 <<Commands: tests>>=
   subroutine commands_29 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(var_list_t), pointer :: model_vars
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_29"
     write (u, "(A)")  "*   Purpose: test SLHA interface"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call syntax_model_file_init ()
     call syntax_slha_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Model MSSM, read SLHA file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "MSSM"')
     call ifile_append (ifile, '?slha_read_decays = true')
     call ifile_append (ifile, 'read_slha ("sps1ap_decays.slha")')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Model MSSM, default values:"
     write (u, "(A)")
 
     call global%model%write (u, verbose = .false., &
          show_vertices = .false., show_particles = .false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Selected global variables"
     write (u, "(A)")
 
     model_vars => global%model%get_var_list_ptr ()
 
     call model_vars%write_var (var_str ("mch1"), u)
     call model_vars%write_var (var_str ("wch1"), u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")  "* Model MSSM, values from SLHA file"
     write (u, "(A)")
 
     call global%model%write (u, verbose = .false., &
          show_vertices = .false., show_particles = .false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Selected global variables"
     write (u, "(A)")
 
     model_vars => global%model%get_var_list_ptr ()
 
     call model_vars%write_var (var_str ("mch1"), u)
     call model_vars%write_var (var_str ("wch1"), u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_slha_final ()
     call syntax_model_file_final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_29"
 
   end subroutine commands_29
 
 @ %def commands_29
 @
 \subsubsection{Expressions for scales}
 Declare a scale, factorization scale or factorization scale expression.
 <<Commands: execute tests>>=
   call test (commands_30, "commands_30", &
        "scales", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_30
 <<Commands: tests>>=
   subroutine commands_30 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_30"
     write (u, "(A)")  "*   Purpose: define scales"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'scale = 200 GeV')
     call ifile_append (ifile, &
          'factorization_scale = eval Pt [particle]')
     call ifile_append (ifile, &
          'renormalization_scale = eval E [particle]')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_expr (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_30"
 
   end subroutine commands_30
 
 @ %def commands_30
 @
 \subsubsection{Weight and reweight expressions}
 Declare an expression for event weights and reweighting.
 <<Commands: execute tests>>=
   call test (commands_31, "commands_31", &
        "event weights/reweighting", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_31
 <<Commands: tests>>=
   subroutine commands_31 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_31"
     write (u, "(A)")  "*   Purpose: define weight/reweight"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'weight = eval Pz [particle]')
     call ifile_append (ifile, 'reweight = eval M2 [particle]')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_expr (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_31"
 
   end subroutine commands_31
 
 @ %def commands_31
 @
 \subsubsection{Selecting events}
 Declare an expression for selecting events in an analysis.
 <<Commands: execute tests>>=
   call test (commands_32, "commands_32", &
        "event selection", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_32
 <<Commands: tests>>=
   subroutine commands_32 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
 
     write (u, "(A)")  "* Test output: commands_32"
     write (u, "(A)")  "*   Purpose: define selection"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'selection = any PDG == 13 [particle]')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     call global%write_expr (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_32"
 
   end subroutine commands_32
 
 @ %def commands_32
 @
 \subsubsection{Executing shell commands}
 Execute a shell command.
 <<Commands: execute tests>>=
   call test (commands_33, "commands_33", &
        "execute shell command", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_33
 <<Commands: tests>>=
   subroutine commands_33 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     integer :: u_file, iostat
     character(3) :: buffer
 
     write (u, "(A)")  "* Test output: commands_33"
     write (u, "(A)")  "*   Purpose: execute shell command"
     write (u, "(A)")
 
     write (u, "(A)")  "*  Initialization"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     write (u, "(A)")  "*  Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'exec ("echo foo >> bar")')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "*  Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
     u_file = free_unit ()
     open (u_file, file = "bar", &
          action = "read", status = "old")
     do
        read (u_file, "(A)", iostat = iostat)  buffer
        if (iostat /= 0) exit
     end do
     write (u, "(A,A)")  "should be 'foo': ", trim (buffer)
     close (u_file)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_33"
 
   end subroutine commands_33
 
 @ %def commands_33
 @
 \subsubsection{Callback}
 Instead of an explicit write, use the callback feature to write the
 analysis file during event generation.  We generate 4 events and
 arrange that the callback is executed while writing the 3rd event.
 <<Commands: execute tests>>=
   call test (commands_34, "commands_34", &
        "analysis via callback", &
        u, results)
 <<Commands: test declarations>>=
   public :: commands_34
 <<Commands: tests>>=
   subroutine commands_34 (u)
     integer, intent(in) :: u
     type(ifile_t) :: ifile
     type(command_list_t), target :: command_list
     type(rt_data_t), target :: global
     type(parse_node_t), pointer :: pn_root
     type(prclib_entry_t), pointer :: lib
     type(event_callback_34_t) :: event_callback
 
     write (u, "(A)")  "* Test output: commands_34"
     write (u, "(A)")  "*   Purpose: write analysis data"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialization: create observable"
     write (u, "(A)")
 
     call syntax_cmd_list_init ()
     call global%global_init ()
 
     call syntax_model_file_init ()
     call global%global_init ()
     call global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
 
     call global%var_list%set_string (var_str ("$method"), &
          var_str ("unit_test"), is_known=.true.)
     call global%var_list%set_string (var_str ("$phs_method"), &
          var_str ("single"), is_known=.true.)
     call global%var_list%set_string (var_str ("$integration_method"),&
          var_str ("midpoint"), is_known=.true.)
     call global%var_list%set_real (var_str ("sqrts"), &
          1000._default, is_known=.true.)
     call global%var_list%set_log (var_str ("?vis_history"),&
          .false., is_known=.true.)
     call global%var_list%set_log (var_str ("?integration_timer"),&
          .false., is_known = .true.)
 
     allocate (lib)
     call lib%init (var_str ("lib_cmd34"))
     call global%add_prclib (lib)
 
     write (u, "(A)")  "* Prepare callback for writing analysis to I/O unit"
     write (u, "(A)")
 
     event_callback%u = u
     call global%set_event_callback (event_callback)
 
     write (u, "(A)")  "* Input file"
     write (u, "(A)")
 
     call ifile_append (ifile, 'model = "Test"')
     call ifile_append (ifile, 'process commands_34_p = s, s => s, s')
     call ifile_append (ifile, 'compile')
     call ifile_append (ifile, 'iterations = 1:1000')
     call ifile_append (ifile, 'integrate (commands_34_p)')
     call ifile_append (ifile, 'observable sq')
     call ifile_append (ifile, 'analysis = record sq (sqrts)')
     call ifile_append (ifile, 'n_events = 4')
     call ifile_append (ifile, 'event_callback_interval = 3')
     call ifile_append (ifile, 'simulate (commands_34_p)')
 
     call ifile_write (ifile, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Parse file"
     write (u, "(A)")
 
     call parse_ifile (ifile, pn_root)
 
     write (u, "(A)")  "* Compile command list"
     write (u, "(A)")
 
     call command_list%compile (pn_root, global)
 
     call command_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Execute command list"
     write (u, "(A)")
 
     call command_list%execute (global)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call ifile_final (ifile)
 
     call analysis_final ()
     call command_list%final ()
     call global%final ()
     call syntax_cmd_list_final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: commands_34"
 
   end subroutine commands_34
 
 @ %def commands_34
 @ For this test, we invent a callback object which simply writes the
 analysis file, using the standard call for this.  Here we rely on the
 fact that the analysis data are stored as a global entity, otherwise
 we would have to access them via the event object.
 <<Commands: test auxiliary types>>=
   type, extends (event_callback_t) :: event_callback_34_t
      private
      integer :: u = 0
    contains
      procedure :: write => event_callback_34_write
      procedure :: proc => event_callback_34
   end type event_callback_34_t
 
 @ %def event_callback_t
 @ The output routine is unused.  The actual callback should write the
 analysis data to the output unit that we have injected into the
 callback object.
 <<Commands: test auxiliary>>=
   subroutine event_callback_34_write (event_callback, unit)
     class(event_callback_34_t), intent(in) :: event_callback
     integer, intent(in), optional :: unit
   end subroutine event_callback_34_write
 
   subroutine event_callback_34 (event_callback, i, event)
     class(event_callback_34_t), intent(in) :: event_callback
     integer(i64), intent(in) :: i
     class(generic_event_t), intent(in) :: event
     call analysis_write (event_callback%u)
   end subroutine event_callback_34
 
 @ %def event_callback_34_write
 @ %def event_callback_34
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Toplevel module WHIZARD}
 <<[[whizard.f90]]>>=
 <<File header>>
 
 module whizard
 
   use io_units
 <<Use strings>>
   use system_defs, only: VERSION_STRING
   use system_defs, only: EOF, BACKSLASH
   use diagnostics
   use os_interface
   use ifiles
   use lexers
   use parser
   use eval_trees
   use models
   use phs_forests
   use prclib_stacks
   use slha_interface
   use blha_config
   use rt_data
   use commands
 
 <<Standard module head>>
 
 <<WHIZARD: public>>
 
 <<WHIZARD: types>>
 
   save
 
 contains
 
 <<WHIZARD: procedures>>
 
 end module whizard
 @ %def whizard
 @
 \subsection{Options}
 Here we introduce a wrapper that holds various user options, so they
 can transparently be passed from the main program to the [[whizard]]
 object.  Most parameters are used for initializing the [[global]]
 state.
 <<WHIZARD: public>>=
   public :: whizard_options_t
 <<WHIZARD: types>>=
   type :: whizard_options_t
      type(string_t) :: job_id
      type(string_t), dimension(:), allocatable :: pack_args
      type(string_t), dimension(:), allocatable :: unpack_args
      type(string_t) :: preload_model
      type(string_t) :: default_lib
      type(string_t) :: preload_libraries
      logical :: rebuild_library = .false.
      logical :: recompile_library = .false.
      logical :: rebuild_user
      logical :: rebuild_phs = .false.
      logical :: rebuild_grids = .false.
      logical :: rebuild_events = .false.
   end type whizard_options_t
 
 @ %def whizard_options_t
 @
 \subsection{Parse tree stack}
 We collect all parse trees that we generate in the [[whizard]] object.  To
 this end, we create a stack of parse trees.  They must not be finalized before
 the [[global]] object is finalized, because items such as a cut definition may
 contain references to the parse tree from which they were generated.
 <<WHIZARD: types>>=
   type, extends (parse_tree_t) :: pt_entry_t
      type(pt_entry_t), pointer :: previous => null ()
   end type pt_entry_t
 
 @ %def pt_entry_t
 @ This is the stack.  Since we always prepend, we just need the [[last]]
 pointer.
 <<WHIZARD: types>>=
   type :: pt_stack_t
      type(pt_entry_t), pointer :: last => null ()
    contains
    <<WHIZARD: pt stack: TBP>>
   end type pt_stack_t
 
 @ %def pt_stack_t
 @ The finalizer is called at the very end.
 <<WHIZARD: pt stack: TBP>>=
   procedure :: final => pt_stack_final
 <<WHIZARD: procedures>>=
   subroutine pt_stack_final (pt_stack)
     class(pt_stack_t), intent(inout) :: pt_stack
     type(pt_entry_t), pointer :: current
     do while (associated (pt_stack%last))
        current => pt_stack%last
        pt_stack%last => current%previous
        call parse_tree_final (current%parse_tree_t)
        deallocate (current)
     end do
   end subroutine pt_stack_final
 
 @ %def pt_stack_final
 @ Create and push a new entry, keeping the previous ones.
 <<WHIZARD: pt stack: TBP>>=
   procedure :: push => pt_stack_push
 <<WHIZARD: procedures>>=
   subroutine pt_stack_push (pt_stack, parse_tree)
     class(pt_stack_t), intent(inout) :: pt_stack
     type(parse_tree_t), intent(out), pointer :: parse_tree
     type(pt_entry_t), pointer :: current
     allocate (current)
     parse_tree => current%parse_tree_t
     current%previous => pt_stack%last
     pt_stack%last => current
   end subroutine pt_stack_push
 
 @ %def pt_stack_push
 @
 \subsection{The [[whizard]] object}
 An object of type [[whizard_t]] is the top-level wrapper for a
 \whizard\ instance.  The object holds various default
 settings and the current state of the generator, the [[global]] object
 of type [[rt_data_t]].  This object contains, for instance, the list
 of variables and the process libraries.
 
 Since components of the [[global]] subobject are frequently used as
 targets, the [[whizard]] object should also consistently carry the
 [[target]] attribute.
 
 The various self-tests do no not use this object.  They initialize
 only specific subsets of the system, according to their needs.
 
 Note: we intend to allow several concurrent instances.  In the current
 implementation, there are still a few obstacles to this: the model
 library and the syntax tables are global variables, and the error
 handling uses global state.  This should be improved.
 <<WHIZARD: public>>=
   public :: whizard_t
 <<WHIZARD: types>>=
   type :: whizard_t
      type(whizard_options_t) :: options
      type(rt_data_t) :: global
      type(pt_stack_t) :: pt_stack
    contains
    <<WHIZARD: whizard: TBP>>
   end type whizard_t
 
 @ %def whizard_t
 @
 \subsection{Initialization and finalization}
 <<WHIZARD: whizard: TBP>>=
   procedure :: init => whizard_init
 <<WHIZARD: procedures>>=
   subroutine whizard_init (whizard, options, paths, logfile)
     class(whizard_t), intent(out), target :: whizard
     type(whizard_options_t), intent(in) :: options
     type(paths_t), intent(in), optional :: paths
     type(string_t), intent(in), optional :: logfile
     call init_syntax_tables ()
     whizard%options = options
     call whizard%global%global_init (paths, logfile)
     call whizard%init_job_id ()
     call whizard%init_rebuild_flags ()
     call whizard%unpack_files ()
     call whizard%preload_model ()
     call whizard%preload_library ()
     call whizard%global%init_fallback_model &
          (var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
   end subroutine whizard_init
 
 @ %def whizard_init
 @ Apart from the global data which have been initialized above, the
 process and model lists need to be finalized.
 <<WHIZARD: whizard: TBP>>=
   procedure :: final => whizard_final
 <<WHIZARD: procedures>>=
   subroutine whizard_final (whizard)
     class(whizard_t), intent(inout), target :: whizard
     call whizard%global%final ()
     call whizard%pt_stack%final ()
     call whizard%pack_files ()
 !!! JRR: WK please check (#529)
     !    call user_code_final ()
     call final_syntax_tables ()
   end subroutine whizard_final
 
 @ %def whizard_final
 @ Set the job ID, if nonempty.  If the ID string is empty, the value remains
 undefined.
 <<WHIZARD: whizard: TBP>>=
   procedure :: init_job_id => whizard_init_job_id
 <<WHIZARD: procedures>>=
   subroutine whizard_init_job_id (whizard)
     class(whizard_t), intent(inout), target :: whizard
     associate (var_list => whizard%global%var_list, options => whizard%options)
       if (options%job_id /= "") then
          call var_list%set_string (var_str ("$job_id"), &
               options%job_id, is_known=.true.)
       end if
     end associate
   end subroutine whizard_init_job_id
   
 @ %def whizard_init_job_id
 @
 Set the rebuild flags.  They can be specified on the command line and
 set the initial value for the associated logical variables.
 <<WHIZARD: whizard: TBP>>=
   procedure :: init_rebuild_flags => whizard_init_rebuild_flags
 <<WHIZARD: procedures>>=
   subroutine whizard_init_rebuild_flags (whizard)
     class(whizard_t), intent(inout), target :: whizard
     associate (var_list => whizard%global%var_list, options => whizard%options)
       call var_list%append_log (var_str ("?rebuild_library"), &
            options%rebuild_library, intrinsic=.true.)
       call var_list%append_log (var_str ("?recompile_library"), &
            options%recompile_library, intrinsic=.true.)
       call var_list%append_log (var_str ("?rebuild_phase_space"), &
            options%rebuild_phs, intrinsic=.true.)
       call var_list%append_log (var_str ("?rebuild_grids"), &
            options%rebuild_grids, intrinsic=.true.)
       call var_list%append_log (var_str ("?powheg_rebuild_grids"), &
            options%rebuild_grids, intrinsic=.true.)
       call var_list%append_log (var_str ("?rebuild_events"), &
            options%rebuild_events, intrinsic=.true.)
     end associate
   end subroutine whizard_init_rebuild_flags
 
 @ %def whizard_init_rebuild_flags
 @
 Pack/unpack files in the working directory, if requested.
 <<WHIZARD: whizard: TBP>>=
   procedure :: pack_files => whizard_pack_files
   procedure :: unpack_files => whizard_unpack_files
 <<WHIZARD: procedures>>=
   subroutine whizard_pack_files (whizard)
     class(whizard_t), intent(in), target :: whizard
     logical :: exist
     integer :: i
     type(string_t) :: file
     if (allocated (whizard%options%pack_args)) then
        do i = 1, size (whizard%options%pack_args)
           file = whizard%options%pack_args(i)
           call msg_message ("Packing file/dir '" // char (file) // "'")
           exist = os_file_exist (file) .or. os_dir_exist (file) 
           if (exist) then
              call os_pack_file (whizard%options%pack_args(i), &
                   whizard%global%os_data)
           else
              call msg_error ("File/dir '" // char (file) // "' not found")
           end if
        end do
     end if
   end subroutine whizard_pack_files
 
   subroutine whizard_unpack_files (whizard)
     class(whizard_t), intent(in), target :: whizard
     logical :: exist
     integer :: i
     type(string_t) :: file
     if (allocated (whizard%options%unpack_args)) then
        do i = 1, size (whizard%options%unpack_args)
           file = whizard%options%unpack_args(i)
           call msg_message ("Unpacking file '" // char (file) // "'")
           exist = os_file_exist (file) 
           if (exist) then
              call os_unpack_file (whizard%options%unpack_args(i), &
                   whizard%global%os_data)
           else
              call msg_error ("File '" // char (file) // "' not found")
           end if
        end do
     end if
   end subroutine whizard_unpack_files
 
 @ %def whizard_pack_files
 @ %def whizard_unpack_files
 @
 This procedure preloads a model, if a model name is given.
 <<WHIZARD: whizard: TBP>>=
   procedure :: preload_model => whizard_preload_model
 <<WHIZARD: procedures>>=
   subroutine whizard_preload_model (whizard)
     class(whizard_t), intent(inout), target :: whizard
     type(string_t) :: model_name
     model_name = whizard%options%preload_model
     if (model_name /= "") then
        call whizard%global%read_model (model_name, whizard%global%preload_model)
        whizard%global%model => whizard%global%preload_model
        if (associated (whizard%global%model)) then
           call whizard%global%model%link_var_list (whizard%global%var_list)
           call msg_message ("Preloaded model: " &
                // char (model_name))
        else
           call msg_fatal ("Preloading model " // char (model_name) &
                // " failed")
        end if
     else
        call msg_message ("No model preloaded")
     end if
   end subroutine whizard_preload_model
 
 @ %def whizard_preload_model
 @
 This procedure preloads a library, if a library name is given.
 
 Note: This version just opens a new library with that name.  It does not load
 (yet) an existing library on file, as previous \whizard\ versions would do.
 <<WHIZARD: whizard: TBP>>=
   procedure :: preload_library => whizard_preload_library
 <<WHIZARD: procedures>>=
   subroutine whizard_preload_library (whizard)
     class(whizard_t), intent(inout), target :: whizard
     type(string_t) :: library_name, libs
     type(string_t), dimension(:), allocatable :: libname_static
     type(prclib_entry_t), pointer :: lib_entry
     integer :: i
     call get_prclib_static (libname_static)
     do i = 1, size (libname_static)
        allocate (lib_entry)
        call lib_entry%init_static (libname_static(i))
        call whizard%global%add_prclib (lib_entry)
     end do
     libs = adjustl (whizard%options%preload_libraries)
     if (libs == "" .and. whizard%options%default_lib /= "") then
           allocate (lib_entry)
           call lib_entry%init (whizard%options%default_lib)
           call whizard%global%add_prclib (lib_entry)
           call msg_message ("Preloaded library: " // &
                char (whizard%options%default_lib))
        end if
     SCAN_LIBS: do while (libs /= "")
        call split (libs, library_name, " ")
        if (library_name /= "") then
           allocate (lib_entry)
           call lib_entry%init (library_name)
           call whizard%global%add_prclib (lib_entry)
           call msg_message ("Preloaded library: " // char (library_name))
        end if
     end do SCAN_LIBS
   end subroutine whizard_preload_library
 
 @ %def whizard_preload_library
 @
 \subsection{Initialization and finalization (old version)}
 These procedures initialize and finalize global variables.  Most of
 them are collected in the [[global]] data record located here, the
 others are syntax tables located in various modules, which do not
 change during program execution.  Furthermore, there is a global model
 list and a global process store, which get filled during program
 execution but are finalized here.
 
 During initialization, we can preload a default model and initialize a
 default library for setting up processes.  The default library is
 loaded if requested by the setup.  Further libraries can be loaded as
 specified by command-line flags.
 @ Initialize/finalize the syntax tables used by WHIZARD:
 <<WHIZARD: public>>=
   public :: init_syntax_tables
   public :: final_syntax_tables
 <<WHIZARD: procedures>>=
   subroutine init_syntax_tables ()
     call syntax_model_file_init ()
     call syntax_phs_forest_init ()
     call syntax_pexpr_init ()
     call syntax_slha_init ()
     call syntax_cmd_list_init ()
   end subroutine init_syntax_tables
 
   subroutine final_syntax_tables ()
     call syntax_model_file_final ()
     call syntax_phs_forest_final ()
     call syntax_pexpr_final ()
     call syntax_slha_final ()
     call syntax_cmd_list_final ()
   end subroutine final_syntax_tables
 
 @ %def init_syntax_tables
 @ %def final_syntax_tables
 @ Write the syntax tables to external files.
 <<WHIZARD: public>>=
   public :: write_syntax_tables
 <<WHIZARD: procedures>>=
   subroutine write_syntax_tables ()
     integer :: unit
     character(*), parameter :: file_model = "whizard.model_file.syntax"
     character(*), parameter :: file_phs = "whizard.phase_space_file.syntax"
     character(*), parameter :: file_pexpr = "whizard.prt_expressions.syntax"
     character(*), parameter :: file_slha = "whizard.slha.syntax"
     character(*), parameter :: file_sindarin = "whizard.sindarin.syntax"
     unit = free_unit ()
     print *, "Writing file '" // file_model // "'"
     open (unit=unit, file=file_model, status="replace", action="write")
     write (unit, "(A)")  VERSION_STRING
     write (unit, "(A)")  "Syntax definition file: " // file_model
     call syntax_model_file_write (unit)
     close (unit)
     print *, "Writing file '" // file_phs // "'"
     open (unit=unit, file=file_phs, status="replace", action="write")
     write (unit, "(A)")  VERSION_STRING
     write (unit, "(A)")  "Syntax definition file: " // file_phs
     call syntax_phs_forest_write (unit)
     close (unit)
     print *, "Writing file '" // file_pexpr // "'"
     open (unit=unit, file=file_pexpr, status="replace", action="write")
     write (unit, "(A)")  VERSION_STRING
     write (unit, "(A)")  "Syntax definition file: " // file_pexpr
     call syntax_pexpr_write (unit)
     close (unit)
     print *, "Writing file '" // file_slha // "'"
     open (unit=unit, file=file_slha, status="replace", action="write")
     write (unit, "(A)")  VERSION_STRING
     write (unit, "(A)")  "Syntax definition file: " // file_slha
     call syntax_slha_write (unit)
     close (unit)
     print *, "Writing file '" // file_sindarin // "'"
     open (unit=unit, file=file_sindarin, status="replace", action="write")
     write (unit, "(A)")  VERSION_STRING
     write (unit, "(A)")  "Syntax definition file: " // file_sindarin
     call syntax_cmd_list_write (unit)
     close (unit)
   end subroutine write_syntax_tables
 
 @ %def write_syntax_tables
 @
 \subsection{Execute command lists}
 Process commands given on the command line, stored as an [[ifile]].  The whole
 input is read, compiled and executed as a whole.
 <<WHIZARD: whizard: TBP>>=
   procedure :: process_ifile => whizard_process_ifile
 <<WHIZARD: procedures>>=
   subroutine whizard_process_ifile (whizard, ifile, quit, quit_code)
     class(whizard_t), intent(inout), target :: whizard
     type(ifile_t), intent(in) :: ifile
     logical, intent(out) :: quit
     integer, intent(out) :: quit_code
     type(lexer_t), target :: lexer
     type(stream_t), target :: stream
     call msg_message ("Reading commands given on the command line")
     call lexer_init_cmd_list (lexer)
     call stream_init (stream, ifile)
     call whizard%process_stream (stream, lexer, quit, quit_code)
     call stream_final (stream)
     call lexer_final (lexer)
   end subroutine whizard_process_ifile
 
 @ %def whizard_process_ifile
 @ Process standard input as a command list.  The whole input is read,
 compiled and executed as a whole.
 <<WHIZARD: whizard: TBP>>=
   procedure :: process_stdin => whizard_process_stdin
 <<WHIZARD: procedures>>=
   subroutine whizard_process_stdin (whizard, quit, quit_code)
     class(whizard_t), intent(inout), target :: whizard
     logical, intent(out) :: quit
     integer, intent(out) :: quit_code
     type(lexer_t), target :: lexer
     type(stream_t), target :: stream
     call msg_message ("Reading commands from standard input")
     call lexer_init_cmd_list (lexer)
     call stream_init (stream, 5)
     call whizard%process_stream (stream, lexer, quit, quit_code)
     call stream_final (stream)
     call lexer_final (lexer)
   end subroutine whizard_process_stdin
 
 @ %def whizard_process_stdin
 @ Process a file as a command list.
 <<WHIZARD: whizard: TBP>>=
   procedure :: process_file => whizard_process_file
 <<WHIZARD: procedures>>=
   subroutine whizard_process_file (whizard, file, quit, quit_code)
     class(whizard_t), intent(inout), target :: whizard
     type(string_t), intent(in) :: file
     logical, intent(out) :: quit
     integer, intent(out) :: quit_code
     type(lexer_t), target :: lexer
     type(stream_t), target :: stream
     logical :: exist
     call msg_message ("Reading commands from file '" // char (file) // "'")
     inquire (file=char(file), exist=exist)
     if (exist) then
        call lexer_init_cmd_list (lexer)
        call stream_init (stream, char (file))
        call whizard%process_stream (stream, lexer, quit, quit_code)
        call stream_final (stream)
        call lexer_final (lexer)
     else
        call msg_error ("File '" // char (file) // "' not found")
     end if
   end subroutine whizard_process_file
 
 @ %def whizard_process_file
 @
 <<WHIZARD: whizard: TBP>>=
   procedure :: process_stream => whizard_process_stream
 <<WHIZARD: procedures>>=
   subroutine whizard_process_stream (whizard, stream, lexer, quit, quit_code)
     class(whizard_t), intent(inout), target :: whizard
     type(stream_t), intent(inout), target :: stream
     type(lexer_t), intent(inout), target :: lexer
     logical, intent(out) :: quit
     integer, intent(out) :: quit_code
     type(parse_tree_t), pointer :: parse_tree
     type(command_list_t), target :: command_list
     call lexer_assign_stream (lexer, stream)
     call whizard%pt_stack%push (parse_tree)
     call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
     if (associated (parse_tree%get_root_ptr ())) then
        whizard%global%lexer => lexer
        call command_list%compile (parse_tree%get_root_ptr (), &
             whizard%global)
     end if
     call whizard%global%activate ()
     call command_list%execute (whizard%global)
     call command_list%final ()
     quit = whizard%global%quit
     quit_code = whizard%global%quit_code
   end subroutine whizard_process_stream
 
 @ %def whizard_process_stream
 @
 \subsection{The WHIZARD shell}
 This procedure implements interactive mode.  One line is processed at
 a time.
 <<WHIZARD: whizard: TBP>>=
   procedure :: shell => whizard_shell
 <<WHIZARD: procedures>>=
   subroutine whizard_shell (whizard, quit_code)
     class(whizard_t), intent(inout), target :: whizard
     integer, intent(out) :: quit_code
     type(lexer_t), target :: lexer
     type(stream_t), target :: stream
     type(string_t) :: prompt1
     type(string_t) :: prompt2
     type(string_t) :: input
     type(string_t) :: extra
     integer :: last
     integer :: iostat
     logical :: mask_tmp
     logical :: quit
     call msg_message ("Launching interactive shell")
     call lexer_init_cmd_list (lexer)
     prompt1 = "whish? "
     prompt2 = "     > "
     COMMAND_LOOP: do
        call put (6, prompt1)
        call get (5, input, iostat=iostat)
        if (iostat > 0 .or. iostat == EOF) exit COMMAND_LOOP
        CONTINUE_INPUT: do
           last = len_trim (input)
           if (extract (input, last, last) /= BACKSLASH)  exit CONTINUE_INPUT
           call put (6, prompt2)
           call get (5, extra, iostat=iostat)
           if (iostat > 0) exit COMMAND_LOOP
           input = replace (input, last, extra)
        end do CONTINUE_INPUT
        call stream_init (stream, input)
        mask_tmp = mask_fatal_errors
        mask_fatal_errors = .true.
        call whizard%process_stream (stream, lexer, quit, quit_code)
        msg_count = 0
        mask_fatal_errors = mask_tmp
        call stream_final (stream)
        if (quit)  exit COMMAND_LOOP
     end do COMMAND_LOOP
     print *
     call lexer_final (lexer)
   end subroutine whizard_shell
 
 @ %def whizard_shell
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Tools for the command line}
 
 We don't intent to be very smart here, but this module provides a few
 small tools that simplify dealing with the command line.
 <<[[cmdline_options.f90]]>>=
 <<File header>>
 
 module cmdline_options
 
 <<Use strings>>
   use diagnostics
 
 <<Standard module head>>
 
   public :: init_options
   public :: no_option_value
   public :: get_option_value
 
 <<Main: cmdline arg len declaration>>
 
   abstract interface
      subroutine msg
      end subroutine msg
   end interface
 
   procedure (msg), pointer :: print_usage => null ()
 
 contains
 
   subroutine init_options (usage_msg)
     procedure (msg) :: usage_msg
     print_usage => usage_msg
   end subroutine init_options
 
   subroutine no_option_value (option, value)
     type(string_t), intent(in) :: option, value
     if (value /= "") then
        call msg_error (" Option '" // char (option) // "' should have no value")
     end if
   end subroutine no_option_value
 
   function get_option_value (i, option, value) result (string)
     type(string_t) :: string
     integer, intent(inout) :: i
     type(string_t), intent(in) :: option
     type(string_t), intent(in), optional :: value
     character(CMDLINE_ARG_LEN) :: arg_value
     integer :: arg_len, arg_status
     logical :: has_value
     if (present (value)) then
        has_value = value /= ""
     else
        has_value = .false.
     end if
     if (has_value) then
        string = value
     else
        i = i + 1
        call get_command_argument (i, arg_value, arg_len, arg_status)
        select case (arg_status)
        case (0)
        case (-1)
           call msg_error (" Option value truncated: '" // arg_value // "'")
        case default
           call print_usage ()
           call msg_fatal (" Option '" // char (option) // "' needs a value")
        end select
        select case (arg_value(1:1))
        case ("-")
           call print_usage ()
           call msg_fatal (" Option '" // char (option) // "' needs a value")
        end select
        string = trim (arg_value)
     end if
   end function get_option_value
 
 end module cmdline_options
 
 @ %def init_options
 @ %def no_option_value
 @ %def get_option_value
 @ %def cmdline_options
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Query Feature Support}
 This module accesses the various optional features (modules) that
 WHIZARD can support and repors on their availability.
 <<[[features.f90]]>>=
 module features
 
   use string_utils, only: lower_case
   use system_dependencies, only: WHIZARD_VERSION
 <<Features: dependencies>>
 
 <<Standard module head>>
 
 <<Features: public>>
 
 contains
 
 <<Features: procedures>>
 
 end module features
 @ %def features
 @
 \subsection{Output}
 <<Features: public>>=
   public :: print_features
 <<Features: procedures>>=
   subroutine print_features ()
     print "(A)", "WHIZARD " // WHIZARD_VERSION
     print "(A)", "Build configuration:"
   <<Features: config>>
     print "(A)", "Optional features available in this build:"
   <<Features: print>>
   end subroutine print_features
 
 @ %def print_features
 @
 \subsection{Query function}
 <<Features: procedures>>=
   subroutine check (feature, recognized, result, help)
     character(*), intent(in) :: feature
     logical, intent(out) :: recognized
     character(*), intent(out) :: result, help
     recognized = .true.
     result = "no"
     select case (lower_case (trim (feature)))
   <<Features: cases>>
     case default
        recognized = .false.
     end select
   end subroutine check
 
 @ %def check
 @ Print this result:
 <<Features: procedures>>=
   subroutine print_check (feature)
     character(*), intent(in) :: feature
     character(16) :: f
     logical :: recognized
     character(10) :: result
     character(48) :: help
     call check (feature, recognized, result, help)
     if (.not. recognized) then
        result = "unknown"
        help = ""
     end if
     f = feature
     print "(2x,A,1x,A,'(',A,')')", f, result, trim (help)
   end subroutine print_check
 
 @ %def print_check
 @
 \subsection{Basic configuration}
 <<Features: config>>=
   call print_check ("precision")
 <<Features: dependencies>>=
   use kinds, only: default
 <<Features: cases>>=
   case ("precision")
      write (result, "(I0)")  precision (1._default)
      help = "significant decimals of real/complex numbers"
 @
 \subsection{Optional features case by case}
 <<Features: print>>=
   call print_check ("OpenMP")
 <<Features: dependencies>>=
   use system_dependencies, only: openmp_is_active
 <<Features: cases>>=
   case ("openmp")
      if (openmp_is_active ()) then
         result = "yes"
      end if
      help = "OpenMP parallel execution"
 @
 <<Features: print>>=
   call print_check ("GoSam")
 <<Features: dependencies>>=
   use system_dependencies, only: GOSAM_AVAILABLE
 <<Features: cases>>=
   case ("gosam")
      if (GOSAM_AVAILABLE) then
         result = "yes"
      end if
      help = "external NLO matrix element provider"
 @
 <<Features: print>>=
   call print_check ("OpenLoops")
 <<Features: dependencies>>=
   use system_dependencies, only: OPENLOOPS_AVAILABLE
 <<Features: cases>>=
   case ("openloops")
      if (OPENLOOPS_AVAILABLE) then
         result = "yes"
      end if
      help = "external NLO matrix element provider"
 @
 <<Features: print>>=
   call print_check ("Recola")
 <<Features: dependencies>>=
   use system_dependencies, only: RECOLA_AVAILABLE
 <<Features: cases>>=
   case ("recola")
      if (RECOLA_AVAILABLE) then
         result = "yes"
      end if
      help = "external NLO matrix element provider"
 @
 <<Features: print>>=
   call print_check ("LHAPDF")
 <<Features: dependencies>>=
   use system_dependencies, only: LHAPDF5_AVAILABLE
   use system_dependencies, only: LHAPDF6_AVAILABLE
 <<Features: cases>>=
   case ("lhapdf")
      if (LHAPDF5_AVAILABLE) then
         result = "v5"
      else if (LHAPDF6_AVAILABLE) then
         result = "v6"
      end if
      help = "PDF library"
 @
 <<Features: print>>=
   call print_check ("HOPPET")
 <<Features: dependencies>>=
   use system_dependencies, only: HOPPET_AVAILABLE
 <<Features: cases>>=
   case ("hoppet")
      if (HOPPET_AVAILABLE) then
         result = "yes"
      end if
      help = "PDF evolution package"
 @
 <<Features: print>>=
   call print_check ("fastjet")
 <<Features: dependencies>>=
   use jets, only: fastjet_available
 <<Features: cases>>=
   case ("fastjet")
      if (fastjet_available ()) then
         result = "yes"
      end if
      help = "jet-clustering package"
 @
 <<Features: print>>=
   call print_check ("Pythia6")
 <<Features: dependencies>>=
   use system_dependencies, only: PYTHIA6_AVAILABLE
 <<Features: cases>>=
   case ("pythia6")
      if (PYTHIA6_AVAILABLE) then
         result = "yes"
      end if
      help = "direct access for shower/hadronization"
 @
 <<Features: print>>=
   call print_check ("Pythia8")
 <<Features: dependencies>>=
   use system_dependencies, only: PYTHIA8_AVAILABLE
 <<Features: cases>>=
   case ("pythia8")
      if (PYTHIA8_AVAILABLE) then
         result = "yes"
      end if
      help = "direct access for shower/hadronization"
 @
 <<Features: print>>=
   call print_check ("StdHEP")
 <<Features: cases>>=
   case ("stdhep")
      result = "yes"
      help = "event I/O format"
 @
 <<Features: print>>=
   call print_check ("HepMC")
 <<Features: dependencies>>=
   use hepmc_interface, only: hepmc_is_available
 <<Features: cases>>=
   case ("hepmc")
      if (hepmc_is_available ()) then
         result = "yes"
      end if
      help = "event I/O format"
 @
 <<Features: print>>=
   call print_check ("LCIO")
 <<Features: dependencies>>=
   use lcio_interface, only: lcio_is_available
 <<Features: cases>>=
   case ("lcio")
      if (lcio_is_available ()) then
         result = "yes"
      end if
      help = "event I/O format"
 @
 <<Features: print>>=
   call print_check ("MetaPost")
 <<Features: dependencies>>=
   use system_dependencies, only: EVENT_ANALYSIS
 <<Features: cases>>=
   case ("metapost")
      result = EVENT_ANALYSIS
      help = "graphical event analysis via LaTeX/MetaPost"
 @
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Driver program}
 The main program handles command options, initializes the environment,
 and runs WHIZARD in a particular mode (interactive, file, standard
 input).
 
 This is also used in the C interface:
 <<Main: cmdline arg len declaration>>=
   integer, parameter :: CMDLINE_ARG_LEN = 1000
 @ %def CMDLINE_ARG_LEN
 @
 The actual main program:
 <<[[main.f90]]>>=
 <<File header>>
 
 program main
 
 <<Use strings>>
   use system_dependencies
   use diagnostics
   use ifiles
   use os_interface
   use rt_data, only: show_description_of_string, show_tex_descriptions
   use whizard
 
   use cmdline_options
   use features
 
 <<Use mpi f08>>
 
   implicit none
 
 <<Main: cmdline arg len declaration>>
 
 !!! (WK 02/2016) Interface for the separate external routine below
   interface
      subroutine print_usage ()
      end subroutine print_usage
   end interface
 
 ! Main program variable declarations
   character(CMDLINE_ARG_LEN) :: arg
   character(2) :: option
   type(string_t) :: long_option, value
   integer :: i, j, arg_len, arg_status
   logical :: look_for_options
   logical :: interactive
   logical :: banner
   type(string_t) :: job_id, files, this, model, default_lib, library, libraries
   type(string_t) :: logfile, query_string
   logical :: user_code_enable = .false.
   integer :: n_user_src = 0, n_user_lib = 0
   type(string_t) :: user_src, user_lib, user_target
   type(paths_t) :: paths
   type(string_t) :: pack_arg, unpack_arg
   type(string_t), dimension(:), allocatable :: pack_args, unpack_args
   type(string_t), dimension(:), allocatable :: tmp_strings
   logical :: rebuild_library, rebuild_user
   logical :: rebuild_phs, rebuild_grids, rebuild_events
   logical :: recompile_library
   type(ifile_t) :: commands
   type(string_t) :: command
 
   type(whizard_options_t), allocatable :: options
   type(whizard_t), allocatable, target :: whizard_instance
 
   ! Exit status
   logical :: quit = .false.
   integer :: quit_code = 0
 
   ! Initial values
   look_for_options = .true.
   interactive = .false.
   job_id = ""
   files = ""
   model = "SM"
   default_lib = "default_lib"
   library = ""
   libraries = ""
   banner = .true.
   logging = .true.
   msg_level = RESULT
   logfile = "whizard.log"
   user_src = ""
   user_lib = ""
   user_target = ""
   rebuild_library = .false.
   rebuild_user = .false.
   rebuild_phs = .false.
   rebuild_grids = .false.
   rebuild_events = .false.
   recompile_library = .false.
   call paths_init (paths)
 
 <<Main: MPI init>>
 
   ! Read and process options
   call init_options (print_usage)
   i = 0
   SCAN_CMDLINE: do
      i = i + 1
      call get_command_argument (i, arg, arg_len, arg_status)
      select case (arg_status)
      case (0)
      case (-1)
         call msg_error (" Command argument truncated: '" // arg // "'")
      case default
         exit SCAN_CMDLINE
      end select
      if (look_for_options) then
         select case (arg(1:2))
         case ("--")
            value = trim (arg)
            call split (value, long_option, "=")
            select case (char (long_option))
            case ("--version")
               call no_option_value (long_option, value)
               call print_version (); stop
            case ("--help")
               call no_option_value (long_option, value)
               call print_usage (); stop
            case ("--prefix")
               paths%prefix = get_option_value (i, long_option, value)
               cycle scan_cmdline
            case ("--exec-prefix")
               paths%exec_prefix = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--bindir")
               paths%bindir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--libdir")
               paths%libdir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--includedir")
               paths%includedir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--datarootdir")
               paths%datarootdir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--libtool")
               paths%libtool = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--lhapdfdir")
               paths%lhapdfdir = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--check")
               call print_usage ()
               call msg_fatal ("Option --check not supported &
                    &(for unit tests, run whizard_ut instead)")
            case ("--show-config")
               call no_option_value (long_option, value)
               call print_features (); stop
            case ("--execute")
               command = get_option_value (i, long_option, value)
               call ifile_append (commands, command)
               cycle SCAN_CMDLINE
            case ("--interactive")
               call no_option_value (long_option, value)
               interactive = .true.
               cycle SCAN_CMDLINE
            case ("--job-id")
               job_id = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--library")
               library = get_option_value (i, long_option, value)
               libraries = libraries // " " // library
               cycle SCAN_CMDLINE
            case ("--no-library")
               call no_option_value (long_option, value)
               default_lib = ""
               library = ""
               libraries = ""
               cycle SCAN_CMDLINE
            case ("--localprefix")
               paths%localprefix = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--logfile")
               logfile = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--no-logfile")
               call no_option_value (long_option, value)
               logfile = ""
               cycle SCAN_CMDLINE
            case ("--logging")
               call no_option_value (long_option, value)
               logging = .true.
               cycle SCAN_CMDLINE
            case ("--no-logging")
               call no_option_value (long_option, value)
               logging = .false.
               cycle SCAN_CMDLINE
            case ("--query")
               call no_option_value (long_option, value)
               query_string = get_option_value (i, long_option, value)
               call show_description_of_string (query_string)
               call exit (0)
            case ("--generate-variables-tex")
               call no_option_value (long_option, value)
               call show_tex_descriptions ()
               call exit (0)
            case ("--debug")
               call no_option_value (long_option, value)
               call set_debug_levels (get_option_value (i, long_option, value))
               cycle SCAN_CMDLINE
            case ("--debug2")
               call no_option_value (long_option, value)
               call set_debug2_levels (get_option_value (i, long_option, value))
               cycle SCAN_CMDLINE
            case ("--single-event")
               call no_option_value (long_option, value)
               single_event = .true.
               cycle SCAN_CMDLINE
            case ("--banner")
               call no_option_value (long_option, value)
               banner = .true.
               cycle SCAN_CMDLINE
            case ("--no-banner")
               call no_option_value (long_option, value)
               banner = .false.
               cycle SCAN_CMDLINE
            case ("--pack")
               pack_arg = get_option_value (i, long_option, value)
               if (allocated (pack_args)) then
                  call move_alloc (from=pack_args, to=tmp_strings)
                  allocate (pack_args (size (tmp_strings)+1))
                  pack_args(1:size(tmp_strings)) = tmp_strings
               else
                  allocate (pack_args (1))
               end if
               pack_args(size(pack_args)) = pack_arg
               cycle SCAN_CMDLINE
            case ("--unpack")
               unpack_arg = get_option_value (i, long_option, value)
               if (allocated (unpack_args)) then
                  call move_alloc (from=unpack_args, to=tmp_strings)
                  allocate (unpack_args (size (tmp_strings)+1))
                  unpack_args(1:size(tmp_strings)) = tmp_strings
               else
                  allocate (unpack_args (1))
               end if
               unpack_args(size(unpack_args)) = unpack_arg
               cycle SCAN_CMDLINE
            case ("--model")
               model = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--no-model")
               call no_option_value (long_option, value)
               model = ""
               cycle SCAN_CMDLINE
            case ("--rebuild")
               call no_option_value (long_option, value)
               rebuild_library = .true.
               rebuild_user = .true.
               rebuild_phs = .true.
               rebuild_grids = .true.
               rebuild_events = .true.
               cycle SCAN_CMDLINE
            case ("--no-rebuild")
               call no_option_value (long_option, value)
               rebuild_library = .false.
               recompile_library = .false.
               rebuild_user = .false.
               rebuild_phs = .false.
               rebuild_grids = .false.
               rebuild_events = .false.
               cycle SCAN_CMDLINE
            case ("--rebuild-library")
               call no_option_value (long_option, value)
               rebuild_library = .true.
               cycle SCAN_CMDLINE
            case ("--rebuild-user")
               call no_option_value (long_option, value)
               rebuild_user = .true.
               cycle SCAN_CMDLINE
            case ("--rebuild-phase-space")
               call no_option_value (long_option, value)
               rebuild_phs = .true.
               cycle SCAN_CMDLINE
            case ("--rebuild-grids")
               call no_option_value (long_option, value)
               rebuild_grids = .true.
               cycle SCAN_CMDLINE
            case ("--rebuild-events")
               call no_option_value (long_option, value)
               rebuild_events = .true.
               cycle SCAN_CMDLINE
            case ("--recompile")
               call no_option_value (long_option, value)
               recompile_library = .true.
               rebuild_grids = .true.
               cycle SCAN_CMDLINE
            case ("--user")
               user_code_enable = .true.
               cycle SCAN_CMDLINE
            case ("--user-src")
               if (user_src == "") then
                  user_src = get_option_value (i, long_option, value)
               else
                  user_src = user_src // " " &
                       // get_option_value (i, long_option, value)
               end if
               n_user_src = n_user_src + 1
               cycle SCAN_CMDLINE
            case ("--user-lib")
               if (user_lib == "") then
                  user_lib = get_option_value (i, long_option, value)
               else
                  user_lib = user_lib // " " &
                       // get_option_value (i, long_option, value)
               end if
               n_user_lib = n_user_lib + 1
               cycle SCAN_CMDLINE
            case ("--user-target")
               user_target = get_option_value (i, long_option, value)
               cycle SCAN_CMDLINE
            case ("--write-syntax-tables")
               call no_option_value (long_option, value)
         call init_syntax_tables ()
               call write_syntax_tables ()
               call final_syntax_tables ()
               stop
               cycle SCAN_CMDLINE
            case default
               call print_usage ()
               call msg_fatal ("Option '" // trim (arg) // "' not recognized")
            end select
         end select
         select case (arg(1:1))
         case ("-")
            j = 1
            if (len_trim (arg) == 1) then
               look_for_options = .false.
            else
               SCAN_SHORT_OPTIONS: do
                  j = j + 1
                  if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS
                  option = "-" // arg(j:j)
                  select case (option)
                  case ("-V")
                     call print_version (); stop
                  case ("-?", "-h")
                     call print_usage (); stop
                  case ("-e")
                     command = get_option_value (i, var_str (option))
                     call ifile_append (commands, command)
                     cycle SCAN_CMDLINE
                  case ("-i")
                     interactive = .true.
                     cycle SCAN_SHORT_OPTIONS
                  case ("-J")
                     if (j == len_trim (arg)) then
                        job_id = get_option_value (i, var_str (option))
                     else
                        job_id = trim (arg(j+1:))
                     end if
                     cycle SCAN_CMDLINE
                  case ("-l")
                     if (j == len_trim (arg)) then
                        library = get_option_value (i, var_str (option))
                     else
                        library = trim (arg(j+1:))
                     end if
                     libraries = libraries // " " // library
                     cycle SCAN_CMDLINE
                  case ("-L")
                     if (j == len_trim (arg)) then
                        logfile = get_option_value (i, var_str (option))
                     else
                        logfile = trim (arg(j+1:))
                     end if
                     cycle SCAN_CMDLINE
                  case ("-m")
                     if (j < len_trim (arg))  call msg_fatal &
                          ("Option '" // option // "' needs a value")
                     model = get_option_value (i, var_str (option))
                     cycle SCAN_CMDLINE
                  case ("-q")
                     call no_option_value (long_option, value)
                     query_string = get_option_value (i, long_option, value)
                     call show_description_of_string (query_string)
                     call exit (0)
                  case ("-r")
                     rebuild_library = .true.
                     rebuild_user = .true.
                     rebuild_phs = .true.
                     rebuild_grids = .true.
                     rebuild_events = .true.
                     cycle SCAN_SHORT_OPTIONS
                  case ("-u")
                     user_code_enable = .true.
                     cycle SCAN_SHORT_OPTIONS
                  case default
                     call print_usage ()
                     call msg_fatal &
                          ("Option '" // option // "' not recognized")
                  end select
               end do SCAN_SHORT_OPTIONS
            end if
         case default
            files = files // " " // trim (arg)
         end select
      else
         files = files // " " // trim (arg)
      end if
   end do SCAN_CMDLINE
 
   ! Overall initialization
   if (logfile /= "")  call logfile_init (logfile)
   if (banner)  call msg_banner ()
 
    allocate (options)
    allocate (whizard_instance)
 
    if (.not. quit) then
 
       ! Set options and initialize the whizard object
       options%job_id = job_id
       if (allocated (pack_args)) then
          options%pack_args = pack_args
       else
          allocate (options%pack_args (0))
       end if
       if (allocated (unpack_args)) then
          options%unpack_args = unpack_args
       else
          allocate (options%unpack_args (0))
       end if
       options%preload_model = model
       options%default_lib = default_lib
       options%preload_libraries = libraries
       options%rebuild_library = rebuild_library
       options%recompile_library = recompile_library
       options%rebuild_user = rebuild_user
       options%rebuild_phs = rebuild_phs
       options%rebuild_grids = rebuild_grids
       options%rebuild_events = rebuild_events
     <<Main: dependent flags>>
 
       call whizard_instance%init (options, paths, logfile)
 
       call mask_term_signals ()
 
    end if
 
    ! Run commands given on the command line
    if (.not. quit .and. ifile_get_length (commands) > 0) then
       call whizard_instance%process_ifile (commands, quit, quit_code)
    end if
 
    if (.not. quit) then
       ! Process commands from standard input
       if (.not. interactive .and. files == "") then
          call whizard_instance%process_stdin (quit, quit_code)
 
          ! ... or process commands from file
       else
          files = trim (adjustl (files))
          SCAN_FILES: do while (files /= "")
             call split (files, this, " ")
             call whizard_instance%process_file (this, quit, quit_code)
             if (quit)  exit SCAN_FILES
          end do SCAN_FILES
 
       end if
   end if
 
   ! Enter an interactive shell if requested
   if (.not. quit .and. interactive) then
      call whizard_instance%shell (quit_code)
   end if
 
   ! Overall finalization
   call ifile_final (commands)
 
   deallocate (options)
 
   call whizard_instance%final ()
   deallocate (whizard_instance)
 
 <<Main: MPI finalize>>
 
   call terminate_now_if_signal ()
   call release_term_signals ()
   call msg_terminate (quit_code = quit_code)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 contains
 
   subroutine print_version ()
     print "(A)", "WHIZARD " // WHIZARD_VERSION
     print "(A)", "Copyright (C) 1999-2018 Wolfgang Kilian, Thorsten Ohl, Juergen Reuter"
     print "(A)", "              ---------------------------------------                "
     print "(A)", "This is free software; see the source for copying conditions.  There is NO"
     print "(A)", "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
     print *
   end subroutine print_version
 
 end program main
 
 !!! (WK 02/2016)
 !!! Separate subroutine, because this becomes a procedure pointer target
 !!! Internal procedures as targets are not supported by some compilers.
 
   subroutine print_usage ()
     use system_dependencies, only: WHIZARD_VERSION
     print "(A)", "WHIZARD " // WHIZARD_VERSION
     print "(A)", "Usage: whizard [OPTIONS] [FILE]"
     print "(A)", "Run WHIZARD with the command list taken from FILE(s)"
     print "(A)", "Options for resetting default directories and tools" &
             // "(GNU naming conventions):"
     print "(A)", "    --prefix DIR"
     print "(A)", "    --exec-prefix DIR"
     print "(A)", "    --bindir DIR"
     print "(A)", "    --libdir DIR"
     print "(A)", "    --includedir DIR"
     print "(A)", "    --datarootdir DIR"
     print "(A)", "    --libtool LOCAL_LIBTOOL"
     print "(A)", "    --lhapdfdir DIR   (PDF sets directory)"
     print "(A)", "Other options:"
     print "(A)", "-h, --help            display this help and exit"
     print "(A)", "    --banner          display banner at startup (default)"
     print "(A)", "    --debug AREA      switch on debug output for AREA."
     print "(A)", "                      AREA can be one of Whizard's src dirs or 'all'"
     print "(A)", "    --debug2 AREA     switch on more verbose debug output for AREA."
     print "(A)", "    --single-event    only compute one phase-space point (for debugging)"
     print "(A)", "-e, --execute CMDS    execute SINDARIN CMDS before reading FILE(s)"
     print "(A)", "-i, --interactive     run interactively after reading FILE(s)"
     print "(A)", "-J, --job-id STRING   set job ID to STRING (default: empty)"
     print "(A)", "-l, --library LIB     preload process library NAME"
     print "(A)", "    --localprefix DIR"
     print "(A)", "                      search in DIR for local models (default: ~/.whizard)"
     print "(A)", "-L, --logfile FILE    write log to FILE (default: 'whizard.log'"
     print "(A)", "    --logging         switch on logging at startup (default)"
     print "(A)", "-m, --model NAME      preload model NAME (default: 'SM')"
     print "(A)", "    --no-banner       do not display banner at startup"
     print "(A)", "    --no-library      do not preload process library"
     print "(A)", "    --no-logfile      do not write a logfile"
     print "(A)", "    --no-logging      switch off logging at startup"
     print "(A)", "    --no-model        do not preload a model"
     print "(A)", "    --no-rebuild      do not force rebuilding"
     print "(A)", "    --pack DIR        tar/gzip DIR after job"
     print "(A)", "-q, --query VARIABLE  display documentation of VARIABLE"
     print "(A)", "-r, --rebuild         rebuild all (see below)"
     print "(A)", "    --rebuild-library"
     print "(A)", "                      rebuild process code library"
     print "(A)", "    --rebuild-user    rebuild user-provided code"
     print "(A)", "    --rebuild-phase-space"
     print "(A)", "                      rebuild phase-space configuration"
     print "(A)", "    --rebuild-grids   rebuild integration grids"
     print "(A)", "    --rebuild-events  rebuild event samples"
     print "(A)", "    --recompile       recompile process code"
     print "(A)", "    --show-config     show build-time configuration"
     print "(A)", "    --unpack FILE     untar/gunzip FILE before job"
     print "(A)", "-u  --user            enable user-provided code"
     print "(A)", "    --user-src FILE   user-provided source file"
     print "(A)", "    --user-lib FILE   user-provided library file"
     print "(A)", "    --user-target BN  basename of created user library (default: user)"
     print "(A)", "-V, --version         output version information and exit"
     print "(A)", "    --write-syntax-tables"
     print "(A)", "                      write the internal syntax tables to files and exit"
     print "(A)", "-                     further options are taken as filenames"
     print *
     print "(A)", "With no FILE, read standard input."
   end subroutine print_usage
 
 @ %def main
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Driver program for the unit tests}
 This is a variant of the above main program that takes unit-test names
 as command-line options and runs those tests.
 <<[[main_ut.f90]]>>=
 <<File header>>
 
 program main_ut
 
 <<Use strings>>
   use unit_tests
   use io_units
   use system_dependencies
   use diagnostics
   use os_interface
 
   use cmdline_options
 
   use model_testbed !NODEP!
 <<Use mpi f08>>
 
 <<Main: use tests>>
 
   implicit none
 
 <<Main: cmdline arg len declaration>>
 
 !!! (WK 02/2016) Interface for the separate external routine below
   interface
      subroutine print_usage ()
      end subroutine print_usage
   end interface
 
   ! Main program variable declarations
   character(CMDLINE_ARG_LEN) :: arg
   character(2) :: option
   type(string_t) :: long_option, value
   integer :: i, j, arg_len, arg_status
   logical :: look_for_options
   logical :: banner
   type(string_t) :: check, checks
   type(test_results_t) :: test_results
   logical :: success
 
   ! Exit status
   integer :: quit_code = 0
 
   ! Initial values
   look_for_options = .true.
   banner = .true.
   logging = .false.
   msg_level = RESULT
   check = ""
   checks = ""
 
 <<Main: MPI init>>
 
   ! Read and process options
   call init_options (print_usage)
   i = 0
   SCAN_CMDLINE: do
      i = i + 1
      call get_command_argument (i, arg, arg_len, arg_status)
      select case (arg_status)
      case (0)
      case (-1)
         call msg_error (" Command argument truncated: '" // arg // "'")
      case default
         exit SCAN_CMDLINE
      end select
      if (look_for_options) then
         select case (arg(1:2))
         case ("--")
            value = trim (arg)
            call split (value, long_option, "=")
            select case (char (long_option))
            case ("--version")
               call no_option_value (long_option, value)
               call print_version (); stop
            case ("--help")
               call no_option_value (long_option, value)
               call print_usage (); stop
            case ("--banner")
               call no_option_value (long_option, value)
               banner = .true.
               cycle SCAN_CMDLINE
            case ("--no-banner")
               call no_option_value (long_option, value)
               banner = .false.
               cycle SCAN_CMDLINE
            case ("--check")
               check = get_option_value (i, long_option, value)
               checks = checks // " " // check
               cycle SCAN_CMDLINE
            case ("--debug")
               call no_option_value (long_option, value)
               call set_debug_levels (get_option_value (i, long_option, value))
               cycle SCAN_CMDLINE
            case ("--debug2")
               call no_option_value (long_option, value)
               call set_debug2_levels (get_option_value (i, long_option, value))
               cycle SCAN_CMDLINE
            case default
               call print_usage ()
               call msg_fatal ("Option '" // trim (arg) // "' not recognized")
            end select
         end select
         select case (arg(1:1))
         case ("-")
            j = 1
            if (len_trim (arg) == 1) then
               look_for_options = .false.
            else
               SCAN_SHORT_OPTIONS: do
                  j = j + 1
                  if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS
                  option = "-" // arg(j:j)
                  select case (option)
                  case ("-V")
                     call print_version (); stop
                  case ("-?", "-h")
                     call print_usage (); stop
                  case default
                     call print_usage ()
                     call msg_fatal &
                          ("Option '" // option // "' not recognized")
                  end select
               end do SCAN_SHORT_OPTIONS
            end if
         case default
            call print_usage ()
            call msg_fatal ("Option '" // trim (arg) // "' not recognized")
         end select
      else
         call print_usage ()
         call msg_fatal ("Option '" // trim (arg) // "' not recognized")
      end if
   end do SCAN_CMDLINE
 
   ! Overall initialization
   if (banner)  call msg_banner ()
 
    ! Run any self-checks (and no commands)
    if (checks /= "") then
       checks = trim (adjustl (checks))
       RUN_CHECKS: do while (checks /= "")
          call split (checks, check, " ")
          call whizard_check (check, test_results)
       end do RUN_CHECKS
       call test_results%wrapup (6, success)
       if (.not. success)  quit_code = 7
    end if
 
  <<Main: MPI finalize>>
 
    call msg_terminate (quit_code = quit_code)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 contains
 
   subroutine print_version ()
     print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)"
     print "(A)", "Copyright (C) 1999-2018 Wolfgang Kilian, Thorsten Ohl, Juergen Reuter"
     print "(A)", "              ---------------------------------------                "
     print "(A)", "This is free software; see the source for copying conditions.  There is NO"
     print "(A)", "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
     print *
   end subroutine print_version
 
 <<Main: tests>>
 
 end program main_ut
 
 !!! (WK 02/2016)
 !!! Separate subroutine, because this becomes a procedure pointer target
 !!! Internal procedures as targets are not supported by some compilers.
 
   subroutine print_usage ()
     use system_dependencies, only: WHIZARD_VERSION
     print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)"
     print "(A)", "Usage: whizard_ut [OPTIONS] [FILE]"
     print "(A)", "Run WHIZARD unit tests as given on the command line"
     print "(A)", "Options:"
     print "(A)", "-h, --help            display this help and exit"
     print "(A)", "    --banner          display banner at startup (default)"
     print "(A)", "    --no-banner       do not display banner at startup"
     print "(A)", "    --debug AREA      switch on debug output for AREA."
     print "(A)", "                      AREA can be one of Whizard's src dirs or 'all'"
     print "(A)", "    --debug2 AREA     switch on more verbose debug output for AREA."
     print "(A)", "-V, --version         output version information and exit"
     print "(A)", "    --check TEST      run unit test TEST"
   end subroutine print_usage
 @ %def main_ut
 @
 <<Main: MPI init>>=
 @
 <<Main: MPI finalize>>=
 @
 @ MPI init.
 <<MPI: Main: MPI init>>=
   call MPI_init ()
 <<MPI: Main: MPI finalize>>=
   call MPI_finalize ()
 @ %def MPI_init MPI_finalize
 <<Main: dependent flags>>=
 @
 Every rebuild action is forbidden for the slave workers except
 [[rebuild_grids]], which is handled correctly inside the corresponding
 integration object.
 <<MPI: Main: dependent flags>>=
   if (.not. mpi_is_comm_master ()) then
     options%rebuild_library = .false.
     options%recompile_library = .false.
     options%rebuild_user = .false.
     options%rebuild_phs = .false.
     options%rebuild_events = .false.
   end if
 @
 \subsection{Self-tests}
 For those self-tests, we need some auxiliary routines that provide an
 enviroment.  The environment depends on things that are not available at the
 level of the module that we want to test.
 
 \subsubsection{Testbed for event I/O}
 This subroutine prepares a test process with a single event.  All objects are
 allocated via anonymous pointers, because we want to recover the pointers and
 delete the objects in a separate procedure.
 <<Main: tests>>=
   subroutine prepare_eio_test (event, unweighted, n_alt)
     use variables, only: var_list_t
     use model_data
     use process, only: process_t
     use instances, only: process_instance_t
     use processes_ut, only: prepare_test_process
     use event_base
     use events
 
     class(generic_event_t), intent(inout), pointer :: event
     logical, intent(in), optional :: unweighted
     integer, intent(in), optional :: n_alt
     type(model_data_t), pointer :: model
     type(var_list_t) :: var_list
     type(process_t), pointer :: proc
     type(process_instance_t), pointer :: process_instance
 
     allocate (model)
     call model%init_test ()
 
     allocate (proc)
     allocate (process_instance)
 
     call prepare_test_process (proc, process_instance, model)
     call process_instance%setup_event_data ()
 
     call model%final ()
     deallocate (model)
 
     allocate (event_t :: event)
     select type (event)
     type is (event_t)
        if (present (unweighted)) then
           call var_list%append_log (&
                var_str ("?unweighted"), unweighted, &
                intrinsic = .true.)
        else
           call var_list%append_log (&
                var_str ("?unweighted"), .true., &
                intrinsic = .true.)
        end if
        call var_list%append_string (&
             var_str ("$sample_normalization"), &
             var_str ("auto"), intrinsic = .true.)
        call event%basic_init (var_list, n_alt)
        call event%connect (process_instance, proc%get_model_ptr ())
        call var_list%final ()
     end select
 
   end subroutine prepare_eio_test
 
 @ %def prepare_eio_test_event
 @ Recover those pointers, finalize the objects and deallocate.
 <<Main: tests>>=
   subroutine cleanup_eio_test (event)
     use model_data
     use process, only: process_t
     use instances, only: process_instance_t
     use processes_ut, only: cleanup_test_process
     use event_base
     use events
 
     class(generic_event_t), intent(inout), pointer :: event
     type(process_t), pointer :: proc
     type(process_instance_t), pointer :: process_instance
 
     select type (event)
     type is (event_t)
        proc => event%get_process_ptr ()
        process_instance => event%get_process_instance_ptr ()
        call cleanup_test_process (proc, process_instance)
        deallocate (process_instance)
        deallocate (proc)
        call event%final ()
     end select
     deallocate (event)
 
   end subroutine cleanup_eio_test
 
 @ %def cleanup_eio_test_event
 @ Assign those procedures to appropriate pointers (module variables) in the
 [[eio_base]] module, so they can be called as if they were module procedures.
 <<Main: use tests>>=
   use eio_base_ut, only: eio_prepare_test
   use eio_base_ut, only: eio_cleanup_test
 <<Main: prepare testbed>>=
   eio_prepare_test => prepare_eio_test
   eio_cleanup_test => cleanup_eio_test
 @
 \subsubsection{Any Model}
 This procedure reads any model from file and, optionally, assigns a
 var-list pointer.
 <<Main: tests>>=
   subroutine prepare_whizard_model (model, name, vars)
   <<Use strings>>
     use os_interface
     use model_data
     use var_base
     use models
     class(model_data_t), intent(inout), pointer :: model
     type(string_t), intent(in) :: name
     class(vars_t), pointer, intent(out), optional :: vars
     type(os_data_t) :: os_data
     call syntax_model_file_init ()
     call os_data_init (os_data)
     allocate (model_t :: model)
     select type (model)
     type is (model_t)
        call model%read (name // ".mdl", os_data)
        if (present (vars)) then
           vars => model%get_var_list_ptr ()
        end if
     end select
   end subroutine prepare_whizard_model
 
 @ %def prepare_whizard_model
 @ Cleanup after use.  Includes deletion of the model-file syntax.
 <<Main: tests>>=
   subroutine cleanup_whizard_model (model)
     use model_data
     use models
     class(model_data_t), intent(inout), pointer :: model
     call model%final ()
     deallocate (model)
     call syntax_model_file_final ()
   end subroutine cleanup_whizard_model
 
 @ %def cleanup_whizard_model
 @ Assign those procedures to appropriate pointers (module variables) in the
 [[model_testbed]] module, so they can be called as if they were module
 procedures.
 <<Main: prepare testbed>>=
   prepare_model => prepare_whizard_model
   cleanup_model => cleanup_whizard_model
 @
 \subsubsection{Fallback model: hadrons}
 Some event format tests require the hadronic SM implementation, which
 has to be read from file.  We provide the functionality here, so the
 tests do not depend on model I/O.
 <<Main: tests>>=
   subroutine prepare_fallback_model (model)
     use model_data
     class(model_data_t), intent(inout), pointer :: model
     call prepare_whizard_model (model, var_str ("SM_hadrons"))
   end subroutine prepare_fallback_model
 
 @ %def prepare_fallback_model
 @ Assign those procedures to appropriate pointers (module variables) in the
 [[eio_base]] module, so they can be called as if they were module procedures.
 <<Main: use tests>>=
   use eio_base_ut, only: eio_prepare_fallback_model
   use eio_base_ut, only: eio_cleanup_fallback_model
 <<Main: prepare testbed>>=
   eio_prepare_fallback_model => prepare_fallback_model
   eio_cleanup_fallback_model => cleanup_model
 @
 \subsubsection{Access to the test random-number generator}
 This generator is not normally available for the dispatcher.  We assign an
 additional dispatch routine to the hook in the [[dispatch]] module
 which will be checked before the default rule.
 <<Main: use tests>>=
   use dispatch_rng, only: dispatch_rng_factory_extra
   use dispatch_rng_ut, only: dispatch_rng_factory_test
 <<Main: prepare testbed>>=
   dispatch_rng_factory_extra => dispatch_rng_factory_test
 @
 \subsubsection{Access to the test structure functions}
 These are not normally available for the dispatcher.  We assign an
 additional dispatch routine to the hook in the [[dispatch]] module
 which will be checked before the default rule.
 <<Main: use tests>>=
   use dispatch_beams, only: dispatch_sf_data_extra
   use dispatch_ut, only: dispatch_sf_data_test
 <<Main: prepare testbed>>=
   dispatch_sf_data_extra => dispatch_sf_data_test
 @
 \subsubsection{Procedure for Checking}
 This is for developers only, but needs a well-defined interface.
 <<Main: tests>>=
   subroutine whizard_check (check, results)
     type(string_t), intent(in) :: check
     type(test_results_t), intent(inout) :: results
     type(os_data_t) :: os_data
     integer :: u
     call os_data_init (os_data)
     u = free_unit ()
     open (u, file="whizard_check." // char (check) // ".log", &
          action="write", status="replace")
     call msg_message (repeat ('=', 76), 0)
     call msg_message ("Running self-test: " // char (check), 0)
     call msg_message (repeat ('-', 76), 0)
   <<Main: prepare testbed>>
     select case (char (check))
   <<Main: test cases>>
     case ("all")
      <<Main: all tests>>
     case default
        call msg_fatal ("Self-test '" // char (check) // "' not implemented.")
     end select
     close (u)
   end subroutine whizard_check
 
 @ %def whizard_check
 @
 \subsection{Unit test references}
 \subsubsection{Formats}
 <<Main: use tests>>=
   use formats_ut, only: format_test
 <<Main: test cases>>=
   case ("formats")
      call format_test (u, results)
 <<Main: all tests>>=
   call format_test (u, results)
 @
 \subsubsection{MD5}
 <<Main: use tests>>=
   use md5_ut, only: md5_test
 <<Main: test cases>>=
   case ("md5")
      call md5_test (u, results)
 <<Main: all tests>>=
   call md5_test (u, results)
 @
 \subsubsection{OS Interface}
 <<Main: use tests>>=
   use os_interface_ut, only: os_interface_test
 <<Main: test cases>>=
   case ("os_interface")
      call os_interface_test (u, results)
 <<Main: all tests>>=
   call os_interface_test (u, results)
 @
 \subsubsection{Sorting}
 <<Main: use tests>>=
   use sorting_ut, only: sorting_test
 <<Main: test cases>>=
   case ("sorting")
      call sorting_test (u, results)
 <<Main: all tests>>=
   call sorting_test (u, results)
 @
 \subsubsection{Grids}
 <<Main: use tests>>=
   use grids_ut, only: grids_test
 <<Main: test cases>>=
   case ("grids")
      call grids_test (u, results)
 <<Main: all tests>>=
   call grids_test (u, results)
 @
 \subsubsection{Solver}
 <<Main: use tests>>=
   use solver_ut, only: solver_test
 <<Main: test cases>>=
   case ("solver")
      call solver_test (u, results)
 <<Main: all tests>>=
   call solver_test (u, results)
 @
 \subsubsection{CPU Time}
 <<Main: use tests>>=
   use cputime_ut, only: cputime_test
 <<Main: test cases>>=
   case ("cputime")
      call cputime_test (u, results)
 <<Main: all tests>>=
   call cputime_test (u, results)
 @
 \subsubsection{SM QCD}
 <<Main: use tests>>=
   use sm_qcd_ut, only: sm_qcd_test
 <<Main: test cases>>=
   case ("sm_qcd")
      call sm_qcd_test (u, results)
 <<Main: all tests>>=
   call sm_qcd_test (u, results)
 @
 \subsubsection{SM physics}
 <<Main: use tests>>=
   use sm_physics_ut, only: sm_physics_test
 <<Main: test cases>>=
   case ("sm_physics")
      call sm_physics_test (u, results)
 <<Main: all tests>>=
   call sm_physics_test (u, results)
 @
 \subsubsection{Lexers}
 <<Main: use tests>>=
   use lexers_ut, only: lexer_test
 <<Main: test cases>>=
   case ("lexers")
      call lexer_test (u, results)
 <<Main: all tests>>=
   call lexer_test (u, results)
 @
 \subsubsection{Parser}
 <<Main: use tests>>=
   use parser_ut, only: parse_test
 <<Main: test cases>>=
   case ("parser")
      call parse_test (u, results)
 <<Main: all tests>>=
   call parse_test (u, results)
 @
 \subsubsection{XML}
 <<Main: use tests>>=
   use xml_ut, only: xml_test
 <<Main: test cases>>=
   case ("xml")
      call xml_test (u, results)
 <<Main: all tests>>=
   call xml_test (u, results)
 @
 \subsubsection{Colors}
 <<Main: use tests>>=
   use colors_ut, only: color_test
 <<Main: test cases>>=
   case ("colors")
      call color_test (u, results)
 <<Main: all tests>>=
   call color_test (u, results)
 @
 \subsubsection{State matrices}
 <<Main: use tests>>=
   use state_matrices_ut, only: state_matrix_test
 <<Main: test cases>>=
   case ("state_matrices")
      call state_matrix_test (u, results)
 <<Main: all tests>>=
   call state_matrix_test (u, results)
 @
 \subsubsection{Analysis}
 <<Main: use tests>>=
   use analysis_ut, only: analysis_test
 <<Main: test cases>>=
   case ("analysis")
      call analysis_test (u, results)
 <<Main: all tests>>=
   call analysis_test (u, results)
 @
 \subsubsection{Particles}
 <<Main: use tests>>=
   use particles_ut, only: particles_test
 <<Main: test cases>>=
   case ("particles")
      call particles_test (u, results)
 <<Main: all tests>>=
   call particles_test (u, results)
 @
 \subsubsection{Models}
 <<Main: use tests>>=
   use models_ut, only: models_test
 <<Main: test cases>>=
   case ("models")
      call models_test (u, results)
 <<Main: all tests>>=
   call models_test (u, results)
 @
 \subsubsection{Auto Components}
 <<Main: use tests>>=
   use auto_components_ut, only: auto_components_test
 <<Main: test cases>>=
   case ("auto_components")
      call auto_components_test (u, results)
 <<Main: all tests>>=
   call auto_components_test (u, results)
 @
 \subsubsection{Radiation Generator}
 <<Main: use tests>>=
   use radiation_generator_ut, only: radiation_generator_test
 <<Main: test cases>>=
   case ("radiation_generator")
      call radiation_generator_test (u, results)
 <<Main: all tests>>=
   call radiation_generator_test (u, results)
 @
 \subsection{BLHA}
 <<Main: use tests>>=
   use blha_ut, only: blha_test
 <<Main: test cases>>=
   case ("blha")
      call blha_test (u, results)
 <<Main: all tests>>=
   call blha_test (u, results)
 @
 \subsubsection{Evaluators}
 <<Main: use tests>>=
   use evaluators_ut, only: evaluator_test
 <<Main: test cases>>=
   case ("evaluators")
      call evaluator_test (u, results)
 <<Main: all tests>>=
   call evaluator_test (u, results)
 @
 \subsubsection{Expressions}
 <<Main: use tests>>=
   use eval_trees_ut, only: expressions_test
 <<Main: test cases>>=
   case ("expressions")
      call expressions_test (u, results)
 <<Main: all tests>>=
   call expressions_test (u, results)
 @
 \subsubsection{Resonances}
 <<Main: use tests>>=
   use resonances_ut, only: resonances_test
 <<Main: test cases>>=
   case ("resonances")
      call resonances_test (u, results)
 <<Main: all tests>>=
   call resonances_test (u, results)
 @
 \subsubsection{PHS Trees}
 <<Main: use tests>>=
   use phs_trees_ut, only: phs_trees_test
 <<Main: test cases>>=
   case ("phs_trees")
      call phs_trees_test (u, results)
 <<Main: all tests>>=
   call phs_trees_test (u, results)
 @
 \subsubsection{PHS Forests}
 <<Main: use tests>>=
   use phs_forests_ut, only: phs_forests_test
 <<Main: test cases>>=
   case ("phs_forests")
      call phs_forests_test (u, results)
 <<Main: all tests>>=
   call phs_forests_test (u, results)
 @
 \subsubsection{Beams}
 <<Main: use tests>>=
   use beams_ut, only: beams_test
 <<Main: test cases>>=
   case ("beams")
      call beams_test (u, results)
 <<Main: all tests>>=
   call beams_test (u, results)
 @
 \subsubsection{$su(N)$ Algebra}
 <<Main: use tests>>=
   use su_algebra_ut, only: su_algebra_test
 <<Main: test cases>>=
   case ("su_algebra")
      call su_algebra_test (u, results)
 <<Main: all tests>>=
   call su_algebra_test (u, results)
 @
 \subsubsection{Bloch Vectors}
 <<Main: use tests>>=
   use bloch_vectors_ut, only: bloch_vectors_test
 <<Main: test cases>>=
   case ("bloch_vectors")
      call bloch_vectors_test (u, results)
 <<Main: all tests>>=
   call bloch_vectors_test (u, results)
 @
 \subsubsection{Polarizations}
 <<Main: use tests>>=
   use polarizations_ut, only: polarizations_test
 <<Main: test cases>>=
   case ("polarizations")
      call polarizations_test (u, results)
 <<Main: all tests>>=
   call polarizations_test (u, results)
 @
 \subsubsection{SF Aux}
 <<Main: use tests>>=
   use sf_aux_ut, only: sf_aux_test
 <<Main: test cases>>=
   case ("sf_aux")
      call sf_aux_test (u, results)
 <<Main: all tests>>=
   call sf_aux_test (u, results)
 @
 \subsubsection{SF Mappings}
 <<Main: use tests>>=
   use sf_mappings_ut, only: sf_mappings_test
 <<Main: test cases>>=
   case ("sf_mappings")
      call sf_mappings_test (u, results)
 <<Main: all tests>>=
   call sf_mappings_test (u, results)
 @
 \subsubsection{SF Base}
 <<Main: use tests>>=
   use sf_base_ut, only: sf_base_test
 <<Main: test cases>>=
   case ("sf_base")
      call sf_base_test (u, results)
 <<Main: all tests>>=
   call sf_base_test (u, results)
 @
 \subsubsection{SF PDF Builtin}
 <<Main: use tests>>=
   use sf_pdf_builtin_ut, only: sf_pdf_builtin_test
 <<Main: test cases>>=
   case ("sf_pdf_builtin")
      call sf_pdf_builtin_test (u, results)
 <<Main: all tests>>=
   call sf_pdf_builtin_test (u, results)
 @
 \subsubsection{SF LHAPDF}
 <<Main: use tests>>=
   use sf_lhapdf_ut, only: sf_lhapdf_test
 <<Main: test cases>>=
   case ("sf_lhapdf")
      call sf_lhapdf_test (u, results)
 <<Main: all tests>>=
   call sf_lhapdf_test (u, results)
 @
 \subsubsection{SF ISR}
 <<Main: use tests>>=
   use sf_isr_ut, only: sf_isr_test
 <<Main: test cases>>=
   case ("sf_isr")
      call sf_isr_test (u, results)
 <<Main: all tests>>=
   call sf_isr_test (u, results)
 @
 \subsubsection{SF EPA}
 <<Main: use tests>>=
   use sf_epa_ut, only: sf_epa_test
 <<Main: test cases>>=
   case ("sf_epa")
      call sf_epa_test (u, results)
 <<Main: all tests>>=
   call sf_epa_test (u, results)
 @
 \subsubsection{SF EWA}
 <<Main: use tests>>=
   use sf_ewa_ut, only: sf_ewa_test
 <<Main: test cases>>=
   case ("sf_ewa")
      call sf_ewa_test (u, results)
 <<Main: all tests>>=
   call sf_ewa_test (u, results)
 @
 \subsubsection{SF CIRCE1}
 <<Main: use tests>>=
   use sf_circe1_ut, only: sf_circe1_test
 <<Main: test cases>>=
   case ("sf_circe1")
      call sf_circe1_test (u, results)
 <<Main: all tests>>=
   call sf_circe1_test (u, results)
 @
 \subsubsection{SF CIRCE2}
 <<Main: use tests>>=
   use sf_circe2_ut, only: sf_circe2_test
 <<Main: test cases>>=
   case ("sf_circe2")
      call sf_circe2_test (u, results)
 <<Main: all tests>>=
   call sf_circe2_test (u, results)
 @
 \subsubsection{SF Gaussian}
 <<Main: use tests>>=
   use sf_gaussian_ut, only: sf_gaussian_test
 <<Main: test cases>>=
   case ("sf_gaussian")
      call sf_gaussian_test (u, results)
 <<Main: all tests>>=
   call sf_gaussian_test (u, results)
 @
 \subsubsection{SF Beam Events}
 <<Main: use tests>>=
   use sf_beam_events_ut, only: sf_beam_events_test
 <<Main: test cases>>=
   case ("sf_beam_events")
      call sf_beam_events_test (u, results)
 <<Main: all tests>>=
   call sf_beam_events_test (u, results)
 @
 \subsubsection{SF EScan}
 <<Main: use tests>>=
   use sf_escan_ut, only: sf_escan_test
 <<Main: test cases>>=
   case ("sf_escan")
      call sf_escan_test (u, results)
 <<Main: all tests>>=
   call sf_escan_test (u, results)
 @
 \subsubsection{PHS Base}
 <<Main: use tests>>=
   use phs_base_ut, only: phs_base_test
 <<Main: test cases>>=
   case ("phs_base")
      call phs_base_test (u, results)
 <<Main: all tests>>=
   call phs_base_test (u, results)
 @
 \subsubsection{PHS None}
 <<Main: use tests>>=
   use phs_none_ut, only: phs_none_test
 <<Main: test cases>>=
   case ("phs_none")
      call phs_none_test (u, results)
 <<Main: all tests>>=
   call phs_none_test (u, results)
 @
 \subsubsection{PHS Single}
 <<Main: use tests>>=
   use phs_single_ut, only: phs_single_test
 <<Main: test cases>>=
   case ("phs_single")
      call phs_single_test (u, results)
 <<Main: all tests>>=
   call phs_single_test (u, results)
 @
+\subsubsection{PHS Rambo}
+<<Main: use tests>>=
+  use phs_rambo_ut, only: phs_rambo_test
+<<Main: test cases>>=
+  case ("phs_rambo")
+     call phs_rambo_test (u, results)
+<<Main: all tests>>=
+  call phs_rambo_test (u, results)
+@
 \subsubsection{PHS Wood}
 <<Main: use tests>>=
   use phs_wood_ut, only: phs_wood_test
   use phs_wood_ut, only: phs_wood_vis_test
 <<Main: test cases>>=
   case ("phs_wood")
      call phs_wood_test (u, results)
   case ("phs_wood_vis")
      call phs_wood_vis_test (u, results)
 <<Main: all tests>>=
   call phs_wood_test (u, results)
   call phs_wood_vis_test (u, results)
 @
 \subsubsection{PHS FKS Generator}
 <<Main: use tests>>=
   use phs_fks_ut, only: phs_fks_generator_test
 <<Main: test cases>>=
   case ("phs_fks_generator")
      call phs_fks_generator_test (u, results)
 <<Main: all tests>>=
   call phs_fks_generator_test (u, results)
 @
 \subsubsection{FKS regions}
 <<Main: use tests>>=
   use fks_regions_ut, only: fks_regions_test
 <<Main: test cases>>=
   case ("fks_regions")
      call fks_regions_test (u, results)
 <<Main: all tests>>=
   call fks_regions_test (u, results)
 @
 \subsubsection{Real subtraction}
 <<Main: use tests>>=
   use real_subtraction_ut, only: real_subtraction_test
 <<Main: test cases>>=
   case ("real_subtraction")
      call real_subtraction_test (u, results)
 <<Main: all tests>>=
   call real_subtraction_test (u, results)
 @
 \subsubsection{RECOLA}
 <<Main: use tests>>=
   use prc_recola_ut, only: prc_recola_test
 <<Main: test cases>>=
   case ("prc_recola")
      call prc_recola_test (u, results)
 <<Main: all tests>>=
   call prc_recola_test (u, results)
 @
 \subsubsection{RNG Base}
 <<Main: use tests>>=
   use rng_base_ut, only: rng_base_test
 <<Main: test cases>>=
   case ("rng_base")
      call rng_base_test (u, results)
 <<Main: all tests>>=
   call rng_base_test (u, results)
 @
 \subsubsection{RNG Tao}
 <<Main: use tests>>=
   use rng_tao_ut, only: rng_tao_test
 <<Main: test cases>>=
   case ("rng_tao")
      call rng_tao_test (u, results)
 <<Main: all tests>>=
   call rng_tao_test (u, results)
 @
 \subsubsection{RNG Stream}
 <<Main: use tests>>=
   use rng_stream_ut, only: rng_stream_test
 <<Main: test cases>>=
   case ("rng_stream")
      call rng_stream_test (u, results)
 <<Main: all tests>>=
   call rng_stream_test (u, results)
 @
 \subsubsection{Selectors}
 <<Main: use tests>>=
   use selectors_ut, only: selectors_test
 <<Main: test cases>>=
   case ("selectors")
      call selectors_test (u, results)
 <<Main: all tests>>=
   call selectors_test (u, results)
 @
 \subsubsection{VEGAS}
 <<Main: use tests>>=
   use vegas_ut, only: vegas_test
 <<Main: test cases>>=
   case ("vegas")
      call vegas_test (u, results)
 <<Main: all tests>>=
   call vegas_test (u, results)
 @
 \subsubsection{VAMP2}
 <<Main: use tests>>=
   use vamp2_ut, only: vamp2_test
 <<Main: test cases>>=
   case ("vamp2")
      call vamp2_test (u, results)
 <<Main: all tests>>=
   call vamp2_test (u, results)
 @
 \subsubsection{MCI Base}
 <<Main: use tests>>=
   use mci_base_ut, only: mci_base_test
 <<Main: test cases>>=
   case ("mci_base")
      call mci_base_test (u, results)
 <<Main: all tests>>=
   call mci_base_test (u, results)
 @
 \subsubsection{MCI None}
 <<Main: use tests>>=
   use mci_none_ut, only: mci_none_test
 <<Main: test cases>>=
   case ("mci_none")
      call mci_none_test (u, results)
 <<Main: all tests>>=
   call mci_none_test (u, results)
 @
 \subsubsection{MCI Midpoint}
 <<Main: use tests>>=
   use mci_midpoint_ut, only: mci_midpoint_test
 <<Main: test cases>>=
   case ("mci_midpoint")
      call mci_midpoint_test (u, results)
 <<Main: all tests>>=
   call mci_midpoint_test (u, results)
 @
 \subsubsection{MCI VAMP}
 <<Main: use tests>>=
   use mci_vamp_ut, only: mci_vamp_test
 <<Main: test cases>>=
   case ("mci_vamp")
      call mci_vamp_test (u, results)
 <<Main: all tests>>=
   call mci_vamp_test (u, results)
 @
 \subsubsection{MCI VAMP2}
 <<Main: use tests>>=
   use mci_vamp2_ut, only: mci_vamp2_test
 <<Main: test cases>>=
   case ("mci_vamp2")
      call mci_vamp2_test (u, results)
 <<Main: all tests>>=
   call mci_vamp2_test (u, results)
 @
 \subsubsection{Integration Results}
 <<Main: use tests>>=
   use integration_results_ut, only: integration_results_test
 <<Main: test cases>>=
   case ("integration_results")
      call integration_results_test (u, results)
 <<Main: all tests>>=
   call integration_results_test (u, results)
 @
 \subsubsection{PRCLib Interfaces}
 <<Main: use tests>>=
   use prclib_interfaces_ut, only: prclib_interfaces_test
 <<Main: test cases>>=
   case ("prclib_interfaces")
      call prclib_interfaces_test (u, results)
 <<Main: all tests>>=
   call prclib_interfaces_test (u, results)
 @
 \subsubsection{Particle Specifiers}
 <<Main: use tests>>=
   use particle_specifiers_ut, only: particle_specifiers_test
 <<Main: test cases>>=
   case ("particle_specifiers")
      call particle_specifiers_test (u, results)
 <<Main: all tests>>=
   call particle_specifiers_test (u, results)
 @
 \subsubsection{Process Libraries}
 <<Main: use tests>>=
   use process_libraries_ut, only: process_libraries_test
 <<Main: test cases>>=
   case ("process_libraries")
      call process_libraries_test (u, results)
 <<Main: all tests>>=
   call process_libraries_test (u, results)
 @
 \subsubsection{PRCLib Stacks}
 <<Main: use tests>>=
   use prclib_stacks_ut, only: prclib_stacks_test
 <<Main: test cases>>=
   case ("prclib_stacks")
      call prclib_stacks_test (u, results)
 <<Main: all tests>>=
   call prclib_stacks_test (u, results)
 @
 \subsubsection{HepMC}
 <<Main: use tests>>=
   use hepmc_interface_ut, only: hepmc_interface_test
 <<Main: test cases>>=
   case ("hepmc")
      call hepmc_interface_test (u, results)
 <<Main: all tests>>=
   call hepmc_interface_test (u, results)
 @
 \subsubsection{LCIO}
 <<Main: use tests>>=
   use lcio_interface_ut, only: lcio_interface_test
 <<Main: test cases>>=
   case ("lcio")
      call lcio_interface_test (u, results)
 <<Main: all tests>>=
   call lcio_interface_test (u, results)
 @
 \subsubsection{Jets}
 <<Main: use tests>>=
   use jets_ut, only: jets_test
 <<Main: test cases>>=
   case ("jets")
      call jets_test (u, results)
 <<Main: all tests>>=
   call jets_test (u, results)
 @
 \subsubsection{PDG Arrays}
 <<Main: use tests>>=
   use pdg_arrays_ut, only: pdg_arrays_test
 <<Main: test cases>>=
   case ("pdg_arrays")
      call pdg_arrays_test (u, results)
 <<Main: all tests>>=
   call pdg_arrays_test (u, results)
 @
 \subsubsection{interactions}
 <<Main: use tests>>=
   use interactions_ut, only: interaction_test
 <<Main: test cases>>=
   case ("interactions")
      call interaction_test (u, results)
 <<Main: all tests>>=
   call interaction_test (u, results)
 @
 \subsubsection{SLHA}
 <<Main: use tests>>=
   use slha_interface_ut, only: slha_test
 <<Main: test cases>>=
   case ("slha_interface")
      call slha_test (u, results)
 <<Main: all tests>>=
   call slha_test (u, results)
 @
 \subsubsection{Cascades}
 <<Main: use tests>>=
   use cascades_ut, only: cascades_test
 <<Main: test cases>>=
   case ("cascades")
      call cascades_test (u, results)
 <<Main: all tests>>=
   call cascades_test (u, results)
 @
 \subsubsection{Cascades2 lexer}
 <<Main: use tests>>=
   use cascades2_lexer_ut, only: cascades2_lexer_test
 <<Main: test cases>>=
   case ("cascades2_lexer")
      call cascades2_lexer_test (u, results)
 <<Main: all tests>>=
   call cascades2_lexer_test (u, results)
 @
 \subsubsection{Cascades2}
 <<Main: use tests>>=
   use cascades2_ut, only: cascades2_test
 <<Main: test cases>>=
   case ("cascades2")
      call cascades2_test (u, results)
 <<Main: all tests>>=
   call cascades2_test (u, results)
 @
 \subsubsection{PRC Test}
 <<Main: use tests>>=
   use prc_test_ut, only: prc_test_test
 <<Main: test cases>>=
   case ("prc_test")
      call prc_test_test (u, results)
 <<Main: all tests>>=
   call prc_test_test (u, results)
 @
 \subsubsection{PRC Template ME}
 <<Main: use tests>>=
   use prc_template_me_ut, only: prc_template_me_test
 <<Main: test cases>>=
   case ("prc_template_me")
      call prc_template_me_test (u, results)
 <<Main: all tests>>=
   call prc_template_me_test (u, results)
 @
 \subsubsection{PRC OMega}
 <<Main: use tests>>=
   use prc_omega_ut, only: prc_omega_test
   use prc_omega_ut, only: prc_omega_diags_test
 <<Main: test cases>>=
   case ("prc_omega")
      call prc_omega_test (u, results)
   case ("prc_omega_diags")
      call prc_omega_diags_test (u, results)
 <<Main: all tests>>=
   call prc_omega_test (u, results)
   call prc_omega_diags_test (u, results)
 @
 \subsubsection{Parton States}
 <<Main: use tests>>=
   use parton_states_ut, only: parton_states_test
 <<Main: test cases>>=
   case ("parton_states")
      call parton_states_test (u, results)
 <<Main: all tests>>=
   call parton_states_test (u, results)
 @
 \subsubsection{Subevt Expr}
 <<Main: use tests>>=
   use expr_tests_ut, only: subevt_expr_test
 <<Main: test cases>>=
   case ("subevt_expr")
      call subevt_expr_test (u, results)
 <<Main: all tests>>=
   call subevt_expr_test (u, results)
 @
 \subsubsection{Processes}
 <<Main: use tests>>=
   use processes_ut, only: processes_test
 <<Main: test cases>>=
   case ("processes")
      call processes_test (u, results)
 <<Main: all tests>>=
   call processes_test (u, results)
 @
 \subsubsection{Process Stacks}
 <<Main: use tests>>=
   use process_stacks_ut, only: process_stacks_test
 <<Main: test cases>>=
   case ("process_stacks")
      call process_stacks_test (u, results)
 <<Main: all tests>>=
   call process_stacks_test (u, results)
 @
 \subsubsection{Event Transforms}
 <<Main: use tests>>=
   use event_transforms_ut, only: event_transforms_test
 <<Main: test cases>>=
   case ("event_transforms")
      call event_transforms_test (u, results)
 <<Main: all tests>>=
   call event_transforms_test (u, results)
 @
 \subsubsection{Resonance Insertion Transform}
 <<Main: use tests>>=
   use resonance_insertion_ut, only: resonance_insertion_test
 <<Main: test cases>>=
   case ("resonance_insertion")
      call resonance_insertion_test (u, results)
 <<Main: all tests>>=
   call resonance_insertion_test (u, results)
 @
 \subsubsection{Recoil Kinematics}
 <<Main: use tests>>=
   use recoil_kinematics_ut, only: recoil_kinematics_test
 <<Main: test cases>>=
   case ("recoil_kinematics")
      call recoil_kinematics_test (u, results)
 <<Main: all tests>>=
   call recoil_kinematics_test (u, results)
 @
 \subsubsection{ISR Handler}
 <<Main: use tests>>=
   use isr_epa_handler_ut, only: isr_handler_test
 <<Main: test cases>>=
   case ("isr_handler")
      call isr_handler_test (u, results)
 <<Main: all tests>>=
   call isr_handler_test (u, results)
 @
 \subsubsection{EPA Handler}
 <<Main: use tests>>=
   use isr_epa_handler_ut, only: epa_handler_test
 <<Main: test cases>>=
   case ("epa_handler")
      call epa_handler_test (u, results)
 <<Main: all tests>>=
   call epa_handler_test (u, results)
 @
 \subsubsection{Decays}
 <<Main: use tests>>=
   use decays_ut, only: decays_test
 <<Main: test cases>>=
   case ("decays")
      call decays_test (u, results)
 <<Main: all tests>>=
   call decays_test (u, results)
 @
 \subsubsection{Shower}
 <<Main: use tests>>=
   use shower_ut, only: shower_test
 <<Main: test cases>>=
   case ("shower")
      call shower_test (u, results)
 <<Main: all tests>>=
   call shower_test (u, results)
 @
 \subsubsection{Events}
 <<Main: use tests>>=
   use events_ut, only: events_test
 <<Main: test cases>>=
   case ("events")
      call events_test (u, results)
 <<Main: all tests>>=
   call events_test (u, results)
 @
 \subsubsection{HEP Events}
 <<Main: use tests>>=
   use hep_events_ut, only: hep_events_test
 <<Main: test cases>>=
   case ("hep_events")
      call hep_events_test (u, results)
 <<Main: all tests>>=
   call hep_events_test (u, results)
 @
 \subsubsection{EIO Data}
 <<Main: use tests>>=
   use eio_data_ut, only: eio_data_test
 <<Main: test cases>>=
   case ("eio_data")
      call eio_data_test (u, results)
 <<Main: all tests>>=
   call eio_data_test (u, results)
 @
 \subsubsection{EIO Base}
 <<Main: use tests>>=
   use eio_base_ut, only: eio_base_test
 <<Main: test cases>>=
   case ("eio_base")
      call eio_base_test (u, results)
 <<Main: all tests>>=
   call eio_base_test (u, results)
 @
 \subsubsection{EIO Direct}
 <<Main: use tests>>=
   use eio_direct_ut, only: eio_direct_test
 <<Main: test cases>>=
   case ("eio_direct")
      call eio_direct_test (u, results)
 <<Main: all tests>>=
   call eio_direct_test (u, results)
 @
 \subsubsection{EIO Raw}
 <<Main: use tests>>=
   use eio_raw_ut, only: eio_raw_test
 <<Main: test cases>>=
   case ("eio_raw")
      call eio_raw_test (u, results)
 <<Main: all tests>>=
   call eio_raw_test (u, results)
 @
 \subsubsection{EIO Checkpoints}
 <<Main: use tests>>=
   use eio_checkpoints_ut, only: eio_checkpoints_test
 <<Main: test cases>>=
   case ("eio_checkpoints")
      call eio_checkpoints_test (u, results)
 <<Main: all tests>>=
   call eio_checkpoints_test (u, results)
 @
 \subsubsection{EIO LHEF}
 <<Main: use tests>>=
   use eio_lhef_ut, only: eio_lhef_test
 <<Main: test cases>>=
   case ("eio_lhef")
      call eio_lhef_test (u, results)
 <<Main: all tests>>=
   call eio_lhef_test (u, results)
 @
 \subsubsection{EIO HepMC}
 <<Main: use tests>>=
   use eio_hepmc_ut, only: eio_hepmc_test
 <<Main: test cases>>=
   case ("eio_hepmc")
      call eio_hepmc_test (u, results)
 <<Main: all tests>>=
   call eio_hepmc_test (u, results)
 @
 \subsubsection{EIO LCIO}
 <<Main: use tests>>=
   use eio_lcio_ut, only: eio_lcio_test
 <<Main: test cases>>=
   case ("eio_lcio")
      call eio_lcio_test (u, results)
 <<Main: all tests>>=
   call eio_lcio_test (u, results)
 @
 \subsubsection{EIO StdHEP}
 <<Main: use tests>>=
   use eio_stdhep_ut, only: eio_stdhep_test
 <<Main: test cases>>=
   case ("eio_stdhep")
      call eio_stdhep_test (u, results)
 <<Main: all tests>>=
   call eio_stdhep_test (u, results)
 @
 \subsubsection{EIO ASCII}
 <<Main: use tests>>=
   use eio_ascii_ut, only: eio_ascii_test
 <<Main: test cases>>=
   case ("eio_ascii")
      call eio_ascii_test (u, results)
 <<Main: all tests>>=
   call eio_ascii_test (u, results)
 @
 \subsubsection{EIO Weights}
 <<Main: use tests>>=
   use eio_weights_ut, only: eio_weights_test
 <<Main: test cases>>=
   case ("eio_weights")
      call eio_weights_test (u, results)
 <<Main: all tests>>=
   call eio_weights_test (u, results)
 @
 \subsubsection{EIO Dump}
 <<Main: use tests>>=
   use eio_dump_ut, only: eio_dump_test
 <<Main: test cases>>=
   case ("eio_dump")
      call eio_dump_test (u, results)
 <<Main: all tests>>=
   call eio_dump_test (u, results)
 @
 \subsubsection{Iterations}
 <<Main: use tests>>=
   use iterations_ut, only: iterations_test
 <<Main: test cases>>=
   case ("iterations")
      call iterations_test (u, results)
 <<Main: all tests>>=
   call iterations_test (u, results)
 @
 \subsubsection{Beam Structures}
 <<Main: use tests>>=
   use beam_structures_ut, only: beam_structures_test
 <<Main: test cases>>=
   case ("beam_structures")
      call beam_structures_test (u, results)
 <<Main: all tests>>=
   call beam_structures_test (u, results)
 @
 \subsubsection{RT Data}
 <<Main: use tests>>=
   use rt_data_ut, only: rt_data_test
 <<Main: test cases>>=
   case ("rt_data")
      call rt_data_test (u, results)
 <<Main: all tests>>=
   call rt_data_test (u, results)
 @
 \subsubsection{Dispatch}
 <<Main: use tests>>=
   use dispatch_ut, only: dispatch_test
 <<Main: test cases>>=
   case ("dispatch")
      call dispatch_test (u, results)
 <<Main: all tests>>=
   call dispatch_test (u, results)
 @
 \subsubsection{Dispatch RNG}
 <<Main: use tests>>=
   use dispatch_rng_ut, only: dispatch_rng_test
 <<Main: test cases>>=
   case ("dispatch_rng")
      call dispatch_rng_test (u, results)
 <<Main: all tests>>=
   call dispatch_rng_test (u, results)
 @
 \subsubsection{Dispatch MCI}
 <<Main: use tests>>=
   use dispatch_mci_ut, only: dispatch_mci_test
 <<Main: test cases>>=
   case ("dispatch_mci")
      call dispatch_mci_test (u, results)
 <<Main: all tests>>=
   call dispatch_mci_test (u, results)
 @
 \subsubsection{Dispatch PHS}
 <<Main: use tests>>=
   use dispatch_phs_ut, only: dispatch_phs_test
 <<Main: test cases>>=
   case ("dispatch_phs")
      call dispatch_phs_test (u, results)
 <<Main: all tests>>=
   call dispatch_phs_test (u, results)
 @
 \subsubsection{Dispatch transforms}
 <<Main: use tests>>=
   use dispatch_transforms_ut, only: dispatch_transforms_test
 <<Main: test cases>>=
   case ("dispatch_transforms")
      call dispatch_transforms_test (u, results)
 <<Main: all tests>>=
   call dispatch_transforms_test (u, results)
 @
 \subsubsection{Shower partons}
 <<Main: use tests>>=
   use shower_base_ut, only: shower_base_test
 <<Main: test cases>>=
   case ("shower_base")
      call shower_base_test (u, results)
 <<Main: all tests>>=
   call shower_base_test (u, results)
 @
 \subsubsection{Process Configurations}
 <<Main: use tests>>=
   use process_configurations_ut, only: process_configurations_test
 <<Main: test cases>>=
   case ("process_configurations")
      call process_configurations_test (u, results)
 <<Main: all tests>>=
   call process_configurations_test (u, results)
 @
 \subsubsection{Compilations}
 <<Main: use tests>>=
   use compilations_ut, only: compilations_test
   use compilations_ut, only: compilations_static_test
 <<Main: test cases>>=
   case ("compilations")
      call compilations_test (u, results)
   case ("compilations_static")
      call compilations_static_test (u, results)
 <<Main: all tests>>=
   call compilations_test (u, results)
   call compilations_static_test (u, results)
 @
 \subsubsection{Integrations}
 <<Main: use tests>>=
   use integrations_ut, only: integrations_test
   use integrations_ut, only: integrations_history_test
 <<Main: test cases>>=
   case ("integrations")
      call integrations_test (u, results)
   case ("integrations_history")
      call integrations_history_test (u, results)
 <<Main: all tests>>=
   call integrations_test (u, results)
   call integrations_history_test (u, results)
 @
 \subsubsection{Event Streams}
 <<Main: use tests>>=
   use event_streams_ut, only: event_streams_test
 <<Main: test cases>>=
   case ("event_streams")
      call event_streams_test (u, results)
 <<Main: all tests>>=
   call event_streams_test (u, results)
 @
 \subsubsection{Restricted Subprocesses}
 <<Main: use tests>>=
   use restricted_subprocesses_ut, only: restricted_subprocesses_test
 <<Main: test cases>>=
   case ("restricted_subprocesses")
      call restricted_subprocesses_test (u, results)
 <<Main: all tests>>=
   call restricted_subprocesses_test (u, results)
 @
 \subsubsection{Simulations}
 <<Main: use tests>>=
   use simulations_ut, only: simulations_test
 <<Main: test cases>>=
   case ("simulations")
      call simulations_test (u, results)
 <<Main: all tests>>=
   call simulations_test (u, results)
 @
 \subsubsection{Commands}
 <<Main: use tests>>=
   use commands_ut, only: commands_test
 <<Main: test cases>>=
   case ("commands")
      call commands_test (u, results)
 <<Main: all tests>>=
   call commands_test (u, results)
 @
 \subsubsection{$ttV$ formfactors}
 <<Main: use tests>>=
   use ttv_formfactors_ut, only: ttv_formfactors_test
 <<Main: test cases>>=
   case ("ttv_formfactors")
      call ttv_formfactors_test (u, results)
 <<Main: all tests>>=
   call ttv_formfactors_test (u, results)
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Whizard-C-Interface}
 <<[[whizard-c-interface.f90]]>>=
 <<File header>>
 
 <<Whizard-C-Interface: Internals>>
 <<Whizard-C-Interface: Init and Finalize>>
 <<Whizard-C-Interface: Interfaced Commads>>
 <<Whizard-C-Interface: HepMC>>
 
 @
 <<Whizard-C-Interface: Internals>>=
   subroutine c_whizard_convert_string (c_string, f_string)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     character(kind=c_char), intent(in) :: c_string(*)
     type(string_t), intent(inout) :: f_string
     character(len=1) :: dummy_char
     integer :: dummy_i = 1
 
     f_string = ""
     do
        if (c_string(dummy_i) == c_null_char) then
           exit
        else if (c_string(dummy_i) == c_new_line) then
           dummy_char = CHAR(13)
           f_string = f_string // dummy_char
           dummy_char = CHAR(10)
        else
           dummy_char = c_string (dummy_i)
        end if
        f_string = f_string // dummy_char
        dummy_i = dummy_i + 1
     end do
     dummy_i = 1
   end subroutine c_whizard_convert_string
 
   subroutine c_whizard_commands (w_c_instance, cmds)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
     use commands
     use diagnostics
     use lexers
     use models
     use parser
     use whizard
 
     type(c_ptr), intent(inout) :: w_c_instance
     type(whizard_t), pointer :: whizard_instance
     type(string_t) :: cmds
     type(parse_tree_t) :: parse_tree
     type(parse_node_t), pointer :: pn_root
     type(stream_t), target :: stream
     type(lexer_t) :: lexer
     type(command_list_t), target :: cmd_list
 
     call c_f_pointer (w_c_instance, whizard_instance)
     call lexer_init_cmd_list (lexer)
     call syntax_cmd_list_init ()
 
     call stream_init (stream, cmds)
     call lexer_assign_stream (lexer, stream)
     call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
     pn_root => parse_tree%get_root_ptr ()
 
     if (associated (pn_root)) then
        call cmd_list%compile (pn_root, whizard_instance%global)
     end if
     call whizard_instance%global%activate ()
     call cmd_list%execute (whizard_instance%global)
     call cmd_list%final ()
 
     call parse_tree_final (parse_tree)
     call stream_final (stream)
     call lexer_final (lexer)
     call syntax_cmd_list_final ()
   end subroutine c_whizard_commands
 
 @
 <<Whizard-C-Interface: Init and Finalize>>=
   subroutine c_whizard_init (w_c_instance) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
     use system_dependencies
     use diagnostics
     use ifiles
     use os_interface
     use whizard
 
     implicit none
 
   <<Main: cmdline arg len declaration>>
 
     type(c_ptr), intent(out) :: w_c_instance
     logical :: banner
     type(string_t) :: files, model, default_lib, library, libraries
 !     type(string_t) :: check, checks
     type(string_t) :: logfile
     type(string_t) :: user_src, user_lib
     type(paths_t) :: paths
     logical :: rebuild_library, rebuild_user
     logical :: rebuild_phs, rebuild_grids, rebuild_events
 
     type(whizard_options_t), allocatable :: options
     type(whizard_t), pointer :: whizard_instance
 
 
     ! Initial values
     files = ""
     model = "SM"
     default_lib = "default_lib"
     library = ""
     libraries = ""
     banner = .true.
     logging = .true.
     logfile = "whizard.log"
 !     check = ""
 !     checks = ""
     user_src = ""
     user_lib = ""
     rebuild_library = .false.
     rebuild_user = .false.
     rebuild_phs = .false.
     rebuild_grids = .false.
     rebuild_events = .false.
     call paths_init (paths)
 
     ! Overall initialization
     if (logfile /= "")  call logfile_init (logfile)
     call mask_term_signals ()
     if (banner)  call msg_banner ()
 
     ! Set options and initialize the whizard object
     allocate (options)
     options%preload_model = model
     options%default_lib = default_lib
     options%preload_libraries = libraries
     options%rebuild_library = rebuild_library
     options%rebuild_user = rebuild_user
     options%rebuild_phs = rebuild_phs
     options%rebuild_grids = rebuild_grids
     options%rebuild_events = rebuild_events
 
     allocate (whizard_instance)
     call whizard_instance%init (options, paths)
 
 !     if (checks /= "") then
 !        checks = trim (adjustl (checks))
 !        RUN_CHECKS: do while (checks /= "")
 !           call split (checks, check, " ")
 !           call whizard_check (check, test_results)
 !        end do RUN_CHECKS
 !        call test_results%wrapup (6, success)
 !        if (.not. success)  quit_code = 7
 !        quit = .true.
 !     end if
 
     w_c_instance = c_loc (whizard_instance)
 
   end subroutine c_whizard_init
 
   subroutine c_whizard_finalize (w_c_instance) bind(C)
     use, intrinsic :: iso_c_binding
     use system_dependencies
     use diagnostics
     use ifiles
     use os_interface
     use whizard
 
     type(c_ptr), intent(in) :: w_c_instance
     type(whizard_t), pointer :: whizard_instance
     integer :: quit_code = 0
 
     call c_f_pointer (w_c_instance, whizard_instance)
     call whizard_instance%final ()
     deallocate (whizard_instance)
     call terminate_now_if_signal ()
     call release_term_signals ()
     call msg_terminate (quit_code = quit_code)
   end subroutine c_whizard_finalize
 
   subroutine c_whizard_process_string (w_c_instance, c_cmds_in) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_cmds_in(*)
     type(string_t) :: f_cmds
 
     call c_whizard_convert_string (c_cmds_in, f_cmds)
     call c_whizard_commands (w_c_instance, f_cmds)
   end subroutine c_whizard_process_string
 
 @
 <<Whizard-C-Interface: Interfaced Commads>>=
   subroutine c_whizard_model (w_c_instance, c_model) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_model(*)
     type(string_t) :: model, mdl_str
 
     call c_whizard_convert_string (c_model, model)
     mdl_str = "model = " // model
     call c_whizard_commands (w_c_instance, mdl_str)
   end subroutine c_whizard_model
 
   subroutine c_whizard_library (w_c_instance, c_library) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_library(*)
     type(string_t) :: library, lib_str
 
     call c_whizard_convert_string(c_library, library)
     lib_str = "library = " // library
     call c_whizard_commands (w_c_instance, lib_str)
   end subroutine c_whizard_library
 
   subroutine c_whizard_process (w_c_instance, c_id, c_in, c_out) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_id(*), c_in(*), c_out(*)
     type(string_t) :: proc_str, id, in, out
 
     call c_whizard_convert_string (c_id, id)
     call c_whizard_convert_string (c_in, in)
     call c_whizard_convert_string (c_out, out)
     proc_str = "process " // id // " = " // in // " => " // out
     call c_whizard_commands (w_c_instance, proc_str)
   end subroutine c_whizard_process
 
   subroutine c_whizard_compile (w_c_instance) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     type(c_ptr), intent(inout) :: w_c_instance
     type(string_t) :: cmp_str
     cmp_str = "compile"
     call c_whizard_commands (w_c_instance, cmp_str)
   end subroutine c_whizard_compile
 
   subroutine c_whizard_beams (w_c_instance, c_specs) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_specs(*)
     type(string_t) :: specs, beam_str
 
     call c_whizard_convert_string (c_specs, specs)
     beam_str = "beams = " // specs
     call c_whizard_commands (w_c_instance, beam_str)
   end subroutine c_whizard_beams
 
   subroutine c_whizard_integrate (w_c_instance, c_process) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_process(*)
     type(string_t) :: process, int_str
 
     call c_whizard_convert_string (c_process, process)
     int_str = "integrate (" // process //")"
     call c_whizard_commands (w_c_instance, int_str)
   end subroutine c_whizard_integrate
 
   subroutine c_whizard_matrix_element_test &
        (w_c_instance, c_process, n_calls) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     integer(kind=c_int) :: n_calls
     character(kind=c_char) :: c_process(*)
     type(string_t) :: process, me_str
     character(len=8) :: buffer
 
     call c_whizard_convert_string (c_process, process)
     write (buffer, "(I0)")  n_calls
     me_str = "integrate (" // process // ") { ?phs_only = true" // &
          "  n_calls_test = " // trim (buffer)
     call c_whizard_commands (w_c_instance, me_str)
   end subroutine c_whizard_matrix_element_test
 
   subroutine c_whizard_simulate (w_c_instance, c_id) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_id(*)
     type(string_t) :: sim_str, id
 
     call c_whizard_convert_string(c_id, id)
     sim_str = "simulate (" // id // ")"
     call c_whizard_commands (w_c_instance, sim_str)
   end subroutine c_whizard_simulate
 
   subroutine c_whizard_sqrts (w_c_instance, c_value, c_unit) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     character(kind=c_char) :: c_unit(*)
     integer(kind=c_int) :: c_value
     integer :: f_value
     character(len=8) :: f_val
     type(string_t) :: val, unit, sqrts_str
 
     f_value = c_value
     write (f_val,'(i8)') f_value
     val = f_val
     call c_whizard_convert_string (c_unit, unit)
     sqrts_str = "sqrts =" // val // unit
     call c_whizard_commands (w_c_instance, sqrts_str)
   end subroutine c_whizard_sqrts
 
 @
 <<Whizard-C-Interface: HepMC>>=
   type(c_ptr) function c_whizard_hepmc_test &
        (w_c_instance, c_id, c_proc_id, c_event_id) bind(C)
     use, intrinsic :: iso_c_binding
     use iso_varying_string, string_t => varying_string !NODEP!
     use commands
     use diagnostics
     use events
     use hepmc_interface
     use lexers
     use models
     use parser
     use instances
     use rt_data
     use simulations
     use whizard
     use os_interface
 
     implicit none
 
     type(c_ptr), intent(inout) :: w_c_instance
     type(string_t) :: sim_str
     type(parse_tree_t) :: parse_tree
     type(parse_node_t), pointer :: pn_root
     type(stream_t), target :: stream
     type(lexer_t) :: lexer
     type(command_list_t), pointer :: cmd_list
     type(whizard_t), pointer :: whizard_instance
 
     type(simulation_t), target :: sim
 
     character(kind=c_char), intent(in) :: c_id(*)
     type(string_t) :: id
     integer(kind=c_int), value :: c_proc_id, c_event_id
     integer :: proc_id
 
     type(hepmc_event_t), pointer :: hepmc_event
 
     call c_f_pointer (w_c_instance, whizard_instance)
 
     call c_whizard_convert_string (c_id, id)
     sim_str = "simulate (" // id // ")"
 
     proc_id = c_proc_id
 
     allocate (hepmc_event)
     call hepmc_event_init (hepmc_event, c_proc_id, c_event_id)
 
     call syntax_cmd_list_init ()
     call lexer_init_cmd_list (lexer)
 
     call stream_init (stream, sim_str)
     call lexer_assign_stream (lexer, stream)
     call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
     pn_root => parse_tree%get_root_ptr ()
 
     allocate (cmd_list)
     if (associated (pn_root)) then
        call cmd_list%compile (pn_root, whizard_instance%global)
     end if
 
     call sim%init ([id], .true., .true., whizard_instance%global)
 
     !!! This should generate a HepMC event as hepmc_event_t type
     call msg_message ("Not enabled for the moment.")
 
     call sim%final ()
 
     call cmd_list%final ()
 
     call parse_tree_final (parse_tree)
     call stream_final (stream)
     call lexer_final (lexer)
     call syntax_cmd_list_final ()
 
     c_whizard_hepmc_test = c_loc(hepmc_event)
     return
   end function c_whizard_hepmc_test
 @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Index: trunk/src/vegas/vegas.nw
===================================================================
--- trunk/src/vegas/vegas.nw	(revision 8186)
+++ trunk/src/vegas/vegas.nw	(revision 8187)
@@ -1,4724 +1,4724 @@
 %% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
 % WHIZARD code as NOWEB source: VEGAS algorithm
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{VEGAS Integration}
 \label{cha:vegas-integration}
 
 @ The backbone integrator of WHIZARD is a object-oriented implemetation of the VEGAS algorithm.
 
 <<[[vegas.f90]]>>=
 <<File header>>
 
 module vegas
 <<Use kinds>>
 
 <<vegas: modules>>
 
 <<Standard module head>>
 
 <<vegas: public>>
 
 <<vegas: parameters>>
 
 <<vegas: types>>
 
 <<vegas: interfaces>>
 
 contains
 
 <<vegas: procedures>>
 
 end module vegas
 @ %def vegas
 <<vegas: modules>>=
   use diagnostics
   use io_units
   use format_utils, only: write_indent
   use format_defs, only: FMT_17
   use rng_base, only: rng_t
   use rng_stream, only: rng_stream_t
 @
 @ MPI Module.
 <<MPI: vegas: modules>>=
   use mpi_f08 !NODEP!
 @
 
 \section{Integration modes}
 \label{sec:integration-modes}
 
 @ VEGAS operates in three different modes: [[vegas_mode_importance_only]], [[vegas_mode_importance]] or [[vegas_mode_stratified]].
 The default mode is [[vegas_mode_importance]], where the algorithm decides whether if it is possible to use importance sampling or stratified sampling.
 In low dimensions VEGAS uses strict stratified sampling.
 
 <<vegas: parameters>>=
   integer, parameter, public :: VEGAS_MODE_IMPORTANCE = 0, &
        & VEGAS_MODE_STRATIFIED = 1, VEGAS_MODE_IMPORTANCE_ONLY = 2
 @ %def vegas_mode_importance vegas_mode_stratified vegas_mode_importance_only
 @
 \section{Type: vegas\_func\_t}
 \label{sec:type:vegas_func_t}
 
 We define a abstract [[func]] type which only gives an interface to an [[evaluate]] procedure.
 The inside of implementation and also the optimization of are not a concern of the [[vegas]] implementation.
 <<vegas: public>>=
   public :: vegas_func_t
 <<vegas: types>>=
   type, abstract :: vegas_func_t
      !
    contains
      procedure(vegas_func_evaluate), deferred, pass, public :: evaluate
   end type vegas_func_t
 
 @ %def vegas_func_t
 @ The only procedure called in [[vegas]] is [[vegas_func_evaluate]].
 It takes a real value [[x]] and returns a real value [[f]].
 <<vegas: interfaces>>=
   abstract interface
      real(default) function vegas_func_evaluate (self, x) result (f)
        import :: default, vegas_func_t
        class(vegas_func_t), intent(inout) :: self
        real(default), dimension(:), intent(in) :: x
      end function vegas_func_evaluate
   end interface
 
 @ %def vegas_func_evaluate
 @
 \section{Type: vegas\_config\_t}
 \label{sec:type:vegas_config_t}
 
 We store the complete configuration in a transparent container.
 The [[vegas_config_t]] object inside VEGAS must not be directly accesible.
 We provide a get method which returns a copy of the [[vegas_config_t]] object.
 
 Apart from the options which can be set by the constructor of [[vegas_t]] object, we store the run-time configuration [[n_calls]], [[calls_per_box]], [[n_bins]] and [[n_boxes]].
 Those are calculated and set accordingly by VEGAS.
 <<vegas: public>>=
   public :: vegas_config_t
 <<vegas: types>>=
   type :: vegas_config_t
      integer :: n_dim = 0
      real(default) :: alpha = 1.5
      integer :: n_bins_max = 50
      integer :: iterations = 5
      integer :: mode = VEGAS_MODE_STRATIFIED
      integer :: calls_per_box = 0
      integer :: n_calls = 0
      integer :: n_calls_min = 20
      integer :: n_boxes = 1
      integer :: n_bins = 1
    contains
    <<vegas: vegas config: TBP>>
   end type vegas_config_t
 
 @ %def vegas_config_t, n_calls, calls_per_box, n_bins, n_boxes
 @ Write out the configuration of the grid.
 <<vegas: vegas config: TBP>>=
   procedure, public :: write => vegas_config_write
 <<vegas: procedures>>=
   subroutine vegas_config_write (self, unit, indent)
     class(vegas_config_t), intent(in) :: self
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: indent
     integer :: u, ind
     u = given_output_unit (unit)
     ind = 0; if (present (indent)) ind = indent
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Number of dimensions            = ", self%n_dim
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "Adaption power (alpha)          = ", self%alpha
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Max. number of bins (per dim.)  = ", self%n_bins_max
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Number of iterations            = ", self%iterations
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Mode (stratified or importance) = ", self%mode
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Calls per box                   = ", self%calls_per_box
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Number of calls                 = ", self%n_calls
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Min. number of calls            = ", self%n_calls_min
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Number of bins                  = ", self%n_bins
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Number of boxes                 = ", self%n_boxes
   end subroutine vegas_config_write
 
 @ %def vegas_config_write
 @
 \section{Type: vegas\_grid\_t}
 \label{sec:type:-vegas_g}
 
 We provide a simple and transparent grid container. The container can then later
 be used, to export the actual grid.
 <<vegas: public>>=
   public :: vegas_grid_t
 <<vegas: types>>=
   type :: vegas_grid_t
      integer :: n_dim = 1
      integer :: n_bins = 1
      real(default), dimension(:), allocatable :: x_lower
      real(default), dimension(:), allocatable :: x_upper
      real(default), dimension(:), allocatable :: delta_x
      real(default), dimension(:,:), allocatable :: xi
    contains
    <<vegas: vegas grid: TBP>>
   end type vegas_grid_t
 
 @ %def vegas_grid_t
 @ Initialise grid.
 <<vegas: interfaces>>=
   interface vegas_grid_t
      module procedure vegas_grid_init
   end interface vegas_grid_t
 
 <<vegas: procedures>>=
   type(vegas_grid_t) function vegas_grid_init (n_dim, n_bins_max) result (self)
     integer, intent(in) :: n_dim
     integer, intent(in) :: n_bins_max
     self%n_dim = n_dim
     self%n_bins = 1
     allocate (self%x_upper(n_dim), source=1.0_default)
     allocate (self%x_lower(n_dim), source=0.0_default)
     allocate (self%delta_x(n_dim), source=1.0_default)
     allocate (self%xi((n_bins_max + 1), n_dim), source=0.0_default)
   end function vegas_grid_init
 
 @ %def vegas_grid_init
 @ Output.
 <<vegas: vegas grid: TBP>>=
   procedure, public :: write => vegas_grid_write
 <<vegas: procedures>>=
   subroutine vegas_grid_write (self, unit)
     class(vegas_grid_t), intent(in) :: self
     integer, intent(in), optional :: unit
     integer :: u, i, j
     u = given_output_unit (unit)
     write (u, descr_fmt) "begin vegas_grid_t"
     write (u, integer_fmt) "n_dim = ", self%n_dim
     write (u, integer_fmt) "n_bins = ", self%n_bins
     write (u, descr_fmt) "begin x_lower"
     do j = 1, self%n_dim
        write (u, double_array_fmt)  j, self%x_lower(j)
     end do
     write (u, descr_fmt) "end x_lower"
     write (u, descr_fmt) "begin x_upper"
     do j = 1, self%n_dim
        write (u, double_array_fmt) j, self%x_upper(j)
     end do
     write (u, descr_fmt) "end x_upper"
     write (u, descr_fmt) "begin delta_x"
     do j = 1, self%n_dim
        write (u, double_array_fmt)  j, self%delta_x(j)
     end do
     write (u, descr_fmt) "end delta_x"
     write (u, descr_fmt) "begin xi"
     do j = 1, self%n_dim
        do i = 1, self%n_bins + 1
           write (u, double_array2_fmt) i, j, self%xi(i, j)
        end do
     end do
     write (u, descr_fmt) "end xi"
     write (u, descr_fmt) "end vegas_grid_t"
   end subroutine vegas_grid_write
 
 @ %def vegas_grid_write
 @ Compare two grids, if they match up to an given precision.
 <<vegas: public>>=
   public :: operator (==)
 <<vegas: interfaces>>=
   interface operator (==)
      module procedure vegas_grid_equal
   end interface operator (==)
 <<vegas: procedures>>=
   logical function vegas_grid_equal (grid_a, grid_b) result (yorn)
     type(vegas_grid_t), intent(in) :: grid_a, grid_b
     yorn = .true.
     yorn = yorn .and. (grid_a%n_dim == grid_b%n_dim)
     yorn = yorn .and. (grid_a%n_bins == grid_b%n_bins)
     yorn = yorn .and. all (grid_a%x_lower == grid_b%x_lower)
     yorn = yorn .and. all (grid_a%x_upper == grid_b%x_upper)
     yorn = yorn .and. all (grid_a%delta_x == grid_b%delta_x)
     yorn = yorn .and. all (grid_a%xi == grid_b%xi)
   end function vegas_grid_equal
 
 @ %def vegas_grid_equal
 @ Resize each bin accordingly to its corresponding weight [[w]]. Can be used to
 resize the grid to a new size of bins or refinement.
 
 The procedure expects two arguments, firstly, [[n_bins]] and, secondly, the
 refinement weights [[w]]. If [[n_bins]] differs from the internally stored one,
 we resize the grid under consideration of [[w]]. If each element of [[w]] equals
 one, then the bins are resized preserving their original bin density.
 
 Anytime else, we refine the grid accordingly to [[w]].
 <<vegas: vegas grid: TBP>>=
   procedure, private :: resize => vegas_grid_resize
 <<vegas: procedures>>=
   subroutine vegas_grid_resize (self, n_bins, w)
     class(vegas_grid_t), intent(inout) :: self
     integer, intent(in) :: n_bins
     real(default), dimension(:, :), intent(in) :: w
     real(default), dimension(size(self%xi)) :: xi_new
     integer :: i, j, k
     real(default) :: pts_per_bin
     real(default) :: d_width
     call msg_debug (D_VAMP2, "vegas_grid_resize")
     do j = 1, self%n_dim
        if (self%n_bins /= n_bins) then
           pts_per_bin = real(self%n_bins, default) / real(n_bins, default)
           self%n_bins = n_bins
        else
           if (all (w(:, j) == 0.)) then
              call msg_bug ("[VEGAS] grid_resize: resize weights are zero.")
           end if
           pts_per_bin = sum(w(:, j)) / self%n_bins
        end if
        d_width = 0.
        k = 0
        do i = 2, self%n_bins
           do while (pts_per_bin > d_width)
              k = k + 1
              d_width = d_width + w(k, j)
           end do
           d_width = d_width - pts_per_bin
           if (debug_active (D_VAMP2)) then
              print *, "  pts_per_bin = ", pts_per_bin, ", d_width = ", d_width
              print *, "  j = ", j, ",  k = ", k, ", i = ", i
           end if
           associate (x_upper => self%xi(k + 1, j), x_lower => self%xi(k, j))
             xi_new(i) = x_upper - (x_upper - x_lower) * d_width / w(k, j)
           end associate
        end do
        self%xi(:, j) = 0. ! Reset grid explicitly
        self%xi(2:n_bins, j) = xi_new(2:n_bins)
        self%xi(n_bins + 1, j) = 1.
     end do
   end subroutine vegas_grid_resize
 
 @ %def vegas_grid_resize
 @ Find the probability for a given [[x]] in the unit hypercube. 
 
 For the case [[n_bins < N_BINARY_SEARCH]], we utilize linear search which is faster for short arrays.
 Else we make use of a binary search. Furthermore, we calculate the inverse of
 the probability and invert the result only at the end (saving some time on division).
 <<vegas: vegas grid: TBP>>=
   procedure, public :: get_probability => vegas_grid_get_probability
 <<vegas: procedures>>=
   function vegas_grid_get_probability (self, x) result (g)
     class(vegas_grid_t), intent(in) :: self
     real(default), dimension(:), intent(in) :: x
     integer, parameter :: N_BINARY_SEARCH = 100
     real(default) :: g, y
     integer :: j, i_lower, i_higher, i_mid
     g = 1.
     if (self%n_bins > N_BINARY_SEARCH) then
        g = binary_search (x)
     else
        g = linear_search (x)
     end if
     ! Move division to the end, which is more efficient.
     if (g /= 0) g = 1. / g
   contains
     real(default) function linear_search (x) result (g)
       real(default), dimension(:), intent(in) :: x
       real(default) :: y
       integer :: j, i
       g = 1.
       ndim: do j = 1, self%n_dim
          y = (x(j) - self%x_lower(j)) / self%delta_x(j)
          if (y >= 0. .and. y <= 1.) then
             do i = 2, self%n_bins + 1
                if (self%xi(i, j) > y) then
                  g = g * (self%delta_x(j) * &
                       & self%n_bins * (self%xi(i, j) - self%xi(i - 1, j)))
                  cycle ndim
               end if
            end do
            g = 0
            exit ndim
         else
            g = 0
            exit ndim
         end if
      end do ndim
    end function linear_search
 
    real(default) function binary_search (x) result (g)
      real(default), dimension(:), intent(in) :: x
      ndim: do j = 1, self%n_dim
         y = (x(j) - self%x_lower(j)) / self%delta_x(j)
         if (y >= 0. .and. y <= 1.) then
            i_lower = 1
            i_higher = self%n_bins + 1
            search: do
               if (i_lower >= (i_higher - 1)) then
                  g = g * (self%delta_x(j) * &
                       & self%n_bins * (self%xi(i_higher, j) - self%xi(i_higher - 1, j)))
                  cycle ndim
               end if
               i_mid = (i_higher + i_lower) / 2
               if (y > self%xi(i_mid, j)) then
                  i_lower = i_mid
               else
                  i_higher = i_mid
               end if
            end do search
         else
            g = 0.
            exit ndim
         end if
      end do ndim
    end function binary_search
  end function vegas_grid_get_probability
 
 @ %def vegas_grid_get_probability
 @ Broadcast the grid information. As safety measure, we get the actual grid
 object from VEGAS (correclty allocated, but for non-root unfilled) and broadcast
 the root object. On success, we set grid into VEGAS.
 
 We use the non-blocking broadcast routine, because we have to send quite a bunch
 of integers and reals.
 
 We have to be very careful with [[n_bins]], the number of bins can actually
 change during different iterations. If we reuse a grid, we have to take that,
 every grid uses the same [[n_bins]]. We expect, that the number of dimension
 does not change, which is in principle possible, but will be checked onto in
 [[vegas_set_grid]].
 <<MPI: vegas: vegas grid: TBP>>=
   procedure, public :: broadcast => vegas_grid_broadcast
 <<MPI: vegas: procedures>>=
   subroutine vegas_grid_broadcast (self)
     class(vegas_grid_t), intent(inout) :: self
     integer :: j, ierror
     type(MPI_Request), dimension(self%n_dim + 4) :: status
     ! Blocking
     call MPI_Bcast (self%n_bins, 1, MPI_INTEGER, 0, MPI_COMM_WORLD)
     ! Non blocking
     call MPI_Ibcast (self%n_dim, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, status(1))
     call MPI_Ibcast (self%x_lower, self%n_dim, &
          & MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, status(2))
     call MPI_Ibcast (self%x_upper, self%n_dim, &
          & MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, status(3))
     call MPI_Ibcast (self%delta_x, self%n_dim, &
          & MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, status(4))
     ndim: do j = 1, self%n_dim
        call MPI_Ibcast (self%xi(1:self%n_bins + 1, j), self%n_bins + 1,&
             & MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, status(4 + j))
     end do ndim
     call MPI_Waitall (self%n_dim + 4, status, MPI_STATUSES_IGNORE)
   end subroutine vegas_grid_broadcast
 
 @ %def vegas_grid_broadcast
 @
 \section{Type: vegas\_result\_t}
 \label{sec:type:-vegas_r}
 
 We store the result of the latest iteration(s) in a transparent container.
 The [[vegas_result_t]] object inside VEGAS must not be directly accessible.
 We export the a copy of the result via a get-method of the [[vegas_t]] object.
 
 We store latest event weight in [[evt_weight]] and a (possible) evebt weight
 excess in [[evt_weight_excess]], if the event weight is larger than
 [[max_abs_f]].
 <<vegas: public>>=
   public :: vegas_result_t
 <<vegas: types>>=
   type :: vegas_result_t
      integer :: it_start = 0
      integer :: it_num = 0
      integer :: samples = 0
      real(default) :: sum_int_wgtd = 0.
      real(default) :: sum_wgts
      real(default) :: sum_chi = 0.
      real(default) :: chi2 = 0.
      real(default) :: efficiency = 0.
      real(default) :: efficiency_pos = 0.
      real(default) :: efficiency_neg = 0.
      real(default) :: max_abs_f = 0.
      real(default) :: max_abs_f_pos = 0.
      real(default) :: max_abs_f_neg = 0.
      real(default) :: result = 0.
      real(default) :: std = 0.
      real(default) :: evt_weight = 0.
      real(default) :: evt_weight_excess = 0.
    contains
    <<vegas: vegas result: TBP>>
   end type vegas_result_t
 
 @ %def vegas_results_t
 @ Write out the current status of the integration result.
 <<vegas: vegas result: TBP>>=
   procedure, public :: write => vegas_result_write
 <<vegas: procedures>>=
   subroutine vegas_result_write (self, unit, indent)
     class(vegas_result_t), intent(in) :: self
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: indent
     integer :: u, ind
     u = given_output_unit (unit)
     ind = 0; if (present (indent)) ind = indent
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Start iteration                 = ", self%it_start
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Iteration number                = ", self%it_num
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Sample number                   = ", self%samples
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 //")") &
          & "Sum of weighted integrals       = ", self%sum_int_wgtd
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")")  &
          & "Sum of weights                  = ", self%sum_wgts
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "Sum of chi                      = ", self%sum_chi
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "chi2                            = ", self%chi2
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "Overall efficiency              = ", self%efficiency
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "f-positive efficiency           = ", self%efficiency_pos
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "f-negative efficiency           = ", self%efficiency_neg
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "Maximum absolute overall value  = ", self%max_abs_f
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "Maximum absolute positive value = ", self%max_abs_f_pos
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "Maximum absolute negative value = ", self%max_abs_f_neg
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "Integral (of latest iteration)  = ", self%result
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "Standard deviation              = ", self%std
     write (u, "(2x,A," // FMT_17 // ")") &
          & "Event weight                    = ", self%evt_weight
     write (u, "(2x,A," // FMT_17 // ")") &
          & "Event weight excess             = ", self%evt_weight_excess
   end subroutine vegas_result_write
 
 @  %def vegas_results_write
 @ Send the result object to specified rank, internally in a non-blocking way.
 
 We do not need to handle the event results, because each event result is atomic.
 <<MPI: vegas: vegas result: TBP>>=
   procedure, public :: send => vegas_result_send
 <<MPI: vegas: procedures>>=
   subroutine vegas_result_send (self, receiver, tag)
     class(vegas_result_t), intent(in) :: self
     integer, intent(in) :: receiver
     integer, intent(in) :: tag
     type(MPI_Request), dimension(13) :: request
     call MPI_Isend (self%it_start, 1, MPI_INTEGER, receiver, 1 + tag,&
          & MPI_COMM_WORLD, request(1))
     call MPI_Isend (self%it_num, 1, MPI_INTEGER, receiver , 2 + tag,&
          & MPI_COMM_WORLD, request(2))
     call MPI_Isend (self%samples, 1, MPI_INTEGER, receiver, 3 + tag,&
          & MPI_COMM_WORLD, request(3))
     call MPI_Isend (self%sum_int_wgtd, 1, MPI_DOUBLE_PRECISION, receiver, 4 +&
          & tag, MPI_COMM_WORLD, request(4))
     call MPI_Isend (self%sum_wgts, 1, MPI_DOUBLE_PRECISION, receiver, 5 + tag,&
          & MPI_COMM_WORLD, request(5))
     call MPI_Isend (self%sum_chi, 1, MPI_DOUBLE_PRECISION, receiver, 6 + tag,&
          & MPI_COMM_WORLD, request(6))
     call MPI_Isend (self%efficiency, 1, MPI_DOUBLE_PRECISION, receiver, 7 + tag&
          &, MPI_COMM_WORLD, request(7))
     call MPI_Isend (self%efficiency_pos, 1, MPI_DOUBLE_PRECISION, receiver, 8 +&
          & tag, MPI_COMM_WORLD, request(8))
     call MPI_Isend (self%efficiency_neg, 1, MPI_DOUBLE_PRECISION, receiver, 9 +&
          & tag, MPI_COMM_WORLD, request(9))
     call MPI_Isend (self%max_abs_f, 1, MPI_DOUBLE_PRECISION, receiver, 10 + tag&
          &, MPI_COMM_WORLD, request(10))
     call MPI_Isend (self%max_abs_f_pos, 1, MPI_DOUBLE_PRECISION, receiver, 11 +&
          & tag, MPI_COMM_WORLD, request(10))
     call MPI_Isend (self%max_abs_f_neg, 1, MPI_DOUBLE_PRECISION, receiver, 12 +&
          & tag, MPI_COMM_WORLD, request(11))
     call MPI_Isend (self%result, 1, MPI_DOUBLE_PRECISION, receiver, 13 + tag,&
          & MPI_COMM_WORLD, request(12))
     call MPI_Isend (self%std, 1, MPI_DOUBLE_PRECISION, receiver, 14 + tag,&
          & MPI_COMM_WORLD, request(13))
     call MPI_waitall (13, request, MPI_STATUSES_IGNORE)
   end subroutine vegas_result_send
 
 @ %def vegas_result_communicate
 @ Receive the result object from a specified rank, internally in a non-blocking way.
 <<MPI: vegas: vegas result: TBP>>=
   procedure, public :: receive => vegas_result_receive
 <<MPI: vegas: procedures>>=
   subroutine vegas_result_receive (self, sender, tag)
     class(vegas_result_t), intent(inout) :: self
     integer, intent(in) :: sender
     integer, intent(in) :: tag
     type(MPI_Request), dimension(13) :: request
     call MPI_Irecv (self%it_start, 1, MPI_INTEGER, sender, 1 + tag,&
          & MPI_COMM_WORLD, request(1))
     call MPI_Irecv (self%it_num, 1, MPI_INTEGER, sender , 2 + tag,&
          & MPI_COMM_WORLD, request(2))
     call MPI_Irecv (self%samples, 1, MPI_INTEGER, sender, 3 + tag,&
          & MPI_COMM_WORLD, request(3))
     call MPI_Irecv (self%sum_int_wgtd, 1, MPI_DOUBLE_PRECISION, sender, 4 + tag&
          &, MPI_COMM_WORLD, request(4))
     call MPI_Irecv (self%sum_wgts, 1, MPI_DOUBLE_PRECISION, sender, 5 + tag,&
          & MPI_COMM_WORLD, request(5))
     call MPI_Irecv (self%sum_chi, 1, MPI_DOUBLE_PRECISION, sender, 6 + tag,&
          & MPI_COMM_WORLD, request(6))
     call MPI_Irecv (self%efficiency, 1, MPI_DOUBLE_PRECISION, sender, 7 + tag,&
          & MPI_COMM_WORLD, request(7))
     call MPI_Irecv (self%efficiency_pos, 1, MPI_DOUBLE_PRECISION, sender, 8 +&
          & tag, MPI_COMM_WORLD, request(8))
     call MPI_Irecv (self%efficiency_neg, 1, MPI_DOUBLE_PRECISION, sender, 9 +&
          & tag, MPI_COMM_WORLD, request(9))
     call MPI_Irecv (self%max_abs_f, 1, MPI_DOUBLE_PRECISION, sender, 10 + tag,&
          & MPI_COMM_WORLD, request(10))
     call MPI_Irecv (self%max_abs_f_pos, 1, MPI_DOUBLE_PRECISION, sender, 11 +&
          & tag, MPI_COMM_WORLD, request(10))
     call MPI_Irecv (self%max_abs_f_neg, 1, MPI_DOUBLE_PRECISION, sender, 12 +&
          & tag, MPI_COMM_WORLD, request(11))
     call MPI_Irecv (self%result, 1, MPI_DOUBLE_PRECISION, sender, 13 + tag,&
          & MPI_COMM_WORLD, request(12))
     call MPI_Irecv (self%std, 1, MPI_DOUBLE_PRECISION, sender, 14 + tag,&
          & MPI_COMM_WORLD, request(13))
     call MPI_waitall (13, request, MPI_STATUSES_IGNORE)
   end subroutine vegas_result_receive
 
 @ %def vegas_result_receive
 \section{Type: vegas\_t}
 \label{sec:type:-vegas_t}
 
 The VEGAS object contains the methods for integration and grid resize- and
 refinement. We store the grid configuration and the (current) result in
 transparent containers alongside with the actual grid and the distribution.
 
 The values of the distribution depend on the chosen mode whether the function
 value or the variance is stored. The distribution is used after each iteration
 to refine the grid.
 <<vegas: public>>=
   public :: vegas_t
 <<vegas: types>>=
   type :: vegas_t
      private
      type(vegas_config_t) :: config
      real(default) :: hypercube_volume = 0.
      real(default) :: jacobian = 0.
      real(default), dimension(:, :), allocatable :: d
      type(vegas_grid_t) :: grid
      integer, dimension(:), allocatable :: bin
      integer, dimension(:), allocatable :: box
      type(vegas_result_t) :: result
    contains
    <<vegas: vegas: TBP>>
   end type vegas_t
 
 @ %def vegas_t
 @ We overload the type constructor of [[vegas_t]] which initialises the
 mandatory argument [[n_dim]] and allocate memory for the grid.
 <<vegas: interfaces>>=
   interface vegas_t
      module procedure vegas_init
   end interface vegas_t
 <<vegas: procedures>>=
   type(vegas_t) function vegas_init (n_dim, alpha, n_bins_max, iterations, mode) result (self)
     integer, intent(in) :: n_dim
     integer, intent(in), optional :: n_bins_max
     real(default), intent(in), optional :: alpha
     integer, intent(in), optional :: iterations
     integer, intent(in), optional :: mode
     self%config%n_dim = n_dim
     if (present (alpha)) self%config%alpha = alpha
     if (present (n_bins_max)) self%config%n_bins_max = n_bins_max
     if (present (iterations)) self%config%iterations = iterations
     if (present (mode)) self%config%mode = mode
     self%grid = vegas_grid_t (n_dim, self%config%n_bins_max)
     allocate (self%d(self%config%n_bins_max, n_dim), source=0.0_default)
     allocate (self%box(n_dim), source=1)
     allocate (self%bin(n_dim), source=1)
     self%config%n_bins = 1
     self%config%n_boxes = 1
     call self%set_limits (self%grid%x_lower, self%grid%x_upper)
     call self%reset_grid ()
     call self%reset_result ()
   end function vegas_init
 
 @ %def vegas_init
 
 @ Finalize the grid. Deallocate grid memory.
 <<vegas: vegas: TBP>>=
   procedure, public :: final => vegas_final
 <<vegas: procedures>>=
   subroutine vegas_final (self)
     class(vegas_t), intent(inout) :: self
     deallocate (self%grid%x_upper)
     deallocate (self%grid%x_lower)
     deallocate (self%grid%delta_x)
     deallocate (self%d)
     deallocate (self%grid%xi)
     deallocate (self%box)
     deallocate (self%bin)
   end subroutine vegas_final
 @ %def vegas_final
 
 \section{Get-/Set-methods}
 \label{sec:set-get-methods}
 
 @ The VEGAS object prohibits direct access from outside. Communication is handle
 via get- or set-methods. Set the limits of integration. The defaults limits
 correspong the $n$-dimensionl unit hypercube.
 
 \textit{Remark:} After setting the limits, the grid is initialised, again.
 Previous results are lost due to recalculation of the overall jacobian.
 <<vegas: vegas: TBP>>=
   procedure, public :: set_limits => vegas_set_limits
 <<vegas: procedures>>=
   subroutine vegas_set_limits (self, x_lower, x_upper)
     class(vegas_t), intent(inout) :: self
     real(default), dimension(:), intent(in) :: x_lower
     real(default), dimension(:), intent(in) :: x_upper
     if (size (x_lower) /= self%config%n_dim &
          & .or. size (x_upper) /= self%config%n_dim) then
        write (msg_buffer, "(A, I5, A, I5, A, I5)") &
             "VEGAS: [set_limits] n_dim of new lower/upper integration limit&
             & does not match previously set n_dim. ", self%config%n_dim, " =/=&
             & ", size (x_lower), " =/= ", size (x_upper)
        call msg_fatal ()
     end if
     if (any(x_upper < x_lower)) then
        call msg_fatal ("VEGAS: [set_limits] upper limits are smaller than lower limits.")
     end if
     if (any((x_upper - x_lower) > huge(0._default))) then
        call msg_fatal ("VEGAS: [set_limits] upper and lower limits exceed rendering.")
     end if
     self%grid%x_upper = x_upper
     self%grid%x_lower = x_lower
     self%grid%delta_x = self%grid%x_upper - self%grid%x_lower
     self%hypercube_volume = product (self%grid%delta_x)
     call self%reset_result ()
   end subroutine vegas_set_limits
 
 @ %def vegas_set_limits
 @ Set the number of calls. If the number of calls changed during different
 passes, we resize the grid preserving the probability density. We should reset
 the results after changing the number of calls which change the size of the grid
 and the running mode of VEGAS. But, this is a set method only for the number of
 calls.
 <<vegas: vegas: TBP>>=
   procedure, public :: set_calls => vegas_set_n_calls
 <<vegas: procedures>>=
   subroutine vegas_set_n_calls (self, n_calls)
     class(vegas_t), intent(inout) :: self
     integer, intent(in) :: n_calls
     if (.not. (n_calls > 0)) then
        write (msg_buffer, "(A, I5)") &
             "VEGAS: [set_calls] number of calls must be a positive number. Keep&
             & number of calls = ", self%config%n_calls
        call msg_warning ()
     else
        self%config%n_calls = max (n_calls, self%config%n_calls_min)
        if (self%config%n_calls /= n_calls) then
           write (msg_buffer, "(A,I5)") &
                "VEGAS: [set calls] number of calls is too few, reset to ", self%config%n_calls
           call msg_warning ()
        end if
        call self%init_grid ()
     end if
   end subroutine vegas_set_n_calls
 
 @ %def vegas_set_n_calls
 @ Get the grid object and set [[n_bins]], [[n_dim]] inside grid container.
 <<vegas: vegas: TBP>>=
   procedure, public :: get_grid => vegas_get_grid
 <<vegas: procedures>>=
   type(vegas_grid_t) function vegas_get_grid (self) result (grid)
     class(vegas_t), intent(in) :: self
     grid = self%grid
     grid%n_dim = self%config%n_dim
     grid%n_bins = self%config%n_bins
   end function vegas_get_grid
 
 @ %def vegas_get_grid
 @ Set grid. We need a set method for the parallelisation. We do some additional
 checks before copying the object. Be careful, we do not check on [[n_bins]],
 because the number of bins can change after setting [[n_calls]]. We remind you,
 that you will loose all your current progress, if you use set the grid. Hence,
 it will only be used when compiled with [[MPI]].
 <<MPI: vegas: vegas: TBP>>=
   procedure, public :: set_grid => vegas_set_grid
 <<MPI: vegas: procedures>>=
   subroutine vegas_set_grid (self, grid)
     class(vegas_t), intent(inout) :: self
     type(vegas_grid_t), intent(in) :: grid
     integer :: j, rank
     logical :: success
     call MPI_Comm_rank (MPI_COMM_WORLD, rank)
     success = .true.
     success = (success .and. (grid%n_dim .eq. self%config%n_dim))
     success = (success .and. all (grid%x_lower .eq. self%grid%x_lower))
     success = (success .and. all (grid%x_upper .eq. self%grid%x_upper))
     success = (success .and. all (grid%delta_x .eq. self%grid%delta_x))
     if (success) then
        self%config%n_bins = grid%n_bins
        do j = 1, self%config%n_dim
           self%grid%xi(1, j) = 0._default
           self%grid%xi(2:self%config%n_bins, j) = grid%xi(2:grid%n_bins, j)
           self%grid%xi(self%config%n_bins + 1, j) = 1._default
        end do
     else
        call msg_bug ("VEGAS: set grid: boundary conditions do not match.")
     end if
   end subroutine vegas_set_grid
 
 @ %def vegas_set_grid
 @ We check if it is senseful to parallelize the actual grid. In simple, this
 means that [[n_boxes]] has to be larger than 2. With the result that we could
 have an actual superimposed stratified grid. In advance, we can give the size of
 communicator [[n_size]] and check whether we have enough boxes to distribute.
 <<MPI: vegas: vegas: TBP>>=
   procedure, public :: is_parallelizable => vegas_is_parallelizable
 <<MPI: vegas: procedures>>=
   elemental logical function vegas_is_parallelizable (self, opt_n_size) result (flag)
     class(vegas_t), intent(in) :: self
     integer, intent(in), optional :: opt_n_size
     integer :: n_size
     n_size = 2
     if (present (opt_n_size)) n_size = opt_n_size
     flag = (self%config%n_boxes**floor (self%config%n_dim / 2.) >= n_size)
   end function vegas_is_parallelizable
 
 @ %def vegas_is_parallelizable
 @ Get the config object.
 <<vegas: vegas: TBP>>=
   procedure, public :: get_config => vegas_get_config
 <<vegas: procedures>>=
   subroutine vegas_get_config (self, config)
     class(vegas_t), intent(in) :: self
     type(vegas_config_t), intent(out) :: config
     config = self%config
   end subroutine vegas_get_config
 
 @ %def vegas_get_config
 @ Set non-runtime dependent configuration. It will no be possible to change
 [[n_bins_max]].
 <<vegas: vegas: TBP>>=
   procedure, public :: set_config => vegas_set_config
 <<vegas: procedures>>=
   subroutine vegas_set_config (self, config)
     class(vegas_t), intent(inout) :: self
     class(vegas_config_t), intent(in) :: config
     self%config%alpha = config%alpha
     self%config%iterations = config%iterations
     self%config%mode = config%mode
     self%config%n_calls_min = config%n_calls_min
    end subroutine vegas_set_config
 
 @ %def vegas_set_config
 @ Get the result object.
 <<vegas: vegas: TBP>>=
   procedure, public :: get_result => vegas_get_result
 <<vegas: procedures>>=
   type(vegas_result_t) function vegas_get_result (self) result (result)
     class(vegas_t), intent(in) :: self
     result = self%result
   end function vegas_get_result
 
 @ %def vegas_get_result
 @ Set the result object. Be reminded, that you will loose your current results,
 if you are not careful! Hence, it will only be avaible during usage with
 [[MPI]].
 <<MPI: vegas: vegas: TBP>>=
   procedure, public :: set_result => vegas_set_result
 <<MPI: vegas: procedures>>=
   subroutine vegas_set_result (self, result)
     class(vegas_t), intent(inout) :: self
     type(vegas_result_t), intent(in) :: result
     self%result = result
   end subroutine vegas_set_result
 
 @ %def vegas_set_result
 @ Get (actual) number of calls.
 <<vegas: vegas: TBP>>=
   procedure, public :: get_calls => vegas_get_n_calls
 <<vegas: procedures>>=
   elemental real(default) function vegas_get_n_calls (self) result (n_calls)
     class(vegas_t), intent(in) :: self
     n_calls = self%config%n_calls
   end function vegas_get_n_calls
 
 @ %def vegas_get_n_calls
 @ Get the cumulative result of the integration. Recalculate weighted average of the integration.
 <<vegas: vegas: TBP>>=
   procedure, public :: get_integral => vegas_get_integral
 <<vegas: procedures>>=
   elemental real(default) function vegas_get_integral (self) result (integral)
     class(vegas_t), intent(in) :: self
     integral = 0.
     if (self%result%sum_wgts > 0.) then
        integral = self%result%sum_int_wgtd / self%result%sum_wgts
     end if
   end function vegas_get_integral
 
 @ %def vegas_get_integral
 @ Get the cumulative variance of the integration. Recalculate the variance.
 <<vegas: vegas: TBP>>=
   procedure, public :: get_variance => vegas_get_variance
 <<vegas: procedures>>=
   elemental real(default) function vegas_get_variance (self) result (variance)
     class(vegas_t), intent(in) :: self
     variance = 0.
     if (self%result%sum_wgts > 0.) then
        variance = 1.0 / self%result%sum_wgts
     end if
   end function vegas_get_variance
 
 @ %def vegas_get_variance
 @ Get efficiency.
 <<vegas: vegas: TBP>>=
   procedure, public :: get_efficiency => vegas_get_efficiency
 <<vegas: procedures>>=
   elemental real(default) function vegas_get_efficiency (self) result (efficiency)
     class(vegas_t), intent(in) :: self
     efficiency = 0.
     if (self%result%efficiency > 0. ) then
        efficiency = self%result%efficiency
     end if
   end function vegas_get_efficiency
 
 @ %def vegas_get_efficiency
 @ Get [[f_max]].
 <<vegas: vegas: TBP>>=
   procedure, public :: get_max_abs_f => vegas_get_max_abs_f
 <<vegas: procedures>>=
   elemental real(default) function vegas_get_max_abs_f (self) result (max_abs_f)
     class(vegas_t), intent(in) :: self
     max_abs_f = 0.
     if (self%result%max_abs_f > 0.) then
        max_abs_f = self%result%max_abs_f
     end if
   end function vegas_get_max_abs_f
 
 @ %def vegas_get_max_abs_f
 @ Get [[f_max_pos]].
 <<vegas: vegas: TBP>>=
   procedure, public :: get_max_abs_f_pos => vegas_get_max_abs_f_pos
 <<vegas: procedures>>=
   elemental real(default) function vegas_get_max_abs_f_pos (self) result (max_abs_f)
     class(vegas_t), intent(in) :: self
     max_abs_f = 0.
     if (self%result%max_abs_f_pos > 0.) then
        max_abs_f = self%result%max_abs_f_pos
     end if
   end function vegas_get_max_abs_f_pos
 
 @ %def vegas_get_max_abs_f_pos
 @ Get [[f_max_neg]].
 <<vegas: vegas: TBP>>=
   procedure, public :: get_max_abs_f_neg => vegas_get_max_abs_f_neg
 <<vegas: procedures>>=
   elemental real(default) function vegas_get_max_abs_f_neg (self) result (max_abs_f)
     class(vegas_t), intent(in) :: self
     max_abs_f = 0.
     if (self%result%max_abs_f_neg > 0.) then
        max_abs_f = self%result%max_abs_f_neg
     end if
   end function vegas_get_max_abs_f_neg
 
 @ %def vegas_get_max_abs_f_neg
 @ Get event weight and excess.
 <<vegas: vegas: TBP>>=
   procedure, public :: get_evt_weight => vegas_get_evt_weight
   procedure, public :: get_evt_weight_excess => vegas_get_evt_weight_excess
 <<vegas: procedures>>=
   real(default) function vegas_get_evt_weight (self) result (evt_weight)
     class(vegas_t), intent(in) :: self
     evt_weight = self%result%evt_weight
   end function vegas_get_evt_weight
 
   real(default) function vegas_get_evt_weight_excess (self) result (evt_weight_excess)
     class(vegas_t), intent(in) :: self
     evt_weight_excess = self%result%evt_weight_excess
   end function vegas_get_evt_weight_excess
 
 @ %def vegas_get_evt_weight, vegas_get_evt_weight_excess
 @ Get and set distribution. Beware! This method is hideous as it allows to
 manipulate the algorithm at its very core.
 <<vegas: vegas: TBP>>=
   procedure, public :: get_distribution => vegas_get_distribution
   procedure, public :: set_distribution => vegas_set_distribution
 <<vegas: procedures>>=
   function vegas_get_distribution (self) result (d)
     class(vegas_t), intent(in) :: self
     real(default), dimension(:, :), allocatable :: d
     d = self%d
   end function vegas_get_distribution
 
   subroutine vegas_set_distribution (self, d)
     class(vegas_t), intent(inout) :: self
     real(default), dimension(:, :), intent(in) :: d
     if (size (d, dim = 2) /= self%config%n_dim) then
        call msg_bug ("[VEGAS] set_distribution: new distribution has wrong size of dimension")
     end if
     if (size (d, dim = 1) /= self%config%n_bins_max) then
        call msg_bug ("[VEGAS] set_distribution: new distribution has wrong number of bins")
     end if
     self%d = d
   end subroutine vegas_set_distribution
 
 @ %def vegas_set_distribution, vegas_get_distribution
 @ Send distribution to specified rank, internally in a non-blocking way.
 We send the complete array of [[d]], not just the actually used part.
 <<MPI: vegas: vegas: TBP>>=
   procedure, public :: send_distribution => vegas_send_distribution
 <<MPI: vegas: procedures>>=
   subroutine vegas_send_distribution (self, receiver, tag)
     class(vegas_t), intent(in) :: self
     integer, intent(in) :: receiver
     integer, intent(in) :: tag
     integer :: j
     type(MPI_Request), dimension(self%config%n_dim + 2) :: request
     call MPI_Isend (self%bin, self%config%n_dim, MPI_INTEGER, receiver, tag + 1&
          &, MPI_COMM_WORLD, request(1))
     call MPI_Isend (self%box, self%config%n_dim, MPI_INTEGER, receiver, tag + 2&
          &, MPI_COMM_WORLD, request(2))
     do j = 1, self%config%n_dim
        call MPI_Isend (self%d(:, j), self%config%n_bins_max,&
             & MPI_DOUBLE_PRECISION, receiver, tag + j + 2, MPI_COMM_WORLD,&
             & request(j + 2))
     end do
     call MPI_Waitall (self%config%n_dim, request, MPI_STATUSES_IGNORE)
   end subroutine vegas_send_distribution
 
 @ %def vegas_send_distribution
 @ Receive distribution from specified rank, internally in a non-blocking way.
 <<MPI: vegas: vegas: TBP>>=
   procedure, public :: receive_distribution => vegas_receive_distribution
 <<MPI: vegas: procedures>>=
   subroutine vegas_receive_distribution (self, sender, tag)
     class(vegas_t), intent(inout) :: self
     integer, intent(in) :: sender
     integer, intent(in) :: tag
     integer :: j
     type(MPI_Request), dimension(self%config%n_dim + 2) :: request
     call MPI_Irecv (self%bin, self%config%n_dim, MPI_INTEGER, sender, tag + 1&
          &, MPI_COMM_WORLD, request(1))
     call MPI_Irecv (self%box, self%config%n_dim, MPI_INTEGER, sender, tag + 2&
          &, MPI_COMM_WORLD, request(2))
     do j = 1, self%config%n_dim
        call MPI_Irecv (self%d(:, j), self%config%n_bins_max,&
             & MPI_DOUBLE_PRECISION, sender, tag + j + 2, MPI_COMM_WORLD,&
             & request(j + 2))
     end do
     call MPI_Waitall (self%config%n_dim, request, MPI_STATUSES_IGNORE)
   end subroutine vegas_receive_distribution
 
 @ %def vegas_receive_distribution
 \section{Grid resize- and refinement}
 \label{sec:grid-resize-refin}
 
 Before integration the grid itself must be initialised. Given the number of
 [[n_calls]] and [[n_dim]] we prepare the grid for the integration.
 
 The grid is binned according to the VEGAS mode and [[n_calls]]. If the mode is
 not set to [[vegas_importance_only]], the grid is divided in to equal boxes. We
 try for 2 calls per box
 \begin{equation}
   boxes = \sqrt[n_{dim}]{\frac{calls}{2}}.
 \end{equation}
 If the numbers of boxes exceeds the number of bins, which is the case for low
 dimensions, the algorithm switches to stratified sampling. Otherwise, we are
 still using importance sampling, but keep the boxes for book keeping. If the
 number of bins changes from the previous invocation, bins are expanded or
 contracted accordingly, while preserving bin density.
 <<vegas: vegas: TBP>>=
   procedure, private :: init_grid => vegas_init_grid
 <<vegas: procedures>>=
   subroutine vegas_init_grid (self)
     class(vegas_t), intent(inout) :: self
     integer :: n_bins, n_boxes, box_per_bin, n_total_boxes
     real(default), dimension(:, :), allocatable :: w
     n_bins = self%config%n_bins_max
     n_boxes = 1
     if (self%config%mode /= VEGAS_MODE_IMPORTANCE_ONLY) then
        ! We try for 2 calls per box
        n_boxes = max (floor ((self%config%n_calls / 2.)**(1. / self%config%n_dim)), 1)
        self%config%mode = VEGAS_MODE_IMPORTANCE
        if (2 * n_boxes >= self%config%n_bins_max) then
           ! if n_bins/box < 2
           box_per_bin = max (n_boxes / self%config%n_bins_max, 1)
           n_bins =  min (n_boxes / box_per_bin, self%config%n_bins_max)
           n_boxes = box_per_bin * n_bins
           self%config%mode = VEGAS_MODE_STRATIFIED
        end if
     end if
     n_total_boxes = n_boxes**self%config%n_dim
     self%config%calls_per_box = max (floor (real (self%config%n_calls) / n_total_boxes), 2)
     self%config%n_calls = self%config%calls_per_box * n_total_boxes
     !  Total volume of x-space/(average n_calls per bin)
     self%jacobian = self%hypercube_volume * real(n_bins, default)&
          &**self%config%n_dim / real(self%config%n_calls, default)
     self%config%n_boxes = n_boxes
     if (n_bins /= self%config%n_bins) then
        allocate (w(self%config%n_bins, self%config%n_dim), source=1.0_default)
        call self%grid%resize (n_bins, w)
        self%config%n_bins = n_bins
     end if
   end subroutine vegas_init_grid
 
 @ %def vegas_init_grid
 @ Reset the cumulative result, and efficiency and max. grid values.
 <<vegas: vegas: TBP>>=
   procedure, public :: reset_result => vegas_reset_result
 <<vegas: procedures>>=
   subroutine vegas_reset_result (self)
     class(vegas_t), intent(inout) :: self
     self%result%sum_int_wgtd = 0.
     self%result%sum_wgts = 0.
     self%result%sum_chi = 0.
     self%result%it_num = 0
     self%result%samples = 0
     self%result%chi2 = 0
     self%result%efficiency = 0.
     self%result%efficiency_pos = 0.
     self%result%efficiency_neg = 0.
     self%result%max_abs_f = 0.
     self%result%max_abs_f_pos = 0.
     self%result%max_abs_f_neg = 0.
   end subroutine vegas_reset_result
 
 @ %def vegas_reset_results
 @ Reset the grid. Purge the adapted grid and the distribution.
 Furthermore, reset the results. The maximal size of the grid remains.
 
 Note: Handle [[vegas_reset_grid]] with great care! Instead of reusing an old
 object, create a new one.
 <<vegas: vegas: TBP>>=
   procedure, public :: reset_grid => vegas_reset_grid
 <<vegas: procedures>>=
   subroutine vegas_reset_grid (self)
     class(vegas_t), intent(inout) :: self
     self%config%n_bins = 1
     self%d = 0._default
     self%grid%xi = 0._default
     self%grid%xi(1, :) = 0._default
     self%grid%xi(2, :) = 1._default
     call self%reset_result ()
   end subroutine vegas_reset_grid
 
 @ %def vegas_reset_grid
 @ Refine the grid to match the distribution [[d]].
 
 Average the distribution over neighbouring bins, then contract or expand the bins.
 The averaging dampens high fluctuations amog the integrand or the variance.
 
 We make the type-bound procedure public accessible because the multi-channel
 integration refines each grid after integration over all grids.
 <<vegas: vegas: TBP>>=
   procedure, public :: refine => vegas_refine_grid
 <<vegas: procedures>>=
   subroutine vegas_refine_grid (self)
     class(vegas_t), intent(inout) :: self
     integer :: j
     real(default), dimension(self%config%n_bins, self%config%n_dim) :: w
     ndim: do j = 1, self%config%n_dim
        call average_distribution (self%config%n_bins, self%d(:self%config&
             &%n_bins, j), self%config%alpha, w(:, j))
     end do ndim
     call self%grid%resize (self%config%n_bins, w)
   contains
     <<vegas: vegas refine grid: procedures>>
   end subroutine vegas_refine_grid
 
 @ %def vegas_refine_grid
 @ We average the collected values [[d]] of the (sq.) weighted [[f]] over
 neighbouring bins. The averaged [[d]] are then agian damped by a logarithm to
 enhance numerical stability. The results are then the refinement weights [[w]].
 
 We have to take care of the special case where we have a very low sampling rate.
 In those cases we can not be sure that the distribution is satisfying filled,
 although we have already averaged over neighbouring bins. This will lead to a
 squashing of the unfilled bins and such the boundaries of those will be pushed
 together. We circumvent this problem by setting those unfilled bins to the
 smallest representable value of a default real.
 
 The problem becomes very annoying in the multi-channel formualae where have to
 look up via binary search the corresponding probability of [[x]] and if the
 width is zero, the point will be neglected.
 <<vegas: vegas refine grid: procedures>>=
   subroutine average_distribution (n_bins, d, alpha, w)
     integer, intent(in) :: n_bins
     real(default), dimension(:), intent(inout) :: d
     real(default), intent(in) :: alpha
     real(default), dimension(n_bins), intent(out) :: w
     if (n_bins > 2) then
        d(1) = (d(1) + d(2)) / 2.0_default
        d(2:n_bins - 1) = (d(1:n_bins - 2) + d(2:n_bins - 1) + d(3:n_bins)) /&
             & 3.0_default
        d(n_bins) = d(n_bins - 1) + d(n_bins) / 2.0_default
     end if
     w = 1.0_default
     if (.not. all (d < tiny (1.0_default))) then
        d = d / sum (d)
        where (d < tiny (1.0_default))
           d = tiny (1.0_default)
        end where
        where (d /= 1.0_default)
           w = ((d - 1.) / log(d))**alpha
        elsewhere
           ! Analytic limes for d -> 1
           w = 1.0_default
        end where
     end if
   end subroutine average_distribution
 
 @ %def average_distribution
 @
 \section{Integration}
 \label{sec:integration}
 
 Integrate [[func]], in the previous set bounds [[x_lower]] to [[x_upper]], with [[n_calls]].
 Use results from previous invocations of [[integrate]] with [[opt_reset_result =
 .false.]] and better with subsequent calls.
 
 Before we walk through the hybercube, we initialise the grid (at a central position).
 
 We step through the (equidistant) boxes which ensure we do not miss any place in the n-dim. hypercube.
 In each box we sample [[calls_per_box]] random points and transform them to bin coordinates.
 The total integral and the total (sample) variance over each box $i$ is then calculated by
 \begin{align*}
   E(I)_{i} = \sum_{j}^{\text{calls per box}} I_{i, j}, \\
   V(I)_{i} = \text{calls per box} \frac{\sum_{j}^{\text{calls per box}}} I_{i, j}^{2} - (\sum_{j}^{\text{calls per box}} I_{i, j})**2 \frac{\text{calls per box}}{\text{calls per box} - 1}.
 \end{align*}
 The stratification of the $n$-dimensional hybercube allows a simple
 parallelisation of the algorithm (R. Kreckel, "Parallelization of adaptive MC integrators", Computer Physics Communications, vol. 106, no. 3, pp. 258–266, Nov. 1997.).
 We have to ensure that all boxes are sampled, but the number of boxes to
 distribute is too large. We allow each thread to sample a fraction $r$ of all
 boxes $k$ such that $r \ll k$. Furthermore, we constrain that the number of
 process $p$ is much smaller than $r$.
 
 The overall constraint is
 \begin{equation}
 p \ll r \ll k.
 \end{equation}
 We divide the intgeration into a parallel and
 a perpendicular subspace. The number of parallel dimensions is $D_{\parallel} =
 \lfloor \frac{D}{2} \rfloor$.
 <<vegas: vegas: TBP>>=
   procedure, public :: integrate => vegas_integrate
 <<vegas: procedures>>=
   subroutine vegas_integrate (self, func, rng, iterations, opt_reset_result,&
        & opt_refine_grid, opt_verbose, result, abserr)
     class(vegas_t), intent(inout) :: self
     class(vegas_func_t), intent(inout) :: func
     class(rng_t), intent(inout) :: rng
     integer, intent(in), optional :: iterations
     logical, intent(in), optional :: opt_reset_result
     logical, intent(in), optional :: opt_refine_grid
     logical, intent(in), optional :: opt_verbose
     real(default), optional, intent(out) :: result, abserr
     integer :: it, j, k
     real(default), dimension(self%config%n_dim) :: x
     real(default) :: fval, fval_sq, bin_volume
     real(default) :: fval_box, fval_sq_box
     real(default) :: total_integral, total_sq_integral, total_variance, chi, wgt
     real(default) :: cumulative_int, cumulative_std
     real(default) :: sum_abs_f_pos, max_abs_f_pos
     real(default) :: sum_abs_f_neg, max_abs_f_neg
     logical :: reset_result = .true.
     logical :: refine_grid = .true.
     logical :: verbose = .false.
   <<vegas: vegas integrate: variables>>
     if (present (iterations)) self%config%iterations = iterations
     if (present (opt_reset_result)) reset_result = opt_reset_result
     if (present (opt_refine_grid)) refine_grid = opt_refine_grid
     if (present (opt_verbose)) verbose = opt_verbose
   <<vegas: vegas integrate: initialization>>
     if (verbose) then
        call msg_message ("Results: [it, calls, integral, error, chi^2, eff.]")
     end if
     iteration: do it = 1, self%config%iterations
      <<vegas: vegas integrate: pre sampling>>
        loop_over_par_boxes: do while (box_success)
           loop_over_perp_boxes: do while (box_success)
              fval_box = 0._default
              fval_sq_box = 0._default
              if (debug2_active (D_VAMP2)) then
                 print *, "box:"
                 print *, self%box
              end if
              do k = 1, self%config%calls_per_box
                 call self%random_point (rng, x, bin_volume)
                 ! Call the function, yeah, call it...
                 fval = self%jacobian * bin_volume * func%evaluate (x)
                 fval_sq = fval**2
                 fval_box = fval_box + fval
                 fval_sq_box = fval_sq_box + fval_sq
                 if (fval > 0.) then
                    max_abs_f_pos = max(abs (fval), max_abs_f_pos)
                    sum_abs_f_pos = sum_abs_f_pos + abs(fval)
                 else
                    max_abs_f_neg = max(abs (fval), max_abs_f_neg)
                    sum_abs_f_neg = sum_abs_f_neg + abs(fval)
                 end if
                 if (self%config%mode /= VEGAS_MODE_STRATIFIED) then
                    call self%accumulate_distribution (fval_sq)
                 end if
                 if (debug2_active (D_VAMP2)) then
                    print *, "fval          = ", fval
                    print *, "fval_sq       = ", fval_sq
                    print *, "fval_box      = ", fval_box
                    print *, "fval_box_sq   = ", fval_sq_box
                    print *, "sum_abs_f_pos = ", sum_abs_f_pos
                    print *, "sum_abs_f_neg = ", sum_abs_f_neg
                    print *, "max_abs_f_pos = ", max_abs_f_pos
                    print *, "max_abs_f_neg = ", max_abs_f_neg
                 end if
              end do
              fval_sq_box = sqrt (fval_sq_box * self%config%calls_per_box)
              ! (a - b) * (a + b) = a**2 - b**2
              fval_sq_box = (fval_sq_box - fval_box) * (fval_sq_box + fval_box)
              if (fval_sq_box <= 0.0) fval_sq_box = tiny (1.0_default)
              total_integral = total_integral + fval_box
              total_sq_integral = total_sq_integral + fval_sq_box
              if (self%config%mode == VEGAS_MODE_STRATIFIED) then
                 call self%accumulate_distribution (fval_sq_box)
              end if
              call increment_box_coord (self%box(n_dim_par + 1:self%config&
                   &%n_dim), box_success)
           end do loop_over_perp_boxes
           shift: do k = 1, n_size
              call increment_box_coord (self%box(1:n_dim_par), box_success)
              if (.not. box_success) exit shift
           end do shift
           <<vegas: vegas integrate: sampling>>
        end do loop_over_par_boxes
      <<vegas: vegas integrate: post sampling>>
        associate (result => self%result)
          ! Compute final results for this iterations
          total_variance = total_sq_integral / (self%config%calls_per_box - 1.)
          ! Ensure variance is always positive and larger than zero.
          if (total_variance < tiny (1._default) / epsilon (1._default) &
               & * max (total_integral**2, 1._default)) then
             total_variance = tiny (1._default) / epsilon (1._default) &
                  & * max (total_integral**2, 1._default)
          end if
          wgt = 1. / total_variance
          total_sq_integral = total_integral**2
          result%result = total_integral
          result%std = sqrt (total_variance)
          result%samples = result%samples + 1
          if (result%samples == 1) then
             result%chi2 = 0._default
          else
             chi = total_integral
             if (result%sum_wgts > 0) then
                chi = chi - result%sum_int_wgtd / result%sum_wgts
             end if
             result%chi2 = result%chi2 * (result%samples - 2.0_default)
             result%chi2 = (wgt / (1._default + (wgt / result%sum_wgts))) &
                  & * chi**2
             result%chi2 = result%chi2 / (result%samples - 1._default)
          end if
          result%sum_wgts = result%sum_wgts + wgt
          result%sum_int_wgtd = result%sum_int_wgtd + (total_integral * wgt)
          result%sum_chi = result%sum_chi + (total_sq_integral * wgt)
          cumulative_int = result%sum_int_wgtd / result%sum_wgts
          cumulative_std = sqrt (1. / result%sum_wgts)
        end associate
        call calculate_efficiency ()
        if (verbose) then
-          write (msg_buffer, "(I0,1x,I0,1x, 4(" // FMT_17 // ",1x))") &
+          write (msg_buffer, "(I0,1x,I0,1x, 4(E16.8E4,1x))") &
                & it, self%config%n_calls, cumulative_int, cumulative_std, &
                & self%result%chi2, self%result%efficiency
           call msg_message ()
        end if
        if (refine_grid) call self%refine ()
     end do iteration
     if (present(result)) result = cumulative_int
     if (present(abserr)) abserr = abs(cumulative_std)
   contains
   <<vegas: vegas integrate: procedures>>
   end subroutine vegas_integrate
 
 @ %def vegas_integrate
 @ Calculate the extras here.
 We define
 \begin{equation}
 \operatorname*{max}_{x} w(x) = \frac{f(x)}{p(x)} \Delta_{\text{jac}}.
 \end{equation}
 In the implementation we have to factor out [[n_calls]] in the jacobian.
 Also, during event generation.
 <<vegas: vegas integrate: procedures>>=
   subroutine calculate_efficiency ()
     self%result%max_abs_f_pos = self%config%n_calls * max_abs_f_pos
     self%result%max_abs_f_neg = self%config%n_calls * max_abs_f_neg
     call msg_debug (D_VAMP2, "max_abs_f_pos", self%result%max_abs_f_pos)
     call msg_debug (D_VAMP2, "max_abs_f_neg", self%result%max_abs_f_neg)
     call msg_debug (D_VAMP2, "sum_abs_f_pos", sum_abs_f_pos)
     call msg_debug (D_VAMP2, "sum_abs_f_neg", sum_abs_f_neg)
     self%result%max_abs_f = &
          & max (self%result%max_abs_f_pos, self%result%max_abs_f_neg)
     self%result%efficiency_pos = 0.
     if (max_abs_f_pos > 0.) then
        self%result%efficiency_pos = &
             & sum_abs_f_pos / max_abs_f_pos
     end if
     self%result%efficiency_neg = 0.
     if (max_abs_f_neg > 0.) then
        self%result%efficiency_neg = &
             & sum_abs_f_neg / max_abs_f_neg
     end if
     self%result%efficiency = 0.
     if (self%result%max_abs_f > 0.) then
        self%result%efficiency = (sum_abs_f_pos + sum_abs_f_neg) &
             & / self%result%max_abs_f
     end if
   end subroutine calculate_efficiency
 
 @ %def calculate_efficiency
 @ We define additional chunk, which will be used later on for inserting
 MPI/general MPI code. The code can is then removed by additional noweb filter if
 not compiled with the correspondig compiler flag.
 
 Overall variables, some additionally introduced due to the MPI parallelization
 and needed in sequentiell verison.
 <<vegas: vegas integrate: variables>>=
   integer :: n_size
   integer :: n_dim_par
   logical :: box_success
   ! MPI-specific variables below
 @ Overall initialization.
 <<vegas: vegas integrate: initialization>>=
   call self%init_grid ()
   if (reset_result) call self%reset_result ()
   self%result%it_start = self%result%it_num
   cumulative_int = 0.
   cumulative_std = 0.
   n_size = 1
   n_dim_par = floor (self%config%n_dim / 2.)
 @ Reset all last-iteration results before sampling.
 <<vegas: vegas integrate: pre sampling>>=
   self%result%it_num = self%result%it_start + it
   self%d = 0.
   self%box = 1
   self%bin = 1
   total_integral = 0.
   total_sq_integral = 0.
   total_variance = 0.
   sum_abs_f_pos = 0.
   max_abs_f_pos = 0.
   sum_abs_f_neg = 0.
   max_abs_f_neg = 0.
   box_success = .true.
   select type (rng)
   type is (rng_stream_t)
      call rng%next_substream ()
   end select
 @ Pacify output by defining empty chunk (nothing to do here).
 <<vegas: vegas integrate: sampling>>=
 @
 <<vegas: vegas integrate: post sampling>>=
 @ Increment the box coordinates by 1. If we reach the largest value for the
 current axis (starting with the largest dimension number), we reset the counter
 to 1 and increment the next axis counter by 1. And so on, until we reach the
 maximum counter value of the axis with the lowest dimension, then we set
 [[success]] to false and the box coord is set to 1.
 <<vegas: vegas integrate: procedures>>=
   subroutine increment_box_coord (box, success)
     integer, dimension(:), intent(inout) :: box
     logical, intent(out) :: success
     integer :: j
     success = .true.
     do j = size (box), 1, -1
        box(j) = box(j) + 1
        if (box(j) <= self%config%n_boxes) return
        box(j) = 1
     end do
     success = .false.
   end subroutine increment_box_coord
 
 @ %def increment_box_coord
 @ We parallelize [[VEGAS]] in simple forward manner. The hyper-cube is dissambled
 in to equidistant boxes in which we sample the integrand [[calls_per_box]]
 times. The workload of calculating those boxes is distributed along the worker.
 
 The number of dimensions which will be parallelised are $\lfloor \frac{D}{2}
 \rfloor$, such MPI Variables for [[vegas_integrate]]. We have to duplicate all
 buffers for [[MPI_Ireduce]], because we cannot use the same send or receive
 buffer.
 
 We temporarily store a (empty) grid, before communicating.
 <<MPI: vegas: vegas integrate: variables>>=
   integer :: rank
   type(vegas_grid_t) :: grid
 @ MPI procedure-specific initialization.
 <<MPI: vegas: vegas integrate: initialization>>=
   call MPI_Comm_size (MPI_COMM_WORLD, n_size)
   call MPI_Comm_rank (MPI_COMM_WORLD, rank)
 @ Pre-sampling communication.
 
 We make a copy of the (actual) grid, which is unfilled when non-root.
 The actual grid is then broadcasted among the workers and inserted into the
 [[VEGAS]] object.
 <<MPI: vegas: vegas integrate: pre sampling>>=
   if (self%is_parallelizable ()) then
      grid = self%get_grid ()
      call grid%broadcast ()
      call self%set_grid (grid)
   end if
 @ Start index of the boxes for different ranks. If the random number generator
 is RngStream, we can advance the current stream in such a way, that we will
 getting matching numbers. Iff [[n_boxes]] is larger than 2, otherwise
 parallelization is useless.
 <<MPI: vegas: vegas integrate: pre sampling>>=
   if (self%is_parallelizable ()) then
      do k = 1, rank
         call increment_box_coord (self%box(1:n_dim_par), box_success)
         if (.not. box_success) exit
      end do
      select type (rng)
      type is (rng_stream_t)
         call rng%advance_state (self%config%n_dim * self%config%calls_per_box&
              & * self%config%n_boxes**(self%config%n_dim - n_dim_par) * rank)
      end select
   end if
 @ Increment [[n_size]] times the box coordinates.
 <<MPI: vegas: vegas integrate: sampling>>=
   if (self%is_parallelizable ()) then
      select type (rng)
      type is (rng_stream_t)
         call rng%advance_state (self%config%n_dim * self%config%calls_per_box&
              & * self%config%n_boxes**(self%config%n_dim - n_dim_par) * (n_size - 1))
      end select
   end if
 @ Call to [[vegas_integrate_collect]].
 <<MPI: vegas: vegas integrate: post sampling>>=
   if (self%is_parallelizable ()) then
      call vegas_integrate_collect ()
      if (rank /= 0) cycle iteration
   end if
 @ Reduce (in an non-blocking fashion) all sampled information via [[MPI_SUM]] or [[MPI_MAX]].
 <<MPI: vegas: vegas integrate: procedures>>=
   subroutine vegas_integrate_collect ()
     real(default) :: root_total_integral, root_total_sq_integral
     real(default) :: root_sum_abs_f_pos, root_max_abs_f_pos
     real(default) :: root_sum_abs_f_neg, root_max_abs_f_neg
     real(default), dimension(self%config%n_bins_max, self%config%n_dim) :: root_d
     type(MPI_Request), dimension(self%config%n_dim + 6) :: status
     root_d = 0._default
     root_sum_abs_f_pos = 0._default
     root_sum_abs_f_neg = 0._default
     root_max_abs_f_pos = 0._default
     root_sum_abs_f_neg = 0._default
     root_total_integral = 0._default
     root_total_sq_integral = 0._default
     call MPI_Ireduce (sum_abs_f_pos, root_sum_abs_f_pos, 1, MPI_DOUBLE_PRECISION,&
          & MPI_SUM, 0, MPI_COMM_WORLD, status(1))
     call MPI_Ireduce (sum_abs_f_neg, root_sum_abs_f_neg, 1, MPI_DOUBLE_PRECISION,&
          & MPI_SUM, 0, MPI_COMM_WORLD, status(2))
     call MPI_Ireduce (max_abs_f_pos, root_max_abs_f_pos, 1, MPI_DOUBLE_PRECISION,&
          & MPI_MAX, 0, MPI_COMM_WORLD, status(3))
     call MPI_Ireduce (max_abs_f_neg, root_max_abs_f_neg, 1, MPI_DOUBLE_PRECISION,&
          & MPI_MAX, 0, MPI_COMM_WORLD, status(4))
     call MPI_Ireduce (total_integral, root_total_integral, 1, MPI_DOUBLE_PRECISION,&
          & MPI_SUM, 0, MPI_COMM_WORLD, status(5))
     call MPI_Ireduce (total_sq_integral, root_total_sq_integral, 1,&
          & MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, status(6))
     do j = 1, self%config%n_dim
        call MPI_Ireduce (self%d(1:self%config%n_bins, j), root_d(1:self%config&
             &%n_bins, j), self%config%n_bins, MPI_DOUBLE_PRECISION, MPI_SUM, 0,&
             & MPI_COMM_WORLD, status(6 + j))
     end do
     call MPI_Waitall (self%config%n_dim + 6, status, MPI_STATUSES_IGNORE)
     if (rank == 0) sum_abs_f_pos = root_sum_abs_f_pos
     if (rank == 0) sum_abs_f_neg = root_sum_abs_f_neg
     if (rank == 0) max_abs_f_pos = root_max_abs_f_pos
     if (rank == 0) max_abs_f_neg = root_max_abs_f_neg
     if (rank == 0) total_integral = root_total_integral
     if (rank == 0) total_sq_integral = root_total_sq_integral
     if (rank == 0) self%d = root_d
   end subroutine vegas_integrate_collect
 
 @ %def vegas_integrate_collect
 @ Obtain a random point inside the $n$-dimensional hypercube, transform onto the correct interval and calculate the bin volume. The additional factor [[n_bins]] is already applied to the [[jacobian]] (per dimension).
 <<vegas: vegas: TBP>>=
   procedure, private :: random_point => vegas_random_point
 <<vegas: procedures>>=
   subroutine vegas_random_point (self, rng, x, bin_volume)
     class(vegas_t), intent(inout) :: self
     class(rng_t), intent(inout) :: rng
     real(default), dimension(self%config%n_dim), intent(out) :: x
     real(default), intent(out) :: bin_volume
     integer :: j
     real(default) :: r, y, z, bin_width
     bin_volume = 1.
     ndim: do j = 1, self%config%n_dim
        call msg_debug2 (D_VAMP2, "j", j)
        call rng%generate (r)
        z = ((self%box(j) - 1 + r) / self%config%n_boxes) * self%config%n_bins + 1
        self%bin(j) = max (min (int (z), self%config%n_bins), 1)
        if (self%bin(j) == 1) then
           bin_width = self%grid%xi(2, j)
           y = (z - self%bin(j)) * bin_width
        else
           bin_width = self%grid%xi(self%bin(j) + 1, j) - self%grid%xi(self%bin(j), j)
           y = self%grid%xi(self%bin(j), j) + (z - self%bin(j)) * bin_width
        end if
        x(j) = self%grid%x_lower(j) + y * self%grid%delta_x(j)
        bin_volume = bin_volume * bin_width
        if (debug2_active (D_VAMP2)) then
           print *, "r      =", r
           print *, "z      =", z
           print *, "bin(j) =", self%bin(j)
           print *, "y      =", y
           print *, "x(j)   =", x(j)
        end if
     end do ndim
     call msg_debug2 (D_VAMP2, "bin_volume", bin_volume)
   end subroutine vegas_random_point
 
 @ %def vegas_random_point
 @ Obtain a random point inside the $n$-dimensional hyper-cube. We neglect
 stratification and generate the random point in the most simple way. Hence, we
 do not need to know in which box we are actually sampling. This is useful for
 only for event generation.
 <<vegas: vegas: TBP>>=
   procedure, private :: simple_random_point => vegas_simple_random_point
 <<vegas: procedures>>=
   subroutine vegas_simple_random_point (self, rng, x, bin_volume)
     class(vegas_t), intent(inout) :: self
     class(rng_t), intent(inout) :: rng
     real(default), dimension(self%config%n_dim), intent(out) :: x
     real(default), intent(out) :: bin_volume
     integer :: j, k
     real(default) :: r, y, z, bin_width
     bin_volume = 1.
     ndim: do j = 1, self%config%n_dim
        call msg_debug2 (D_VAMP2, "j", j)
        call rng%generate (r)
        z = r * self%config%n_bins + 1
        k = max (min (int (z), self%config%n_bins), 1)
        if (k == 1) then
           bin_width = self%grid%xi(2, j)
           y = (z - 1) * bin_width
        else
           bin_width = self%grid%xi(k + 1, j) - self%grid%xi(k, j)
           y = self%grid%xi(k, j) + (z - k) * bin_width
        end if
        x(j) = self%grid%x_lower(j) + y * self%grid%delta_x(j)
        bin_volume = bin_volume * bin_width
        if (debug2_active (D_VAMP2)) then
           print *, "r      =", r
           print *, "z      =", z
           print *, "bin(j) =", self%bin(j)
           print *, "y      =", y
           print *, "x(j)   =", x(j)
        end if
     end do ndim
     call msg_debug2 (D_VAMP2, "bin_volume", bin_volume)
   end subroutine vegas_simple_random_point
 
 @ %def vegas_simple_random_point
 @
 <<vegas: vegas: TBP>>=
   procedure, private :: accumulate_distribution => vegas_accumulate_distribution
 <<vegas: procedures>>=
   subroutine vegas_accumulate_distribution (self, y)
     class(vegas_t), intent(inout) :: self
     real(default), intent(in) :: y
     integer :: j
     do j = 1, self%config%n_dim
        self%d(self%bin(j), j) = self%d(self%bin(j), j) + y
     end do
   end subroutine vegas_accumulate_distribution
 
 @ %def vegas_accumulate_distribution
 @ Generate weighted random event.
 
 The weight given by the overall jacobian
 \begin{equation}
  \Delta_{\text{jac}} = \prod_{j=1}^{d} \left( x_j^+ - x_j^- \right) \frac{N_{\text{bins}}^d}{N_{\text{calls}}}
 \end{equation}
 includes the overall non-changing factors $\frac{1}{N_{\text{calls}}}$-factor (divisions are
 expensive) and $N_{\text{bins}}^{d}$, the latter combined with [[bin_volume]]
 gives rise to the probability, see [[vegas_init_grid]] for details.
 We have to factor out $N_{\text{calls}}$ to retrieve the correct weight.
 <<vegas: vegas: TBP>>=
   procedure :: generate_weighted => vegas_generate_weighted_event
 <<vegas: procedures>>=
   subroutine vegas_generate_weighted_event (self, func, rng, x)
     class(vegas_t), intent(inout) :: self
     class(vegas_func_t), intent(inout) :: func
     class(rng_t), intent(inout) :: rng
     real(default), dimension(self%config%n_dim), intent(inout) :: x
     real(default) :: bin_volume
     call self%simple_random_point (rng, x, bin_volume)
     ! Cancel n_calls from jacobian with n_calls
     self%result%evt_weight = self%config%n_calls * self%jacobian * bin_volume &
          & * func%evaluate (x)
     call msg_debug (D_VAMP2, "Event weight", self%result%evt_weight)
   end subroutine vegas_generate_weighted_event
 
 @ %def vegas_generate_weighted_event
 @ Generate random event. We accept on the rate
 \begin{equation}
   \frac{|f(x)|}{\underset{x}{\max} |f(x)|}.
 \end{equation}
 We keep separate maximum weights for positive and negative weights, and use
 them, accordingly.
 In the case of unweighted event generation, if the current weight exceeds the
 the maximum weight, we update the maximum, accordingly.
 <<vegas: vegas: TBP>>=
   procedure, public :: generate_unweighted=> vegas_generate_unweighted_event
 <<vegas: procedures>>=
   subroutine vegas_generate_unweighted_event (self, func, rng, x)
     class(vegas_t), intent(inout) :: self
     class(vegas_func_t), intent(inout) :: func
     class(rng_t), intent(inout) :: rng
     real(default), dimension(self%config%n_dim), intent(out) :: x
     real(default) :: bin_volume
     real(default) :: max_abs_f
     real(default) :: r
     associate (result => self%result)
       generate: do
          call self%generate_weighted (func, rng, x)
          max_abs_f = merge (result%max_abs_f_pos, result%max_abs_f_neg, &
               & result%evt_weight > 0.)
          if (result%evt_weight > max_abs_f) then
             result%evt_weight_excess = &
                  & result%evt_weight / max_abs_f - 1._default
             exit generate
          end if
          call rng%generate (r)
          if (debug2_active (D_VAMP2)) then
             print *, "max_abs_f    = ", max_abs_f
             print *, "accept       = ", max_abs_f * r
             print *, "x            = ", x
          end if
          ! Do not use division, because max_abs_f could be zero.
          if (max_abs_f * r <= abs(result%evt_weight)) then
           exit generate
          end if
       end do generate
     end associate
   end subroutine vegas_generate_unweighted_event
 
 @ %def vegas_random_event
 \section{I/0 operation}
 \label{sec:i0-operation}
 @ Write grid to file. We use the original VAMP formater.
 <<vegas: parameters>>=
   character(len=*), parameter, private :: &
      descr_fmt =         "(1X,A)", &
      integer_fmt =       "(1X,A18,1X,I15)", &
      integer_array_fmt = "(1X,I18,1X,I15)", &
      logical_fmt =       "(1X,A18,1X,L1)", &
-     double_fmt =        "(1X,A18,1X," // FMT_17 // ")", &
-     double_array_fmt =  "(1X,I18,1X," // FMT_17 // ")", &
-     double_array2_fmt =  "(1X,2(1X,I8),1X," // FMT_17 // ")"
+     double_fmt =        "(1X,A18,1X,E16.8E4)", &
+     double_array_fmt =  "(1X,I18,1X,E16.8E4)", &
+     double_array2_fmt =  "(1X,2(1X,I8),1X,E16.8E4)"
 
 @ %def descr_fmt integer_fmt integer_array_fmt logical_fmt
 @ %def double_fmt double_array_fmt double_array2_fmt
 <<vegas: vegas: TBP>>=
   procedure, public :: write_grid => vegas_write_grid
 <<vegas: procedures>>=
   subroutine vegas_write_grid (self, unit)
     class(vegas_t), intent(in) :: self
     integer, intent(in), optional :: unit
     integer :: u
     integer :: i, j
     u = given_output_unit (unit)
     write (u, descr_fmt) "begin type(vegas_t)"
     write (u, integer_fmt) "n_dim =", self%config%n_dim
     write (u, integer_fmt) "n_bins_max =", self%config%n_bins_max
     write (u, double_fmt) "alpha =", self%config%alpha
     write (u, integer_fmt) "iterations =", self%config%iterations
     write (u, integer_fmt) "mode =", self%config%mode
     write (u, integer_fmt) "calls_per_box =", self%config%calls_per_box
     write (u, integer_fmt) "n_calls =", self%config%n_calls
     write (u, integer_fmt) "n_calls_min =", self%config%n_calls_min
     write (u, integer_fmt) "n_boxes =", self%config%n_boxes
     write (u, integer_fmt) "n_bins =", self%config%n_bins
     write (u, integer_fmt) "it_start =", self%result%it_start
     write (u, integer_fmt) "it_num =", self%result%it_num
     write (u, integer_fmt) "samples =", self%result%samples
     write (u, double_fmt) "sum_int_wgtd =", self%result%sum_int_wgtd
     write (u, double_fmt) "sum_wgts =", self%result%sum_wgts
     write (u, double_fmt) "sum_chi =", self%result%sum_chi
     write (u, double_fmt) "chi2 =", self%result%chi2
     write (u, double_fmt) "efficiency =", self%result%efficiency
     write (u, double_fmt) "efficiency =", self%result%efficiency_pos
     write (u, double_fmt) "efficiency =", self%result%efficiency_neg
     write (u, double_fmt) "max_abs_f =", self%result%max_abs_f
     write (u, double_fmt) "max_abs_f_pos =", self%result%max_abs_f_pos
     write (u, double_fmt) "max_abs_f_neg =", self%result%max_abs_f_neg
     write (u, double_fmt) "result =", self%result%result
     write (u, double_fmt) "std =", self%result%std
     write (u, double_fmt) "hypercube_volume =", self%hypercube_volume
     write (u, double_fmt) "jacobian =", self%jacobian
     write (u, descr_fmt) "begin x_lower"
     do j = 1, self%config%n_dim
        write (u, double_array_fmt) j, self%grid%x_lower(j)
     end do
     write (u, descr_fmt) "end x_lower"
     write (u, descr_fmt) "begin x_upper"
     do j = 1, self%config%n_dim
        write (u, double_array_fmt) j, self%grid%x_upper(j)
     end do
     write (u, descr_fmt) "end x_upper"
     write (u, descr_fmt) "begin delta_x"
     do j = 1, self%config%n_dim
        write (u, double_array_fmt) j, self%grid%delta_x(j)
     end do
     write (u, descr_fmt) "end delta_x"
     write (u, integer_fmt) "n_bins =", self%config%n_bins
     write (u, descr_fmt) "begin bin"
     do j = 1, self%config%n_dim
        write (u, integer_array_fmt) j, self%bin(j)
     end do
     write (u, descr_fmt) "end n_bin"
     write (u, integer_fmt) "n_boxes =", self%config%n_boxes
     write (u, descr_fmt) "begin box"
     do j = 1, self%config%n_dim
        write (u, integer_array_fmt) j, self%box(j)
     end do
     write (u, descr_fmt) "end box"
     write (u, descr_fmt) "begin d"
     do j = 1, self%config%n_dim
        do i = 1, self%config%n_bins_max
           write (u, double_array2_fmt) i, j, self%d(i, j)
        end do
     end do
     write (u, descr_fmt) "end d"
     write (u, descr_fmt) "begin xi"
     do j = 1, self%config%n_dim
        do i = 1, self%config%n_bins_max + 1
           write (u,  double_array2_fmt) i, j, self%grid%xi(i, j)
        end do
     end do
     write (u, descr_fmt) "end xi"
     write (u, descr_fmt) "end type(vegas_t)"
   end subroutine vegas_write_grid
 
 @ %def vegas_write_grid
 @ Read grid configuration from file.
 <<vegas: vegas: TBP>>=
   procedure, public :: read_grid => vegas_read_grid
 <<vegas: procedures>>=
   subroutine vegas_read_grid (self, unit)
     class(vegas_t), intent(out) :: self
     integer, intent(in) :: unit
     integer :: i, j
     character(len=80) :: buffer
     integer :: ibuffer, jbuffer
     read (unit, descr_fmt) buffer
     read (unit, integer_fmt) buffer, ibuffer
     read (unit, integer_fmt) buffer, jbuffer
     select type(self)
     type is (vegas_t)
        self = vegas_t (n_dim = ibuffer, n_bins_max = jbuffer)
     end select
     read (unit, double_fmt) buffer, self%config%alpha
     read (unit, integer_fmt) buffer, self%config%iterations
     read (unit, integer_fmt) buffer, self%config%mode
     read (unit, integer_fmt) buffer, self%config%calls_per_box
     read (unit, integer_fmt) buffer, self%config%n_calls
     read (unit, integer_fmt) buffer, self%config%n_calls_min
     read (unit, integer_fmt) buffer, self%config%n_boxes
     read (unit, integer_fmt) buffer, self%config%n_bins
     self%grid%n_bins = self%config%n_bins
     read (unit, integer_fmt) buffer, self%result%it_start
     read (unit, integer_fmt) buffer, self%result%it_num
     read (unit, integer_fmt) buffer, self%result%samples
     read (unit, double_fmt) buffer, self%result%sum_int_wgtd
     read (unit, double_fmt) buffer, self%result%sum_wgts
     read (unit, double_fmt) buffer, self%result%sum_chi
     read (unit, double_fmt) buffer, self%result%chi2
     read (unit, double_fmt) buffer, self%result%efficiency
     read (unit, double_fmt) buffer, self%result%efficiency_pos
     read (unit, double_fmt) buffer, self%result%efficiency_neg
     read (unit, double_fmt) buffer, self%result%max_abs_f
     read (unit, double_fmt) buffer, self%result%max_abs_f_pos
     read (unit, double_fmt) buffer, self%result%max_abs_f_neg
     read (unit, double_fmt) buffer, self%result%result
     read (unit, double_fmt) buffer, self%result%std
     read (unit, double_fmt) buffer, self%hypercube_volume
     read (unit, double_fmt) buffer, self%jacobian
     read (unit, descr_fmt) buffer
     do j = 1, self%config%n_dim
        read (unit, double_array_fmt) jbuffer, self%grid%x_lower(j)
     end do
     read (unit, descr_fmt) buffer
     read (unit, descr_fmt) buffer
     do j = 1, self%config%n_dim
        read (unit, double_array_fmt) jbuffer, self%grid%x_upper(j)
     end do
     read (unit, descr_fmt) buffer
     read (unit, descr_fmt) buffer
     do j = 1, self%config%n_dim
        read (unit, double_array_fmt) jbuffer, self%grid%delta_x(j)
     end do
     read (unit, descr_fmt) buffer
     read (unit, integer_fmt) buffer, self%config%n_bins
     read (unit, descr_fmt) buffer
     do j = 1, self%config%n_dim
        read (unit, integer_array_fmt) jbuffer, self%bin(j)
     end do
     read (unit, descr_fmt) buffer
     read (unit, integer_fmt) buffer, self%config%n_boxes
     read (unit, descr_fmt) buffer
     do j = 1, self%config%n_dim
        read (unit, integer_array_fmt) jbuffer, self%box(j)
     end do
     read (unit, descr_fmt) buffer
     read (unit, descr_fmt) buffer
     do j = 1, self%config%n_dim
        do i = 1, self%config%n_bins_max
           read (unit, double_array2_fmt) ibuffer, jbuffer, self%d(i, j)
        end do
     end do
     read (unit, descr_fmt) buffer
     read (unit, descr_fmt) buffer
     do j = 1, self%config%n_dim
        do i = 1, self%config%n_bins_max + 1
           read (unit,  double_array2_fmt) ibuffer, jbuffer, self%grid%xi(i, j)
        end do
     end do
     read (unit, descr_fmt) buffer
     read (unit, descr_fmt) buffer
   end subroutine vegas_read_grid
 
 @ %def vegas_read_grid
 @
 \section{Unit tests}
 \label{sec:unit-tests}
 
 Test module, followed by the corresponding implementation module.
 
 <<[[vegas_ut.f90]]>>=
 <<File header>>
 
 module vegas_ut
   use unit_tests
   use vegas_uti
 
 <<Standard module head>>
 
 <<vegas: public test>>
 
 contains
 <<vegas: test driver>>
 end module vegas_ut
 @ %def vegas_ut
 @
 <<[[vegas_uti.f90]]>>=
 <<File header>>
 
 module vegas_uti
 <<Use kinds>>
   use io_units
   use constants, only: pi
   use format_defs, only: FMT_10, FMT_12
   use rng_base
   use rng_stream
   use vegas
 
 <<Standard module head>>
 
 <<vegas: test declaration>>
 
 <<vegas: test types>>
 
 contains
 <<vegas: tests>>
 end module vegas_uti
 @ %def vegas_uti
 @ API: driver for the unit tests below.
 <<vegas: public test>>=
   public :: vegas_test
 <<vegas: test driver>>=
   subroutine vegas_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
     <<vegas: execute tests>>
   end subroutine vegas_test
 
 @ %def vegas_test
 @
 \subsubsection{Test function}
 \label{sec:test-function}
 
 We use the example from the Monte Carlo Examples of the GSL library
 \begin{equation}
   I = \int_{-pi}^{+pi} {dk_x/(2 pi)}  \int_{-pi}^{+pi} {dk_y/(2 pi)}  \int_{-pi}^{+pi} {dk_z/(2 pi)}  1 / (1 - cos(k_x)cos(k_y)cos(k_z)).
 \end{equation}
 The integral is reduced to region (0,0,0) $\rightarrow$ ($\pi$, $\pi$, $\pi$) and multiplied by 8.
 <<vegas: test types>>=
   type, extends (vegas_func_t) :: vegas_test_func_t
      !
    contains
    <<vegas: vegas test func: TBP>>
   end type vegas_test_func_t
 
 @ %def vegas_test_func_t
 @ Evaluate the integrand.
 <<vegas: vegas test func: TBP>>=
   procedure, public :: evaluate => vegas_test_func_evaluate
 <<vegas: tests>>=
   real(default) function vegas_test_func_evaluate (self, x) result (f)
     class(vegas_test_func_t), intent(inout) :: self
     real(default), dimension(:), intent(in) :: x
     f = 1.0 / (pi**3)
     f = f / ( 1.0 - cos (x(1)) * cos (x(2)) * cos (x(3)))
   end function vegas_test_func_evaluate
 
 @ %def vegas_test_func_evaluate
 @ The second test function is the normalised n-dim.\@ gaussian distribution.
 <<vegas: test types>>=
   type, extends (vegas_func_t) :: vegas_gaussian_test_func_t
      !
    contains
    <<vegas: vegas gaussian test func: TBP>>
   end type vegas_gaussian_test_func_t
 
 @ %def vegas_gaussian_test_func_t
 @ Evaluate the integrand.
 <<vegas: vegas gaussian test func: TBP>>=
   procedure, public :: evaluate => vegas_gaussian_evaluate
 <<vegas: tests>>=
   real(default) function vegas_gaussian_evaluate (self, x) result (f)
     class(vegas_gaussian_test_func_t), intent(inout) :: self
     real(default), dimension(:), intent(in) :: x
     real(default), parameter :: inv_sqrt_pi = 1._default / sqrt(pi)
     f = inv_sqrt_pi**size (x)
     f = f * exp (- dot_product(x, x))
   end function vegas_gaussian_evaluate
 
 @ %def vegas_gaussian_evaluate
 @ The third test function is a three-dimensional polynomial function which
 factories. The function is defined in such a way that the integral in the unit
 range is normalised to zero.
 \begin{equation}
   f(x) = - \frac{8}{3} (x + 1)*(y-1)*z
 \end{equation}
 <<vegas: test types>>=
   type, extends (vegas_func_t) :: vegas_polynomial_func_t
      !
    contains
    <<vegas: vegas polynomial func: TBP>>
    end type vegas_polynomial_func_t
 
 @ %def vegas_polynomial_func_t
 <<vegas: vegas polynomial func: TBP>>=
   procedure, public :: evaluate => vegas_polynomial_evaluate
 <<vegas: tests>>=
   real(default) function vegas_polynomial_evaluate (self, x) result (f)
     class(vegas_polynomial_func_t), intent(inout) :: self
     real(default), dimension(:), intent(in) :: x
     f = - 8. / 3. * (x(1) + 1.) * (x(2) - 1.) * x(3)
   end function vegas_polynomial_evaluate
 
 @ %def vegas_polynomial_evaluate
 @
 \subsubsection{MC Integrator check}
 \label{sec:mc-integrator-check}
 
 Initialise the VEGAS MC integrator and call to [[vegas_init_grid]] for the
 initialisation of the grid.
 <<vegas: execute tests>>=
   call test (vegas_1, "vegas_1", "VEGAS initialisation and&
        & grid preparation", u, results)
 <<vegas: test declaration>>=
   public :: vegas_1
 <<vegas: tests>>=
   subroutine vegas_1 (u)
     integer, intent(in) :: u
     type(vegas_t) :: mc_integrator
     class(rng_t), allocatable :: rng
     class(vegas_func_t), allocatable :: func
     real(default), dimension(3), parameter :: x_lower = 0., &
          x_upper = pi
     real(default) :: result, abserr
 
     write (u, "(A)") "* Test output: vegas_1"
     write (u, "(A)") "*   Purpose: initialise the VEGAS MC integrator and the grid"
     write (u, "(A)")
 
     write (u, "(A)") "* Initialise random number generator (default seed)"
     write (u, "(A)")
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
 
     call rng%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise MC integrator with n_dim = 3"
     write (u, "(A)")
 
     allocate (vegas_test_func_t :: func)
     mc_integrator = vegas_t (3)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise grid with n_calls = 10000"
     write (u, "(A)")
 
     call mc_integrator%set_limits (x_lower, x_upper)
     call mc_integrator%set_calls (10000)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 10000 (Adaptation)"
     write (u, "(A)")
 
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
     write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 2000 (Precision)"
     write (u, "(A)")
 
     call mc_integrator%set_calls (2000)
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
     write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Cleanup"
 
     call mc_integrator%final ()
     call rng%final ()
     deallocate (rng)
   end subroutine vegas_1
 @ %def vegas_1
 @
 \subsubsection{Configuration and result check}
 \label{sec:conf-result-check}
 
 Initialise the MC integrator. Get and write the config object, also the (empty) result object.
 <<vegas: execute tests>>=
   call test (vegas_2, "vegas_2", "VEGAS configuration and result object", u, results)
 <<vegas: test declaration>>=
   public :: vegas_2
 <<vegas: tests>>=
   subroutine vegas_2 (u)
     integer, intent(in) :: u
     type(vegas_t) :: mc_integrator
     type(vegas_config_t) :: mc_integrator_config
     type(vegas_result_t) :: mc_integrator_result
 
     write (u, "(A)") "* Test output: vegas_2"
     write (u, "(A)") "*   Purpose: use transparent containers for&
          & configuration and result."
     write (u, "(A)")
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise MC integrator with n_dim = 10"
     write (u, "(A)")
 
     mc_integrator = vegas_t (10)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise grid with n_calls = 10000 (Importance Sampling)"
     write (u, "(A)")
 
     call mc_integrator%set_calls (10000)
 
     write (u, "(A)")
     write (u, "(A)") "* Get VEGAS config object and write out"
     write (u, "(A)")
 
     call mc_integrator%get_config (mc_integrator_config)
     call mc_integrator_config%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Get VEGAS empty result object and write out"
     write (u, "(A)")
 
     mc_integrator_result = mc_integrator%get_result ()
     call mc_integrator_result%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Cleanup"
 
     call mc_integrator%final ()
   end subroutine vegas_2
 @ %def vegas_2
 @
 \subsubsection{Grid check}
 \label{sec:conf-result-check}
 
 Initialise the MC integrator. Get and write the config object. Integrate the gaussian distribution.
 Get and write the result object. Before and after integration get the grid
 object and output both.
 Repeat with different number of dimensions.
 <<vegas: execute tests>>=
   call test (vegas_3, "vegas_3", "VEGAS integration of multi-dimensional gaussian", u, results)
 <<vegas: test declaration>>=
   public :: vegas_3
 <<vegas: tests>>=
   subroutine vegas_3 (u)
     integer, intent(in) :: u
     type(vegas_t) :: mc_integrator
     class(rng_t), allocatable :: rng
     class(vegas_func_t), allocatable :: func
     real(default), dimension(3), parameter :: x_lower_3 = -10._default, &
          x_upper_3 = 10._default
     type(vegas_config_t) :: mc_integrator_config
     type(vegas_grid_t) :: mc_integrator_grid
     type(vegas_result_t) :: mc_integrator_result
 
     real(default) :: result, abserr
 
     write (u, "(A)") "* Test output: vegas_3"
     write (u, "(A)") "*   Purpose: Integrate gaussian distribution."
     write (u, "(A)")
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
 
     call rng%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise MC integrator with n_dim = 3"
     write (u, "(A)")
 
     allocate (vegas_gaussian_test_func_t :: func)
     mc_integrator = vegas_t (3)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise grid with n_calls = 10000"
     write (u, "(A)")
 
     call mc_integrator%set_limits (x_lower_3, x_upper_3)
     call mc_integrator%set_calls (10000)
 
     write (u, "(A)")
     write (u, "(A)") "* Get VEGAS config object and write out"
     write (u, "(A)")
 
     call mc_integrator%get_config (mc_integrator_config)
     call mc_integrator_config%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Get VEGAS grid object and write out"
     write (u, "(A)")
 
     mc_integrator_grid = mc_integrator%get_grid ()
     call mc_integrator_grid%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 20000 (Adaptation)"
     write (u, "(A)")
 
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
     write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 2000 (Precision)"
     write (u, "(A)")
 
     call mc_integrator%set_calls (2000)
     call mc_integrator%get_config (mc_integrator_config)
     call mc_integrator_config%write (u)
 
     write (u, "(A)")
 
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
     write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
 
     write (u, "(A)")
     write (u, "(A)") "* Get VEGAS result object and write out"
     write (u, "(A)")
 
     mc_integrator_result = mc_integrator%get_result ()
     call mc_integrator_result%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Get VEGAS grid object and write out"
     write (u, "(A)")
 
     mc_integrator_grid = mc_integrator%get_grid ()
     call mc_integrator_grid%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Cleanup"
 
     call mc_integrator%final ()
   end subroutine vegas_3
 @ %def vegas_3
 \subsubsection{Three-dimensional integration with polynomial function}
 \label{sec:conf-result-check}
 
 Initialise the MC integrator. Get and write the config object. Integrate the
 factorisable polynomial function. Get and write the result object. Repeat with
 different number of dimensions.
 <<vegas: execute tests>>=
   call test (vegas_4, "vegas_4", "VEGAS integration of three&
        &-dimensional factorisable polynomial function", u, results)
 <<vegas: test declaration>>=
   public :: vegas_4
 <<vegas: tests>>=
   subroutine vegas_4 (u)
     integer, intent(in) :: u
     type(vegas_t) :: mc_integrator
     class(rng_t), allocatable :: rng
     class(vegas_func_t), allocatable :: func
     real(default), dimension(3), parameter :: x_lower_3 = 0._default, &
          x_upper_3 = 1._default
     type(vegas_config_t) :: mc_integrator_config
     type(vegas_result_t) :: mc_integrator_result
 
     real(default) :: result, abserr
 
     write (u, "(A)") "* Test output: vegas_4"
     write (u, "(A)") "*   Purpose: Integrate gaussian distribution."
     write (u, "(A)")
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
 
     call rng%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise MC integrator with n_dim = 3"
     write (u, "(A)")
 
     allocate (vegas_polynomial_func_t :: func)
     mc_integrator = vegas_t (3)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise grid with n_calls = 2000"
     write (u, "(A)")
 
     call mc_integrator%set_limits (x_lower_3, x_upper_3)
     call mc_integrator%set_calls (2000)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 2000 (Adaptation)"
     write (u, "(A)")
 
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
 
     call mc_integrator%get_config (mc_integrator_config)
     call mc_integrator_config%write (u)
 
     write (u, "(A)")
 
     write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 20000 (Precision)"
     write (u, "(A)")
 
     call mc_integrator%set_calls (20000)
 
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
 
     call mc_integrator%get_config (mc_integrator_config)
     call mc_integrator_config%write (u)
 
     write (u, "(A)")
     write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Cleanup"
 
     call mc_integrator%final ()
   end subroutine vegas_4
 
 @ %def vegas_4
 @
 \subsubsection{Event generation}
 
 Initialise the MC integrator. Integrate the gaussian distribution.
 Get and write the result object. Finally, generate events in accordance to the
 adapted grid and print them out.
 <<vegas: execute tests>>=
   call test (vegas_5, "vegas_5", "VEGAS integration and event&
        & generation of multi-dimensional gaussian", u, results)
 <<vegas: test declaration>>=
   public :: vegas_5
 <<vegas: tests>>=
   subroutine vegas_5 (u)
     integer, intent(in) :: u
     type(vegas_t) :: mc_integrator
     class(rng_t), allocatable :: rng
     class(vegas_func_t), allocatable :: func
     real(default), dimension(1), parameter :: x_lower_1 = -10._default, &
          x_upper_1 = 10._default
     type(vegas_config_t) :: mc_integrator_config
     type(vegas_result_t) :: mc_integrator_result
 
     integer :: i, u_event
     real(default), dimension(1) :: event, mean, delta, M2
     real(default) :: result, abserr
 
     write (u, "(A)") "* Test output: vegas_5"
     write (u, "(A)") "*   Purpose: Integrate gaussian distribution."
     write (u, "(A)")
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
 
     call rng%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise MC integrator with n_dim = 1"
     write (u, "(A)")
 
     allocate (vegas_gaussian_test_func_t :: func)
     mc_integrator = vegas_t (1)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise grid with n_calls = 20000"
     write (u, "(A)")
 
     call mc_integrator%set_limits (x_lower_1, x_upper_1)
     call mc_integrator%set_calls (20000)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 (Adaptation)"
     write (u, "(A)")
 
     call mc_integrator%integrate (func, rng, 3, opt_verbose=.true., result=result, abserr=abserr)
     call mc_integrator%get_config (mc_integrator_config)
     call mc_integrator_config%write (u)
     write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") &
          & "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 2000 (Precision)"
     write (u, "(A)")
 
     call mc_integrator%set_calls (2000)
     call mc_integrator%integrate (func, rng, 3, opt_verbose=.true., result=result, abserr=abserr)
     call mc_integrator%get_config (mc_integrator_config)
     call mc_integrator_config%write (u)
     write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") &
          & "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Generate 10000 events based on the adaptation and&
          & calculate mean and variance"
     write (u, "(A)")
 
     mean = 0._default
     M2 = 0._default
     do i = 1, 10000
        call mc_integrator%generate_unweighted (func, rng, event)
        delta = event - mean
        mean = mean + delta / i
        M2 = M2 + delta * (event - mean)
     end do
 
     write (u, "(2X,A)") "Result:"
     write (u, "(4X,A," // FMT_12 //")") &
          & "mean               = ", mean
     write (u, "(4X,A," // FMT_12 //")") &
          & "(sample) std. dev. = ", sqrt (M2 / (9999))
 
     write (u, "(A)")
     write (u, "(A)") "* Cleanup"
 
     call mc_integrator%final ()
   end subroutine vegas_5
 
 @ %def vegas_5
 @
 \subsubsection{Grid I/O}
 \label{sec:grid-io}
 
 Initialise the MC integrator. Get and write the config object. Integrate the
 factorisable polynomial function. Get and write the result object. Write grid to
 file and start with fresh grid.
 <<vegas: execute tests>>=
   call test (vegas_6, "vegas_6", "VEGAS integrate and write grid, &
        & read grid and continue", u, results)
 <<vegas: test declaration>>=
   public :: vegas_6
 <<vegas: tests>>=
   subroutine vegas_6 (u)
     integer, intent(in) :: u
     type(vegas_t) :: mc_integrator
     class(rng_t), allocatable :: rng
     class(vegas_func_t), allocatable :: func
     real(default), dimension(3), parameter :: x_lower_3 = 0._default, &
          x_upper_3 = 1._default
     type(vegas_config_t) :: mc_integrator_config
     type(vegas_result_t) :: mc_integrator_result
 
     real(default) :: result, abserr
     integer :: unit
 
     write (u, "(A)") "* Test output: vegas_6"
     write (u, "(A)") "*   Purpose: Write and read grid, and continue."
     write (u, "(A)")
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
 
     call rng%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise MC integrator with n_dim = 3"
     write (u, "(A)")
 
     allocate (vegas_polynomial_func_t :: func)
     mc_integrator = vegas_t (3)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise grid with n_calls = 2000"
     write (u, "(A)")
 
     call mc_integrator%set_limits (x_lower_3, x_upper_3)
     call mc_integrator%set_calls (2000)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 2000 (Adaptation)"
     write (u, "(A)")
 
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
 
     call mc_integrator%get_config (mc_integrator_config)
     call mc_integrator_config%write (u)
 
     write (u, "(A)")
 
     write (u,  "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Write grid to file vegas_io.grid"
     write (u, "(A)")
 
     unit = free_unit ()
     open (unit, file = "vegas_io.grid", &
          action = "write", status = "replace")
     call mc_integrator%write_grid (unit)
     close (unit)
 
     write (u, "(A)")
     write (u, "(A)") "* Read grid from file vegas_io.grid"
     write (u, "(A)")
 
     call mc_integrator%final ()
     open (unit, file = "vegas_io.grid", &
          action = "read", status = "old")
     call mc_integrator%read_grid (unit)
     close (unit)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 20000 (Precision)"
     write (u, "(A)")
 
     call mc_integrator%set_calls (20000)
 
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
 
     call mc_integrator%get_config (mc_integrator_config)
     call mc_integrator_config%write (u)
 
     write (u, "(A)")
     write (u,  "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Cleanup"
 
     call mc_integrator%final ()
   end subroutine vegas_6
 
 @ %def vegas_6
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{VAMP2}
 \label{sec:vamp2}
 
 We concentrate all configuration and run-time data in a derived-type, such that,
 [[mci_t]] can spwan each time a distinctive MCI VEGAS integrator object.
 
 <<[[vamp2.f90]]>>=
 <<File header>>
 
 module vamp2
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_utils, only: pac_fmt
   use format_utils, only: write_separator, write_indent
-  use format_defs, only: FMT_12, FMT_14, FMT_17, FMT_19
+  use format_defs, only: FMT_17
   use diagnostics
   use rng_base
   use rng_stream, only: rng_stream_t
 
   use vegas
 
 <<vamp2: modules>>
 
 <<Standard module head>>
 
 <<vamp2: public>>
 
 <<vamp2: parameters>>
 
 <<vamp2: types>>
 
 <<vamp2: interfaces>>
 
 contains
 
 <<vamp2: procedures>>
 
 end module vamp2
 @ %def vamp2
 <<vamp2: modules>>=
 @
 <<MPI: vamp2: modules>>=
   use mpi_f08 !NODEP!
 @
 \subsection{Type: vamp2\_func\_t}
 \label{sec:vamp2-func}
 
 We extend [[vegas_func_t]] with the multi-channel weights and the
 [[vegas_grid_t]], such that, the overall multi-channel weight can be calculated
 by the function itself.
 
 We add an additional logicial [[valid_x]], if it is set to [[.false.]], we do
 not compute weighted function and just set the weighted integrand to zero.
 This behavior is in particular very useful, if a mapping is prohibited or fails.
 Or in the case of WHIZARD, a phase cut is applied.
 <<vamp2: public>>=
   public :: vamp2_func_t
 <<vamp2: types>>=
   type, abstract, extends(vegas_func_t) :: vamp2_func_t
      integer :: current_channel = 0
      integer :: n_dim = 0
      integer :: n_channel = 0
      integer :: n_calls = 0
      logical :: valid_x = .false.
      real(default), dimension(:, :), allocatable :: xi
      real(default), dimension(:), allocatable :: det
      real(default), dimension(:), allocatable :: wi
      real(default), dimension(:), allocatable :: gi
      type(vegas_grid_t), dimension(:), allocatable :: grids
      real(default) :: g = 0.
    contains
    <<vamp2: vamp2 func: TBP>>
   end type vamp2_func_t
 
 @ %def vamp2_func_t
 @ Init.
 <<vamp2: vamp2 func: TBP>>=
   procedure, public :: init => vamp2_func_init
 <<vamp2: procedures>>=
   subroutine vamp2_func_init (self, n_dim, n_channel)
     class(vamp2_func_t), intent(out) :: self
     integer, intent(in) :: n_dim
     integer, intent(in) :: n_channel
     self%n_dim = n_dim
     self%n_channel = n_channel
     allocate (self%xi(n_dim, n_channel), source=0._default)
     allocate (self%det(n_channel), source=1._default)
     allocate (self%wi(n_channel), source=0._default)
     allocate (self%gi(n_channel), source=0._default)
     allocate (self%grids(n_channel))
   end subroutine vamp2_func_init
 
 @ %def vamp2_func_init
 @ Set current channel.
 <<vamp2: vamp2 func: TBP>>=
   procedure, public :: set_channel => vamp2_func_set_channel
 <<vamp2: procedures>>=
   subroutine vamp2_func_set_channel (self, channel)
     class(vamp2_func_t), intent(inout) :: self
     integer, intent(in) :: channel
     self%current_channel = channel
   end subroutine vamp2_func_set_channel
 
 @ %def vamp2_func_set_channel
 @ Get number of function calls for which $f \neq 0$.
 <<vamp2: vamp2 func: TBP>>=
   procedure, public :: get_n_calls => vamp2_func_get_n_calls
 <<vamp2: procedures>>=
   integer function vamp2_func_get_n_calls (self) result (n_calls)
     class(vamp2_func_t), intent(in) :: self
     n_calls = self%n_calls
   end function vamp2_func_get_n_calls
 
 @ %def vamp2_func_get_func_calls
 @ Reset number of calls.
 <<vamp2: vamp2 func: TBP>>=
   procedure, public :: reset_n_calls => vamp2_func_reset_n_calls
 <<vamp2: procedures>>=
   subroutine vamp2_func_reset_n_calls (self)
     class(vamp2_func_t), intent(inout) :: self
     self%n_calls = 0
   end subroutine vamp2_func_reset_n_calls
 
 @ %def vamp2_func_reset_n_calls
 @ Evaluate mappings. We defer this method to be implemented by the user.
 The result must be written to [[xi]] and [[det]].
 
 The mapping is defined by $\phi : U \rightarrow M$. We map $x \in M$ to the
 different mappings of the hypercube $U_{i}$, such that $x_{i} \in U_{i}$.
 
 The mapping should determine, whether [[x]] is a valid point, e.g. can be
 mapped, or is restricted otherwise.
 <<vamp2: vamp2 func: TBP>>=
   procedure(vamp2_func_evaluate_maps), deferred :: evaluate_maps
 <<vamp2: interfaces>>=
  abstract interface
     subroutine vamp2_func_evaluate_maps (self, x)
       import :: vamp2_func_t, default
       class(vamp2_func_t), intent(inout) :: self
       real(default), dimension(:), intent(in) :: x
     end subroutine vamp2_func_evaluate_maps
  end interface
 
 @ %def vamp2_evaluate_func
 @ Evaluate channel weights.
 <<vamp2: vamp2 func: TBP>>=
   procedure, private :: evaluate_weight => vamp2_func_evaluate_weight
 <<vamp2: procedures>>=
   subroutine vamp2_func_evaluate_weight (self)
     class(vamp2_func_t), intent(inout) :: self
     integer :: ch
     self%g = 0.
     self%gi = 0.
     !$OMP PARALLEL DO PRIVATE(ch) SHARED(self)
     do ch = 1, self%n_channel
        if (self%wi(ch) /= 0) then
           self%gi(ch) = self%grids(ch)%get_probability (self%xi(:, ch))
        end if
     end do
     !$OMP END PARALLEL DO
     if (self%gi(self%current_channel) /= 0) then
        do ch = 1, self%n_channel
           if (self%wi(ch) /= 0 .and. self%det(ch) /= 0) then
              self%g = self%g + self%wi(ch) * self%gi(ch) / self%det(ch)
           end if
        end do
        self%g = self%g / self%gi(self%current_channel)
     end if
   end subroutine vamp2_func_evaluate_weight
 
 @ %def vamp2_func_evaluate_weight
 @ Evaluate function at [[x]]. We call this procedure in [[vamp2_func_evaluate]].
 <<vamp2: vamp2 func: TBP>>=
   procedure(vamp2_func_evaluate_func), deferred :: evaluate_func
 <<vamp2: interfaces>>=
   abstract interface
      real(default) function vamp2_func_evaluate_func (self, x) result (f)
        import :: vamp2_func_t, default
        class(vamp2_func_t), intent(in) :: self
        real(default), dimension(:), intent(in) :: x
      end function vamp2_func_evaluate_func
   end interface
 
 @ %def vamp2_func_evaluate_func
 <<vamp2: vamp2 func: TBP>>=
   procedure, public :: evaluate => vamp2_func_evaluate
 <<vamp2: procedures>>=
   real(default) function vamp2_func_evaluate (self, x) result (f)
     class(vamp2_func_t), intent(inout) :: self
     real(default), dimension(:), intent(in) :: x
     call self%evaluate_maps (x)
     f = 0.
     self%gi = 0.
     self%g = 1
     if (self%valid_x) then
        call self%evaluate_weight ()
        f = self%evaluate_func (x) / self%g
        self%n_calls = self%n_calls + 1
     end if
   end function vamp2_func_evaluate
 
 @ %def vamp2_func_evaluate
 \subsection{Type: vamp2\_config\_t}
 \label{sec:vamp2-config}
 
 This is a transparent container which incorporates and extends the definitions
 in [[vegas_config]]. The parent object can then be used to parametrise the VEGAS
 grids directly, where the new parameters are exclusively used in the
 multi-channel implementation of VAMP2.
 [[n_calls_min]] is calculated by [[n_calls_min_per_channel]] and [[n_channel]].
 The channels weights (and the result [[n_calls]] for each channel) are
 calculated regarding [[n_calls_threshold]].
 <<vamp2: public>>=
   public :: vamp2_config_t
 <<vamp2: types>>=
   type, extends(vegas_config_t) :: vamp2_config_t
      integer :: n_channel = 0
      integer :: n_calls_min_per_channel = 20
      integer :: n_calls_threshold = 10
      integer :: n_chains = 0
      logical :: stratified = .true.
      logical :: equivalences = .false.
      real(default) :: beta = 0.5_default
      real(default) :: accuracy_goal = 0._default
      real(default) :: error_goal = 0._default
      real(default) :: rel_error_goal = 0._default
    contains
    <<vamp2: vamp2 config: TBP>>
   end type vamp2_config_t
 
 @ %def vamp2_config_t
 @ Write.
 <<vamp2: vamp2 config: TBP>>=
   procedure, public :: write => vamp2_config_write
 <<vamp2: procedures>>=
   subroutine vamp2_config_write (self, unit, indent)
     class(vamp2_config_t), intent(in) :: self
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: indent
     integer :: u, ind
     u = given_output_unit (unit)
     ind = 0; if (present (indent)) ind = indent
     call self%vegas_config_t%write (unit, indent)
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Number of channels                               = ", self%n_channel
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Min. number of calls per channel (setting calls) = ", &
          & self%n_calls_min_per_channel
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Threshold number of calls (adapting weights)     = ", &
          & self%n_calls_threshold
     call write_indent (u, ind)
     write (u, "(2x,A,I0)") &
          & "Number of chains                                 = ", self%n_chains
     call write_indent (u, ind)
     write (u, "(2x,A,L1)") &
          & "Stratified                                       = ", self%stratified
     call write_indent (u, ind)
     write (u, "(2x,A,L1)") &
          & "Equivalences                                     = ", self%equivalences
     call write_indent (u, ind)
     write (u, "(2x,A," // FMT_17 // ")") &
          & "Adaption power (beta)                            = ", self%beta
     if (self%accuracy_goal > 0) then
        call write_indent (u, ind)
        write (u, "(2x,A," // FMT_17 // ")") &
             & "accuracy_goal                                 = ", self%accuracy_goal
     end if
     if (self%error_goal > 0) then
        call write_indent (u, ind)
        write (u, "(2x,A," // FMT_17 // ")") &
             & "error_goal                                    = ", self%error_goal
     end if
     if (self%rel_error_goal > 0) then
        call write_indent (u, ind)
        write (u, "(2x,A," // FMT_17 // ")") &
             & "rel_error_goal                                = ", self%rel_error_goal
     end if
   end subroutine vamp2_config_write
 
 @ %def vamp2_config_write
 @
 \subsection{Type: vamp2\_result\_t}
 \label{sec:vamp2-result}
 
 This is a transparent container which incorporates and extends the definitions
 of [[vegas_result_t]].
 
 <<vamp2: public>>=
   public :: vamp2_result_t
 <<vamp2: types>>=
   type, extends(vegas_result_t) :: vamp2_result_t
    contains
    <<vamp2: vamp2 result: TBP>>
   end type vamp2_result_t
 
 @ %def vamp2_result_t
 @ Output.
 <<vamp2: vamp2 result: TBP>>=
   procedure, public :: write => vamp2_result_write
 <<vamp2: procedures>>=
   subroutine vamp2_result_write (self, unit, indent)
     class(vamp2_result_t), intent(in) :: self
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: indent
     integer :: u, ind
     u = given_output_unit (unit)
     ind = 0; if (present (indent)) ind = indent
     call self%vegas_result_t%write (unit, indent)
   end subroutine vamp2_result_write
 
 @ %def vamp2_result_write
 @
 \subsection{Type: vamp2\_equivalences\_t}
 \label{sec:vamp2-eqv}
 
 <<vamp2: parameters>>=
 integer, parameter, public :: &
      VEQ_IDENTITY = 0, VEQ_INVERT = 1, VEQ_SYMMETRIC = 2, VEQ_INVARIANT = 3
 @
 @ Channel equivalences. Store retrieving and sourcing channel.
 <<vamp2: types>>=
   type :: vamp2_equi_t
      integer :: ch
      integer :: ch_src
      integer, dimension(:), allocatable :: perm
      integer, dimension(:), allocatable :: mode
    contains
    <<vamp2: vamp2 equi: TBP>>
   end type vamp2_equi_t
 
 @ %def vamp2_equi_t
 @ Write equivalence.
 <<vamp2: vamp2 equi: TBP>>=
   procedure :: write => vamp2_equi_write
 <<vamp2: procedures>>=
   subroutine vamp2_equi_write (self, unit, indent)
     class(vamp2_equi_t), intent(in) :: self
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: indent
     integer :: u, ind
     u = given_output_unit (unit)
     ind = 0; if (present (indent)) ind = indent
     call write_indent (u, ind)
     write (u, "(2(A,1X,I0))") "src:", self%ch_src, "-> dest:", self%ch
     call write_indent (u, ind)
     write (u, "(A,99(1X,I0))") "Perm: ", self%perm
     call write_indent (u, ind)
     write (u, "(A,99(1X,I0))") "Mode: ", self%mode
   end subroutine vamp2_equi_write
 
 @ %def vamp2_equi_write
 @
 <<vamp2: public>>=
   public :: vamp2_equivalences_t
 <<vamp2: types>>=
   type :: vamp2_equivalences_t
       private
       integer :: n_eqv = 0
       integer :: n_channel = 0
       integer :: n_dim = 0
       type(vamp2_equi_t), dimension(:), allocatable :: eqv
       integer, dimension(:), allocatable :: map
       integer, dimension(:), allocatable :: multiplicity
       integer, dimension(:), allocatable :: symmetry
       logical, dimension(:), allocatable :: independent
       integer, dimension(:), allocatable :: equivalent_to_ch
       logical, dimension(:, :), allocatable :: dim_is_invariant
    contains
    <<vamp2: vamp2 equivalences: TBP>>
   end type vamp2_equivalences_t
 
 @ %def vamp2_equivalences_t
 @ Constructor.
 <<vamp2: interfaces>>=
   interface vamp2_equivalences_t
      module procedure vamp2_equivalences_init
   end interface vamp2_equivalences_t
 
 <<vamp2: procedures>>=
   type(vamp2_equivalences_t) function vamp2_equivalences_init (&
        n_eqv, n_channel, n_dim) result (eqv)
     integer, intent(in) :: n_eqv, n_channel, n_dim
     eqv%n_eqv = n_eqv
     eqv%n_channel = n_channel
     eqv%n_dim = n_dim
     allocate (eqv%eqv(n_eqv))
     allocate (eqv%map(n_channel), source = 0)
     allocate (eqv%multiplicity(n_channel), source = 0)
     allocate (eqv%symmetry(n_channel), source = 0)
     allocate (eqv%independent(n_channel), source = .true.)
     allocate (eqv%equivalent_to_ch(n_channel), source = 0)
     allocate (eqv%dim_is_invariant(n_dim, n_channel), source = .false.)
   end function vamp2_equivalences_init
 
 @ %def vamp2_equivlences_init
 @ Write equivalences.
 <<vamp2: vamp2 equivalences: TBP>>=
   procedure :: write => vamp2_equivalences_write
 <<vamp2: procedures>>=
   subroutine vamp2_equivalences_write (self, unit, indent)
     class(vamp2_equivalences_t), intent(in) :: self
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: indent
     integer :: u, ind, i_eqv, ch
     u = given_output_unit (unit)
     ind = 0; if (present (indent)) ind = indent
     write (u, "(A)") "Inequivalent channels:"
     if (allocated (self%independent)) then
        do ch = 1, self%n_channel
           if (self%independent(ch)) then
              write (u, "(2X,A,1x,I0,A,4x,A,I0,4x,A,I0,4x,A,999(L1))") &
                   "Channel", ch, ":", &
                   "Mult. = ", self%multiplicity(ch), &
                   "Symm. = ", self%symmetry(ch), &
                   "Invar.: ", self%dim_is_invariant(:, ch)
           end if
        end do
     else
        write (u, "(A)") "[not allocated]"
     end if
     write (u, "(A)") "Equivalence list:"
     if (allocated (self%eqv)) then
        do i_eqv = 1, self%n_eqv
           write (u, "(2X,A,1X,I0)") "i_eqv:", i_eqv
           call self%eqv(i_eqv)%write (unit, indent = ind + 4)
        end do
     else
        write (u, "(A)") "[not allocated]"
     end if
   end subroutine vamp2_equivalences_write
 
 @ %def vamp2_equivalences_write
 @ Is allocated.
 <<vamp2: vamp2 equivalences: TBP>>=
   procedure, public :: is_allocated => vamp2_equivalences_is_allocated
 <<vamp2: procedures>>=
   logical function vamp2_equivalences_is_allocated (self) result (yorn)
     class(vamp2_equivalences_t), intent(in) :: self
     yorn = allocated (self%eqv)
   end function vamp2_equivalences_is_allocated
 
 @ %def vamp2_equivalences_is_allocated
 @ Get source channel and destination channel for given equivalence.
 <<vamp2: vamp2 equivalences: TBP>>=
   procedure, public :: get_channels => vamp2_equivalences_get_channels
 <<vamp2: procedures>>=
   subroutine vamp2_equivalences_get_channels (eqv, i_eqv, dest, src)
    class(vamp2_equivalences_t), intent(in) :: eqv
    integer, intent(in) :: i_eqv
    integer, intent(out) :: dest, src
    dest = eqv%eqv(i_eqv)%ch
    src = eqv%eqv(i_eqv)%ch_src
   end subroutine vamp2_equivalences_get_channels
 
 @ %def vamp2_equivalences_get_channels
 @
 <<vamp2: vamp2 equivalences: TBP>>=
   procedure, public :: get_mode => vamp2_equivalences_get_mode
   procedure, public :: get_perm => vamp2_equivalences_get_perm
 <<vamp2: procedures>>=
   function vamp2_equivalences_get_mode (eqv, i_eqv) result (mode)
     class(vamp2_equivalences_t), intent(in) :: eqv
     integer, intent(in) :: i_eqv
     integer, dimension(:), allocatable :: mode
     mode = eqv%eqv(i_eqv)%mode
   end function vamp2_equivalences_get_mode
 
   function vamp2_equivalences_get_perm (eqv, i_eqv) result (perm)
     class(vamp2_equivalences_t), intent(in) :: eqv
     integer, intent(in) :: i_eqv
     integer, dimension(:), allocatable :: perm
     perm = eqv%eqv(i_eqv)%perm
   end function vamp2_equivalences_get_perm
 
 @ %def vamp2_equivalences_get_perm, vamp2_equivalences_get_mode
 @
 <<vamp2: vamp2 equivalences: TBP>>=
   procedure, public :: set_equivalence => vamp2_equivalences_set_equivalence
 <<vamp2: procedures>>=
   subroutine vamp2_equivalences_set_equivalence &
        (eqv, i_eqv, dest, src, perm, mode)
     class(vamp2_equivalences_t), intent(inout) :: eqv
     integer, intent(in) :: i_eqv
     integer, intent(in) :: dest, src
     integer, dimension(:), intent(in) :: perm, mode
     integer :: i
     if (dest < 1 .or. dest > eqv%n_channel)  call msg_bug &
        ("[VAMP2] set_equivalences: destination channel out of range.")
     if (src < 1 .or. src > eqv%n_channel)  call msg_bug &
          ("[VAMP2] set_equivalences: source channel out of range.")
     if (size(perm) /= eqv%n_dim)  call msg_bug &
          ("[VAMP2] set_equivalences: size(perm) does not match n_dim.")
     if (size(mode) /= eqv%n_dim)  call msg_bug &
          ("[VAMP2] set_equivalences: size(mode) does not match n_dim.")
     eqv%eqv(i_eqv)%ch = dest
     eqv%eqv(i_eqv)%ch_src = src
     allocate (eqv%eqv(i_eqv)%perm (size (perm)))
     do i = 1, size (perm)
        eqv%eqv(i_eqv)%perm(i) = perm(i)
     end do
     allocate (eqv%eqv(i_eqv)%mode (size (mode)))
     do i = 1, size (mode)
        eqv%eqv(i_eqv)%mode(i) = mode(i)
     end do
   end subroutine vamp2_equivalences_set_equivalence
 
 @ %def vamp2_equivalences_set_equivalence
 @ Freeze equivalences.
 <<vamp2: vamp2 equivalences: TBP>>=
   procedure, public :: freeze => vamp2_equivalences_freeze
 <<vamp2: procedures>>=
   subroutine vamp2_equivalences_freeze (self)
     class(vamp2_equivalences_t), intent(inout) :: self
     integer :: i_eqv, ch, upper, lower
     ch = 0
     do i_eqv = 1, self%n_eqv
        if (ch /= self%eqv(i_eqv)%ch) then
           ch = self%eqv(i_eqv)%ch
           self%map(ch) = i_eqv
        end if
     end do
     do ch = 1, self%n_channel
        lower = self%map(ch)
        if (ch == self%n_channel) then
           upper = self%n_eqv
        else
           upper = self%map(ch + 1) - 1
        end if
        associate (eqv => self%eqv, n_eqv => size (self%eqv(lower:upper)))
          if (.not. all(eqv(lower:upper)%ch == ch) .or. &
               eqv(lower)%ch_src > ch) then
             do i_eqv = lower, upper
                call self%eqv(i_eqv)%write ()
             end do
             call msg_bug ("[VAMP2] vamp2_equivalences_freeze: &
                  &equivalence order is not correct.")
          end if
          self%symmetry(ch) = count (eqv(lower:upper)%ch_src == ch)
          if (mod (n_eqv, self%symmetry(ch)) /= 0) then
             do i_eqv = lower, upper
                call self%eqv(i_eqv)%write ()
             end do
             call msg_bug ("[VAMP2] vamp2_equivalences_freeze: &
                  &permutation count is not correct.")
          end if
          self%multiplicity(ch) = n_eqv / self%symmetry(ch)
          self%independent(ch) = all (eqv(lower:upper)%ch_src >= ch)
          self%equivalent_to_ch(ch) = eqv(lower)%ch_src
          self%dim_is_invariant(:, ch) = eqv(lower)%mode == VEQ_INVARIANT
        end associate
     end do
   end subroutine vamp2_equivalences_freeze
 
 @ %def vamp2_equivalences_freeze
 @
 \subsection{Type: vamp2\_t}
 \label{sec:vamp2-t}
 
 <<vamp2: public>>=
   public :: vamp2_t
 <<vamp2: types>>=
   type :: vamp2_t
      private
      type(vamp2_config_t) :: config
      type(vegas_t), dimension(:), allocatable :: integrator
      integer, dimension(:), allocatable :: chain
      real(default), dimension(:), allocatable :: weight
      real(default), dimension(:), allocatable :: integral
      real(default), dimension(:), allocatable :: variance
      real(default), dimension(:), allocatable :: efficiency
      type(vamp2_result_t) :: result
      type(vamp2_equivalences_t) :: equivalences
      logical :: event_prepared
      real(default), dimension(:), allocatable :: event_weight
    contains
    <<vamp2: vamp2: TBP>>
   end type vamp2_t
 
 <<vamp2: interfaces>>=
   interface vamp2_t
      module procedure vamp2_init
   end interface vamp2_t
 
 @ %def vamp2_t
 @ Constructor.
 <<vamp2: procedures>>=
   type(vamp2_t) function vamp2_init (n_channel, n_dim, alpha, beta, n_bins_max,&
        & n_calls_min_per_channel, iterations, mode) result (self)
     integer, intent(in) :: n_channel
     integer, intent(in) :: n_dim
     integer, intent(in), optional :: n_bins_max
     integer, intent(in), optional :: n_calls_min_per_channel
     real(default), intent(in), optional :: alpha
     real(default), intent(in), optional :: beta
     integer, intent(in), optional :: iterations
     integer, intent(in), optional :: mode
     integer :: ch
     self%config%n_dim = n_dim
     self%config%n_channel = n_channel
     if (present (n_bins_max)) self%config%n_bins_max = n_bins_max
     if (present (n_calls_min_per_channel)) self%config%n_calls_min_per_channel = n_calls_min_per_channel
     if (present (alpha)) self%config%alpha = alpha
     if (present (beta)) self%config%beta = beta
     if (present (iterations)) self%config%iterations = iterations
     if (present (mode)) self%config%mode = mode
     allocate (self%chain(n_channel), source=0)
     allocate (self%integrator(n_channel))
     allocate (self%weight(n_channel), source=0._default)
     do ch = 1, n_channel
        self%integrator(ch) = vegas_t (n_dim, alpha, n_bins_max, 1, mode)
     end do
     self%weight = 1. / self%config%n_channel
     call self%reset_result ()
     allocate (self%event_weight(self%config%n_channel), source = 0._default)
     self%event_prepared = .false.
   end function vamp2_init
 
 @ %def vamp2_init
 <<vamp2: vamp2: TBP>>=
   procedure, public :: final => vamp2_final
 <<vamp2: procedures>>=
   subroutine vamp2_final (self)
     class(vamp2_t), intent(inout) :: self
     integer :: ch
     do ch = 1, self%config%n_channel
        call self%integrator(ch)%final ()
     end do
   end subroutine vamp2_final
 
 @ %def vamp2_final
 @ Output.
 <<vamp2: vamp2: TBP>>=
   procedure, public :: write => vamp2_write
 <<vamp2: procedures>>=
   subroutine vamp2_write (self, unit, indent)
     class(vamp2_t), intent(in) :: self
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: indent
     integer :: u, ind, ch
     u = given_output_unit (unit)
     ind = 0; if (present (indent)) ind = indent
     call write_indent (u, ind)
     write (u, "(A)") "VAMP2: VEGAS AMPlified 2"
     call write_indent (u, ind)
     call self%config%write (unit, indent)
     call self%result%write (unit, indent)
   end subroutine vamp2_write
 
 @ %def vamp2_write
 @ Get the config object.
 <<vamp2: vamp2: TBP>>=
   procedure, public :: get_config => vamp2_get_config
 <<vamp2: procedures>>=
   subroutine vamp2_get_config (self, config)
     class(vamp2_t), intent(in) :: self
     type(vamp2_config_t), intent(out) :: config
     config = self%config
   end subroutine vamp2_get_config
 
 @ %def vamp2_get_config
 @ Set non-runtime dependent configuration. It will no be possible to change
 [[n_bins_max]].
 <<vamp2: vamp2: TBP>>=
   procedure, public :: set_config => vamp2_set_config
 <<vamp2: procedures>>=
   subroutine vamp2_set_config (self, config)
     class(vamp2_t), intent(inout) :: self
     class(vamp2_config_t), intent(in) :: config
     integer :: ch
     self%config%equivalences = config%equivalences
     self%config%n_calls_min_per_channel = config%n_calls_min_per_channel
     self%config%n_calls_threshold = config%n_calls_threshold
     self%config%n_calls_min = config%n_calls_min
     self%config%beta = config%beta
     self%config%accuracy_goal = config%accuracy_goal
     self%config%error_goal = config%error_goal
     self%config%rel_error_goal = config%rel_error_goal
     do ch = 1, self%config%n_channel
        call self%integrator(ch)%set_config (config)
     end do
   end subroutine vamp2_set_config
 
 @ %def vamp2_set_config
 @ Set the overall number of calls. The number of calls each channel is scaled by
 the channel weights
 \begin{equation}
   N_i = \alpha_i N.
 \end{equation}
 <<vamp2: vamp2: TBP>>=
   procedure, public :: set_calls => vamp2_set_n_calls
 <<vamp2: procedures>>=
   subroutine vamp2_set_n_calls (self, n_calls)
     class(vamp2_t), intent(inout) :: self
     integer, intent(in) :: n_calls
     integer :: ch
     self%config%n_calls_min = self%config%n_calls_min_per_channel &
          & * self%config%n_channel
     self%config%n_calls = max(n_calls, self%config%n_calls_min)
     if (self%config%n_calls > n_calls) then
        write (msg_buffer, "(A,I0)") "VAMP2: [set_calls] number of calls too few,&
             & reset to = ", self%config%n_calls
        call msg_message ()
     end if
     do ch = 1, self%config%n_channel
        call self%integrator(ch)%set_calls (max (nint (self%config%n_calls *&
             & self%weight(ch)), self%config%n_calls_min_per_channel))
     end do
   end subroutine vamp2_set_n_calls
 
 @ %def vamp2_set_n_calls
 @ Set limits. We only support same limits for all channels.
 <<vamp2: vamp2: TBP>>=
   procedure, public :: set_limits => vamp2_set_limits
 <<vamp2: procedures>>=
   subroutine vamp2_set_limits (self, x_upper, x_lower)
     class(vamp2_t), intent(inout) :: self
     real(default), dimension(:), intent(in) :: x_upper
     real(default), dimension(:), intent(in) :: x_lower
     integer :: ch
     do ch = 1, self%config%n_channel
        call self%integrator(ch)%set_limits (x_upper, x_lower)
     end do
   end subroutine vamp2_set_limits
 
 @ %def vamp2_set_limits
 @ Set [[n_chains]] and the (actual) chains. [[chain]] must have size
 [[n_channels]] and each elements must store an index to a corresponding chain.
 This means, that channels with equal index correspond to the same chain, and we
 refer to those as chained weights, where we average the contributions of the
 chained weights in [[vamp2_adapt_weights]].
 <<vamp2: vamp2: TBP>>=
   procedure, public :: set_chain => vamp2_set_chain
 <<vamp2: procedures>>=
   subroutine vamp2_set_chain (self, n_chains, chain)
     class(vamp2_t), intent(inout) :: self
     integer, intent(in) :: n_chains
     integer, dimension(:), intent(in) :: chain
     if (size (chain) /= self%config%n_channel) then
        call msg_bug ("[VAMP2] set chain: size of chain array does not match n_channel.")
     else
        call msg_message ("[VAMP2] set chain: use chained weights.")
     end if
     self%config%n_chains = n_chains
     self%chain = chain
   end subroutine vamp2_set_chain
 
 @ %def vamp2_set_chain
 @ Set channel equivalences.
 <<vamp2: vamp2: TBP>>=
   procedure, public :: set_equivalences => vamp2_set_equivalences
 <<vamp2: procedures>>=
   subroutine vamp2_set_equivalences (self, equivalences)
     class(vamp2_t), intent(inout) :: self
     type(vamp2_equivalences_t), intent(in) :: equivalences
     self%equivalences = equivalences
   end subroutine vamp2_set_equivalences
 
 @ %def vamp2_set_equivalences
 @ Get [[n_calls]] calculated by [[VEGAS]].
 <<vamp2: vamp2: TBP>>=
   procedure, public :: get_n_calls => vamp2_get_n_calls
 <<vamp2: procedures>>=
   elemental real(default) function vamp2_get_n_calls (self) result (n_calls)
     class(vamp2_t), intent(in) :: self
     n_calls = sum (self%integrator%get_calls ())
   end function vamp2_get_n_calls
 
 @ %def vamp2_get_n_calls
 @ Get the cumulative result of the integration. Recalculate weighted average of the integration.
 <<vamp2: vamp2: TBP>>=
   procedure, public :: get_integral => vamp2_get_integral
 <<vamp2: procedures>>=
   elemental real(default) function vamp2_get_integral (self) result (integral)
     class(vamp2_t), intent(in) :: self
     integral = 0.
     if (self%result%sum_wgts > 0.) then
        integral = self%result%sum_int_wgtd / self%result%sum_wgts
     end if
   end function vamp2_get_integral
 
 @ %def vamp2_get_integral
 @ Get the cumulative variance of the integration. Recalculate the variance.
 <<vamp2: vamp2: TBP>>=
   procedure, public :: get_variance => vamp2_get_variance
 <<vamp2: procedures>>=
   elemental real(default) function vamp2_get_variance (self) result (variance)
     class(vamp2_t), intent(in) :: self
     variance = 0.
     if (self%result%sum_wgts > 0.) then
        variance = 1.0 / self%result%sum_wgts
     end if
   end function vamp2_get_variance
 
 @ %def vamp2_get_variance
 @ Get efficiency.
 <<vamp2: vamp2: TBP>>=
   procedure, public :: get_efficiency => vamp2_get_efficiency
 <<vamp2: procedures>>=
   elemental real(default) function vamp2_get_efficiency (self) result (efficiency)
     class(vamp2_t), intent(in) :: self
     efficiency = 0.
     if (self%result%efficiency > 0.) then
        efficiency = self%result%efficiency
     end if
   end function vamp2_get_efficiency
 
 @ %def vamp2_get_efficiency
 @ Get event weight and event weight excess.
 <<vamp2: vamp2: TBP>>=
   procedure :: get_evt_weight => vamp2_get_evt_weight
   procedure :: get_evt_weight_excess => vamp2_get_evt_weight_excess
 <<vamp2: procedures>>=
   real(default) function vamp2_get_evt_weight (self) result (evt_weight)
     class(vamp2_t), intent(in) :: self
     evt_weight = self%result%evt_weight
   end function vamp2_get_evt_weight
 
   real(default) function vamp2_get_evt_weight_excess (self) result (evt_weight_excess)
     class(vamp2_t), intent(in) :: self
     evt_weight_excess = self%result%evt_weight_excess
   end function vamp2_get_evt_weight_excess
 
 @ %def vamp2_get_evt_weight, vamp2_get_evt_weight_excess
 @ Get procedure to retrieve channel-th grid.
 <<vamp2: vamp2: TBP>>=
   procedure :: get_grid => vamp2_get_grid
 <<vamp2: procedures>>=
   type(vegas_grid_t) function vamp2_get_grid (self, channel) result (grid)
     class(vamp2_t), intent(in) :: self
     integer, intent(in) :: channel
     if (channel < 1 .or. channel > self%config%n_channel) &
          call msg_bug ("[VAMP2] vamp2_get_grid: channel index < 1 or > n_channel.")
     grid = self%integrator(channel)%get_grid ()
   end function vamp2_get_grid
 
 @ %def vamp2_get_grid
 @ Adapt. We adapt the weights due the contribution of variances with $\beta >
 0$.
 \begin{equation}
   \alpha_i = \frac{\alpha_i V_i^\beta}{\sum_i \alpha_i V_i^\beta}
 \end{equation}
 If [[n_calls_threshold]] is set, we rescale the weights in such a way, that the
 [[n_calls]] for each channel are greater than [[n_calls_threshold]].
 We calculate the distance of the weights to the [[weight_min]] and reset those weights
 which are less than [[weight_mins]] to this value. The other values are
 accordingly resized to fit the boundary condition of the partition of unity.
 <<vamp2: vamp2: TBP>>=
   procedure, private :: adapt_weights => vamp2_adapt_weights
 <<vamp2: procedures>>=
   subroutine vamp2_adapt_weights (self)
     class(vamp2_t), intent(inout) :: self
     integer :: n_weights_underflow
     real(default) :: weight_min, sum_weights_underflow
     self%weight = self%weight * self%integrator%get_variance ()**self%config%beta
     if (sum (self%weight) == 0) self%weight = real(self%config%n_calls, default)
     if (self%config%n_chains > 0) then
        call chain_weights ()
     end if
     self%weight = self%weight / sum(self%weight)
     if (self%config%n_calls_threshold /= 0) then
        weight_min = real(self%config%n_calls_threshold, default) &
             & / self%config%n_calls
        sum_weights_underflow = sum (self%weight, self%weight < weight_min)
        n_weights_underflow = count (self%weight < weight_min)
        where (self%weight < weight_min)
           self%weight = weight_min
        elsewhere
           self%weight = self%weight * (1. - n_weights_underflow * weight_min) &
                & / (1. - sum_weights_underflow)
        end where
     end if
     call self%set_calls (self%config%n_calls)
   contains
   <<vamp2: vamp2 adapt weights: procedures>>
   end subroutine vamp2_adapt_weights
 
 @ %def vamp2_adapt_weights
 @ We average the weights over their respective chain members.
 <<vamp2: vamp2 adapt weights: procedures>>=
   subroutine chain_weights ()
     integer :: ch
     real(default) :: average
     do ch = 1, self%config%n_chains
        average = max (sum (self%weight, self%chain == ch), 0._default)
        if (average /= 0) then
           average = average / count (self%chain == ch)
           where (self%chain == ch)
              self%weight = average
           end where
        end if
     end do
   end subroutine chain_weights
 
 @ %def chain_weights
 <<vamp2: vamp2: TBP>>=
   procedure, private :: apply_equivalences => vamp2_apply_equivalences
 <<vamp2: procedures>>=
   subroutine vamp2_apply_equivalences (self)
     class(vamp2_t), intent(inout) :: self
     integer :: ch, ch_src, j, j_src, i_eqv
     real(default), dimension(:, :, :), allocatable :: d
     real(default), dimension(:, :), allocatable :: d_src
     integer, dimension(:), allocatable :: mode, perm
     if (.not. self%equivalences%is_allocated ()) then
        call msg_bug ("[VAMP2] vamp2_apply_equivalences: &
             &cannot apply not-allocated equivalences.")
     end if
     allocate (d(self%config%n_bins_max, self%config%n_dim, &
          self%config%n_channel), source=0._default)
     associate (eqv => self%equivalences, nb => self%config%n_bins_max)
       do i_eqv = 1, self%equivalences%n_eqv
          call eqv%get_channels (i_eqv, ch, ch_src)
          d_src = self%integrator(ch_src)%get_distribution ()
          mode = eqv%get_mode (i_eqv)
          perm = eqv%get_perm (i_eqv)
          do j = 1, self%config%n_dim
             select case (mode (j))
             case (VEQ_IDENTITY)
                d(:, j, ch) = d(:, j, ch) + &
                     d_src(:, perm(j))
             case (VEQ_INVERT)
                d(:, j, ch) = d(:, j, ch) + &
                     d_src(nb:1:-1, perm(j))
             case (VEQ_SYMMETRIC)
                d(:, j, ch) = d(:, j, ch) + &
                     d_src(:, perm(j)) / 2. + &
                     d_src(nb:1:-1, perm(j)) / 2.
             case (VEQ_INVARIANT)
                d(:, j, ch) = 1._default
             end select
          end do
       end do
     end associate
     do ch = 1, self%config%n_channel
        call self%integrator(ch)%set_distribution (d(:, :, ch))
     end do
   end subroutine vamp2_apply_equivalences
 
 @ %def vamp2_apply_equivalences
 @ Reset the cumulative result.
 <<vamp2: vamp2: TBP>>=
   procedure, public :: reset_result => vamp2_reset_result
 <<vamp2: procedures>>=
   subroutine vamp2_reset_result (self)
     class(vamp2_t), intent(inout) :: self
     self%result%sum_int_wgtd = 0.
     self%result%sum_wgts = 0.
     self%result%sum_chi = 0.
     self%result%it_num = 0
     self%result%samples = 0
     self%result%chi2 = 0
     self%result%efficiency = 0.
   end subroutine vamp2_reset_result
 
 @ %def vamp2_reset_result
 @ Integrate. We integrate each channel separately and combine the results
 \begin{align}
   I & = \sum_i \alpha_i I_i, \\
   \sigma^2 & = \sum_i \alpha_i^2 \sigma^2_i.
 \end{align}
 Although, the (population) variance is given by
 \begin{equation}
   \begin{split}
     \sigma^2 & = \frac{1}{N} \left( \sum_i \alpha_i I^2_i - I^2 \right) \\
     & = \frac{1}{N - 1} \left( \sum_i \left( N_i \sigma^2_i + I^2_i \right) -I^2
     \right) \\
     & = \frac{1}{N - 1} \left( \sum_i \alpha_i \sigma^2_i + \alpha_i I^2_i - I^2
     \right),
   \end{split}
 \end{equation}
 where we used $\sigma^2_i = \frac{1}{N} \left( \langle I^2_i \rangle - \langle
   I_i \rangle^2 \right)$, we use the approximation for numeric stability.
 The population variance relates to sample variance
 \begin{equation}
   s^2 = \frac{n}{n - 1} \sigma^2,
 \end{equation}
 which gives an unbiased error estimate.
 
 Beside those adaption to multichannel, the overall processing of
 [[total_integral]], [[total_sq_integral]] and [[total_variance]] is the same as
 in [[vegas_integrate]].
 <<vamp2: vamp2: TBP>>=
   procedure, public :: integrate => vamp2_integrate
 <<vamp2: procedures>>=
   subroutine vamp2_integrate (self, func, rng, iterations, opt_reset_result,&
        & opt_refine_grid, opt_adapt_weight, opt_verbose, result, abserr)
     class(vamp2_t), intent(inout) :: self
     class(vamp2_func_t), intent(inout) :: func
     class(rng_t), intent(inout) :: rng
     integer, intent(in), optional :: iterations
     logical, intent(in), optional :: opt_reset_result
     logical, intent(in), optional :: opt_refine_grid
     logical, intent(in), optional :: opt_adapt_weight
     logical, intent(in), optional :: opt_verbose
     real(default), optional, intent(out) :: result, abserr
     integer :: it, ch
     real(default) :: total_integral, total_sq_integral, total_variance, chi, wgt
     real(default) :: cumulative_int, cumulative_std
     logical :: reset_result = .true.
     logical :: adapt_weight = .true.
     logical :: refine_grid = .true.
     logical :: verbose = .false.
   <<vamp2: vamp2 integrate: variables>>
     if (present (iterations)) self%config%iterations = iterations
     if (present (opt_reset_result)) reset_result = opt_reset_result
     if (present (opt_adapt_weight)) adapt_weight = opt_adapt_weight
     if (present (opt_refine_grid)) refine_grid = opt_refine_grid
     if (present (opt_verbose)) verbose = opt_verbose
   <<vamp2: vamp2 integrate: initalization>>
     if (verbose) then
        call msg_message ("Results: [it, calls, integral, error, chi^2, eff.]")
     end if
     iteration: do it = 1, self%config%iterations
      <<vamp2: vamp2 integrate: pre sampling>>
        do ch = 1, self%config%n_channel
           func%wi(ch) = self%weight(ch)
           func%grids(ch) = self%integrator(ch)%get_grid ()
        end do
        channel: do ch = 1, self%config%n_channel
         <<vamp2: vamp2 integrate: sampling>>
           call func%set_channel (ch)
           call self%integrator(ch)%integrate ( &
                & func, rng, iterations, opt_refine_grid = .false., opt_verbose = verbose)
        end do channel
      <<vamp2: vamp2 integrate: post sampling>>
        total_integral = dot_product (self%weight, self%integrator%get_integral ())
        total_sq_integral = dot_product (self%weight, self%integrator%get_integral ()**2)
        total_variance = self%config%n_calls * dot_product (self%weight**2, self%integrator%get_variance ())
        associate (result => self%result)
          ! a**2 - b**2 = (a - b) * (a + b)
          total_variance = sqrt (total_variance + total_sq_integral)
          total_variance = 1. / self%config%n_calls * &
               & (total_variance + total_integral) * (total_variance - total_integral)
          ! Ensure variance is always positive and larger than zero
          if (total_variance < tiny (1._default) / epsilon (1._default) * max (total_integral**2, 1._default)) then
             total_variance = tiny (1._default) / epsilon (1._default) * max (total_integral**2, 1._default)
          end if
          wgt = 1. / total_variance
          result%result = total_integral
          result%std = sqrt (total_variance)
          result%samples = result%samples + 1
          if (result%samples == 1) then
             result%chi2 = 0._default
          else
             chi = total_integral
             if (result%sum_wgts > 0) chi = chi - result%sum_int_wgtd / result%sum_wgts
             result%chi2 = result%chi2 * (result%samples - 2.0_default)
             result%chi2 = (wgt / (1._default + (wgt / result%sum_wgts))) &
                  & * chi**2
             result%chi2 = result%chi2 / (result%samples - 1._default)
          end if
          result%sum_wgts = result%sum_wgts + wgt
          result%sum_int_wgtd = result%sum_int_wgtd + (total_integral * wgt)
          result%sum_chi = result%sum_chi + (total_sq_integral * wgt)
          cumulative_int = result%sum_int_wgtd / result%sum_wgts
          cumulative_std = sqrt (1. / result%sum_wgts)
          call calculate_efficiency ()
          if (verbose) then
-            write (msg_buffer, "(I0,1x,I0,1x, 4(" // FMT_17 // ",1x))") &
+            write (msg_buffer, "(I0,1x,I0,1x, 4(E16.8E4,1x))") &
                  & it, self%config%n_calls, cumulative_int, cumulative_std, &
                  & self%result%chi2, self%result%efficiency
             call msg_message ()
          end if
        end associate
        if (adapt_weight) then
           call self%adapt_weights ()
        end if
        if (refine_grid) then
-          if (self%config%equivalences) then
+          if (self%config%equivalences .and. self%equivalences%is_allocated ()) then
              call self%apply_equivalences ()
           end if
           do ch = 1, self%config%n_channel
              call self%integrator(ch)%refine ()
           end do
        end if
     end do iteration
     if (present (result)) result = cumulative_int
     if (present (abserr)) abserr = abs (cumulative_std)
   <<vamp2: vamp2 integrate: procedures>>
   end subroutine vamp2_integrate
 
 @ %def vamp2_integrate
 @
 <<vamp2: vamp2 integrate: procedures>>=
 contains
   subroutine calculate_efficiency ()
     self%result%max_abs_f = dot_product (self%weight, &
          & self%integrator%get_max_abs_f ())
     self%result%max_abs_f_pos = dot_product (self%weight, &
          & self%integrator%get_max_abs_f_pos ())
     self%result%max_abs_f_neg = dot_product (self%weight, &
          & self%integrator%get_max_abs_f_neg ())
     self%result%efficiency = 0.
     if (self%result%max_abs_f > 0.) then
        self%result%efficiency = &
             & dot_product (self%weight * self%integrator%get_max_abs_f (), &
             & self%integrator%get_efficiency ()) / self%result%max_abs_f
        ! TODO pos. or. negative efficiency would be very nice.
     end if
   end subroutine calculate_efficiency
 
 @ %def calculate_efficiency
 @
 We define additional chunks, which we use to insert parallel/MPI code.
 <<vamp2: vamp2 integrate: variables>>=
 @
 <<vamp2: vamp2 integrate: initalization>>=
   cumulative_int = 0.
   cumulative_std = 0.
   if (reset_result) call self%reset_result ()
 @
 <<vamp2: vamp2 integrate: pre sampling>>=
   total_integral = 0._default
   total_sq_integral = 0._default
   total_variance = 0._default
 @
 <<vamp2: vamp2 integrate: sampling>>=
 @
 <<vamp2: vamp2 integrate: post sampling>>=
 @
 @ Distribute workers up in chunks of [[n_size]].
 <<MPI: vamp2: vamp2 integrate: procedures>>=
   integer function map_channel_to_worker (channel, n_size) result (worker)
     integer, intent(in) :: channel
     integer, intent(in) :: n_size
     worker = mod (channel, n_size)
   end function map_channel_to_worker
 
 @ %def map_channel_to_rank
 <<MPI: vamp2: vamp2 integrate: variables>>=
   type(vegas_grid_t) :: grid
   type(MPI_Request) :: status
   integer :: rank, n_size, worker
 @
 <<MPI: vamp2: vamp2 integrate: initalization>>=
   call MPI_Comm_rank (MPI_COMM_WORLD, rank)
   call MPI_Comm_size (MPI_COMM_WORLD, n_size)
 @ Broadcast all a-priori weights. After setting the weights, we have to update
 the number of calls in each channel. Afterwards, we can collect the number of
 channels, which are not parallelized by [[VEGAS]] itself, [[n_channel_non_parallel]].
 <<MPI: vamp2: vamp2 integrate: pre sampling>>=
   call MPI_Ibcast (self%weight, self%config%n_channel, MPI_DOUBLE_PRECISION, 0,&
        & MPI_COMM_WORLD, status)
   do ch = 1, self%config%n_channel
      grid = self%integrator(ch)%get_grid ()
      call grid%broadcast ()
      call self%integrator(ch)%set_grid (grid)
   end do
   call MPI_Wait (status, MPI_STATUS_IGNORE)
   call self%set_calls (self%config%n_calls)
 @ We check on the parallelization state of the current [[VEGAS]] integrator.
 If [[VEGAS]] can not be parallelized on lowest level, we map the current channel
 to a rank and calculate the channel on that rank.
 On all other worker we just enhance the random-generator (when supported), see
 [[vegas_integrate]] for the details on the random-generator handling.
 <<MPI: vamp2: vamp2 integrate: sampling>>=
   if (.not. self%integrator(ch)%is_parallelizable ()) then
      worker = map_channel_to_worker (ch, n_size)
      if (rank /= worker) then
         select type (rng)
         type is (rng_stream_t)
            call rng%next_substream ()
         end select
         cycle channel
      end if
   else
      call MPI_Barrier (MPI_COMM_WORLD)
   end if
 @ Collect results, the actual communication is done inside the different objects.
 <<MPI: vamp2: vamp2 integrate: post sampling>>=
   call vamp2_integrate_collect ()
 <<MPI: vamp2: vamp2 integrate: procedures>>=
   subroutine vamp2_integrate_collect ()
     type(vegas_result_t) :: result
     integer :: root_n_calls
     integer :: worker
     do ch = 1, self%config%n_channel
        if (self%integrator(ch)%is_parallelizable ()) cycle
        worker = map_channel_to_worker (ch, n_size)
        result = self%integrator(ch)%get_result ()
        if (rank == 0) then
           if (worker /= 0) then
              call result%receive (worker, ch)
              call self%integrator(ch)%receive_distribution (worker, ch)
              call self%integrator(ch)%set_result (result)
           end if
        else
           if (rank == worker) then
              call result%send (0, ch)
              call self%integrator(ch)%send_distribution (0, ch)
           end if
        end if
     end do
     select type (func)
     class is (vamp2_func_t)
        call MPI_reduce (func%n_calls, root_n_calls, 1, MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD)
        if (rank == 0) then
           func%n_calls = root_n_calls
        else
           call func%reset_n_calls ()
        end if
     end select
   end subroutine vamp2_integrate_collect
 
 @ %def vegas_integrate_collect
 @ Skip results analyze if non-root, after waiting for all processes to reach the
 barrier.
 <<MPI: vamp2: vamp2 integrate: post sampling>>=
   call MPI_barrier (MPI_COMM_WORLD)
   if (rank /= 0) cycle iteration
 @ Generate event from multi-channel weight $w(x) = f(x) / g(x)$.
 
 We select a channel using the a-priori weights and $f_{i}^{\text{max}}$, to
 flatten possible unbalanced channel weight(s).
 
 An additional rescale factor [[opt_event_rescale]] is applied to [[f_max]], iff set.
 <<vamp2: vamp2: TBP>>=
   procedure, public :: generate_weighted => vamp2_generate_weighted_event
 <<vamp2: procedures>>=
   subroutine vamp2_generate_weighted_event (&
        self, func, rng, x)
     class(vamp2_t), intent(inout) :: self
     class(vamp2_func_t), intent(inout) :: func
     class(rng_t), intent(inout) :: rng
     real(default), dimension(self%config%n_dim), intent(out)  :: x
     integer :: ch, i
     real(default) :: r
     if (.not. self%event_prepared) then
        call prepare_event ()
     end if
     call rng%generate (r)
     nchannel: do ch = 1, self%config%n_channel
        r = r - self%event_weight(ch)
        if (r <= 0._default) exit nchannel
     end do nchannel
     ch = min (ch, self%config%n_channel)
     call func%set_channel (ch)
     call msg_debug (D_VAMP2, "vamp2_generate_weighted_event")
     call msg_debug (D_VAMP2, "Selected channel", ch)
     call msg_debug (D_VAMP2, "Ch. Event weight", self%event_weight(ch))
     call self%integrator(ch)%generate_weighted (func, rng, x)
     ! Norm weight by f_max, hidden in event_weight(ch), else by 1
     self%result%evt_weight = self%integrator(ch)%get_evt_weight () &
          * self%weight(ch) / self%event_weight(ch)
     call msg_debug2 (D_VAMP2, "Event weight", self%result%evt_weight)
   contains
   <<vamp2: vamp2 generate event: procedures>>
   end subroutine vamp2_generate_weighted_event
 
 @ %def vamp2_generate_weighted_event
 @ Generate unweighted events.
 
 After selecting a channel $ch$ by the acceptance $r$
 \begin{equation*}
   r > \operatorname*{argmax}_{ch} \sum_{i = 1}^{ch} \alpha_i,
 \end{equation*}
 we try for an event from the previously selected channel.
 If the event is rejected, we also reject the selected channel.
 <<vamp2: vamp2: TBP>>=
   procedure, public :: generate_unweighted => vamp2_generate_unweighted_event
 <<vamp2: procedures>>=
   subroutine vamp2_generate_unweighted_event ( &
        & self, func, rng, x, opt_event_rescale)
     class(vamp2_t), intent(inout) :: self
     class(vamp2_func_t), intent(inout) :: func
     class(rng_t), intent(inout) :: rng
     real(default), dimension(self%config%n_dim), intent(out)  :: x
     real(default), intent(in), optional :: opt_event_rescale
     integer :: ch, i
     real(default) :: r, max_abs_f, event_rescale
     event_rescale = 1._default
     if (present (opt_event_rescale)) then
        event_rescale = opt_event_rescale
     end if
     if (.not. self%event_prepared) then
        call prepare_event ()
     end if
     generate: do
        call rng%generate (r)
        nchannel: do ch = 1, self%config%n_channel
           r = r - self%event_weight(ch)
           if (r <= 0._default) exit nchannel
        end do nchannel
        ch = min (ch, self%config%n_channel)
        call func%set_channel (ch)
        if (debug_active (D_VAMP2)) then
           call msg_debug (D_VAMP2, "vamp2_generate_unweighted_event")
           call msg_debug (D_VAMP2, "Selected channel", ch)
           call msg_debug (D_VAMP2, "Ch. Event weight", self%event_weight(ch))
        end if
        call self%integrator(ch)%generate_weighted (func, rng, x)
        self%result%evt_weight = self%integrator(ch)%get_evt_weight ()
        if (debug_active (D_VAMP2)) &
           call msg_debug (D_VAMP2, "Event weight", self%result%evt_weight)
        max_abs_f = merge ( &
             self%integrator(ch)%get_max_abs_f_pos (), &
             self%integrator(ch)%get_max_abs_f_neg (), &
             self%result%evt_weight > 0.)
        self%result%evt_weight_excess = 0._default
        if (self%result%evt_weight > max_abs_f) then
           self%result%evt_weight_excess = self%result%evt_weight / max_abs_f - 1._default
           exit generate
        end if
        call rng%generate (r)
        if (debug2_active (D_VAMP2)) then
           print *, "max_abs_f    = ", max_abs_f
           print *, "rescale      = ", event_rescale
           print *, "r            = ", r
           print *, "accept       = ", event_rescale * max_abs_f * r
           print *, "x            = ", x
           print *, "Event Excess = ", self%result%evt_weight_excess
        end if
        ! Do not use division, because max_abs_f could be zero.
        if (event_rescale * max_abs_f * r <= abs(self%result%evt_weight)) then
           call msg_debug (D_VAMP2, "accept event")
           exit generate
        else
           if (debug2_active (D_VAMP2)) then
              print *, "diff           = ", abs(self%result%evt_weight) - (event_rescale * max_abs_f * r)
              print *, "max_abs_f_pos  = ", self%integrator(ch)%get_max_abs_f_pos ()
              print *, "max_abs_f_neg  = ", self%integrator(ch)%get_max_abs_f_neg ()
              print *, "sign           = ", (self%result%evt_weight > 0.)
           end if
           call msg_debug (D_VAMP2, "do not accept event")
        end if
     end do generate
   contains
   <<vamp2: vamp2 generate event: procedures>>
   end subroutine vamp2_generate_unweighted_event
 
 @ %def vamp2_generate_event
 Prepare event generation. We have to set the channel weights and the grids for
 the integrand's object.
 
 We use an ansatz proposed by T. Ohl in the original VAMP code where we do not have to accept on
 \begin{equation*}
    \frac{w_i(x)}{\operatorname*{max}_{i, x} w_i(x)},
 \end{equation*}
 after we have selected a channel by the weights $\alpha_i$. But rather, we use a
 more efficient way where we rescale the channel weights $\alpha_i$
 \begin{equation*}
    \alpha_i \rightarrow \alpha_i \frac{\operatorname*{max}_x w_i(x)}{\operatorname*{max}_{i, x} w_i(x)}.
 \end{equation*}
 The overall magic is to insert a "1" and to  move the uneasy part into the channel selection,
 such that we can generate events likewise in the single channel mode.
 We generate an unweighted event by
 \begin{equation*}
    \frac{w_i(x)}{\operatorname*{max}_{x} w_i{x}},
 \end{equation*}
 after we have selected a channel by the rescaled event channel weights.
 The overall normalization $\operatorname*{max}_{i, x}$ is not needed because we normalize the event channel weights
 to one and therefore the overall normalization cancels.
 <<vamp2: vamp2 generate event: procedures>>=
   subroutine prepare_event ()
     integer :: i
     self%event_prepared = .false.
     do i = 1, self%config%n_channel
        func%wi(i) = self%weight(i)
        func%grids(i) = self%integrator(i)%get_grid ()
     end do
     if (any (self%integrator%get_max_abs_f () > 0)) then
        self%event_weight = self%weight * self%integrator%get_max_abs_f ()
     else
        self%event_weight = self%weight
     end if
     self%event_weight = self%event_weight / sum (self%event_weight)
     self%event_prepared = .true.
   end subroutine prepare_event
 
 @ %def prepare_event
 @ Write grids to unit.
 <<vamp2: parameters>>=
   character(len=*), parameter, private :: &
      descr_fmt =         "(1X,A)", &
      integer_fmt =       "(1X,A18,1X,I15)", &
      integer_array_fmt = "(1X,I18,1X,I15)", &
      logical_fmt =       "(1X,A18,1X,L1)", &
-     double_fmt =        "(1X,A18,1X," // FMT_17 // ")", &
-     double_array_fmt =  "(1X,I18,1X," // FMT_17 // ")", &
-     double_array2_fmt =  "(1X,2(1X,I8),1X," // FMT_17 // ")"
+     double_fmt =        "(1X,A18,1X,E16.8E4)", &
+     double_array_fmt =  "(1X,I18,1X,E16.8E4)", &
+     double_array2_fmt = "(1X,2(1X,I8),1X,E16.8E4)"
 @ %def descr_fmt integer_fmt integer_array_fmt logical_fmt
 @ %def double_fmt double_array_fmt double_array2_fmt
 <<vamp2: vamp2: TBP>>=
   procedure, public :: write_grids => vamp2_write_grids
 <<vamp2: procedures>>=
   subroutine vamp2_write_grids (self, unit)
     class(vamp2_t), intent(in) :: self
     integer, intent(in), optional :: unit
     integer :: u
     integer :: ch
     u = given_output_unit (unit)
     write (u, descr_fmt) "begin type(vamp2_t)"
     write (u, integer_fmt) "n_channel =", self%config%n_channel
     write (u, integer_fmt) "n_dim =", self%config%n_dim
     write (u, integer_fmt) "n_calls_min_ch =", self%config%n_calls_min_per_channel
     write (u, integer_fmt) "n_calls_thres =", self%config%n_calls_threshold
     write (u, integer_fmt) "n_chains =", self%config%n_chains
     write (u, logical_fmt) "stratified =", self%config%stratified
     write (u, double_fmt) "alpha =", self%config%alpha
     write (u, double_fmt) "beta =", self%config%beta
     write (u, integer_fmt) "n_bins_max =", self%config%n_bins_max
     write (u, integer_fmt) "iterations =", self%config%iterations
     write (u, integer_fmt) "n_calls =", self%config%n_calls
     write (u, integer_fmt) "it_start =", self%result%it_start
     write (u, integer_fmt) "it_num =", self%result%it_num
     write (u, integer_fmt) "samples =", self%result%samples
     write (u, double_fmt) "sum_int_wgtd =", self%result%sum_int_wgtd
     write (u, double_fmt) "sum_wgts =", self%result%sum_wgts
     write (u, double_fmt) "sum_chi =", self%result%sum_chi
     write (u, double_fmt) "chi2 =", self%result%chi2
     write (u, double_fmt) "efficiency =", self%result%efficiency
     write (u, double_fmt) "efficiency_pos =", self%result%efficiency_pos
     write (u, double_fmt) "efficiency_neg =", self%result%efficiency_neg
     write (u, double_fmt) "max_abs_f =", self%result%max_abs_f
     write (u, double_fmt) "max_abs_f_pos =", self%result%max_abs_f_pos
     write (u, double_fmt) "max_abs_f_neg =", self%result%max_abs_f_neg
     write (u, double_fmt) "result =", self%result%result
     write (u, double_fmt) "std =", self%result%std
     write (u, descr_fmt) "begin weight"
     do ch = 1, self%config%n_channel
        write (u, double_array_fmt) ch, self%weight(ch)
     end do
     write (u, descr_fmt) "end weight"
     if (self%config%n_chains > 0) then
        write (u, descr_fmt) "begin chain"
        do ch = 1, self%config%n_channel
           write (u, integer_array_fmt) ch, self%chain(ch)
        end do
        write (u, descr_fmt) "end chain"
     end if
     write (u, descr_fmt) "begin integrator"
     do ch = 1, self%config%n_channel
        call self%integrator(ch)%write_grid (unit)
     end do
     write (u, descr_fmt) "end integrator"
     write (u, descr_fmt) "end type(vamp2_t)"
   end subroutine vamp2_write_grids
 
 @ %def vamp2_write_grids
 @ Read grids from unit.
 <<vamp2: vamp2: TBP>>=
   procedure, public :: read_grids => vamp2_read_grids
 <<vamp2: procedures>>=
   subroutine vamp2_read_grids (self, unit)
     class(vamp2_t), intent(out) :: self
     integer, intent(in), optional :: unit
     integer :: u
     integer :: ibuffer, jbuffer, ch
     character(len=80) :: buffer
     read (unit, descr_fmt) buffer
     read (unit, integer_fmt) buffer, ibuffer
     read (unit, integer_fmt) buffer, jbuffer
     select type (self)
     type is (vamp2_t)
        self = vamp2_t (n_channel = ibuffer, n_dim = jbuffer)
     end select
     read (unit, integer_fmt) buffer, self%config%n_calls_min_per_channel
     read (unit, integer_fmt) buffer, self%config%n_calls_threshold
     read (unit, integer_fmt) buffer, self%config%n_chains
     read (unit, logical_fmt) buffer, self%config%stratified
     read (unit, double_fmt) buffer, self%config%alpha
     read (unit, double_fmt) buffer, self%config%beta
     read (unit, integer_fmt) buffer, self%config%n_bins_max
     read (unit, integer_fmt) buffer, self%config%iterations
     read (unit, integer_fmt) buffer, self%config%n_calls
     read (unit, integer_fmt) buffer, self%result%it_start
     read (unit, integer_fmt) buffer, self%result%it_num
     read (unit, integer_fmt) buffer, self%result%samples
     read (unit, double_fmt) buffer, self%result%sum_int_wgtd
     read (unit, double_fmt) buffer, self%result%sum_wgts
     read (unit, double_fmt) buffer, self%result%sum_chi
     read (unit, double_fmt) buffer, self%result%chi2
     read (unit, double_fmt) buffer, self%result%efficiency
     read (unit, double_fmt) buffer, self%result%efficiency_pos
     read (unit, double_fmt) buffer, self%result%efficiency_neg
     read (unit, double_fmt) buffer, self%result%max_abs_f
     read (unit, double_fmt) buffer, self%result%max_abs_f_pos
     read (unit, double_fmt) buffer, self%result%max_abs_f_neg
     read (unit, double_fmt) buffer, self%result%result
     read (unit, double_fmt) buffer, self%result%std
     read (unit, descr_fmt) buffer
     do ch = 1, self%config%n_channel
        read (unit, double_array_fmt) ibuffer, self%weight(ch)
     end do
     read (unit, descr_fmt) buffer
     if (self%config%n_chains > 0) then
        read (unit, descr_fmt) buffer
        do ch = 1, self%config%n_channel
           read (unit, integer_array_fmt) ibuffer, self%chain(ch)
        end do
        read (unit, descr_fmt) buffer
     end if
     read (unit, descr_fmt) buffer
     do ch = 1, self%config%n_channel
        call self%integrator(ch)%read_grid (unit)
     end do
     read (unit, descr_fmt) buffer
     read (unit, descr_fmt) buffer
   end subroutine vamp2_read_grids
 
 @ %def vamp2_read_grids
 @
 \section{Unit tests}
 \label{sec:unit-tests}
 
 Test module, followed by the corresponding implementation module.
 
 <<[[vamp2_ut.f90]]>>=
 <<File header>>
 
 module vamp2_ut
   use unit_tests
   use vamp2_uti
 
 <<Standard module head>>
 
 <<vamp2: public test>>
 
 contains
 <<vamp2: test driver>>
 end module vamp2_ut
 @ %def vamp2_ut
 @
 <<[[vamp2_uti.f90]]>>=
 <<File header>>
 
 module vamp2_uti
 <<Use kinds>>
   use io_units
   use constants, only: pi
   use numeric_utils, only: nearly_equal
   use format_defs, only: FMT_12
   use rng_base
   use rng_stream
   use vegas, only: vegas_func_t, vegas_grid_t, operator(==)
   use vamp2
 
 <<Standard module head>>
 
 <<vamp2: test declaration>>
 
 <<vamp2: test types>>
 
 contains
 <<vamp2: tests>>
 end module vamp2_uti
 @ %def vamp2_uti
 @ API: driver for the unit tests below.
 <<vamp2: public test>>=
   public :: vamp2_test
 <<vamp2: test driver>>=
   subroutine vamp2_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
     <<vamp2: execute tests>>
   end subroutine vamp2_test
 
 @ %def vamp2_test
 @
 \subsubsection{Test function}
 \label{sec:test-function}
 
 We use the example from the Monte Carlo Examples of the GSL library
 \begin{equation}
   I = \int_{-pi}^{+pi} {dk_x/(2 pi)}  \int_{-pi}^{+pi} {dk_y/(2 pi)}  \int_{-pi}^{+pi} {dk_z/(2 pi)}  1 / (1 - cos(k_x)cos(k_y)cos(k_z)).
 \end{equation}
 The integral is reduced to region (0,0,0) $\rightarrow$ ($\pi$, $\pi$, $\pi$) and multiplied by 8.
 <<vamp2: test types>>=
    type, extends (vamp2_func_t) :: vamp2_test_func_t
      !
    contains
    <<vamp2: vamp2 test func: TBP>>
 end type vamp2_test_func_t
 
 @ %def vegas_test_func_t
 @
 <<vamp2: vamp2 test func: TBP>>=
   procedure, public :: evaluate_maps => vamp2_test_func_evaluate_maps
 <<vamp2: tests>>=
   subroutine vamp2_test_func_evaluate_maps (self, x)
     class(vamp2_test_func_t), intent(inout) :: self
     real(default), dimension(:), intent(in) :: x
     self%xi(:, 1) = x
     self%det(1) = 1
     self%valid_x = .true.
   end subroutine vamp2_test_func_evaluate_maps
 
 @ %def vamp2_test_func_evaluate_maps
 @ Evaluate the integrand.
 <<vamp2: vamp2 test func: TBP>>=
   procedure, public :: evaluate_func => vamp2_test_func_evaluate
 <<vamp2: tests>>=
   real(default) function vamp2_test_func_evaluate (self, x) result (f)
     class(vamp2_test_func_t), intent(in) :: self
     real(default), dimension(:), intent(in) :: x
     f = 1.0 / (pi**3)
     f = f / ( 1.0 - cos (x(1)) * cos (x(2)) * cos (x(3)))
   end function vamp2_test_func_evaluate
 
 @ %def vamp2_test_func_evaluate
 @ The second test function implements
 \begin{equation}
   f(\vec{x}) = 4 \sin^{2}(\pi x_{1})\sin^{2}(\pi x_{2}) + 2\sin^2(\pi v),
 \end{equation}
 where
 \begin{align}
   x = u^{v} & y = u^{1 - v} \\
   u = xy & v = \frac{1}{2} \left( 1 + \frac{\log(x/y}{\log(xy)} \right).
 \end{align}
 The jacobian is $\frac{\partial (x, y)}{\partial (u, v)}$.
 
 <<vamp2: test types>>=
   type, extends(vamp2_func_t) :: vamp2_test_func_2_t
      !
    contains
    <<vamp2: vamp2 test func 2: TBP>>
   end type vamp2_test_func_2_t
 
 @ %def vamp2_test_func_2_t
 @ Evaluate maps.
 <<vamp2: vamp2 test func 2: TBP>>=
   procedure :: evaluate_maps => vamp2_test_func_2_evaluate_maps
 <<vamp2: tests>>=
   subroutine vamp2_test_func_2_evaluate_maps (self, x)
     class(vamp2_test_func_2_t), intent(inout) :: self
     real(default), dimension(:), intent(in) :: x
     select case (self%current_channel)
     case (1)
        self%xi(:, 1) = x
        self%xi(1, 2) = x(1) * x(2)
        self%xi(2, 2) = 0.5 * ( 1. + log(x(1) / x(2)) / log(x(1) * x(2)))
     case (2)
        self%xi(1, 1) = x(1)**x(2)
        self%xi(2, 1) = x(1)**(1. - x(2))
        self%xi(:, 2) = x
     end select
     self%det(1) = 1.
     self%det(2) = abs (log(self%xi(1, 2)))
     self%valid_x = .true.
   end subroutine vamp2_test_func_2_evaluate_maps
 
 @ %def vamp2_test_func_2_evaluate_maps
 @ Evaluate func.
 <<vamp2: vamp2 test func 2: TBP>>=
   procedure :: evaluate_func => vamp2_test_func_2_evaluate_func
 <<vamp2: tests>>=
   real(default) function vamp2_test_func_2_evaluate_func (self, x) result (f)
     class(vamp2_test_func_2_t), intent(in) :: self
     real(default), dimension(:), intent(in) :: x
     f = 4. * sin(pi * self%xi(1, 1))**2 * sin(pi * self%xi(2, 1))**2 + 2. * sin(pi * self%xi(2, 2))**2
   end function vamp2_test_func_2_evaluate_func
 
 @ %def vamp2_test_func_2_evaluate_func
 @@ The third test function implements
 \begin{equation}
   f(\vec{x}) = 5 x_{1}^4 + 5 (1 - x_{1})^4,
 \end{equation}
 where
 \begin{align}
   x_1 = u^{1 / 5} & ∨ x_1 =  1 - v^{1 / 5} \\
 \end{align}
 The jacobians are $\frac{\partial x_1}{\partial u} = \frac{1}{5} u^{-\frac{4}{5}}$
 and $\frac{\partial x_1}{\partial v} = \frac{1}{5} v^{-\frac{4}{5}}$.
 <<vamp2: test types>>=
   type, extends(vamp2_func_t) :: vamp2_test_func_3_t
      !
    contains
    <<vamp2: vamp2 test func 3: TBP>>
   end type vamp2_test_func_3_t
 
 @ %def vamp2_test_func_3_t
 @ Evaluate maps.
 <<vamp2: vamp2 test func 3: TBP>>=
   procedure :: evaluate_maps => vamp2_test_func_3_evaluate_maps
 <<vamp2: tests>>=
   subroutine vamp2_test_func_3_evaluate_maps (self, x)
     class(vamp2_test_func_3_t), intent(inout) :: self
     real(default), dimension(:), intent(in) :: x
     real(default) :: u, v, xx
     select case (self%current_channel)
     case (1)
        u = x(1)
        xx = u**0.2_default
        v = (1 - xx)**5._default
     case (2)
        v = x(1)
        xx = 1 - v**0.2_default
        u = xx**5._default
     end select
     self%det(1) = 0.2_default * u**(-0.8_default)
     self%det(2) = 0.2_default * v**(-0.8_default)
     self%xi(:, 1) = [u]
     self%xi(:, 2) = [v]
     self%valid_x = .true.
   end subroutine vamp2_test_func_3_evaluate_maps
 
 @ %def vamp2_test_func_3_evaluate_maps
 @ Evaluate func.
 <<vamp2: vamp2 test func 3: TBP>>=
   procedure :: evaluate_func => vamp2_test_func_3_evaluate_func
 <<vamp2: tests>>=
   real(default) function vamp2_test_func_3_evaluate_func (self, x) result (f)
     class(vamp2_test_func_3_t), intent(in) :: self
     real(default), dimension(:), intent(in) :: x
     real(default) :: xx
     select case (self%current_channel)
     case (1)
        xx = x(1)**0.2_default
     case (2)
        xx = 1 - x(1)**0.2_default
     end select
     f = 5 * xx**4 + 5 * (1 - xx)**4
   end function vamp2_test_func_3_evaluate_func
 
 @ %def vamp2_test_func_3_evaluate_func
 @
 \subsubsection{MC Integrator check}
 \label{sec:mc-integrator-check}
 
 We reproduce the first test case of VEGAS.
 Initialise the VAMP2 MC integrator and call to [[vamp2_init_grid]] for the initialisation of the grid.
 <<vamp2: execute tests>>=
   call test (vamp2_1, "vamp2_1", "VAMP2 initialisation and&
        & grid preparation", u, results)
 <<vamp2: test declaration>>=
   public :: vamp2_1
 <<vamp2: tests>>=
   subroutine vamp2_1 (u)
     integer, intent(in) :: u
     type(vamp2_t) :: mc_integrator
     class(rng_t), allocatable :: rng
     class(vamp2_func_t), allocatable :: func
     real(default), dimension(3), parameter :: x_lower = 0., &
          x_upper = pi
     real(default) :: result, abserr
 
     write (u, "(A)") "* Test output: vamp2_1"
     write (u, "(A)") "*   Purpose: initialise the VAMP2 MC integrator and the grid"
     write (u, "(A)")
 
     write (u, "(A)") "* Initialise random number generator (default seed)"
     write (u, "(A)")
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
 
     call rng%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise MC integrator with n_channel = 1 and n_dim = 3"
     write (u, "(A)")
 
     allocate (vamp2_test_func_t :: func)
     call func%init (n_dim = 3, n_channel = 1)
     mc_integrator = vamp2_t (1, 3)
     call mc_integrator%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise grid with n_calls = 10000"
     write (u, "(A)")
 
     call mc_integrator%set_limits (x_lower, x_upper)
     call mc_integrator%set_calls (10000)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 10000 (Adaptation)"
     write (u, "(A)")
 
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
     write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 2000 (Precision)"
     write (u, "(A)")
 
     call mc_integrator%set_calls (2000)
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
     write (u,  "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Cleanup"
 
     call mc_integrator%final ()
     call rng%final ()
     deallocate (rng)
   end subroutine vamp2_1
 
 @ %def vamp2_1
 @ Integrate a function with two-dimensional argument and two channels.
 <<vamp2: execute tests>>=
   call test (vamp2_2, "vamp2_2", "VAMP2 intgeration of two-dimensional &
        & function with two channels", u, results)
 <<vamp2: test declaration>>=
   public :: vamp2_2
 <<vamp2: tests>>=
   subroutine vamp2_2 (u)
     integer, intent(in) :: u
     type(vamp2_t) :: mc_integrator
     class(rng_t), allocatable :: rng
     class(vamp2_func_t), allocatable :: func
     real(default), dimension(2), parameter :: x_lower = 0., &
          x_upper = 1.
     real(default) :: result, abserr
 
     write (u, "(A)") "* Test output: vamp2_2"
     write (u, "(A)") "*   Purpose:  intgeration of two-dimensional &
        & function with two channels"
     write (u, "(A)")
 
     write (u, "(A)") "* Initialise random number generator (default seed)"
     write (u, "(A)")
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
 
     call rng%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise MC integrator with n_channel = 1 and n_dim = 3"
     write (u, "(A)")
 
     allocate (vamp2_test_func_2_t :: func)
     call func%init (n_dim = 2, n_channel = 2)
     mc_integrator = vamp2_t (2, 2)
     call mc_integrator%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise grid with n_calls = 10000"
     write (u, "(A)")
 
     call mc_integrator%set_limits (x_lower, x_upper)
     call mc_integrator%set_calls (1000)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 10000 (Adaptation)"
     write (u, "(A)")
 
     call mc_integrator%integrate (func, rng, 3, opt_verbose = .true., result=result, abserr=abserr)
     write (u,  "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 2000 (Precision)"
     write (u, "(A)")
 
     call mc_integrator%set_calls (200)
     call mc_integrator%integrate (func, rng, 3, opt_verbose = .true., result=result, abserr=abserr)
     write (u,  "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Cleanup"
 
     call mc_integrator%final ()
     call rng%final ()
     deallocate (rng)
   end subroutine vamp2_2
 
 @ %def vamp2_2
 @ Integrate a function with two-dimensional argument and two channels.
 <<vamp2: execute tests>>=
   call test (vamp2_3, "vamp2_3", "VAMP2 intgeration of two-dimensional &
        & function with two channels", u, results)
 <<vamp2: test declaration>>=
   public :: vamp2_3
 <<vamp2: tests>>=
   subroutine vamp2_3 (u)
     integer, intent(in) :: u
     type(vamp2_t) :: mc_integrator
     class(rng_t), allocatable :: rng
     class(vamp2_func_t), allocatable :: func
     real(default), dimension(2), parameter :: x_lower = 0., &
          x_upper = 1.
     real(default) :: result, abserr
     integer :: unit
 
     write (u, "(A)") "* Test output: vamp2_3"
     write (u, "(A)") "*   Purpose:  intgeration of two-dimensional &
        & function with two channels"
     write (u, "(A)")
 
     write (u, "(A)") "* Initialise random number generator (default seed)"
     write (u, "(A)")
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
 
     call rng%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise MC integrator with n_channel = 1 and n_dim = 3"
     write (u, "(A)")
 
     allocate (vamp2_test_func_2_t :: func)
     call func%init (n_dim = 2, n_channel = 2)
     mc_integrator = vamp2_t (2, 2)
     call mc_integrator%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise grid with n_calls = 20000"
     write (u, "(A)")
 
     call mc_integrator%set_limits (x_lower, x_upper)
     call mc_integrator%set_calls (20000)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 20000 (Adaptation)"
     write (u, "(A)")
 
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
     write (u,  "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Write grid to file vamp2_3.grids"
     write (u, "(A)")
 
     unit = free_unit ()
     open (unit, file = "vamp2_3.grids", &
          action = "write", status = "replace")
     call mc_integrator%write_grids (unit)
     close (unit)
 
     write (u, "(A)")
     write (u, "(A)") "* Read grid from file vamp2_3.grids"
     write (u, "(A)")
 
     call mc_integrator%final ()
 
     unit = free_unit ()
     open (unit, file = "vamp2_3.grids", &
          action = "read", status = "old")
     call mc_integrator%read_grids (unit)
     close (unit)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 5000 (Precision)"
     write (u, "(A)")
 
     call mc_integrator%set_calls (5000)
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
     write (u,  "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Cleanup"
 
     call mc_integrator%final ()
     call rng%final ()
     deallocate (rng)
   end subroutine vamp2_3
 
 @ %def vamp2_3
 @ Integrate a function with two-dimensional argument and two channels.
 Use chained weights, although we average over each weight itself.
 <<vamp2: execute tests>>=
   call test (vamp2_4, "vamp2_4", "VAMP2 intgeration of two-dimensional &
        & function with two channels with chains", u, results)
 <<vamp2: test declaration>>=
   public :: vamp2_4
 <<vamp2: tests>>=
   subroutine vamp2_4 (u)
     integer, intent(in) :: u
     type(vamp2_t) :: mc_integrator
     class(rng_t), allocatable :: rng
     class(vamp2_func_t), allocatable :: func
     real(default), dimension(2), parameter :: x_lower = 0., &
          x_upper = 1.
     real(default) :: result, abserr
     integer :: unit
 
     write (u, "(A)") "* Test output: vamp2_4"
     write (u, "(A)") "*   Purpose:  intgeration of two-dimensional &
        & function with two channels with chains"
     write (u, "(A)")
 
     write (u, "(A)") "* Initialise random number generator (default seed)"
     write (u, "(A)")
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
 
     call rng%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise MC integrator with n_channel = 2 and n_dim = 2"
     write (u, "(A)")
 
     allocate (vamp2_test_func_2_t :: func)
     call func%init (n_dim = 2, n_channel = 2)
     mc_integrator = vamp2_t (2, 2)
     call mc_integrator%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise grid with n_calls = 20000 and set chains"
     write (u, "(A)")
 
     call mc_integrator%set_limits (x_lower, x_upper)
     call mc_integrator%set_calls (20000)
     call mc_integrator%set_chain (2, [1, 2])
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 10000 (Adaptation)"
     write (u, "(A)")
 
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
     write (u,  "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Write grid to file vamp2_4.grids"
     write (u, "(A)")
 
     unit = free_unit ()
     open (unit, file = "vamp2_4.grids", &
          action = "write", status = "replace")
     call mc_integrator%write_grids (unit)
     close (unit)
 
     write (u, "(A)")
     write (u, "(A)") "* Read grid from file vamp2_4.grids"
     write (u, "(A)")
 
     call mc_integrator%final ()
 
     unit = free_unit ()
     open (unit, file = "vamp2_4.grids", &
          action = "read", status = "old")
     call mc_integrator%read_grids (unit)
     close (unit)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 5000 (Precision)"
     write (u, "(A)")
 
     call mc_integrator%set_calls (5000)
     call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
     write (u,  "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr
 
     write (u, "(A)")
     write (u, "(A)") "* Cleanup"
 
     call mc_integrator%final ()
     call rng%final ()
     deallocate (rng)
   end subroutine vamp2_4
 
 @ %def vamp2_4
 @
 <<vamp2: execute tests>>=
   call test (vamp2_5, "vamp2_5", "VAMP2 intgeration of two-dimensional &
        & function with two channels with equivalences", u, results)
 <<vamp2: test declaration>>=
   public :: vamp2_5
 <<vamp2: tests>>=
   subroutine vamp2_5 (u)
     integer, intent(in) :: u
     type(vamp2_t) :: mc_integrator
     class(rng_t), allocatable :: rng
     class(vamp2_func_t), allocatable :: func
     real(default), dimension(1), parameter :: x_lower = 0., &
          x_upper = 1.
     real(default) :: result, abserr
     integer :: unit
     type(vamp2_config_t) :: config
     type(vamp2_equivalences_t) :: eqv
     type(vegas_grid_t), dimension(2) :: grid
 
     write (u, "(A)") "* Test output: vamp2_5"
     write (u, "(A)") "*   Purpose:  intgeration of two-dimensional &
        & function with two channels with equivalences"
     write (u, "(A)")
 
     write (u, "(A)") "* Initialise random number generator (default seed)"
     write (u, "(A)")
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
 
     call rng%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise MC integrator with n_channel = 2 and n_dim = 1"
     write (u, "(A)")
 
     allocate (vamp2_test_func_3_t :: func)
     call func%init (n_dim = 1, n_channel = 2)
     config%equivalences = .true.
     mc_integrator = vamp2_t (n_channel = 2, n_dim = 1)
     call mc_integrator%set_config (config)
     call mc_integrator%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise grid with n_calls = 20000 and set chains"
     write (u, "(A)")
 
     call mc_integrator%set_limits (x_lower, x_upper)
     call mc_integrator%set_calls (20000)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise equivalences"
     write (u, "(A)")
 
     eqv = vamp2_equivalences_t (n_eqv = 4, n_channel = 2, n_dim = 1)
     call eqv%set_equivalence &
          (i_eqv = 1, dest = 2, src = 1, perm = [1], mode = [VEQ_IDENTITY])
     call eqv%set_equivalence &
          (i_eqv = 2, dest = 1, src = 2, perm = [1], mode = [VEQ_IDENTITY])
     call eqv%set_equivalence &
          (i_eqv = 3, dest = 1, src = 1, perm = [1], mode = [VEQ_IDENTITY])
     call eqv%set_equivalence &
          (i_eqv = 4, dest = 2, src = 2, perm = [1], mode = [VEQ_IDENTITY])
     call eqv%write (u)
     call mc_integrator%set_equivalences (eqv)
 
     write (u, "(A)")
     write (u, "(A)") &
          "* Integrate with n_it = 3 and n_calls = 10000 (Grid-only Adaptation)"
     write (u, "(A)")
 
     call mc_integrator%integrate (func, rng, 3, &
          opt_adapt_weight = .false., result=result, abserr=abserr)
     if (nearly_equal &
          (result, 2.000_default, rel_smallness = 0.003_default)) then
        write (u,  "(2x,A)") "Result: 2.000 [ok]"
     else
        write (u,  "(2x,A," // FMT_12 // ",A," // FMT_12 // ",A)") &
             "Result: ", result, " +/- ", abserr, " [not ok]"
     end if
 
     write (u, "(A)")
     write (u, "(A)") "* Compare the grids of both channels"
     write (u, "(A)")
 
     grid(1) = mc_integrator%get_grid(channel = 1)
     grid(2) = mc_integrator%get_grid(channel = 2)
 
     write (u, "(2X,A,1X,L1)") "Equal grids =", (grid(1) == grid(2))
 
     write (u, "(A)")
     write (u, "(A)") "* Write grid to file vamp2_5.grids"
     write (u, "(A)")
 
     unit = free_unit ()
     open (unit, file = "vamp2_5.grids", &
          action = "write", status = "replace")
     call mc_integrator%write_grids (unit)
     close (unit)
 
     write (u, "(A)")
     write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 5000 (Precision)"
     write (u, "(A)")
 
     call mc_integrator%set_calls (5000)
     call mc_integrator%integrate (func, rng, 3, opt_adapt_weight = .false., &
          opt_refine_grid = .false., result=result, abserr=abserr)
     if (nearly_equal &
          (result, 2.000_default, rel_smallness = 0.002_default)) then
        write (u,  "(2x,A)") "Result: 2.000 [ok]"
     else
        write (u,  "(2x,A," // FMT_12 // ",A," // FMT_12 // ",A)") &
             "Result: ", result, " +/- ", abserr, " [not ok]"
     end if
 
     write (u, "(A)")
     write (u, "(A)") "* Cleanup"
 
     call mc_integrator%final ()
     call rng%final ()
     deallocate (rng)
   end subroutine vamp2_5
 
Index: trunk/src/mci/mci.nw
===================================================================
--- trunk/src/mci/mci.nw	(revision 8186)
+++ trunk/src/mci/mci.nw	(revision 8187)
@@ -1,14020 +1,14027 @@
 %% -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
 % WHIZARD code as NOWEB source: integration and event generation
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Multi-Channel Integration}
 \includemodulegraph{mci}
 
 The abstract representation of multi-channel
 Monte Carlo algorithms for integration and event generation.
 \begin{description}
 \item[Module [[mci_base]]:]
   The abstract types and their methods.  It provides a test integrator
   that is referenced in later unit tests.
 \item[iterations]
   Container for defining integration call and pass settings.
 \item[integration\_results]
   This module handles results from integrating processes.  It records passes
   and iterations, calculates statistical averages, and provides the user
   output of integration results.
 \end{description}
 
 These are the implementations:
 \begin{description}
 \item[Module [[mci_midpoint]]:]
   A simple integrator that uses the midpoint rule to sample the
   integrand uniformly over the unit hypercube.  There is only one
   integration channel, so this can be matched only to single-channel
   phase space.
 \item[Module [[mci_vamp]]:]
   Interface for the VAMP package.
 \end{description}
 
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \clearpage
 \section{Generic Integrator}
 This module provides a multi-channel integrator (MCI) base type, a
 corresponding configuration type, and methods for integration and event
 generation.
 
 <<[[mci_base.f90]]>>=
 <<File header>>
 
 module mci_base
 
   use kinds
   use io_units
   use format_utils, only: pac_fmt
   use format_defs, only: FMT_14, FMT_17
   use diagnostics
   use cputime
   use phs_base
   use rng_base
 
 <<Standard module head>>
 
 <<MCI base: public>>
 
 <<MCI base: types>>
 
 <<MCI base: interfaces>>
 
 contains
 
 <<MCI base: procedures>>
 
 end module mci_base
 @ %def mci_base
 @
 \subsection{MCI: integrator}
 The MCI object contains the methods for integration and event generation.
 For the actual work and data storage, it spawns an MCI instance object.
 
 The base object contains the number of integration dimensions and the number
 of channels as configuration data.  Further configuration data are stored in
 the concrete extensions.
 
 The MCI sum contains all relevant information about the integrand.  It can be
 used for comparing the current configuration against a previous one.  If they
 match, we can skip an actual integration.  (Implemented only for the VAMP
 version.)
 
 There is a random-number generator (its state with associated methods)
 available as [[rng]].  It may or may not be used for integration.  It
 will be used for event generation.
 <<MCI base: public>>=
   public :: mci_t
 <<MCI base: types>>=
   type, abstract :: mci_t
      integer :: n_dim = 0
      integer :: n_channel = 0
      integer :: n_chain = 0
      integer, dimension(:), allocatable :: chain
      real(default), dimension(:), allocatable :: chain_weights
      character(32) :: md5sum = ""
      logical :: integral_known = .false.
      logical :: error_known = .false.
      logical :: efficiency_known = .false.
      real(default) :: integral = 0
      real(default) :: error = 0
      real(default) :: efficiency = 0
      logical :: use_timer = .false.
      type(timer_t) :: timer
      class(rng_t), allocatable :: rng
    contains
    <<MCI base: mci: TBP>>
   end type mci_t
 
 @ %def mci_t
 @ Finalizer: the random-number generator may need one.
 <<MCI base: mci: TBP>>=
   procedure :: base_final => mci_final
   procedure (mci_final), deferred :: final
 <<MCI base: procedures>>=
   subroutine mci_final (object)
     class(mci_t), intent(inout) :: object
     if (allocated (object%rng))  call object%rng%final ()
   end subroutine mci_final
 
 @ %def mci_final
 @ Output: basic and extended output.
 <<MCI base: mci: TBP>>=
   procedure :: base_write => mci_write
   procedure (mci_write), deferred :: write
 <<MCI base: procedures>>=
   subroutine mci_write (object, unit, pacify, md5sum_version)
     class(mci_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacify
     logical, intent(in), optional :: md5sum_version
     logical :: md5sum_ver
     integer :: u, i, j
     character(len=7) :: fmt
     call pac_fmt (fmt, FMT_17, FMT_14, pacify)
     u = given_output_unit (unit)
     md5sum_ver = .false.
     if (present (md5sum_version))  md5sum_ver = md5sum_version
     if (object%use_timer .and. .not. md5sum_ver) then
        write (u, "(2x)", advance="no")
        call object%timer%write (u)
     end if
     if (object%integral_known) then
        write (u, "(3x,A," // fmt // ")") &
             "Integral             = ", object%integral
     end if
     if (object%error_known) then
        write (u, "(3x,A," // fmt // ")") &
             "Error                = ", object%error
     end if
     if (object%efficiency_known) then
        write (u, "(3x,A," // fmt // ")")  &
             "Efficiency           = ", object%efficiency
     end if
     write (u, "(3x,A,I0)")  "Number of channels   = ", object%n_channel
     write (u, "(3x,A,I0)")  "Number of dimensions = ", object%n_dim
     if (object%n_chain > 0) then
        write (u, "(3x,A,I0)")  "Number of chains     = ", object%n_chain
        write (u, "(3x,A)")  "Chains:"
        do i = 1, object%n_chain
           write (u, "(5x,I0,':')", advance = "no")  i
           do j = 1, object%n_channel
              if (object%chain(j) == i) &
                   write (u, "(1x,I0)", advance = "no")  j
           end do
           write (u, "(A)")
        end do
     end if
   end subroutine mci_write
 
 @ %def mci_write
 @ Print an informative message when starting integration.
 <<MCI base: mci: TBP>>=
   procedure (mci_startup_message), deferred :: startup_message
   procedure :: base_startup_message => mci_startup_message
 <<MCI base: procedures>>=
   subroutine mci_startup_message (mci, unit, n_calls)
     class(mci_t), intent(in) :: mci
     integer, intent(in), optional :: unit, n_calls
     if (mci%n_chain > 0) then
        write (msg_buffer, "(A,3(1x,I0,1x,A))") &
             "Integrator:", mci%n_chain, "chains,", &
             mci%n_channel, "channels,", &
             mci%n_dim, "dimensions"
     else
        write (msg_buffer, "(A,3(1x,I0,1x,A))") &
             "Integrator:", &
             mci%n_channel, "channels,", &
             mci%n_dim, "dimensions"
     end if
     call msg_message (unit = unit)
   end subroutine mci_startup_message
 
 @ %def mci_startup_message
 @ Dump type-specific info to a logfile.
 <<MCI base: mci: TBP>>=
   procedure(mci_write_log_entry), deferred :: write_log_entry
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_write_log_entry (mci, u)
        import
        class(mci_t), intent(in) :: mci
        integer, intent(in) :: u
      end subroutine mci_write_log_entry
   end interface
 
 @ %def mci_write_log_entry
 In order to avoid dependencies on definite MCI implementations,
 we introduce a MD5 sum calculator.
 <<MCI base: mci: TBP>>=
   procedure(mci_compute_md5sum), deferred :: compute_md5sum
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_compute_md5sum (mci, pacify)
        import
        class(mci_t), intent(inout) :: mci
        logical, intent(in), optional :: pacify
      end subroutine mci_compute_md5sum
   end interface
 
 @ %def mci_compute_md5sum@
 @ Record the index of the MCI object within a process.  For
 multi-component processes with more than one integrator, the
 integrator should know about its own index, so file names can be
 unique, etc.  The default implementation does nothing, however.
 <<MCI base: mci: TBP>>=
   procedure :: record_index => mci_record_index
 <<MCI base: procedures>>=
   subroutine mci_record_index (mci, i_mci)
     class(mci_t), intent(inout) :: mci
     integer, intent(in) :: i_mci
   end subroutine mci_record_index
 
 @ %def mci_record_index
 @ There is no Initializer for the abstract type, but a generic setter
 for the number of channels and dimensions.  We make two aliases
 available, to be able to override it.
 <<MCI base: mci: TBP>>=
   procedure :: set_dimensions => mci_set_dimensions
   procedure :: base_set_dimensions => mci_set_dimensions
 <<MCI base: procedures>>=
   subroutine mci_set_dimensions (mci, n_dim, n_channel)
     class(mci_t), intent(inout) :: mci
     integer, intent(in) :: n_dim
     integer, intent(in) :: n_channel
     mci%n_dim = n_dim
     mci%n_channel = n_channel
   end subroutine mci_set_dimensions
 
 @ %def mci_set_dimensions
 @ Declare particular dimensions as flat.  This information can be used
 to simplify integration.  When generating events, the flat dimensions
 should be sampled with uniform and uncorrelated distribution.  It
 depends on the integrator what to do with that information.
 <<MCI base: mci: TBP>>=
   procedure (mci_declare_flat_dimensions), deferred :: declare_flat_dimensions
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_declare_flat_dimensions (mci, dim_flat)
        import
        class(mci_t), intent(inout) :: mci
        integer, dimension(:), intent(in) :: dim_flat
      end subroutine mci_declare_flat_dimensions
   end interface
 
 @ %def mci_declare_flat_dimensions
 @ Declare particular channels as equivalent, possibly allowing for
 permutations or reflections of dimensions.  We use the information
 stored in the [[phs_channel_t]] object array that the phase-space module
 provides.
 
 (We do not test this here, deferring the unit test to the [[mci_vamp]]
 implementation where we actually use this feature.)
 <<MCI base: mci: TBP>>=
   procedure (mci_declare_equivalences), deferred :: declare_equivalences
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_declare_equivalences (mci, channel, dim_offset)
        import
        class(mci_t), intent(inout) :: mci
        type(phs_channel_t), dimension(:), intent(in) :: channel
        integer, intent(in) :: dim_offset
      end subroutine mci_declare_equivalences
   end interface
 
 @ %def mci_declare_equivalences
 @ Declare particular channels as chained together.  The implementation may use
 this array for keeping their weights equal to each other, etc.
 
 The chain array is an array sized by the number of channels.  For each
 channel, there is an integer entry that indicates the correponding
 chains.  The total number of chains is the maximum value of this
 entry.
 <<MCI base: mci: TBP>>=
   procedure :: declare_chains => mci_declare_chains
 <<MCI base: procedures>>=
   subroutine mci_declare_chains (mci, chain)
     class(mci_t), intent(inout) :: mci
     integer, dimension(:), intent(in) :: chain
     allocate (mci%chain (size (chain)))
     mci%n_chain = maxval (chain)
     allocate (mci%chain_weights (mci%n_chain), source = 0._default)
     mci%chain = chain
   end subroutine mci_declare_chains
 
 @ %def mci_declare_chains
 @ Collect channel weights according to chains and store them in the
 [[chain_weights]] for output.  We sum up the weights for all channels that
 share the same [[chain]] index and store the results in the [[chain_weights]]
 array.
 <<MCI base: mci: TBP>>=
   procedure :: collect_chain_weights => mci_collect_chain_weights
 <<MCI base: procedures>>=
   subroutine mci_collect_chain_weights (mci, weight)
     class(mci_t), intent(inout) :: mci
     real(default), dimension(:), intent(in) :: weight
     integer :: i, c
     if (allocated (mci%chain)) then
        mci%chain_weights = 0
        do i = 1, size (mci%chain)
           c = mci%chain(i)
           mci%chain_weights(c) = mci%chain_weights(c) + weight(i)
        end do
     end if
   end subroutine mci_collect_chain_weights
 
 @ %def mci_collect_chain_weights
 @ Check if there are chains.
 <<MCI base: mci: TBP>>=
   procedure :: has_chains => mci_has_chains
 <<MCI base: procedures>>=
   function mci_has_chains (mci) result (flag)
     class(mci_t), intent(in) :: mci
     logical :: flag
     flag = allocated (mci%chain)
   end function mci_has_chains
 
 @ %def mci_has_chains
 @ Output of the chain weights, kept separate from the main [[write]] method.
 
 [The formatting will work as long as the number of chains is less than
   $10^{10}$\ldots]
 <<MCI base: mci: TBP>>=
   procedure :: write_chain_weights => mci_write_chain_weights
 <<MCI base: procedures>>=
   subroutine mci_write_chain_weights (mci, unit)
     class(mci_t), intent(in) :: mci
     integer, intent(in), optional :: unit
     integer :: u, i, n, n_digits
     character(4) :: ifmt
     u = given_output_unit (unit)
     if (allocated (mci%chain_weights)) then
        write (u, "(1x,A)")  "Weights of channel chains (groves):"
        n_digits = 0
        n = size (mci%chain_weights)
        do while (n > 0)
           n = n / 10
           n_digits = n_digits + 1
        end do
        write (ifmt, "(A1,I1)") "I", n_digits
        do i = 1, size (mci%chain_weights)
           write (u, "(3x," // ifmt // ",F13.10)")  i, mci%chain_weights(i)
        end do
     end if
   end subroutine mci_write_chain_weights
 
 @ %def mci_write_chain_weights
 @ Set the MD5 sum, independent of initialization.
 <<MCI base: mci: TBP>>=
   procedure :: set_md5sum => mci_set_md5sum
 <<MCI base: procedures>>=
   subroutine mci_set_md5sum (mci, md5sum)
     class(mci_t), intent(inout) :: mci
     character(32), intent(in) :: md5sum
     mci%md5sum = md5sum
   end subroutine mci_set_md5sum
 
 @ %def mci_set_md5sum
 @ Initialize a new integration pass.  This is not necessarily
 meaningful, so we provide an empty base method.  The [[mci_vamp]]
 implementation overrides this.
 <<MCI base: mci: TBP>>=
   procedure :: add_pass => mci_add_pass
 <<MCI base: procedures>>=
   subroutine mci_add_pass (mci, adapt_grids, adapt_weights, final_pass)
     class(mci_t), intent(inout) :: mci
     logical, intent(in), optional :: adapt_grids
     logical, intent(in), optional :: adapt_weights
     logical, intent(in), optional :: final_pass
   end subroutine mci_add_pass
 
 @ %def mci_add_pass
 @ Allocate an instance with matching type.  This must be deferred.
 <<MCI base: mci: TBP>>=
   procedure (mci_allocate_instance), deferred :: allocate_instance
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_allocate_instance (mci, mci_instance)
        import
        class(mci_t), intent(in) :: mci
        class(mci_instance_t), intent(out), pointer :: mci_instance
      end subroutine mci_allocate_instance
   end interface
 
 @ %def mci_allocate_instance
 @ Import a random-number generator.  We transfer the allocation of an
 existing generator state into the object.  The generator state may
 already be initialized, or we can reset it by its [[init]]
 method.
 <<MCI base: mci: TBP>>=
   procedure :: import_rng => mci_import_rng
 <<MCI base: procedures>>=
   subroutine mci_import_rng (mci, rng)
     class(mci_t), intent(inout) :: mci
     class(rng_t), intent(inout), allocatable :: rng
     call move_alloc (rng, mci%rng)
   end subroutine mci_import_rng
 
 @ %def mci_import_rng
 @ Activate or deactivate the timer.
 <<MCI base: mci: TBP>>=
   procedure :: set_timer => mci_set_timer
 <<MCI base: procedures>>=
   subroutine mci_set_timer (mci, active)
     class(mci_t), intent(inout) :: mci
     logical, intent(in) :: active
     mci%use_timer = active
   end subroutine mci_set_timer
 
 @ %def mci_set_timer
 @ Start and stop signal for the timer, if active.  The elapsed time
 can then be retrieved from the MCI record.
 <<MCI base: mci: TBP>>=
   procedure :: start_timer => mci_start_timer
   procedure :: stop_timer => mci_stop_timer
 <<MCI base: procedures>>=
   subroutine mci_start_timer (mci)
     class(mci_t), intent(inout) :: mci
     if (mci%use_timer)  call mci%timer%start ()
   end subroutine mci_start_timer
 
   subroutine mci_stop_timer (mci)
     class(mci_t), intent(inout) :: mci
     if (mci%use_timer)  call mci%timer%stop ()
   end subroutine mci_stop_timer
 
 @ %def mci_start_timer
 @ %def mci_stop_timer
 @ Sampler test.  Evaluate the sampler a given number of times.  Results are
 discarded, so we don't need the MCI instance which would record them.
 
 The evaluation channel is iterated, and the [[x]] parameters are randomly
 chosen.
 <<MCI base: mci: TBP>>=
   procedure :: sampler_test => mci_sampler_test
 <<MCI base: procedures>>=
   subroutine mci_sampler_test (mci, sampler, n_calls)
     class(mci_t), intent(inout) :: mci
     class(mci_sampler_t), intent(inout), target :: sampler
     integer, intent(in) :: n_calls
     real(default), dimension(:), allocatable :: x_in, f
     real(default), dimension(:,:), allocatable :: x_out
     real(default) :: val
     integer :: i, c
     allocate (x_in (mci%n_dim))
     allocate (f (mci%n_channel))
     allocate (x_out (mci%n_dim, mci%n_channel))
     do i = 1, n_calls
        c = mod (i, mci%n_channel) + 1
        call mci%rng%generate_array (x_in)
        call sampler%evaluate (c, x_in, val, x_out, f)
     end do
   end subroutine mci_sampler_test
 
 @ %def mci_sampler_test
 @ Integrate: this depends on the implementation. We foresee a pacify
 flag to take care of small numerical noise on different platforms.
 <<MCI base: mci: TBP>>=
   procedure (mci_integrate), deferred :: integrate
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_integrate (mci, instance, sampler, &
           n_it, n_calls, results, pacify)
        import
        class(mci_t), intent(inout) :: mci
        class(mci_instance_t), intent(inout), target :: instance
        class(mci_sampler_t), intent(inout), target :: sampler
        integer, intent(in) :: n_it
        integer, intent(in) :: n_calls
        logical, intent(in), optional :: pacify
        class(mci_results_t), intent(inout), optional :: results
      end subroutine mci_integrate
   end interface
 
 @ %def mci_integrate
 @ Event generation.  Depending on the implementation,
 event generation may or may not require a previous integration pass.
 
 Instead of a black-box [[simulate]] method, we require an initializer,
 a finalizer, and procedures for generating a single event.  This
 allows us to interface simulation event by event from the outside, and
 it facilitates the further processing of an event after successful
 generation.  For integration, this is not necessary.
 
 The initializer has [[intent(inout)]] for the [[mci]] passed object.  The
 reason is that the initializer can read integration results and grids from
 file, where the results can modify the [[mci]] record.
 <<MCI base: mci: TBP>>=
   procedure (mci_prepare_simulation), deferred :: prepare_simulation
 @ %def mci_final_simulation
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_prepare_simulation (mci)
        import
        class(mci_t), intent(inout) :: mci
      end subroutine mci_prepare_simulation
   end interface
 
 @ %def mci_prepare_simulation
 @
 The generated event will reside in in the [[instance]] object (overall
 results and weight) and in the [[sampler]] object (detailed data).  In
 the real application, we can subsequently call methods of the
 [[sampler]] in order to further process the generated event.
 
 The [[target]] attributes are required by the VAMP implementation,
 which uses pointers to refer to the instance and sampler objects from
 within the integration function.
 <<MCI base: mci: TBP>>=
   procedure (mci_generate), deferred :: generate_weighted_event
   procedure (mci_generate), deferred :: generate_unweighted_event
 @ %def mci_generate_weighted_event
 @ %def mci_generate_unweighted_event
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_generate (mci, instance, sampler)
        import
        class(mci_t), intent(inout) :: mci
        class(mci_instance_t), intent(inout), target :: instance
        class(mci_sampler_t), intent(inout), target :: sampler
      end subroutine mci_generate
   end interface
 
 @ %def mci_generate
 @ This is analogous, but we rebuild the event from the information
 stored in [[state]] instead of generating it.
 
 Note: currently unused outside of tests, might be deleted later.
 <<MCI base: mci: TBP>>=
   procedure (mci_rebuild), deferred :: rebuild_event
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_rebuild (mci, instance, sampler, state)
        import
        class(mci_t), intent(inout) :: mci
        class(mci_instance_t), intent(inout) :: instance
        class(mci_sampler_t), intent(inout) :: sampler
        class(mci_state_t), intent(in) :: state
      end subroutine mci_rebuild
   end interface
 
 @ %def mci_rebuild
 @
 Pacify: reduce numerical noise.  The base implementation does nothing.
 <<MCI base: mci: TBP>>=
   procedure :: pacify => mci_pacify
 <<MCI base: procedures>>=
   subroutine mci_pacify (object, efficiency_reset, error_reset)
     class(mci_t), intent(inout) :: object
     logical, intent(in), optional :: efficiency_reset, error_reset
   end subroutine mci_pacify
 
 @ %def mci_pacify
 @
 Return the value of the integral, error, efficiency, and time per call.
 <<MCI base: mci: TBP>>=
   procedure :: get_integral => mci_get_integral
   procedure :: get_error => mci_get_error
   procedure :: get_efficiency => mci_get_efficiency
   procedure :: get_time => mci_get_time
 <<MCI base: procedures>>=
   function mci_get_integral (mci) result (integral)
     class(mci_t), intent(in) :: mci
     real(default) :: integral
     if (mci%integral_known) then
        integral = mci%integral
     else
        call msg_bug ("The integral is unknown. This is presumably a" // &
             "WHIZARD bug.")
     end if
   end function mci_get_integral
 
   function mci_get_error (mci) result (error)
     class(mci_t), intent(in) :: mci
     real(default) :: error
     if (mci%error_known) then
        error = mci%error
     else
        error = 0
     end if
   end function mci_get_error
 
   function mci_get_efficiency (mci) result (efficiency)
     class(mci_t), intent(in) :: mci
     real(default) :: efficiency
     if (mci%efficiency_known) then
        efficiency = mci%efficiency
     else
        efficiency = 0
     end if
   end function mci_get_efficiency
 
   function mci_get_time (mci) result (time)
     class(mci_t), intent(in) :: mci
     real(default) :: time
     if (mci%use_timer) then
        time = mci%timer
     else
        time = 0
     end if
   end function mci_get_time
 
 @ %def mci_get_integral
 @ %def mci_get_error
 @ %def mci_get_efficiency
 @ %def mci_get_time
 @ Return the MD5 sum of the configuration.  This may be overridden in
 an extension, to return a different MD5 sum.
 <<MCI base: mci: TBP>>=
   procedure :: get_md5sum => mci_get_md5sum
 <<MCI base: procedures>>=
   pure function mci_get_md5sum (mci) result (md5sum)
     class(mci_t), intent(in) :: mci
     character(32) :: md5sum
     md5sum = mci%md5sum
   end function mci_get_md5sum
 
 @ %def mci_get_md5sum
 @
 \subsection{MCI instance}
 The base type contains an array of channel weights.  The value [[mci_weight]]
 is the combined MCI weight that corresponds to a particular sampling point.
 
 For convenience, we also store the [[x]] and Jacobian values for this sampling
 point.
 <<MCI base: public>>=
   public :: mci_instance_t
 <<MCI base: types>>=
   type, abstract :: mci_instance_t
      logical :: valid = .false.
      real(default), dimension(:), allocatable :: w
      real(default), dimension(:), allocatable :: f
      real(default), dimension(:,:), allocatable :: x
      integer :: selected_channel = 0
      real(default) :: mci_weight = 0
      real(default) :: integrand  = 0
      logical :: negative_weights = .false.
    contains
    <<MCI base: mci instance: TBP>>
   end type mci_instance_t
 
 @ %def mci_instance_t
 @ Output: deferred
 <<MCI base: mci instance: TBP>>=
   procedure (mci_instance_write), deferred :: write
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_instance_write (object, unit, pacify)
        import
        class(mci_instance_t), intent(in) :: object
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: pacify
      end subroutine mci_instance_write
   end interface
 
 @ %def mci_instance_write
 @ A finalizer, just in case.
 <<MCI base: mci instance: TBP>>=
   procedure (mci_instance_final), deferred :: final
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_instance_final (object)
        import
        class(mci_instance_t), intent(inout) :: object
      end subroutine mci_instance_final
   end interface
 
 @ %def mci_instance_final
 @ Init: basic initializer for the arrays, otherwise deferred.  Assigning
 the [[mci]] object is also deferred, because it depends on the concrete type.
 
 The weights are initialized with an uniform normalized value.
 <<MCI base: mci instance: TBP>>=
   procedure (mci_instance_base_init), deferred :: init
   procedure :: base_init => mci_instance_base_init
 <<MCI base: procedures>>=
   subroutine mci_instance_base_init (mci_instance, mci)
     class(mci_instance_t), intent(out) :: mci_instance
     class(mci_t), intent(in), target :: mci
     allocate (mci_instance%w (mci%n_channel))
     allocate (mci_instance%f (mci%n_channel))
     allocate (mci_instance%x (mci%n_dim, mci%n_channel))
     if (mci%n_channel > 0) then
        call mci_instance%set_channel_weights &
             (spread (1._default, dim=1, ncopies=mci%n_channel))
     end if
     mci_instance%f = 0
     mci_instance%x = 0
   end subroutine mci_instance_base_init
 
 @ %def mci_instance_base_init
 @ Explicitly set the array of channel weights.
 <<MCI base: mci instance: TBP>>=
   procedure :: set_channel_weights => mci_instance_set_channel_weights
 <<MCI base: procedures>>=
   subroutine mci_instance_set_channel_weights (mci_instance, weights, sum_non_zero)
     class(mci_instance_t), intent(inout) :: mci_instance
     real(default), dimension(:), intent(in) :: weights
     logical, intent(out), optional :: sum_non_zero
     real(default) :: wsum
     wsum = sum (weights)
     if (wsum /= 0) then
        mci_instance%w = weights / wsum
        if (present (sum_non_zero)) sum_non_zero = .true.
     else
        if (present (sum_non_zero)) sum_non_zero = .false.
        call msg_warning ("MC sampler initialization:&
             & sum of channel weights is zero")
     end if
   end subroutine mci_instance_set_channel_weights
 
 @ %def mci_instance_set_channel_weights
 @ Compute the overall weight factor for a configuration of $x$ values and
 Jacobians $f$.  The $x$ values come in [[n_channel]] rows with [[n_dim]]
 entries each.  The $f$ factors constitute an array with [[n_channel]] entries.
 
 We assume that the $x$ and $f$ arrays are already stored inside the MC
 instance.  The result is also stored there.
 <<MCI base: mci instance: TBP>>=
   procedure (mci_instance_compute_weight), deferred :: compute_weight
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_instance_compute_weight (mci, c)
        import
        class(mci_instance_t), intent(inout) :: mci
        integer, intent(in) :: c
      end subroutine mci_instance_compute_weight
   end interface
 
 @ %def mci_instance_compute_weight
 @ Record the integrand as returned by the sampler.  Depending on the
 implementation, this may merely copy the value, or do more complicated things.
 
 We may need the MCI weight for the actual computations, so this should
 be called after the previous routine.
 <<MCI base: mci instance: TBP>>=
   procedure (mci_instance_record_integrand), deferred :: record_integrand
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_instance_record_integrand (mci, integrand)
        import
        class(mci_instance_t), intent(inout) :: mci
        real(default), intent(in) :: integrand
      end subroutine mci_instance_record_integrand
   end interface
 
 @ %def mci_instance_record_integrand
 @ Sample a point directly: evaluate the sampler, then compute the weight and
 the weighted integrand.  Finally, record the integrand within the MCI instance.
 
 If a signal (interrupt) was raised recently, we abort the calculation before
 entering the sampler.  Thus, a previous calculation will have
 completed and any data are already recorded, but any new point can be
 discarded.  If the [[abort]] flag is present, we may delay the interrupt, so
 we can do some cleanup.
 <<MCI base: mci instance: TBP>>=
   procedure :: evaluate => mci_instance_evaluate
 <<MCI base: procedures>>=
   subroutine mci_instance_evaluate (mci, sampler, c, x)
     class(mci_instance_t), intent(inout) :: mci
     class(mci_sampler_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x
     real(default) :: val
     call sampler%evaluate (c, x, val, mci%x, mci%f)
     mci%valid = sampler%is_valid ()
     if (mci%valid) then
        call mci%compute_weight (c)
        call mci%record_integrand (val)
     end if
   end subroutine mci_instance_evaluate
 
 @ %def mci_instance_evaluate
 @ Initiate and terminate simulation.  In contrast to integration, we implement
 these as methods of the process instance, since the [[mci]] configuration
 object is unchanged.
 
 The safety factor reduces the acceptance probability for unweighted
 events.  The implementation of this feature depends on the concrete type.
 <<MCI base: mci instance: TBP>>=
   procedure (mci_instance_init_simulation), deferred :: init_simulation
   procedure (mci_instance_final_simulation), deferred :: final_simulation
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_instance_init_simulation (instance, safety_factor)
        import
        class(mci_instance_t), intent(inout) :: instance
        real(default), intent(in), optional :: safety_factor
      end subroutine mci_instance_init_simulation
   end interface
 
   abstract interface
      subroutine mci_instance_final_simulation (instance)
        import
        class(mci_instance_t), intent(inout) :: instance
      end subroutine mci_instance_final_simulation
   end interface
 
 @ %def mci_instance_init_simulation mci_instance_final_simulation
 @ Assuming that the sampler is in a completely defined state, just
 extract the data that [[evaluate]] would compute.  Also record the integrand.
 <<MCI base: mci instance: TBP>>=
   procedure :: fetch => mci_instance_fetch
 <<MCI base: procedures>>=
   subroutine mci_instance_fetch (mci, sampler, c)
     class(mci_instance_t), intent(inout) :: mci
     class(mci_sampler_t), intent(in) :: sampler
     integer, intent(in) :: c
     real(default) :: val
     mci%valid = sampler%is_valid ()
     if (mci%valid) then
        call sampler%fetch (val, mci%x, mci%f)
        call mci%compute_weight (c)
        call mci%record_integrand (val)
     end if
   end subroutine mci_instance_fetch
 
 @ %def mci_instance_fetch
 @ The value, i.e., the weighted integrand, is the integrand (which
 should be taken as-is from the sampler) multiplied by the MCI weight.
 <<MCI base: mci instance: TBP>>=
   procedure :: get_value => mci_instance_get_value
 <<MCI base: procedures>>=
   function mci_instance_get_value (mci) result (value)
     class(mci_instance_t), intent(in) :: mci
     real(default) :: value
     if (mci%valid) then
        value = mci%integrand * mci%mci_weight
     else
        value = 0
     end if
   end function mci_instance_get_value
 
 @ %def mci_instance_get_value
 @ This is an extra routine.  By default, the event weight is equal to
 the value returned by the previous routine.  However, if we select a
 channel for event generation not just based on the channel weights,
 the event weight has to account for this bias, so the event weight
 that applies to event generation is different.  In that case, we
 should override the default routine.
 <<MCI base: mci instance: TBP>>=
   procedure :: get_event_weight => mci_instance_get_value
 @ %def mci_instance_get_event_weight
 @ Excess weight can occur during unweighted event generation, if the
 assumed maximum value of the integrand is too small.  This excess
 should be normalized in the same way as the event weight above (which
 for unweighted events becomes unity).
 <<MCI base: mci instance: TBP>>=
   procedure (mci_instance_get_event_excess), deferred :: get_event_excess
 <<MCI base: interfaces>>=
   abstract interface
      function mci_instance_get_event_excess (mci) result (excess)
        import
        class(mci_instance_t), intent(in) :: mci
        real(default) :: excess
      end function mci_instance_get_event_excess
   end interface
 
 @ %def mci_instance_get_event_excess
 @
 \subsection{MCI state}
 This object can hold the relevant information that allows us to
 reconstruct the MCI instance without re-evaluating the sampler completely.
 
 We store the [[x_in]] MC input parameter set, which coincides with the
 section of the complete [[x]] array that belongs to a particular
 channel.  We also store the MC function value.  When we want to
 reconstruct the state, we can use the input array to recover the
 complete [[x]] and [[f]] arrays (i.e., the kinematics), but do not
 need to recompute the MC function value (the dynamics).
 
 The [[mci_state_t]] may be extended, to allow storing/recalling more
 information.  In that case, we would override the type-bound
 procedures.  However, the base type is also a concrete type and
 self-contained.
 <<MCI base: public>>=
   public :: mci_state_t
 <<MCI base: types>>=
   type :: mci_state_t
      integer :: selected_channel = 0
      real(default), dimension(:), allocatable :: x_in
      real(default) :: val
    contains
    <<MCI base: mci state: TBP>>
   end type mci_state_t
 
 @ %def mci_state_t
 @ Output:
 <<MCI base: mci state: TBP>>=
   procedure :: write => mci_state_write
 <<MCI base: procedures>>=
   subroutine mci_state_write (object, unit)
     class(mci_state_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "MCI state:"
     write (u, "(3x,A,I0)")  "Channel   = ", object%selected_channel
     write (u, "(3x,A,999(1x,F12.10))")  "x (in)    =", object%x_in
     write (u, "(3x,A,ES19.12)")  "Integrand = ", object%val
   end subroutine mci_state_write
 
 @ %def mci_state_write
 @ To store the object, we take the relevant section of the [[x]]
 array.  The channel used for storing data is taken from the
 [[instance]] object, but it could be arbitrary in principle.
 <<MCI base: mci instance: TBP>>=
   procedure :: store => mci_instance_store
 <<MCI base: procedures>>=
   subroutine mci_instance_store (mci, state)
     class(mci_instance_t), intent(in) :: mci
     class(mci_state_t), intent(out) :: state
     state%selected_channel = mci%selected_channel
     allocate (state%x_in (size (mci%x, 1)))
     state%x_in = mci%x(:,mci%selected_channel)
     state%val = mci%integrand
   end subroutine mci_instance_store
 
 @ %def mci_instance_store
 @ Recalling the state, we must consult the sampler in order to fully
 reconstruct the [[x]] and [[f]] arrays.  The integrand value is known,
 and we also give it to the sampler, bypassing evaluation.
 
 The final steps are equivalent to the [[evaluate]] method above.
 <<MCI base: mci instance: TBP>>=
   procedure :: recall => mci_instance_recall
 <<MCI base: procedures>>=
   subroutine mci_instance_recall (mci, sampler, state)
     class(mci_instance_t), intent(inout) :: mci
     class(mci_sampler_t), intent(inout) :: sampler
     class(mci_state_t), intent(in) :: state
     if (size (state%x_in) == size (mci%x, 1) &
          .and. state%selected_channel <= size (mci%x, 2)) then
        call sampler%rebuild (state%selected_channel, &
             state%x_in, state%val, mci%x, mci%f)
        call mci%compute_weight (state%selected_channel)
        call mci%record_integrand (state%val)
     else
        call msg_fatal ("Recalling event: mismatch in channel or dimension")
     end if
   end subroutine mci_instance_recall
 
 @ %def mci_instance_recall
 @
 \subsection{MCI sampler}
 A sampler is an object that implements a multi-channel parameterization of the
 unit hypercube.  Specifically, it is able to compute, given a channel and a
 set of $x$ MC parameter values, a the complete set of $x$ values and
 associated Jacobian factors $f$ for all channels.
 
 Furthermore, the sampler should return a single real value, the integrand, for
 the given point in the hypercube.
 
 It must implement a method [[evaluate]] for performing the above
 computations.
 <<MCI base: public>>=
   public :: mci_sampler_t
 <<MCI base: types>>=
   type, abstract :: mci_sampler_t
    contains
    <<MCI base: mci sampler: TBP>>
   end type mci_sampler_t
 
 @ %def mci_sampler_t
 @ Output, deferred to the implementation.
 <<MCI base: mci sampler: TBP>>=
   procedure (mci_sampler_write), deferred :: write
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_sampler_write (object, unit, testflag)
        import
        class(mci_sampler_t), intent(in) :: object
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: testflag
      end subroutine mci_sampler_write
   end interface
 
 @ %def mci_sampler_write
 @ The evaluation routine.  Input is the channel index [[c]] and the
 one-dimensional parameter array [[x_in]].  Output are the integrand value
 [[val]], the two-dimensional parameter array [[x]] and the Jacobian array
 [[f]].
 <<MCI base: mci sampler: TBP>>=
   procedure (mci_sampler_evaluate), deferred :: evaluate
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_sampler_evaluate (sampler, c, x_in, val, x, f)
        import
        class(mci_sampler_t), intent(inout) :: sampler
        integer, intent(in) :: c
        real(default), dimension(:), intent(in) :: x_in
        real(default), intent(out) :: val
        real(default), dimension(:,:), intent(out) :: x
        real(default), dimension(:), intent(out) :: f
      end subroutine mci_sampler_evaluate
   end interface
 
 @ %def mci_sampler_evaluate
 @ Query the validity of the sampling point.  Can be called after
 [[evaluate]].
 <<MCI base: mci sampler: TBP>>=
   procedure (mci_sampler_is_valid), deferred :: is_valid
 <<MCI base: interfaces>>=
   abstract interface
      function mci_sampler_is_valid (sampler) result (valid)
        import
        class(mci_sampler_t), intent(in) :: sampler
        logical :: valid
      end function mci_sampler_is_valid
   end interface
 
 @ %def mci_sampler_is_valid
 @ The shortcut.  Again, the channel index [[c]] and the parameter
 array [[x_in]] are input.  However, we also provide the integrand
 value [[val]], and we just require that the complete parameter array
 [[x]] and Jacobian array [[f]] are recovered.
 <<MCI base: mci sampler: TBP>>=
   procedure (mci_sampler_rebuild), deferred :: rebuild
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_sampler_rebuild (sampler, c, x_in, val, x, f)
        import
        class(mci_sampler_t), intent(inout) :: sampler
        integer, intent(in) :: c
        real(default), dimension(:), intent(in) :: x_in
        real(default), intent(in) :: val
        real(default), dimension(:,:), intent(out) :: x
        real(default), dimension(:), intent(out) :: f
      end subroutine mci_sampler_rebuild
   end interface
 
 @ %def mci_sampler_rebuild
 @ This routine should extract the important data from a sampler that
 has been filled by other means.  We fetch the integrand value [[val]],
 the two-dimensional parameter array [[x]] and the Jacobian array [[f]].
 <<MCI base: mci sampler: TBP>>=
   procedure (mci_sampler_fetch), deferred :: fetch
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_sampler_fetch (sampler, val, x, f)
        import
        class(mci_sampler_t), intent(in) :: sampler
        real(default), intent(out) :: val
        real(default), dimension(:,:), intent(out) :: x
        real(default), dimension(:), intent(out) :: f
      end subroutine mci_sampler_fetch
   end interface
 
 @ %def mci_sampler_fetch
 @
 \subsection{Results record}
 This is an abstract type which allows us to implement callback: each
 integration results can optionally be recorded to an instance of this
 object.  The actual object may store a new result, average results,
 etc.  It may also display a result on-line or otherwise, whenever
 the [[record]] method is called.
 <<MCI base: public>>=
   public :: mci_results_t
 <<MCI base: types>>=
   type, abstract :: mci_results_t
    contains
    <<MCI base: mci results: TBP>>
   end type mci_results_t
 
 @ %def mci_results_t
 @ The output routine is deferred.  We provide an extra [[verbose]]
 flag, which could serve any purpose.
 <<MCI base: mci results: TBP>>=
   procedure (mci_results_write), deferred :: write
   procedure (mci_results_write_verbose), deferred :: write_verbose
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_results_write (object, unit, suppress)
        import
        class(mci_results_t), intent(in) :: object
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: suppress
      end subroutine mci_results_write
 
      subroutine mci_results_write_verbose (object, unit)
        import
        class(mci_results_t), intent(in) :: object
        integer, intent(in), optional :: unit
      end subroutine mci_results_write_verbose
   end interface
 
 @ %def mci_results_write
 @ This is the generic [[record]] method, which can be called directly from the
 integrator. The [[record_extended]] procedure store additionally the valid
 calls, positive and negative efficiency.
 <<MCI base: mci results: TBP>>=
   generic :: record => record_simple, record_extended
   procedure (mci_results_record_simple), deferred :: record_simple
   procedure (mci_results_record_extended), deferred :: record_extended
 <<MCI base: interfaces>>=
   abstract interface
      subroutine mci_results_record_simple (object, n_it, &
           n_calls, integral, error, efficiency, chain_weights, suppress)
        import
        class(mci_results_t), intent(inout) :: object
        integer, intent(in) :: n_it
        integer, intent(in) :: n_calls
        real(default), intent(in) :: integral
        real(default), intent(in) :: error
        real(default), intent(in) :: efficiency
        real(default), dimension(:), intent(in), optional :: chain_weights
        logical, intent(in), optional :: suppress
      end subroutine mci_results_record_simple
 
      subroutine mci_results_record_extended (object, n_it, n_calls,&
           & n_calls_valid, integral, error, efficiency, efficiency_pos,&
           & efficiency_neg, chain_weights, suppress)
        import
        class(mci_results_t), intent(inout) :: object
        integer, intent(in) :: n_it
        integer, intent(in) :: n_calls
        integer, intent(in) :: n_calls_valid
        real(default), intent(in) :: integral
        real(default), intent(in) :: error
        real(default), intent(in) :: efficiency
        real(default), intent(in) :: efficiency_pos
        real(default), intent(in) :: efficiency_neg
        real(default), dimension(:), intent(in), optional :: chain_weights
        logical, intent(in), optional :: suppress
      end subroutine mci_results_record_extended
   end interface
 
 @ %def mci_results_record
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[mci_base_ut.f90]]>>=
 <<File header>>
 
 module mci_base_ut
   use unit_tests
   use mci_base_uti
 
 <<Standard module head>>
 
 <<MCI base: public test>>
 
 <<MCI base: public test auxiliary>>
 
 contains
 
 <<MCI base: test driver>>
 
 end module mci_base_ut
 @ %def mci_base_ut
 @
 <<[[mci_base_uti.f90]]>>=
 <<File header>>
 
 module mci_base_uti
 
 <<Use kinds>>
   use io_units
   use diagnostics
   use phs_base
   use rng_base
 
   use mci_base
 
   use rng_base_ut, only: rng_test_t
 
 <<Standard module head>>
 
 <<MCI base: public test auxiliary>>
 
 <<MCI base: test declarations>>
 
 <<MCI base: test types>>
 
 contains
 
 <<MCI base: tests>>
 
 end module mci_base_uti
 @ %def mci_base_ut
 @ API: driver for the unit tests below.
 <<MCI base: public test>>=
   public :: mci_base_test
 <<MCI base: test driver>>=
   subroutine mci_base_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<MCI base: execute tests>>
   end subroutine mci_base_test
 
 @ %def mci_base_test
 @
 \subsubsection{Test implementation of the configuration type}
 The concrete type contains the number of requested calls and the integral
 result, to be determined.
 
 The [[max_factor]] entry is set for the actual test integration, where the
 integrand is not unity but some other constant value.  This value should be
 set here, such that the actual maximum of the integrand is known when
 vetoing unweighted events.
 <<MCI base: public test auxiliary>>=
   public :: mci_test_t
 <<MCI base: test types>>=
   type, extends (mci_t) :: mci_test_t
      integer :: divisions = 0
      integer :: tries = 0
      real(default) :: max_factor = 1
    contains
      procedure :: final => mci_test_final
      procedure :: write => mci_test_write
      procedure :: startup_message => mci_test_startup_message
      procedure :: write_log_entry => mci_test_write_log_entry
      procedure :: compute_md5sum => mci_test_compute_md5sum
      procedure :: declare_flat_dimensions => mci_test_ignore_flat_dimensions
      procedure :: declare_equivalences => mci_test_ignore_equivalences
      procedure :: set_divisions => mci_test_set_divisions
      procedure :: set_max_factor => mci_test_set_max_factor
      procedure :: allocate_instance => mci_test_allocate_instance
      procedure :: integrate => mci_test_integrate
      procedure :: prepare_simulation => mci_test_ignore_prepare_simulation
      procedure :: generate_weighted_event => mci_test_generate_weighted_event
      procedure :: generate_unweighted_event => &
           mci_test_generate_unweighted_event
      procedure :: rebuild_event => mci_test_rebuild_event
   end type mci_test_t
 
 @ %def mci_test_t
 @ Finalizer: base version is sufficient
 <<MCI base: tests>>=
   subroutine mci_test_final (object)
     class(mci_test_t), intent(inout) :: object
     call object%base_final ()
   end subroutine mci_test_final
 
 @ %def mci_test_final
 @ Output: trivial
 <<MCI base: tests>>=
   subroutine mci_test_write (object, unit, pacify, md5sum_version)
     class(mci_test_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacify
     logical, intent(in), optional :: md5sum_version
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Test integrator:"
     call object%base_write (u, pacify, md5sum_version)
     if (object%divisions /= 0) then
        write (u, "(3x,A,I0)")  "Number of divisions  = ", object%divisions
     end if
     if (allocated (object%rng))  call object%rng%write (u)
   end subroutine mci_test_write
 
 @ %def mci_test_write
 @ Short version.
 <<MCI base: tests>>=
   subroutine mci_test_startup_message (mci, unit, n_calls)
     class(mci_test_t), intent(in) :: mci
     integer, intent(in), optional :: unit, n_calls
     call mci%base_startup_message (unit = unit, n_calls = n_calls)
     write (msg_buffer, "(A,1x,I0,1x,A)") &
          "Integrator: Test:", mci%divisions, "divisions"
     call msg_message (unit = unit)
   end subroutine mci_test_startup_message
 
 @ %def mci_test_startup_message
 @ Log entry: nothing.
 <<MCI base: tests>>=
   subroutine mci_test_write_log_entry (mci, u)
     class(mci_test_t), intent(in) :: mci
     integer, intent(in) :: u
   end subroutine mci_test_write_log_entry
 
 @ %def mci_test_write_log_entry
 @ Compute MD5 sum: nothing.
 <<MCI base: tests>>=
   subroutine mci_test_compute_md5sum (mci, pacify)
     class(mci_test_t), intent(inout) :: mci
     logical, intent(in), optional :: pacify
   end subroutine mci_test_compute_md5sum
 
 @ %def mci_test_compute_md5sum
 @ This is a no-op for the test integrator.
 <<MCI base: tests>>=
   subroutine mci_test_ignore_flat_dimensions (mci, dim_flat)
     class(mci_test_t), intent(inout) :: mci
     integer, dimension(:), intent(in) :: dim_flat
   end subroutine mci_test_ignore_flat_dimensions
 
 @ %def mci_test_ignore_flat_dimensions
 @ Ditto.
 <<MCI base: tests>>=
   subroutine mci_test_ignore_equivalences (mci, channel, dim_offset)
     class(mci_test_t), intent(inout) :: mci
     type(phs_channel_t), dimension(:), intent(in) :: channel
     integer, intent(in) :: dim_offset
   end subroutine mci_test_ignore_equivalences
 
 @ %def mci_test_ignore_equivalences
 @ Set the number of divisions to a nonzero value.
 <<MCI base: tests>>=
   subroutine mci_test_set_divisions (object, divisions)
     class(mci_test_t), intent(inout) :: object
     integer, intent(in) :: divisions
     object%divisions = divisions
   end subroutine mci_test_set_divisions
 
 @ %def mci_test_set_divisions
 @ Set the maximum factor (default is 1).
 <<MCI base: tests>>=
   subroutine mci_test_set_max_factor (object, max_factor)
     class(mci_test_t), intent(inout) :: object
     real(default), intent(in) :: max_factor
     object%max_factor = max_factor
   end subroutine mci_test_set_max_factor
 
 @ %def mci_test_set_max_factor
 @ Allocate instance with matching type.
 <<MCI base: tests>>=
   subroutine mci_test_allocate_instance (mci, mci_instance)
     class(mci_test_t), intent(in) :: mci
     class(mci_instance_t), intent(out), pointer :: mci_instance
     allocate (mci_test_instance_t :: mci_instance)
   end subroutine mci_test_allocate_instance
 
 @ %def mci_test_allocate_instance
 @ Integrate: sample at the midpoints of uniform bits and add the results.
 We implement this for one and for two dimensions.  In the latter case,
 we scan over two channels and multiply with the channel weights.
 
 The arguments [[n_it]] and [[n_calls]] are ignored in this implementations.
 
 The test integrator does not set error or efficiency, so those will
 remain undefined.
 <<MCI base: tests>>=
   subroutine mci_test_integrate (mci, instance, sampler, &
        n_it, n_calls, results, pacify)
     class(mci_test_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     integer, intent(in) :: n_it
     integer, intent(in) :: n_calls
     logical, intent(in), optional :: pacify
     class(mci_results_t), intent(inout), optional :: results
     real(default), dimension(:), allocatable :: integral
     real(default), dimension(:), allocatable :: x
     integer :: i, j, c
     select type (instance)
     type is (mci_test_instance_t)
        allocate (integral (mci%n_channel))
        integral = 0
        allocate (x (mci%n_dim))
        select case (mci%n_dim)
        case (1)
           do c = 1, mci%n_channel
              do i = 1, mci%divisions
                 x(1) = (i - 0.5_default) / mci%divisions
                 call instance%evaluate (sampler, c, x)
                 integral(c) = integral(c) + instance%get_value ()
              end do
           end do
           mci%integral = dot_product (instance%w, integral) &
                / mci%divisions
           mci%integral_known = .true.
        case (2)
           do c = 1, mci%n_channel
              do i = 1, mci%divisions
                 x(1) = (i - 0.5_default) / mci%divisions
                 do j = 1, mci%divisions
                    x(2) = (j - 0.5_default) / mci%divisions
                    call instance%evaluate (sampler, c, x)
                    integral(c) = integral(c) + instance%get_value ()
                 end do
              end do
           end do
           mci%integral = dot_product (instance%w, integral) &
                / mci%divisions / mci%divisions
           mci%integral_known = .true.
        end select
        if (present (results)) then
           call results%record (n_it, n_calls, &
                mci%integral, mci%error, &
                efficiency = 0._default)
        end if
     end select
   end subroutine mci_test_integrate
 
 @ %def mci_test_integrate
 @ Simulation initializer and finalizer: nothing to do here.
 <<MCI base: tests>>=
   subroutine mci_test_ignore_prepare_simulation (mci)
     class(mci_test_t), intent(inout) :: mci
   end subroutine mci_test_ignore_prepare_simulation
 
 @ %def mci_test_ignore_prepare_simulation
 @ Event generator.  We use mock random numbers for first selecting the
 channel and then setting the $x$ values.  The results reside in the
 state of [[instance]] and [[sampler]].
 <<MCI base: tests>>=
   subroutine mci_test_generate_weighted_event (mci, instance, sampler)
     class(mci_test_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     real(default) :: r
     real(default), dimension(:), allocatable :: x
     integer :: c
     select type (instance)
     type is (mci_test_instance_t)
        allocate (x (mci%n_dim))
        select case (mci%n_channel)
        case (1)
           c = 1
           call mci%rng%generate (x(1))
        case (2)
           call mci%rng%generate (r)
           if (r < instance%w(1)) then
              c = 1
           else
              c = 2
           end if
           call mci%rng%generate (x)
        end select
        call instance%evaluate (sampler, c, x)
     end select
   end subroutine mci_test_generate_weighted_event
 
 @ %def mci_test_generate_weighted_event
 @ For unweighted events, we generate weighted events and apply a
 simple rejection step to the relative event weight, until an event passes.
 
 (This might result in an endless loop if we happen to be in sync with
 the mock random generator cycle.  Therefore, limit the number of tries.)
 <<MCI base: tests>>=
   subroutine mci_test_generate_unweighted_event (mci, instance, sampler)
     class(mci_test_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     real(default) :: r
     integer :: i
     select type (instance)
     type is (mci_test_instance_t)
        mci%tries = 0
        do i = 1, 10
           call mci%generate_weighted_event (instance, sampler)
           mci%tries = mci%tries + 1
           call mci%rng%generate (r)
           if (r < instance%rel_value)  exit
        end do
     end select
   end subroutine mci_test_generate_unweighted_event
 
 @ %def mci_test_generate_unweighted_event
 @ Here, we rebuild the event from the state without consulting the rng.
 <<MCI base: tests>>=
   subroutine mci_test_rebuild_event (mci, instance, sampler, state)
     class(mci_test_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout) :: instance
     class(mci_sampler_t), intent(inout) :: sampler
     class(mci_state_t), intent(in) :: state
     select type (instance)
     type is (mci_test_instance_t)
        call instance%recall (sampler, state)
     end select
   end subroutine mci_test_rebuild_event
 
 @ %def mci_test_rebuild_event
 @
 \subsubsection{Instance of the test MCI type}
 This instance type simulates the VAMP approach.  We implement the VAMP
 multi-channel formula, but keep the channel-specific probability
 functions $g_i$ smooth and fixed.  We also keep the weights fixed.
 
 The setup is as follows: we have $n$ mappings of the unit hypercube
 \begin{equation}
   x = x (x^{(k)}) \qquad \text{where $x=(x_1,\ldots)$}.
 \end{equation}
 The Jacobian factors are the determinants
 \begin{equation}
   f^{(k)}(x^{(k)}) = \left|\frac{\partial x}{\partial x^{(k)}}\right|
 \end{equation}
 We introduce arbitrary probability functions
 \begin{equation}
   g^{(k)}(x^{(k)}) \qquad
   \text{with}\quad \int dx^{(k)} g^{(k)}(x^{(k)}) = 1
 \end{equation}
 and weights
 \begin{equation}
   w_k \qquad \text{with}\quad \sum_k w_k = 1
 \end{equation}
 and construct the joint probability function
 \begin{equation}
   g(x) = \sum_k w_k\frac{g^{(k)}(x^{(k)}(x))}{f^{(k)}(x^{(k)}(x))}
 \end{equation}
 which also satisfies
 \begin{equation}
   \int g(x)\,dx = 1.
 \end{equation}
 The algorithm implements a resolution of unity as follows
 \begin{align}
   1 &= \int dx = \int\frac{g(x)}{g(x)} dx
   \nonumber\\
   &= \sum w_k \int \frac{g^{(k)}(x^{(k)}(x))}{f^{(k)}(x^{(k)}(x))}
   \,\frac{dx}{g(x)}
   \nonumber\\
   &= \sum w_k \int g^{(k)}(x^{(k)}) \frac{dx^{(k)}}{g(x(x^{(k)}))}
 \end{align}
 where each of the integrals in the sum is evaluated using the
 channel-specific variables $x^{(k)}$.
 
 We provide two examples: (1) trivial with one channel, one dimension,
 and all functions unity and (2) two channels and two dimensions with
 \begin{align}
   x (x^{(1)}) &= (x^{(1)}_1, x^{(1)}_2)
   \nonumber\\
   x (x^{(2)}) &= (x^{(2)}_1{}^2, x^{(2)}_2)
 \end{align}
 hence
 \begin{align}
   f^{(1)}&\equiv 1,
   &f^{(2)}(x^{(2)}) &= 2x^{(2)}_1
 \end{align}
 The probability functions are
 \begin{align}
   g^{(1)}&\equiv 1,
   &g^{(2)}(x^{(2)}) = 2 x^{(2)}_2
 \end{align}
 
 In the concrete implementation of the integrator instance we store
 values for the channel probabilities $g_i$ and the accumulated
 probability $g$.
 
 We also store the result (product of integrand and MCI weight), the
 expected maximum for the result in each channel.
 <<XXX MCI base: public>>=
   public :: mci_test_instance_t
 <<MCI base: test types>>=
   type, extends (mci_instance_t) :: mci_test_instance_t
      type(mci_test_t), pointer :: mci => null ()
      real(default) :: g = 0
      real(default), dimension(:), allocatable :: gi
      real(default) :: value = 0
      real(default) :: rel_value = 0
      real(default), dimension(:), allocatable :: max
    contains
      procedure :: write => mci_test_instance_write
      procedure :: final => mci_test_instance_final
      procedure :: init => mci_test_instance_init
      procedure :: compute_weight => mci_test_instance_compute_weight
      procedure :: record_integrand => mci_test_instance_record_integrand
      procedure :: init_simulation => mci_test_instance_init_simulation
      procedure :: final_simulation => mci_test_instance_final_simulation
      procedure :: get_event_excess => mci_test_instance_get_event_excess
   end type mci_test_instance_t
 
 @ %def mci_test_instance_t
 @ Output: trivial
 <<MCI base: tests>>=
   subroutine mci_test_instance_write (object, unit, pacify)
     class(mci_test_instance_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacify
     integer :: u, c
     u = given_output_unit (unit)
     write (u, "(1x,A,ES13.7)") "Result value = ", object%value
     write (u, "(1x,A,ES13.7)") "Rel. weight  = ", object%rel_value
     write (u, "(1x,A,ES13.7)") "Integrand    = ", object%integrand
     write (u, "(1x,A,ES13.7)") "MCI weight   = ", object%mci_weight
     write (u, "(3x,A,I0)")  "c = ", object%selected_channel
     write (u, "(3x,A,ES13.7)") "g = ", object%g
     write (u, "(1x,A)")  "Channel parameters:"
     do c = 1, object%mci%n_channel
        write (u, "(1x,I0,A,4(1x,ES13.7))")  c, ": w/f/g/m =", &
             object%w(c), object%f(c), object%gi(c), object%max(c)
        write (u, "(4x,A,9(1x,F9.7))")  "x =", object%x(:,c)
     end do
   end subroutine mci_test_instance_write
 
 @ %def mci_test_instance_write
 @ The finalizer is empty.
 <<MCI base: tests>>=
   subroutine mci_test_instance_final (object)
     class(mci_test_instance_t), intent(inout) :: object
   end subroutine mci_test_instance_final
 
 @ %def mci_test_instance_final
 @ Initializer.  We make use of the analytical result that the maximum of
 the weighted integrand, in each channel, is equal to $1$
 (one-dimensional case) and $2$ (two-dimensional case), respectively.
 <<MCI base: tests>>=
   subroutine mci_test_instance_init (mci_instance, mci)
     class(mci_test_instance_t), intent(out) :: mci_instance
     class(mci_t), intent(in), target :: mci
     call mci_instance%base_init (mci)
     select type (mci)
     type is (mci_test_t)
        mci_instance%mci => mci
     end select
     allocate (mci_instance%gi (mci%n_channel))
     mci_instance%gi = 0
     allocate (mci_instance%max (mci%n_channel))
     select case (mci%n_channel)
     case (1)
        mci_instance%max = 1._default
     case (2)
        mci_instance%max = 2._default
     end select
   end subroutine mci_test_instance_init
 
 @ %def mci_test_instance_init
 @ Compute weight: we implement the VAMP multi-channel formula.  The channel
 probabilities [[gi]] are predefined functions.
 <<MCI base: tests>>=
   subroutine mci_test_instance_compute_weight (mci, c)
     class(mci_test_instance_t), intent(inout) :: mci
     integer, intent(in) :: c
     integer :: i
     mci%selected_channel = c
     select case (mci%mci%n_dim)
     case (1)
        mci%gi(1) = 1
     case (2)
        mci%gi(1) = 1
        mci%gi(2) = 2 * mci%x(2,2)
     end select
     mci%g = 0
     do i = 1, mci%mci%n_channel
        mci%g = mci%g + mci%w(i) * mci%gi(i) / mci%f(i)
     end do
     mci%mci_weight = mci%gi(c) / mci%g
   end subroutine mci_test_instance_compute_weight
 
 @ %def mci_test_instance_compute_weight
 @ Record the integrand.  Apply the Jacobian weight to get the absolute value.
 Divide by the channel maximum and by any overall factor to get the value
 relative to the maximum.
 <<MCI base: tests>>=
   subroutine mci_test_instance_record_integrand (mci, integrand)
     class(mci_test_instance_t), intent(inout) :: mci
     real(default), intent(in) :: integrand
     mci%integrand = integrand
     mci%value = mci%integrand * mci%mci_weight
     mci%rel_value = mci%value / mci%max(mci%selected_channel) &
          / mci%mci%max_factor
   end subroutine mci_test_instance_record_integrand
 
 @ %def mci_test_instance_record_integrand
 @ Nothing to do here.
 <<MCI base: tests>>=
   subroutine mci_test_instance_init_simulation (instance, safety_factor)
     class(mci_test_instance_t), intent(inout) :: instance
     real(default), intent(in), optional :: safety_factor
   end subroutine mci_test_instance_init_simulation
 
   subroutine mci_test_instance_final_simulation (instance)
     class(mci_test_instance_t), intent(inout) :: instance
   end subroutine mci_test_instance_final_simulation
 
 @ %def mci_test_instance_init_simulation
 @ %def mci_test_instance_final_simulation
 @ Return always zero.
 <<MCI base: tests>>=
   function mci_test_instance_get_event_excess (mci) result (excess)
     class(mci_test_instance_t), intent(in) :: mci
     real(default) :: excess
     excess = 0
   end function mci_test_instance_get_event_excess
 
 @ %def mci_test_instance_get_event_excess
 @
 \subsubsection{Test sampler}
 The test sampler implements a fixed configuration, either trivial
 (one-channel, one-dimension), or slightly nontrivial (two-channel,
 two-dimension).  In the second channel, the first parameter is mapped
 according to $x_1 = x^{(2)}_1{}^2$, so we have $f^{(2)}(x^{(2)}) =
 2x^{(2)}_1$.
 
 For display purposes, we store the return values inside the object.  This is
 not strictly necessary.
 <<MCI base: test types>>=
   type, extends (mci_sampler_t) :: test_sampler_t
      real(default) :: integrand = 0
      integer :: selected_channel = 0
      real(default), dimension(:,:), allocatable :: x
      real(default), dimension(:), allocatable :: f
    contains
      procedure :: init => test_sampler_init
      procedure :: write => test_sampler_write
      procedure :: compute => test_sampler_compute
      procedure :: is_valid => test_sampler_is_valid
      procedure :: evaluate => test_sampler_evaluate
      procedure :: rebuild => test_sampler_rebuild
      procedure :: fetch => test_sampler_fetch
   end type test_sampler_t
 
 @ %def test_sampler_t
 <<MCI base: tests>>=
   subroutine test_sampler_init (sampler, n)
     class(test_sampler_t), intent(out) :: sampler
     integer, intent(in) :: n
     allocate (sampler%x (n, n))
     allocate (sampler%f (n))
   end subroutine test_sampler_init
 
 @ %def test_sampler_init
 @ Output
 <<MCI base: tests>>=
   subroutine test_sampler_write (object, unit, testflag)
     class(test_sampler_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u, c
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Test sampler:"
     write (u, "(3x,A,ES13.7)")  "Integrand = ", object%integrand
     write (u, "(3x,A,I0)")      "Channel   = ", object%selected_channel
     do c = 1, size (object%f)
        write (u, "(1x,I0,':',1x,A,ES13.7)") c, "f = ", object%f(c)
        write (u, "(4x,A,9(1x,F9.7))") "x =", object%x(:,c)
     end do
   end subroutine test_sampler_write
 
 @ %def test_sampler_write
 @ Compute $x$ and Jacobians, given the input parameter array.  This is called
 both by [[evaluate]] and [[rebuild]].
 <<MCI base: tests>>=
   subroutine test_sampler_compute (sampler, c, x_in)
     class(test_sampler_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     sampler%selected_channel = c
     select case (size (sampler%f))
     case (1)
        sampler%x(:,1) = x_in
        sampler%f = 1
     case (2)
        select case (c)
        case (1)
           sampler%x(:,1) = x_in
           sampler%x(1,2) = sqrt (x_in(1))
           sampler%x(2,2) = x_in(2)
        case (2)
           sampler%x(1,1) = x_in(1) ** 2
           sampler%x(2,1) = x_in(2)
           sampler%x(:,2) = x_in
        end select
        sampler%f(1) = 1
        sampler%f(2) = 2 * sampler%x(1,2)
     end select
   end subroutine test_sampler_compute
 
 @ %def test_sampler_kineamtics
 @ The point is always valid.
 <<MCI base: tests>>=
   function test_sampler_is_valid (sampler) result (valid)
     class(test_sampler_t), intent(in) :: sampler
     logical :: valid
     valid = .true.
   end function test_sampler_is_valid
 
 @ %def test_sampler_is_valid
 @ The integrand is always equal to 1.
 <<MCI base: tests>>=
   subroutine test_sampler_evaluate (sampler, c, x_in, val, x, f)
     class(test_sampler_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     call sampler%compute (c, x_in)
     sampler%integrand = 1
     val = sampler%integrand
     x = sampler%x
     f = sampler%f
   end subroutine test_sampler_evaluate
 
 @ %def test_sampler_evaluate
 @ Construct kinematics from the input $x$ array.  Set the integrand
 instead of evaluating it.
 <<MCI base: tests>>=
   subroutine test_sampler_rebuild (sampler, c, x_in, val, x, f)
     class(test_sampler_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(in) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     call sampler%compute (c, x_in)
     sampler%integrand = val
     x = sampler%x
     f = sampler%f
   end subroutine test_sampler_rebuild
 
 @ %def test_sampler_rebuild
 @ Recall contents.
 <<MCI base: tests>>=
   subroutine test_sampler_fetch (sampler, val, x, f)
     class(test_sampler_t), intent(in) :: sampler
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     val = sampler%integrand
     x = sampler%x
     f = sampler%f
   end subroutine test_sampler_fetch
 
 @ %def test_sampler_fetch
 @
 \subsubsection{Test results object}
 This mock object just stores and displays the current result.
 <<MCI base: test types>>=
   type, extends (mci_results_t) :: mci_test_results_t
      integer :: n_it = 0
      integer :: n_calls = 0
      real(default) :: integral = 0
      real(default) :: error = 0
      real(default) :: efficiency = 0
    contains
    <<MCI base: mci test results: TBP>>
   end type mci_test_results_t
 
 @ %def mci_test_results_t
 @ Output.
 <<MCI base: mci test results: TBP>>=
   procedure :: write => mci_test_results_write
   procedure :: write_verbose => mci_test_results_write_verbose
 <<MCI base: tests>>=
   subroutine mci_test_results_write (object, unit, suppress)
     class(mci_test_results_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: suppress
     integer :: u
     u = given_output_unit (unit)
     write (u, "(3x,A,1x,I0)") "Iterations = ", object%n_it
     write (u, "(3x,A,1x,I0)") "Calls      = ", object%n_calls
     write (u, "(3x,A,1x,F12.10)")  "Integral   = ", object%integral
     write (u, "(3x,A,1x,F12.10)")  "Error      = ", object%error
     write (u, "(3x,A,1x,F12.10)")  "Efficiency = ", object%efficiency
   end subroutine mci_test_results_write
 
   subroutine mci_test_results_write_verbose (object, unit)
     class(mci_test_results_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(3x,A,1x,I0)") "Iterations = ", object%n_it
     write (u, "(3x,A,1x,I0)") "Calls      = ", object%n_calls
     write (u, "(3x,A,1x,F12.10)")  "Integral   = ", object%integral
     write (u, "(3x,A,1x,F12.10)")  "Error      = ", object%error
     write (u, "(3x,A,1x,F12.10)")  "Efficiency = ", object%efficiency
   end subroutine mci_test_results_write_verbose
 
 @ %def mci_test_results_write
 @ Record result.
 <<MCI base: mci test results: TBP>>=
   procedure :: record_simple => mci_test_results_record_simple
   procedure :: record_extended => mci_test_results_record_extended
 <<MCI base: tests>>=
   subroutine mci_test_results_record_simple (object, n_it, n_calls, &
        integral, error, efficiency, chain_weights, suppress)
     class(mci_test_results_t), intent(inout) :: object
     integer, intent(in) :: n_it
     integer, intent(in) :: n_calls
     real(default), intent(in) :: integral
     real(default), intent(in) :: error
     real(default), intent(in) :: efficiency
     real(default), dimension(:), intent(in), optional :: chain_weights
     logical, intent(in), optional :: suppress
     object%n_it = n_it
     object%n_calls = n_calls
     object%integral = integral
     object%error = error
     object%efficiency = efficiency
   end subroutine mci_test_results_record_simple
 
   subroutine mci_test_results_record_extended (object, n_it, n_calls, &
        & n_calls_valid, integral, error, efficiency, efficiency_pos, &
        & efficiency_neg, chain_weights, suppress)
     class(mci_test_results_t), intent(inout) :: object
     integer, intent(in) :: n_it
     integer, intent(in) :: n_calls
     integer, intent(in) :: n_calls_valid
     real(default), intent(in) :: integral
     real(default), intent(in) :: error
     real(default), intent(in) :: efficiency
     real(default), intent(in) :: efficiency_pos
     real(default), intent(in) :: efficiency_neg
     real(default), dimension(:), intent(in), optional :: chain_weights
     logical, intent(in), optional :: suppress
     object%n_it = n_it
     object%n_calls = n_calls
     object%integral = integral
     object%error = error
     object%efficiency = efficiency
   end subroutine mci_test_results_record_extended
 
 @ %def mci_test_results_record
 @
 \subsubsection{Integrator configuration data}
 Construct and display a test integrator configuration object.
 <<MCI base: execute tests>>=
   call test (mci_base_1, "mci_base_1", &
        "integrator configuration", &
        u, results)
 <<MCI base: test declarations>>=
   public :: mci_base_1
 <<MCI base: tests>>=
   subroutine mci_base_1 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
 
     real(default) :: integrand
 
     write (u, "(A)")  "* Test output: mci_base_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &test integrator"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_test_t :: mci)
     call mci%set_dimensions (2, 2)
 
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_t :: sampler)
     select type (sampler)
     type is (test_sampler_t)
        call sampler%init (2)
     end select
 
     write (u, "(A)")  "* Evaluate sampler for given point and channel"
     write (u, "(A)")
 
     call sampler%evaluate (1, [0.25_default, 0.8_default], &
          integrand, mci_instance%x, mci_instance%f)
 
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute MCI weight"
     write (u, "(A)")
 
     call mci_instance%compute_weight (1)
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Get integrand and compute weight for another point"
     write (u, "(A)")
 
     call mci_instance%evaluate (sampler, 2, [0.5_default, 0.6_default])
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recall results, again"
     write (u, "(A)")
 
     call mci_instance%final ()
     deallocate (mci_instance)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     call mci_instance%fetch (sampler, 2)
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Retrieve value"
     write (u, "(A)")
 
     write (u, "(1x,A,ES13.7)")  "Weighted integrand = ", &
          mci_instance%get_value ()
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_base_1"
 
   end subroutine mci_base_1
 
 @ %def mci_base_1
 @
 \subsubsection{Trivial integral}
 Use the MCI approach to compute a trivial one-dimensional integral.
 <<MCI base: execute tests>>=
   call test (mci_base_2, "mci_base_2", &
        "integration", &
        u, results)
 <<MCI base: test declarations>>=
   public :: mci_base_2
 <<MCI base: tests>>=
   subroutine mci_base_2 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
 
     write (u, "(A)")  "* Test output: mci_base_2"
     write (u, "(A)")  "*   Purpose: perform a test integral"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_test_t :: mci)
     call mci%set_dimensions (1, 1)
     select type (mci)
     type is (mci_test_t)
        call mci%set_divisions (10)
     end select
 
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_t :: sampler)
     select type (sampler)
     type is (test_sampler_t)
        call sampler%init (1)
     end select
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call mci%integrate (mci_instance, sampler, 0, 0)
 
     call mci%write (u)
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_base_2"
 
   end subroutine mci_base_2
 
 @ %def mci_base_2
 @
 \subsubsection{Nontrivial integral}
 Use the MCI approach to compute a simple two-dimensional integral with
 two channels.
 <<MCI base: execute tests>>=
   call test (mci_base_3, "mci_base_3", &
        "integration (two channels)", &
        u, results)
 <<MCI base: test declarations>>=
   public :: mci_base_3
 <<MCI base: tests>>=
   subroutine mci_base_3 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
 
     write (u, "(A)")  "* Test output: mci_base_3"
     write (u, "(A)")  "*   Purpose: perform a nontrivial test integral"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_test_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_test_t)
        call mci%set_divisions (10)
     end select
 
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_t :: sampler)
     select type (sampler)
     type is (test_sampler_t)
        call sampler%init (2)
     end select
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call mci%integrate (mci_instance, sampler, 0, 0)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with higher resolution"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_test_t)
        call mci%set_divisions (100)
     end select
 
     call mci%integrate (mci_instance, sampler, 0, 0)
     call mci%write (u)
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_base_3"
 
   end subroutine mci_base_3
 
 @ %def mci_base_3
 @
 \subsubsection{Event generation}
 We generate ``random'' events, one weighted and one unweighted.  The
 test implementation does not require an integration pass, we can
 generate events immediately.
 <<MCI base: execute tests>>=
   call test (mci_base_4, "mci_base_4", &
        "event generation (two channels)", &
        u, results)
 <<MCI base: test declarations>>=
   public :: mci_base_4
 <<MCI base: tests>>=
   subroutine mci_base_4 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_base_4"
     write (u, "(A)")  "*   Purpose: generate events"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator, instance, sampler"
     write (u, "(A)")
 
     allocate (mci_test_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_test_t)
        call mci%set_divisions (10)
     end select
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_t :: sampler)
     select type (sampler)
     type is (test_sampler_t)
        call sampler%init (2)
     end select
 
     allocate (rng_test_t :: rng)
     call mci%import_rng (rng)
 
     write (u, "(A)")  "* Generate weighted event"
     write (u, "(A)")
 
     call mci%generate_weighted_event (mci_instance, sampler)
 
     call sampler%write (u)
     write (u, *)
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate unweighted event"
     write (u, "(A)")
 
     call mci%generate_unweighted_event (mci_instance, sampler)
 
     select type (mci)
     type is (mci_test_t)
        write (u, "(A,I0)")  " Success in try ", mci%tries
        write (u, "(A)")
     end select
 
     call sampler%write (u)
     write (u, *)
     call mci_instance%write (u)
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_base_4"
 
   end subroutine mci_base_4
 
 @ %def mci_base_4
 @
 \subsubsection{Store and recall data}
 We generate an event and store the relevant data, i.e., the input
 parameters and the result value for a particular channel.  Then we use
 those data to recover the event, as far as the MCI record is concerned.
 <<MCI base: execute tests>>=
   call test (mci_base_5, "mci_base_5", &
        "store and recall", &
        u, results)
 <<MCI base: test declarations>>=
   public :: mci_base_5
 <<MCI base: tests>>=
   subroutine mci_base_5 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
     class(mci_state_t), allocatable :: state
 
     write (u, "(A)")  "* Test output: mci_base_5"
     write (u, "(A)")  "*   Purpose: store and recall an event"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator, instance, sampler"
     write (u, "(A)")
 
     allocate (mci_test_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_test_t)
        call mci%set_divisions (10)
     end select
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_t :: sampler)
     select type (sampler)
     type is (test_sampler_t)
        call sampler%init (2)
     end select
 
     allocate (rng_test_t :: rng)
     call mci%import_rng (rng)
 
     write (u, "(A)")  "* Generate weighted event"
     write (u, "(A)")
 
     call mci%generate_weighted_event (mci_instance, sampler)
 
     call sampler%write (u)
     write (u, *)
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Store data"
     write (u, "(A)")
 
     allocate (state)
     call mci_instance%store (state)
     call mci_instance%final ()
     deallocate (mci_instance)
 
     call state%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recall data and rebuild event"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
     call mci%rebuild_event (mci_instance, sampler, state)
 
     call sampler%write (u)
     write (u, *)
     call mci_instance%write (u)
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_base_5"
 
   end subroutine mci_base_5
 
 @ %def mci_base_5
 @
 \subsubsection{Chained channels}
 Chain channels together.  In the base configuration, this just fills entries
 in an extra array (each channel may belong to a chain).  In type
 implementations, this will be used for grouping equivalent channels by keeping
 their weights equal.
 <<MCI base: execute tests>>=
   call test (mci_base_6, "mci_base_6", &
        "chained channels", &
        u, results)
 <<MCI base: test declarations>>=
   public :: mci_base_6
 <<MCI base: tests>>=
   subroutine mci_base_6 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
 
     write (u, "(A)")  "* Test output: mci_base_6"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &test integrator with chains"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_test_t :: mci)
     call mci%set_dimensions (1, 5)
 
     write (u, "(A)")  "* Introduce chains"
     write (u, "(A)")
 
     call mci%declare_chains ([1, 2, 2, 1, 2])
 
     call mci%write (u)
 
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_base_6"
 
   end subroutine mci_base_6
 
 @ %def mci_base_6
 @
 \subsubsection{Recording results}
 Compute a simple two-dimensional integral and record the result.
 <<MCI base: execute tests>>=
   call test (mci_base_7, "mci_base_7", &
        "recording results", &
        u, results)
 <<MCI base: test declarations>>=
   public :: mci_base_7
 <<MCI base: tests>>=
   subroutine mci_base_7 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(mci_results_t), allocatable :: results
 
     write (u, "(A)")  "* Test output: mci_base_7"
     write (u, "(A)")  "*   Purpose: perform a nontrivial test integral &
          &and record results"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_test_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_test_t)
        call mci%set_divisions (10)
     end select
 
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_t :: sampler)
     select type (sampler)
     type is (test_sampler_t)
        call sampler%init (2)
     end select
 
     allocate (mci_test_results_t :: results)
 
     write (u, "(A)")  "* Integrate"
     write (u, "(A)")
 
     call mci%integrate (mci_instance, sampler, 1, 1000, results)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Display results"
     write (u, "(A)")
 
     call results%write (u)
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_base_7"
 
   end subroutine mci_base_7
 
 @ %def mci_base_7
 @
 \subsubsection{Timer}
 Simple checks for the embedded timer.
 <<MCI base: execute tests>>=
   call test (mci_base_8, "mci_base_8", &
        "timer", &
        u, results)
 <<MCI base: test declarations>>=
   public :: mci_base_8
 <<MCI base: tests>>=
   subroutine mci_base_8 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
 
     real(default) :: dummy
 
     write (u, "(A)")  "* Test output: mci_base_8"
     write (u, "(A)")  "*   Purpose: check timer availability"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator with timer"
     write (u, "(A)")
 
     allocate (mci_test_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_test_t)
        call mci%set_divisions (10)
     end select
 
     call mci%set_timer (active = .true.)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Start timer"
     write (u, "(A)")
 
     call mci%start_timer ()
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Stop timer"
     write (u, "(A)")
 
     call mci%stop_timer ()
     write (u, "(A)")  " (ok)"
 
     write (u, "(A)")
     write (u, "(A)")  "* Readout"
     write (u, "(A)")
 
     dummy = mci%get_time ()
     write (u, "(A)")  " (ok)"
 
     write (u, "(A)")
     write (u, "(A)")  "* Deactivate timer"
     write (u, "(A)")
 
     call mci%set_timer (active = .false.)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_base_8"
 
   end subroutine mci_base_8
 
 @ %def mci_base_8
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Iterations}
 This module defines a container for the list of iterations and calls, to be
 submitted to integration.
 <<[[iterations.f90]]>>=
 <<File header>>
 
 module iterations
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use diagnostics
 
 <<Standard module head>>
 
 <<Iterations: public>>
 
 <<Iterations: types>>
 
 contains
 
 <<Iterations: procedures>>
 
 end module iterations
 @ %def iterations
 @
 \subsection{The iterations list}
 Each integration pass has a number of iterations and a number of calls
 per iteration.  The last pass produces the end result; the previous
 passes are used for adaptation.
 
 The flags [[adapt_grid]] and [[adapt_weight]] are used only if
 [[custom_adaptation]] is set.  Otherwise, default settings are used
 that depend on the integration pass.
 <<Iterations: types>>=
   type :: iterations_spec_t
      private
      integer :: n_it = 0
      integer :: n_calls = 0
      logical :: custom_adaptation = .false.
      logical :: adapt_grids = .false.
      logical :: adapt_weights = .false.
   end type iterations_spec_t
 
 @ %def iterations_spec_t
 @ We build up a list of iterations.
 <<Iterations: public>>=
   public :: iterations_list_t
 <<Iterations: types>>=
   type :: iterations_list_t
      private
      integer :: n_pass = 0
      type(iterations_spec_t), dimension(:), allocatable :: pass
    contains
    <<Iterations: iterations list: TBP>>
   end type iterations_list_t
 
 @ %def iterations_list_t
 @ Initialize an iterations list.  For each pass, we have to specify
 the number of iterations and calls.  We may provide the adaption
 conventions explicitly, either as character codes or as logicals.
 
 For passes where the adaptation conventions are not specified, we use
 the following default setting: adapt weights and grids for all passes
 except the last one.
 <<Iterations: iterations list: TBP>>=
   procedure :: init => iterations_list_init
 <<Iterations: procedures>>=
   subroutine iterations_list_init &
        (it_list, n_it, n_calls, adapt, adapt_code, adapt_grids, adapt_weights)
     class(iterations_list_t), intent(inout) :: it_list
     integer, dimension(:), intent(in) :: n_it, n_calls
     logical, dimension(:), intent(in), optional :: adapt
     type(string_t), dimension(:), intent(in), optional :: adapt_code
     logical, dimension(:), intent(in), optional :: adapt_grids, adapt_weights
     integer :: i
     it_list%n_pass = size (n_it)
     if (allocated (it_list%pass)) deallocate (it_list%pass)
     allocate (it_list%pass (it_list%n_pass))
     it_list%pass%n_it = n_it
     it_list%pass%n_calls = n_calls
     if (present (adapt)) then
        it_list%pass%custom_adaptation = adapt
        do i = 1, it_list%n_pass
           if (adapt(i)) then
              if (verify (adapt_code(i), "wg") /= 0) then
                 call msg_error ("iteration specification: " &
                      // "adaptation code letters must be 'w' or 'g'")
              end if
              it_list%pass(i)%adapt_grids = scan (adapt_code(i), "g") /= 0
              it_list%pass(i)%adapt_weights = scan (adapt_code(i), "w") /= 0
           end if
        end do
     else if (present (adapt_grids) .and. present (adapt_weights)) then
        it_list%pass%custom_adaptation = .true.
        it_list%pass%adapt_grids = adapt_grids
        it_list%pass%adapt_weights = adapt_weights
     end if
     do i = 1, it_list%n_pass - 1
        if (.not. it_list%pass(i)%custom_adaptation) then
           it_list%pass(i)%adapt_grids = .true.
           it_list%pass(i)%adapt_weights = .true.
        end if
     end do
   end subroutine iterations_list_init
 
 @ %def iterations_list_init
 <<Iterations: iterations list: TBP>>=
   procedure :: clear => iterations_list_clear
 <<Iterations: procedures>>=
   subroutine iterations_list_clear (it_list)
     class(iterations_list_t), intent(inout) :: it_list
     it_list%n_pass = 0
     deallocate (it_list%pass)
   end subroutine iterations_list_clear
 
 @ %def iterations_list_clear
 @ Write the list of iterations.
 <<Iterations: iterations list: TBP>>=
   procedure :: write => iterations_list_write
 <<Iterations: procedures>>=
   subroutine iterations_list_write (it_list, unit)
     class(iterations_list_t), intent(in) :: it_list
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(A)")  char (it_list%to_string ())
   end subroutine iterations_list_write
 
 @ %def iterations_list_write
 @ The output as a single-line string.
 <<Iterations: iterations list: TBP>>=
   procedure :: to_string => iterations_list_to_string
 <<Iterations: procedures>>=
   function iterations_list_to_string (it_list) result (buffer)
     class(iterations_list_t), intent(in) :: it_list
     type(string_t) :: buffer
     character(30) :: ibuf
     integer :: i
     buffer = "iterations = "
     if (it_list%n_pass > 0) then
        do i = 1, it_list%n_pass
           if (i > 1)  buffer = buffer // ", "
           write (ibuf, "(I0,':',I0)") &
                it_list%pass(i)%n_it, it_list%pass(i)%n_calls
           buffer = buffer // trim (ibuf)
           if (it_list%pass(i)%custom_adaptation &
                .or. it_list%pass(i)%adapt_grids &
                .or. it_list%pass(i)%adapt_weights) then
              buffer = buffer // ':"'
              if (it_list%pass(i)%adapt_grids)  buffer = buffer // "g"
              if (it_list%pass(i)%adapt_weights)  buffer = buffer // "w"
              buffer = buffer // '"'
           end if
        end do
     else
        buffer = buffer // "[undefined]"
     end if
   end function iterations_list_to_string
 
 @ %def iterations_list_to_string
 @
 \subsection{Tools}
 Return the total number of passes.
 <<Iterations: iterations list: TBP>>=
   procedure :: get_n_pass => iterations_list_get_n_pass
 <<Iterations: procedures>>=
   function iterations_list_get_n_pass (it_list) result (n_pass)
     class(iterations_list_t), intent(in) :: it_list
     integer :: n_pass
     n_pass = it_list%n_pass
   end function iterations_list_get_n_pass
 
 @ %def iterations_list_get_n_pass
 @ Return the number of calls for a specific pass.
 <<Iterations: iterations list: TBP>>=
   procedure :: get_n_calls => iterations_list_get_n_calls
 <<Iterations: procedures>>=
   function iterations_list_get_n_calls (it_list, pass) result (n_calls)
     class(iterations_list_t), intent(in) :: it_list
     integer :: n_calls
     integer, intent(in) :: pass
     if (pass <= it_list%n_pass) then
        n_calls = it_list%pass(pass)%n_calls
     else
        n_calls = 0
     end if
   end function iterations_list_get_n_calls
 
 @ %def iterations_list_get_n_calls
 @
 <<Iterations: iterations list: TBP>>=
   procedure :: set_n_calls => iterations_list_set_n_calls
 <<Iterations: procedures>>=
   subroutine iterations_list_set_n_calls (it_list, pass, n_calls)
     class(iterations_list_t), intent(inout) :: it_list
     integer, intent(in) :: pass, n_calls
     it_list%pass(pass)%n_calls = n_calls
   end subroutine iterations_list_set_n_calls
 
 @ %def iterations_list_set_n_calls
 @ Get the adaptation mode (automatic/custom) and, for custom adaptation, the
 flags for a specific pass.
 <<Iterations: iterations list: TBP>>=
   procedure :: adapt_grids => iterations_list_adapt_grids
   procedure :: adapt_weights => iterations_list_adapt_weights
 <<Iterations: procedures>>=
   function iterations_list_adapt_grids (it_list, pass) result (flag)
     logical :: flag
     class(iterations_list_t), intent(in) :: it_list
     integer, intent(in) :: pass
     if (pass <= it_list%n_pass) then
        flag = it_list%pass(pass)%adapt_grids
     else
        flag = .false.
     end if
   end function iterations_list_adapt_grids
 
   function iterations_list_adapt_weights (it_list, pass) result (flag)
     logical :: flag
     class(iterations_list_t), intent(in) :: it_list
     integer, intent(in) :: pass
     if (pass <= it_list%n_pass) then
        flag = it_list%pass(pass)%adapt_weights
     else
        flag = .false.
     end if
   end function iterations_list_adapt_weights
 
 @ %def iterations_list_has_custom_adaptation
 @ %def iterations_list_adapt_grids
 @ %def iterations_list_adapt_weights
 @ Return the total number of iterations / the iterations for a specific pass.
 <<Iterations: iterations list: TBP>>=
   procedure :: get_n_it => iterations_list_get_n_it
 <<Iterations: procedures>>=
   function iterations_list_get_n_it (it_list, pass) result (n_it)
     class(iterations_list_t), intent(in) :: it_list
     integer :: n_it
     integer, intent(in) :: pass
     if (pass <= it_list%n_pass) then
        n_it = it_list%pass(pass)%n_it
     else
        n_it = 0
     end if
   end function iterations_list_get_n_it
 
 @ %def iterations_list_get_n_it
 @
 \subsection{Iteration Multipliers}
 <<Iterations: public>>=
   public :: iteration_multipliers_t
 <<Iterations: types>>=
   type :: iteration_multipliers_t
     real(default) :: mult_real = 1._default
     real(default) :: mult_virt = 1._default
     real(default) :: mult_dglap = 1._default
     real(default) :: mult_threshold = 1._default
     integer, dimension(:), allocatable :: n_calls0
   end type iteration_multipliers_t
 
 @ %def iterations_multipliers
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[iterations_ut.f90]]>>=
 <<File header>>
 
 module iterations_ut
   use unit_tests
   use iterations_uti
 
 <<Standard module head>>
 
 <<Iterations: public test>>
 
 contains
 
 <<Iterations: test driver>>
 
 end module iterations_ut
 @ %def iterations_ut
 @
 <<[[iterations_uti.f90]]>>=
 <<File header>>
 
 module iterations_uti
 
 <<Use strings>>
 
   use iterations
 
 <<Standard module head>>
 
 <<Iterations: test declarations>>
 
 contains
 
 <<Iterations: tests>>
 
 end module iterations_uti
 @ %def iterations_ut
 @ API: driver for the unit tests below.
 <<Iterations: public test>>=
   public :: iterations_test
 <<Iterations: test driver>>=
   subroutine iterations_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Iterations: execute tests>>
 end subroutine iterations_test
 
 @ %def iterations_test
 @
 \subsubsection{Empty list}
 <<Iterations: execute tests>>=
   call test (iterations_1, "iterations_1", &
        "empty iterations list", &
        u, results)
 <<Iterations: test declarations>>=
   public :: iterations_1
 <<Iterations: tests>>=
   subroutine iterations_1 (u)
     integer, intent(in) :: u
     type(iterations_list_t) :: it_list
 
     write (u, "(A)")  "* Test output: iterations_1"
     write (u, "(A)")  "*   Purpose: display empty iterations list"
     write (u, "(A)")
 
     call it_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: iterations_1"
 
   end subroutine iterations_1
 
 @ %def iterations_1
 @
 \subsubsection{Fill list}
 <<Iterations: execute tests>>=
   call test (iterations_2, "iterations_2", &
        "create iterations list", &
        u, results)
 <<Iterations: test declarations>>=
   public :: iterations_2
 <<Iterations: tests>>=
   subroutine iterations_2 (u)
     integer, intent(in) :: u
     type(iterations_list_t) :: it_list
 
     write (u, "(A)")  "* Test output: iterations_2"
     write (u, "(A)")  "*   Purpose: fill and display iterations list"
     write (u, "(A)")
 
     write (u, "(A)")  "* Minimal setup (2 passes)"
     write (u, "(A)")
 
     call it_list%init ([2, 4], [5000, 20000])
 
     call it_list%write (u)
     call it_list%clear ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup with flags (3 passes)"
     write (u, "(A)")
 
     call it_list%init ([2, 4, 5], [5000, 20000, 400], &
          [.false., .true., .true.], &
          [var_str (""), var_str ("g"), var_str ("wg")])
 
     call it_list%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract data"
     write (u, "(A)")
 
     write (u, "(A,I0)")  "n_pass = ", it_list%get_n_pass ()
     write (u, "(A)")
     write (u, "(A,I0)")  "n_calls(2) = ", it_list%get_n_calls (2)
     write (u, "(A)")
     write (u, "(A,I0)")  "n_it(3) = ", it_list%get_n_it (3)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: iterations_2"
 
   end subroutine iterations_2
 
 @ %def iterations_2
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Integration results}
 
 We record integration results and errors in a dedicated type.  This
 allows us to do further statistics such as weighted average,
 chi-squared, grouping by integration passes, etc.
 
 Note WHIZARD 2.2.0: This code is taken from the previous [[processes]]
 module essentially unchanged and converted into a separate module.  It
 lacks an overhaul and, in particular, self-tests.
 <<[[integration_results.f90]]>>=
 module integration_results
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_utils, only: mp_format, pac_fmt
   use format_defs, only: FMT_10, FMT_14
   use diagnostics
   use md5
   use os_interface
   use mci_base
 
 <<Standard module head>>
 
 <<Integration results: public>>
 
 <<Integration results: parameters>>
 
 <<Integration results: types>>
 
 <<Integration results: interfaces>>
 
 contains
 
 <<Integration results: procedures>>
 
 end module integration_results
 @ %def integration_results
 @
 \subsection{Integration results entry}
 This object collects the results of an integration pass and makes them
 available to the outside.
 
 The results object has to distinguish the process type:
 
 We store the process type, the index of the integration pass and the
 absolute iteration index, the number of iterations contained in this
 result (for averages), and the integral (cross section or partial
 width), error estimate, efficiency.
 
 For intermediate results, we set a flag if this result is an
 improvement w.r.t. previous ones.
 
 The process type indicates decay or scattering.  Dummy entries
 (skipped iterations) have a process type of [[PRC_UNKNOWN]].
 
 The additional information [[n_calls_valid]], [[efficiency_pos]] and
 [[efficiency_neg]] are stored, but only used in verbose mode.
 <<Integration results: public>>=
   public :: integration_entry_t
 <<Integration results: types>>=
   type :: integration_entry_t
      private
      integer :: process_type = PRC_UNKNOWN
      integer :: pass = 0
      integer :: it = 0
      integer :: n_it = 0
      integer :: n_calls = 0
      integer :: n_calls_valid = 0
      logical :: improved = .false.
      real(default) :: integral = 0
      real(default) :: error = 0
      real(default) :: efficiency = 0
      real(default) :: efficiency_pos = 0
      real(default) :: efficiency_neg = 0
      real(default) :: chi2 = 0
      real(default), dimension(:), allocatable :: chain_weights
    contains
    <<Integration results: integration entry: TBP>>
   end type integration_entry_t
 
 @ %def integration_result_t
 @
 The possible values of the type indicator:
 <<Integration results: parameters>>=
   integer, parameter, public :: PRC_UNKNOWN = 0
   integer, parameter, public :: PRC_DECAY = 1
   integer, parameter, public :: PRC_SCATTERING = 2
 
 @ %def PRC_UNKNOWN PRC_DECAY PRC_SCATTERING
 @ Initialize with all relevant data.
 <<Integration results: interfaces>>=
   interface integration_entry_t
      module procedure integration_entry_init
   end interface integration_entry_t
 
 <<Integration results: procedures>>=
   type(integration_entry_t) function integration_entry_init (process_type, pass,&
        & it, n_it, n_calls, n_calls_valid, improved, integral, error,&
        & efficiency, efficiency_pos, efficiency_neg, chi2, chain_weights)&
        & result (entry)
     integer, intent(in) :: process_type, pass, it, n_it, n_calls, n_calls_valid
     logical, intent(in) :: improved
     real(default), intent(in) :: integral, error, efficiency, efficiency_pos, efficiency_neg
     real(default), intent(in), optional :: chi2
     real(default), dimension(:), intent(in), optional :: chain_weights
     entry%process_type = process_type
     entry%pass = pass
     entry%it = it
     entry%n_it = n_it
     entry%n_calls = n_calls
     entry%n_calls_valid = n_calls_valid
     entry%improved = improved
     entry%integral = integral
     entry%error = error
     entry%efficiency = efficiency
     entry%efficiency_pos = efficiency_pos
     entry%efficiency_neg = efficiency_neg
     if (present (chi2)) entry%chi2 = chi2
     if (present (chain_weights)) then
        allocate (entry%chain_weights (size (chain_weights)))
        entry%chain_weights = chain_weights
     end if
   end function integration_entry_init
 
 @ %def integration_entry_init
 @ Access values, some of them computed on demand:
 <<Integration results: integration entry: TBP>>=
   procedure :: get_pass => integration_entry_get_pass
   procedure :: get_n_calls => integration_entry_get_n_calls
   procedure :: get_n_calls_valid => integration_entry_get_n_calls_valid
   procedure :: get_integral => integration_entry_get_integral
   procedure :: get_error => integration_entry_get_error
   procedure :: get_rel_error => integration_entry_get_relative_error
   procedure :: get_accuracy => integration_entry_get_accuracy
   procedure :: get_efficiency => integration_entry_get_efficiency
   procedure :: get_efficiency_pos => integration_entry_get_efficiency_pos
   procedure :: get_efficiency_neg => integration_entry_get_efficiency_neg
   procedure :: get_chi2 => integration_entry_get_chi2
   procedure :: has_improved => integration_entry_has_improved
   procedure :: get_n_groves => integration_entry_get_n_groves
 <<Integration results: procedures>>=
   elemental function integration_entry_get_pass (entry) result (n)
     integer :: n
     class(integration_entry_t), intent(in) :: entry
     n = entry%pass
   end function integration_entry_get_pass
 
   elemental function integration_entry_get_n_calls (entry) result (n)
     integer :: n
     class(integration_entry_t), intent(in) :: entry
     n = entry%n_calls
   end function integration_entry_get_n_calls
 
   elemental function integration_entry_get_n_calls_valid (entry) result (n)
     integer :: n
     class(integration_entry_t), intent(in) :: entry
     n = entry%n_calls_valid
   end function integration_entry_get_n_calls_valid
 
   elemental function integration_entry_get_integral (entry) result (int)
     real(default) :: int
     class(integration_entry_t), intent(in) :: entry
     int = entry%integral
   end function integration_entry_get_integral
 
   elemental function integration_entry_get_error (entry) result (err)
     real(default) :: err
     class(integration_entry_t), intent(in) :: entry
     err = entry%error
   end function integration_entry_get_error
 
   elemental function integration_entry_get_relative_error (entry) result (err)
     real(default) :: err
     class(integration_entry_t), intent(in) :: entry
     err = 0
     if (entry%integral /= 0) then
        err = entry%error / entry%integral
     end if
   end function integration_entry_get_relative_error
 
   elemental function integration_entry_get_accuracy (entry) result (acc)
     real(default) :: acc
     class(integration_entry_t), intent(in) :: entry
     acc = accuracy (entry%integral, entry%error, entry%n_calls)
   end function integration_entry_get_accuracy
 
   elemental function accuracy (integral, error, n_calls) result (acc)
     real(default) :: acc
     real(default), intent(in) :: integral, error
     integer, intent(in) :: n_calls
     acc = 0
     if (integral /= 0) then
        acc = error / integral * sqrt (real (n_calls, default))
     end if
   end function accuracy
 
   elemental function integration_entry_get_efficiency (entry) result (eff)
     real(default) :: eff
     class(integration_entry_t), intent(in) :: entry
     eff = entry%efficiency
   end function integration_entry_get_efficiency
 
   elemental function integration_entry_get_efficiency_pos (entry) result (eff)
     real(default) :: eff
     class(integration_entry_t), intent(in) :: entry
     eff = entry%efficiency_pos
   end function integration_entry_get_efficiency_pos
 
   elemental function integration_entry_get_efficiency_neg (entry) result (eff)
     real(default) :: eff
     class(integration_entry_t), intent(in) :: entry
     eff = entry%efficiency_neg
   end function integration_entry_get_efficiency_neg
 
   elemental function integration_entry_get_chi2 (entry) result (chi2)
     real(default) :: chi2
     class(integration_entry_t), intent(in) :: entry
     chi2 = entry%chi2
   end function integration_entry_get_chi2
 
   elemental function integration_entry_has_improved (entry) result (flag)
     logical :: flag
     class(integration_entry_t), intent(in) :: entry
     flag = entry%improved
   end function integration_entry_has_improved
 
   elemental function integration_entry_get_n_groves (entry) result (n_groves)
     integer :: n_groves
     class(integration_entry_t), intent(in) :: entry
     n_groves = 0
     if (allocated (entry%chain_weights)) then
        n_groves = size (entry%chain_weights, 1)
     end if
   end function integration_entry_get_n_groves
 
 @ %def integration_entry_get_pass
 @ %def integration_entry_get_integral
 @ %def integration_entry_get_error
 @ %def integration_entry_get_relative_error
 @ %def integration_entry_get_accuracy
 @ %def accuracy
 @ %def integration_entry_get_efficiency
 @ %def integration_entry_get_chi2
 @ %def integration_entry_has_improved
 @ %def integration_entry_get_n_groves
 @ This writes the standard result account into one screen line.  The
 verbose version uses multiple lines and prints the unabridged values.
 Dummy entries are not written.
 <<Integration results: integration entry: TBP>>=
   procedure :: write => integration_entry_write
   procedure :: write_verbose => integration_entry_write_verbose
 <<Integration results: procedures>>=
   subroutine integration_entry_write (entry, unit, verbosity, suppress)
     class(integration_entry_t), intent(in) :: entry
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: verbosity
     logical, intent(in), optional :: suppress
     integer :: u
     character(1) :: star
     character(12) :: fmt
     character(7) :: fmt2
     character(120) :: buffer
     integer :: verb
     logical :: supp
     u = given_output_unit (unit);  if (u < 0)  return
     verb = 0; if (present (verbosity)) verb = verbosity
     supp = .false.;  if (present (suppress)) supp = suppress
     if (entry%process_type /= PRC_UNKNOWN) then
        if (entry%improved .and. .not. supp) then
           star = "*"
        else
           star = " "
        end if
        call pac_fmt (fmt, FMT_14, "3x," // FMT_10 // ",1x", suppress)
        call pac_fmt (fmt2, "1x,F6.2", "2x,F5.1", suppress)
        write (buffer, "(1x,I3,1x,I10)") entry%it, entry%n_calls
        if (verb > 1) then
           write (buffer, "(A,1x,I10)") trim (buffer), entry%n_calls_valid
        end if
        write (buffer, "(A,1x," // fmt // ",1x,ES9.2,1x,F7.2," // &
             "1x,F7.2,A1," // fmt2 // ")") &
             trim (buffer), &
             entry%integral, &
             abs(entry%error), &
             abs(integration_entry_get_relative_error (entry)) * 100, &
             abs(integration_entry_get_accuracy (entry)), &
             star, &
             entry%efficiency * 100
        if (verb > 2) then
           write (buffer, "(A,1X," // fmt2 // ",1X," // fmt2 // ")") &
                trim (buffer), &
                entry%efficiency_pos * 100, &
                entry%efficiency_neg * 100
        end if
        if (entry%n_it /= 1) then
           write (buffer, "(A,1x,F7.2,1x,I3)") &
                trim (buffer), &
                entry%chi2, &
                entry%n_it
        end if
        write (u, "(A)") trim (buffer)
     end if
     flush (u)
   end subroutine integration_entry_write
 
   subroutine integration_entry_write_verbose (entry, unit)
     class(integration_entry_t), intent(in) :: entry
     integer, intent(in) :: unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, *)  "  process_type = ", entry%process_type
     write (u, *)  "          pass = ", entry%pass
     write (u, *)  "            it = ", entry%it
     write (u, *)  "          n_it = ", entry%n_it
     write (u, *)  "       n_calls = ", entry%n_calls
     write (u, *)  " n_calls_valid = ", entry%n_calls_valid
     write (u, *)  "      improved = ", entry%improved
     write (u, *)  "      integral = ", entry%integral
     write (u, *)  "         error = ", entry%error
     write (u, *)  "    efficiency = ", entry%efficiency
     write (u, *)  "efficiency_pos = ", entry%efficiency_pos
     write (u, *)  "efficiency_neg = ", entry%efficiency_neg
     write (u, *)  "          chi2 = ", entry%chi2
     if (allocated (entry%chain_weights)) then
        write (u, *)  "    n_groves = ", size (entry%chain_weights)
        write (u, *)  "chain_weights = ", entry%chain_weights
     else
        write (u, *)  "    n_groves = 0"
     end if
     flush (u)
   end subroutine integration_entry_write_verbose
 
 @ %def integration_entry_write
 @ Read the entry, assuming it has been written in verbose format.
 <<Integration results: integration entry: TBP>>=
   procedure :: read => integration_entry_read
 <<Integration results: procedures>>=
   subroutine integration_entry_read (entry, unit)
     class(integration_entry_t), intent(out) :: entry
     integer, intent(in) :: unit
     character(30) :: dummy
     character :: equals
     integer :: n_groves
     read (unit, *)  dummy, equals, entry%process_type
     read (unit, *)  dummy, equals, entry%pass
     read (unit, *)  dummy, equals, entry%it
     read (unit, *)  dummy, equals, entry%n_it
     read (unit, *)  dummy, equals, entry%n_calls
     read (unit, *)  dummy, equals, entry%n_calls_valid
     read (unit, *)  dummy, equals, entry%improved
     read (unit, *)  dummy, equals, entry%integral
     read (unit, *)  dummy, equals, entry%error
     read (unit, *)  dummy, equals, entry%efficiency
     read (unit, *)  dummy, equals, entry%efficiency_pos
     read (unit, *)  dummy, equals, entry%efficiency_neg
     read (unit, *)  dummy, equals, entry%chi2
     read (unit, *)  dummy, equals, n_groves
     if (n_groves /= 0) then
        allocate (entry%chain_weights (n_groves))
        read (unit, *)  dummy, equals, entry%chain_weights
     end if
   end subroutine integration_entry_read
 
 @ %def integration_entry_read
 @ Write an account of the channel weights, accumulated by groves.
 <<Integration results: integration entry: TBP>>=
   procedure :: write_chain_weights => integration_entry_write_chain_weights
 <<Integration results: procedures>>=
   subroutine integration_entry_write_chain_weights (entry, unit)
     class(integration_entry_t), intent(in) :: entry
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     if (allocated (entry%chain_weights)) then
        do i = 1, size (entry%chain_weights)
           write (u, "(1x,I3)", advance="no")  nint (entry%chain_weights(i) * 100)
        end do
        write (u, *)
     end if
   end subroutine integration_entry_write_chain_weights
 
 @ %def integration_entry_write_chain_weights
 @
 \subsection{Combined integration results}
 We collect a list of results which grows during the execution of the
 program.  This is implemented as an array which grows if necessary; so
 we can easily compute averages.
 
 We implement this as an extension of the [[mci_results_t]] which is
 defined in [[mci_base]] as an abstract type.  We thus decouple the
 implementation of the integrator from the implementation of the
 results display, but nevertheless can record intermediate results
 during integration.  This implies that the present extension
 implements a [[record]] method.
 <<Integration results: public>>=
   public :: integration_results_t
 <<Integration results: types>>=
   type, extends (mci_results_t) :: integration_results_t
      private
      integer :: process_type = PRC_UNKNOWN
      integer :: current_pass = 0
      integer :: n_pass = 0
      integer :: n_it = 0
      logical :: screen = .false.
      integer :: unit = 0
      integer :: verbosity = 0
      real(default) :: error_threshold = 0
      type(integration_entry_t), dimension(:), allocatable :: entry
      type(integration_entry_t), dimension(:), allocatable :: average
    contains
    <<Integration results: integration results: TBP>>
   end type integration_results_t
 
 @ %def integration_results_t
 @ The array is extended in chunks of 10 entries.
 <<Integration results: parameters>>=
   integer, parameter :: RESULTS_CHUNK_SIZE = 10
 
 @ %def RESULTS_CHUNK_SIZE
 @ The standard does not require to explicitly initialize the integers;
 however, some gfortran version has a bug here and misses the default
 initialization in the type definition.
 <<Integration results: integration results: TBP>>=
   procedure :: init => integration_results_init
 <<Integration results: procedures>>=
   subroutine integration_results_init (results, process_type)
     class(integration_results_t), intent(out) :: results
     integer, intent(in) :: process_type
     results%process_type = process_type
     results%n_pass = 0
     results%n_it = 0
     allocate (results%entry (RESULTS_CHUNK_SIZE))
     allocate (results%average (RESULTS_CHUNK_SIZE))
   end subroutine integration_results_init
 
 @ %def integration_results_init
 @ Set verbose output of the integration results. In verbose mode, valid calls,
 negative as positive efficiency will be printed.
 <<Integration results: integration results: TBP>>=
   procedure :: set_verbosity => integration_results_set_verbosity
 <<Integration results: procedures>>=
   subroutine integration_results_set_verbosity (results, verbosity)
     class(integration_results_t), intent(inout) :: results
     integer, intent(in) :: verbosity
     results%verbosity = verbosity
   end subroutine integration_results_set_verbosity
 
 @ %def integration_results_set_verbose
 @ Set additional parameters: the [[error_threshold]] declares that any error
 value (in absolute numbers) smaller than this is to be considered zero.
 <<Integration results: integration results: TBP>>=
   procedure :: set_error_threshold => integration_results_set_error_threshold
 <<Integration results: procedures>>=
   subroutine integration_results_set_error_threshold (results, error_threshold)
     class(integration_results_t), intent(inout) :: results
     real(default), intent(in) :: error_threshold
     results%error_threshold = error_threshold
   end subroutine integration_results_set_error_threshold
 
 @ %def integration_results_set_error_threshold
 @ Output (ASCII format).  The [[verbose]] format is used for writing
 the header in grid files.
 <<Integration results: integration results: TBP>>=
   procedure :: write => integration_results_write
   procedure :: write_verbose => integration_results_write_verbose
 <<Integration results: procedures>>=
   subroutine integration_results_write (object, unit, suppress)
     class(integration_results_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: suppress
     logical :: verb
     integer :: u, n
     u = given_output_unit (unit);  if (u < 0)  return
     call object%write_dline (unit)
     if (object%n_it /= 0) then
        call object%write_header (unit, logfile = .false.)
        call object%write_dline (unit)
        do n = 1, object%n_it
           if (n > 1) then
              if (object%entry(n)%pass /= object%entry(n-1)%pass) then
                 call object%write_hline (unit)
                 call object%average(object%entry(n-1)%pass)%write ( &
                      & unit, suppress = suppress)
                 call object%write_hline (unit)
              end if
           end if
           call object%entry(n)%write (unit, &
                suppress = suppress)
        end do
        call object%write_hline(unit)
        call object%average(object%n_pass)%write (unit, suppress = suppress)
     else
        call msg_message ("[WHIZARD integration results: empty]", unit)
     end if
     call object%write_dline (unit)
     flush (u)
   end subroutine integration_results_write
 
   subroutine integration_results_write_verbose (object, unit)
     class(integration_results_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, n
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, *)  "begin(integration_results)"
     write (u, *)  "  n_pass = ", object%n_pass
     write (u, *)  "    n_it = ", object%n_it
     if (object%n_it > 0) then
        write (u, *)  "begin(integration_pass)"
        do n = 1, object%n_it
           if (n > 1) then
              if (object%entry(n)%pass /= object%entry(n-1)%pass) then
                 write (u, *)  "end(integration_pass)"
                 write (u, *)  "begin(integration_pass)"
              end if
           end if
           write (u, *)  "begin(iteration)"
           call object%entry(n)%write_verbose (unit)
           write (u, *)  "end(iteration)"
        end do
        write (u, *)  "end(integration_pass)"
     end if
     write (u, *)  "end(integration_results)"
     flush (u)
   end subroutine integration_results_write_verbose
 
 @ %def integration_results_write integration_results_verbose
 @ Write a concise table of chain weights, i.e., the channel history where
 channels are collected by chains.
 <<Integration results: integration results: TBP>>=
   procedure :: write_chain_weights => &
        integration_results_write_chain_weights
 <<Integration results: procedures>>=
   subroutine integration_results_write_chain_weights (results, unit)
     class(integration_results_t), intent(in) :: results
     integer, intent(in), optional :: unit
     integer :: u, i, n
     u = given_output_unit (unit);  if (u < 0)  return
     if (allocated (results%entry(1)%chain_weights) .and. results%n_it /= 0) then
        call msg_message ("Phase-space chain (grove) weight history: " &
             // "(numbers in %)", unit)
        write (u, "(A9)", advance="no")  "| chain |"
     do i = 1, integration_entry_get_n_groves (results%entry(1))
           write (u, "(1x,I3)", advance="no")  i
        end do
        write (u, *)
        call results%write_dline (unit)
        do n = 1, results%n_it
           if (n > 1) then
              if (results%entry(n)%pass /= results%entry(n-1)%pass) then
                 call results%write_hline (unit)
              end if
           end if
           write (u, "(1x,I6,1x,A1)", advance="no")  n, "|"
           call results%entry(n)%write_chain_weights (unit)
        end do
        flush (u)
        call results%write_dline(unit)
     end if
   end subroutine integration_results_write_chain_weights
 
 @ %def integration_results_write_chain_weights
 @ Read the list from file.  The file must be written using the
 [[verbose]] option of the writing routine.
 <<Integration results: integration results: TBP>>=
   procedure :: read => integration_results_read
 <<Integration results: procedures>>=
   subroutine integration_results_read (results, unit)
     class(integration_results_t), intent(out) :: results
     integer, intent(in) :: unit
     character(80) :: buffer
     character :: equals
     integer :: pass, it
     read (unit, *)  buffer
     if (trim (adjustl (buffer)) /= "begin(integration_results)") then
        call read_err ();  return
     end if
     read (unit, *)  buffer, equals, results%n_pass
     read (unit, *)  buffer, equals, results%n_it
     allocate (results%entry (results%n_it + RESULTS_CHUNK_SIZE))
     allocate (results%average (results%n_it + RESULTS_CHUNK_SIZE))
     it = 0
     do pass = 1, results%n_pass
        read (unit, *)  buffer
        if (trim (adjustl (buffer)) /= "begin(integration_pass)") then
           call read_err ();  return
        end if
        READ_ENTRIES: do
           read (unit, *)  buffer
           if (trim (adjustl (buffer)) /= "begin(iteration)") then
              exit READ_ENTRIES
           end if
           it = it + 1
           call results%entry(it)%read (unit)
           read (unit, *)  buffer
           if (trim (adjustl (buffer)) /= "end(iteration)") then
              call read_err (); return
           end if
        end do READ_ENTRIES
        if (trim (adjustl (buffer)) /= "end(integration_pass)") then
           call read_err (); return
        end if
        results%average(pass) = compute_average (results%entry, pass)
     end do
     read (unit, *)  buffer
     if (trim (adjustl (buffer)) /= "end(integration_results)") then
        call read_err (); return
     end if
   contains
     subroutine read_err ()
       call msg_fatal ("Reading integration results from file: syntax error")
     end subroutine read_err
   end subroutine integration_results_read
 
 @ %def integration_results_read
 @ Auxiliary output.
 <<Integration results: integration results: TBP>>=
   procedure, private :: write_header
   procedure, private :: write_hline
   procedure, private :: write_dline
 <<Integration results: procedures>>=
   subroutine write_header (results, unit, logfile)
     class(integration_results_t), intent(in) :: results
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: logfile
     character(5) :: phys_unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     select case (results%process_type)
     case (PRC_DECAY);      phys_unit = "[GeV]"
     case (PRC_SCATTERING); phys_unit = "[fb] "
     case default
        phys_unit = "    "
     end select
     write (msg_buffer, "(A, A)") &
          "It      Calls"
     if (results%verbosity > 1) then
        write (msg_buffer, "(A, A)") trim (msg_buffer), &
             "      Valid"
     end if
     write (msg_buffer, "(A, A)") trim (msg_buffer), &
          "  Integral" // phys_unit // &
          " Error" // phys_unit // &
          "  Err[%]    Acc  Eff[%]"
     if (results%verbosity > 2) then
        write (msg_buffer, "(A, A)") trim (msg_buffer), &
             "  (+)[%]  (-)[%]"
     end if
     write (msg_buffer, "(A, A)") trim (msg_buffer), &
          "   Chi2 N[It] |"
     call msg_message (unit=u, logfile=logfile)
   end subroutine write_header
 
   subroutine write_hline (results, unit)
     class(integration_results_t), intent(in) :: results
     integer, intent(in), optional :: unit
     integer :: u, len
     u = given_output_unit (unit);  if (u < 0)  return
     len = 77
     if (results%verbosity > 1) len = len + 11
     if (results%verbosity > 2) len = len + 16
     write (u, "(A)")  "|" // (repeat ("-", len)) // "|"
     flush (u)
   end subroutine write_hline
 
   subroutine write_dline (results, unit)
     class(integration_results_t), intent(in) :: results
     integer, intent(in), optional :: unit
     integer :: u, len
     u = given_output_unit (unit);  if (u < 0)  return
     len = 77
     if (results%verbosity > 1) len = len + 11
     if (results%verbosity > 2) len = len + 16
     write (u, "(A)")  "|" // (repeat ("=", len)) // "|"
     flush (u)
   end subroutine write_dline
 
 @ %def write_header write_hline write_dline
 @ During integration, we do not want to print all results at once, but
 each intermediate result as soon as we get it.  Thus, the previous procedure
 is chopped in pieces.  First piece: store the
 output unit and a flag whether we want to print to standard output as
 well.  Then write the header if the results are still empty, i.e.,
 before integration has started.  The second piece writes a single
 result to the saved output channels.  We call this from the [[record]]
 method, which can be called from the integrator directly.  The third
 piece writes the average result, once a pass has been completed.  The
 fourth piece writes a footer (if any), assuming that this is the final result.
 <<Integration results: integration results: TBP>>=
   procedure :: display_init => integration_results_display_init
   procedure :: display_current => integration_results_display_current
   procedure :: display_pass => integration_results_display_pass
   procedure :: display_final => integration_results_display_final
 <<Integration results: procedures>>=
   subroutine integration_results_display_init &
        (results, screen, unit)
     class(integration_results_t), intent(inout) :: results
     logical, intent(in) :: screen
     integer, intent(in), optional :: unit
     integer :: u
     if (present (unit))  results%unit = unit
     u = given_output_unit ()
     results%screen = screen
     if (results%n_it == 0) then
        if (results%screen) then
           call results%write_dline (u)
           call results%write_header (u, &
                logfile=.false.)
           call results%write_dline (u)
        end if
        if (results%unit /= 0) then
           call results%write_dline (results%unit)
           call results%write_header (results%unit, &
                logfile=.false.)
           call results%write_dline (results%unit)
        end if
     else
        if (results%screen) then
           call results%write_hline (u)
        end if
        if (results%unit /= 0) then
           call results%write_hline (results%unit)
        end if
     end if
   end subroutine integration_results_display_init
 
   subroutine integration_results_display_current (results, pacify)
     class(integration_results_t), intent(in) :: results
     integer :: u
     logical, intent(in), optional :: pacify
     u = given_output_unit ()
     if (results%screen) then
        call results%entry(results%n_it)%write (u, &
             verbosity = results%verbosity, suppress = pacify)
     end if
     if (results%unit /= 0) then
        call results%entry(results%n_it)%write ( &
             results%unit, verbosity = results%verbosity, suppress = pacify)
     end if
   end subroutine integration_results_display_current
 
   subroutine integration_results_display_pass (results, pacify)
     class(integration_results_t), intent(in) :: results
     logical, intent(in), optional :: pacify
     integer :: u
     u = given_output_unit ()
     if (results%screen) then
        call results%write_hline (u)
        call results%average(results%entry(results%n_it)%pass)%write ( &
                 u, verbosity = results%verbosity, suppress = pacify)
     end if
     if (results%unit /= 0) then
        call results%write_hline (results%unit)
        call results%average(results%entry(results%n_it)%pass)%write ( &
                 results%unit, verbosity = results%verbosity, suppress = pacify)
     end if
   end subroutine integration_results_display_pass
 
   subroutine integration_results_display_final (results)
     class(integration_results_t), intent(inout) :: results
     integer :: u
     u = given_output_unit ()
     if (results%screen) then
        call results%write_dline (u)
     end if
     if (results%unit /= 0) then
        call results%write_dline (results%unit)
     end if
     results%screen = .false.
     results%unit = 0
   end subroutine integration_results_display_final
 
 @ %def integration_results_display_init
 @ %def integration_results_display_current
 @ %def integration_results_display_pass
 @ Expand the list of entries if the limit has been reached:
 <<Integration results: integration results: TBP>>=
   procedure :: expand => integration_results_expand
 <<Integration results: procedures>>=
   subroutine integration_results_expand (results)
     class(integration_results_t), intent(inout) :: results
     type(integration_entry_t), dimension(:), allocatable :: entry_tmp
     if (results%n_it == size (results%entry)) then
        allocate (entry_tmp (results%n_it))
        entry_tmp = results%entry
        deallocate (results%entry)
        allocate (results%entry (results%n_it + RESULTS_CHUNK_SIZE))
        results%entry(:results%n_it) = entry_tmp
        deallocate (entry_tmp)
     end if
     if (results%n_pass == size (results%average)) then
        allocate (entry_tmp (results%n_pass))
        entry_tmp = results%average
        deallocate (results%average)
        allocate (results%average (results%n_it + RESULTS_CHUNK_SIZE))
        results%average(:results%n_pass) = entry_tmp
        deallocate (entry_tmp)
     end if
   end subroutine integration_results_expand
 
 @ %def integration_results_expand
 @ Increment the [[current_pass]] counter. Must be done before each new
 integration pass; after integration, the recording method may use the value of
 this counter to define the entry.
 <<Integration results: integration results: TBP>>=
   procedure :: new_pass => integration_results_new_pass
 <<Integration results: procedures>>=
   subroutine integration_results_new_pass (results)
     class(integration_results_t), intent(inout) :: results
     results%current_pass = results%current_pass + 1
   end subroutine integration_results_new_pass
 
 @ %def integration_results_new_pass
 @ Enter results into the results list.  For the error value, we may compare
 them with a given threshold.  This guards against numerical noise, if the
 exact error would be zero.
 <<Integration results: integration results: TBP>>=
   procedure :: append => integration_results_append
 <<Integration results: procedures>>=
   subroutine integration_results_append (results, &
        n_it, n_calls, n_calls_valid, &
        integral, error, efficiency, efficiency_pos, efficiency_neg, &
        chain_weights)
     class(integration_results_t), intent(inout) :: results
     integer, intent(in) :: n_it, n_calls, n_calls_valid
     real(default), intent(in) :: integral, error, efficiency, efficiency_pos, &
          & efficiency_neg
     real(default), dimension(:), intent(in), optional :: chain_weights
     logical :: improved
     type(integration_entry_t) :: entry
     real(default) :: err_checked
     improved = .true.
     if (results%n_it /= 0) improved = abs(accuracy (integral, error, n_calls)) &
             < abs(results%entry(results%n_it)%get_accuracy ())
     err_checked = 0
     if (abs (error) >= results%error_threshold) err_checked = error
     entry = integration_entry_t ( &
          results%process_type, results%current_pass, &
          results%n_it+1, n_it, n_calls, n_calls_valid, improved, &
          integral, err_checked, efficiency, efficiency_pos, efficiency_neg, &
          chain_weights=chain_weights)
     if (results%n_it == 0) then
        results%n_it = 1
        results%n_pass = 1
     else
        call results%expand ()
        if (entry%pass /= results%entry(results%n_it)%pass) &
             results%n_pass = results%n_pass + 1
        results%n_it = results%n_it + 1
     end if
     results%entry(results%n_it) = entry
     results%average(results%n_pass) = &
          compute_average (results%entry, entry%pass)
   end subroutine integration_results_append
 
 @ %def integration_results_append
 @ Record an integration pass executed by an [[mci]] integrator
 object.
 
 There is a tolerance below we treat an error (relative to the
 integral) as zero.
 <<Integration results: parameters>>=
   real(default), parameter, public :: INTEGRATION_ERROR_TOLERANCE = 1e-10
 @ %def INTEGRATION_ERROR_TOLERANCE
 @
 <<Integration results: integration results: TBP>>=
   procedure :: record_simple => integration_results_record_simple
 <<Integration results: procedures>>=
   subroutine integration_results_record_simple &
        (object, n_it, n_calls, integral, error, efficiency, &
         chain_weights, suppress)
     class(integration_results_t), intent(inout) :: object
     integer, intent(in) :: n_it, n_calls
     real(default), intent(in) :: integral, error, efficiency
     real(default), dimension(:), intent(in), optional :: chain_weights
     real(default) :: err
     logical, intent(in), optional :: suppress
     err = 0._default
     if (abs (error) >= abs (integral) * INTEGRATION_ERROR_TOLERANCE) then
        err = error
     end if
     call object%append (n_it, n_calls, 0, integral, err, efficiency, 0._default,&
          & 0._default, chain_weights)
     call object%display_current (suppress)
   end subroutine integration_results_record_simple
 
 @ %def integration_results_record_simple
 @ Record extended results from integration pass.
 <<Integration results: integration results: TBP>>=
   procedure :: record_extended => integration_results_record_extended
 <<Integration results: procedures>>=
   subroutine integration_results_record_extended (object, n_it, n_calls,&
        & n_calls_valid, integral, error, efficiency, efficiency_pos,&
        & efficiency_neg, chain_weights, suppress)
     class(integration_results_t), intent(inout) :: object
     integer, intent(in) :: n_it, n_calls, n_calls_valid
     real(default), intent(in) :: integral, error, efficiency, efficiency_pos,&
          & efficiency_neg
     real(default), dimension(:), intent(in), optional :: chain_weights
     real(default) :: err
     logical, intent(in), optional :: suppress
     err = 0._default
     if (abs (error) >= abs (integral) * INTEGRATION_ERROR_TOLERANCE) then
        err = error
     end if
     call object%append (n_it, n_calls, n_calls_valid, integral, err, efficiency,&
          & efficiency_pos, efficiency_neg, chain_weights)
     call object%display_current (suppress)
   end subroutine integration_results_record_extended
 
 @ %def integration_results_record_extended
 @ Compute the average for all entries in the specified integration
 pass.  The integrals are weighted w.r.t.\ their individual errors.
 
 The quoted error of the result is the expected error, computed from
 the weighted average of the given individual errors.
 
 This should be compared to the actual distribution of the results,
 from which we also can compute an error estimate if there is more than
 one iteration.  The ratio of the distribution error and the averaged
 error, is the $\chi^2$ value.
 
 All error distributions are assumed Gaussian, of course.  The $\chi^2$
 value is a partial check for this assumption.  If it is significantly
 greater than unity, there is something wrong with the individual errors.
 
 The efficiency returned is the one of the last entry in the
 integration pass.
 
 If any error vanishes, averaging by this algorithm would fail.  In this case,
 we simply average the entries and use the deviations from this average (if
 any) to estimate the error.
 <<Integration results: procedures>>=
   type(integration_entry_t) function compute_average (entry, pass) &
        & result (result)
     type(integration_entry_t), dimension(:), intent(in) :: entry
     integer, intent(in) :: pass
     integer :: i
     logical, dimension(size(entry)) :: mask
     real(default), dimension(size(entry)) :: ivar
     real(default) :: sum_ivar, variance
     result%process_type = entry(1)%process_type
     result%pass = pass
     mask = entry%pass == pass .and. entry%process_type /= PRC_UNKNOWN
     result%it = maxval (entry%it, mask)
     result%n_it = count (mask)
     result%n_calls = sum (entry%n_calls, mask)
     result%n_calls_valid = sum (entry%n_calls_valid, mask)
     if (.not. any (mask .and. entry%error == 0)) then
        where (mask)
           ivar = 1 / entry%error ** 2
        elsewhere
           ivar = 0
        end where
        sum_ivar = sum (ivar, mask)
        variance = 0
        if (sum_ivar /= 0) then
           variance = 1 / sum_ivar
        end if
        result%integral = sum (entry%integral * ivar, mask) * variance
        if (result%n_it > 1) then
           result%chi2 = &
                sum ((entry%integral - result%integral)**2 * ivar, mask) &
                / (result%n_it - 1)
        end if
     else if (result%n_it /= 0) then
        result%integral = sum (entry%integral, mask) / result%n_it
        variance = 0
        if (result%n_it > 1) then
           variance = &
                sum ((entry%integral - result%integral)**2, mask) &
                / (result%n_it - 1)
           if (result%integral /= 0) then
              if (abs (variance / result%integral) &
                   < 100 * epsilon (1._default)) then
                 variance = 0
              end if
           end if
        end if
        result%chi2 = variance / result%n_it
     end if
     result%error = sqrt (variance)
     result%efficiency = entry(last_index (mask))%efficiency
     result%efficiency_pos = entry(last_index (mask))%efficiency_pos
     result%efficiency_neg = entry(last_index (mask))%efficiency_neg
   contains
     integer function last_index (mask) result (index)
       logical, dimension(:), intent(in) :: mask
       integer :: i
       do i = size (mask), 1, -1
          if (mask(i)) exit
       end do
       index = i
     end function last_index
   end function compute_average
 
 @ %def compute_average
 @
 \subsection{Access results}
 Return true if the results object has entries.
 <<Integration results: integration results: TBP>>=
   procedure :: exist => integration_results_exist
 <<Integration results: procedures>>=
   function integration_results_exist (results) result (flag)
     logical :: flag
     class(integration_results_t), intent(in) :: results
     flag = results%n_pass > 0
   end function integration_results_exist
 
 @ %def integration_results_exist
 @ Retrieve information from the results record.  If [[last]] is set and
 true, take the last iteration.  If [[it]] is set instead, take this
 iteration.  If [[pass]] is set, take this average.  If none is set,
 take the final average.
 
 If the result would be invalid, the entry is not assigned.  Due to
 default initialization, this returns a null entry.
 <<Integration results: integration results: TBP>>=
   procedure :: get_entry => results_get_entry
 <<Integration results: procedures>>=
   function results_get_entry (results, last, it, pass) result (entry)
     class(integration_results_t), intent(in) :: results
     type(integration_entry_t) :: entry
     logical, intent(in), optional :: last
     integer, intent(in), optional :: it, pass
     if (present (last)) then
        if (allocated (results%entry) .and. results%n_it > 0) then
           entry = results%entry(results%n_it)
        else
           call error ()
        end if
     else if (present (it)) then
        if (allocated (results%entry) .and. it > 0 .and. it <= results%n_it) then
           entry = results%entry(it)
        else
           call error ()
        end if
     else if (present (pass)) then
        if (allocated (results%average) &
             .and. pass > 0 .and. pass <= results%n_pass) then
           entry = results%average (pass)
        else
           call error ()
        end if
     else
        if (allocated (results%average) .and. results%n_pass > 0) then
           entry = results%average (results%n_pass)
        else
           call error ()
        end if
     end if
   contains
     subroutine error ()
       call msg_fatal ("Requested integration result is not available")
     end subroutine error
   end function results_get_entry
 
 @ %def results_get_entry
 @ The individual procedures.  The [[results]] record should have the
 [[target]] attribute, but only locally within the function.
 <<Integration results: integration results: TBP>>=
   procedure :: get_n_calls => integration_results_get_n_calls
   procedure :: get_integral => integration_results_get_integral
   procedure :: get_error => integration_results_get_error
   procedure :: get_accuracy => integration_results_get_accuracy
   procedure :: get_chi2 => integration_results_get_chi2
   procedure :: get_efficiency => integration_results_get_efficiency
 <<Integration results: procedures>>=
   function integration_results_get_n_calls (results, last, it, pass) &
        result (n_calls)
     class(integration_results_t), intent(in), target :: results
     integer :: n_calls
     logical, intent(in), optional :: last
     integer, intent(in), optional :: it, pass
     type(integration_entry_t) :: entry
     entry = results%get_entry (last, it, pass)
     n_calls = entry%get_n_calls ()
   end function integration_results_get_n_calls
 
   function integration_results_get_integral (results, last, it, pass) &
        result (integral)
     class(integration_results_t), intent(in), target :: results
     real(default) :: integral
     logical, intent(in), optional :: last
     integer, intent(in), optional :: it, pass
     type(integration_entry_t) :: entry
     entry = results%get_entry (last, it, pass)
     integral = entry%get_integral ()
   end function integration_results_get_integral
 
   function integration_results_get_error (results, last, it, pass) &
        result (error)
     class(integration_results_t), intent(in), target :: results
     real(default) :: error
     logical, intent(in), optional :: last
     integer, intent(in), optional :: it, pass
     type(integration_entry_t) :: entry
     entry = results%get_entry (last, it, pass)
     error = entry%get_error ()
   end function integration_results_get_error
 
   function integration_results_get_accuracy (results, last, it, pass) &
        result (accuracy)
     class(integration_results_t), intent(in), target :: results
     real(default) :: accuracy
     logical, intent(in), optional :: last
     integer, intent(in), optional :: it, pass
     type(integration_entry_t) :: entry
     entry = results%get_entry (last, it, pass)
     accuracy = entry%get_accuracy ()
   end function integration_results_get_accuracy
 
   function integration_results_get_chi2 (results, last, it, pass) &
        result (chi2)
     class(integration_results_t), intent(in), target :: results
     real(default) :: chi2
     logical, intent(in), optional :: last
     integer, intent(in), optional :: it, pass
     type(integration_entry_t) :: entry
     entry = results%get_entry (last, it, pass)
     chi2 = entry%get_chi2 ()
   end function integration_results_get_chi2
 
   function integration_results_get_efficiency (results, last, it, pass) &
        result (efficiency)
     class(integration_results_t), intent(in), target :: results
     real(default) :: efficiency
     logical, intent(in), optional :: last
     integer, intent(in), optional :: it, pass
     type(integration_entry_t) :: entry
     entry = results%get_entry (last, it, pass)
     efficiency = entry%get_efficiency ()
   end function integration_results_get_efficiency
 
 @ %def integration_results_get_n_calls
 @ %def integration_results_get_integral
 @ %def integration_results_get_error
 @ %def integration_results_get_accuracy
 @ %def integration_results_get_chi2
 @ %def integration_results_get_efficiency
 @ Return the last pass index and the index of the last iteration
 \emph{within} the last pass.  The third routine returns the absolute
 index of the last iteration.
 <<Integration results: procedures>>=
   function integration_results_get_current_pass (results) result (pass)
     integer :: pass
     type(integration_results_t), intent(in) :: results
     pass = results%n_pass
   end function integration_results_get_current_pass
 
   function integration_results_get_current_it (results) result (it)
     integer :: it
     type(integration_results_t), intent(in) :: results
     it = 0
     if (allocated (results%entry)) then
        it = count (results%entry(1:results%n_it)%pass == results%n_pass)
     end if
   end function integration_results_get_current_it
 
   function integration_results_get_last_it (results) result (it)
     integer :: it
     type(integration_results_t), intent(in) :: results
     it = results%n_it
   end function integration_results_get_last_it
 
 @ %def integration_results_get_current_pass
 @ %def integration_results_get_current_it
 @ %def integration_results_get_last_it
 @ Return the index of the best iteration (lowest accuracy value)
 within the current pass.  If none qualifies, return zero.
 <<Integration results: procedures>>=
   function integration_results_get_best_it (results) result (it)
     integer :: it
     type(integration_results_t), intent(in) :: results
     integer :: i
     real(default) :: acc, acc_best
     acc_best = -1
     it = 0
     do i = 1, results%n_it
        if (results%entry(i)%pass == results%n_pass) then
           acc = integration_entry_get_accuracy (results%entry(i))
           if (acc_best < 0 .or. acc <= acc_best) then
              acc_best = acc
              it = i
           end if
        end if
     end do
   end function integration_results_get_best_it
 
 @ %def integration_results_get_best_it
 @ Compute the MD5 sum by printing everything and checksumming the
 resulting file.
 <<Integration results: procedures>>=
   function integration_results_get_md5sum (results) result (md5sum_results)
     character(32) :: md5sum_results
     type(integration_results_t), intent(in) :: results
     integer :: u
     u = free_unit ()
     open (unit = u, status = "scratch", action = "readwrite")
     call results%write_verbose (u)
     rewind (u)
     md5sum_results = md5sum (u)
     close (u)
   end function integration_results_get_md5sum
 
 @ %def integration_results_get_md5sum
 @
 This is (ab)used to suppress numerical noise when integrating constant
 matrix elements.
 <<Integration results: integration results: TBP>>=
   procedure :: pacify => integration_results_pacify
 <<Integration results: procedures>>=
   subroutine integration_results_pacify (results, efficiency_reset)
     class(integration_results_t), intent(inout) :: results
     logical, intent(in), optional :: efficiency_reset
     integer :: i
     logical :: reset
     reset = .false.
     if (present (efficiency_reset))  reset = efficiency_reset
     if (allocated (results%entry)) then
        do i = 1, size (results%entry)
           call pacify (results%entry(i)%error, &
                results%entry(i)%integral * 1.E-9_default)
           if (reset)  results%entry(i)%efficiency = 1
        end do
     end if
     if (allocated (results%average)) then
        do i = 1, size (results%average)
           call pacify (results%average(i)%error, &
                results%average(i)%integral * 1.E-9_default)
           if (reset)  results%average(i)%efficiency = 1
        end do
     end if
   end subroutine integration_results_pacify
 
 @ %def integration_results_pacify
 @
 <<Integration results: integration results: TBP>>=
   procedure :: record_correction => integration_results_record_correction
 <<Integration results: procedures>>=
   subroutine integration_results_record_correction (object, corr, err)
     class(integration_results_t), intent(inout) :: object
     real(default), intent(in) :: corr, err
     integer :: u
     u = given_output_unit ()
     if (object%screen) then
       call object%write_hline (u)
       call msg_message ("NLO Correction: [O(alpha_s+1)/O(alpha_s)]")
       write(msg_buffer,'(1X,A1,F8.4,A4,F9.5,1X,A3)') '(', corr, ' +- ', err, ') %'
       call msg_message ()
     end if
   end subroutine integration_results_record_correction
 
 @ %def integration_results_record_correction
 @
 \subsection{Results display}
 Write a driver file for history visualization.
 
 The ratio of $y$ range over $y$ value must not become too small, otherwise
 we run into an arithmetic overflow in GAMELAN.  2\% appears to be safe.
 <<Integration results: parameters>>=
   real, parameter, public :: GML_MIN_RANGE_RATIO = 0.02
 <<Integration results: public>>=
   public :: integration_results_write_driver
 <<Integration results: procedures>>=
   subroutine integration_results_write_driver (results, filename, eff_reset)
     type(integration_results_t), intent(inout) :: results
     type(string_t), intent(in) :: filename
     logical, intent(in), optional :: eff_reset
     type(string_t) :: file_tex
     integer :: unit
     integer :: n, i, n_pass, pass
     integer, dimension(:), allocatable :: ipass
     real(default) :: ymin, ymax, yavg, ydif, y0, y1
     real(default), dimension(results%n_it) :: ymin_arr, ymax_arr
     logical :: reset
     file_tex = filename // ".tex"
     unit = free_unit ()
     open (unit=unit, file=char(file_tex), action="write", status="replace")
     reset = .false.; if (present (eff_reset))  reset = eff_reset
     n = results%n_it
     n_pass = results%n_pass
     allocate (ipass (results%n_pass))
     ipass(1) = 0
     pass = 2
     do i = 1, n-1
        if (integration_entry_get_pass (results%entry(i)) &
            /= integration_entry_get_pass (results%entry(i+1))) then
           ipass(pass) = i
           pass = pass + 1
        end if
     end do
     ymin_arr = integration_entry_get_integral (results%entry(:n)) &
                    - integration_entry_get_error (results%entry(:n))
     ymin = minval (ymin_arr)
     ymax_arr = integration_entry_get_integral (results%entry(:n)) &
                    + integration_entry_get_error (results%entry(:n))
     ymax = maxval (ymax_arr)
     yavg = (ymax + ymin) / 2
     ydif = (ymax - ymin)
     if (ydif * 1.5 > GML_MIN_RANGE_RATIO * yavg) then
        y0 = yavg - ydif * 0.75
        y1 = yavg + ydif * 0.75
     else
        y0 = yavg * (1 - GML_MIN_RANGE_RATIO / 2)
        y1 = yavg * (1 + GML_MIN_RANGE_RATIO / 2)
     end if
     write (unit, "(A)") "\documentclass{article}"
     write (unit, "(A)") "\usepackage{a4wide}"
     write (unit, "(A)") "\usepackage{gamelan}"
     write (unit, "(A)") "\usepackage{amsmath}"
     write (unit, "(A)") ""
     write (unit, "(A)") "\begin{document}"
     write (unit, "(A)") "\begin{gmlfile}"
     write (unit, "(A)") "\section*{Integration Results Display}"
     write (unit, "(A)") ""
     write (unit, "(A)") "Process: \verb|" // char (filename) // "|"
     write (unit, "(A)") ""
     write (unit, "(A)") "\vspace*{2\baselineskip}"
     write (unit, "(A)") "\unitlength 1mm"
     write (unit, "(A)") "\begin{gmlcode}"
     write (unit, "(A)") "  picture sym;  sym = fshape (circle scaled 1mm)();"
     write (unit, "(A)") "  color col.band;  col.band = 0.9white;"
     write (unit, "(A)") "  color col.eband;  col.eband = 0.98white;"
     write (unit, "(A)") "\end{gmlcode}"
     write (unit, "(A)") "\begin{gmlgraph*}(130,180)[history]"
     write (unit, "(A)") "  setup (linear, linear);"
     write (unit, "(A,I0,A)") "  history.n_pass = ", n_pass, ";"
     write (unit, "(A,I0,A)") "  history.n_it   = ", n, ";"
     write (unit, "(A,A,A)")  "  history.y0 = #""", char (mp_format (y0)), """;"
     write (unit, "(A,A,A)")  "  history.y1 = #""", char (mp_format (y1)), """;"
     write (unit, "(A)") &
          "  graphrange (#0.5, history.y0), (#(n+0.5), history.y1);"
     do pass = 1, n_pass
        write (unit, "(A,I0,A,I0,A)") &
             "  history.pass[", pass, "] = ", ipass(pass), ";"
        write (unit, "(A,I0,A,A,A)") &
             "  history.avg[", pass, "] = #""", &
             char (mp_format &
                (integration_entry_get_integral (results%average(pass)))), &
             """;"
        write (unit, "(A,I0,A,A,A)") &
             "  history.err[", pass, "] = #""", &
             char (mp_format &
                (integration_entry_get_error (results%average(pass)))), &
             """;"
        write (unit, "(A,I0,A,A,A)") &
             "  history.chi[", pass, "] = #""", &
             char (mp_format &
                (integration_entry_get_chi2 (results%average(pass)))), &
             """;"
     end do
     write (unit, "(A,I0,A,I0,A)") &
          "  history.pass[", n_pass + 1, "] = ", n, ";"
     write (unit, "(A)")  "  for i = 1 upto history.n_pass:"
     write (unit, "(A)")  "    if history.chi[i] greater one:"
     write (unit, "(A)")  "    fill plot ("
     write (unit, "(A)")  &
          "      (#(history.pass[i]  +.5), " &
          // "history.avg[i] minus history.err[i] times history.chi[i]),"
     write (unit, "(A)")  &
          "      (#(history.pass[i+1]+.5), " &
          // "history.avg[i] minus history.err[i] times history.chi[i]),"
     write (unit, "(A)")  &
          "      (#(history.pass[i+1]+.5), " &
          // "history.avg[i] plus history.err[i] times history.chi[i]),"
     write (unit, "(A)")  &
          "      (#(history.pass[i]  +.5), " &
          // "history.avg[i] plus history.err[i] times history.chi[i])"
     write (unit, "(A)")  "    ) withcolor col.eband fi;"
     write (unit, "(A)")  "    fill plot ("
     write (unit, "(A)")  &
          "      (#(history.pass[i]  +.5), history.avg[i] minus history.err[i]),"
     write (unit, "(A)")  &
          "      (#(history.pass[i+1]+.5), history.avg[i] minus history.err[i]),"
     write (unit, "(A)")  &
          "      (#(history.pass[i+1]+.5), history.avg[i] plus history.err[i]),"
     write (unit, "(A)")  &
          "      (#(history.pass[i]  +.5), history.avg[i] plus history.err[i])"
     write (unit, "(A)")  "    ) withcolor col.band;"
     write (unit, "(A)")  "    draw plot ("
     write (unit, "(A)")  &
          "      (#(history.pass[i]  +.5), history.avg[i]),"
     write (unit, "(A)")  &
          "      (#(history.pass[i+1]+.5), history.avg[i])"
     write (unit, "(A)")  "      ) dashed evenly;"
     write (unit, "(A)")  "  endfor"
     write (unit, "(A)")  "  for i = 1 upto history.n_pass + 1:"
     write (unit, "(A)")  "    draw plot ("
     write (unit, "(A)")  &
          "      (#(history.pass[i]+.5), history.y0),"
     write (unit, "(A)")  &
          "      (#(history.pass[i]+.5), history.y1)"
     write (unit, "(A)")  "      ) dashed withdots;"
     write (unit, "(A)")  "  endfor"
     do i = 1, n
        write (unit, "(A,I0,A,A,A,A,A)") "  plot (history) (#", &
           i, ", #""", &
     char (mp_format (integration_entry_get_integral (results%entry(i)))),&
           """) vbar #""", &
           char (mp_format (integration_entry_get_error (results%entry(i)))), &
           """;"
     end do
     write (unit, "(A)") "  draw piecewise from (history) " &
       // "withsymbol sym;"
     write (unit, "(A)") "  fullgrid.lr (5,20);"
     write (unit, "(A)") "  standardgrid.bt (n);"
     write (unit, "(A)")  "  begingmleps ""Whizard-Logo.eps"";"
     write (unit, "(A)")  "    base := (120*unitlength,170*unitlength);"
     write (unit, "(A)")  "    height := 9.6*unitlength;"
     write (unit, "(A)")  "    width := 11.2*unitlength;"
     write (unit, "(A)")  "  endgmleps;"
     write (unit, "(A)") "\end{gmlgraph*}"
     write (unit, "(A)") "\end{gmlfile}"
     write (unit, "(A)") "\clearpage"
     write (unit, "(A)") "\begin{verbatim}"
     if (reset) then
       call results%pacify (reset)
     end if
     call integration_results_write (results, unit)
     write (unit, "(A)") "\end{verbatim}"
     write (unit, "(A)") "\end{document}"
     close (unit)
   end subroutine integration_results_write_driver
 
 @ %def integration_results_write_driver
 @ Call \LaTeX\ and Metapost for the history driver file, and convert to PS and
 PDF.
 <<Integration results: public>>=
   public :: integration_results_compile_driver
 <<Integration results: procedures>>=
   subroutine integration_results_compile_driver (results, filename, os_data)
     type(integration_results_t), intent(in) :: results
     type(string_t), intent(in) :: filename
     type(os_data_t), intent(in) :: os_data
     integer :: unit_dev, status
     type(string_t) :: file_tex, file_dvi, file_ps, file_pdf, file_mp
     type(string_t) :: setenv_tex, setenv_mp, pipe, pipe_dvi
     if (.not. os_data%event_analysis) then
        call msg_warning ("Skipping integration history display " &
            // "because latex or mpost is not available")
        return
     end if
     file_tex = filename // ".tex"
     file_dvi = filename // ".dvi"
     file_ps = filename // ".ps"
     file_pdf = filename // ".pdf"
     file_mp = filename // ".mp"
     call msg_message ("Creating integration history display "&
          // char (file_ps) // " and " // char (file_pdf))
     BLOCK: do
        unit_dev = free_unit ()
        open (file = "/dev/null", unit = unit_dev, &
               action = "write", iostat = status)
        if (status /= 0) then
           pipe = ""
           pipe_dvi = ""
        else
           pipe = " > /dev/null"
           pipe_dvi = " 2>/dev/null 1>/dev/null"
        end if
        close (unit_dev)
        if (os_data%whizard_texpath /= "") then
           setenv_tex = &
                "TEXINPUTS=" // os_data%whizard_texpath // ":$TEXINPUTS "
           setenv_mp = &
                "MPINPUTS=" // os_data%whizard_texpath // ":$MPINPUTS "
        else
           setenv_tex = ""
           setenv_mp = ""
        end if
        call os_system_call (setenv_tex // os_data%latex // " " // &
             file_tex // pipe, status)
        if (status /= 0)  exit BLOCK
        if (os_data%gml /= "") then
           call os_system_call (setenv_mp // os_data%gml // " " // &
                file_mp // pipe, status)
        else
           call msg_error ("Could not use GAMELAN/MetaPOST.")
           exit BLOCK
        end if
        if (status /= 0)  exit BLOCK
        call os_system_call (setenv_tex // os_data%latex // " " // &
              file_tex // pipe, status)
        if (status /= 0)  exit BLOCK
        if (os_data%event_analysis_ps) then
           call os_system_call (os_data%dvips // " " // &
              file_dvi // pipe_dvi, status)
           if (status /= 0)  exit BLOCK
        else
           call msg_warning ("Skipping PostScript generation because dvips " &
                // "is not available")
           exit BLOCK
        end if
        if (os_data%event_analysis_pdf) then
           call os_system_call (os_data%ps2pdf // " " // &
                   file_ps, status)
           if (status /= 0)  exit BLOCK
        else
           call msg_warning ("Skipping PDF generation because ps2pdf " &
                // "is not available")
           exit BLOCK
        end if
        exit BLOCK
     end do BLOCK
     if (status /= 0) then
        call msg_error ("Unable to compile integration history display")
     end if
   end subroutine integration_results_compile_driver
 
 @ %def integration_results_compile_driver
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[integration_results_ut.f90]]>>=
 <<File header>>
 
 module integration_results_ut
   use unit_tests
   use integration_results_uti
 
 <<Standard module head>>
 
 <<integration results: public test>>
 
 contains
 
 <<integration results: test driver>>
 
 end module integration_results_ut
 @ %def integration_results_ut
 @
 <<[[integration_results_uti.f90]]>>=
 <<File header>>
 
 module integration_results_uti
 
 <<Use kinds>>
 
   use integration_results
 
 <<Standard module head>>
 
 <<integration results: test declarations>>
 
 contains
 
 <<integration results: tests>>
 
 end module integration_results_uti
 @ %def integration_results_ut
 @ API: driver for the unit tests below.
 <<integration results: public test>>=
   public :: integration_results_test
 <<integration results: test driver>>=
   subroutine integration_results_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
     <<integration results: execute tests>>
   end subroutine integration_results_test
 
 @ %def integration_results_test
 @
 \subsubsection{Integration entry}
 <<integration results: execute tests>>=
   call test (integration_results_1, "integration_results_1", &
        "record single line and write to log", &
        u, results)
 <<integration results: test declarations>>=
   public :: integration_results_1
 <<integration results: tests>>=
   subroutine integration_results_1 (u)
     integer, intent(in) :: u
     type(integration_entry_t) :: entry
 
     write (u, "(A)")  "* Test output: integration_results_1"
     write (u, "(A)")  "*   Purpose: record single entry and write to log"
     write (u, "(A)")
 
     write (u, "(A)")  "* Write single line output"
     write (u, "(A)")
 
     entry = integration_entry_t ( &
          & process_type = 1, &
          & pass = 1, &
          & it = 1, &
          & n_it = 10, &
          & n_calls = 1000, &
          & n_calls_valid = 500, &
          & improved = .true., &
          & integral = 1.0_default, &
          & error = 0.5_default, &
          & efficiency = 0.25_default, &
          & efficiency_pos = 0.22_default, &
          & efficiency_neg = 0.03_default)
     call entry%write (u, 3)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integration_results_1"
 
   end subroutine integration_results_1
 
 @ %def integration_results_1
 @
 <<integration results: execute tests>>=
   call test (integration_results_2, "integration_results_2", &
        "record single result and write to log", &
        u, results)
 <<integration results: test declarations>>=
   public :: integration_results_2
 <<integration results: tests>>=
   subroutine integration_results_2 (u)
     integer, intent(in) :: u
     type(integration_results_t) :: results
 
     write (u, "(A)")  "* Test output: integration_results_2"
     write (u, "(A)")  "*   Purpose: record single result and write to log"
     write (u, "(A)")
 
     write (u, "(A)")  "* Write single line output"
     write (u, "(A)")
 
     call results%init (PRC_DECAY)
     call results%append (1, 250, 0, 1.0_default, 0.5_default, 0.25_default,&
          & 0._default, 0._default)
 
     call results%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integration_results_2"
 
   end subroutine integration_results_2
 
 @ %def integration_results_2
 @
 <<integration results: execute tests>>=
   call test (integration_results_3, "integration_results_3", &
        "initialize display and add/display each entry", &
        u, results)
 <<integration results: test declarations>>=
   public :: integration_results_3
 <<integration results: tests>>=
   subroutine integration_results_3 (u)
     integer, intent(in) :: u
     type(integration_results_t) :: results
 
     write (u, "(A)")  "* Test output: integration_results_2"
     write (u, "(A)")  "*   Purpose: intialize display, record three entries,&
          & display pass average and finalize display"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize display and add entry"
     write (u, "(A)")
 
     call results%init (PRC_DECAY)
     call results%set_verbosity (1)
     call results%display_init (screen = .false., unit = u)
     call results%new_pass ()
 
     call results%record (1, 250, 1.0_default, 0.5_default, 0.25_default)
     call results%record (1, 250, 1.1_default, 0.5_default, 0.25_default)
     call results%record (1, 250, 0.9_default, 0.5_default, 0.25_default)
 
     write (u, "(A)")
     write (u, "(A)")  "* Display pass"
     write (u, "(A)")
 
     call results%display_pass ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Finalize displays"
     write (u, "(A)")
 
     call results%display_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integration_results_3"
 
   end subroutine integration_results_3
 
 @ %def integration_results_3
 @
 <<integration results: execute tests>>=
   call test (integration_results_4, "integration_results_4", &
        "record extended results and display", &
        u, results)
 <<integration results: test declarations>>=
   public :: integration_results_4
 <<integration results: tests>>=
   subroutine integration_results_4 (u)
     integer, intent(in) :: u
     type(integration_results_t) :: results
 
     write (u, "(A)")  "* Test output: integration_results_4"
     write (u, "(A)")  "*   Purpose: record extended results and display with verbosity = 2"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize display and record extended result"
     write (u, "(A)")
 
     call results%init (PRC_DECAY)
     call results%set_verbosity (2)
     call results%display_init (screen = .false., unit = u)
     call results%new_pass ()
 
     call results%record (1, 250, 150, 1.0_default, 0.5_default, 0.25_default,&
          & 0.22_default, 0.03_default)
     call results%record (1, 250, 180, 1.1_default, 0.5_default, 0.25_default,&
          & 0.23_default, 0.02_default)
     call results%record (1, 250, 130, 0.9_default, 0.5_default, 0.25_default,&
          & 0.25_default, 0.00_default)
 
     write (u, "(A)")
     write (u, "(A)")  "* Display pass"
     write (u, "(A)")
 
     call results%display_pass ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Finalize displays"
     write (u, "(A)")
 
     call results%display_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integration_results_4"
 
   end subroutine integration_results_4
 
 @ %def integration_results_4
 @
 <<integration results: execute tests>>=
   call test (integration_results_5, "integration_results_5", &
        "record extended results and display", &
        u, results)
 <<integration results: test declarations>>=
   public :: integration_results_5
 <<integration results: tests>>=
   subroutine integration_results_5 (u)
     integer, intent(in) :: u
     type(integration_results_t) :: results
 
     write (u, "(A)")  "* Test output: integration_results_5"
     write (u, "(A)")  "*   Purpose: record extended results and display  with verbosity = 3"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize display and record extended result"
     write (u, "(A)")
 
     call results%init (PRC_DECAY)
     call results%set_verbosity (3)
     call results%display_init (screen = .false., unit = u)
     call results%new_pass ()
 
     call results%record (1, 250, 150, 1.0_default, 0.5_default, 0.25_default,&
          & 0.22_default, 0.03_default)
     call results%record (1, 250, 180, 1.1_default, 0.5_default, 0.25_default,&
          & 0.23_default, 0.02_default)
     call results%record (1, 250, 130, 0.9_default, 0.5_default, 0.25_default,&
          & 0.25_default, 0.00_default)
     call results%display_pass ()
     call results%display_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: integration_results_5"
 
   end subroutine integration_results_5
 
 @ %def integration_results_5
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Dummy integrator}
 
 This implementation acts as a placeholder for cases where no
 integration or event generation is required at all.
 
 <<[[mci_none.f90]]>>=
 <<File header>>
 
 module mci_none
 
 <<Use kinds>>
   use io_units, only: given_output_unit
   use diagnostics, only: msg_message, msg_fatal
   use phs_base, only: phs_channel_t
 
   use mci_base
 
 <<Standard module head>>
 
 <<MCI none: public>>
 
 <<MCI none: types>>
 
 contains
 
 <<MCI none: procedures>>
 
 end module mci_none
 @ %def mci_none
 @
 \subsection{Integrator}
 The object contains the methods for integration and event generation.
 For the actual work and data storage, it spawns an instance object.
 
 After an integration pass, we update the [[max]] parameter to indicate
 the maximum absolute value of the integrand that the integrator
 encountered.  This is required for event generation.
 <<MCI none: public>>=
   public :: mci_none_t
 <<MCI none: types>>=
   type, extends (mci_t) :: mci_none_t
    contains
    <<MCI none: mci none: TBP>>
 end type mci_none_t
 
 @ %def mci_t
 @ Finalizer: no-op.
 <<MCI none: mci none: TBP>>=
   procedure :: final => mci_none_final
 <<MCI none: procedures>>=
   subroutine mci_none_final (object)
     class(mci_none_t), intent(inout) :: object
   end subroutine mci_none_final
 
 @ %def mci_none_final
 @ Output.
 <<MCI none: mci none: TBP>>=
   procedure :: write => mci_none_write
 <<MCI none: procedures>>=
   subroutine mci_none_write (object, unit, pacify, md5sum_version)
     class(mci_none_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacify
     logical, intent(in), optional :: md5sum_version
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)") "Integrator: non-functional dummy"
   end subroutine mci_none_write
 
 @ %def mci_none_write
 @ Startup message: short version.
 <<MCI none: mci none: TBP>>=
   procedure :: startup_message => mci_none_startup_message
 <<MCI none: procedures>>=
   subroutine mci_none_startup_message (mci, unit, n_calls)
     class(mci_none_t), intent(in) :: mci
     integer, intent(in), optional :: unit, n_calls
     call msg_message ("Integrator: none")
   end subroutine mci_none_startup_message
 
 @ %def mci_none_startup_message
 @ Log entry: just headline.
 <<MCI none: mci none: TBP>>=
   procedure :: write_log_entry => mci_none_write_log_entry
 <<MCI none: procedures>>=
   subroutine mci_none_write_log_entry (mci, u)
     class(mci_none_t), intent(in) :: mci
     integer, intent(in) :: u
     write (u, "(1x,A)")  "MC Integrator is none (no-op)"
   end subroutine mci_none_write_log_entry
 
 @ %def mci_none_write_log_entry
 @ MD5 sum: nothing.
 <<MCI none: mci none: TBP>>=
   procedure :: compute_md5sum => mci_none_compute_md5sum
 <<MCI none: procedures>>=
   subroutine mci_none_compute_md5sum (mci, pacify)
     class(mci_none_t), intent(inout) :: mci
     logical, intent(in), optional :: pacify
   end subroutine mci_none_compute_md5sum
 
 @ %def mci_none_compute_md5sum
 @ The number of channels must be one.
 <<CCC MCI none: mci none: TBP>>=
   procedure :: set_dimensions => mci_none_set_dimensions
 <<CCC MCI none: procedures>>=
   subroutine mci_none_set_dimensions (mci, n_dim, n_channel)
     class(mci_none_t), intent(inout) :: mci
     integer, intent(in) :: n_dim
     integer, intent(in) :: n_channel
     if (n_channel == 1) then
        mci%n_channel = n_channel
        mci%n_dim = n_dim
        allocate (mci%dim_is_binned (mci%n_dim))
        mci%dim_is_binned = .true.
        mci%n_dim_binned = count (mci%dim_is_binned)
        allocate (mci%n_bin (mci%n_dim))
        mci%n_bin = 0
     else
        call msg_fatal ("Attempt to initialize single-channel integrator &
             &for multiple channels")
     end if
   end subroutine mci_none_set_dimensions
 
 @ %def mci_none_set_dimensions
 @ Required by API.
 <<MCI none: mci none: TBP>>=
   procedure :: declare_flat_dimensions => mci_none_ignore_flat_dimensions
 <<MCI none: procedures>>=
   subroutine mci_none_ignore_flat_dimensions (mci, dim_flat)
     class(mci_none_t), intent(inout) :: mci
     integer, dimension(:), intent(in) :: dim_flat
   end subroutine mci_none_ignore_flat_dimensions
 
 @ %def mci_none_ignore_flat_dimensions
 @ Required by API.
 <<MCI none: mci none: TBP>>=
   procedure :: declare_equivalences => mci_none_ignore_equivalences
 <<MCI none: procedures>>=
   subroutine mci_none_ignore_equivalences (mci, channel, dim_offset)
     class(mci_none_t), intent(inout) :: mci
     type(phs_channel_t), dimension(:), intent(in) :: channel
     integer, intent(in) :: dim_offset
   end subroutine mci_none_ignore_equivalences
 
 @ %def mci_none_ignore_equivalences
 @ Allocate instance with matching type.
 <<MCI none: mci none: TBP>>=
   procedure :: allocate_instance => mci_none_allocate_instance
 <<MCI none: procedures>>=
   subroutine mci_none_allocate_instance (mci, mci_instance)
     class(mci_none_t), intent(in) :: mci
     class(mci_instance_t), intent(out), pointer :: mci_instance
     allocate (mci_none_instance_t :: mci_instance)
   end subroutine mci_none_allocate_instance
 
 @ %def mci_none_allocate_instance
 @ Integrate.  This must not be called at all.
 <<MCI none: mci none: TBP>>=
   procedure :: integrate => mci_none_integrate
 <<MCI none: procedures>>=
   subroutine mci_none_integrate (mci, instance, sampler, n_it, n_calls, &
        results, pacify)
     class(mci_none_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     integer, intent(in) :: n_it
     integer, intent(in) :: n_calls
     logical, intent(in), optional :: pacify
     class(mci_results_t), intent(inout), optional :: results
     call msg_fatal ("Integration: attempt to integrate with the 'mci_none' method")
   end subroutine mci_none_integrate
 
 @ %def mci_none_integrate
 @ Simulation initializer and finalizer: nothing to do here.
 <<MCI none: mci none: TBP>>=
   procedure :: prepare_simulation => mci_none_ignore_prepare_simulation
 <<MCI none: procedures>>=
   subroutine mci_none_ignore_prepare_simulation (mci)
     class(mci_none_t), intent(inout) :: mci
   end subroutine mci_none_ignore_prepare_simulation
 
 @ %def mci_none_ignore_prepare_simulation
 @ Generate events, must not be called.
 <<MCI none: mci none: TBP>>=
   procedure :: generate_weighted_event => mci_none_generate_no_event
   procedure :: generate_unweighted_event => mci_none_generate_no_event
 <<MCI none: procedures>>=
   subroutine mci_none_generate_no_event (mci, instance, sampler)
     class(mci_none_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     call msg_fatal ("Integration: attempt to generate event with the 'mci_none' method")
   end subroutine mci_none_generate_no_event
 
 @ %def mci_none_generate_no_event
 @ Rebuild an event, no-op.
 <<MCI none: mci none: TBP>>=
   procedure :: rebuild_event => mci_none_rebuild_event
 <<MCI none: procedures>>=
   subroutine mci_none_rebuild_event (mci, instance, sampler, state)
     class(mci_none_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout) :: instance
     class(mci_sampler_t), intent(inout) :: sampler
     class(mci_state_t), intent(in) :: state
   end subroutine mci_none_rebuild_event
 
 @ %def mci_none_rebuild_event
 @
 \subsection{Integrator instance}
 Covering the case of flat dimensions, we store a complete [[x]] array.  This
 is filled when generating events.
 <<MCI none: public>>=
   public :: mci_none_instance_t
 <<MCI none: types>>=
   type, extends (mci_instance_t) :: mci_none_instance_t
    contains
    <<MCI none: mci none instance: TBP>>
   end type mci_none_instance_t
 
 @ %def mci_none_instance_t
 @ Output.
 <<MCI none: mci none instance: TBP>>=
   procedure :: write => mci_none_instance_write
 <<MCI none: procedures>>=
   subroutine mci_none_instance_write (object, unit, pacify)
     class(mci_none_instance_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacify
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)") "Integrator instance: non-functional dummy"
   end subroutine mci_none_instance_write
 
 @ %def mci_none_instance_write
 @ The finalizer is empty.
 <<MCI none: mci none instance: TBP>>=
   procedure :: final => mci_none_instance_final
 <<MCI none: procedures>>=
   subroutine mci_none_instance_final (object)
     class(mci_none_instance_t), intent(inout) :: object
   end subroutine mci_none_instance_final
 
 @ %def mci_none_instance_final
 @ Initializer, empty.
 <<MCI none: mci none instance: TBP>>=
   procedure :: init => mci_none_instance_init
 <<MCI none: procedures>>=
   subroutine mci_none_instance_init (mci_instance, mci)
     class(mci_none_instance_t), intent(out) :: mci_instance
     class(mci_t), intent(in), target :: mci
   end subroutine mci_none_instance_init
 
 @ %def mci_none_instance_init
 @ Copy the stored extrema of the integrand in the instance record.
 <<CCC MCI none: mci none instance: TBP>>=
   procedure :: get_max => mci_none_instance_get_max
 <<CCC MCI none: procedures>>=
   subroutine mci_none_instance_get_max (instance)
     class(mci_none_instance_t), intent(inout) :: instance
     associate (mci => instance%mci)
       if (mci%max_known) then
          instance%max_known = .true.
          instance%max = mci%max
          instance%min = mci%min
          instance%max_abs = mci%max_abs
          instance%min_abs = mci%min_abs
       end if
     end associate
   end subroutine mci_none_instance_get_max
 
 @ %def mci_none_instance_get_max
 @ Reverse operations: recall the extrema, but only if they are wider
 than the extrema already stored in the configuration.  Also recalculate the
 efficiency value.
 <<CCC MCI none: mci none instance: TBP>>=
   procedure :: set_max => mci_none_instance_set_max
 <<CCC MCI none: procedures>>=
   subroutine mci_none_instance_set_max (instance)
     class(mci_none_instance_t), intent(inout) :: instance
     associate (mci => instance%mci)
       if (instance%max_known) then
          if (mci%max_known) then
             mci%max = max (mci%max, instance%max)
             mci%min = min (mci%min, instance%min)
             mci%max_abs = max (mci%max_abs, instance%max_abs)
             mci%min_abs = min (mci%min_abs, instance%min_abs)
          else
             mci%max = instance%max
             mci%min = instance%min
             mci%max_abs = instance%max_abs
             mci%min_abs = instance%min_abs
             mci%max_known = .true.
          end if
          if (mci%max_abs /= 0) then
             if (mci%integral_neg == 0) then
                mci%efficiency = mci%integral / mci%max_abs
                mci%efficiency_known = .true.
             else if (mci%n_calls /= 0) then
                mci%efficiency = &
                     (mci%integral_pos - mci%integral_neg) / mci%max_abs
                mci%efficiency_known = .true.
             end if
          end if
       end if
     end associate
   end subroutine mci_none_instance_set_max
 
 @ %def mci_none_instance_set_max
 @ The weight cannot be computed.
 <<MCI none: mci none instance: TBP>>=
   procedure :: compute_weight => mci_none_instance_compute_weight
 <<MCI none: procedures>>=
   subroutine mci_none_instance_compute_weight (mci, c)
     class(mci_none_instance_t), intent(inout) :: mci
     integer, intent(in) :: c
     call msg_fatal ("Integration: attempt to compute weight with the 'mci_none' method")
   end subroutine mci_none_instance_compute_weight
 
 @ %def mci_none_instance_compute_weight
 @ Record the integrand, no-op.
 <<MCI none: mci none instance: TBP>>=
   procedure :: record_integrand => mci_none_instance_record_integrand
 <<MCI none: procedures>>=
   subroutine mci_none_instance_record_integrand (mci, integrand)
     class(mci_none_instance_t), intent(inout) :: mci
     real(default), intent(in) :: integrand
   end subroutine mci_none_instance_record_integrand
 
 @ %def mci_none_instance_record_integrand
 @ No-op.
 <<MCI none: mci none instance: TBP>>=
   procedure :: init_simulation => mci_none_instance_init_simulation
   procedure :: final_simulation => mci_none_instance_final_simulation
 <<MCI none: procedures>>=
   subroutine mci_none_instance_init_simulation (instance, safety_factor)
     class(mci_none_instance_t), intent(inout) :: instance
     real(default), intent(in), optional :: safety_factor
   end subroutine mci_none_instance_init_simulation
 
   subroutine mci_none_instance_final_simulation (instance)
     class(mci_none_instance_t), intent(inout) :: instance
   end subroutine mci_none_instance_final_simulation
 
 @ %def mci_none_instance_init_simulation
 @ %def mci_none_instance_final_simulation
 @ Return excess weight for the current event: return zero, just in case.
 <<MCI none: mci none instance: TBP>>=
   procedure :: get_event_excess => mci_none_instance_get_event_excess
 <<MCI none: procedures>>=
   function mci_none_instance_get_event_excess (mci) result (excess)
     class(mci_none_instance_t), intent(in) :: mci
     real(default) :: excess
     excess = 0
   end function mci_none_instance_get_event_excess
 
 @ %def mci_none_instance_get_event_excess
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[mci_none_ut.f90]]>>=
 <<File header>>
 
 module mci_none_ut
   use unit_tests
   use mci_none_uti
 
 <<Standard module head>>
 
 <<MCI none: public test>>
 
 contains
 
 <<MCI none: test driver>>
 
 end module mci_none_ut
 @ %def mci_none_ut
 @
 <<[[mci_none_uti.f90]]>>=
 <<File header>>
 
 module mci_none_uti
 
   use mci_base
 
   use mci_none
 
 <<Standard module head>>
 
 <<MCI none: test declarations>>
 
 <<MCI none: test types>>
 
 contains
 
 <<MCI none: tests>>
 
 end module mci_none_uti
 @ %def mci_none_ut
 @ API: driver for the unit tests below.
 <<MCI none: public test>>=
   public :: mci_none_test
 <<MCI none: test driver>>=
   subroutine mci_none_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<MCI none: execute tests>>
   end subroutine mci_none_test
 
 @ %def mci_none_test
 @
 \subsubsection{Trivial sanity check}
 Construct an integrator and display it.
 <<MCI none: execute tests>>=
   call test (mci_none_1, "mci_none_1", &
        "dummy integrator", &
        u, results)
 <<MCI none: test declarations>>=
   public :: mci_none_1
 <<MCI none: tests>>=
   subroutine mci_none_1 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
 
     write (u, "(A)")  "* Test output: mci_none_1"
     write (u, "(A)")  "*   Purpose: display mci configuration"
     write (u, "(A)")
 
     write (u, "(A)")  "* Allocate integrator"
     write (u, "(A)")
 
     allocate (mci_none_t :: mci)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     call mci_instance%write (u)
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_none_1"
 
   end subroutine mci_none_1
 
 @ %def mci_none_1
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Simple midpoint integration}
 This is a most simple implementation of an integrator.  The algorithm
 is the straightforward multi-dimensional midpoint rule, i.e., the
 integration hypercube is binned uniformly, the integrand is evaluated
 at the midpoints of each bin, and the result is the average.  The
 binning is equivalent for all integration dimensions.
 
 This rule is accurate to the order $h^2$, where $h$ is the bin width.
 Given that $h=N^{-1/d}$, where $d$ is the integration dimension and
 $N$ is the total number of sampling points, we get a relative error
 of order $N^{-2/d}$.  This is superior to MC integration if $d<4$, and
 equivalent if $d=4$.  It is not worse than higher-order formulas
 (such as Gauss integration) if the integrand is not smooth, e.g., if
 it contains cuts.
 
 The integrator is specifically single-channel.  However, we do not
 limit the dimension.
 <<[[mci_midpoint.f90]]>>=
 <<File header>>
 
 module mci_midpoint
 
 <<Use kinds>>
   use io_units
   use diagnostics
   use phs_base
 
   use mci_base
 
 <<Standard module head>>
 
 <<MCI midpoint: public>>
 
 <<MCI midpoint: types>>
 
 contains
 
 <<MCI midpoint: procedures>>
 
 end module mci_midpoint
 @ %def mci_midpoint
 @
 \subsection{Integrator}
 The object contains the methods for integration and event generation.
 For the actual work and data storage, it spawns an instance object.
 
 After an integration pass, we update the [[max]] parameter to indicate
 the maximum absolute value of the integrand that the integrator
 encountered.  This is required for event generation.
 <<MCI midpoint: public>>=
   public :: mci_midpoint_t
 <<MCI midpoint: types>>=
   type, extends (mci_t) :: mci_midpoint_t
      integer :: n_dim_binned = 0
      logical, dimension(:), allocatable :: dim_is_binned
      logical :: calls_known = .false.
      integer :: n_calls = 0
      integer :: n_calls_pos = 0
      integer :: n_calls_nul = 0
      integer :: n_calls_neg = 0
      real(default) :: integral_pos = 0
      real(default) :: integral_neg = 0
      integer, dimension(:), allocatable :: n_bin
      logical :: max_known = .false.
      real(default) :: max = 0
      real(default) :: min = 0
      real(default) :: max_abs = 0
      real(default) :: min_abs = 0
    contains
    <<MCI midpoint: mci midpoint: TBP>>
 end type mci_midpoint_t
 
 @ %def mci_t
 @ Finalizer: base version is sufficient
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: final => mci_midpoint_final
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_final (object)
     class(mci_midpoint_t), intent(inout) :: object
     call object%base_final ()
   end subroutine mci_midpoint_final
 
 @ %def mci_midpoint_final
 @ Output.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: write => mci_midpoint_write
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_write (object, unit, pacify, md5sum_version)
     class(mci_midpoint_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacify
     logical, intent(in), optional :: md5sum_version
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)") "Single-channel midpoint rule integrator:"
     call object%base_write (u, pacify, md5sum_version)
     if (object%n_dim_binned < object%n_dim) then
        write (u, "(3x,A,99(1x,I0))")  "Flat dimensions      =", &
             pack ([(i, i = 1, object%n_dim)], mask = .not. object%dim_is_binned)
        write (u, "(3x,A,I0)")  "Number of binned dim = ", object%n_dim_binned
     end if
     if (object%calls_known) then
        write (u, "(3x,A,99(1x,I0))")  "Number of bins       =", object%n_bin
        write (u, "(3x,A,I0)")  "Number of calls      = ", object%n_calls
        if (object%n_calls_pos /= object%n_calls) then
           write (u, "(3x,A,I0)")  "  positive value     = ", object%n_calls_pos
           write (u, "(3x,A,I0)")  "  zero value         = ", object%n_calls_nul
           write (u, "(3x,A,I0)")  "  negative value     = ", object%n_calls_neg
           write (u, "(3x,A,ES17.10)") &
                "Integral (pos. part) = ", object%integral_pos
           write (u, "(3x,A,ES17.10)") &
                "Integral (neg. part) = ", object%integral_neg
        end if
     end if
     if (object%max_known) then
        write (u, "(3x,A,ES17.10)")  "Maximum of integrand = ", object%max
        write (u, "(3x,A,ES17.10)")  "Minimum of integrand = ", object%min
        if (object%min /= object%min_abs) then
           write (u, "(3x,A,ES17.10)")  "Maximum (abs. value) = ", object%max_abs
           write (u, "(3x,A,ES17.10)")  "Minimum (abs. value) = ", object%min_abs
        end if
     end if
     if (allocated (object%rng))  call object%rng%write (u)
   end subroutine mci_midpoint_write
 
 @ %def mci_midpoint_write
 @ Startup message: short version.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: startup_message => mci_midpoint_startup_message
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_startup_message (mci, unit, n_calls)
     class(mci_midpoint_t), intent(in) :: mci
     integer, intent(in), optional :: unit, n_calls
     call mci%base_startup_message (unit = unit, n_calls = n_calls)
     if (mci%n_dim_binned < mci%n_dim) then
        write (msg_buffer, "(A,2(1x,I0,1x,A))") &
             "Integrator: Midpoint rule:", &
             mci%n_dim_binned, "binned dimensions"
     else
        write (msg_buffer, "(A,2(1x,I0,1x,A))") &
             "Integrator: Midpoint rule"
     end if
     call msg_message (unit = unit)
   end subroutine mci_midpoint_startup_message
 
 @ %def mci_midpoint_startup_message
 @ Log entry: just headline.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: write_log_entry => mci_midpoint_write_log_entry
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_write_log_entry (mci, u)
     class(mci_midpoint_t), intent(in) :: mci
     integer, intent(in) :: u
     write (u, "(1x,A)")  "MC Integrator is Midpoint rule"
   end subroutine mci_midpoint_write_log_entry
 
 @ %def mci_midpoint_write_log_entry
 @ MD5 sum: nothing.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: compute_md5sum => mci_midpoint_compute_md5sum
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_compute_md5sum (mci, pacify)
     class(mci_midpoint_t), intent(inout) :: mci
     logical, intent(in), optional :: pacify
   end subroutine mci_midpoint_compute_md5sum
 
 @ %def mci_midpoint_compute_md5sum
 @ The number of channels must be one.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: set_dimensions => mci_midpoint_set_dimensions
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_set_dimensions (mci, n_dim, n_channel)
     class(mci_midpoint_t), intent(inout) :: mci
     integer, intent(in) :: n_dim
     integer, intent(in) :: n_channel
     if (n_channel == 1) then
        mci%n_channel = n_channel
        mci%n_dim = n_dim
        allocate (mci%dim_is_binned (mci%n_dim))
        mci%dim_is_binned = .true.
        mci%n_dim_binned = count (mci%dim_is_binned)
        allocate (mci%n_bin (mci%n_dim))
        mci%n_bin = 0
     else
        call msg_fatal ("Attempt to initialize single-channel integrator &
             &for multiple channels")
     end if
   end subroutine mci_midpoint_set_dimensions
 
 @ %def mci_midpoint_set_dimensions
 @ Declare particular dimensions as flat.  These dimensions will not be binned.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: declare_flat_dimensions => mci_midpoint_declare_flat_dimensions
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_declare_flat_dimensions (mci, dim_flat)
     class(mci_midpoint_t), intent(inout) :: mci
     integer, dimension(:), intent(in) :: dim_flat
     integer :: d
     mci%n_dim_binned = mci%n_dim - size (dim_flat)
     do d = 1, size (dim_flat)
        mci%dim_is_binned(dim_flat(d)) = .false.
     end do
     mci%n_dim_binned = count (mci%dim_is_binned)
   end subroutine mci_midpoint_declare_flat_dimensions
 
 @ %def mci_midpoint_declare_flat_dimensions
 @ Declare particular channels as equivalent.  This has no effect.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: declare_equivalences => mci_midpoint_ignore_equivalences
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_ignore_equivalences (mci, channel, dim_offset)
     class(mci_midpoint_t), intent(inout) :: mci
     type(phs_channel_t), dimension(:), intent(in) :: channel
     integer, intent(in) :: dim_offset
   end subroutine mci_midpoint_ignore_equivalences
 
 @ %def mci_midpoint_ignore_equivalences
 @ Allocate instance with matching type.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: allocate_instance => mci_midpoint_allocate_instance
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_allocate_instance (mci, mci_instance)
     class(mci_midpoint_t), intent(in) :: mci
     class(mci_instance_t), intent(out), pointer :: mci_instance
     allocate (mci_midpoint_instance_t :: mci_instance)
   end subroutine mci_midpoint_allocate_instance
 
 @ %def mci_midpoint_allocate_instance
 @ Integrate.  The number of dimensions is arbitrary.  We make sure
 that the number of calls is evenly distributed among the dimensions.
 The actual number of calls will typically be smaller than the
 requested number, but never smaller than 1.
 
 The sampling over a variable number of dimensions implies a variable
 number of nested loops.  We implement this by a recursive subroutine,
 one loop in each recursion level.
 
 The number of iterations [[n_it]] is ignored.  Also, the error is set
 to zero in the current implementation.
 
 With this integrator, we allow the calculation to abort immediately when
 forced by a signal.  There is no state that we can save, hence we do not catch
 an interrupt.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: integrate => mci_midpoint_integrate
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_integrate (mci, instance, sampler, n_it, n_calls, &
        results, pacify)
     class(mci_midpoint_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     integer, intent(in) :: n_it
     integer, intent(in) :: n_calls
     logical, intent(in), optional :: pacify
     class(mci_results_t), intent(inout), optional :: results
     real(default), dimension(:), allocatable :: x
     real(default) :: integral, integral_pos, integral_neg
     integer :: n_bin
     select type (instance)
     type is (mci_midpoint_instance_t)
        allocate (x (mci%n_dim))
        integral = 0
        integral_pos = 0
        integral_neg = 0
        select case (mci%n_dim_binned)
        case (1)
           n_bin = n_calls
        case (2:)
           n_bin = max (int (n_calls ** (1. / mci%n_dim_binned)), 1)
        end select
        where (mci%dim_is_binned)
           mci%n_bin = n_bin
        elsewhere
           mci%n_bin = 1
        end where
        mci%n_calls = product (mci%n_bin)
        mci%n_calls_pos = 0
        mci%n_calls_nul = 0
        mci%n_calls_neg = 0
        mci%calls_known = .true.
        call sample_dim (mci%n_dim)
        mci%integral = integral / mci%n_calls
        mci%integral_pos = integral_pos / mci%n_calls
        mci%integral_neg = integral_neg / mci%n_calls
        mci%integral_known = .true.
        call instance%set_max ()
        if (present (results)) then
           call results%record (1, mci%n_calls, &
                mci%integral, mci%error, mci%efficiency)
        end if
     end select
   contains
     recursive subroutine sample_dim (d)
       integer, intent(in) :: d
       integer :: i
       real(default) :: value
       do i = 1, mci%n_bin(d)
          x(d) = (i - 0.5_default) / mci%n_bin(d)
          if (d > 1) then
             call sample_dim (d - 1)
          else
             if (signal_is_pending ())  return
             call instance%evaluate (sampler, 1, x)
             value = instance%get_value ()
             if (value > 0) then
                mci%n_calls_pos = mci%n_calls_pos + 1
                integral = integral + value
                integral_pos = integral_pos + value
             else if (value == 0) then
                mci%n_calls_nul = mci%n_calls_nul + 1
             else
                mci%n_calls_neg = mci%n_calls_neg + 1
                integral = integral + value
                integral_neg = integral_neg + value
             end if
          end if
       end do
     end subroutine sample_dim
   end subroutine mci_midpoint_integrate
 
 @ %def mci_midpoint_integrate
 @ Simulation initializer and finalizer: nothing to do here.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: prepare_simulation => mci_midpoint_ignore_prepare_simulation
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_ignore_prepare_simulation (mci)
     class(mci_midpoint_t), intent(inout) :: mci
   end subroutine mci_midpoint_ignore_prepare_simulation
 
 @ %def mci_midpoint_ignore_prepare_simulation
 @ Generate weighted event.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: generate_weighted_event => mci_midpoint_generate_weighted_event
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_generate_weighted_event (mci, instance, sampler)
     class(mci_midpoint_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     real(default), dimension(mci%n_dim) :: x
     select type (instance)
     type is (mci_midpoint_instance_t)
        call mci%rng%generate (x)
        call instance%evaluate (sampler, 1, x)
        instance%excess_weight = 0
     end select
   end subroutine mci_midpoint_generate_weighted_event
 
 @ %def mci_midpoint_generate_weighted_event
 @ For unweighted events, we generate weighted events and apply a
 simple rejection step to the relative event weight, until an event
 passes.
 
 Note that we use the [[max_abs]] value stored in the configuration
 record, not the one stored in the instance.  The latter may change
 during event generation.  After an event generation pass is over, we
 may update the value for a subsequent pass.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: generate_unweighted_event => &
        mci_midpoint_generate_unweighted_event
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_generate_unweighted_event (mci, instance, sampler)
     class(mci_midpoint_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     real(default) :: x, norm, int
     select type (instance)
     type is (mci_midpoint_instance_t)
        if (mci%max_known .and. mci%max_abs > 0) then
           norm = abs (mci%max_abs * instance%safety_factor)
           REJECTION: do
              call mci%generate_weighted_event (instance, sampler)
              if (sampler%is_valid ()) then
                 call mci%rng%generate (x)
                 int = abs (instance%integrand)
                 if (x * norm <= int) then
                    if (norm > 0 .and. norm < int) then
                       instance%excess_weight = int / norm - 1
                    end if
                    exit REJECTION
                 end if
              end if
              if (signal_is_pending ())  return
           end do REJECTION
        else
           call msg_fatal ("Unweighted event generation: &
                &maximum of integrand is zero or unknown")
        end if
     end select
   end subroutine mci_midpoint_generate_unweighted_event
 
 @ %def mci_midpoint_generate_unweighted_event
 @ Rebuild an event, using the [[state]] input.
 <<MCI midpoint: mci midpoint: TBP>>=
   procedure :: rebuild_event => mci_midpoint_rebuild_event
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_rebuild_event (mci, instance, sampler, state)
     class(mci_midpoint_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout) :: instance
     class(mci_sampler_t), intent(inout) :: sampler
     class(mci_state_t), intent(in) :: state
     select type (instance)
     type is (mci_midpoint_instance_t)
        call instance%recall (sampler, state)
     end select
   end subroutine mci_midpoint_rebuild_event
 
 @ %def mci_midpoint_rebuild_event
 @
 \subsection{Integrator instance}
 Covering the case of flat dimensions, we store a complete [[x]] array.  This
 is filled when generating events.
 <<MCI midpoint: public>>=
   public :: mci_midpoint_instance_t
 <<MCI midpoint: types>>=
   type, extends (mci_instance_t) :: mci_midpoint_instance_t
      type(mci_midpoint_t), pointer :: mci => null ()
      logical :: max_known = .false.
      real(default) :: max = 0
      real(default) :: min = 0
      real(default) :: max_abs = 0
      real(default) :: min_abs = 0
      real(default) :: safety_factor = 1
      real(default) :: excess_weight = 0
    contains
    <<MCI midpoint: mci midpoint instance: TBP>>
   end type mci_midpoint_instance_t
 
 @ %def mci_midpoint_instance_t
 @ Output.
 <<MCI midpoint: mci midpoint instance: TBP>>=
   procedure :: write => mci_midpoint_instance_write
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_instance_write (object, unit, pacify)
     class(mci_midpoint_instance_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacify
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A,9(1x,F12.10))")  "x =", object%x(:,1)
     write (u, "(1x,A,ES19.12)") "Integrand = ", object%integrand
     write (u, "(1x,A,ES19.12)") "Weight    = ", object%mci_weight
     if (object%safety_factor /= 1) then
        write (u, "(1x,A,ES19.12)") "Safety f  = ", object%safety_factor
     end if
     if (object%excess_weight /= 0) then
        write (u, "(1x,A,ES19.12)") "Excess    = ", object%excess_weight
     end if
     if (object%max_known) then
        write (u, "(1x,A,ES19.12)") "Maximum   = ", object%max
        write (u, "(1x,A,ES19.12)") "Minimum   = ", object%min
        if (object%min /= object%min_abs) then
           write (u, "(1x,A,ES19.12)") "Max.(abs) = ", object%max_abs
           write (u, "(1x,A,ES19.12)") "Min.(abs) = ", object%min_abs
        end if
     end if
   end subroutine mci_midpoint_instance_write
 
 @ %def mci_midpoint_instance_write
 @ The finalizer is empty.
 <<MCI midpoint: mci midpoint instance: TBP>>=
   procedure :: final => mci_midpoint_instance_final
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_instance_final (object)
     class(mci_midpoint_instance_t), intent(inout) :: object
   end subroutine mci_midpoint_instance_final
 
 @ %def mci_midpoint_instance_final
 @ Initializer.
 <<MCI midpoint: mci midpoint instance: TBP>>=
   procedure :: init => mci_midpoint_instance_init
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_instance_init (mci_instance, mci)
     class(mci_midpoint_instance_t), intent(out) :: mci_instance
     class(mci_t), intent(in), target :: mci
     call mci_instance%base_init (mci)
     select type (mci)
     type is (mci_midpoint_t)
        mci_instance%mci => mci
        call mci_instance%get_max ()
        mci_instance%selected_channel = 1
     end select
   end subroutine mci_midpoint_instance_init
 
 @ %def mci_midpoint_instance_init
 @ Copy the stored extrema of the integrand in the instance record.
 <<MCI midpoint: mci midpoint instance: TBP>>=
   procedure :: get_max => mci_midpoint_instance_get_max
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_instance_get_max (instance)
     class(mci_midpoint_instance_t), intent(inout) :: instance
     associate (mci => instance%mci)
       if (mci%max_known) then
          instance%max_known = .true.
          instance%max = mci%max
          instance%min = mci%min
          instance%max_abs = mci%max_abs
          instance%min_abs = mci%min_abs
       end if
     end associate
   end subroutine mci_midpoint_instance_get_max
 
 @ %def mci_midpoint_instance_get_max
 @ Reverse operations: recall the extrema, but only if they are wider
 than the extrema already stored in the configuration.  Also recalculate the
 efficiency value.
 <<MCI midpoint: mci midpoint instance: TBP>>=
   procedure :: set_max => mci_midpoint_instance_set_max
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_instance_set_max (instance)
     class(mci_midpoint_instance_t), intent(inout) :: instance
     associate (mci => instance%mci)
       if (instance%max_known) then
          if (mci%max_known) then
             mci%max = max (mci%max, instance%max)
             mci%min = min (mci%min, instance%min)
             mci%max_abs = max (mci%max_abs, instance%max_abs)
             mci%min_abs = min (mci%min_abs, instance%min_abs)
          else
             mci%max = instance%max
             mci%min = instance%min
             mci%max_abs = instance%max_abs
             mci%min_abs = instance%min_abs
             mci%max_known = .true.
          end if
          if (mci%max_abs /= 0) then
             if (mci%integral_neg == 0) then
                mci%efficiency = mci%integral / mci%max_abs
                mci%efficiency_known = .true.
             else if (mci%n_calls /= 0) then
                mci%efficiency = &
                     (mci%integral_pos - mci%integral_neg) / mci%max_abs
                mci%efficiency_known = .true.
             end if
          end if
       end if
     end associate
   end subroutine mci_midpoint_instance_set_max
 
 @ %def mci_midpoint_instance_set_max
 @ The weight is the Jacobian of the mapping for the only channel.
 <<MCI midpoint: mci midpoint instance: TBP>>=
   procedure :: compute_weight => mci_midpoint_instance_compute_weight
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_instance_compute_weight (mci, c)
     class(mci_midpoint_instance_t), intent(inout) :: mci
     integer, intent(in) :: c
     select case (c)
     case (1)
        mci%mci_weight = mci%f(1)
     case default
        call msg_fatal ("MCI midpoint integrator: only single channel supported")
     end select
   end subroutine mci_midpoint_instance_compute_weight
 
 @ %def mci_midpoint_instance_compute_weight
 @ Record the integrand.  Update stored values for maximum and minimum.
 <<MCI midpoint: mci midpoint instance: TBP>>=
   procedure :: record_integrand => mci_midpoint_instance_record_integrand
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_instance_record_integrand (mci, integrand)
     class(mci_midpoint_instance_t), intent(inout) :: mci
     real(default), intent(in) :: integrand
     mci%integrand = integrand
     if (mci%max_known) then
        mci%max = max (mci%max, integrand)
        mci%min = min (mci%min, integrand)
        mci%max_abs = max (mci%max_abs, abs (integrand))
        mci%min_abs = min (mci%min_abs, abs (integrand))
     else
        mci%max = integrand
        mci%min = integrand
        mci%max_abs = abs (integrand)
        mci%min_abs = abs (integrand)
        mci%max_known = .true.
     end if
   end subroutine mci_midpoint_instance_record_integrand
 
 @ %def mci_midpoint_instance_record_integrand
 @ We store the safety factor, otherwise nothing to do here.
 <<MCI midpoint: mci midpoint instance: TBP>>=
   procedure :: init_simulation => mci_midpoint_instance_init_simulation
   procedure :: final_simulation => mci_midpoint_instance_final_simulation
 <<MCI midpoint: procedures>>=
   subroutine mci_midpoint_instance_init_simulation (instance, safety_factor)
     class(mci_midpoint_instance_t), intent(inout) :: instance
     real(default), intent(in), optional :: safety_factor
     if (present (safety_factor))  instance%safety_factor = safety_factor
   end subroutine mci_midpoint_instance_init_simulation
 
   subroutine mci_midpoint_instance_final_simulation (instance)
     class(mci_midpoint_instance_t), intent(inout) :: instance
   end subroutine mci_midpoint_instance_final_simulation
 
 @ %def mci_midpoint_instance_init_simulation
 @ %def mci_midpoint_instance_final_simulation
 @ Return excess weight for the current event.
 <<MCI midpoint: mci midpoint instance: TBP>>=
   procedure :: get_event_excess => mci_midpoint_instance_get_event_excess
 <<MCI midpoint: procedures>>=
   function mci_midpoint_instance_get_event_excess (mci) result (excess)
     class(mci_midpoint_instance_t), intent(in) :: mci
     real(default) :: excess
     excess = mci%excess_weight
   end function mci_midpoint_instance_get_event_excess
 
 @ %def mci_midpoint_instance_get_event_excess
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[mci_midpoint_ut.f90]]>>=
 <<File header>>
 
 module mci_midpoint_ut
   use unit_tests
   use mci_midpoint_uti
 
 <<Standard module head>>
 
 <<MCI midpoint: public test>>
 
 contains
 
 <<MCI midpoint: test driver>>
 
 end module mci_midpoint_ut
 @ %def mci_midpoint_ut
 @
 <<[[mci_midpoint_uti.f90]]>>=
 <<File header>>
 
 module mci_midpoint_uti
 
 <<Use kinds>>
   use io_units
   use rng_base
   use mci_base
 
   use mci_midpoint
 
   use rng_base_ut, only: rng_test_t
 
 <<Standard module head>>
 
 <<MCI midpoint: test declarations>>
 
 <<MCI midpoint: test types>>
 
 contains
 
 <<MCI midpoint: tests>>
 
 end module mci_midpoint_uti
 @ %def mci_midpoint_ut
 @ API: driver for the unit tests below.
 <<MCI midpoint: public test>>=
   public :: mci_midpoint_test
 <<MCI midpoint: test driver>>=
   subroutine mci_midpoint_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<MCI midpoint: execute tests>>
   end subroutine mci_midpoint_test
 
 @ %def mci_midpoint_test
 @
 \subsubsection{Test sampler}
 A test sampler object should implement a function with known integral that
 we can use to check the integrator.
 
 This is the function $f(x) = 3 x^2$ with integral $\int_0^1
 f(x)\,dx=1$ and maximum $f(1)=3$.  If the integration dimension is
 greater than one, the function is extended as a constant in the other
 dimension(s).
 
 Mimicking the behavior of a process object, we store the argument
 and result inside the sampler, so we can [[fetch]] results.
 <<MCI midpoint: test types>>=
   type, extends (mci_sampler_t) :: test_sampler_1_t
      real(default), dimension(:), allocatable :: x
      real(default) :: val
    contains
    <<MCI midpoint: test sampler 1: TBP>>
   end type test_sampler_1_t
 
 @ %def test_sampler_1_t
 @ Output: There is nothing stored inside, so just print an informative line.
 <<MCI midpoint: test sampler 1: TBP>>=
   procedure :: write => test_sampler_1_write
 <<MCI midpoint: tests>>=
   subroutine test_sampler_1_write (object, unit, testflag)
     class(test_sampler_1_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)") "Test sampler: f(x) = 3 x^2"
   end subroutine test_sampler_1_write
 
 @ %def test_sampler_1_write
 @ Evaluation: compute the function value.  The output $x$ parameter
 (only one channel) is identical to the input $x$, and the Jacobian is 1.
 <<MCI midpoint: test sampler 1: TBP>>=
   procedure :: evaluate => test_sampler_1_evaluate
 <<MCI midpoint: tests>>=
   subroutine test_sampler_1_evaluate (sampler, c, x_in, val, x, f)
     class(test_sampler_1_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     if (allocated (sampler%x))  deallocate (sampler%x)
     allocate (sampler%x (size (x_in)))
     sampler%x = x_in
     sampler%val = 3 * x_in(1) ** 2
     call sampler%fetch (val, x, f)
   end subroutine test_sampler_1_evaluate
 
 @ %def test_sampler_1_evaluate
 @ The point is always valid.
 <<MCI midpoint: test sampler 1: TBP>>=
   procedure :: is_valid => test_sampler_1_is_valid
 <<MCI midpoint: tests>>=
   function test_sampler_1_is_valid (sampler) result (valid)
     class(test_sampler_1_t), intent(in) :: sampler
     logical :: valid
     valid = .true.
   end function test_sampler_1_is_valid
 
 @ %def test_sampler_1_is_valid
 @ Rebuild: compute all but the function value.
 <<MCI midpoint: test sampler 1: TBP>>=
   procedure :: rebuild => test_sampler_1_rebuild
 <<MCI midpoint: tests>>=
   subroutine test_sampler_1_rebuild (sampler, c, x_in, val, x, f)
     class(test_sampler_1_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(in) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     if (allocated (sampler%x))  deallocate (sampler%x)
     allocate (sampler%x (size (x_in)))
     sampler%x = x_in
     sampler%val = val
     x(:,1) = sampler%x
     f = 1
   end subroutine test_sampler_1_rebuild
 
 @ %def test_sampler_1_rebuild
 @ Extract the results.
 <<MCI midpoint: test sampler 1: TBP>>=
   procedure :: fetch => test_sampler_1_fetch
 <<MCI midpoint: tests>>=
   subroutine test_sampler_1_fetch (sampler, val, x, f)
     class(test_sampler_1_t), intent(in) :: sampler
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     val = sampler%val
     x(:,1) = sampler%x
     f = 1
   end subroutine test_sampler_1_fetch
 
 @ %def test_sampler_1_fetch
 @
 This is the function $f(x) = 3 x^2 + 2 y$ with integral $\int_0^1
 f(x,y)\,dx\,dy=2$ and maximum $f(1)=5$.
 <<MCI midpoint: test types>>=
   type, extends (mci_sampler_t) :: test_sampler_2_t
      real(default) :: val
      real(default), dimension(2) :: x
    contains
    <<MCI midpoint: test sampler 2: TBP>>
   end type test_sampler_2_t
 
 @ %def test_sampler_2_t
 @ Output: There is nothing stored inside, so just print an informative line.
 <<MCI midpoint: test sampler 2: TBP>>=
   procedure :: write => test_sampler_2_write
 <<MCI midpoint: tests>>=
   subroutine test_sampler_2_write (object, unit, testflag)
     class(test_sampler_2_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)") "Test sampler: f(x) = 3 x^2 + 2 y"
   end subroutine test_sampler_2_write
 
 @ %def test_sampler_2_write
 @ Evaluate: compute the function value.  The output $x$ parameter
 (only one channel) is identical to the input $x$, and the Jacobian is 1.
 <<MCI midpoint: test sampler 2: TBP>>=
   procedure :: evaluate => test_sampler_2_evaluate
 <<MCI midpoint: tests>>=
   subroutine test_sampler_2_evaluate (sampler, c, x_in, val, x, f)
     class(test_sampler_2_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     sampler%x = x_in
     sampler%val = 3 * x_in(1) ** 2 + 2 * x_in(2)
     call sampler%fetch (val, x, f)
   end subroutine test_sampler_2_evaluate
 
 @ %def test_sampler_2_evaluate
 @ The point is always valid.
 <<MCI midpoint: test sampler 2: TBP>>=
   procedure :: is_valid => test_sampler_2_is_valid
 <<MCI midpoint: tests>>=
   function test_sampler_2_is_valid (sampler) result (valid)
     class(test_sampler_2_t), intent(in) :: sampler
     logical :: valid
     valid = .true.
   end function test_sampler_2_is_valid
 
 @ %def test_sampler_2_is_valid
 @ Rebuild: compute all but the function value.
 <<MCI midpoint: test sampler 2: TBP>>=
   procedure :: rebuild => test_sampler_2_rebuild
 <<MCI midpoint: tests>>=
   subroutine test_sampler_2_rebuild (sampler, c, x_in, val, x, f)
     class(test_sampler_2_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(in) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     sampler%x = x_in
     sampler%val = val
     x(:,1) = sampler%x
     f = 1
   end subroutine test_sampler_2_rebuild
 
 @ %def test_sampler_2_rebuild
 <<MCI midpoint: test sampler 2: TBP>>=
   procedure :: fetch => test_sampler_2_fetch
 <<MCI midpoint: tests>>=
   subroutine test_sampler_2_fetch (sampler, val, x, f)
     class(test_sampler_2_t), intent(in) :: sampler
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     val = sampler%val
     x(:,1) = sampler%x
     f = 1
   end subroutine test_sampler_2_fetch
 
 @ %def test_sampler_2_fetch
 @
 This is the function $f(x) = (1 - 3 x^2)\,\theta(x-1/2)$ with integral
 $\int_0^1 f(x)\,dx=-3/8$, minimum $f(1)=-2$ and maximum $f(1/2)=1/4$.
 If the integration dimension is greater than one, the function is
 extended as a constant in the other dimension(s).
 <<MCI midpoint: test types>>=
   type, extends (mci_sampler_t) :: test_sampler_4_t
      real(default) :: val
      real(default), dimension(:), allocatable :: x
    contains
    <<MCI midpoint: test sampler 4: TBP>>
   end type test_sampler_4_t
 
 @ %def test_sampler_4_t
 @ Output: There is nothing stored inside, so just print an informative line.
 <<MCI midpoint: test sampler 4: TBP>>=
   procedure :: write => test_sampler_4_write
 <<MCI midpoint: tests>>=
   subroutine test_sampler_4_write (object, unit, testflag)
     class(test_sampler_4_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)") "Test sampler: f(x) = 1 - 3 x^2"
   end subroutine test_sampler_4_write
 
 @ %def test_sampler_4_write
 @ Evaluation: compute the function value.  The output $x$ parameter
 (only one channel) is identical to the input $x$, and the Jacobian is 1.
 <<MCI midpoint: test sampler 4: TBP>>=
   procedure :: evaluate => test_sampler_4_evaluate
 <<MCI midpoint: tests>>=
   subroutine test_sampler_4_evaluate (sampler, c, x_in, val, x, f)
     class(test_sampler_4_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     if (x_in(1) >= .5_default) then
        sampler%val = 1 - 3 * x_in(1) ** 2
     else
        sampler%val = 0
     end if
     if (.not. allocated (sampler%x))  allocate (sampler%x (size (x_in)))
     sampler%x = x_in
     call sampler%fetch (val, x, f)
   end subroutine test_sampler_4_evaluate
 
 @ %def test_sampler_4_evaluate
 @ The point is always valid.
 <<MCI midpoint: test sampler 4: TBP>>=
   procedure :: is_valid => test_sampler_4_is_valid
 <<MCI midpoint: tests>>=
   function test_sampler_4_is_valid (sampler) result (valid)
     class(test_sampler_4_t), intent(in) :: sampler
     logical :: valid
     valid = .true.
   end function test_sampler_4_is_valid
 
 @ %def test_sampler_4_is_valid
 @ Rebuild: compute all but the function value.
 <<MCI midpoint: test sampler 4: TBP>>=
   procedure :: rebuild => test_sampler_4_rebuild
 <<MCI midpoint: tests>>=
   subroutine test_sampler_4_rebuild (sampler, c, x_in, val, x, f)
     class(test_sampler_4_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(in) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     sampler%x = x_in
     sampler%val = val
     x(:,1) = sampler%x
     f = 1
   end subroutine test_sampler_4_rebuild
 
 @ %def test_sampler_4_rebuild
 <<MCI midpoint: test sampler 4: TBP>>=
   procedure :: fetch => test_sampler_4_fetch
 <<MCI midpoint: tests>>=
   subroutine test_sampler_4_fetch (sampler, val, x, f)
     class(test_sampler_4_t), intent(in) :: sampler
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     val = sampler%val
     x(:,1) = sampler%x
     f = 1
   end subroutine test_sampler_4_fetch
 
 @ %def test_sampler_4_fetch
 @
 \subsubsection{One-dimensional integration}
 Construct an integrator and use it for a one-dimensional sampler.
 <<MCI midpoint: execute tests>>=
   call test (mci_midpoint_1, "mci_midpoint_1", &
        "one-dimensional integral", &
        u, results)
 <<MCI midpoint: test declarations>>=
   public :: mci_midpoint_1
 <<MCI midpoint: tests>>=
   subroutine mci_midpoint_1 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
 
     write (u, "(A)")  "* Test output: mci_midpoint_1"
     write (u, "(A)")  "*   Purpose: integrate function in one dimension"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_midpoint_t :: mci)
     call mci%set_dimensions (1, 1)
 
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_1_t :: sampler)
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for x = 0.8"
     write (u, "(A)")
 
     call mci_instance%evaluate (sampler, 1, [0.8_default])
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for x = 0.7"
     write (u, "(A)")
 
     call mci_instance%evaluate (sampler, 1, [0.7_default])
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for x = 0.9"
     write (u, "(A)")
 
     call mci_instance%evaluate (sampler, 1, [0.9_default])
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_calls = 1000"
     write (u, "(A)")
 
     call mci%integrate (mci_instance, sampler, 1, 1000)
     call mci%write (u)
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_midpoint_1"
 
   end subroutine mci_midpoint_1
 
 @ %def mci_midpoint_1
 @
 \subsubsection{Two-dimensional integration}
 Construct an integrator and use it for a two-dimensional sampler.
 <<MCI midpoint: execute tests>>=
   call test (mci_midpoint_2, "mci_midpoint_2", &
        "two-dimensional integral", &
        u, results)
 <<MCI midpoint: test declarations>>=
   public :: mci_midpoint_2
 <<MCI midpoint: tests>>=
   subroutine mci_midpoint_2 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
 
     write (u, "(A)")  "* Test output: mci_midpoint_2"
     write (u, "(A)")  "*   Purpose: integrate function in two dimensions"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_midpoint_t :: mci)
     call mci%set_dimensions (2, 1)
 
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_2_t :: sampler)
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for x = 0.8, y = 0.2"
     write (u, "(A)")
 
     call mci_instance%evaluate (sampler, 1, [0.8_default, 0.2_default])
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_calls = 1000"
     write (u, "(A)")
 
     call mci%integrate (mci_instance, sampler, 1, 1000)
     call mci%write (u)
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_midpoint_2"
 
   end subroutine mci_midpoint_2
 
 @ %def mci_midpoint_2
 @
 \subsubsection{Two-dimensional integration with flat dimension}
 Construct an integrator and use it for a two-dimensional sampler,
 where the function is constant in the second dimension.
 <<MCI midpoint: execute tests>>=
   call test (mci_midpoint_3, "mci_midpoint_3", &
        "two-dimensional integral with flat dimension", &
        u, results)
 <<MCI midpoint: test declarations>>=
   public :: mci_midpoint_3
 <<MCI midpoint: tests>>=
   subroutine mci_midpoint_3 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
 
     write (u, "(A)")  "* Test output: mci_midpoint_3"
     write (u, "(A)")  "*   Purpose: integrate function with one flat dimension"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_midpoint_t :: mci)
     select type (mci)
     type is (mci_midpoint_t)
        call mci%set_dimensions (2, 1)
        call mci%declare_flat_dimensions ([2])
     end select
 
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_1_t :: sampler)
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for x = 0.8, y = 0.2"
     write (u, "(A)")
 
     call mci_instance%evaluate (sampler, 1, [0.8_default, 0.2_default])
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_calls = 1000"
     write (u, "(A)")
 
     call mci%integrate (mci_instance, sampler, 1, 1000)
     call mci%write (u)
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_midpoint_3"
 
   end subroutine mci_midpoint_3
 
 @ %def mci_midpoint_3
 @
 \subsubsection{Integrand with sign flip}
 Construct an integrator and use it for a one-dimensional sampler.
 <<MCI midpoint: execute tests>>=
   call test (mci_midpoint_4, "mci_midpoint_4", &
        "integrand with sign flip", &
        u, results)
 <<MCI midpoint: test declarations>>=
   public :: mci_midpoint_4
 <<MCI midpoint: tests>>=
   subroutine mci_midpoint_4 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
 
     write (u, "(A)")  "* Test output: mci_midpoint_4"
     write (u, "(A)")  "*   Purpose: integrate function with sign flip &
          &in one dimension"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_midpoint_t :: mci)
     call mci%set_dimensions (1, 1)
 
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_4_t :: sampler)
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate for x = 0.8"
     write (u, "(A)")
 
     call mci_instance%evaluate (sampler, 1, [0.8_default])
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_calls = 1000"
     write (u, "(A)")
 
     call mci%integrate (mci_instance, sampler, 1, 1000)
     call mci%write (u)
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_midpoint_4"
 
   end subroutine mci_midpoint_4
 
 @ %def mci_midpoint_4
 @
 \subsubsection{Weighted events}
 Generate weighted events.  Without rejection, we do not need to know maxima
 and minima, so we can start generating events immediately.  We have two
 dimensions.
 <<MCI midpoint: execute tests>>=
   call test (mci_midpoint_5, "mci_midpoint_5", &
        "weighted events", &
        u, results)
 <<MCI midpoint: test declarations>>=
   public :: mci_midpoint_5
 <<MCI midpoint: tests>>=
   subroutine mci_midpoint_5 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
     class(mci_state_t), allocatable :: state
 
     write (u, "(A)")  "* Test output: mci_midpoint_5"
     write (u, "(A)")  "*   Purpose: generate weighted events"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_midpoint_t :: mci)
     call mci%set_dimensions (2, 1)
 
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_2_t :: sampler)
 
     write (u, "(A)")  "* Initialize random-number generator"
     write (u, "(A)")
 
     allocate (rng_test_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     write (u, "(A)")  "* Generate weighted event"
     write (u, "(A)")
 
     call mci%generate_weighted_event (mci_instance, sampler)
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate weighted event"
     write (u, "(A)")
 
     call mci%generate_weighted_event (mci_instance, sampler)
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Store data"
     write (u, "(A)")
 
     allocate (state)
     call mci_instance%store (state)
     call mci_instance%final ()
     deallocate (mci_instance)
 
     call state%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Recall data and rebuild event"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
     call mci%rebuild_event (mci_instance, sampler, state)
 
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     deallocate (mci_instance)
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_midpoint_5"
 
   end subroutine mci_midpoint_5
 
 @ %def mci_midpoint_5
 @
 \subsubsection{Unweighted events}
 Generate unweighted events.  The integrand has a sign flip in it.
 <<MCI midpoint: execute tests>>=
   call test (mci_midpoint_6, "mci_midpoint_6", &
        "unweighted events", &
        u, results)
 <<MCI midpoint: test declarations>>=
   public :: mci_midpoint_6
 <<MCI midpoint: tests>>=
   subroutine mci_midpoint_6 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_midpoint_6"
     write (u, "(A)")  "*   Purpose: generate unweighted events"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_midpoint_t :: mci)
     call mci%set_dimensions (1, 1)
 
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_4_t :: sampler)
 
     write (u, "(A)")  "* Initialize random-number generator"
     write (u, "(A)")
 
     allocate (rng_test_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     write (u, "(A)")  "* Integrate (determine maximum of integrand"
     write (u, "(A)")
     call mci%integrate (mci_instance, sampler, 1, 1000)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate unweighted event"
     write (u, "(A)")
 
     call mci%generate_unweighted_event (mci_instance, sampler)
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     deallocate (mci_instance)
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_midpoint_6"
 
   end subroutine mci_midpoint_6
 
 @ %def mci_midpoint_6
 @
 \subsubsection{Excess weight}
 Generate unweighted events.  With only 2 points for integration, the
 maximum of the integrand is too low, and we produce excess weight.
 <<MCI midpoint: execute tests>>=
   call test (mci_midpoint_7, "mci_midpoint_7", &
        "excess weight", &
        u, results)
 <<MCI midpoint: test declarations>>=
   public :: mci_midpoint_7
 <<MCI midpoint: tests>>=
   subroutine mci_midpoint_7 (u)
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_midpoint_7"
     write (u, "(A)")  "*   Purpose: generate unweighted event &
          &with excess weight"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_midpoint_t :: mci)
     call mci%set_dimensions (1, 1)
 
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_4_t :: sampler)
 
     write (u, "(A)")  "* Initialize random-number generator"
     write (u, "(A)")
 
     allocate (rng_test_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     write (u, "(A)")  "* Integrate (determine maximum of integrand"
     write (u, "(A)")
     call mci%integrate (mci_instance, sampler, 1, 2)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate unweighted event"
     write (u, "(A)")
 
     call mci_instance%init_simulation ()
     call mci%generate_unweighted_event (mci_instance, sampler)
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Use getter methods"
     write (u, "(A)")
 
     write (u, "(1x,A,1x,ES19.12)")  "weight =", mci_instance%get_event_weight ()
     write (u, "(1x,A,1x,ES19.12)")  "excess =", mci_instance%get_event_excess ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Apply safety factor"
     write (u, "(A)")
 
     call mci_instance%init_simulation (safety_factor = 2.1_default)
 
     write (u, "(A)")  "* Generate unweighted event"
     write (u, "(A)")
 
     call mci%generate_unweighted_event (mci_instance, sampler)
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Use getter methods"
     write (u, "(A)")
 
     write (u, "(1x,A,1x,ES19.12)")  "weight =", mci_instance%get_event_weight ()
     write (u, "(1x,A,1x,ES19.12)")  "excess =", mci_instance%get_event_excess ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     deallocate (mci_instance)
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_midpoint_7"
 
   end subroutine mci_midpoint_7
 
 @ %def mci_midpoint_7
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{\vamp\ interface}
 The standard method for integration is \vamp: the multi-channel
 version of the VEGAS algorithm.  Each parameterization (channel) of
 the hypercube is binned in each dimension.  The binning is equally
 equidistant, but an iteration of the integration procedure,
 the binning is updated for each dimension, according to the variance
 distribution of the integrand, summed over all other dimension.  In
 the next iteration, the binning approximates (hopefully) follows the
 integrand more closely, and the accuracy of the result is increased.
 Furthermore, the relative weight of the individual channels is also updated
 after an iteration.
 
 The bin distribution is denoted as the grid for a channel, which we
 can write to file and reuse later.
 
 In our implementation we specify the generic \vamp\ algorithm more
 tightly: the number of bins is equal for all dimensions, the initial
 weights are all equal.  The user controls whether to update bins
 and/or weights after each iteration.  The integration is organized in
 passes, each one consisting of several iterations with a common number
 of calls to the integrand.  The first passes are intended as warmup,
 so the results are displayed but otherwise discarded.  In the final
 pass, the integration estimates for the individual iterations are
 averaged for the final result.
 <<[[mci_vamp.f90]]>>=
 <<File header>>
 
 module mci_vamp
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use constants, only: zero
   use format_utils, only: pac_fmt
   use format_utils, only: write_separator
   use format_defs, only: FMT_12, FMT_14, FMT_17, FMT_19
   use diagnostics
   use md5
   use phs_base
   use rng_base
   use rng_tao
   use vamp !NODEP!
   use exceptions !NODEP!
 
   use mci_base
 
 <<Standard module head>>
 
 <<MCI vamp: public>>
 
 <<MCI vamp: types>>
 
 <<MCI vamp: interfaces>>
 
 contains
 
 <<MCI vamp: procedures>>
 
 end module mci_vamp
 @ %def mci_vamp
 @
 \subsection{Grid parameters}
 This is a transparent container.  It holds the parameters that are
 stored in grid files, and are checked when grid files are read.
 <<MCI vamp: public>>=
   public :: grid_parameters_t
 <<MCI vamp: types>>=
   type :: grid_parameters_t
      integer :: threshold_calls = 0
      integer :: min_calls_per_channel = 10
      integer :: min_calls_per_bin = 10
      integer :: min_bins = 3
      integer :: max_bins = 20
      logical :: stratified = .true.
      logical :: use_vamp_equivalences = .true.
      real(default) :: channel_weights_power = 0.25_default
      real(default) :: accuracy_goal = 0
      real(default) :: error_goal = 0
      real(default) :: rel_error_goal = 0
    contains
    <<MCI vamp: grid parameters: TBP>>
   end type grid_parameters_t
 
 @ %def grid_parameters_t
 @ I/O:
 <<MCI vamp: grid parameters: TBP>>=
   procedure :: write => grid_parameters_write
 <<MCI vamp: procedures>>=
   subroutine grid_parameters_write (object, unit)
     class(grid_parameters_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(3x,A,I0)") "threshold_calls       = ", &
          object%threshold_calls
     write (u, "(3x,A,I0)") "min_calls_per_channel = ", &
          object%min_calls_per_channel
     write (u, "(3x,A,I0)") "min_calls_per_bin     = ", &
          object%min_calls_per_bin
     write (u, "(3x,A,I0)") "min_bins              = ", &
          object%min_bins
     write (u, "(3x,A,I0)") "max_bins              = ", &
          object%max_bins
     write (u, "(3x,A,L1)") "stratified            = ", &
          object%stratified
     write (u, "(3x,A,L1)") "use_vamp_equivalences = ", &
          object%use_vamp_equivalences
     write (u, "(3x,A,F10.7)") "channel_weights_power = ", &
          object%channel_weights_power
     if (object%accuracy_goal > 0) then
        write (u, "(3x,A,F10.7)") "accuracy_goal         = ", &
             object%accuracy_goal
     end if
     if (object%error_goal > 0) then
        write (u, "(3x,A,F10.7)") "error_goal            = ", &
             object%error_goal
     end if
     if (object%rel_error_goal > 0) then
        write (u, "(3x,A,F10.7)") "rel_error_goal        = ", &
             object%rel_error_goal
     end if
   end subroutine grid_parameters_write
 
 @ %def grid_parameters_write
 @
 \subsection{History parameters}
 The history parameters are also stored in a transparent container.
 This is not a part of the grid definition, and should not be included
 in the MD5 sum.
 <<MCI vamp: public>>=
   public :: history_parameters_t
 <<MCI vamp: types>>=
   type :: history_parameters_t
      logical :: global = .true.
      logical :: global_verbose = .false.
      logical :: channel = .false.
      logical :: channel_verbose = .false.
    contains
    <<MCI vamp: history parameters: TBP>>
   end type history_parameters_t
 
 @ %def history_parameters_t
 @ I/O:
 <<MCI vamp: history parameters: TBP>>=
   procedure :: write => history_parameters_write
 <<MCI vamp: procedures>>=
   subroutine history_parameters_write (object, unit)
     class(history_parameters_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(3x,A,L1)") "history(global)       = ", object%global
     write (u, "(3x,A,L1)") "history(global) verb. = ", object%global_verbose
     write (u, "(3x,A,L1)") "history(channels)     = ", object%channel
     write (u, "(3x,A,L1)") "history(chann.) verb. = ", object%channel_verbose
   end subroutine history_parameters_write
 
 @ %def history_parameters_write
 @
 \subsection{Integration pass}
 We store the parameters for each integration pass in a linked list.
 <<MCI vamp: types>>=
   type :: pass_t
      integer :: i_pass = 0
      integer :: i_first_it = 0
      integer :: n_it = 0
      integer :: n_calls = 0
      integer :: n_bins = 0
      logical :: adapt_grids = .false.
      logical :: adapt_weights = .false.
      logical :: is_final_pass = .false.
      logical :: integral_defined = .false.
      integer, dimension(:), allocatable :: calls
      integer, dimension(:), allocatable :: calls_valid
      real(default), dimension(:), allocatable :: integral
      real(default), dimension(:), allocatable :: error
      real(default), dimension(:), allocatable :: efficiency
      type(vamp_history), dimension(:), allocatable :: v_history
      type(vamp_history), dimension(:,:), allocatable :: v_histories
      type(pass_t), pointer :: next => null ()
    contains
    <<MCI vamp: pass: TBP>>
   end type pass_t
 
 @ %def pass_t
 @ Finalizer.  The VAMP histories contain a pointer array.
 <<MCI vamp: pass: TBP>>=
   procedure :: final => pass_final
 <<MCI vamp: procedures>>=
   subroutine pass_final (object)
     class(pass_t), intent(inout) :: object
     if (allocated (object%v_history)) then
        call vamp_delete_history (object%v_history)
     end if
     if (allocated (object%v_histories)) then
        call vamp_delete_history (object%v_histories)
     end if
   end subroutine pass_final
 
 @ %def pass_final
 @ Output.  Note that the precision of the numerical values should match the
 precision for comparing output from file with data.
 <<MCI vamp: pass: TBP>>=
   procedure :: write => pass_write
 <<MCI vamp: procedures>>=
   subroutine pass_write (object, unit, pacify)
     class(pass_t), intent(in) :: object
     integer, intent(in) :: unit
     logical, intent(in), optional :: pacify
     integer :: u, i
     character(len=7) :: fmt
     call pac_fmt (fmt, FMT_17, FMT_14, pacify)
     u = given_output_unit (unit)
     write (u, "(3x,A,I0)")  "n_it          = ", object%n_it
     write (u, "(3x,A,I0)")  "n_calls       = ", object%n_calls
     write (u, "(3x,A,I0)")  "n_bins        = ", object%n_bins
     write (u, "(3x,A,L1)")  "adapt grids   = ", object%adapt_grids
     write (u, "(3x,A,L1)")  "adapt weights = ", object%adapt_weights
     if (object%integral_defined) then
        write (u, "(3x,A)")  "Results:  [it, calls, valid, integral, error, efficiency]"
        do i = 1, object%n_it
           write (u, "(5x,I0,2(1x,I0),3(1x," // fmt // "))") &
                i, object%calls(i), object%calls_valid(i), object%integral(i), object%error(i), &
                object%efficiency(i)
        end do
     else
        write (u, "(3x,A)")  "Results: [undefined]"
     end if
   end subroutine pass_write
 
 @ %def pass_write
 @ Read and reconstruct the pass.
 <<MCI vamp: pass: TBP>>=
   procedure :: read => pass_read
 <<MCI vamp: procedures>>=
   subroutine pass_read (object, u, n_pass, n_it)
     class(pass_t), intent(out) :: object
     integer, intent(in) :: u, n_pass, n_it
     integer :: i, j
     character(80) :: buffer
     object%i_pass = n_pass + 1
     object%i_first_it = n_it + 1
     call read_ival (u, object%n_it)
     call read_ival (u, object%n_calls)
     call read_ival (u, object%n_bins)
     call read_lval (u, object%adapt_grids)
     call read_lval (u, object%adapt_weights)
     allocate (object%calls (object%n_it), source = 0)
     allocate (object%calls_valid (object%n_it), source = 0)
     allocate (object%integral (object%n_it), source = 0._default)
     allocate (object%error (object%n_it), source = 0._default)
     allocate (object%efficiency (object%n_it), source = 0._default)
     read (u, "(A)")  buffer
     select case (trim (adjustl (buffer)))
     case ("Results:  [it, calls, valid, integral, error, efficiency]")
        do i = 1, object%n_it
           read (u, *) &
                j, object%calls(i), object%calls_valid(i), object%integral(i), object%error(i), &
                object%efficiency(i)
        end do
        object%integral_defined = .true.
     case ("Results: [undefined]")
        object%integral_defined = .false.
     case default
        call msg_fatal ("Reading integration pass: corrupted file")
     end select
   end subroutine pass_read
 
 @ %def pass_read
 @ Write the VAMP history for this pass.  (The subroutine writes the
 whole array at once.)
 <<MCI vamp: pass: TBP>>=
   procedure :: write_history => pass_write_history
 <<MCI vamp: procedures>>=
   subroutine pass_write_history (pass, unit)
     class(pass_t), intent(in) :: pass
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     if (allocated (pass%v_history)) then
        call vamp_write_history (u, pass%v_history)
     else
        write (u, "(1x,A)")  "Global history: [undefined]"
     end if
     if (allocated (pass%v_histories)) then
        write (u, "(1x,A)")  "Channel histories:"
        call vamp_write_history (u, pass%v_histories)
     else
        write (u, "(1x,A)")  "Channel histories: [undefined]"
     end if
   end subroutine pass_write_history
 
 @ %def pass_write_history
 @ Given a number of calls and iterations, compute remaining data.
 <<MCI vamp: pass: TBP>>=
   procedure :: configure => pass_configure
 <<MCI vamp: procedures>>=
   subroutine pass_configure (pass, n_it, n_calls, min_calls, &
        min_bins, max_bins, min_channel_calls)
     class(pass_t), intent(inout) :: pass
     integer, intent(in) :: n_it, n_calls, min_channel_calls
     integer, intent(in) :: min_calls, min_bins, max_bins
     pass%n_it = n_it
     if (min_calls /= 0) then
        pass%n_bins =  max (min_bins, &
             min (n_calls / min_calls, max_bins))
     else
        pass%n_bins = max_bins
     end if
     pass%n_calls = max (n_calls, max (min_calls, min_channel_calls))
     if (pass%n_calls /= n_calls) then
        write (msg_buffer, "(A,I0)")  "VAMP: too few calls, resetting " &
             // "n_calls to ", pass%n_calls
        call msg_warning ()
     end if
     allocate (pass%calls (n_it), source = 0)
     allocate (pass%calls_valid (n_it), source = 0)
     allocate (pass%integral (n_it), source = 0._default)
     allocate (pass%error (n_it), source = 0._default)
     allocate (pass%efficiency (n_it), source = 0._default)
   end subroutine pass_configure
 
 @ %def pass_configure
 @ Allocate the VAMP history and give options.  We assume that the
 [[configure]] routine above has been executed, so the number of
 iterations is known.
 <<MCI vamp: pass: TBP>>=
   procedure :: configure_history => pass_configure_history
 <<MCI vamp: procedures>>=
   subroutine pass_configure_history (pass, n_channels, par)
     class(pass_t), intent(inout) :: pass
     integer, intent(in) :: n_channels
     type(history_parameters_t), intent(in) :: par
     if (par%global) then
        allocate (pass%v_history (pass%n_it))
        call vamp_create_history (pass%v_history, &
             verbose = par%global_verbose)
     end if
     if (par%channel) then
        allocate (pass%v_histories (pass%n_it, n_channels))
        call vamp_create_history (pass%v_histories, &
             verbose = par%channel_verbose)
     end if
   end subroutine pass_configure_history
 
 @ %def pass_configure_history
 @ Given two pass objects, compare them.  All parameters must match.  Where
 integrations are done in both (number of calls nonzero), the results must be
 equal (up to numerical noise).
 
 The allocated array sizes might be different, but should match up to the
 common [[n_it]] value.
 <<MCI vamp: interfaces>>=
   interface operator (.matches.)
      module procedure pass_matches
   end interface operator (.matches.)
 <<MCI vamp: procedures>>=
   function pass_matches (pass, ref) result (ok)
     type(pass_t), intent(in) :: pass, ref
     integer :: n
     logical :: ok
     ok = .true.
     if (ok)  ok = pass%i_pass == ref%i_pass
     if (ok)  ok = pass%i_first_it == ref%i_first_it
     if (ok)  ok = pass%n_it == ref%n_it
     if (ok)  ok = pass%n_calls == ref%n_calls
     if (ok)  ok = pass%n_bins == ref%n_bins
     if (ok)  ok = pass%adapt_grids .eqv. ref%adapt_grids
     if (ok)  ok = pass%adapt_weights .eqv. ref%adapt_weights
     if (ok)  ok = pass%integral_defined .eqv. ref%integral_defined
     if (pass%integral_defined) then
        n = pass%n_it
        if (ok)  ok = all (pass%calls(:n) == ref%calls(:n))
        if (ok)  ok = all (pass%calls_valid(:n) == ref%calls_valid (:n))
        if (ok)  ok = all (pass%integral(:n) .matches. ref%integral(:n))
        if (ok)  ok = all (pass%error(:n) .matches. ref%error(:n))
        if (ok)  ok = all (pass%efficiency(:n) .matches. ref%efficiency(:n))
     end if
   end function pass_matches
 
 @ %def pass_matches
 @ Update a pass object, given a reference.  The parameters must match, except
 for the [[n_it]] entry.  The number of complete iterations must be less or
 equal to the reference, and the number of complete iterations in the reference
 must be no larger than [[n_it]].  Where results are present in both passes,
 they must match.  Where results are present in the reference only, the pass is
 updated accordingly.
 <<MCI vamp: pass: TBP>>=
   procedure :: update => pass_update
 <<MCI vamp: procedures>>=
   subroutine pass_update (pass, ref, ok)
     class(pass_t), intent(inout) :: pass
     type(pass_t), intent(in) :: ref
     logical, intent(out) :: ok
     integer :: n, n_ref
     ok = .true.
     if (ok)  ok = pass%i_pass == ref%i_pass
     if (ok)  ok = pass%i_first_it == ref%i_first_it
     if (ok)  ok = pass%n_calls == ref%n_calls
     if (ok)  ok = pass%n_bins == ref%n_bins
     if (ok)  ok = pass%adapt_grids .eqv. ref%adapt_grids
     if (ok)  ok = pass%adapt_weights .eqv. ref%adapt_weights
     if (ok) then
        if (ref%integral_defined) then
           if (.not. allocated (pass%calls)) then
              allocate (pass%calls (pass%n_it), source = 0)
              allocate (pass%calls_valid (pass%n_it), source = 0)
              allocate (pass%integral (pass%n_it), source = 0._default)
              allocate (pass%error (pass%n_it), source = 0._default)
              allocate (pass%efficiency (pass%n_it), source = 0._default)
           end if
           n = count (pass%calls /= 0)
           n_ref = count (ref%calls /= 0)
           ok = n <= n_ref .and. n_ref <= pass%n_it
           if (ok)  ok = all (pass%calls(:n) == ref%calls(:n))
           if (ok)  ok = all (pass%calls_valid(:n) == ref%calls_valid(:n))
           if (ok)  ok = all (pass%integral(:n) .matches. ref%integral(:n))
           if (ok)  ok = all (pass%error(:n) .matches. ref%error(:n))
           if (ok)  ok = all (pass%efficiency(:n) .matches. ref%efficiency(:n))
           if (ok) then
              pass%calls(n+1:n_ref) = ref%calls(n+1:n_ref)
              pass%calls_valid(n+1:n_ref) = ref%calls_valid(n+1:n_ref)
              pass%integral(n+1:n_ref) = ref%integral(n+1:n_ref)
              pass%error(n+1:n_ref) = ref%error(n+1:n_ref)
              pass%efficiency(n+1:n_ref) = ref%efficiency(n+1:n_ref)
              pass%integral_defined = any (pass%calls /= 0)
           end if
        end if
     end if
   end subroutine pass_update
 
 @ %def pass_update
 @ Match two real numbers: they are equal up to a tolerance, which is
 $10^{-8}$, matching the number of digits that are output by [[pass_write]].
 In particular, if one number is exactly zero, the other one must also be zero.
 <<MCI vamp: interfaces>>=
   interface operator (.matches.)
      module procedure real_matches
   end interface operator (.matches.)
 <<MCI vamp: procedures>>=
   elemental function real_matches (x, y) result (ok)
     real(default), intent(in) :: x, y
     logical :: ok
     real(default), parameter :: tolerance = 1.e-8_default
     ok = abs (x - y) <= tolerance * max (abs (x), abs (y))
   end function real_matches
 
 @ %def real_matches
 @ Return the index of the most recent complete integration.  If there is none,
 return zero.
 <<MCI vamp: pass: TBP>>=
   procedure :: get_integration_index => pass_get_integration_index
 <<MCI vamp: procedures>>=
   function pass_get_integration_index (pass) result (n)
     class (pass_t), intent(in) :: pass
     integer :: n
     integer :: i
     n = 0
     if (allocated (pass%calls)) then
        do i = 1, pass%n_it
           if (pass%calls(i) == 0)  exit
           n = i
        end do
     end if
   end function pass_get_integration_index
 
 @ %def pass_get_integration_index
 @ Return the most recent integral and error, if available.
 <<MCI vamp: pass: TBP>>=
   procedure :: get_calls => pass_get_calls
   procedure :: get_calls_valid => pass_get_calls_valid
   procedure :: get_integral => pass_get_integral
   procedure :: get_error => pass_get_error
   procedure :: get_efficiency => pass_get_efficiency
 <<MCI vamp: procedures>>=
   function pass_get_calls (pass) result (calls)
     class(pass_t), intent(in) :: pass
     integer :: calls
     integer :: n
     n = pass%get_integration_index ()
     if (n /= 0) then
        calls = pass%calls(n)
     else
        calls = 0
     end if
   end function pass_get_calls
 
   function pass_get_calls_valid (pass) result (calls_valid)
     class(pass_t), intent(in) :: pass
     integer :: calls_valid
     integer :: n
     n = pass%get_integration_index ()
     if (n /= 0) then
        calls_valid = pass%calls_valid(n)
     else
        calls_valid = 0
     end if
   end function pass_get_calls_valid
 
   function pass_get_integral (pass) result (integral)
     class(pass_t), intent(in) :: pass
     real(default) :: integral
     integer :: n
     n = pass%get_integration_index ()
     if (n /= 0) then
        integral = pass%integral(n)
     else
        integral = 0
     end if
   end function pass_get_integral
 
   function pass_get_error (pass) result (error)
     class(pass_t), intent(in) :: pass
     real(default) :: error
     integer :: n
     n = pass%get_integration_index ()
     if (n /= 0) then
        error = pass%error(n)
     else
        error = 0
     end if
   end function pass_get_error
 
   function pass_get_efficiency (pass) result (efficiency)
     class(pass_t), intent(in) :: pass
     real(default) :: efficiency
     integer :: n
     n = pass%get_integration_index ()
     if (n /= 0) then
        efficiency = pass%efficiency(n)
     else
        efficiency = 0
     end if
   end function pass_get_efficiency
 
 @ %def pass_get_calls
 @ %def pass_get_calls_valid
 @ %def pass_get_integral
 @ %def pass_get_error
 @ %def pass_get_efficiency
 @
 \subsection{Integrator}
 <<MCI vamp: public>>=
   public :: mci_vamp_t
 <<MCI vamp: types>>=
   type, extends (mci_t) :: mci_vamp_t
      logical, dimension(:), allocatable :: dim_is_flat
      type(grid_parameters_t) :: grid_par
      type(history_parameters_t) :: history_par
      integer :: min_calls = 0
      type(pass_t), pointer :: first_pass => null ()
      type(pass_t), pointer :: current_pass => null ()
      type(vamp_equivalences_t) :: equivalences
      logical :: rebuild = .true.
      logical :: check_grid_file = .true.
      logical :: grid_filename_set = .false.
      logical :: negative_weights = .false.
      logical :: verbose = .false.
      type(string_t) :: grid_filename
      character(32) :: md5sum_adapted = ""
    contains
    <<MCI vamp: mci vamp: TBP>>
   end type mci_vamp_t
 
 @ %def mci_vamp_t
 @ Reset: delete integration-pass entries.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: reset => mci_vamp_reset
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_reset (object)
     class(mci_vamp_t), intent(inout) :: object
     type(pass_t), pointer :: current_pass
     do while (associated (object%first_pass))
        current_pass => object%first_pass
        object%first_pass => current_pass%next
        call current_pass%final ()
        deallocate (current_pass)
     end do
     object%current_pass => null ()
   end subroutine mci_vamp_reset
 
 @ %def mci_vamp_reset
 @ Finalizer: reset and finalize the equivalences list.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: final => mci_vamp_final
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_final (object)
     class(mci_vamp_t), intent(inout) :: object
     call object%reset ()
     call vamp_equivalences_final (object%equivalences)
     call object%base_final ()
   end subroutine mci_vamp_final
 
 @ %def mci_vamp_final
 @ Output.  Do not output the grids themselves, this may result in tons
 of data.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: write => mci_vamp_write
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_write (object, unit, pacify, md5sum_version)
     class(mci_vamp_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacify
     logical, intent(in), optional :: md5sum_version
     type(pass_t), pointer :: current_pass
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "VAMP integrator:"
     call object%base_write (u, pacify, md5sum_version)
     if (allocated (object%dim_is_flat)) then
        write (u, "(3x,A,999(1x,I0))")  "Flat dimensions    =", &
             pack ([(i, i = 1, object%n_dim)], object%dim_is_flat)
     end if
     write (u, "(1x,A)")  "Grid parameters:"
     call object%grid_par%write (u)
     write (u, "(3x,A,I0)") "min_calls             = ", object%min_calls
     write (u, "(3x,A,L1)") "negative weights      = ", &
          object%negative_weights
     write (u, "(3x,A,L1)") "verbose               = ", &
          object%verbose
     if (object%grid_par%use_vamp_equivalences) then
        call vamp_equivalences_write (object%equivalences, u)
     end if
     current_pass => object%first_pass
     do while (associated (current_pass))
        write (u, "(1x,A,I0,A)")  "Integration pass:"
        call current_pass%write (u, pacify)
        current_pass => current_pass%next
     end do
     if (object%md5sum_adapted /= "") then
        write (u, "(1x,A,A,A)")  "MD5 sum (including results) = '", &
             object%md5sum_adapted, "'"
     end if
   end subroutine mci_vamp_write
 
 @ %def mci_vamp_write
 @ Write the history parameters.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: write_history_parameters => mci_vamp_write_history_parameters
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_write_history_parameters (mci, unit)
     class(mci_vamp_t), intent(in) :: mci
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "VAMP history parameters:"
     call mci%history_par%write (unit)
   end subroutine mci_vamp_write_history_parameters
 
 @ %def mci_vamp_write_history_parameters
 @ Write the history, iterating over passes.  We keep this separate
 from the generic [[write]] routine.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: write_history => mci_vamp_write_history
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_write_history (mci, unit)
     class(mci_vamp_t), intent(in) :: mci
     integer, intent(in), optional :: unit
     type(pass_t), pointer :: current_pass
     integer :: i_pass
     integer :: u
     u = given_output_unit (unit)
     if (associated (mci%first_pass)) then
        write (u, "(1x,A)")  "VAMP history (global):"
        i_pass = 0
        current_pass => mci%first_pass
        do while (associated (current_pass))
           i_pass = i_pass + 1
           write (u, "(1x,A,I0,':')")  "Pass #", i_pass
           call current_pass%write_history (u)
           current_pass => current_pass%next
        end do
     end if
   end subroutine mci_vamp_write_history
 
 @ %def mci_vamp_write_history
 @ Compute the MD5 sum, including the configuration MD5 sum and the
 printout, which incorporates the current results.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: compute_md5sum => mci_vamp_compute_md5sum
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_compute_md5sum (mci, pacify)
     class(mci_vamp_t), intent(inout) :: mci
     logical, intent(in), optional :: pacify
     integer :: u
     mci%md5sum_adapted = ""
     u = free_unit ()
     open (u, status = "scratch", action = "readwrite")
     write (u, "(A)")  mci%md5sum
     call mci%write (u, pacify, md5sum_version = .true.)
     rewind (u)
     mci%md5sum_adapted = md5sum (u)
     close (u)
   end subroutine mci_vamp_compute_md5sum
 
 @ %def mci_vamp_compute_md5sum
 @ Return the MD5 sum: If available, return the adapted one.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: get_md5sum => mci_vamp_get_md5sum
 <<MCI vamp: procedures>>=
   pure function mci_vamp_get_md5sum (mci) result (md5sum)
     class(mci_vamp_t), intent(in) :: mci
     character(32) :: md5sum
     if (mci%md5sum_adapted /= "") then
        md5sum = mci%md5sum_adapted
     else
        md5sum = mci%md5sum
     end if
   end function mci_vamp_get_md5sum
 
 @ %def mci_vamp_get_md5sum
 @ Startup message: short version.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: startup_message => mci_vamp_startup_message
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_startup_message (mci, unit, n_calls)
     class(mci_vamp_t), intent(in) :: mci
     integer, intent(in), optional :: unit, n_calls
     integer :: num_calls, n_bins
     if (present (n_calls)) then
        num_calls = n_calls
     else
        num_calls = 0
     end if
     if (mci%min_calls /= 0) then
        n_bins =  max (mci%grid_par%min_bins, &
             min (num_calls / mci%min_calls, &
             mci%grid_par%max_bins))
     else
        n_bins = mci%grid_par%max_bins
     end if
     call mci%base_startup_message (unit = unit, n_calls = n_calls)
     if (mci%grid_par%use_vamp_equivalences) then
        write (msg_buffer, "(A,2(1x,I0,1x,A))") &
             "Integrator: Using VAMP channel equivalences"
        call msg_message (unit = unit)
     end if
     write (msg_buffer, "(A,2(1x,I0,1x,A),L1)") &
          "Integrator:", num_calls, &
          "initial calls,", n_bins, &
          "bins, stratified = ", &
          mci%grid_par%stratified
     call msg_message (unit = unit)
     write (msg_buffer, "(A,2(1x,I0,1x,A))") &
          "Integrator: VAMP"
     call msg_message (unit = unit)
   end subroutine mci_vamp_startup_message
 
 @ %def mci_vamp_startup_message
 @ Log entry: just headline.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: write_log_entry => mci_vamp_write_log_entry
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_write_log_entry (mci, u)
     class(mci_vamp_t), intent(in) :: mci
     integer, intent(in) :: u
     write (u, "(1x,A)")  "MC Integrator is VAMP"
     call write_separator (u)
     call mci%write_history (u)
     call write_separator (u)
     if (mci%grid_par%use_vamp_equivalences) then
        call vamp_equivalences_write (mci%equivalences, u)
     else
        write (u, "(3x,A)") "No VAMP equivalences have been used"
     end if
     call write_separator (u)
     call mci%write_chain_weights (u)
   end subroutine mci_vamp_write_log_entry
 
 @ %def mci_vamp_write_log_entry
 @ Set the MCI index (necessary for processes with multiple components).
 We append the index to the grid filename, just before the final dotted
 suffix.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: record_index => mci_vamp_record_index
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_record_index (mci, i_mci)
     class(mci_vamp_t), intent(inout) :: mci
     integer, intent(in) :: i_mci
     type(string_t) :: basename, suffix
     character(32) :: buffer
     if (mci%grid_filename_set) then
        basename = mci%grid_filename
        call split (basename, suffix, ".", back=.true.)
        write (buffer, "(I0)")  i_mci
        if (basename /= "") then
           mci%grid_filename = basename // ".m" // trim (buffer) // "." // suffix
        else
           mci%grid_filename = suffix // ".m" // trim (buffer) // ".vg"
        end if
     end if
   end subroutine mci_vamp_record_index
 
 @ %def mci_vamp_record_index
 @ Set the grid parameters.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: set_grid_parameters => mci_vamp_set_grid_parameters
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_set_grid_parameters (mci, grid_par)
     class(mci_vamp_t), intent(inout) :: mci
     type(grid_parameters_t), intent(in) :: grid_par
     mci%grid_par = grid_par
     mci%min_calls = grid_par%min_calls_per_bin * mci%n_channel
   end subroutine mci_vamp_set_grid_parameters
 
 @ %def mci_vamp_set_grid_parameters
 @ Set the history parameters.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: set_history_parameters => mci_vamp_set_history_parameters
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_set_history_parameters (mci, history_par)
     class(mci_vamp_t), intent(inout) :: mci
     type(history_parameters_t), intent(in) :: history_par
     mci%history_par = history_par
   end subroutine mci_vamp_set_history_parameters
 
 @ %def mci_vamp_set_history_parameters
 @ Set the rebuild flag, also the flag for checking the grid file.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: set_rebuild_flag => mci_vamp_set_rebuild_flag
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_set_rebuild_flag (mci, rebuild, check_grid_file)
     class(mci_vamp_t), intent(inout) :: mci
     logical, intent(in) :: rebuild
     logical, intent(in) :: check_grid_file
     mci%rebuild = rebuild
     mci%check_grid_file = check_grid_file
   end subroutine mci_vamp_set_rebuild_flag
 
 @ %def mci_vamp_set_rebuild_flag
 @ Set the filename.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: set_grid_filename => mci_vamp_set_grid_filename
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_set_grid_filename (mci, name, run_id)
     class(mci_vamp_t), intent(inout) :: mci
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: run_id
     if (present (run_id)) then
        mci%grid_filename = name // "." // run_id // ".vg"
     else
        mci%grid_filename = name // ".vg"
     end if
     mci%grid_filename_set = .true.
   end subroutine mci_vamp_set_grid_filename
 
 @ %def mci_vamp_set_grid_filename
 @ To simplify the interface, we prepend a grid path in a separate subroutine.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: prepend_grid_path => mci_vamp_prepend_grid_path
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_prepend_grid_path (mci, prefix)
     class(mci_vamp_t), intent(inout) :: mci
     type(string_t), intent(in) :: prefix
     if (mci%grid_filename_set) then
        mci%grid_filename = prefix // "/" // mci%grid_filename
     else
        call msg_warning ("Cannot add prefix to invalid grid filename!")
     end if
   end subroutine mci_vamp_prepend_grid_path
 
 @ %def mci_vamp_prepend_grid_path
 @ Declare particular dimensions as flat.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: declare_flat_dimensions => mci_vamp_declare_flat_dimensions
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_declare_flat_dimensions (mci, dim_flat)
     class(mci_vamp_t), intent(inout) :: mci
     integer, dimension(:), intent(in) :: dim_flat
     integer :: d
     allocate (mci%dim_is_flat (mci%n_dim), source = .false.)
     do d = 1, size (dim_flat)
        mci%dim_is_flat(dim_flat(d)) = .true.
     end do
   end subroutine mci_vamp_declare_flat_dimensions
 
 @ %def mci_vamp_declare_flat_dimensions
 @ Declare equivalences.  We have an array of channel equivalences,
 provided by the phase-space module.  Here, we translate this into the
 [[vamp_equivalences]] array.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: declare_equivalences => mci_vamp_declare_equivalences
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_declare_equivalences (mci, channel, dim_offset)
     class(mci_vamp_t), intent(inout) :: mci
     type(phs_channel_t), dimension(:), intent(in) :: channel
     integer, intent(in) :: dim_offset
     integer, dimension(:), allocatable :: perm, mode
     integer :: n_channels, n_dim, n_equivalences
     integer :: c, i, j, left, right
     n_channels = mci%n_channel
     n_dim = mci%n_dim
     n_equivalences = 0
     do c = 1, n_channels
        n_equivalences = n_equivalences + size (channel(c)%eq)
     end do
     call vamp_equivalences_init (mci%equivalences, &
          n_equivalences, n_channels, n_dim)
     allocate (perm (n_dim))
     allocate (mode (n_dim))
     perm(1:dim_offset) = [(i, i = 1, dim_offset)]
     mode(1:dim_offset) = VEQ_IDENTITY
     c = 1
     j = 0
     do i = 1, n_equivalences
        if (j < size (channel(c)%eq)) then
           j = j + 1
        else
           c = c + 1
           j = 1
        end if
        associate (eq => channel(c)%eq(j))
          left = c
          right = eq%c
          perm(dim_offset+1:) = eq%perm + dim_offset
          mode(dim_offset+1:) = eq%mode
          call vamp_equivalence_set (mci%equivalences, &
               i, left, right, perm, mode)
        end associate
     end do
     call vamp_equivalences_complete (mci%equivalences)
   end subroutine mci_vamp_declare_equivalences
 
 @ %def mci_vamp_declare_equivalences
 @ Allocate instance with matching type.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: allocate_instance => mci_vamp_allocate_instance
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_allocate_instance (mci, mci_instance)
     class(mci_vamp_t), intent(in) :: mci
     class(mci_instance_t), intent(out), pointer :: mci_instance
     allocate (mci_vamp_instance_t :: mci_instance)
   end subroutine mci_vamp_allocate_instance
 
 @ %def mci_vamp_allocate_instance
 @ Allocate a new integration pass.  We can preset everything that does not
 depend on the number of iterations and calls.  This is postponed to
 the [[integrate]] method.
 
 In the final pass, we do not check accuracy goal etc., since we can assume
 that the user wants to perform and average all iterations in this pass.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: add_pass => mci_vamp_add_pass
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_add_pass (mci, adapt_grids, adapt_weights, final_pass)
     class(mci_vamp_t), intent(inout) :: mci
     logical, intent(in), optional :: adapt_grids, adapt_weights, final_pass
     integer :: i_pass, i_it
     type(pass_t), pointer :: new
     allocate (new)
     if (associated (mci%current_pass)) then
        i_pass = mci%current_pass%i_pass + 1
        i_it   = mci%current_pass%i_first_it + mci%current_pass%n_it
        mci%current_pass%next => new
     else
        i_pass = 1
        i_it = 1
        mci%first_pass => new
     end if
     mci%current_pass => new
     new%i_pass = i_pass
     new%i_first_it = i_it
     if (present (adapt_grids)) then
        new%adapt_grids = adapt_grids
     else
        new%adapt_grids = .false.
     end if
     if (present (adapt_weights)) then
        new%adapt_weights = adapt_weights
     else
        new%adapt_weights = .false.
     end if
     if (present (final_pass)) then
        new%is_final_pass = final_pass
     else
        new%is_final_pass = .false.
     end if
   end subroutine mci_vamp_add_pass
 
 @ %def mci_vamp_add_pass
 @ Update the list of integration passes.  All passes except for the last one
 must match exactly.  For the last one, integration results are updated.  The
 reference output may contain extra passes, these are ignored.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: update_from_ref => mci_vamp_update_from_ref
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_update_from_ref (mci, mci_ref, success)
     class(mci_vamp_t), intent(inout) :: mci
     class(mci_t), intent(in) :: mci_ref
     logical, intent(out) :: success
     type(pass_t), pointer :: current_pass, ref_pass
     select type (mci_ref)
     type is (mci_vamp_t)
        current_pass => mci%first_pass
        ref_pass => mci_ref%first_pass
        success = .true.
        do while (success .and. associated (current_pass))
           if (associated (ref_pass)) then
              if (associated (current_pass%next)) then
                 success = current_pass .matches. ref_pass
              else
                 call current_pass%update (ref_pass, success)
                 if (current_pass%integral_defined) then
                    mci%integral = current_pass%get_integral ()
                    mci%error = current_pass%get_error ()
                    mci%efficiency = current_pass%get_efficiency ()
                    mci%integral_known = .true.
                    mci%error_known = .true.
                    mci%efficiency_known = .true.
                 end if
              end if
              current_pass => current_pass%next
              ref_pass => ref_pass%next
           else
              success = .false.
           end if
        end do
     end select
   end subroutine mci_vamp_update_from_ref
 
 @ %def mci_vamp_update
 @ Update the MCI record (i.e., the integration passes) by reading from input
 stream.  The stream should contain a [[write]] output from a previous run.  We
 first check the MD5 sum of the configuration parameters.  If that matches, we
 proceed directly to the stored integration passes.  If successful, we may
 continue to read the file; the position will be after a blank line that
 must follow the MCI record.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: update => mci_vamp_update
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_update (mci, u, success)
     class(mci_vamp_t), intent(inout) :: mci
     integer, intent(in) :: u
     logical, intent(out) :: success
     character(80) :: buffer
     character(32) :: md5sum_file
     type(mci_vamp_t) :: mci_file
     integer :: n_pass, n_it
     call read_sval (u, md5sum_file)
     if (mci%check_grid_file) then
        success = md5sum_file == mci%md5sum
     else
        success = .true.
     end if
     if (success) then
        read (u, *)
        read (u, "(A)")  buffer
        if (trim (adjustl (buffer)) == "VAMP integrator:") then
           n_pass = 0
           n_it = 0
           do
              read (u, "(A)")  buffer
              select case (trim (adjustl (buffer)))
              case ("")
                 exit
              case ("Integration pass:")
                 call mci_file%add_pass ()
                 call mci_file%current_pass%read (u, n_pass, n_it)
                 n_pass = n_pass + 1
                 n_it = n_it + mci_file%current_pass%n_it
              end select
           end do
           call mci%update_from_ref (mci_file, success)
           call mci_file%final ()
        else
           call msg_fatal ("VAMP: reading grid file: corrupted data")
        end if
     end if
   end subroutine mci_vamp_update
 
 @ %def mci_vamp_update
 @ Read / write grids from / to file.
 
 Bug fix for 2.2.5: after reading grids from file, channel weights
 must be copied back to the [[mci_instance]] record.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: write_grids => mci_vamp_write_grids
   procedure :: read_grids_header => mci_vamp_read_grids_header
   procedure :: read_grids_data => mci_vamp_read_grids_data
   procedure :: read_grids => mci_vamp_read_grids
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_write_grids (mci, instance)
     class(mci_vamp_t), intent(in) :: mci
     class(mci_instance_t), intent(inout) :: instance
     integer :: u
     select type (instance)
     type is (mci_vamp_instance_t)
        if (mci%grid_filename_set) then
           if (instance%grids_defined) then
              u = free_unit ()
              open (u, file = char (mci%grid_filename), &
                   action = "write", status = "replace")
              write (u, "(1x,A,A,A)")  "MD5sum = '", mci%md5sum, "'"
              write (u, *)
              call mci%write (u)
              write (u, *)
              write (u, "(1x,A)")  "VAMP grids:"
              call vamp_write_grids (instance%grids, u, &
                   write_integrals = .true.)
              close (u)
           else
              call msg_bug ("VAMP: write grids: grids undefined")
           end if
        else
           call msg_bug ("VAMP: write grids: filename undefined")
        end if
     end select
   end subroutine mci_vamp_write_grids
 
   subroutine mci_vamp_read_grids_header (mci, success)
     class(mci_vamp_t), intent(inout) :: mci
     logical, intent(out) :: success
     logical :: exist
     integer :: u
     success = .false.
     if (mci%grid_filename_set) then
        inquire (file = char (mci%grid_filename), exist = exist)
        if (exist) then
           u = free_unit ()
           open (u, file = char (mci%grid_filename), &
                action = "read", status = "old")
           call mci%update (u, success)
           close (u)
           if (.not. success) then
              write (msg_buffer, "(A,A,A)") &
                   "VAMP: parameter mismatch, discarding grid file '", &
                   char (mci%grid_filename), "'"
              call msg_message ()
           end if
        end if
     else
        call msg_bug ("VAMP: read grids: filename undefined")
     end if
   end subroutine mci_vamp_read_grids_header
 
   subroutine mci_vamp_read_grids_data (mci, instance, read_integrals)
     class(mci_vamp_t), intent(in) :: mci
     class(mci_instance_t), intent(inout) :: instance
     logical, intent(in), optional :: read_integrals
     integer :: u
     character(80) :: buffer
     select type (instance)
     type is (mci_vamp_instance_t)
        if (.not. instance%grids_defined) then
           u = free_unit ()
           open (u, file = char (mci%grid_filename), &
                action = "read", status = "old")
           do
              read (u, "(A)")  buffer
              if (trim (adjustl (buffer)) == "VAMP grids:")  exit
           end do
           call vamp_read_grids (instance%grids, u, read_integrals)
           close (u)
           call instance%set_channel_weights (instance%grids%weights)
           instance%grids_defined = .true.
        else
           call msg_bug ("VAMP: read grids: grids already defined")
        end if
     end select
   end subroutine mci_vamp_read_grids_data
 
   subroutine mci_vamp_read_grids (mci, instance, success)
     class(mci_vamp_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout) :: instance
     logical, intent(out) :: success
     logical :: exist
     integer :: u
     character(80) :: buffer
     select type (instance)
     type is (mci_vamp_instance_t)
        success = .false.
        if (mci%grid_filename_set) then
           if (.not. instance%grids_defined) then
              inquire (file = char (mci%grid_filename), exist = exist)
              if (exist) then
                 u = free_unit ()
                 open (u, file = char (mci%grid_filename), &
                      action = "read", status = "old")
                 call mci%update (u, success)
                 if (success) then
                    read (u, "(A)")  buffer
                    if (trim (adjustl (buffer)) == "VAMP grids:") then
                       call vamp_read_grids (instance%grids, u)
                    else
                       call msg_fatal ("VAMP: reading grid file: &
                            &corrupted grid data")
                    end if
                 else
                    write (msg_buffer, "(A,A,A)") &
                         "VAMP: parameter mismatch, discarding grid file '", &
                         char (mci%grid_filename), "'"
                    call msg_message ()
                 end if
                 close (u)
                 instance%grids_defined = success
              end if
           else
              call msg_bug ("VAMP: read grids: grids already defined")
           end if
        else
           call msg_bug ("VAMP: read grids: filename undefined")
        end if
     end select
   end subroutine mci_vamp_read_grids
 
 @ %def mci_vamp_write_grids
 @ %def mci_vamp_read_grids_header
 @ %def mci_vamp_read_grids_data
 @ %def mci_vamp_read_grids
 @ Auxiliary: Read real, integer, string value.  We search for an equals sign,
 the value must follow.
 <<MCI vamp: procedures>>=
   subroutine read_rval (u, rval)
     integer, intent(in) :: u
     real(default), intent(out) :: rval
     character(80) :: buffer
     read (u, "(A)")  buffer
     buffer = adjustl (buffer(scan (buffer, "=") + 1:))
     read (buffer, *)  rval
   end subroutine read_rval
 
   subroutine read_ival (u, ival)
     integer, intent(in) :: u
     integer, intent(out) :: ival
     character(80) :: buffer
     read (u, "(A)")  buffer
     buffer = adjustl (buffer(scan (buffer, "=") + 1:))
     read (buffer, *)  ival
   end subroutine read_ival
 
   subroutine read_sval (u, sval)
     integer, intent(in) :: u
     character(*), intent(out) :: sval
     character(80) :: buffer
     read (u, "(A)")  buffer
     buffer = adjustl (buffer(scan (buffer, "=") + 1:))
     read (buffer, *)  sval
   end subroutine read_sval
 
   subroutine read_lval (u, lval)
     integer, intent(in) :: u
     logical, intent(out) :: lval
     character(80) :: buffer
     read (u, "(A)")  buffer
     buffer = adjustl (buffer(scan (buffer, "=") + 1:))
     read (buffer, *)  lval
   end subroutine read_lval
 
 @ %def read_rval read_ival read_sval read_lval
 @ Integrate.  Perform a new integration pass (possibly reusing
 previous results), which may consist of several iterations.
 
 Note: we record the integral once per iteration.  The integral stored
 in the [[mci]] record itself is the last integral of the current
 iteration, no averaging done.  The [[results]] record may average results.
 
 Note: recording the efficiency is not supported yet.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: integrate => mci_vamp_integrate
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_integrate (mci, instance, sampler, &
        n_it, n_calls, results, pacify)
     class(mci_vamp_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     integer, intent(in) :: n_it
     integer, intent(in) :: n_calls
     class(mci_results_t), intent(inout), optional :: results
     logical, intent(in), optional :: pacify
     integer :: it
     logical :: reshape, from_file, success
     select type (instance)
     type is (mci_vamp_instance_t)
        if (associated (mci%current_pass)) then
           mci%current_pass%integral_defined = .false.
           call mci%current_pass%configure (n_it, n_calls, &
                mci%min_calls, mci%grid_par%min_bins, &
                mci%grid_par%max_bins, &
                mci%grid_par%min_calls_per_channel * mci%n_channel)
           call mci%current_pass%configure_history &
                (mci%n_channel, mci%history_par)
           instance%pass_complete = .false.
           instance%it_complete = .false.
           call instance%new_pass (reshape)
           if (.not. instance%grids_defined .or. instance%grids_from_file) then
              if (mci%grid_filename_set .and. .not. mci%rebuild) then
                 call mci%read_grids_header (success)
                 from_file = success
                 if (.not. instance%grids_defined .and. success) then
                    call mci%read_grids_data (instance)
                 end if
              else
                 from_file = .false.
              end if
           else
              from_file = .false.
           end if
           if (from_file) then
              if (.not. mci%check_grid_file) &
                   call msg_warning ("Reading grid file: MD5 sum check disabled")
              call msg_message ("VAMP: " &
                   // "using grids and results from file '" &
                   // char (mci%grid_filename) // "'")
           else if (.not. instance%grids_defined) then
              call instance%create_grids ()
           end if
           do it = 1, instance%n_it
              if (signal_is_pending ())  return
              instance%grids_from_file = from_file .and. &
                   it <= mci%current_pass%get_integration_index ()
              if (.not. instance%grids_from_file) then
                 instance%it_complete = .false.
                 call instance%adapt_grids ()
                 if (signal_is_pending ())  return
                 call instance%adapt_weights ()
                 if (signal_is_pending ())  return
                 call instance%discard_integrals (reshape)
                 if (mci%grid_par%use_vamp_equivalences) then
                    call instance%sample_grids (mci%rng, sampler, &
                         mci%equivalences)
                 else
                    call instance%sample_grids (mci%rng, sampler)
                 end if
                 if (signal_is_pending ())  return
                 instance%it_complete = .true.
                 if (instance%integral /= 0) then
                    mci%current_pass%calls(it) = instance%calls
                    mci%current_pass%calls_valid(it) = instance%calls_valid
                    mci%current_pass%integral(it) = instance%integral
                    if (abs (instance%error / instance%integral) &
                         > epsilon (1._default)) then
                       mci%current_pass%error(it) = instance%error
                    end if
                    mci%current_pass%efficiency(it) = instance%efficiency
                 end if
                 mci%current_pass%integral_defined = .true.
              end if
              if (present (results)) then
                 if (mci%has_chains ()) then
                    call mci%collect_chain_weights (instance%w)
                    call results%record (1, &
                         n_calls        = mci%current_pass%calls(it), &
                         n_calls_valid  = mci%current_pass%calls_valid(it), &
                         integral       = mci%current_pass%integral(it), &
                         error          = mci%current_pass%error(it), &
                         efficiency     = mci%current_pass%efficiency(it), &
                         ! TODO pos. and neg. Efficiency
                         efficiency_pos = 0._default, &
                         efficiency_neg = 0._default, &
                         chain_weights  = mci%chain_weights, &
                         suppress = pacify)
                 else
                    call results%record (1, &
                         n_calls        = mci%current_pass%calls(it), &
                         n_calls_valid  = mci%current_pass%calls_valid(it), &
                         integral       = mci%current_pass%integral(it), &
                         error          = mci%current_pass%error(it), &
                         efficiency     = mci%current_pass%efficiency(it), &
                         ! TODO pos. and neg. Efficiency
                         efficiency_pos = 0._default, &
                         efficiency_neg = 0._default, &
                         suppress = pacify)
                 end if
              end if
              if (.not. instance%grids_from_file &
                   .and. mci%grid_filename_set) then
                 call mci%write_grids (instance)
              end if
              call instance%allow_adaptation ()
              reshape = .false.
              if (.not. mci%current_pass%is_final_pass) then
                 call mci%check_goals (it, success)
                 if (success)  exit
              end if
           end do
           if (signal_is_pending ())  return
           instance%pass_complete = .true.
           mci%integral = mci%current_pass%get_integral()
           mci%error = mci%current_pass%get_error()
           mci%efficiency = mci%current_pass%get_efficiency()
           mci%integral_known = .true.
           mci%error_known = .true.
           mci%efficiency_known = .true.
           call mci%compute_md5sum (pacify)
        else
           call msg_bug ("MCI integrate: current_pass object not allocated")
        end if
     end select
   end subroutine mci_vamp_integrate
 
 @ %def mci_vamp_integrate
 @ Check whether we are already finished with this pass.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: check_goals => mci_vamp_check_goals
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_check_goals (mci, it, success)
     class(mci_vamp_t), intent(inout) :: mci
     integer, intent(in) :: it
     logical, intent(out) :: success
     success = .false.
     if (mci%error_reached (it)) then
        mci%current_pass%n_it = it
        call msg_message ("VAMP: error goal reached; &
             &skipping iterations")
        success = .true.
        return
     end if
     if (mci%rel_error_reached (it)) then
        mci%current_pass%n_it = it
        call msg_message ("VAMP: relative error goal reached; &
             &skipping iterations")
        success = .true.
        return
     end if
     if (mci%accuracy_reached (it)) then
        mci%current_pass%n_it = it
        call msg_message ("VAMP: accuracy goal reached; &
             &skipping iterations")
        success = .true.
        return
     end if
   end subroutine mci_vamp_check_goals
 
 @ %def mci_vamp_check_goals
 @ Return true if the error, relative error, or accuracy goal has been reached,
 if any.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: error_reached => mci_vamp_error_reached
   procedure :: rel_error_reached => mci_vamp_rel_error_reached
   procedure :: accuracy_reached => mci_vamp_accuracy_reached
 <<MCI vamp: procedures>>=
   function mci_vamp_error_reached (mci, it) result (flag)
     class(mci_vamp_t), intent(in) :: mci
     integer, intent(in) :: it
     logical :: flag
     real(default) :: error_goal, error
     error_goal = mci%grid_par%error_goal
     if (error_goal > 0) then
        associate (pass => mci%current_pass)
          if (pass%integral_defined) then
             error = abs (pass%error(it))
             flag = error < error_goal
          else
             flag = .false.
          end if
        end associate
     else
        flag = .false.
     end if
   end function mci_vamp_error_reached
 
   function mci_vamp_rel_error_reached (mci, it) result (flag)
     class(mci_vamp_t), intent(in) :: mci
     integer, intent(in) :: it
     logical :: flag
     real(default) :: rel_error_goal, rel_error
     rel_error_goal = mci%grid_par%rel_error_goal
     if (rel_error_goal > 0) then
        associate (pass => mci%current_pass)
          if (pass%integral_defined) then
             if (pass%integral(it) /= 0) then
                rel_error = abs (pass%error(it) / pass%integral(it))
                flag = rel_error < rel_error_goal
             else
                flag = .true.
             end if
          else
             flag = .false.
          end if
        end associate
     else
        flag = .false.
     end if
   end function mci_vamp_rel_error_reached
 
   function mci_vamp_accuracy_reached (mci, it) result (flag)
     class(mci_vamp_t), intent(in) :: mci
     integer, intent(in) :: it
     logical :: flag
     real(default) :: accuracy_goal, accuracy
     accuracy_goal = mci%grid_par%accuracy_goal
     if (accuracy_goal > 0) then
        associate (pass => mci%current_pass)
          if (pass%integral_defined) then
             if (pass%integral(it) /= 0) then
                accuracy = abs (pass%error(it) / pass%integral(it)) &
                     * sqrt (real (pass%calls(it), default))
                flag = accuracy < accuracy_goal
             else
                flag = .true.
             end if
          else
             flag = .false.
          end if
        end associate
     else
        flag = .false.
     end if
   end function mci_vamp_accuracy_reached
 
 @ %def mci_vamp_error_reached
 @ %def mci_vamp_rel_error_reached
 @ %def mci_vamp_accuracy_reached
 @ Prepare an event generation pass.  Should be called before a sequence of
 events is generated, then we should call the corresponding finalizer.
 
 The pass-specific data of the previous integration pass are retained,
 but we reset the number of iterations and calls to zero.  The latter
 now counts the number of events (calls to the sampling function, actually).
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: prepare_simulation => mci_vamp_prepare_simulation
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_prepare_simulation (mci)
     class(mci_vamp_t), intent(inout) :: mci
     logical :: success
     if (mci%grid_filename_set) then
        call mci%read_grids_header (success)
        call mci%compute_md5sum ()
        if (.not. success) then
           call msg_fatal ("Simulate: " &
                // "reading integration grids from file '" &
                // char (mci%grid_filename) // "' failed")
        end if
     else
        call msg_bug ("VAMP: simulation: no grids, no grid filename")
     end if
   end subroutine mci_vamp_prepare_simulation
 
 @ %def mci_vamp_prepare_simulation
 @ Generate weighted event.  Note that the event weight
 ([[vamp_weight]]) is not just the MCI weight.  [[vamp_next_event]]
 selects a channel based on the channel weights multiplied by the
 (previously recorded) maximum integrand value of the channel.  The
 MCI weight is renormalized accordingly, to cancel this effect on the
 result.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: generate_weighted_event => mci_vamp_generate_weighted_event
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_generate_weighted_event (mci, instance, sampler)
     class(mci_vamp_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     class(vamp_data_t), allocatable :: data
     type(exception) :: vamp_exception
     select type (instance)
     type is (mci_vamp_instance_t)
        instance%vamp_weight_set = .false.
        allocate (mci_workspace_t :: data)
        select type (data)
        type is (mci_workspace_t)
           data%sampler => sampler
           data%instance => instance
        end select
        select type (rng => mci%rng)
        type is (rng_tao_t)
           if (instance%grids_defined) then
              call vamp_next_event ( &
                   instance%vamp_x, &
                   rng%state, &
                   instance%grids, &
                   vamp_sampling_function, &
                   data, &
                   phi = phi_trivial, &
                   weight = instance%vamp_weight, &
                   exc = vamp_exception)
              call handle_vamp_exception (vamp_exception, mci%verbose)
              instance%vamp_excess = 0
              instance%vamp_weight_set = .true.
           else
              call msg_bug ("VAMP: generate event: grids undefined")
           end if
        class default
          call msg_fatal ("VAMP event generation: &
                &random-number generator must be TAO")
        end select
     end select
   end subroutine mci_vamp_generate_weighted_event
 
 @ %def mci_vamp_generate_weighted_event
 @ Generate unweighted event.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: generate_unweighted_event => &
        mci_vamp_generate_unweighted_event
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_generate_unweighted_event (mci, instance, sampler)
     class(mci_vamp_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     class(vamp_data_t), allocatable :: data
     logical :: positive
     type(exception) :: vamp_exception
     select type (instance)
     type is (mci_vamp_instance_t)
        instance%vamp_weight_set = .false.
        allocate (mci_workspace_t :: data)
        select type (data)
        type is (mci_workspace_t)
           data%sampler => sampler
           data%instance => instance
        end select
        select type (rng => mci%rng)
        type is (rng_tao_t)
           if (instance%grids_defined) then
              REJECTION: do
                 call vamp_next_event ( &
                      instance%vamp_x, &
                      rng%state, &
                      instance%grids, &
                      vamp_sampling_function, &
                      data, &
                      phi = phi_trivial, &
                      excess = instance%vamp_excess, &
                      positive = positive, &
                      exc = vamp_exception)
                 if (signal_is_pending ())  return
                 if (sampler%is_valid ())  exit REJECTION
              end do REJECTION
              call handle_vamp_exception (vamp_exception, mci%verbose)
              if (positive) then
                 instance%vamp_weight = 1
              else if (instance%negative_weights) then
                 instance%vamp_weight = -1
              else
                 call msg_fatal ("VAMP: event with negative weight generated")
                 instance%vamp_weight = 0
              end if
              instance%vamp_weight_set = .true.
           else
              call msg_bug ("VAMP: generate event: grids undefined")
           end if
        class default
          call msg_fatal ("VAMP event generation: &
                &random-number generator must be TAO")
        end select
     end select
   end subroutine mci_vamp_generate_unweighted_event
 
 @ %def mci_vamp_generate_unweighted_event
 @ Rebuild an event, using the [[state]] input.
 
 Note: This feature is currently unused.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: rebuild_event => mci_vamp_rebuild_event
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_rebuild_event (mci, instance, sampler, state)
     class(mci_vamp_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout) :: instance
     class(mci_sampler_t), intent(inout) :: sampler
     class(mci_state_t), intent(in) :: state
     call msg_bug ("MCI vamp rebuild event not implemented yet")
   end subroutine mci_vamp_rebuild_event
 
 @ %def mci_vamp_rebuild_event
 @ Pacify: override the default no-op, since VAMP numerics might need
 some massage.
 <<MCI vamp: mci vamp: TBP>>=
   procedure :: pacify => mci_vamp_pacify
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_pacify (object, efficiency_reset, error_reset)
     class(mci_vamp_t), intent(inout) :: object
     logical, intent(in), optional :: efficiency_reset, error_reset
     logical :: err_reset
     type(pass_t), pointer :: current_pass
     err_reset = .false.
     if (present (error_reset))  err_reset = error_reset
     current_pass => object%first_pass
     do while (associated (current_pass))
        if (allocated (current_pass%error) .and. err_reset) then
           current_pass%error = 0
        end if
        if (allocated (current_pass%efficiency) .and. err_reset) then
           current_pass%efficiency = 1
        end if
        current_pass => current_pass%next
     end do
   end subroutine mci_vamp_pacify
 
 @ %def mci_vamp_pacify
 @
 \subsection{Sampler as Workspace}
 In the full setup, the sampling function requires the process instance
 object as workspace.  We implement this by (i) implementing the
 process instance as a type extension of the abstract [[sampler_t]]
 object used by the MCI implementation and (ii) providing such an
 object as an extra argument to the sampling function that VAMP can
 call.  To minimize cross-package dependencies, we use an abstract type
 [[vamp_workspace]] that VAMP declares and extend this by including a
 pointer to the [[sampler]] and [[instance]] objects.  In the body of
 the sampling function, we dereference this pointer and can then work
 with the contents.
 <<MCI vamp: types>>=
   type, extends (vamp_data_t) :: mci_workspace_t
      class(mci_sampler_t), pointer :: sampler => null ()
      class(mci_vamp_instance_t), pointer :: instance => null ()
   end type mci_workspace_t
 
 @ %def mci_workspace_t
 @
 \subsection{Integrator instance}
 The history entries should point to the corresponding history entry in
 the [[pass_t]] object.  If there is none, we may allocate a local
 history, which is then just transient.
 <<MCI vamp: public>>=
   public :: mci_vamp_instance_t
 <<MCI vamp: types>>=
   type, extends (mci_instance_t) :: mci_vamp_instance_t
      type(mci_vamp_t), pointer :: mci => null ()
      logical :: grids_defined = .false.
      logical :: grids_from_file = .false.
      integer :: n_it = 0
      integer :: it = 0
      logical :: pass_complete = .false.
      integer :: n_calls = 0
      integer :: calls = 0
      integer :: calls_valid = 0
      logical :: it_complete = .false.
      logical :: enable_adapt_grids = .false.
      logical :: enable_adapt_weights = .false.
      logical :: allow_adapt_grids = .false.
      logical :: allow_adapt_weights = .false.
      integer :: n_adapt_grids = 0
      integer :: n_adapt_weights = 0
      logical :: generating_events = .false.
      real(default) :: safety_factor = 1
      type(vamp_grids) :: grids
      real(default) :: g = 0
      real(default), dimension(:), allocatable :: gi
      real(default) :: integral = 0
      real(default) :: error = 0
      real(default) :: efficiency = 0
      real(default), dimension(:), allocatable :: vamp_x
      logical :: vamp_weight_set = .false.
      real(default) :: vamp_weight = 0
      real(default) :: vamp_excess = 0
      logical :: allocate_global_history = .false.
      type(vamp_history), dimension(:), pointer :: v_history => null ()
      logical :: allocate_channel_history = .false.
      type(vamp_history), dimension(:,:), pointer :: v_histories => null ()
    contains
    <<MCI vamp: mci vamp instance: TBP>>
   end type mci_vamp_instance_t
 
 @ %def mci_vamp_instance_t
 @ Output.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: write => mci_vamp_instance_write
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_write (object, unit, pacify)
     class(mci_vamp_instance_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacify
     integer :: u, i
     character(len=7) :: fmt
     call pac_fmt (fmt, FMT_17, FMT_14, pacify)
     u = given_output_unit (unit)
     write (u, "(3x,A," // FMT_19 // ")") "Integrand = ", object%integrand
     write (u, "(3x,A," // FMT_19 // ")") "Weight    = ", object%mci_weight
     if (object%vamp_weight_set) then
        write (u, "(3x,A," // FMT_19 // ")") "VAMP wgt  = ", object%vamp_weight
        if (object%vamp_excess /= 0) then
           write (u, "(3x,A," // FMT_19 // ")") "VAMP exc  = ", &
                object%vamp_excess
        end if
     end if
     write (u, "(3x,A,L1)")  "adapt grids   = ", object%enable_adapt_grids
     write (u, "(3x,A,L1)")  "adapt weights = ", object%enable_adapt_weights
     if (object%grids_defined) then
        if (object%grids_from_file) then
           write (u, "(3x,A)")  "VAMP grids: read from file"
        else
           write (u, "(3x,A)")  "VAMP grids: defined"
        end if
     else
        write (u, "(3x,A)")  "VAMP grids: [undefined]"
     end if
     write (u, "(3x,A,I0)")  "n_it          = ", object%n_it
     write (u, "(3x,A,I0)")  "it            = ", object%it
     write (u, "(3x,A,L1)")  "pass complete = ", object%it_complete
     write (u, "(3x,A,I0)")  "n_calls       = ", object%n_calls
     write (u, "(3x,A,I0)")  "calls         = ", object%calls
     write (u, "(3x,A,I0)")  "calls_valid   = ", object%calls_valid
     write (u, "(3x,A,L1)")  "it complete   = ", object%it_complete
     write (u, "(3x,A,I0)")  "n adapt.(g)   = ", object%n_adapt_grids
     write (u, "(3x,A,I0)")  "n adapt.(w)   = ", object%n_adapt_weights
     write (u, "(3x,A,L1)")  "gen. events   = ", object%generating_events
     write (u, "(3x,A,L1)")  "neg. weights  = ", object%negative_weights
     if (object%safety_factor /= 1)  write &
           (u, "(3x,A," // fmt // ")")  "safety f = ", object%safety_factor
     write (u, "(3x,A," // fmt // ")")  "integral = ", object%integral
     write (u, "(3x,A," // fmt // ")")  "error    = ", object%error
     write (u, "(3x,A," // fmt // ")")  "eff.     = ", object%efficiency
     write (u, "(3x,A)")  "weights:"
     do i = 1, size (object%w)
        write (u, "(5x,I0,1x," // FMT_12 // ")")  i, object%w(i)
     end do
   end subroutine mci_vamp_instance_write
 
 @ %def mci_vamp_instance_write
 @ Write the grids to the specified unit.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: write_grids => mci_vamp_instance_write_grids
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_write_grids (object, unit)
     class(mci_vamp_instance_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     if (object%grids_defined) then
        call vamp_write_grids (object%grids, u, write_integrals = .true.)
     end if
   end subroutine mci_vamp_instance_write_grids
 
 @ %def mci_vamp_instance_write_grids
 @ Finalizer: the history arrays are pointer arrays and need finalization.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: final => mci_vamp_instance_final
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_final (object)
     class(mci_vamp_instance_t), intent(inout) :: object
     if (object%allocate_global_history) then
        if (associated (object%v_history)) then
           call vamp_delete_history (object%v_history)
           deallocate (object%v_history)
        end if
     end if
     if (object%allocate_channel_history) then
        if (associated (object%v_histories)) then
           call vamp_delete_history (object%v_histories)
           deallocate (object%v_histories)
        end if
     end if
     if (object%grids_defined) then
        call vamp_delete_grids (object%grids)
        object%grids_defined = .false.
     end if
   end subroutine mci_vamp_instance_final
 
 @ %def mci_vamp_instance_final
 @ Initializer.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: init => mci_vamp_instance_init
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_init (mci_instance, mci)
     class(mci_vamp_instance_t), intent(out) :: mci_instance
     class(mci_t), intent(in), target :: mci
     call mci_instance%base_init (mci)
     select type (mci)
     type is (mci_vamp_t)
        mci_instance%mci => mci
        allocate (mci_instance%gi (mci%n_channel))
        mci_instance%allocate_global_history = .not. mci%history_par%global
        mci_instance%allocate_channel_history = .not. mci%history_par%channel
        mci_instance%negative_weights = mci%negative_weights
     end select
   end subroutine mci_vamp_instance_init
 
 @ %def mci_vamp_instance_init
 @ Prepare a new integration pass: write the pass-specific settings to
 the [[instance]] object.  This should be called initially, together
 with the [[create_grids]] procedure, and whenever we start a new
 integration pass.
 
 Set [[reshape]] if the number of calls is different than previously (unless it
 was zero, indicating the first pass).
 
 We link VAMP histories to the allocated histories in the current pass
 object, so the recorded results are persistent.  However, if there are
 no histories present there, we allocate them locally.  In that case,
 the histories will disappear together with the MCI instance object.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: new_pass => mci_vamp_instance_new_pass
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_new_pass (instance, reshape)
     class(mci_vamp_instance_t), intent(inout) :: instance
     logical, intent(out) :: reshape
     type(pass_t), pointer :: current
     associate (mci => instance%mci)
       current => mci%current_pass
       instance%n_it = current%n_it
       if (instance%n_calls == 0) then
          reshape = .false.
          instance%n_calls = current%n_calls
       else if (instance%n_calls == current%n_calls) then
          reshape = .false.
       else
          reshape = .true.
          instance%n_calls = current%n_calls
       end if
       instance%it = 0
       instance%calls = 0
       instance%calls_valid = 0
       instance%enable_adapt_grids = current%adapt_grids
       instance%enable_adapt_weights = current%adapt_weights
       instance%generating_events = .false.
       if (instance%allocate_global_history) then
          if (associated (instance%v_history)) then
             call vamp_delete_history (instance%v_history)
             deallocate (instance%v_history)
          end if
          allocate (instance%v_history (instance%n_it))
          call vamp_create_history (instance%v_history, verbose = .false.)
       else
          instance%v_history => current%v_history
       end if
       if (instance%allocate_channel_history) then
          if (associated (instance%v_histories)) then
             call vamp_delete_history (instance%v_histories)
             deallocate (instance%v_histories)
          end if
          allocate (instance%v_histories (instance%n_it, mci%n_channel))
          call vamp_create_history (instance%v_histories, verbose = .false.)
       else
          instance%v_histories => current%v_histories
       end if
     end associate
   end subroutine mci_vamp_instance_new_pass
 
 @ %def mci_vamp_instance_new_pass
 @
 Create a grid set within the [[instance]] object, using the data of
 the current integration pass.  Also reset counters that track this
 grid set.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: create_grids => mci_vamp_instance_create_grids
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_create_grids (instance)
     class(mci_vamp_instance_t), intent(inout) :: instance
     type (pass_t), pointer :: current
     integer, dimension(:), allocatable :: num_div
     real(default), dimension(:,:), allocatable :: region
     associate (mci => instance%mci)
       current => mci%current_pass
       allocate (num_div (mci%n_dim))
       allocate (region (2, mci%n_dim))
       region(1,:) = 0
       region(2,:) = 1
       num_div = current%n_bins
       instance%n_adapt_grids = 0
       instance%n_adapt_weights = 0
       if (.not. instance%grids_defined) then
          call vamp_create_grids (instance%grids, &
               region, &
               current%n_calls, &
               weights = instance%w, &
               num_div = num_div, &
               stratified = mci%grid_par%stratified)
          instance%grids_defined = .true.
       else
          call msg_bug ("VAMP: create grids: grids already defined")
       end if
     end associate
   end subroutine mci_vamp_instance_create_grids
 
 @ %def mci_vamp_instance_create_grids
 @ Reset a grid set, so we can start a fresh integration pass.  In
 effect, we delete results of previous integrations, but keep the grid
 shapes, weights, and variance arrays, so adaptation is still possible.
 The grids are prepared for a specific number of calls (per iteration)
 and sampling mode (stratified/importance).
 
 The [[vamp_discard_integrals]] implementation will reshape the grids
 only if the argument [[num_calls]] is present.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: discard_integrals => mci_vamp_instance_discard_integrals
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_discard_integrals (instance, reshape)
     class(mci_vamp_instance_t), intent(inout) :: instance
     logical, intent(in) :: reshape
     instance%calls = 0
     instance%calls_valid = 0
     instance%integral = 0
     instance%error = 0
     instance%efficiency = 0
     associate (mci => instance%mci)
       if (instance%grids_defined) then
          if (mci%grid_par%use_vamp_equivalences) then
             if (reshape) then
                call vamp_discard_integrals (instance%grids, &
                     num_calls = instance%n_calls, &
                     stratified = mci%grid_par%stratified, &
                     eq = mci%equivalences)
             else
                call vamp_discard_integrals (instance%grids, &
                     stratified = mci%grid_par%stratified, &
                     eq = mci%equivalences)
             end if
          else
             if (reshape) then
                call vamp_discard_integrals (instance%grids, &
                     num_calls = instance%n_calls, &
                     stratified = mci%grid_par%stratified)
             else
                call vamp_discard_integrals (instance%grids, &
                     stratified = mci%grid_par%stratified)
             end if
          end if
       else
          call msg_bug ("VAMP: discard integrals: grids undefined")
       end if
     end associate
   end subroutine mci_vamp_instance_discard_integrals
 
 @ %def mci_vamp_instance_discard_integrals
 @ After grids are created (with equidistant binning and equal weight),
 adaptation is redundant.  Therefore, we should allow it only after a
 complete integration step has been performed, calling this.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: allow_adaptation => mci_vamp_instance_allow_adaptation
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_allow_adaptation (instance)
     class(mci_vamp_instance_t), intent(inout) :: instance
     instance%allow_adapt_grids = .true.
     instance%allow_adapt_weights = .true.
   end subroutine mci_vamp_instance_allow_adaptation
 
 @ %def mci_vamp_instance_allow_adaptation
 @ Adapt grids.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: adapt_grids => mci_vamp_instance_adapt_grids
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_adapt_grids (instance)
     class(mci_vamp_instance_t), intent(inout) :: instance
     if (instance%enable_adapt_grids .and. instance%allow_adapt_grids) then
        if (instance%grids_defined) then
           call vamp_refine_grids (instance%grids)
           instance%n_adapt_grids = instance%n_adapt_grids + 1
       else
          call msg_bug ("VAMP: adapt grids: grids undefined")
       end if
     end if
   end subroutine mci_vamp_instance_adapt_grids
 
 @ %def mci_vamp_instance_adapt_grids
 @ Adapt weights.  Use the variance array returned by \vamp\ for
 recalculating the weight array.  The parameter
 [[channel_weights_power]] dampens fluctuations.
 
 If the number of calls in a given channel falls below a user-defined threshold,
 the weight is not lowered further but kept at this threshold.  The other
 channel weights are reduced accordingly.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: adapt_weights => mci_vamp_instance_adapt_weights
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_adapt_weights (instance)
     class(mci_vamp_instance_t), intent(inout) :: instance
     real(default) :: w_sum, w_avg_ch, sum_w_underflow, w_min
     real(default), dimension(:), allocatable :: weights
     integer :: n_ch, ch, n_underflow
     logical, dimension(:), allocatable :: mask, underflow
     type(exception) :: vamp_exception
     logical :: wsum_non_zero
     if (instance%enable_adapt_weights .and. instance%allow_adapt_weights) then
        associate (mci => instance%mci)
          if (instance%grids_defined) then
             allocate (weights (size (instance%grids%weights)))
             weights = instance%grids%weights &
                  * vamp_get_variance (instance%grids%grids) &
                  ** mci%grid_par%channel_weights_power
             w_sum = sum (weights)
             if (w_sum /= 0) then
                weights = weights / w_sum
                if (mci%n_chain /= 0) then
                   allocate (mask (mci%n_channel))
                   do ch = 1, mci%n_chain
                      mask = mci%chain == ch
                      n_ch = count (mask)
                      if (n_ch /= 0) then
                         w_avg_ch = sum (weights, mask) / n_ch
                         where (mask)  weights = w_avg_ch
                      end if
                   end do
                end if
                if (mci%grid_par%threshold_calls /= 0) then
                   w_min = &
                        real (mci%grid_par%threshold_calls, default) &
                        / instance%n_calls
                   allocate (underflow (mci%n_channel))
                   underflow = weights /= 0 .and. abs (weights) < w_min
                   n_underflow = count (underflow)
                   sum_w_underflow = sum (weights, mask=underflow)
                   if (sum_w_underflow /= 1) then
                      where (underflow)
                         weights = w_min
                      elsewhere
                         weights = weights &
                              * (1 - n_underflow * w_min) / (1 - sum_w_underflow)
                      end where
                   end if
                end if
             end if
             call instance%set_channel_weights (weights, wsum_non_zero)
             if (wsum_non_zero) call vamp_update_weights &
                (instance%grids, weights, exc = vamp_exception)
             call handle_vamp_exception (vamp_exception, mci%verbose)
          else
             call msg_bug ("VAMP: adapt weights: grids undefined")
          end if
        end associate
        instance%n_adapt_weights = instance%n_adapt_weights + 1
     end if
   end subroutine mci_vamp_instance_adapt_weights
 
 @ %def mci_vamp_instance_adapt_weights
 @ Integration: sample the VAMP grids.  The number of calls etc. are
 already stored inside the grids.  We provide the random-number
 generator, the sampling function, and a link to the workspace object,
 which happens to contain a pointer to the sampler object.  The sampler
 object thus becomes the workspace of the sampling function.
 
 Note: in the current implementation, the random-number generator must
 be the TAO generator.  This explicit dependence should be removed from
 the VAMP implementation.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: sample_grids => mci_vamp_instance_sample_grids
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_sample_grids (instance, rng, sampler, eq)
     class(mci_vamp_instance_t), intent(inout), target :: instance
     class(rng_t), intent(inout) :: rng
     class(mci_sampler_t), intent(inout), target :: sampler
     type(vamp_equivalences_t), intent(in), optional :: eq
     class(vamp_data_t), allocatable :: data
     type(exception) :: vamp_exception
     allocate (mci_workspace_t :: data)
     select type (data)
     type is (mci_workspace_t)
        data%sampler => sampler
        data%instance => instance
     end select
     select type (rng)
     type is (rng_tao_t)
        instance%it = instance%it + 1
        instance%calls = 0
        if (instance%grids_defined) then
           call vamp_sample_grids ( &
                rng%state, &
                instance%grids, &
                vamp_sampling_function, &
                data, &
                1, &
                eq = eq, &
                history = instance%v_history(instance%it:), &
                histories = instance%v_histories(instance%it:,:), &
                integral = instance%integral, &
                std_dev = instance%error, &
                exc = vamp_exception, &
                negative_weights = instance%negative_weights)
           call handle_vamp_exception (vamp_exception, instance%mci%verbose)
           instance%efficiency = instance%get_efficiency ()
        else
           call msg_bug ("VAMP: sample grids: grids undefined")
        end if
     class default
        call msg_fatal ("VAMP integration: random-number generator must be TAO")
     end select
   end subroutine mci_vamp_instance_sample_grids
 
 @ %def mci_vamp_instance_sample_grids
 @
 Compute the reweighting efficiency for the current grids, suitable
 averaged over all active channels.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: get_efficiency_array => mci_vamp_instance_get_efficiency_array
   procedure :: get_efficiency => mci_vamp_instance_get_efficiency
 <<MCI vamp: procedures>>=
   function mci_vamp_instance_get_efficiency_array (mci) result (efficiency)
     class(mci_vamp_instance_t), intent(in) :: mci
     real(default), dimension(:), allocatable :: efficiency
     allocate (efficiency (mci%mci%n_channel))
     if (.not. mci%negative_weights) then
        where (mci%grids%grids%f_max /= 0)
           efficiency = mci%grids%grids%mu(1) / abs (mci%grids%grids%f_max)
        elsewhere
           efficiency = 0
        end where
     else
        where (mci%grids%grids%f_max /= 0)
           efficiency = &
                (mci%grids%grids%mu_plus(1) - mci%grids%grids%mu_minus(1)) &
                / abs (mci%grids%grids%f_max)
        elsewhere
           efficiency = 0
        end where
     end if
   end function mci_vamp_instance_get_efficiency_array
 
   function mci_vamp_instance_get_efficiency (mci) result (efficiency)
     class(mci_vamp_instance_t), intent(in) :: mci
     real(default) :: efficiency
     real(default), dimension(:), allocatable :: weight
     real(default) :: norm
     allocate (weight (mci%mci%n_channel))
     weight = mci%grids%weights * abs (mci%grids%grids%f_max)
     norm = sum (weight)
     if (norm /= 0) then
        efficiency = dot_product (mci%get_efficiency_array (), weight) / norm
     else
        efficiency = 1
     end if
   end function mci_vamp_instance_get_efficiency
 
 @ %def mci_vamp_instance_get_efficiency_array
 @ %def mci_vamp_instance_get_efficiency
 @ Prepare an event generation pass.  Should be called before a sequence of
 events is generated, then we should call the corresponding finalizer.
 
 The pass-specific data of the previous integration pass are retained,
 but we reset the number of iterations and calls to zero.  The latter
 now counts the number of events (calls to the sampling function, actually).
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: init_simulation => mci_vamp_instance_init_simulation
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_init_simulation (instance, safety_factor)
     class(mci_vamp_instance_t), intent(inout) :: instance
     real(default), intent(in), optional :: safety_factor
     associate (mci => instance%mci)
       allocate (instance%vamp_x (mci%n_dim))
       instance%it = 0
       instance%calls = 0
       instance%generating_events = .true.
       if (present (safety_factor))  instance%safety_factor = safety_factor
       if (.not. instance%grids_defined) then
          if (mci%grid_filename_set) then
             if (.not. mci%check_grid_file) &
                  call msg_warning ("Reading grid file: MD5 sum check disabled")
             call msg_message ("Simulate: " &
                  // "using integration grids from file '" &
                  // char (mci%grid_filename) // "'")
             call mci%read_grids_data (instance)
             if (instance%safety_factor /= 1) then
                write (msg_buffer, "(A,ES10.3,A)")  "Simulate: &
                     &applying safety factor", instance%safety_factor, &
                     " to event rejection"
                call msg_message ()
                instance%grids%grids%f_max = &
                     instance%grids%grids%f_max * instance%safety_factor
             end if
          else
             call msg_bug ("VAMP: simulation: no grids, no grid filename")
          end if
       end if
     end associate
   end subroutine mci_vamp_instance_init_simulation
 
 @ %def mci_vamp_init_simulation
 @ Finalize an event generation pass.  Should be called before a sequence of
 events is generated, then we should call the corresponding finalizer.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: final_simulation => mci_vamp_instance_final_simulation
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_final_simulation (instance)
     class(mci_vamp_instance_t), intent(inout) :: instance
     if (allocated (instance%vamp_x))  deallocate (instance%vamp_x)
   end subroutine mci_vamp_instance_final_simulation
 
 @ %def mci_vamp_instance_final_simulation
 @
 \subsection{Sampling function}
 The VAMP sampling function has a well-defined interface which we have
 to implement.  The [[data]] argument allows us to pass pointers to the
 [[sampler]] and [[instance]] objects, so we can access configuration
 data and fill point-dependent contents within these objects.
 
 The [[weights]] and [[channel]] argument must be present in the call.
 
 Note: we would normally declare the [[instance]] pointer with the
 concrete type, or just use the [[data]] component directly.
 Unfortunately, gfortran 4.6 forgets the inherited base-type methods in
 that case.
 
 Note: this is the place where we must look for external signals, i.e.,
 interrupt from the OS.  We would like to raise a \vamp\ exception which is then
 caught by [[vamp_sample_grids]] as the caller, so it dumps its current state
 and returns (with the signal still pending).  \whizard\ will then terminate
 gracefully.  Of course, VAMP should be able to resume from the dump.
 
 In the current implementation, we handle the exception in place and terminate
 immediately.  The incomplete current integration pass is lost.
 <<MCI vamp: procedures>>=
   function vamp_sampling_function &
        (xi, data, weights, channel, grids) result (f)
     real(default) :: f
     real(default), dimension(:), intent(in) :: xi
     class(vamp_data_t), intent(in) :: data
     real(default), dimension(:), intent(in), optional :: weights
     integer, intent(in), optional :: channel
     type(vamp_grid), dimension(:), intent(in), optional :: grids
     type(exception) :: exc
     logical :: verbose
     character(*), parameter :: FN = "WHIZARD sampling function"
     class(mci_instance_t), pointer :: instance
     select type (data)
     type is (mci_workspace_t)
        instance => data%instance
        select type (instance)
        class is (mci_vamp_instance_t)
           verbose = instance%mci%verbose
           call instance%evaluate (data%sampler, channel, xi)
           if (signal_is_pending ()) then
              call raise_exception (exc, EXC_FATAL, FN, "signal received")
              call handle_vamp_exception (exc, verbose)
              call terminate_now_if_signal ()
           end if
           instance%calls = instance%calls + 1
           if (data%sampler%is_valid ()) &
                & instance%calls_valid = instance%calls_valid + 1
           f = instance%get_value ()
           call terminate_now_if_single_event ()
        class default
           call msg_bug("VAMP: " // FN // ": unknown MCI instance type")
        end select
     end select
   end function vamp_sampling_function
 
 @ %def vamp_sampling_function
 @ This is supposed to be the mapping between integration channels.
 The VAMP event generating procedures technically require it, but it is
 meaningless in our setup where all transformations happen inside the
 sampler object.  So, this implementation is trivial:
 <<MCI vamp: procedures>>=
   pure function phi_trivial (xi, channel_dummy) result (x)
     real(default), dimension(:), intent(in) :: xi
     integer, intent(in) :: channel_dummy
     real(default), dimension(size(xi)) :: x
     x = xi
   end function phi_trivial
 
 @ %def phi_trivial
 @
 \subsection{Integrator instance: evaluation}
 Here, we compute the multi-channel reweighting factor for the current
 channel, that accounts for the Jacobians of the transformations
 from/to all other channels.
 
 The computation of the VAMP probabilities may consume considerable
 time, therefore we enable parallel evaluation. (Collecting the
 contributions to [[mci%g]] is a reduction, which we should also
 implement via OpenMP.)
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: compute_weight => mci_vamp_instance_compute_weight
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_compute_weight (mci, c)
     class(mci_vamp_instance_t), intent(inout) :: mci
     integer, intent(in) :: c
     integer :: i
     mci%selected_channel = c
     !$OMP PARALLEL PRIVATE(i) SHARED(mci)
     !$OMP DO
     do i = 1, mci%mci%n_channel
        if (mci%w(i) /= 0) then
           mci%gi(i) = vamp_probability (mci%grids%grids(i), mci%x(:,i))
        else
           mci%gi(i) = 0
        end if
     end do
     !$OMP END DO
     !$OMP END PARALLEL
     mci%g = 0
     if (mci%gi(c) /= 0) then
        do i = 1, mci%mci%n_channel
           if (mci%w(i) /= 0 .and. mci%f(i) /= 0) then
              mci%g = mci%g + mci%w(i) * mci%gi(i) / mci%f(i)
           end if
        end do
     end if
     if (mci%g /= 0) then
        mci%mci_weight = mci%gi(c) / mci%g
     else
        mci%mci_weight = 0
     end if
   end subroutine mci_vamp_instance_compute_weight
 
 @ %def mci_vamp_instance_compute_weight
 @ Record the integrand.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: record_integrand => mci_vamp_instance_record_integrand
 <<MCI vamp: procedures>>=
   subroutine mci_vamp_instance_record_integrand (mci, integrand)
     class(mci_vamp_instance_t), intent(inout) :: mci
     real(default), intent(in) :: integrand
     mci%integrand = integrand
   end subroutine mci_vamp_instance_record_integrand
 
 @ %def mci_vamp_instance_record_integrand
 @ Get the event weight.  The default routine returns the same value that
 we would use for integration.  This is correct if we select the integration
 channel according to the channel weight.  [[vamp_next_event]] does
 differently, so we should rather rely on the weight that VAMP
 returns.  This is the value stored in [[vamp_weight]].  We override
 the default TBP accordingly.
 <<MCI vamp: mci vamp instance: TBP>>=
   procedure :: get_event_weight => mci_vamp_instance_get_event_weight
   procedure :: get_event_excess => mci_vamp_instance_get_event_excess
 <<MCI vamp: procedures>>=
   function mci_vamp_instance_get_event_weight (mci) result (value)
     class(mci_vamp_instance_t), intent(in) :: mci
     real(default) :: value
     if (mci%vamp_weight_set) then
        value = mci%vamp_weight
     else
        call msg_bug ("VAMP: attempt to read undefined event weight")
     end if
   end function mci_vamp_instance_get_event_weight
 
   function mci_vamp_instance_get_event_excess (mci) result (value)
     class(mci_vamp_instance_t), intent(in) :: mci
     real(default) :: value
     if (mci%vamp_weight_set) then
        value = mci%vamp_excess
     else
        call msg_bug ("VAMP: attempt to read undefined event excess weight")
     end if
   end function mci_vamp_instance_get_event_excess
 
 @ %def mci_vamp_instance_get_event_excess
 @
 \subsection{VAMP exceptions}
 A VAMP routine may have raised an exception.  Turn this into a WHIZARD
 error message.
 
 An external signal could raise a fatal exception, but this should be delayed and
 handled by the correct termination routine.
 <<MCI vamp: procedures>>=
   subroutine handle_vamp_exception (exc, verbose)
     type(exception), intent(in) :: exc
     logical, intent(in) :: verbose
     integer :: exc_level
     if (verbose) then
        exc_level = EXC_INFO
     else
        exc_level = EXC_ERROR
     end if
     if (exc%level >= exc_level) then
        write (msg_buffer, "(A,':',1x,A)")  trim (exc%origin), trim (exc%message)
        select case (exc%level)
        case (EXC_INFO);  call msg_message ()
        case (EXC_WARN);  call msg_warning ()
        case (EXC_ERROR); call msg_error ()
        case (EXC_FATAL)
           if (signal_is_pending ()) then
              call msg_message ()
           else
              call msg_fatal ()
           end if
        end select
     end if
   end subroutine handle_vamp_exception
 
 @ %def handle_vamp_exception
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[mci_vamp_ut.f90]]>>=
 <<File header>>
 
 module mci_vamp_ut
   use unit_tests
   use mci_vamp_uti
 
 <<Standard module head>>
 
 <<MCI vamp: public test>>
 
 contains
 
 <<MCI vamp: test driver>>
 
 end module mci_vamp_ut
 @ %def mci_vamp_ut
 @
 <<[[mci_vamp_uti.f90]]>>=
 <<File header>>
 
 module mci_vamp_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use constants, only: PI, TWOPI
   use rng_base
   use rng_tao
   use phs_base
   use mci_base
   use vamp, only: vamp_write_grids !NODEP!
 
   use mci_vamp
 
 <<Standard module head>>
 
 <<MCI vamp: test declarations>>
 
 <<MCI vamp: test types>>
 
 contains
 
 <<MCI vamp: tests>>
 
 end module mci_vamp_uti
 @ %def mci_vamp_ut
 @ API: driver for the unit tests below.
 <<MCI vamp: public test>>=
   public :: mci_vamp_test
 <<MCI vamp: test driver>>=
   subroutine mci_vamp_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<MCI vamp: execute tests>>
   end subroutine mci_vamp_test
 
 @ %def mci_vamp_test
 @
 \subsubsection{Test sampler}
 A test sampler object should implement a function with known integral that
 we can use to check the integrator.
 
 In mode [[1]], the function is $f(x) = 3 x^2$ with integral $\int_0^1
 f(x)\,dx=1$ and maximum $f(1)=3$.  If the integration dimension is
 greater than one, the function is extended as a constant in the other
 dimension(s).
 
 In mode [[2]], the function is $11 x^{10}$, also with integral $1$.
 
 Mode [[4]] includes ranges of zero and negative function value, the
 integral is negative.  The results should be identical to the results
 of [[mci_midpoint_4]], where the same function is evaluated.  The
 function is $f(x) = (1 - 3 x^2)\,\theta(x-1/2)$ with integral
 $\int_0^1 f(x)\,dx=-3/8$, minimum $f(1)=-2$ and maximum $f(1/2)=1/4$.
 <<MCI vamp: test types>>=
   type, extends (mci_sampler_t) :: test_sampler_1_t
      real(default), dimension(:), allocatable :: x
      real(default) :: val
      integer :: mode = 1
    contains
    <<MCI vamp: test sampler 1: TBP>>
   end type test_sampler_1_t
 
 @ %def test_sampler_1_t
 @ Output: There is nothing stored inside, so just print an informative line.
 <<MCI vamp: test sampler 1: TBP>>=
   procedure :: write => test_sampler_1_write
 <<MCI vamp: tests>>=
   subroutine test_sampler_1_write (object, unit, testflag)
     class(test_sampler_1_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     select case (object%mode)
     case (1)
        write (u, "(1x,A)") "Test sampler: f(x) = 3 x^2"
     case (2)
        write (u, "(1x,A)") "Test sampler: f(x) = 11 x^10"
     case (3)
        write (u, "(1x,A)") "Test sampler: f(x) = 11 x^10 * 2 * cos^2 (2 pi y)"
     case (4)
        write (u, "(1x,A)") "Test sampler: f(x) = (1 - 3 x^2) theta(x - 1/2)"
     end select
   end subroutine test_sampler_1_write
 
 @ %def test_sampler_1_write
 @ Evaluation: compute the function value.  The output $x$ parameter
 (only one channel) is identical to the input $x$, and the Jacobian is 1.
 <<MCI vamp: test sampler 1: TBP>>=
   procedure :: evaluate => test_sampler_1_evaluate
 <<MCI vamp: tests>>=
   subroutine test_sampler_1_evaluate (sampler, c, x_in, val, x, f)
     class(test_sampler_1_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     if (allocated (sampler%x))  deallocate (sampler%x)
     allocate (sampler%x (size (x_in)))
     sampler%x = x_in
     select case (sampler%mode)
     case (1)
        sampler%val = 3 * x_in(1) ** 2
     case (2)
        sampler%val = 11 * x_in(1) ** 10
     case (3)
        sampler%val = 11 * x_in(1) ** 10 * 2 * cos (twopi * x_in(2)) ** 2
     case (4)
        if (x_in(1) >= .5_default) then
           sampler%val = 1 - 3 * x_in(1) ** 2
        else
           sampler%val = 0
        end if
     end select
     call sampler%fetch (val, x, f)
   end subroutine test_sampler_1_evaluate
 
 @ %def test_sampler_1_evaluate
 @ The point is always valid.
 <<MCI vamp: test sampler 1: TBP>>=
   procedure :: is_valid => test_sampler_1_is_valid
 <<MCI vamp: tests>>=
   function test_sampler_1_is_valid (sampler) result (valid)
     class(test_sampler_1_t), intent(in) :: sampler
     logical :: valid
     valid = .true.
   end function test_sampler_1_is_valid
 
 @ %def test_sampler_1_is_valid
 @ Rebuild: compute all but the function value.
 <<MCI vamp: test sampler 1: TBP>>=
   procedure :: rebuild => test_sampler_1_rebuild
 <<MCI vamp: tests>>=
   subroutine test_sampler_1_rebuild (sampler, c, x_in, val, x, f)
     class(test_sampler_1_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(in) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     if (allocated (sampler%x))  deallocate (sampler%x)
     allocate (sampler%x (size (x_in)))
     sampler%x = x_in
     sampler%val = val
     x(:,1) = sampler%x
     f = 1
   end subroutine test_sampler_1_rebuild
 
 @ %def test_sampler_1_rebuild
 @ Extract the results.
 <<MCI vamp: test sampler 1: TBP>>=
   procedure :: fetch => test_sampler_1_fetch
 <<MCI vamp: tests>>=
   subroutine test_sampler_1_fetch (sampler, val, x, f)
     class(test_sampler_1_t), intent(in) :: sampler
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     val = sampler%val
     x(:,1) = sampler%x
     f = 1
   end subroutine test_sampler_1_fetch
 
 @ %def test_sampler_1_fetch
 @
 \subsubsection{Two-channel, two dimension test sampler}
 This sampler implements the function
 \begin{equation}
   f(x, y) = 4\sin^2(\pi x)\sin^2(\pi y) + 2\sin^2(\pi v)
 \end{equation}
 where
 \begin{align}
   x &= u^v        &u &= xy
 \\
   y &= u^{(1-v)}  &v &= \frac12\left(1 + \frac{\log(x/y)}{\log xy}\right)
 \end{align}
 Each term contributes $1$ to the integral.  The first term in the function is
 peaked along a cross aligned to the coordinates $x$ and $y$, while the second
 term is peaked along the diagonal $x=y$.
 
 The Jacobian is
 \begin{equation}
   \frac{\partial(x,y)}{\partial(u,v)} = |\log u|
 \end{equation}
 <<MCI vamp: test types>>=
   type, extends (mci_sampler_t) :: test_sampler_2_t
      real(default), dimension(:,:), allocatable :: x
      real(default), dimension(:), allocatable :: f
      real(default) :: val
    contains
    <<MCI vamp: test sampler 2: TBP>>
   end type test_sampler_2_t
 
 @ %def test_sampler_2_t
 @ Output: There is nothing stored inside, so just print an informative line.
 <<MCI vamp: test sampler 2: TBP>>=
   procedure :: write => test_sampler_2_write
 <<MCI vamp: tests>>=
   subroutine test_sampler_2_write (object, unit, testflag)
     class(test_sampler_2_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)") "Two-channel test sampler 2"
   end subroutine test_sampler_2_write
 
 @ %def test_sampler_2_write
 @ Kinematics: compute $x$ and Jacobians, given the input parameter array.
 <<MCI vamp: test sampler 2: TBP>>=
   procedure :: compute => test_sampler_2_compute
 <<MCI vamp: tests>>=
   subroutine test_sampler_2_compute (sampler, c, x_in)
     class(test_sampler_2_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default) :: xx, yy, uu, vv
     if (.not. allocated (sampler%x)) &
          allocate (sampler%x (size (x_in), 2))
     if (.not. allocated (sampler%f)) &
          allocate (sampler%f (2))
     select case (c)
     case (1)
        xx = x_in(1)
        yy = x_in(2)
        uu = xx * yy
        vv = (1 + log (xx/yy) / log (xx*yy)) / 2
     case (2)
        uu = x_in(1)
        vv = x_in(2)
        xx = uu ** vv
        yy = uu ** (1 - vv)
     end select
     sampler%val = (2 * sin (pi * xx) * sin (pi * yy)) ** 2 &
          + 2 * sin (pi * vv) ** 2
     sampler%f(1) = 1
     sampler%f(2) = abs (log (uu))
     sampler%x(:,1) = [xx, yy]
     sampler%x(:,2) = [uu, vv]
   end subroutine test_sampler_2_compute
 
 @ %def test_sampler_kinematics
 @ Evaluation: compute the function value.  The output $x$ parameter
 (only one channel) is identical to the input $x$, and the Jacobian is 1.
 <<MCI vamp: test sampler 2: TBP>>=
   procedure :: evaluate => test_sampler_2_evaluate
 <<MCI vamp: tests>>=
   subroutine test_sampler_2_evaluate (sampler, c, x_in, val, x, f)
     class(test_sampler_2_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     call sampler%compute (c, x_in)
     call sampler%fetch (val, x, f)
   end subroutine test_sampler_2_evaluate
 
 @ %def test_sampler_2_evaluate
 @ The point is always valid.
 <<MCI vamp: test sampler 2: TBP>>=
   procedure :: is_valid => test_sampler_2_is_valid
 <<MCI vamp: tests>>=
   function test_sampler_2_is_valid (sampler) result (valid)
     class(test_sampler_2_t), intent(in) :: sampler
     logical :: valid
     valid = .true.
   end function test_sampler_2_is_valid
 
 @ %def test_sampler_2_is_valid
 @ Rebuild: compute all but the function value.
 <<MCI vamp: test sampler 2: TBP>>=
   procedure :: rebuild => test_sampler_2_rebuild
 <<MCI vamp: tests>>=
   subroutine test_sampler_2_rebuild (sampler, c, x_in, val, x, f)
     class(test_sampler_2_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(in) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     call sampler%compute (c, x_in)
     x = sampler%x
     f = sampler%f
   end subroutine test_sampler_2_rebuild
 
 @ %def test_sampler_2_rebuild
 @ Extract the results.
 <<MCI vamp: test sampler 2: TBP>>=
   procedure :: fetch => test_sampler_2_fetch
 <<MCI vamp: tests>>=
   subroutine test_sampler_2_fetch (sampler, val, x, f)
     class(test_sampler_2_t), intent(in) :: sampler
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     val = sampler%val
     x = sampler%x
     f = sampler%f
   end subroutine test_sampler_2_fetch
 
 @ %def test_sampler_2_fetch
 @
 \subsubsection{Two-channel, one dimension test sampler}
 This sampler implements the function
 \begin{equation}
   f(x, y) = a * 5 x^4 + b * 5 (1-x)^4
 \end{equation}
 Each term contributes $1$ to the integral, multiplied by $a$ or $b$,
 respectively.  The first term is peaked at $x=1$, the second one at $x=0$..
 
 We implement the two mappings
 \begin{equation}
   x = u^{1/5} \quad\text{and}\quad x = 1 - v^{1/5},
 \end{equation}
 with Jacobians
 \begin{equation}
   \frac{\partial(x)}{\partial(u)} = u^{-4/5}/5 \quad\text{and}\quad v^{-4/5}/5,
 \end{equation}
 respectively.  The first mapping concentrates points near $x=1$, the
 second one near $x=0$.
 <<MCI vamp: test types>>=
   type, extends (mci_sampler_t) :: test_sampler_3_t
      real(default), dimension(:,:), allocatable :: x
      real(default), dimension(:), allocatable :: f
      real(default) :: val
      real(default) :: a = 1
      real(default) :: b = 1
    contains
    <<MCI vamp: test sampler 3: TBP>>
   end type test_sampler_3_t
 
 @ %def test_sampler_3_t
 @ Output: display $a$ and $b$
 <<MCI vamp: test sampler 3: TBP>>=
   procedure :: write => test_sampler_3_write
 <<MCI vamp: tests>>=
   subroutine test_sampler_3_write (object, unit, testflag)
     class(test_sampler_3_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)") "Two-channel test sampler 3"
     write (u, "(3x,A,F5.2)")  "a = ", object%a
     write (u, "(3x,A,F5.2)")  "b = ", object%b
   end subroutine test_sampler_3_write
 
 @ %def test_sampler_3_write
 @ Kinematics: compute $x$ and Jacobians, given the input parameter array.
 <<MCI vamp: test sampler 3: TBP>>=
   procedure :: compute => test_sampler_3_compute
 <<MCI vamp: tests>>=
   subroutine test_sampler_3_compute (sampler, c, x_in)
     class(test_sampler_3_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default) :: u, v, xx
     if (.not. allocated (sampler%x)) &
          allocate (sampler%x (size (x_in), 2))
     if (.not. allocated (sampler%f)) &
          allocate (sampler%f (2))
     select case (c)
     case (1)
        u = x_in(1)
        xx = u ** 0.2_default
        v = (1 - xx) ** 5._default
     case (2)
        v = x_in(1)
        xx = 1 - v ** 0.2_default
        u = xx ** 5._default
     end select
     sampler%val = sampler%a * 5 * xx ** 4 + sampler%b * 5 * (1 - xx) ** 4
     sampler%f(1) = 0.2_default * u ** (-0.8_default)
     sampler%f(2) = 0.2_default * v ** (-0.8_default)
     sampler%x(:,1) = [u]
     sampler%x(:,2) = [v]
   end subroutine test_sampler_3_compute
 
 @ %def test_sampler_kineamtics
 @ Evaluation: compute the function value.  The output $x$ parameter
 (only one channel) is identical to the input $x$, and the Jacobian is 1.
 <<MCI vamp: test sampler 3: TBP>>=
   procedure :: evaluate => test_sampler_3_evaluate
 <<MCI vamp: tests>>=
   subroutine test_sampler_3_evaluate (sampler, c, x_in, val, x, f)
     class(test_sampler_3_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     call sampler%compute (c, x_in)
     call sampler%fetch (val, x, f)
   end subroutine test_sampler_3_evaluate
 
 @ %def test_sampler_3_evaluate
 @ The point is always valid.
 <<MCI vamp: test sampler 3: TBP>>=
   procedure :: is_valid => test_sampler_3_is_valid
 <<MCI vamp: tests>>=
   function test_sampler_3_is_valid (sampler) result (valid)
     class(test_sampler_3_t), intent(in) :: sampler
     logical :: valid
     valid = .true.
   end function test_sampler_3_is_valid
 
 @ %def test_sampler_3_is_valid
 @ Rebuild: compute all but the function value.
 <<MCI vamp: test sampler 3: TBP>>=
   procedure :: rebuild => test_sampler_3_rebuild
 <<MCI vamp: tests>>=
   subroutine test_sampler_3_rebuild (sampler, c, x_in, val, x, f)
     class(test_sampler_3_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(in) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     call sampler%compute (c, x_in)
     x = sampler%x
     f = sampler%f
   end subroutine test_sampler_3_rebuild
 
 @ %def test_sampler_3_rebuild
 @ Extract the results.
 <<MCI vamp: test sampler 3: TBP>>=
   procedure :: fetch => test_sampler_3_fetch
 <<MCI vamp: tests>>=
   subroutine test_sampler_3_fetch (sampler, val, x, f)
     class(test_sampler_3_t), intent(in) :: sampler
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     val = sampler%val
     x = sampler%x
     f = sampler%f
   end subroutine test_sampler_3_fetch
 
 @ %def test_sampler_3_fetch
 @
 \subsubsection{One-dimensional integration}
 Construct an integrator and use it for a one-dimensional sampler.
 
 Note: We would like to check the precise contents of the grid
 allocated during integration, but the output format for reals is very
 long (for good reasons), so the last digits in the grid content
 display are numerical noise.  So, we just check the integration
 results.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_1, "mci_vamp_1", &
        "one-dimensional integral", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_1
 <<MCI vamp: tests>>=
   subroutine mci_vamp_1 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_1"
     write (u, "(A)")  "*   Purpose: integrate function in one dimension &
          &(single channel)"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (1, 1)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_1_t :: sampler)
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_calls = 1000"
     write (u, "(A)")  "   (lower precision to avoid"
     write (u, "(A)")  "      numerical noise)"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass ()
     end select
     call mci%integrate (mci_instance, sampler, 1, 1000, pacify = .true.)
     call mci%write (u, .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u, .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_1"
 
   end subroutine mci_vamp_1
 
 @ %def mci_vamp_1
 @
 \subsubsection{Multiple iterations}
 Construct an integrator and use it for a one-dimensional sampler.
 Integrate with five iterations without grid adaptation.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_2, "mci_vamp_2", &
        "multiple iterations", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_2
 <<MCI vamp: tests>>=
   subroutine mci_vamp_2 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_2"
     write (u, "(A)")  "*   Purpose: integrate function in one dimension &
          &(single channel)"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (1, 1)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_1_t :: sampler)
     select type (sampler)
     type is (test_sampler_1_t)
        sampler%mode = 2
     end select
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 100"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .false.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 100)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_2"
 
   end subroutine mci_vamp_2
 
 @ %def mci_vamp_2
 @
 \subsubsection{Grid adaptation}
 Construct an integrator and use it for a one-dimensional sampler.
 Integrate with three iterations and in-between grid adaptations.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_3, "mci_vamp_3", &
        "grid adaptation", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_3
 <<MCI vamp: tests>>=
   subroutine mci_vamp_3 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_3"
     write (u, "(A)")  "*   Purpose: integrate function in one dimension &
          &(single channel)"
     write (u, "(A)")  "*            and adapt grid"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (1, 1)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_1_t :: sampler)
     select type (sampler)
     type is (test_sampler_1_t)
        sampler%mode = 2
     end select
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 100"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 100)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_3"
 
   end subroutine mci_vamp_3
 
 @ %def mci_vamp_3
 @
 \subsubsection{Two-dimensional integral}
 Construct an integrator and use it for a two-dimensional sampler.
 Integrate with three iterations and in-between grid adaptations.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_4, "mci_vamp_4", &
        "two-dimensional integration", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_4
 <<MCI vamp: tests>>=
   subroutine mci_vamp_4 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_4"
     write (u, "(A)")  "*   Purpose: integrate function in two dimensions &
          &(single channel)"
     write (u, "(A)")  "*            and adapt grid"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (2, 1)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_1_t :: sampler)
     select type (sampler)
     type is (test_sampler_1_t)
        sampler%mode = 3
     end select
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 1000"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_4"
 
   end subroutine mci_vamp_4
 
 @ %def mci_vamp_4
 @
 \subsubsection{Two-channel integral}
 Construct an integrator and use it for a two-dimensional sampler with two
 channels.
 
 Integrate with three iterations and in-between grid adaptations.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_5, "mci_vamp_5", &
        "two-dimensional integration", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_5
 <<MCI vamp: tests>>=
   subroutine mci_vamp_5 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_5"
     write (u, "(A)")  "*   Purpose: integrate function in two dimensions &
          &(two channels)"
     write (u, "(A)")  "*            and adapt grid"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_2_t :: sampler)
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 1000"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_5"
 
   end subroutine mci_vamp_5
 
 @ %def mci_vamp_5
 @
 \subsubsection{Weight adaptation}
 Construct an integrator and use it for a one-dimensional sampler with two
 channels.
 
 Integrate with three iterations and in-between weight adaptations.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_6, "mci_vamp_6", &
        "weight adaptation", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_6
 <<MCI vamp: tests>>=
   subroutine mci_vamp_6 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_6"
     write (u, "(A)")  "*   Purpose: integrate function in one dimension &
          &(two channels)"
     write (u, "(A)")  "*            and adapt weights"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (1, 2)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_3_t :: sampler)
     select type (sampler)
     type is (test_sampler_3_t)
        sampler%a = 0.9_default
        sampler%b = 0.1_default
     end select
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 1000"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_weights = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
     deallocate (mci_instance)
     deallocate (mci)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-initialize with chained channels"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (1, 2)
     call mci%declare_chains ([1,1])
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 1000"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_weights = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_6"
 
   end subroutine mci_vamp_6
 
 @ %def mci_vamp_6
 @
 \subsubsection{Equivalences}
 Construct an integrator and use it for a one-dimensional sampler with two
 channels.
 
 Integrate with three iterations and in-between grid adaptations.
 Apply an equivalence between the two channels, so the binning of the
 two channels is forced to coincide.  Compare this with the behavior
 without equivalences.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_7, "mci_vamp_7", &
        "use channel equivalences", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_7
 <<MCI vamp: tests>>=
   subroutine mci_vamp_7 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     type(phs_channel_t), dimension(:), allocatable :: channel
     class(rng_t), allocatable :: rng
     real(default), dimension(:,:), allocatable :: x
     integer :: u_grid, iostat, i, div, ch
     character(16) :: buffer
 
     write (u, "(A)")  "* Test output: mci_vamp_7"
     write (u, "(A)")  "*   Purpose: check effect of channel equivalences"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (1, 2)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_3_t :: sampler)
     select type (sampler)
     type is (test_sampler_3_t)
        sampler%a = 0.7_default
        sampler%b = 0.3_default
     end select
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 2 and n_calls = 1000, &
          &adapt grids"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 2, 1000)
 
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Write grids and extract binning"
     write (u, "(A)")
 
     u_grid = free_unit ()
     open (u_grid, status = "scratch", action = "readwrite")
     select type (mci_instance)
     type is (mci_vamp_instance_t)
        call vamp_write_grids (mci_instance%grids, u_grid)
     end select
     rewind (u_grid)
     allocate (x (0:20, 2))
     do div = 1, 2
        FIND_BINS1: do
           read (u_grid, "(A)")  buffer
           if (trim (adjustl (buffer)) == "begin d%x") then
              do
                 read (u_grid, *, iostat = iostat)  i, x(i,div)
                 if (iostat /= 0)  exit FIND_BINS1
              end do
           end if
        end do FIND_BINS1
     end do
     close (u_grid)
 
     write (u, "(1x,A,L1)")  "Equal binning in both channels = ", &
          all (x(:,1) == x(:,2))
     deallocate (x)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
     deallocate (mci_instance)
     deallocate (mci)
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-initialize integrator, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (1, 2)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .true.
        call mci%set_grid_parameters (grid_par)
     end select
 
     write (u, "(A)")  "* Define equivalences"
     write (u, "(A)")
 
     allocate (channel (2))
     do ch = 1, 2
        allocate (channel(ch)%eq (2))
        do i = 1, 2
           associate (eq => channel(ch)%eq(i))
             call eq%init (1)
             eq%c = i
             eq%perm = [1]
             eq%mode = [0]
           end associate
        end do
        write (u, "(1x,I0,':')", advance = "no")  ch
        call channel(ch)%write (u)
     end do
     call mci%declare_equivalences (channel, dim_offset = 0)
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 2 and n_calls = 1000, &
          &adapt grids"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 2, 1000)
 
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)") "* Write grids and extract binning"
     write (u, "(A)")
 
     u_grid = free_unit ()
     open (u_grid, status = "scratch", action = "readwrite")
     select type (mci_instance)
     type is (mci_vamp_instance_t)
        call vamp_write_grids (mci_instance%grids, u_grid)
     end select
     rewind (u_grid)
     allocate (x (0:20, 2))
     do div = 1, 2
        FIND_BINS2: do
           read (u_grid, "(A)")  buffer
           if (trim (adjustl (buffer)) == "begin d%x") then
              do
                 read (u_grid, *, iostat = iostat)  i, x(i,div)
                 if (iostat /= 0)  exit FIND_BINS2
              end do
           end if
        end do FIND_BINS2
     end do
     close (u_grid)
 
     write (u, "(1x,A,L1)")  "Equal binning in both channels = ", &
          all (x(:,1) == x(:,2))
     deallocate (x)
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_7"
 
   end subroutine mci_vamp_7
 
 @ %def mci_vamp_7
 @
 \subsubsection{Multiple passes}
 Integrate with three passes and different settings for weight and grid
 adaptation.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_8, "mci_vamp_8", &
        "integration passes", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_8
 <<MCI vamp: tests>>=
   subroutine mci_vamp_8 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_8"
     write (u, "(A)")  "*   Purpose: integrate function in one dimension &
          &(two channels)"
     write (u, "(A)")  "*            in three passes"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (1, 2)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_3_t :: sampler)
     select type (sampler)
     type is (test_sampler_3_t)
        sampler%a = 0.9_default
        sampler%b = 0.1_default
     end select
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with grid and weight adaptation"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .true., adapt_weights = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with grid adaptation"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate without adaptation"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass ()
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_8"
 
   end subroutine mci_vamp_8
 
 @ %def mci_vamp_8
 @
 \subsubsection{Weighted events}
 Construct an integrator and use it for a two-dimensional sampler with two
 channels.  Integrate and generate a weighted event.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_9, "mci_vamp_9", &
        "weighted event", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_9
 <<MCI vamp: tests>>=
   subroutine mci_vamp_9 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_9"
     write (u, "(A)")  "*   Purpose: integrate function in two dimensions &
          &(two channels)"
     write (u, "(A)")  "*            and generate a weighted event"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_2_t :: sampler)
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 1000"
     write (u, "(A)")
 
     call mci%add_pass ()
     call mci%integrate (mci_instance, sampler, 1, 1000)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate a weighted event"
     write (u, "(A)")
 
     call mci_instance%init_simulation ()
     call mci%generate_weighted_event (mci_instance, sampler)
 
     write (u, "(1x,A)")  "MCI instance:"
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final_simulation ()
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_9"
 
   end subroutine mci_vamp_9
 
 @ %def mci_vamp_9
 @
 \subsubsection{Grids I/O}
 Construct an integrator and allocate grids.  Write grids to file, read
 them in again and compare.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_10, "mci_vamp_10", &
        "grids I/O", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_10
 <<MCI vamp: tests>>=
   subroutine mci_vamp_10 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
     type(string_t) :: file1, file2
     character(80) :: buffer1, buffer2
     integer :: u1, u2, iostat1, iostat2
     logical :: equal, success
 
     write (u, "(A)")  "* Test output: mci_vamp_10"
     write (u, "(A)")  "*   Purpose: write and read VAMP grids"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     mci%md5sum = "1234567890abcdef1234567890abcdef"
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_2_t :: sampler)
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 1000"
     write (u, "(A)")
 
     call mci%add_pass ()
     call mci%integrate (mci_instance, sampler, 1, 1000)
 
     write (u, "(A)")  "* Write grids to file"
     write (u, "(A)")
 
     file1 = "mci_vamp_10.1"
     select type (mci)
     type is (mci_vamp_t)
        call mci%set_grid_filename (file1)
        call mci%write_grids (mci_instance)
     end select
 
     call mci_instance%final ()
     call mci%final ()
     deallocate (mci)
 
     write (u, "(A)")  "* Read grids from file"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_vamp_t)
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     mci%md5sum = "1234567890abcdef1234567890abcdef"
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%set_grid_filename (file1)
        call mci%add_pass ()
        call mci%current_pass%configure (1, 1000, &
             mci%min_calls, &
             mci%grid_par%min_bins, mci%grid_par%max_bins, &
             mci%grid_par%min_calls_per_channel * mci%n_channel)
        call mci%read_grids_header (success)
        call mci%compute_md5sum ()
        call mci%read_grids_data (mci_instance, read_integrals = .true.)
     end select
     write (u, "(1x,A,L1)")  "success = ", success
 
     write (u, "(A)")
     write (u, "(A)")  "* Write grids again"
     write (u, "(A)")
 
     file2 = "mci_vamp_10.2"
     select type (mci)
     type is (mci_vamp_t)
        call mci%set_grid_filename (file2)
        call mci%write_grids (mci_instance)
     end select
 
     u1 = free_unit ()
     open (u1, file = char (file1) // ".vg", action = "read", status = "old")
     u2 = free_unit ()
     open (u2, file = char (file2) // ".vg", action = "read", status = "old")
 
     equal = .true.
     iostat1 = 0
     iostat2 = 0
     do while (equal .and. iostat1 == 0 .and. iostat2 == 0)
        read (u1, "(A)", iostat = iostat1)  buffer1
        read (u2, "(A)", iostat = iostat2)  buffer2
        equal = buffer1 == buffer2 .and. iostat1 == iostat2
     end do
     close (u1)
     close (u2)
 
     if (equal) then
        write (u, "(1x,A)")  "Success: grid files are identical"
     else
        write (u, "(1x,A)")  "Failure: grid files differ"
     end if
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_10"
 
   end subroutine mci_vamp_10
 
 @ %def mci_vamp_10
 @
 \subsubsection{Weighted events with grid I/O}
 Construct an integrator and use it for a two-dimensional sampler with two
 channels.  Integrate, write grids, and generate a weighted event using
 the grids from file.
 <<MCI vamp: execute tests>>=
  call test (mci_vamp_11, "mci_vamp_11", &
       "weighted events with grid I/O", &
       u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_11
 <<MCI vamp: tests>>=
   subroutine mci_vamp_11 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_11"
     write (u, "(A)")  "*   Purpose: integrate function in two dimensions &
          &(two channels)"
     write (u, "(A)")  "*            and generate a weighted event"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
        call mci%set_grid_filename (var_str ("mci_vamp_11"))
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_2_t :: sampler)
 
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 1000"
     write (u, "(A)")
 
     call mci%add_pass ()
     call mci%integrate (mci_instance, sampler, 1, 1000)
 
     write (u, "(A)")  "* Reset instance"
     write (u, "(A)")
 
     call mci_instance%final ()
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Generate a weighted event"
     write (u, "(A)")
 
     call mci_instance%init_simulation ()
     call mci%generate_weighted_event (mci_instance, sampler)
 
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final_simulation ()
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_11"
 
   end subroutine mci_vamp_11
 
 @ %def mci_vamp_11
 @
 \subsubsection{Unweighted events with grid I/O}
 Construct an integrator and use it for a two-dimensional sampler with two
 channels.
 <<MCI vamp: execute tests>>=
  call test (mci_vamp_12, "mci_vamp_12", &
       "unweighted events with grid I/O", &
       u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_12
 <<MCI vamp: tests>>=
   subroutine mci_vamp_12 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_12"
     write (u, "(A)")  "*   Purpose: integrate function in two dimensions &
          &(two channels)"
     write (u, "(A)")  "*            and generate an unweighted event"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
        call mci%set_grid_filename (var_str ("mci_vamp_12"))
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_2_t :: sampler)
 
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 1000"
     write (u, "(A)")
 
     call mci%add_pass ()
     call mci%integrate (mci_instance, sampler, 1, 1000)
 
     write (u, "(A)")  "* Reset instance"
     write (u, "(A)")
 
     call mci_instance%final ()
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Generate an unweighted event"
     write (u, "(A)")
 
     call mci_instance%init_simulation ()
     call mci%generate_unweighted_event (mci_instance, sampler)
 
     write (u, "(1x,A)")  "MCI instance:"
     call mci_instance%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final_simulation ()
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_12"
 
   end subroutine mci_vamp_12
 
 @ %def mci_vamp_12
 @
 \subsubsection{Update integration results}
 Compare two [[mci]] objects; match the two and update the first if
 successful.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_13, "mci_vamp_13", &
        "updating integration results", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_13
 <<MCI vamp: tests>>=
   subroutine mci_vamp_13 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci, mci_ref
     logical :: success
 
     write (u, "(A)")  "* Test output: mci_vamp_13"
     write (u, "(A)")  "*   Purpose: match and update integrators"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator with no passes"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (2, 2)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
     end select
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize reference"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci_ref)
     call mci_ref%set_dimensions (2, 2)
     select type (mci_ref)
     type is (mci_vamp_t)
        call mci_ref%set_grid_parameters (grid_par)
     end select
 
     select type (mci_ref)
     type is (mci_vamp_t)
        call mci_ref%add_pass (adapt_grids = .true.)
        call mci_ref%current_pass%configure (2, 1000, 0, 1, 5, 0)
        mci_ref%current_pass%calls = [77, 77]
        mci_ref%current_pass%integral = [1.23_default, 3.45_default]
        mci_ref%current_pass%error = [0.23_default, 0.45_default]
        mci_ref%current_pass%efficiency = [0.1_default, 0.6_default]
        mci_ref%current_pass%integral_defined = .true.
 
        call mci_ref%add_pass ()
        call mci_ref%current_pass%configure (2, 2000, 0, 1, 7, 0)
        mci_ref%current_pass%calls = [99, 0]
        mci_ref%current_pass%integral = [7.89_default, 0._default]
        mci_ref%current_pass%error = [0.89_default, 0._default]
        mci_ref%current_pass%efficiency = [0.86_default, 0._default]
        mci_ref%current_pass%integral_defined = .true.
     end select
 
     call mci_ref%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Update integrator (no-op, should succeed)"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%update_from_ref (mci_ref, success)
     end select
 
     write (u, "(1x,A,L1)")  "success = ", success
     write (u, "(A)")
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Add pass to integrator"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .true.)
        call mci%current_pass%configure (2, 1000, 0, 1, 5, 0)
        mci%current_pass%calls = [77, 77]
        mci%current_pass%integral = [1.23_default, 3.45_default]
        mci%current_pass%error = [0.23_default, 0.45_default]
        mci%current_pass%efficiency = [0.1_default, 0.6_default]
        mci%current_pass%integral_defined = .true.
     end select
 
     write (u, "(A)")  "* Update integrator (no-op, should succeed)"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%update_from_ref (mci_ref, success)
     end select
 
     write (u, "(1x,A,L1)")  "success = ", success
     write (u, "(A)")
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Add pass to integrator, wrong parameters"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass ()
        call mci%current_pass%configure (2, 1000, 0, 1, 7, 0)
     end select
 
     write (u, "(A)")  "* Update integrator (should fail)"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%update_from_ref (mci_ref, success)
     end select
 
     write (u, "(1x,A,L1)")  "success = ", success
     write (u, "(A)")
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Reset and add passes to integrator"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%reset ()
        call mci%add_pass (adapt_grids = .true.)
        call mci%current_pass%configure (2, 1000, 0, 1, 5, 0)
        mci%current_pass%calls = [77, 77]
        mci%current_pass%integral = [1.23_default, 3.45_default]
        mci%current_pass%error = [0.23_default, 0.45_default]
        mci%current_pass%efficiency = [0.1_default, 0.6_default]
        mci%current_pass%integral_defined = .true.
 
        call mci%add_pass ()
        call mci%current_pass%configure (2, 2000, 0, 1, 7, 0)
     end select
 
     write (u, "(A)")  "* Update integrator (should succeed)"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%update_from_ref (mci_ref, success)
     end select
 
     write (u, "(1x,A,L1)")  "success = ", success
     write (u, "(A)")
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Update again (no-op, should succeed)"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%update_from_ref (mci_ref, success)
     end select
 
     write (u, "(1x,A,L1)")  "success = ", success
     write (u, "(A)")
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Add extra result to integrator"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        mci%current_pass%calls(2) = 1234
     end select
 
     write (u, "(A)")  "* Update integrator (should fail)"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%update_from_ref (mci_ref, success)
     end select
 
     write (u, "(1x,A,L1)")  "success = ", success
     write (u, "(A)")
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci%final ()
     call mci_ref%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_13"
 
   end subroutine mci_vamp_13
 
 @ %def mci_vamp_13
 @
 \subsubsection{Accuracy Goal}
 Integrate with multiple iterations.  Skip iterations once an accuracy goal has
 been reached.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_14, "mci_vamp_14", &
        "accuracy goal", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_14
 <<MCI vamp: tests>>=
   subroutine mci_vamp_14 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_14"
     write (u, "(A)")  "*   Purpose: integrate function in one dimension &
          &(single channel)"
     write (u, "(A)")  "*            and check accuracy goal"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (1, 1)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%use_vamp_equivalences = .false.
        grid_par%accuracy_goal = 5E-2_default
        call mci%set_grid_parameters (grid_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_1_t :: sampler)
     select type (sampler)
     type is (test_sampler_1_t)
        sampler%mode = 2
     end select
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 5 and n_calls = 100"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 5, 100)
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_14"
 
   end subroutine mci_vamp_14
 
 @ %def mci_vamp_14
 @
 \subsubsection{VAMP history}
 Integrate with three passes and different settings for weight and grid
 adaptation.  Then show the VAMP history.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_15, "mci_vamp_15", &
        "VAMP history", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_15
 <<MCI vamp: tests>>=
   subroutine mci_vamp_15 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     type(history_parameters_t) :: history_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_15"
     write (u, "(A)")  "*   Purpose: integrate function in one dimension &
          &(two channels)"
     write (u, "(A)")  "*            in three passes, show history"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     history_par%channel = .true.
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (1, 2)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%stratified = .false.
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
        call mci%set_history_parameters (history_par)
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_3_t :: sampler)
     select type (sampler)
     type is (test_sampler_3_t)
        sampler%a = 0.9_default
        sampler%b = 0.1_default
     end select
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Pass 1: grid and weight adaptation"
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .true., adapt_weights = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000)
 
     write (u, "(A)")
     write (u, "(A)")  "* Pass 2: grid adaptation"
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass (adapt_grids = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000)
 
     write (u, "(A)")
     write (u, "(A)")  "* Pass 3: without adaptation"
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass ()
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of MCI record, with history"
     write (u, "(A)")
 
     call mci%write (u)
     select type (mci)
     type is (mci_vamp_t)
        call mci%write_history (u)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_15"
 
   end subroutine mci_vamp_15
 
 @ %def mci_vamp_15
 @
 \subsubsection{One-dimensional integration with sign change}
 Construct an integrator and use it for a one-dimensional sampler.
 <<MCI vamp: execute tests>>=
   call test (mci_vamp_16, "mci_vamp_16", &
        "1-D integral with sign change", &
        u, results)
 <<MCI vamp: test declarations>>=
   public :: mci_vamp_16
 <<MCI vamp: tests>>=
   subroutine mci_vamp_16 (u)
     integer, intent(in) :: u
     type(grid_parameters_t) :: grid_par
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
 
     write (u, "(A)")  "* Test output: mci_vamp_16"
     write (u, "(A)")  "*   Purpose: integrate function in one dimension &
          &(single channel)"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator"
     write (u, "(A)")
 
     allocate (mci_vamp_t :: mci)
     call mci%set_dimensions (1, 1)
     select type (mci)
     type is (mci_vamp_t)
        grid_par%use_vamp_equivalences = .false.
        call mci%set_grid_parameters (grid_par)
        mci%negative_weights = .true.
     end select
 
     allocate (rng_tao_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")  "* Initialize test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_1_t :: sampler)
     select type (sampler)
     type is (test_sampler_1_t)
        sampler%mode = 4
     end select
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_calls = 1000"
     write (u, "(A)")  "   (lower precision to avoid"
     write (u, "(A)")  "      numerical noise)"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp_t)
        call mci%add_pass ()
     end select
     call mci%integrate (mci_instance, sampler, 1, 1000, pacify = .true.)
     call mci%write (u, .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u, .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp_16"
 
   end subroutine mci_vamp_16
 
 @ %def mci_vamp_16
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Multi-channel integration with VAMP2}
 \label{sec:vegas-integration}
 The multi-channel integration uses VEGAS as backbone integrator.
 The base interface for the multi-channel integration is given by [[mci_base]] module.
 
 We interface the VAMP2 interface given by [[vamp2]] module.
 
 <<[[mci_vamp2.f90]]>>=
 <<File header>>
 
 module mci_vamp2
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_utils, only: pac_fmt
   use format_utils, only: write_separator, write_indent
   use format_defs, only: FMT_12, FMT_14, FMT_17, FMT_19
+  use constants, only: tiny_13
   use diagnostics
   use md5
   use phs_base
   use rng_base
 
   use mci_base
 
   use vegas, only: VEGAS_MODE_IMPORTANCE, VEGAS_MODE_IMPORTANCE_ONLY
   use vamp2
 
 <<MCI vamp2: modules>>
 
 <<Standard module head>>
 
 <<MCI vamp2: public>>
 
 <<MCI vamp2: types>>
 
 <<MCI vamp2: interfaces>>
 
 contains
 
 <<MCI vamp2: procedures>>
 
 end module mci_vamp2
 @ %def mci_vamp2
 <<MCI vamp2: modules>>=
 @
 <<MPI: MCI vamp2: modules>>=
   use mpi_f08 !NODEP!
 @ %def mpi_f08
 @
 \subsection{Type: mci\_vamp2\_func\_t}
 \label{sec:mci-vamp2-func}
 
 <<MCI vamp2: types>>=
   type, extends (vamp2_func_t) :: mci_vamp2_func_t
      private
      real(default) :: integrand = 0.
      class(mci_sampler_t), pointer :: sampler => null ()
      class(mci_vamp2_instance_t), pointer :: instance => null ()
    contains
    <<MCI vamp2: mci vamp2 func: TBP>>
   end type mci_vamp2_func_t
 
 @ %def mci_vamp2_func_t
 @ Set instance and sampler aka workspace. Also, reset number of [[n_calls]].
 <<MCI vamp2: mci vamp2 func: TBP>>=
   procedure, public :: set_workspace => mci_vamp2_func_set_workspace
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_func_set_workspace (self, instance, sampler)
     class(mci_vamp2_func_t), intent(inout) :: self
     class(mci_vamp2_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     self%instance => instance
     self%sampler => sampler
   end subroutine mci_vamp2_func_set_workspace
 
 @ %def mci_vamp2_func_set_workspace
 @ Get the different channel probabilities.
 <<MCI vamp2: mci vamp2 func: TBP>>=
   procedure, public :: get_probabilities => mci_vamp2_func_get_probabilities
 <<MCI vamp2: procedures>>=
   function mci_vamp2_func_get_probabilities (self) result (gi)
     class(mci_vamp2_func_t), intent(inout) :: self
     real(default), dimension(self%n_channel) :: gi
     gi = self%gi
   end function mci_vamp2_func_get_probabilities
 
 @ %def mci_vamp2_func_get_probabilities
 @ Get multi-channel weight.
 <<MCI vamp2: mci vamp2 func: TBP>>=
   procedure, public :: get_weight => mci_vamp2_func_get_weight
 <<MCI vamp2: procedures>>=
   real(default) function mci_vamp2_func_get_weight (self) result (g)
     class(mci_vamp2_func_t), intent(in) :: self
     g = self%g
   end function mci_vamp2_func_get_weight
 
 @ %def mci_vamp2_func_get_weight
 @ Set integrand.
 <<MCI vamp2: mci vamp2 func: TBP>>=
   procedure, public :: set_integrand => mci_vamp2_func_set_integrand
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_func_set_integrand (self, integrand)
     class(mci_vamp2_func_t), intent(inout) :: self
     real(default), intent(in) :: integrand
     self%integrand = integrand
   end subroutine mci_vamp2_func_set_integrand
 
 @ %def mci_vamp2_func_set_integrand
 @ Evaluate the mappings.
 <<MCI vamp2: mci vamp2 func: TBP>>=
   procedure, public :: evaluate_maps => mci_vamp2_func_evaluate_maps
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_func_evaluate_maps (self, x)
     class(mci_vamp2_func_t), intent(inout) :: self
     real(default), dimension(:), intent(in) :: x
     select type (self)
     type is (mci_vamp2_func_t)
        call self%instance%evaluate (self%sampler, self%current_channel, x)
     end select
     self%valid_x = self%instance%valid
     self%xi = self%instance%x
     self%det = self%instance%f
   end subroutine mci_vamp2_func_evaluate_maps
 
 @ %def mci_vamp2_func_evaluate_maps
 @ Evaluate the function, more or less.
 <<MCI vamp2: mci vamp2 func: TBP>>=
   procedure, public :: evaluate_func => mci_vamp2_func_evaluate_func
 <<MCI vamp2: procedures>>=
   real(default) function mci_vamp2_func_evaluate_func (self, x) result (f)
     class(mci_vamp2_func_t), intent(in) :: self
     real(default), dimension(:), intent(in) :: x
     f = self%integrand
     if (signal_is_pending ()) then
        call msg_message ("MCI VAMP2: function evalutae func: signal received")
        call terminate_now_if_signal ()
     end if
     call terminate_now_if_single_event ()
   end function mci_vamp2_func_evaluate_func
 
 @ %def mci_vamp2_func_evaluate_func
 @
 \subsection{Type: mci\_vamp2\_config\_t}
 We extend [[vamp2_config_t]].
 <<MCI vamp2: public>>=
   public :: mci_vamp2_config_t
 <<MCI vamp2: types>>=
   type, extends (vamp2_config_t) :: mci_vamp2_config_t
      !
   end type mci_vamp2_config_t
 
 @ %def mci_vamp2_config_t
 @
 \subsection{Integration pass}
 The list of passes is organized in a separate container. We store the parameters
 and results for each integration pass in [[pass_t]] and the linked list is
 stored in [[list_pass_t]].
 <<MCI vamp2: types>>=
   type :: list_pass_t
      type(pass_t), pointer :: first => null ()
      type(pass_t), pointer :: current => null ()
    contains
    <<MCI vamp2: list pass: TBP>>
   end type list_pass_t
 
 @ %def list_pass_t
 @ Finalizer. Deallocate each element of the list beginning by the first.
 <<MCI vamp2: list pass: TBP>>=
   procedure :: final => list_pass_final
 <<MCI vamp2: procedures>>=
   subroutine list_pass_final (self)
     class(list_pass_t), intent(inout) :: self
     type(pass_t), pointer :: current
     current => self%first
     do while (associated (current))
        self%first => current%next
        deallocate (current)
        current => self%first
     end do
   end subroutine list_pass_final
 
 @ %def pass_final
 @ Add a new pass.
 <<MCI vamp2: list pass: TBP>>=
   procedure :: add => list_pass_add
 <<MCI vamp2: procedures>>=
   subroutine list_pass_add (self, adapt_grids, adapt_weights, final_pass)
     class(list_pass_t), intent(inout) :: self
     logical, intent(in), optional :: adapt_grids, adapt_weights, final_pass
     type(pass_t), pointer :: new_pass
     allocate (new_pass)
     new_pass%i_pass = 1
     new_pass%i_first_it = 1
     new_pass%adapt_grids = .false.; if (present (adapt_grids)) &
          & new_pass%adapt_grids = adapt_grids
     new_pass%adapt_weights = .false.; if (present (adapt_weights)) &
          & new_pass%adapt_weights = adapt_weights
     new_pass%is_final_pass = .false.; if (present (final_pass)) &
          & new_pass%is_final_pass = final_pass
     if (.not. associated (self%first)) then
        self%first => new_pass
     else
        new_pass%i_pass = new_pass%i_pass + self%current%i_pass
        new_pass%i_first_it = self%current%i_first_it + self%current%n_it
        self%current%next => new_pass
     end if
     self%current => new_pass
   end subroutine list_pass_add
 
 @ %def list_pass_add
 @ Update list from a reference. All passes except for the last one must match
 exactly. For the last one, integration results are updated. The reference output
 may contain extra passes, these are ignored.
 <<MCI vamp2: list pass: TBP>>=
   procedure :: update_from_ref => list_pass_update_from_ref
 <<MCI vamp2: procedures>>=
   subroutine list_pass_update_from_ref (self, ref, success)
     class(list_pass_t), intent(inout) :: self
     type(list_pass_t), intent(in) :: ref
     logical, intent(out) :: success
     type(pass_t), pointer :: current, ref_current
     current => self%first
     ref_current => ref%first
     success = .true.
     do while (success .and. associated (current))
        if (associated (ref_current)) then
           if (associated (current%next)) then
              success = current .matches. ref_current
           else
              call current%update (ref_current, success)
           end if
           current => current%next
           ref_current => ref_current%next
        else
           success = .false.
        end if
     end do
   end subroutine list_pass_update_from_ref
 
 @ %def list_pass_update_from_ref
 @ Output. Write the complete linked list to the specified unit.
 <<MCI vamp2: list pass: TBP>>=
   procedure :: write => list_pass_write
 <<MCI vamp2: procedures>>=
   subroutine list_pass_write (self, unit, pacify)
     class(list_pass_t), intent(in) :: self
     integer, intent(in) :: unit
     logical, intent(in), optional :: pacify
     type(pass_t), pointer :: current
     current => self%first
     do while (associated (current))
        write (unit, "(1X,A)") "Integration pass:"
        call current%write (unit, pacify)
        current => current%next
     end do
   end subroutine list_pass_write
 
 @ %def list_pass_write
 @ The parameters and results are stored in the nodes [[pass_t]] of the linked
 list.
 <<MCI vamp2: types>>=
   type :: pass_t
      integer :: i_pass = 0
      integer :: i_first_it = 0
      integer :: n_it = 0
      integer :: n_calls = 0
      logical :: adapt_grids = .false.
      logical :: adapt_weights = .false.
      logical :: is_final_pass = .false.
      logical :: integral_defined = .false.
      integer, dimension(:), allocatable :: calls
      integer, dimension(:), allocatable :: calls_valid
      real(default), dimension(:), allocatable :: integral
      real(default), dimension(:), allocatable :: error
      real(default), dimension(:), allocatable :: efficiency
      type(pass_t), pointer :: next => null ()
    contains
    <<MCI vamp2: pass: TBP>>
   end type pass_t
 
 @ %def pass_t
 @ Output.  Note that the precision of the numerical values should match the
 precision for comparing output from file with data.
 <<MCI vamp2: pass: TBP>>=
   procedure :: write => pass_write
 <<MCI vamp2: procedures>>=
   subroutine pass_write (self, unit, pacify)
     class(pass_t), intent(in) :: self
     integer, intent(in) :: unit
     logical, intent(in), optional :: pacify
     integer :: u, i
+    real(default) :: pac_error
     character(len=7) :: fmt
     call pac_fmt (fmt, FMT_17, FMT_14, pacify)
     u = given_output_unit (unit)
     write (u, "(3X,A,I0)") "n_it          = ", self%n_it
     write (u, "(3X,A,I0)") "n_calls       = ", self%n_calls
     write (u, "(3X,A,L1)") "adapt grids   = ", self%adapt_grids
     write (u, "(3X,A,L1)") "adapt weights = ", self%adapt_weights
     if (self%integral_defined) then
        write (u, "(3X,A)") "Results:  [it, calls, valid, integral, error, efficiency]"
        do i = 1, self%n_it
+          if (abs (self%error(i)) > tiny_13) then
+             pac_error = self%error(i)
+          else
+             pac_error = 0
+          end if
           write (u, "(5x,I0,2(1x,I0),3(1x," // fmt // "))") &
-               i, self%calls(i), self%calls_valid(i), self%integral(i), self%error(i), &
-               self%efficiency(i)
+               i, self%calls(i), self%calls_valid(i), self%integral(i), &
+               pac_error, self%efficiency(i)
        end do
     else
        write (u, "(3x,A)")  "Results: [undefined]"
     end if
   end subroutine pass_write
 
 @ %def pass_write
 @ Read and reconstruct the pass.
 <<MCI vamp2: pass: TBP>>=
   procedure :: read => pass_read
 <<MCI vamp2: procedures>>=
   subroutine pass_read (self, u, n_pass, n_it)
     class(pass_t), intent(out) :: self
     integer, intent(in) :: u, n_pass, n_it
     integer :: i, j
     character(80) :: buffer
     self%i_pass = n_pass + 1
     self%i_first_it = n_it + 1
     call read_ival (u, self%n_it)
     call read_ival (u, self%n_calls)
     call read_lval (u, self%adapt_grids)
     call read_lval (u, self%adapt_weights)
     allocate (self%calls (self%n_it), source = 0)
     allocate (self%calls_valid (self%n_it), source = 0)
     allocate (self%integral (self%n_it), source = 0._default)
     allocate (self%error (self%n_it), source = 0._default)
     allocate (self%efficiency (self%n_it), source = 0._default)
     read (u, "(A)")  buffer
     select case (trim (adjustl (buffer)))
     case ("Results:  [it, calls, valid, integral, error, efficiency]")
        do i = 1, self%n_it
           read (u, *) &
                j, self%calls(i), self%calls_valid(i), self%integral(i), self%error(i), &
                self%efficiency(i)
        end do
        self%integral_defined = .true.
     case ("Results: [undefined]")
        self%integral_defined = .false.
     case default
        call msg_fatal ("Reading integration pass: corrupted file")
     end select
   end subroutine pass_read
 
 @ %def pass_read
 @ Auxiliary: Read real, integer, string value.  We search for an equals sign,
 the value must follow.
 <<MCI vamp2: procedures>>=
   subroutine read_rval (u, rval)
     integer, intent(in) :: u
     real(default), intent(out) :: rval
     character(80) :: buffer
     read (u, "(A)")  buffer
     buffer = adjustl (buffer(scan (buffer, "=") + 1:))
     read (buffer, *)  rval
   end subroutine read_rval
 
   subroutine read_ival (u, ival)
     integer, intent(in) :: u
     integer, intent(out) :: ival
     character(80) :: buffer
     read (u, "(A)")  buffer
     buffer = adjustl (buffer(scan (buffer, "=") + 1:))
     read (buffer, *)  ival
   end subroutine read_ival
 
   subroutine read_sval (u, sval)
     integer, intent(in) :: u
     character(*), intent(out) :: sval
     character(80) :: buffer
     read (u, "(A)")  buffer
     buffer = adjustl (buffer(scan (buffer, "=") + 1:))
     read (buffer, *)  sval
   end subroutine read_sval
 
   subroutine read_lval (u, lval)
     integer, intent(in) :: u
     logical, intent(out) :: lval
     character(80) :: buffer
     read (u, "(A)")  buffer
     buffer = adjustl (buffer(scan (buffer, "=") + 1:))
     read (buffer, *)  lval
   end subroutine read_lval
 
 @ %def read_rval read_ival read_sval read_lval
 @ Configure. We adjust the number of [[n_calls]], if it is lower than
 [[n_calls_min_per_channel]] times [[b_channel]], and print a warning message.
 <<MCI vamp2: pass: TBP>>=
   procedure :: configure => pass_configure
 <<MCI vamp2: procedures>>=
   subroutine pass_configure (pass, n_it, n_calls, n_calls_min)
     class(pass_t), intent(inout) :: pass
     integer, intent(in) :: n_it
     integer, intent(in) :: n_calls
     integer, intent(in) :: n_calls_min
     pass%n_it = n_it
     pass%n_calls = max (n_calls, n_calls_min)
     if (pass%n_calls /= n_calls) then
        write (msg_buffer, "(A,I0)")  "VAMP2: too few calls, resetting " &
             // "n_calls to ", pass%n_calls
        call msg_warning ()
     end if
     allocate (pass%calls (n_it), source = 0)
     allocate (pass%calls_valid (n_it), source = 0)
     allocate (pass%integral (n_it), source = 0._default)
     allocate (pass%error (n_it), source = 0._default)
     allocate (pass%efficiency (n_it), source = 0._default)
   end subroutine pass_configure
 
 @ %def pass_configure
 @ Given two pass objects, compare them.  All parameters must match.  Where
 integrations are done in both (number of calls nonzero), the results must be
 equal (up to numerical noise).
 
 The allocated array sizes might be different, but should match up to the
 common [[n_it]] value.
 <<MCI vamp2: interfaces>>=
   interface operator (.matches.)
      module procedure pass_matches
   end interface operator (.matches.)
 <<MCI vamp2: procedures>>=
   function pass_matches (pass, ref) result (ok)
     type(pass_t), intent(in) :: pass, ref
     integer :: n
     logical :: ok
     ok = .true.
     if (ok)  ok = pass%i_pass == ref%i_pass
     if (ok)  ok = pass%i_first_it == ref%i_first_it
     if (ok)  ok = pass%n_it == ref%n_it
     if (ok)  ok = pass%n_calls == ref%n_calls
     if (ok)  ok = pass%adapt_grids .eqv. ref%adapt_grids
     if (ok)  ok = pass%adapt_weights .eqv. ref%adapt_weights
     if (ok)  ok = pass%integral_defined .eqv. ref%integral_defined
     if (pass%integral_defined) then
        n = pass%n_it
        if (ok)  ok = all (pass%calls(:n) == ref%calls(:n))
        if (ok)  ok = all (pass%calls_valid(:n) == ref%calls_valid(:n))
        if (ok)  ok = all (pass%integral(:n) .matches. ref%integral(:n))
        if (ok)  ok = all (pass%error(:n) .matches. ref%error(:n))
        if (ok)  ok = all (pass%efficiency(:n) .matches. ref%efficiency(:n))
     end if
   end function pass_matches
 @ %def pass_matches
 @ Update a pass object, given a reference.  The parameters must match, except
 for the [[n_it]] entry.  The number of complete iterations must be less or
 equal to the reference, and the number of complete iterations in the reference
 must be no larger than [[n_it]].  Where results are present in both passes,
 they must match.  Where results are present in the reference only, the pass is
 updated accordingly.
 <<MCI vamp2: pass: TBP>>=
   procedure :: update => pass_update
 <<MCI vamp2: procedures>>=
   subroutine pass_update (pass, ref, ok)
     class(pass_t), intent(inout) :: pass
     type(pass_t), intent(in) :: ref
     logical, intent(out) :: ok
     integer :: n, n_ref
     ok = .true.
     if (ok)  ok = pass%i_pass == ref%i_pass
     if (ok)  ok = pass%i_first_it == ref%i_first_it
     if (ok)  ok = pass%n_calls == ref%n_calls
     if (ok)  ok = pass%adapt_grids .eqv. ref%adapt_grids
     if (ok)  ok = pass%adapt_weights .eqv. ref%adapt_weights
     if (ok) then
        if (ref%integral_defined) then
           if (.not. allocated (pass%calls)) then
              allocate (pass%calls (pass%n_it), source = 0)
              allocate (pass%calls_valid (pass%n_it), source = 0)
              allocate (pass%integral (pass%n_it), source = 0._default)
              allocate (pass%error (pass%n_it), source = 0._default)
              allocate (pass%efficiency (pass%n_it), source = 0._default)
           end if
           n = count (pass%calls /= 0)
           n_ref = count (ref%calls /= 0)
           ok = n <= n_ref .and. n_ref <= pass%n_it
           if (ok)  ok = all (pass%calls(:n) == ref%calls(:n))
           if (ok)  ok = all (pass%calls_valid(:n) == ref%calls_valid(:n))
           if (ok)  ok = all (pass%integral(:n) .matches. ref%integral(:n))
           if (ok)  ok = all (pass%error(:n) .matches. ref%error(:n))
           if (ok)  ok = all (pass%efficiency(:n) .matches. ref%efficiency(:n))
           if (ok) then
              pass%calls(n+1:n_ref) = ref%calls(n+1:n_ref)
              pass%calls_valid(n+1:n_ref) = ref%calls_valid(n+1:n_ref)
              pass%integral(n+1:n_ref) = ref%integral(n+1:n_ref)
              pass%error(n+1:n_ref) = ref%error(n+1:n_ref)
              pass%efficiency(n+1:n_ref) = ref%efficiency(n+1:n_ref)
              pass%integral_defined = any (pass%calls /= 0)
           end if
        end if
     end if
   end subroutine pass_update
 
 @ %def pass_update
 @ Match two real numbers: they are equal up to a tolerance, which is
 $10^{-8}$, matching the number of digits that are output by [[pass_write]].
 In particular, if one number is exactly zero, the other one must also be zero.
 <<MCI vamp2: interfaces>>=
   interface operator (.matches.)
      module procedure real_matches
   end interface operator (.matches.)
 <<MCI vamp2: procedures>>=
   elemental function real_matches (x, y) result (ok)
     real(default), intent(in) :: x, y
     logical :: ok
     real(default), parameter :: tolerance = 1.e-8_default
     ok = abs (x - y) <= tolerance * max (abs (x), abs (y))
   end function real_matches
 
 @ %def real_matches
 @ Return the index of the most recent complete integration.  If there is none,
 return zero.
 <<MCI vamp2: pass: TBP>>=
   procedure :: get_integration_index => pass_get_integration_index
 <<MCI vamp2: procedures>>=
   function pass_get_integration_index (pass) result (n)
     class (pass_t), intent(in) :: pass
     integer :: n
     integer :: i
     n = 0
     if (allocated (pass%calls)) then
        do i = 1, pass%n_it
           if (pass%calls(i) == 0)  exit
           n = i
        end do
     end if
   end function pass_get_integration_index
 
 @ %def pass_get_integration_index
 @ Return the most recent integral and error, if available.
 <<MCI vamp2: pass: TBP>>=
   procedure :: get_calls => pass_get_calls
   procedure :: get_calls_valid => pass_get_calls_valid
   procedure :: get_integral => pass_get_integral
   procedure :: get_error => pass_get_error
   procedure :: get_efficiency => pass_get_efficiency
 <<MCI vamp2: procedures>>=
   function pass_get_calls (pass) result (calls)
     class(pass_t), intent(in) :: pass
     integer :: calls
     integer :: n
     n = pass%get_integration_index ()
     calls = 0
     if (n /= 0) then
        calls = pass%calls(n)
     end if
   end function pass_get_calls
 
   function pass_get_calls_valid (pass) result (valid)
     class(pass_t), intent(in) :: pass
     integer :: valid
     integer :: n
     n = pass%get_integration_index ()
     valid = 0
     if (n /= 0) then
        valid = pass%calls_valid(n)
     end if
   end function pass_get_calls_valid
 
   function pass_get_integral (pass) result (integral)
     class(pass_t), intent(in) :: pass
     real(default) :: integral
     integer :: n
     n = pass%get_integration_index ()
     integral = 0
     if (n /= 0) then
        integral = pass%integral(n)
     end if
   end function pass_get_integral
 
   function pass_get_error (pass) result (error)
     class(pass_t), intent(in) :: pass
     real(default) :: error
     integer :: n
     n = pass%get_integration_index ()
     error = 0
     if (n /= 0) then
        error = pass%error(n)
     end if
   end function pass_get_error
 
   function pass_get_efficiency (pass) result (efficiency)
     class(pass_t), intent(in) :: pass
     real(default) :: efficiency
     integer :: n
     n = pass%get_integration_index ()
     efficiency = 0
     if (n /= 0) then
        efficiency = pass%efficiency(n)
     end if
   end function pass_get_efficiency
 
 @ %def pass_get_calls
 @ %def pass_get_calls_valid
 @ %def pass_get_integral
 @ %def pass_get_error
 @ %def pass_get_efficiency
 @
 \subsection{Integrator}
 \label{sec:integrator}
 We store the different passes of integration, adaptation and actual sampling, in
 a linked list.
 
 We store the total number of calls [[n_calls]] and the minimal number of calls
 [[n_calls_min]]. The latter is calculated based on [[n_channel]] and
 [[min_calls_per_channel]]. If [[n_calls]] is smaller than [[n_calls_min]], then
 we replace [[n_calls]] with [[n_min_calls]].
 <<MCI vamp2: public>>=
   public :: mci_vamp2_t
 <<MCI vamp2: types>>=
   type, extends(mci_t) :: mci_vamp2_t
      type(mci_vamp2_config_t) :: config
      type(vamp2_t) :: integrator
      type(vamp2_equivalences_t) :: equivalences
      logical :: integrator_defined = .false.
      logical :: integrator_from_file = .false.
      logical :: adapt_grids = .false.
      logical :: adapt_weights = .false.
      integer :: n_adapt_grids = 0
      integer :: n_adapt_weights = 0
      integer :: n_calls = 0
      type(list_pass_t) :: list_pass
      logical :: rebuild = .true.
      logical :: check_grid_file = .true.
      logical :: integrator_filename_set = .false.
      logical :: negative_weights = .false.
      logical :: verbose = .false.
      logical :: pass_complete = .false.
      logical :: it_complete = .false.
      type(string_t) :: integrator_filename
      character(32) :: md5sum_adapted = ""
    contains
    <<MCI vamp2: mci vamp2: TBP>>
   end type mci_vamp2_t
 
 @ %def mci_vamp2_t
 @ Finalizer: call to base and list finalizer.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: final => mci_vamp2_final
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_final (object)
     class(mci_vamp2_t), intent(inout) :: object
     call object%list_pass%final ()
     call object%base_final ()
   end subroutine mci_vamp2_final
 
 @ %def mci_vamp2_final
 @ Output. Do not output the grids themselves, this may result in tons of data.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: write => mci_vamp2_write
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_write (object, unit, pacify, md5sum_version)
     class(mci_vamp2_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacify
     logical, intent(in), optional :: md5sum_version
     integer :: u, i
     u = given_output_unit (unit)
     write (u, "(1X,A)") "VAMP2 integrator:"
     call object%base_write (u, pacify, md5sum_version)
     write (u, "(1X,A)") "Grid config:"
     call object%config%write (u)
     write (u, "(3X,A,L1)") "Integrator defined   = ", object%integrator_defined
     write (u, "(3X,A,L1)") "Integrator from file = ", object%integrator_from_file
     write (u, "(3X,A,L1)") "Adapt grids          = ", object%adapt_grids
     write (u, "(3X,A,L1)") "Adapt weights        = ", object%adapt_weights
     write (u, "(3X,A,I0)") "No. of adapt grids   = ", object%n_adapt_grids
     write (u, "(3X,A,I0)") "No. of adapt weights = ", object%n_adapt_weights
     write (u, "(3X,A,L1)") "Verbose              = ", object%verbose
     if (object%config%equivalences) then
        call object%equivalences%write (u)
     end if
     call object%list_pass%write (u, pacify)
     if (object%md5sum_adapted /= "") then
        write (u, "(1X,A,A,A)")  "MD5 sum (including results) = '", &
             & object%md5sum_adapted, "'"
     end if
   end subroutine mci_vamp2_write
 
 @ %def mci_vamp2_write
 @ Compute the (adapted) MD5 sum, including the configuration MD5 sum and the
 printout, which incorporates the current results.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: compute_md5sum => mci_vamp2_compute_md5sum
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_compute_md5sum (mci, pacify)
     class(mci_vamp2_t), intent(inout) :: mci
     logical, intent(in), optional :: pacify
     integer :: u
     mci%md5sum_adapted = ""
     u = free_unit ()
     open (u, status = "scratch", action = "readwrite")
     write (u, "(A)")  mci%md5sum
     call mci%write (u, pacify, md5sum_version = .true.)
     rewind (u)
     mci%md5sum_adapted = md5sum (u)
     close (u)
   end subroutine mci_vamp2_compute_md5sum
 
 @ %def mci_vamp2_compute_md5sum
 @ Return the MD5 sum: If available, return the adapted one.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: get_md5sum => mci_vamp2_get_md5sum
 <<MCI vamp2: procedures>>=
   pure function mci_vamp2_get_md5sum (mci) result (md5sum)
     class(mci_vamp2_t), intent(in) :: mci
     character(32) :: md5sum
     if (mci%md5sum_adapted /= "") then
        md5sum = mci%md5sum_adapted
     else
        md5sum = mci%md5sum
     end if
   end function mci_vamp2_get_md5sum
 
 @ %def mci_vamp_get_md5sum
 @ Startup message: short version. Make a call to the base function and print
 additional information about the multi-channel parameters.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: startup_message => mci_vamp2_startup_message
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_startup_message (mci, unit, n_calls)
     class(mci_vamp2_t), intent(in) :: mci
     integer, intent(in), optional :: unit, n_calls
     integer :: num_calls, n_bins
     num_calls = 0; if (present (n_calls)) num_calls = n_calls
     n_bins = mci%config%n_bins_max
     call mci%base_startup_message (unit = unit, n_calls = n_calls)
     if (mci%config%equivalences) then
        write (msg_buffer, "(A)") &
             "Integrator: Using VAMP2 channel equivalences"
        call msg_message (unit = unit)
     end if
     write (msg_buffer, "(A,2(1x,I0,1x,A),L1)") &
          "Integrator:", num_calls, &
          "initial calls,", n_bins, &
          "max. bins, stratified = ", &
          mci%config%stratified
     call msg_message (unit = unit)
     write (msg_buffer, "(A,2(1x,I0,1x,A))") &
          "Integrator: VAMP2"
     call msg_message (unit = unit)
   end subroutine mci_vamp2_startup_message
 
 @ %def mci_vamp2_startup_message
 @ Log entry: just headline.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: write_log_entry => mci_vamp2_write_log_entry
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_write_log_entry (mci, u)
     class(mci_vamp2_t), intent(in) :: mci
     integer, intent(in) :: u
     write (u, "(1x,A)")  "MC Integrator is VAMP2"
     call write_separator (u)
     if (mci%config%equivalences) then
        call mci%equivalences%write (u)
     else
        write (u, "(3x,A)") "No channel equivalences have been used."
     end if
     call write_separator (u)
     call mci%write_chain_weights (u)
   end subroutine mci_vamp2_write_log_entry
 
 @ %def mci_vamp2_write_log_entry
 @ Set the MCI index (necessary for processes with multiple components). We
 append the index to the grid filename, just before the final dotted suffix.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: record_index => mci_vamp2_record_index
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_record_index (mci, i_mci)
     class(mci_vamp2_t), intent(inout) :: mci
     integer, intent(in) :: i_mci
     type(string_t) :: basename, suffix
     character(32) :: buffer
     if (mci%integrator_filename_set) then
        basename = mci%integrator_filename
        call split (basename, suffix, ".", back=.true.)
        write (buffer, "(I0)") i_mci
        if (basename /= "") then
           mci%integrator_filename = basename // ".m" // trim (buffer) // "." // suffix
        else
           mci%integrator_filename = suffix // ".m" // trim (buffer) // ".vg2"
        end if
     end if
   end subroutine mci_vamp2_record_index
 
 @ %def mci_vamp2_record_index
 @ Set the configuration object.
 We adjust the maximum number of bins [[n_bins_max]] according to [[n_calls]]
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: set_config => mci_vamp2_set_config
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_set_config (mci, config)
     class(mci_vamp2_t), intent(inout) :: mci
     type(mci_vamp2_config_t), intent(in) :: config
     mci%config = config
   end subroutine mci_vamp2_set_config
 
 @ %def mci_vamp2_set_config
 @ Set the the rebuild flag, also the for checking the grid.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: set_rebuild_flag => mci_vamp2_set_rebuild_flag
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_set_rebuild_flag (mci, rebuild, check_grid_file)
     class(mci_vamp2_t), intent(inout) :: mci
     logical, intent(in) :: rebuild
     logical, intent(in) :: check_grid_file
     mci%rebuild = rebuild
     mci%check_grid_file = check_grid_file
   end subroutine mci_vamp2_set_rebuild_flag
 
 @ %def mci_vegaa_set_rebuild_flag
 @ Set the filename.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: set_integrator_filename => mci_vamp2_set_integrator_filename
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_set_integrator_filename (mci, name, run_id)
     class(mci_vamp2_t), intent(inout) :: mci
     type(string_t), intent(in) :: name
     type(string_t), intent(in), optional :: run_id
     mci%integrator_filename = name // ".vg2"
     if (present (run_id)) then
        mci%integrator_filename = name // "." // run_id // ".vg2"
     end if
     mci%integrator_filename_set = .true.
   end subroutine mci_vamp2_set_integrator_filename
 
 @ %def mci_vamp2_set_integrator_filename
 @ To simplify the interface, we prepend a grid path in a separate subroutine.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure :: prepend_integrator_path => mci_vamp2_prepend_integrator_path
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_prepend_integrator_path (mci, prefix)
     class(mci_vamp2_t), intent(inout) :: mci
     type(string_t), intent(in) :: prefix
     if (.not. mci%integrator_filename_set) then
        call msg_warning ("Cannot add prefix to invalid integrator filename!")
     end if
     mci%integrator_filename = prefix // "/" // mci%integrator_filename
   end subroutine mci_vamp2_prepend_integrator_path
 
 @ %def mci_vamp2_prepend_integrator_path
 @ TODO: Not implemented.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: declare_flat_dimensions => mci_vamp2_declare_flat_dimensions
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_declare_flat_dimensions (mci, dim_flat)
     class(mci_vamp2_t), intent(inout) :: mci
     integer, dimension(:), intent(in) :: dim_flat
   end subroutine mci_vamp2_declare_flat_dimensions
 
 @ %def mci_vamp2_declare_flat_dimensions
 @ TODO: Not implemented.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: declare_equivalences => mci_vamp2_declare_equivalences
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_declare_equivalences (mci, channel, dim_offset)
     class(mci_vamp2_t), intent(inout) :: mci
     type(phs_channel_t), dimension(:), intent(in) :: channel
     integer, intent(in) :: dim_offset
     integer, dimension(:), allocatable :: perm, mode
     integer :: n_channels, n_dim, n_equivalences
     integer :: c, i, j, dest, src
     n_channels = mci%n_channel
     n_dim = mci%n_dim
     n_equivalences = 0
     do c = 1, n_channels
        n_equivalences = n_equivalences + size (channel(c)%eq)
     end do
     mci%equivalences = vamp2_equivalences_t (&
          n_eqv = n_equivalences, n_channel = n_channels, n_dim = n_dim)
     allocate (perm (n_dim))
     allocate (mode (n_dim))
     perm(1:dim_offset) = [(i, i = 1, dim_offset)]
     mode(1:dim_offset) = 0
     c = 1
     j = 0
     do i = 1, n_equivalences
        if (j < size (channel(c)%eq)) then
           j = j + 1
        else
           c = c + 1
           j = 1
        end if
        associate (eq => channel(c)%eq(j))
          dest = c
          src = eq%c
          perm(dim_offset+1:) = eq%perm + dim_offset
          mode(dim_offset+1:) = eq%mode
          call mci%equivalences%set_equivalence &
               (i, dest, src, perm, mode)
        end associate
     end do
     call mci%equivalences%freeze ()
   end subroutine mci_vamp2_declare_equivalences
 
 @ %def mci_vamp2_declare_quivalences
 @ Allocate instance with matching type.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: allocate_instance => mci_vamp2_allocate_instance
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_allocate_instance (mci, mci_instance)
     class(mci_vamp2_t), intent(in) :: mci
     class(mci_instance_t), intent(out), pointer :: mci_instance
     allocate (mci_vamp2_instance_t :: mci_instance)
   end subroutine mci_vamp2_allocate_instance
 
 @ %def mci_vamp2_allocate_instance
 @ Allocate a new integration pass. We can preset everything that does not depend
 on the number of iterations and calls. This is postponed to the integrate
 method.
 
 In the final pass, we do not check accuracy goal etc., since we can assume
 that the user wants to perform and average all iterations in this pass.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: add_pass => mci_vamp2_add_pass
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_add_pass (mci, adapt_grids, adapt_weights, final_pass)
     class(mci_vamp2_t), intent(inout) :: mci
     logical, intent(in), optional :: adapt_grids, adapt_weights, final_pass
     call mci%list_pass%add (adapt_grids, adapt_weights, final_pass)
   end subroutine mci_vamp2_add_pass
 
 @ %def mci_vamp2_add_pass
 @ Update the list of integration passes.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: update_from_ref => mci_vamp2_update_from_ref
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_update_from_ref (mci, mci_ref, success)
     class(mci_vamp2_t), intent(inout) :: mci
     class(mci_t), intent(in) :: mci_ref
     logical, intent(out) :: success
     select type (mci_ref)
     type is (mci_vamp2_t)
        call mci%list_pass%update_from_ref (mci_ref%list_pass, success)
        if (mci%list_pass%current%integral_defined) then
           mci%integral = mci%list_pass%current%get_integral ()
           mci%error = mci%list_pass%current%get_error ()
           mci%efficiency = mci%list_pass%current%get_efficiency ()
           mci%integral_known = .true.
           mci%error_known = .true.
           mci%efficiency_known = .true.
        end if
     end select
   end subroutine mci_vamp2_update_from_ref
 
 @ %def mci_vamp2_update_from_ref
 @ Update the MCI record (i.e., the integration passes) by reading from input
 stream. The stream should contain a write output from a previous run. We first
 check the MD5 sum of the configuration parameters. If that matches, we proceed
 directly to the stored integration passes. If successful, we may continue to
 read the file; the position will be after a blank line that must follow the MCI
 record.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: update => mci_vamp2_update
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_update (mci, u, success)
     class(mci_vamp2_t), intent(inout) :: mci
     integer, intent(in) :: u
     logical, intent(out) :: success
     character(80) :: buffer
     character(32) :: md5sum_file
     type(mci_vamp2_t) :: mci_file
     integer :: n_pass, n_it
     call read_sval (u, md5sum_file)
     success = .true.; if (mci%check_grid_file) &
        & success = (md5sum_file == mci%md5sum)
     if (success) then
        read (u, *)
        read (u, "(A)") buffer
        if (trim (adjustl (buffer)) /= "VAMP2 integrator:") then
           call msg_fatal ("VAMP2: reading grid file: corrupted data")
        end if
        n_pass = 0
        n_it = 0
        do
           read (u, "(A)") buffer
           select case (trim (adjustl (buffer)))
           case ("")
              exit
           case ("Integration pass:")
              call mci_file%list_pass%add ()
              call mci_file%list_pass%current%read (u, n_pass, n_it)
              n_pass = n_pass + 1
              n_it = n_it + mci_file%list_pass%current%n_it
           end select
        end do
        call mci%update_from_ref (mci_file, success)
        call mci_file%final ()
     end if
   end subroutine mci_vamp2_update
 
 @ %def mci_vamp2_update
 @ Read / write grids from / to file.
 
 We split the reading process in two parts. First, we check on the header where
 we check (and update) all relevant pass data using [[mci_vamp2_update]]. In the
 second part we only read the integrator data. We implement [[mci_vamp2_read]]
 for completeness.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure :: write_grids => mci_vamp2_write_grids
   procedure :: read_header => mci_vamp2_read_header
   procedure :: read_data => mci_vamp2_read_data
   procedure :: read_grids => mci_vamp2_read_grids
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_write_grids (mci)
     class(mci_vamp2_t), intent(in) :: mci
     integer :: u
     if (.not. mci%integrator_filename_set) then
        call msg_bug ("VAMP2: write grids: filename undefined")
     end if
     if (.not. mci%integrator_defined) then
        call msg_bug ("VAMP2: write grids: grids undefined")
     end if
     u = free_unit ()
     open (u, file = char (mci%integrator_filename), &
          action = "write", status = "replace")
     write (u, "(1X,A,A,A)") "MD5sum = '", mci%md5sum, "'"
     write (u, *)
     call mci%write (u)
     write (u, *)
     write (u, "(1X,A)") "VAMP2 grids:"
     call mci%integrator%write_grids (u)
     close (u)
   end subroutine mci_vamp2_write_grids
 
   subroutine mci_vamp2_read_header (mci, success)
     class(mci_vamp2_t), intent(inout) :: mci
     logical, intent(out) :: success
     logical :: exist
     integer :: u
     success = .false.
     if (.not. mci%integrator_filename_set) then
        call msg_bug ("VAMP2: read grids: filename undefined")
     end if
     inquire (file = char (mci%integrator_filename), exist = exist)
     if (exist) then
        u = free_unit ()
        open (u, file = char (mci%integrator_filename), &
             action = "read", status = "old")
        call mci%update (u, success)
        close (u)
        if (.not. success) then
           write (msg_buffer, "(A,A,A)") &
                "VAMP2: header: parameter mismatch, discarding grid file '", &
                char (mci%integrator_filename), "'"
           call msg_message ()
        end if
     end if
   end subroutine mci_vamp2_read_header
 
   subroutine mci_vamp2_read_data (mci)
     class(mci_vamp2_t), intent(inout) :: mci
     integer :: u
     character(80) :: buffer
     if (mci%integrator_defined) then
        call msg_bug ("VAMP2: read grids: grids already defined")
     end if
     u = free_unit ()
     open (u, file = char (mci%integrator_filename), &
          action = "read", status = "old")
     do
        read (u, "(A)")  buffer
        if (trim (adjustl (buffer)) == "VAMP2 grids:")  exit
     end do
     call mci%integrator%read_grids (u)
     close (u)
     mci%integrator_defined = .true.
   end subroutine mci_vamp2_read_data
 
   subroutine mci_vamp2_read_grids (mci, success)
     class(mci_vamp2_t), intent(inout) :: mci
     logical, intent(out) :: success
     logical :: exist
     integer :: u
     character(80) :: buffer
     success = .false.
     if (.not. mci%integrator_filename_set) then
        call msg_bug ("VAMP2: read grids: filename undefined")
     end if
     if (mci%integrator_defined) then
        call msg_bug ("VAMP2: read grids: grids already defined")
     end if
     inquire (file = char (mci%integrator_filename), exist = exist)
     if (exist) then
        u = free_unit ()
        open (u, file = char (mci%integrator_filename), &
             action = "read", status = "old")
        call mci%update (u, success)
        if (success) then
           read (u, "(A)")  buffer
           if (trim (adjustl (buffer)) /= "VAMP2 grids:") then
              call msg_fatal ("VAMP2: reading grid file: &
                   &corrupted grid data")
           end if
           call mci%integrator%read_grids (u)
        else
           write (msg_buffer, "(A,A,A)") &
                "VAMP2: read grids: parameter mismatch, discarding grid file '", &
                char (mci%integrator_filename), "'"
           call msg_message ()
        end if
        close (u)
        mci%integrator_defined = success
     end if
   end subroutine mci_vamp2_read_grids
 @ %def mci_vamp2_write_grids
 @ %def mci_vamp2_read_header
 @ %def mci_vamp2_read_data
 @ %def mci_vamp2_read_grids
 @
 \subsubsection{Interface: VAMP2}
 \label{sec:interface-vamp2}
 
 We define the interfacing procedures, as such, initialising the VAMP2 integrator
 or resetting the results.
 
 Initialise the VAMP2 integrator which is stored within the [[mci]] object, using
 the data of the current integration pass. Furthermore, reset the counters that
 track this set of integrator.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: init_integrator => mci_vamp2_init_integrator
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_init_integrator (mci)
     class(mci_vamp2_t), intent(inout) :: mci
     type (pass_t), pointer :: current
     integer :: ch, vegas_mode
     current => mci%list_pass%current
     vegas_mode = merge (VEGAS_MODE_IMPORTANCE, VEGAS_MODE_IMPORTANCE_ONLY,&
          & mci%config%stratified)
     mci%n_adapt_grids = 0
     mci%n_adapt_weights = 0
     if (mci%integrator_defined) then
        call msg_bug ("[MCI VAMP2]: init integrator: &
             & integrator is already initialised.")
     end if
     mci%integrator = vamp2_t (mci%n_channel, mci%n_dim, &
          & n_bins_max = mci%config%n_bins_max, &
          & iterations = 1, &
          & mode = vegas_mode)
     if (mci%has_chains ()) call mci%integrator%set_chain (mci%n_chain, mci%chain)
     call mci%integrator%set_config (mci%config)
     mci%integrator_defined = .true.
   end subroutine mci_vamp2_init_integrator
 
 @ %def mci_vamp2_init_integrator
 @ Reset a grid set. Purge the accumulated results.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: reset_result => mci_vamp2_reset_result
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_reset_result (mci)
     class(mci_vamp2_t), intent(inout) :: mci
     if (.not. mci%integrator_defined) then
        call msg_bug ("[MCI VAMP2] reset results: integrator undefined")
     end if
     call mci%integrator%reset_result ()
   end subroutine mci_vamp2_reset_result
 
 @ %def mci_vamp2_reset_result
 @ Set calls per channel. The number of calls to each channel is defined by the
 channel weight
 \begin{equation}
   \alpha_i = \frac{N_i}{\sum N_i}.
 \end{equation}
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: set_calls => mci_vamp2_set_calls
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_set_calls (mci, n_calls)
     class(mci_vamp2_t), intent(inout) :: mci
     integer :: n_calls
     if (.not. mci%integrator_defined) then
        call msg_bug ("[MCI VAMP2] set calls: grids undefined")
     end if
     call mci%integrator%set_calls (n_calls)
   end subroutine mci_vamp2_set_calls
 
 @ %def mci_vamp2_set_calls
 \subsubsection{Integration}
 
 Initialize. We prepare the integrator from a previous pass, or from file, or
 with new objects.
 
 At the emd, set the number of calls for the current, if the integrator is not
 read from file.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, private :: init_integration => mci_vamp2_init_integration
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_init_integration (mci, n_it, n_calls, instance)
     class(mci_vamp2_t), intent(inout) :: mci
     integer, intent(in) :: n_it
     integer, intent(in) :: n_calls
     class(mci_instance_t), intent(inout) :: instance
     logical :: from_file, success
     if (.not. associated (mci%list_pass%current)) then
        call msg_bug ("MCI integrate: current_pass object not allocated")
     end if
     associate (current_pass => mci%list_pass%current)
       current_pass%integral_defined = .false.
       mci%config%n_calls_min = mci%config%n_calls_min_per_channel * mci%config%n_channel
       call current_pass%configure (n_it, n_calls, mci%config%n_calls_min)
       mci%adapt_grids = current_pass%adapt_grids
       mci%adapt_weights = current_pass%adapt_weights
       mci%pass_complete = .false.
       mci%it_complete = .false.
       from_file = .false.
       if (.not. mci%integrator_defined .or. mci%integrator_from_file) then
          if (mci%integrator_filename_set .and. .not. mci%rebuild) then
             call mci%read_header (success)
             from_file = success
             if (.not. mci%integrator_defined .and. success) &
                  & call mci%read_data ()
          end if
       end if
       if (from_file) then
          if (.not. mci%check_grid_file) &
               & call msg_warning ("Reading grid file: MD5 sum check disabled")
          call msg_message ("VAMP2: " &
               // "using grids and results from file ’" &
               // char (mci%integrator_filename) // "’")
       else if (.not. mci%integrator_defined) then
          call mci%init_integrator ()
       end if
       mci%integrator_from_file = from_file
       if (.not. mci%integrator_from_file) then
          call mci%integrator%set_calls (current_pass%n_calls)
       end if
       call mci%integrator%set_equivalences (mci%equivalences)
     end associate
   end subroutine mci_vamp2_init_integration
 
 @ %def mci_vamp2_init
 @ Integrate. Perform a new integration pass (possibly reusing previous results),
 which may consist of several iterations.
 We reinitialise the sampling new each time and set the workspace again.
 Note: we record the integral once per iteration. The integral stored in the
 mci record itself is the last integral of the current iteration, no averaging done.
 The results record may average results.
 Note: recording the efficiency is not supported yet.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: integrate => mci_vamp2_integrate
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_integrate (mci, instance, sampler, &
        n_it, n_calls, results, pacify)
     class(mci_vamp2_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     integer, intent(in) :: n_it
     integer, intent(in) :: n_calls
     class(mci_results_t), intent(inout), optional :: results
     logical, intent(in), optional :: pacify
     integer :: it
     logical :: from_file, success
   <<MCI vamp2: mci vamp2 integrate: variables>>
   <<MCI vamp2: mci vamp2 integrate: initialization>>
     call mci%init_integration (n_it, n_calls, instance)
     from_file = mci%integrator_from_file
     select type (instance)
     type is (mci_vamp2_instance_t)
        call instance%set_workspace (sampler)
     end select
     associate (current_pass => mci%list_pass%current)
       do it = 1, current_pass%n_it
          if (signal_is_pending ()) return
          mci%integrator_from_file = from_file .and. &
               it <= current_pass%get_integration_index ()
          if (.not. mci%integrator_from_file) then
             mci%it_complete = .false.
             select type (instance)
             type is (mci_vamp2_instance_t)
                call mci%integrator%integrate (instance%func, mci%rng, &
                     & iterations = 1, &
                     & opt_reset_result = .true., &
                     & opt_refine_grid = mci%adapt_grids, &
                     & opt_adapt_weight = mci%adapt_weights, &
                     & opt_verbose = mci%verbose)
             end select
             if (signal_is_pending ()) return
             mci%it_complete = .true.
             integral = mci%integrator%get_integral ()
             calls = mci%integrator%get_n_calls ()
             select type (instance)
             type is (mci_vamp2_instance_t)
                calls_valid = instance%func%get_n_calls ()
                call instance%func%reset_n_calls ()
             end select
             error = sqrt (mci%integrator%get_variance ())
             efficiency = mci%integrator%get_efficiency ()
           <<MCI vamp2: mci vamp2 integrate: sampling>>
             if (integral /= 0) then
                current_pass%integral(it) = integral
                current_pass%calls(it) = calls
                current_pass%calls_valid(it) = calls_valid
                current_pass%error(it) = error
                current_pass%efficiency(it) = efficiency
             end if
             current_pass%integral_defined = .true.
          end if
          if (present (results)) then
             if (mci%has_chains ()) then
                call mci%collect_chain_weights (instance%w)
                call results%record (1, &
                     n_calls = current_pass%calls(it), &
                     n_calls_valid = current_pass%calls_valid(it), &
                     integral = current_pass%integral(it), &
                     error = current_pass%error(it), &
                     efficiency = current_pass%efficiency(it), &
                     efficiency_pos = current_pass%efficiency(it), &
                     efficiency_neg = 0._default, &
                     chain_weights = mci%chain_weights, &
                     suppress = pacify)
             else
                call results%record (1, &
                     n_calls = current_pass%calls(it), &
                     n_calls_valid = current_pass%calls_valid(it), &
                     integral = current_pass%integral(it), &
                     error = current_pass%error(it), &
                     efficiency = current_pass%efficiency(it), &
                     efficiency_pos = current_pass%efficiency(it), &
                     efficiency_neg = 0._default, &
                     suppress = pacify)
             end if
          end if
          if (.not. mci%integrator_from_file &
               .and. mci%integrator_filename_set) then
             <<MCI vamp2: mci vamp2 integrate: post sampling>> call mci%write_grids ()
          end if
          if (.not. current_pass%is_final_pass) then
             call check_goals (it, success)
             if (success) exit
          end if
       end do
       if (signal_is_pending ()) return
       mci%pass_complete = .true.
       mci%integral = current_pass%get_integral()
       mci%error = current_pass%get_error()
       mci%efficiency = current_pass%get_efficiency()
       mci%integral_known = .true.
       mci%error_known = .true.
       mci%efficiency_known = .true.
       call mci%compute_md5sum (pacify)
     end associate
   contains
     <<MCI vamp2: mci vamp2 integrate: procedures>>
   end subroutine mci_vamp2_integrate
 
 @ %def mci_vamp2_integrate
 <<MCI vamp2: mci vamp2 integrate: variables>>=
   real(default) :: integral, error, efficiency
   integer :: calls, calls_valid
 @
 <<MCI vamp2: mci vamp2 integrate: initialization>>=
 @
 <<MCI vamp2: mci vamp2 integrate: sampling>>=
 @
 <<MCI vamp2: mci vamp2 integrate: post sampling>>=
 @
 <<MPI: MCI vamp2: mci vamp2 integrate: variables>>=
   integer :: rank, n_size
   type(MPI_Request), dimension(6) :: request
 @ MPI procedure-specific initialization.
 <<MPI: MCI vamp2: mci vamp2 integrate: initialization>>=
   call MPI_Comm_size (MPI_COMM_WORLD, n_size)
   call MPI_Comm_rank (MPI_COMM_WORLD, rank)
 @ We broadcast the current results to all worker, such that they can store them
 in to the pass list.
 <<MPI: MCI vamp2: mci vamp2 integrate: sampling>>=
   call MPI_Ibcast (integral, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, request(1))
   call MPI_Ibcast (calls, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, request(2))
   call MPI_Ibcast (calls_valid, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, request(3))
   call MPI_Ibcast (error, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, request(4))
   call MPI_Ibcast (efficiency, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, request(5))
   call MPI_Waitall (5, request, MPI_STATUSES_IGNORE)
 @ We only allow the master to write the grids to file.
 <<MPI: MCI vamp2: mci vamp2 integrate: post sampling>>=
   if (rank == 0)
 @ Check whether we are already finished with this pass.
 <<MCI vamp2: mci vamp2 integrate: procedures>>=
   subroutine check_goals (it, success)
     integer, intent(in) :: it
     logical, intent(out) :: success
     success = .false.
     associate (current_pass => mci%list_pass%current)
       if (error_reached (it)) then
          current_pass%n_it = it
          call msg_message ("[MCI VAMP2] error goal reached; &
               &skipping iterations")
          success = .true.
          return
       end if
       if (rel_error_reached (it)) then
          current_pass%n_it = it
          call msg_message ("[MCI VAMP2] relative error goal reached; &
               &skipping iterations")
          success = .true.
          return
       end if
       if (accuracy_reached (it)) then
          current_pass%n_it = it
          call msg_message ("[MCI VAMP2] accuracy goal reached; &
               &skipping iterations")
          success = .true.
          return
       end if
     end associate
   end subroutine check_goals
 
 @ %def mci_vamp2_check_goals
 @ Return true if the error, relative error or accurary goals hase been reached,
 if any.
 <<MCI vamp2: mci vamp2 integrate: procedures>>=
   function error_reached (it) result (flag)
     integer, intent(in) :: it
     logical :: flag
     real(default) :: error_goal, error
     error_goal = mci%config%error_goal
     flag = .false.
     associate (current_pass => mci%list_pass%current)
       if (error_goal > 0 .and. current_pass%integral_defined) then
          error = abs (current_pass%error(it))
          flag = error < error_goal
       end if
     end associate
   end function error_reached
 
   function rel_error_reached (it) result (flag)
     integer, intent(in) :: it
     logical :: flag
     real(default) :: rel_error_goal, rel_error
     rel_error_goal = mci%config%rel_error_goal
     flag = .false.
     associate (current_pass => mci%list_pass%current)
       if (rel_error_goal > 0 .and. current_pass%integral_defined) then
          rel_error = abs (current_pass%error(it) / current_pass%integral(it))
          flag = rel_error < rel_error_goal
       end if
     end associate
   end function rel_error_reached
 
   function accuracy_reached (it) result (flag)
     integer, intent(in) :: it
     logical :: flag
     real(default) :: accuracy_goal, accuracy
     accuracy_goal = mci%config%accuracy_goal
     flag = .false.
     associate (current_pass => mci%list_pass%current)
       if (accuracy_goal > 0 .and. current_pass%integral_defined) then
          if (current_pass%integral(it) /= 0) then
             accuracy = abs (current_pass%error(it) / current_pass%integral(it)) &
                  * sqrt (real (current_pass%calls(it), default))
             flag = accuracy < accuracy_goal
          else
             flag = .true.
          end if
       end if
     end associate
   end function accuracy_reached
 
 @ %def error_reached, rel_error_reached, accuracy_reached
 @
 \subsection{Event generation}
 
 Prepare simulation. We check the grids and reread them from file, if necessary.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: prepare_simulation => mci_vamp2_prepare_simulation
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_prepare_simulation (mci)
     class(mci_vamp2_t), intent(inout) :: mci
     logical :: success
     if (.not. mci%integrator_filename_set) then
        call msg_bug ("VAMP2: preapre simulation: integrator filename not set.")
     end if
     call mci%read_header (success)
     call mci%compute_md5sum ()
     if (.not. success) then
        call msg_fatal ("Simulate: " &
             // "reading integration grids from file ’" &
             // char (mci%integrator_filename) // "’ failed")
     end if
     if (.not. mci%integrator_defined) then
        call mci%read_data ()
     end if
   end subroutine mci_vamp2_prepare_simulation
 
 @ %def mci_vamp2_prepare_simulation
 @ Generate an unweighted event. We only set the workspace again before
 generating an event.
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: generate_weighted_event => mci_vamp2_generate_weighted_event
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_generate_weighted_event (mci, instance, sampler)
     class(mci_vamp2_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     if (.not. mci%integrator_defined) then
        call msg_bug ("VAMP2: generate weighted event: undefined integrator")
     end if
     select type (instance)
     type is (mci_vamp2_instance_t)
        instance%event_generated = .false.
        call instance%set_workspace (sampler)
        call mci%integrator%generate_weighted (&
             & instance%func, mci%rng, instance%event_x)
        instance%event_weight = mci%integrator%get_evt_weight ()
        instance%event_excess = 0
        instance%n_events = instance%n_events + 1
        instance%event_generated = .true.
     end select
   end subroutine mci_vamp2_generate_weighted_event
 
 @ %def mci_vamp2_generate_weighted_event
 @ We apply an additional rescaling factor for [[f_max]] (either for the positive or negative distribution).
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: generate_unweighted_event => mci_vamp2_generate_unweighted_event
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_generate_unweighted_event (mci, instance, sampler)
     class(mci_vamp2_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     if (.not. mci%integrator_defined) then
        call msg_bug ("VAMP2: generate unweighted event: undefined integrator")
     end if
     select type (instance)
     type is (mci_vamp2_instance_t)
        instance%event_generated = .false.
        call instance%set_workspace (sampler)
        generate: do
           call mci%integrator%generate_unweighted (&
                & instance%func, mci%rng, instance%event_x, &
                & opt_event_rescale = instance%event_rescale_f_max)
           instance%event_excess = mci%integrator%get_evt_weight_excess ()
           if (signal_is_pending ()) return
           if (sampler%is_valid ()) exit generate
        end do generate
        if (mci%integrator%get_evt_weight () < 0.) then
           if (.not. mci%negative_weights) then
              call msg_fatal ("MCI VAMP2 cannot sample negative weights!")
           end if
           instance%event_weight = -1._default
        else
           instance%event_weight = 1._default
        end if
        instance%n_events = instance%n_events + 1
        instance%event_generated = .true.
     end select
   end subroutine mci_vamp2_generate_unweighted_event
 
 @ %def mci_vamp2_generate_unweighted_event
 @
 <<MCI vamp2: mci vamp2: TBP>>=
   procedure, public :: rebuild_event => mci_vamp2_rebuild_event
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_rebuild_event (mci, instance, sampler, state)
     class(mci_vamp2_t), intent(inout) :: mci
     class(mci_instance_t), intent(inout) :: instance
     class(mci_sampler_t), intent(inout) :: sampler
     class(mci_state_t), intent(in) :: state
     call msg_bug ("MCI VAMP2 rebuild event not implemented yet.")
   end subroutine mci_vamp2_rebuild_event
 
 @ %def mci_vamp2_rebuild_event
 @
 \subsection{Integrator instance}
 \label{sec:nistance}
 
 We store all information relevant for simulation. The event weight is stored, when a
 weighted event is generated, and the event excess, when a larger weight occurs
 than actual stored max. weight.
 
 We give the possibility to rescale the [[f_max]] within the integrator object
 with [[event_rescale_f_max]].
 <<MCI vamp2: public>>=
   public :: mci_vamp2_instance_t
 <<MCI vamp2: types>>=
   type, extends (mci_instance_t) :: mci_vamp2_instance_t
      class(mci_vamp2_func_t), allocatable :: func
      real(default), dimension(:), allocatable :: gi
      integer :: n_events = 0
      logical :: event_generated = .false.
      real(default) :: event_weight = 0.
      real(default) :: event_excess = 0.
      real(default) :: event_rescale_f_max = 1.
      real(default), dimension(:), allocatable :: event_x
    contains
    <<MCI vamp2: mci vamp2 instance: TBP>>
   end type mci_vamp2_instance_t
 
 @ %def mci_vamp2_instance_t
 @ Output.
 <<MCI vamp2: mci vamp2 instance: TBP>>=
   procedure, public :: write => mci_vamp2_instance_write
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_instance_write (object, unit, pacify)
     class(mci_vamp2_instance_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: pacify
     integer :: u, ch, j
     character(len=7) :: fmt
     call pac_fmt (fmt, FMT_17, FMT_14, pacify)
     u = given_output_unit (unit)
     write (u, "(1X,A)") "MCI VAMP2 instance:"
     write (u, "(1X,A,I0)") &
          & "Selected channel        = ", object%selected_channel
     write (u, "(1X,A25,1X," // fmt // ")") &
          & "Integrand               = ", object%integrand
     write (u, "(1X,A25,1X," // fmt // ")") &
          & "MCI weight              = ", object%mci_weight
     write (u, "(1X,A,L1)") &
          & "Valid                   = ", object%valid
     write (u, "(1X,A)") "MCI a-priori weight:"
     do ch = 1, size (object%w)
        write (u, "(3X,I25,1X," // fmt // ")") ch, object%w(ch)
     end do
     write (u, "(1X,A)") "MCI jacobian:"
     do ch = 1, size (object%w)
        write (u, "(3X,I25,1X," // fmt // ")") ch, object%f(ch)
     end do
     write (u, "(1X,A)") "MCI mapped x:"
     do ch = 1, size (object%w)
        do j = 1, size (object%x, 1)
           write (u, "(3X,2(1X,I8),1X," // fmt // ")") j, ch, object%x(j, ch)
        end do
     end do
     write (u, "(1X,A)") "MCI channel weight:"
     do ch = 1, size (object%w)
        write (u, "(3X,I25,1X," // fmt // ")") ch, object%gi(ch)
     end do
     write (u, "(1X,A,I0)") &
          & "Number of event         = ", object%n_events
     write (u, "(1X,A,L1)") &
          & "Event generated         = ", object%event_generated
     write (u, "(1X,A25,1X," // fmt // ")") &
          & "Event weight            = ", object%event_weight
     write (u, "(1X,A25,1X," // fmt // ")") &
          & "Event excess            = ", object%event_excess
     write (u, "(1X,A25,1X," // fmt // ")") &
          & "Event rescale f max     = ", object%event_rescale_f_max
     write (u, "(1X,A,L1)") &
          & "Negative (event) weight = ", object%negative_weights
     write (u, "(1X,A)") "MCI event"
     do j = 1, size (object%event_x)
        write (u, "(3X,I25,1X," // fmt // ")") j, object%event_x(j)
     end do
   end subroutine mci_vamp2_instance_write
 
 @ %def mci_vamp2_instance_write
 @ Finalizer. We are only using allocatable, so there is nothing to do here.
 <<MCI vamp2: mci vamp2 instance: TBP>>=
   procedure, public :: final => mci_vamp2_instance_final
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_instance_final (object)
     class(mci_vamp2_instance_t), intent(inout) :: object
     !
   end subroutine mci_vamp2_instance_final
 
 @ %def mci_vamp2_instance_final
 @ Initializer.
 <<MCI vamp2: mci vamp2 instance: TBP>>=
   procedure, public :: init => mci_vamp2_instance_init
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_instance_init (mci_instance, mci)
     class(mci_vamp2_instance_t), intent(out) :: mci_instance
     class(mci_t), intent(in), target :: mci
     call mci_instance%base_init (mci)
     allocate (mci_instance%gi(mci%n_channel), source=0._default)
     allocate (mci_instance%event_x(mci%n_dim), source=0._default)
     allocate (mci_vamp2_func_t :: mci_instance%func)
     call mci_instance%func%init (n_dim = mci%n_dim, n_channel = mci%n_channel)
   end subroutine mci_vamp2_instance_init
 
 @ %def mci_vamp2_instance_init
 @ Set workspace for [[mci_vamp2_func_t]].
 <<MCI vamp2: mci vamp2 instance: TBP>>=
   procedure, public :: set_workspace => mci_vamp2_instance_set_workspace
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_instance_set_workspace (instance, sampler)
     class(mci_vamp2_instance_t), intent(inout), target :: instance
     class(mci_sampler_t), intent(inout), target :: sampler
     call instance%func%set_workspace (instance, sampler)
   end subroutine mci_vamp2_instance_set_workspace
 
 @ %def mci_vmp2_instance_set_workspace
 @
 \subsubsection{Evaluation}
 Compute multi-channel weight. The computation of the multi-channel weight is
 done by the VAMP2 function. We retrieve the information.
 <<MCI vamp2: mci vamp2 instance: TBP>>=
   procedure, public :: compute_weight => mci_vamp2_instance_compute_weight
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_instance_compute_weight (mci, c)
     class(mci_vamp2_instance_t), intent(inout) :: mci
     integer, intent(in) :: c
     mci%gi = mci%func%get_probabilities ()
     mci%mci_weight = mci%func%get_weight ()
   end subroutine mci_vamp2_instance_compute_weight
 
 @ %def mci_vamp2_instance_compute_weight
 @ Record the integrand.
 <<MCI vamp2: mci vamp2 instance: TBP>>=
   procedure, public :: record_integrand => mci_vamp2_instance_record_integrand
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_instance_record_integrand (mci, integrand)
     class(mci_vamp2_instance_t), intent(inout) :: mci
     real(default), intent(in) :: integrand
     mci%integrand = integrand
     call mci%func%set_integrand (integrand)
   end subroutine mci_vamp2_instance_record_integrand
 
 @ %def mci_vamp2_instance_record_integrand
 @ \subsubsection{Event simulation}
 In contrast to VAMP, we reset only counters
 and set the safety factor, which will then will be applied each time a event is
 generated. In that way we do not rescale the actual values in the integrator,
 but more the current value!
 <<MCI vamp2: mci vamp2 instance: TBP>>=
   procedure, public :: init_simulation => mci_vamp2_instance_init_simulation
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_instance_init_simulation (instance, safety_factor)
     class(mci_vamp2_instance_t), intent(inout) :: instance
     real(default), intent(in), optional :: safety_factor
     if (present (safety_factor)) instance%event_rescale_f_max = safety_factor
     instance%n_events = 0
     instance%event_generated = .false.
     if (instance%event_rescale_f_max /= 1) then
        write (msg_buffer, "(A,ES10.3,A)") "Simulate: &
             &applying safety factor ", instance%event_rescale_f_max, &
             & " to event rejection."
        call msg_message ()
     end if
   end subroutine mci_vamp2_instance_init_simulation
 
 @ %def mci_vamp2_instance_init_simulation
 @
 <<MCI vamp2: mci vamp2 instance: TBP>>=
   procedure, public :: final_simulation => mci_vamp2_instance_final_simulation
 <<MCI vamp2: procedures>>=
   subroutine mci_vamp2_instance_final_simulation (instance)
     class(mci_vamp2_instance_t), intent(inout) :: instance
     !
   end subroutine mci_vamp2_instance_final_simulation
 
 @ %def mci_vamp2_instance_final
 @
 <<MCI vamp2: mci vamp2 instance: TBP>>=
   procedure, public :: get_event_weight => mci_vamp2_instance_get_event_weight
 <<MCI vamp2: procedures>>=
   function mci_vamp2_instance_get_event_weight (mci) result (weight)
     class(mci_vamp2_instance_t), intent(in) :: mci
     real(default) :: weight
     if (.not. mci%event_generated) then
        call msg_bug ("MCI VAMP2: get event weight: no event generated")
     end if
     weight = mci%event_weight
   end function mci_vamp2_instance_get_event_weight
 
 @ %def mci_vamp2_instance_get_event_weight
 @
 <<MCI vamp2: mci vamp2 instance: TBP>>=
   procedure, public :: get_event_excess => mci_vamp2_instance_get_event_excess
 <<MCI vamp2: procedures>>=
   function mci_vamp2_instance_get_event_excess (mci) result (excess)
     class(mci_vamp2_instance_t), intent(in) :: mci
     real(default) :: excess
     if (.not. mci%event_generated) then
        call msg_bug ("MCI VAMP2: get event excess: no event generated")
     end if
     excess = mci%event_excess
   end function mci_vamp2_instance_get_event_excess
 
 @ %def mci_vamp2_instance_get_event_excess
 @
 \clearpage
 \subsection{Unit tests}
 \label{sec:mic-vamp2-ut}
 Test module, followed by the corresponding implementation module.
 <<[[mci_vamp2_ut.f90]]>>=
 <<File header>>
 
 module mci_vamp2_ut
   use unit_tests
   use mci_vamp2_uti
 
 <<Standard module head>>
 
 <<MCI vamp2: public test>>
 
 contains
 
 <<MCI vamp2: test driver>>
 
 end module mci_vamp2_ut
 @ %def mci_vamp2_ut
 @
 <<[[mci_vamp2_uti.f90]]>>=
 <<File header>>
 
 module mci_vamp2_uti
 
 <<Use kinds>>
 <<Use strings>>
 
   use io_units
   use constants, only: PI, TWOPI
   use rng_base
   use rng_tao
   use rng_stream
   use mci_base
 
   use mci_vamp2
 
 <<Standard module head>>
 
 <<MCI vamp2: test declarations>>
 
 <<MCI vamp2: test types>>
 
 contains
 
 <<MCI vamp2: tests>>
 
 end module mci_vamp2_uti
 @ %def mci_vamp2_uti
 @ API: driver for the unit tests below.
 <<MCI vamp2: public test>>=
   public :: mci_vamp2_test
 <<MCI vamp2: test driver>>=
   subroutine mci_vamp2_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<MCI vamp2: execute tests>>
   end subroutine mci_vamp2_test
 
 @ %def mci_vamp2_test
 @
 \subsubsection{Test sampler}
 \label{sec:mci-vamp2-test-sampler}
 
 A test sampler object should implement a function with known integral that
 we can use to check the integrator.
 
 In mode [[1]], the function is $f(x) = 3 x^2$ with integral $\int_0^1
 f(x)\,dx=1$ and maximum $f(1)=3$.  If the integration dimension is
 greater than one, the function is extended as a constant in the other
 dimension(s).
 
 In mode [[2]], the function is $11 x^{10}$, also with integral $1$.
 
 Mode [[4]] includes ranges of zero and negative function value, the
 integral is negative.  The results should be identical to the results
 of [[mci_midpoint_4]], where the same function is evaluated.  The
 function is $f(x) = (1 - 3 x^2)\,\theta(x-1/2)$ with integral
 $\int_0^1 f(x)\,dx=-3/8$, minimum $f(1)=-2$ and maximum $f(1/2)=1/4$.
 <<MCI vamp2: test types>>=
   type, extends (mci_sampler_t) :: test_sampler_1_t
      real(default), dimension(:), allocatable :: x
      real(default) :: val
      integer :: mode = 1
    contains
    <<MCI vamp2: test sampler 1: TBP>>
   end type test_sampler_1_t
 
 @ %def test_sampler_1_t
 @ Output: There is nothing stored inside, so just print an informative line.
 <<MCI vamp2: test sampler 1: TBP>>=
   procedure, public :: write => test_sampler_1_write
 <<MCI vamp2: tests>>=
   subroutine test_sampler_1_write (object, unit, testflag)
     class(test_sampler_1_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     select case (object%mode)
     case (1)
        write (u, "(1x,A)") "Test sampler: f(x) = 3 x^2"
     case (2)
        write (u, "(1x,A)") "Test sampler: f(x) = 11 x^10"
     case (3)
        write (u, "(1x,A)") "Test sampler: f(x) = 11 x^10 * 2 * cos^2 (2 pi y)"
     case (4)
        write (u, "(1x,A)") "Test sampler: f(x) = (1 - 3 x^2) theta(x - 1/2)"
     end select
   end subroutine test_sampler_1_write
 
 @ %def test_sampler_1_write
 @ Evaluation: compute the function value.  The output $x$ parameter
 (only one channel) is identical to the input $x$, and the Jacobian is 1.
 <<MCI vamp2: test sampler 1: TBP>>=
   procedure, public :: evaluate => test_sampler_1_evaluate
 <<MCI vamp2: tests>>=
   subroutine test_sampler_1_evaluate (sampler, c, x_in, val, x, f)
     class(test_sampler_1_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     if (allocated (sampler%x))  deallocate (sampler%x)
     allocate (sampler%x (size (x_in)))
     sampler%x = x_in
     select case (sampler%mode)
     case (1)
        sampler%val = 3 * x_in(1) ** 2
     case (2)
        sampler%val = 11 * x_in(1) ** 10
     case (3)
        sampler%val = 11 * x_in(1) ** 10 * 2 * cos (twopi * x_in(2)) ** 2
     case (4)
        if (x_in(1) >= .5_default) then
           sampler%val = 1 - 3 * x_in(1) ** 2
        else
           sampler%val = 0
        end if
     end select
     call sampler%fetch (val, x, f)
   end subroutine test_sampler_1_evaluate
 
 @ %def test_sampler_1_evaluate
 @ The point is always valid.
 <<MCI vamp2: test sampler 1: TBP>>=
   procedure, public :: is_valid => test_sampler_1_is_valid
 <<MCI vamp2: tests>>=
   function test_sampler_1_is_valid (sampler) result (valid)
     class(test_sampler_1_t), intent(in) :: sampler
     logical :: valid
     valid = .true.
   end function test_sampler_1_is_valid
 
 @ %def test_sampler_1_is_valid
 @ Rebuild: compute all but the function value.
 <<MCI vamp2: test sampler 1: TBP>>=
   procedure, public :: rebuild => test_sampler_1_rebuild
 <<MCI vamp2: tests>>=
   subroutine test_sampler_1_rebuild (sampler, c, x_in, val, x, f)
     class(test_sampler_1_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(in) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     if (allocated (sampler%x))  deallocate (sampler%x)
     allocate (sampler%x (size (x_in)))
     sampler%x = x_in
     sampler%val = val
     x(:,1) = sampler%x
     f = 1
   end subroutine test_sampler_1_rebuild
 
 @ %def test_sampler_1_rebuild
 @ Extract the results.
 <<MCI vamp2: test sampler 1: TBP>>=
   procedure, public :: fetch => test_sampler_1_fetch
 <<MCI vamp2: tests>>=
   subroutine test_sampler_1_fetch (sampler, val, x, f)
     class(test_sampler_1_t), intent(in) :: sampler
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     val = sampler%val
     x(:,1) = sampler%x
     f = 1
   end subroutine test_sampler_1_fetch
 
 @ %def test_sampler_1_fetch
 @
 \subsubsection{Two-channel, two dimension test sampler}
 This sampler implements the function
 \begin{equation}
   f(x, y) = 4\sin^2(\pi x)\sin^2(\pi y) + 2\sin^2(\pi v)
 \end{equation}
 where
 \begin{align}
   x &= u^v        &u &= xy
 \\
   y &= u^{(1-v)}  &v &= \frac12\left(1 + \frac{\log(x/y)}{\log xy}\right)
 \end{align}
 Each term contributes $1$ to the integral. The first term in the function is
 peaked along a cross aligned to the coordinates $x$ and $y$, while the second
 term is peaked along the diagonal $x=y$.
 
 The Jacobian is
 \begin{equation}
   \frac{\partial(x,y)}{\partial(u,v)} = |\log u|
 \end{equation}
 <<MCI vamp2: test types>>=
   type, extends (mci_sampler_t) :: test_sampler_2_t
      real(default), dimension(:,:), allocatable :: x
      real(default), dimension(:), allocatable :: f
      real(default) :: val
    contains
    <<MCI vamp2: test sampler 2: TBP>>
   end type test_sampler_2_t
 
 @ %def test_sampler_2_t
 @ Output: There is nothing stored inside, so just print an informative line.
 <<MCI vamp2: test sampler 2: TBP>>=
   procedure, public :: write => test_sampler_2_write
 <<MCI vamp2: tests>>=
   subroutine test_sampler_2_write (object, unit, testflag)
     class(test_sampler_2_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: testflag
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)") "Two-channel test sampler 2"
   end subroutine test_sampler_2_write
 
 @ %def test_sampler_2_write
 @ Kinematics: compute $x$ and Jacobians, given the input parameter array.
 <<MCI vamp2: test sampler 2: TBP>>=
   procedure, public :: compute => test_sampler_2_compute
 <<MCI vamp2: tests>>=
   subroutine test_sampler_2_compute (sampler, c, x_in)
     class(test_sampler_2_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default) :: xx, yy, uu, vv
     if (.not. allocated (sampler%x)) &
          allocate (sampler%x (size (x_in), 2))
     if (.not. allocated (sampler%f)) &
          allocate (sampler%f (2))
     select case (c)
     case (1)
        xx = x_in(1)
        yy = x_in(2)
        uu = xx * yy
        vv = (1 + log (xx/yy) / log (xx*yy)) / 2
     case (2)
        uu = x_in(1)
        vv = x_in(2)
        xx = uu ** vv
        yy = uu ** (1 - vv)
     end select
     sampler%val = (2 * sin (pi * xx) * sin (pi * yy)) ** 2 &
          + 2 * sin (pi * vv) ** 2
     sampler%f(1) = 1
     sampler%f(2) = abs (log (uu))
     sampler%x(:,1) = [xx, yy]
     sampler%x(:,2) = [uu, vv]
   end subroutine test_sampler_2_compute
 
 @ %def test_sampler_kinematics
 @ Evaluation: compute the function value. The output $x$ parameter (only one
 channel) is identical to the input $x$, and the Jacobian is 1.
 <<MCI vamp2: test sampler 2: TBP>>=
   procedure, public :: evaluate => test_sampler_2_evaluate
 <<MCI vamp2: tests>>=
   subroutine test_sampler_2_evaluate (sampler, c, x_in, val, x, f)
     class(test_sampler_2_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     call sampler%compute (c, x_in)
     call sampler%fetch (val, x, f)
   end subroutine test_sampler_2_evaluate
 
 @ %def test_sampler_2_evaluate
 @ The point is always valid.
 <<MCI vamp2: test sampler 2: TBP>>=
   procedure, public :: is_valid => test_sampler_2_is_valid
 <<MCI vamp2: tests>>=
   function test_sampler_2_is_valid (sampler) result (valid)
     class(test_sampler_2_t), intent(in) :: sampler
     logical :: valid
     valid = .true.
   end function test_sampler_2_is_valid
 
 @ %def test_sampler_2_is_valid
 @ Rebuild: compute all but the function value.
 <<MCI vamp2: test sampler 2: TBP>>=
   procedure, public :: rebuild => test_sampler_2_rebuild
 <<MCI vamp2: tests>>=
   subroutine test_sampler_2_rebuild (sampler, c, x_in, val, x, f)
     class(test_sampler_2_t), intent(inout) :: sampler
     integer, intent(in) :: c
     real(default), dimension(:), intent(in) :: x_in
     real(default), intent(in) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     call sampler%compute (c, x_in)
     x = sampler%x
     f = sampler%f
   end subroutine test_sampler_2_rebuild
 
 @ %def test_sampler_2_rebuild
 @ Extract the results.
 <<MCI vamp2: test sampler 2: TBP>>=
   procedure, public :: fetch => test_sampler_2_fetch
 <<MCI vamp2: tests>>=
   subroutine test_sampler_2_fetch (sampler, val, x, f)
     class(test_sampler_2_t), intent(in) :: sampler
     real(default), intent(out) :: val
     real(default), dimension(:,:), intent(out) :: x
     real(default), dimension(:), intent(out) :: f
     val = sampler%val
     x = sampler%x
     f = sampler%f
   end subroutine test_sampler_2_fetch
 
 @ %def test_sampler_2_fetch
 @
 \subsubsection{One-dimensional integration}
 \label{sec:mci-vamp2-one-dim}
 
 Construct an integrator and use it for a one-dimensional sampler.
 <<MCI vamp2: execute tests>>=
   call test (mci_vamp2_1, "mci_vamp2_1", "one-dimensional integral", u, results)
 <<MCI vamp2: test declarations>>=
   public :: mci_vamp2_1
 <<MCI vamp2: tests>>=
   subroutine mci_vamp2_1 (u)
     integer, intent(in) :: u
     type(mci_vamp2_config_t) :: config
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable, target :: mci_sampler
     class(rng_t), allocatable :: rng
     type(string_t) :: filename
 
     write (u, "(A)") "* Test output: mci_vamp2_1"
     write (u, "(A)") "*   Purpose: integrate function in one dimension (single channel)"
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise integrator"
     write (u, "(A)")
 
     allocate (mci_vamp2_t :: mci)
     call mci%set_dimensions (1, 1)
 
     filename = "mci_vamp2_1"
     select type (mci)
     type is (mci_vamp2_t)
        call mci%set_config (config)
        call mci%set_integrator_filename (filename)
     end select
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%write (u, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise instance"
     write (u, "(A)")
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     write (u, "(A)")
     write (u, "(A)") "* Initialise test sampler"
     write (u, "(A)")
 
     allocate (test_sampler_1_t :: mci_sampler)
     call mci_sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_calls = 1000"
     write (u, "(A)")  "   (lower precision to avoid"
     write (u, "(A)")  "      numerical noise)"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp2_t)
        call mci%add_pass ()
     end select
     call mci%integrate (mci_instance, mci_sampler, 1, 1000, pacify = .true.)
     call mci%write (u, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)") "* Dump channel weights and grids to file"
     write (u, "(A)")
 
     mci%md5sum = "1234567890abcdef1234567890abcdef"
     select type (mci)
     type is (mci_vamp2_t)
        call mci%write_grids ()
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp2_1"
 
   end subroutine mci_vamp2_1
 
 @ %def mci_vamp2_test1
 @
 \subsubsection{Multiple iterations}
 Construct an integrator and use it for a one-dimensional sampler.
 Integrate with five iterations without grid adaptation.
 <<MCI vamp2: execute tests>>=
   call test (mci_vamp2_2, "mci_vamp2_2", &
        "multiple iterations", &
        u, results)
 <<MCI vamp2: test declarations>>=
   public :: mci_vamp2_2
 <<MCI vamp2: tests>>=
   subroutine mci_vamp2_2 (u)
     type(mci_vamp2_config_t) :: config
     integer, intent(in) :: u
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
     type(string_t) :: filename
 
     write (u, "(A)")  "* Test output: mci_vamp2_2"
     write (u, "(A)")  "*   Purpose: integrate function in one dimension &
          &(single channel), but multiple iterations."
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp2_t :: mci)
     call mci%set_dimensions (1, 1)
     filename = "mci_vamp2_2"
     select type (mci)
     type is (mci_vamp2_t)
        call mci%set_config (config)
        call mci%set_integrator_filename (filename)
     end select
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_1_t :: sampler)
     select type (sampler)
     type is (test_sampler_1_t)
        sampler%mode = 2
     end select
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 100"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp2_t)
        call mci%add_pass (adapt_grids = .false.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000, pacify = .true.)
     call mci%write (u, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)") "* Dump channel weights and grids to file"
     write (u, "(A)")
 
     mci%md5sum = "1234567890abcdef1234567890abcdef"
     select type (mci)
     type is (mci_vamp2_t)
        call mci%write_grids ()
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp2_2"
 
   end subroutine mci_vamp2_2
 
 @ %def mci_vamp2_2
 @
 \subsubsection{Grid adaptation}
 Construct an integrator and use it for a one-dimensional sampler.
 Integrate with three iterations and in-between grid adaptations.
 <<MCI vamp2: execute tests>>=
   call test (mci_vamp2_3, "mci_vamp2_3", &
        "grid adaptation", &
        u, results)
 <<MCI vamp2: test declarations>>=
   public :: mci_vamp2_3
 <<MCI vamp2: tests>>=
   subroutine mci_vamp2_3 (u)
     integer, intent(in) :: u
     type(mci_vamp2_config_t) :: config
     class(mci_t), allocatable, target :: mci
     class(mci_instance_t), pointer :: mci_instance => null ()
     class(mci_sampler_t), allocatable :: sampler
     class(rng_t), allocatable :: rng
     type(string_t) :: filename
 
     write (u, "(A)")  "* Test output: mci_vamp2_3"
     write (u, "(A)")  "*   Purpose: integrate function in one dimension &
          &(single channel)"
     write (u, "(A)")  "*            and adapt grid"
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize integrator, sampler, instance"
     write (u, "(A)")
 
     allocate (mci_vamp2_t :: mci)
     call mci%set_dimensions (1, 1)
     filename = "mci_vamp2_3"
     select type (mci)
     type is (mci_vamp2_t)
        call mci%set_integrator_filename (filename)
        call mci%set_config (config)
     end select
 
     allocate (rng_stream_t :: rng)
     call rng%init ()
     call mci%import_rng (rng)
 
     call mci%allocate_instance (mci_instance)
     call mci_instance%init (mci)
 
     allocate (test_sampler_1_t :: sampler)
     select type (sampler)
     type is (test_sampler_1_t)
        sampler%mode = 2
     end select
     call sampler%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Integrate with n_it = 3 and n_calls = 100"
     write (u, "(A)")
 
     select type (mci)
     type is (mci_vamp2_t)
        call mci%add_pass (adapt_grids = .true.)
     end select
     call mci%integrate (mci_instance, sampler, 3, 1000, pacify = .true.)
     call mci%write (u, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Contents of mci_instance:"
     write (u, "(A)")
 
     call mci_instance%write (u, pacify = .true.)
 
     write (u, "(A)")
     write (u, "(A)") "* Dump channel weights and grids to file"
     write (u, "(A)")
 
     mci%md5sum = "1234567890abcdef1234567890abcdef"
     select type (mci)
     type is (mci_vamp2_t)
        call mci%write_grids ()
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
     write (u, "(A)")
 
     call mci_instance%final ()
     call mci%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: mci_vamp2_3"
 
   end subroutine mci_vamp2_3
 
 @ %def mci_vamp2_3
 @
 \section{Dispatch}
 @
 <<[[dispatch_mci.f90]]>>=
 <<File header>>
 
 module dispatch_mci
 
 <<Use strings>>
   use diagnostics
   use os_interface
   use variables
 
   use mci_base
   use mci_none
   use mci_midpoint
   use mci_vamp
   use mci_vamp2
 
 <<Standard module head>>
 
 <<Dispatch mci: public>>
 
 <<Dispatch mci: parameters>>
 
 contains
 
 <<Dispatch mci: procedures>>
 
 end module dispatch_mci
 @ %def dispatch_mci
 Allocate an integrator according to the variable [[$integration_method]].
 <<Dispatch mci: public>>=
   public :: dispatch_mci_s
 <<Dispatch mci: procedures>>=
   subroutine dispatch_mci_s (mci, var_list, process_id, is_nlo)
     class(mci_t), allocatable, intent(inout) :: mci
     logical, intent(in), optional :: is_nlo
     type(var_list_t), intent(in) :: var_list
     type(string_t), intent(in) :: process_id
     type(string_t) :: run_id
     type(string_t) :: integration_method
     type(grid_parameters_t) :: grid_par
     type(history_parameters_t) :: history_par
     type(mci_vamp2_config_t) :: mci_vamp2_config
     logical :: rebuild_grids, check_grid_file, negative_weights, verbose
     logical :: dispatch_nlo
     type(string_t) :: grid_path
     dispatch_nlo = .false.; if (present (is_nlo)) dispatch_nlo = is_nlo
     integration_method = &
          var_list%get_sval (var_str ("$integration_method"))
     select case (char (integration_method))
     case ("none")
        allocate (mci_none_t :: mci)
     case ("midpoint")
        allocate (mci_midpoint_t :: mci)
     case ("vamp", "default")
        call unpack_options_vamp ()
        allocate (mci_vamp_t :: mci)
        select type (mci)
        type is (mci_vamp_t)
           call mci%set_grid_parameters (grid_par)
           if (run_id /= "") then
              call mci%set_grid_filename (process_id, run_id)
           else
              call mci%set_grid_filename (process_id)
           end if
           grid_path = var_list%get_sval (var_str ("$integrate_workspace"))
           if (grid_path /= "") then
              call setup_grid_path (grid_path)
              call mci%prepend_grid_path (grid_path)
           end if
           call mci%set_history_parameters (history_par)
           call mci%set_rebuild_flag (rebuild_grids, check_grid_file)
           mci%negative_weights = negative_weights
           mci%verbose = verbose
        end select
     case ("vamp2")
        call unpack_options_vamp2 ()
        allocate (mci_vamp2_t :: mci)
        select type (mci)
        type is (mci_vamp2_t)
           call mci%set_config (mci_vamp2_config)
           if (run_id /= "") then
              call mci%set_integrator_filename (process_id, run_id)
           else
              call mci%set_integrator_filename (process_id)
           end if
           grid_path = var_list%get_sval (var_str ("$integrate_workspace"))
           if (grid_path /= "") then
              call setup_grid_path (grid_path)
              call mci%prepend_integrator_path (grid_path)
           end if
           call mci%set_rebuild_flag (rebuild_grids, check_grid_file)
           mci%negative_weights = negative_weights
           mci%verbose = verbose
        end select
     case default
        call msg_fatal ("Integrator '" &
             // char (integration_method) // "' not implemented")
     end select
   contains
     <<Dispatch mci s: procedures>>
   end subroutine dispatch_mci_s
 
 @ %def dispatch_mci_s
 @
 <<Dispatch mci s: procedures>>=
   subroutine unpack_options_vamp ()
     grid_par%threshold_calls = &
          var_list%get_ival (var_str ("threshold_calls"))
     grid_par%min_calls_per_channel = &
          var_list%get_ival (var_str ("min_calls_per_channel"))
     grid_par%min_calls_per_bin = &
          var_list%get_ival (var_str ("min_calls_per_bin"))
     grid_par%min_bins = &
          var_list%get_ival (var_str ("min_bins"))
     grid_par%max_bins = &
          var_list%get_ival (var_str ("max_bins"))
     grid_par%stratified = &
          var_list%get_lval (var_str ("?stratified"))
     if (.not. dispatch_nlo) then
        grid_par%use_vamp_equivalences = &
             var_list%get_lval (var_str ("?use_vamp_equivalences"))
     else
        grid_par%use_vamp_equivalences = .false.
     end if
     grid_par%channel_weights_power = &
          var_list%get_rval (var_str ("channel_weights_power"))
     grid_par%accuracy_goal = &
          var_list%get_rval (var_str ("accuracy_goal"))
     grid_par%error_goal = &
          var_list%get_rval (var_str ("error_goal"))
     grid_par%rel_error_goal = &
          var_list%get_rval (var_str ("relative_error_goal"))
     history_par%global = &
          var_list%get_lval (var_str ("?vamp_history_global"))
     history_par%global_verbose = &
          var_list%get_lval (var_str ("?vamp_history_global_verbose"))
     history_par%channel = &
          var_list%get_lval (var_str ("?vamp_history_channels"))
     history_par%channel_verbose = &
          var_list%get_lval (var_str ("?vamp_history_channels_verbose"))
     verbose = &
          var_list%get_lval (var_str ("?vamp_verbose"))
     check_grid_file = &
          var_list%get_lval (var_str ("?check_grid_file"))
     run_id = &
          var_list%get_sval (var_str ("$run_id"))
     rebuild_grids = &
          var_list%get_lval (var_str ("?rebuild_grids"))
     negative_weights = &
          var_list%get_lval (var_str ("?negative_weights")) .or. dispatch_nlo
   end subroutine unpack_options_vamp
 
   subroutine unpack_options_vamp2 ()
     mci_vamp2_config%n_bins_max = &
          var_list%get_ival (var_str ("max_bins"))
     mci_vamp2_config%n_calls_min_per_channel = &
          var_list%get_ival (var_str ("min_calls_per_channel"))
     mci_vamp2_config%n_calls_threshold = &
          var_list%get_ival (var_str ("threshold_calls"))
     mci_vamp2_config%beta = &
          var_list%get_rval (var_str ("channel_weights_power"))
     mci_vamp2_config%stratified = &
          var_list%get_lval (var_str ("?stratified"))
     if (.not. dispatch_nlo) then
        mci_vamp2_config%equivalences = &
             var_list%get_lval (var_str ("?use_vamp_equivalences"))
     else
        mci_vamp2_config%equivalences = .false.
     end if
     mci_vamp2_config%accuracy_goal = &
          var_list%get_rval (var_str ("accuracy_goal"))
     mci_vamp2_config%error_goal = &
          var_list%get_rval (var_str ("error_goal"))
     mci_vamp2_config%rel_error_goal = &
          var_list%get_rval (var_str ("relative_error_goal"))
     verbose = &
          var_list%get_lval (var_str ("?vamp_verbose"))
     check_grid_file = &
          var_list%get_lval (var_str ("?check_grid_file"))
     run_id = &
          var_list%get_sval (var_str ("$run_id"))
     rebuild_grids = &
          var_list%get_lval (var_str ("?rebuild_grids"))
     negative_weights = &
          var_list%get_lval (var_str ("?negative_weights")) .or. dispatch_nlo
   end subroutine unpack_options_vamp2
 
 @
 @ Make sure that the VAMP grid subdirectory, if requested, exists before it is
 used.  Also include a sanity check on the directory name.
 <<Dispatch mci: parameters>>=
   character(*), parameter :: ALLOWED_IN_DIRNAME = &
        "abcdefghijklmnopqrstuvwxyz&
        &ABCDEFGHIJKLMNOPQRSTUVWXYZ&
        &1234567890&
        &.,_-+="
 @ %def ALLOWED_IN_DIRNAME
 <<Dispatch mci: procedures>>=
   subroutine setup_grid_path (grid_path)
     type(string_t), intent(in) :: grid_path
     if (verify (grid_path, ALLOWED_IN_DIRNAME) == 0) then
        call msg_message ("Integrator: preparing VAMP grid directory '" &
             // char (grid_path) // "'")
        call os_system_call ("mkdir -p '" // grid_path // "'")
     else
        call msg_fatal ("Integrator: VAMP grid_path '" &
             // char (grid_path) // "' contains illegal characters")
     end if
   end subroutine setup_grid_path
   
 @ %def setup_grid_path
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[dispatch_mci_ut.f90]]>>=
 <<File header>>
 
 module dispatch_mci_ut
   use unit_tests
   use dispatch_mci_uti
 
 <<Standard module head>>
 
 <<Dispatch mci: public test>>
 
 contains
 
 <<Dispatch mci: test driver>>
 
 end module dispatch_mci_ut
 @ %def dispatch_mci_ut
 @
 <<[[dispatch_mci_uti.f90]]>>=
 <<File header>>
 
 module dispatch_mci_uti
 
 <<Use kinds>>
 <<Use strings>>
   use variables
   use mci_base
   use mci_none
   use mci_midpoint
   use mci_vamp
   use dispatch_mci
 
 <<Standard module head>>
 
 <<Dispatch mci: test declarations>>
 
 contains
 
 <<Dispatch mci: tests>>
 
 end module dispatch_mci_uti
 @ %def dispatch_mci_ut
 @ API: driver for the unit tests below.
 <<Dispatch mci: public test>>=
   public ::dispatch_mci_test
 <<Dispatch mci: test driver>>=
   subroutine dispatch_mci_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Dispatch mci: execute tests>>
   end subroutine dispatch_mci_test
 
 @  %def dispatch_mci_test
 @
 \subsubsection{Select type: integrator core}
 <<Dispatch mci: execute tests>>=
   call test (dispatch_mci_1, "dispatch_mci_1", &
        "integration method", &
        u, results)
 <<Dispatch mci: test declarations>>=
   public :: dispatch_mci_1
 <<Dispatch mci: tests>>=
   subroutine dispatch_mci_1 (u)
     integer, intent(in) :: u
     type(var_list_t) :: var_list
     class(mci_t), allocatable :: mci
     type(string_t) :: process_id
 
     write (u, "(A)")  "* Test output: dispatch_mci_1"
     write (u, "(A)")  "*   Purpose: select integration method"
     write (u, "(A)")
 
     call var_list%init_defaults (0)
 
     process_id = "dispatch_mci_1"
 
     write (u, "(A)")  "* Allocate MCI as none_t"
     write (u, "(A)")
 
     call var_list%set_string (&
          var_str ("$integration_method"), &
          var_str ("none"), is_known = .true.)
     call dispatch_mci_s (mci, var_list, process_id)
     select type (mci)
     type is (mci_none_t)
        call mci%write (u)
     end select
 
     call mci%final ()
     deallocate (mci)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate MCI as midpoint_t"
     write (u, "(A)")
 
     call var_list%set_string (&
          var_str ("$integration_method"), &
          var_str ("midpoint"), is_known = .true.)
     call dispatch_mci_s (mci, var_list, process_id)
     select type (mci)
     type is (mci_midpoint_t)
        call mci%write (u)
     end select
 
     call mci%final ()
     deallocate (mci)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate MCI as vamp_t"
     write (u, "(A)")
 
     call var_list%set_string (&
          var_str ("$integration_method"), &
          var_str ("vamp"), is_known = .true.)
     call var_list%set_int (var_str ("threshold_calls"), &
          1, is_known = .true.)
     call var_list%set_int (var_str ("min_calls_per_channel"), &
          2, is_known = .true.)
     call var_list%set_int (var_str ("min_calls_per_bin"), &
          3, is_known = .true.)
     call var_list%set_int (var_str ("min_bins"), &
          4, is_known = .true.)
     call var_list%set_int (var_str ("max_bins"), &
          5, is_known = .true.)
     call var_list%set_log (var_str ("?stratified"), &
          .false., is_known = .true.)
     call var_list%set_log (var_str ("?use_vamp_equivalences"),&
          .false., is_known = .true.)
     call var_list%set_real (var_str ("channel_weights_power"),&
          4._default, is_known = .true.)
     call var_list%set_log (&
          var_str ("?vamp_history_global_verbose"), &
          .true., is_known = .true.)
     call var_list%set_log (&
          var_str ("?vamp_history_channels"), &
          .true., is_known = .true.)
     call var_list%set_log (&
          var_str ("?vamp_history_channels_verbose"), &
          .true., is_known = .true.)
     call var_list%set_log (var_str ("?stratified"), &
          .false., is_known = .true.)
 
     call dispatch_mci_s (mci, var_list, process_id)
     select type (mci)
     type is (mci_vamp_t)
        call mci%write (u)
        call mci%write_history_parameters (u)
     end select
 
     call mci%final ()
     deallocate (mci)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate MCI as vamp_t, allow for negative weights"
     write (u, "(A)")
 
     call var_list%set_string (&
          var_str ("$integration_method"), &
          var_str ("vamp"), is_known = .true.)
     call var_list%set_log (var_str ("?negative_weights"), &
          .true., is_known = .true.)
 
     call dispatch_mci_s (mci, var_list, process_id)
     select type (mci)
     type is (mci_vamp_t)
        call mci%write (u)
        call mci%write_history_parameters (u)
     end select
 
     call mci%final ()
     deallocate (mci)
 
     call var_list%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_mci_1"
 
   end subroutine dispatch_mci_1
 
 @ %def dispatch_mci_1
Index: trunk/src/phase_space/phase_space.nw
===================================================================
--- trunk/src/phase_space/phase_space.nw	(revision 8186)
+++ trunk/src/phase_space/phase_space.nw	(revision 8187)
@@ -1,26757 +1,27614 @@
 % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*-
 % WHIZARD code as NOWEB source: phase space
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Phase Space}
 \includemodulegraph{phase_space}
 
 The abstract representation of a type that parameterizes phase space,
 with methods for construction and evaluation.
 \begin{description}
 \item[phs\_base]
   Abstract phase-space representation.
 \end{description}
 
 A simple implementation:
 \begin{description}
 \item[phs\_1none]
   This implements a non-functional dummy module for the phase space.
   A process which uses this module cannot be integrated.  The purpose
   of this module is to provide a placeholder for processes which do
   not require phase-space evaluation.  They may still allow for evaluating
   matrix elements.
 \item[phs\_single]
   Parameterize the phase space of a single particle, i.e., the solid
   angle.  This is useful only for very restricted problems, but it
   avoids the complexity of a generic approach in those trivial cases.
 \end{description}
 
 The standard implementation is called \emph{wood} phase space.  It
 consists of several auxiliary modules and the actual implementation
 module.
 \begin{description}
 \item[mappings]
   Generate invariant masses and decay angles from given
   random numbers (or the inverse operation).  Each mapping pertains to a
   particular node in a phase-space tree.  Different mappings account for
   uniform distributions, resonances, zero-mass behavior, and so on.
 \item[phs\_trees]
   Phase space parameterizations for scattering
   processes are defined recursively as if there was an initial particle
   decaying.  This module sets up a representation in terms of abstract
   trees, where each node gets a unique binary number.  Each tree is
   stored as an array of branches, where integers indicate the
   connections.  This emulates pointers in a transparent way.  Real
   pointers would also be possible, but seem to be less efficient for
   this particular case.
 \item[phs\_forests]
   The type defined by this module collects the
   decay trees corresponding to a given process and the applicable
   mappings.  To set this up, a file is read which is either written by
   the user or by the \textbf{cascades} module functions.  The module
   also contains the routines that evaluate phase space, i.e., generate
   momenta from random numbers and back.
 \item[cascades]
   This module is a pseudo Feynman diagram generator with the
   particular purpose of finding the phase space parameterizations best
   suited for a given process.  It uses a model file to set up the
   possible vertices, generates all possible diagrams, identifies
   resonances and singularities, and simplifies the list by merging
   equivalent diagrams and dropping irrelevant ones.  This process can be
   controlled at several points by user-defined parameters.  Note that it
   depends on the particular values of particle masses, so it cannot be
   done before reading the input file.
 \item[phs\_wood]
   Make the functionality available in form of an implementation of the
   abstract phase-space type.
 \item[phs\_fks]
   Phase-space parameterization with modifications for the FKS scheme.
 \end{description}
 
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Abstract phase-space module}
 
 In this module we define an abstract base type (and a trivial test
 implementation) for multi-channel phase-space parameterizations.
 <<[[phs_base.f90]]>>=
 <<File header>>
 
 module phs_base
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use constants, only: TWOPI, TWOPI4
   use string_utils, only: split_string
   use format_defs, only: FMT_19
   use numeric_utils
   use diagnostics
   use md5
   use physics_defs
   use lorentz
   use model_data
   use flavors
   use process_constants
 
 <<Standard module head>>
 
 <<PHS base: public>>
 
 <<PHS base: types>>
 
 <<PHS base: interfaces>>
 
 contains
 
 <<PHS base: procedures>>
 
 end module phs_base
 @ %def phs_base
 @
 \subsection{Phase-space channels}
 The kinematics configuration may generate multiple parameterizations of phase
 space.  Some of those have specific properties, such as a resonance in the s
 channel.
 
 \subsubsection{Channel properties}
 This is the abstract type for the channel properties.  We need them as
 a data transfer container, so everything is public and transparent.
 <<PHS base: public>>=
   public :: channel_prop_t
 <<PHS base: types>>=
   type, abstract :: channel_prop_t
    contains
      procedure (channel_prop_to_string), deferred :: to_string
      generic :: operator (==) => is_equal
      procedure (channel_eq), deferred :: is_equal
   end type channel_prop_t
 
 @ %def channel_prop_t
 <<PHS base: interfaces>>=
   abstract interface
      function channel_prop_to_string (object) result (string)
        import
        class(channel_prop_t), intent(in) :: object
        type(string_t) :: string
      end function channel_prop_to_string
   end interface
 
 @ %def channel_prop_to_string
 <<PHS base: interfaces>>=
   abstract interface
      function channel_eq (prop1, prop2) result (flag)
        import
        class(channel_prop_t), intent(in) :: prop1, prop2
        logical :: flag
      end function channel_eq
   end interface
 
 @ %def channel_prop_to_string
 @
 Here is a resonance as a channel property.  Mass and width are stored
 here in physical units.
 <<PHS base: public>>=
   public :: resonance_t
 <<PHS base: types>>=
   type, extends (channel_prop_t) :: resonance_t
      real(default) :: mass = 0
      real(default) :: width = 0
    contains
      procedure :: to_string => resonance_to_string
      procedure :: is_equal => resonance_is_equal
   end type resonance_t
 
 @ %def resonance_t
 @ Print mass and width.
 <<PHS base: procedures>>=
   function resonance_to_string (object) result (string)
     class(resonance_t), intent(in) :: object
     type(string_t) :: string
     character(32) :: buffer
     string = "resonant: m ="
     write (buffer, "(" // FMT_19 // ")")  object%mass
     string = string // trim (buffer) // " GeV, w ="
     write (buffer, "(" // FMT_19 // ")")  object%width
     string = string // trim (buffer) // " GeV"
   end function resonance_to_string
 
 @ %def resonance_to_string
 @ Equality.
 <<PHS base: procedures>>=
   function resonance_is_equal (prop1, prop2) result (flag)
     class(resonance_t), intent(in) :: prop1
     class(channel_prop_t), intent(in) :: prop2
     logical :: flag
     select type (prop2)
     type is (resonance_t)
        flag = prop1%mass == prop2%mass .and. prop1%width == prop2%width
     class default
        flag = .false.
     end select
   end function resonance_is_equal
 
 @ %def resonance_is_equal
 @
 This is the limiting case of a resonance, namely an on-shell particle.
 We just store the mass in physical units.
 <<PHS base: public>>=
   public :: on_shell_t
 <<PHS base: types>>=
   type, extends (channel_prop_t) :: on_shell_t
      real(default) :: mass = 0
    contains
      procedure :: to_string => on_shell_to_string
      procedure :: is_equal => on_shell_is_equal
   end type on_shell_t
 
 @ %def on_shell_t
 @ Print mass and width.
 <<PHS base: procedures>>=
   function on_shell_to_string (object) result (string)
     class(on_shell_t), intent(in) :: object
     type(string_t) :: string
     character(32) :: buffer
     string = "on shell: m ="
     write (buffer, "(" // FMT_19 // ")")  object%mass
     string = string // trim (buffer) // " GeV"
   end function on_shell_to_string
 
 @ %def on_shell_to_string
 @ Equality.
 <<PHS base: procedures>>=
   function on_shell_is_equal (prop1, prop2) result (flag)
     class(on_shell_t), intent(in) :: prop1
     class(channel_prop_t), intent(in) :: prop2
     logical :: flag
     select type (prop2)
     type is (on_shell_t)
        flag = prop1%mass == prop2%mass
     class default
        flag = .false.
     end select
   end function on_shell_is_equal
 
 @ %def on_shell_is_equal
 @
 \subsubsection{Channel equivalences}
 This type describes an equivalence.  The current channel is equivalent
 to channel [[c]].  The equivalence involves a permutation [[perm]] of
 integration dimensions and, within each integration dimension, a
 mapping [[mode]].
 <<PHS base: types>>=
   type :: phs_equivalence_t
      integer :: c = 0
      integer, dimension(:), allocatable :: perm
      integer, dimension(:), allocatable :: mode
    contains
    <<PHS base: phs equivalence: TBP>>
   end type phs_equivalence_t
 
 @ %def phs_equivalence_t
 @
 The mapping modes are
 <<PHS base: types>>=
   integer, parameter, public :: &
        EQ_IDENTITY = 0, EQ_INVERT = 1, EQ_SYMMETRIC = 2, EQ_INVARIANT = 3
 
 @ %def EQ_IDENTITY EQ_INVERT EQ_SYMMETRIC
 @ In particular, if a channel is equivalent to itself in the
 [[EQ_SYMMETRIC]] mode, the integrand can be assumed to be symmetric
 w.r.t.\ a reflection $x\to 1 - x$ of the correponding integration variable.
 
 These are the associated tags, for output:
 <<PHS base: types>>=
   character, dimension(0:3), parameter :: TAG = ["+", "-", ":", "x"]
 
 @ %def TAG
 @ Write an equivalence.
 <<PHS base: phs equivalence: TBP>>=
   procedure :: write => phs_equivalence_write
 <<PHS base: procedures>>=
   subroutine phs_equivalence_write (object, unit)
     class(phs_equivalence_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, j
     u = given_output_unit (unit)
     write (u, "(5x,'=',1x,I0,1x)", advance = "no")  object%c
     if (allocated (object%perm)) then
        write (u, "(A)", advance = "no")  "("
        do j = 1, size (object%perm)
           if (j > 1)  write (u, "(1x)", advance = "no")
           write (u, "(I0,A1)", advance = "no") &
                object%perm(j), TAG(object%mode(j))
        end do
        write (u, "(A)")  ")"
     else
        write (u, "(A)")
     end if
   end subroutine phs_equivalence_write
 
 @ %def phs_equivalence_write
 @ Initialize an equivalence.  This allocates the [[perm]] and [[mode]]
 arrays with equal size.
 <<PHS base: phs equivalence: TBP>>=
   procedure :: init => phs_equivalence_init
 <<PHS base: procedures>>=
   subroutine phs_equivalence_init (eq, n_dim)
     class(phs_equivalence_t), intent(out) :: eq
     integer, intent(in) :: n_dim
     allocate (eq%perm (n_dim), source = 0)
     allocate (eq%mode (n_dim), source = EQ_IDENTITY)
   end subroutine phs_equivalence_init
 
 @ %def phs_equivalence_init
 @
 \subsubsection{Channel objects}
 The channel entry holds (optionally) specific properties.
 
 [[sf_channel]] is the structure-function channel that corresponds to this
 phase-space channel.  The structure-function channel may be set up with a
 specific mapping that depends on the phase-space channel properties.  (The
 default setting is to leave the properties empty.)
 <<PHS base: public>>=
   public :: phs_channel_t
 <<PHS base: types>>=
   type :: phs_channel_t
      class(channel_prop_t), allocatable :: prop
      integer :: sf_channel = 1
      type(phs_equivalence_t), dimension(:), allocatable :: eq
    contains
    <<PHS base: phs channel: TBP>>
   end type phs_channel_t
 
 @ %def phs_channel_t
 @ Output.
 <<PHS base: phs channel: TBP>>=
   procedure :: write => phs_channel_write
 <<PHS base: procedures>>=
   subroutine phs_channel_write (object, unit)
     class(phs_channel_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, j
     u = given_output_unit (unit)
     write (u, "(1x,I0)", advance="no") object%sf_channel
     if (allocated (object%prop)) then
        write (u, "(1x,A)")  char (object%prop%to_string ())
     else
        write (u, *)
     end if
     if (allocated (object%eq)) then
        do j = 1, size (object%eq)
           call object%eq(j)%write (u)
        end do
     end if
   end subroutine phs_channel_write
 
 @ %def phs_channel_write
 @ Identify the channel with an s-channel resonance.
 <<PHS base: phs channel: TBP>>=
   procedure :: set_resonant => channel_set_resonant
 <<PHS base: procedures>>=
   subroutine channel_set_resonant (channel, mass, width)
     class(phs_channel_t), intent(inout) :: channel
     real(default), intent(in) :: mass, width
     allocate (resonance_t :: channel%prop)
     select type (prop => channel%prop)
     type is (resonance_t)
        prop%mass = mass
        prop%width = width
     end select
   end subroutine channel_set_resonant
 
 @ %def channel_set_resonant
 @ Identify the channel with an on-shell particle.
 <<PHS base: phs channel: TBP>>=
   procedure :: set_on_shell => channel_set_on_shell
 <<PHS base: procedures>>=
   subroutine channel_set_on_shell (channel, mass)
     class(phs_channel_t), intent(inout) :: channel
     real(default), intent(in) :: mass
     allocate (on_shell_t :: channel%prop)
     select type (prop => channel%prop)
     type is (on_shell_t)
        prop%mass = mass
     end select
   end subroutine channel_set_on_shell
 
 @ %def channel_set_on_shell
 @
 \subsection{Property collection}
 We can set up a list of all distinct channel properties for a given
 set of channels.
 <<PHS base: public>>=
   public :: phs_channel_collection_t
 <<PHS base: types>>=
   type :: prop_entry_t
      integer :: i = 0
      class(channel_prop_t), allocatable :: prop
      type(prop_entry_t), pointer :: next => null ()
   end type prop_entry_t
 
   type :: phs_channel_collection_t
      integer :: n = 0
      type(prop_entry_t), pointer :: first => null ()
    contains
    <<PHS base: phs channel collection: TBP>>
   end type phs_channel_collection_t
 
 @ %def prop_entry_t
 @ %def phs_channel_collection_t
 @ Finalizer for the list.
 <<PHS base: phs channel collection: TBP>>=
   procedure :: final => phs_channel_collection_final
 <<PHS base: procedures>>=
   subroutine phs_channel_collection_final (object)
     class(phs_channel_collection_t), intent(inout) :: object
     type(prop_entry_t), pointer :: entry
     do while (associated (object%first))
        entry => object%first
        object%first => entry%next
        deallocate (entry)
     end do
   end subroutine phs_channel_collection_final
 
 @ %def phs_channel_collection_final
 @ Output.
 
 Note: eliminating the [[string]] auxiliary triggers an ICE in gfortran 4.7.2.
 <<PHS base: phs channel collection: TBP>>=
   procedure :: write => phs_channel_collection_write
 <<PHS base: procedures>>=
   subroutine phs_channel_collection_write (object, unit)
     class(phs_channel_collection_t), intent(in) :: object
     integer, intent(in), optional :: unit
     type(prop_entry_t), pointer :: entry
     type(string_t) :: string
     integer :: u
     u = given_output_unit (unit)
     entry => object%first
     do while (associated (entry))
        if (allocated (entry%prop)) then
           string = entry%prop%to_string ()
           write (u, "(1x,I0,1x,A)")  entry%i, char (string)
        else
           write (u, "(1x,I0)")  entry%i
        end if
        entry => entry%next
     end do
   end subroutine phs_channel_collection_write
 
 @ %def phs_channel_collection_write
 @ Push a new property to the stack if it is not yet included.
 Simultaneously, set the [[sf_channel]] entry in the phase-space
 channel object to the index of the matching entry, or the new entry if
 there was no match.
 <<PHS base: phs channel collection: TBP>>=
   procedure :: push => phs_channel_collection_push
 <<PHS base: procedures>>=
   subroutine phs_channel_collection_push (coll, channel)
     class(phs_channel_collection_t), intent(inout) :: coll
     type(phs_channel_t), intent(inout) :: channel
     type(prop_entry_t), pointer :: entry, new
     if (associated (coll%first)) then
        entry => coll%first
        do
           if (allocated (entry%prop)) then
              if (allocated (channel%prop)) then
                 if (entry%prop == channel%prop) then
                    channel%sf_channel = entry%i
                    return
                 end if
              end if
           else if (.not. allocated (channel%prop)) then
              channel%sf_channel = entry%i
              return
           end if
           if (associated (entry%next)) then
              entry => entry%next
           else
              exit
           end if
        end do
        allocate (new)
        entry%next => new
     else
        allocate (new)
        coll%first => new
     end if
     coll%n = coll%n + 1
     new%i = coll%n
     channel%sf_channel = new%i
     if (allocated (channel%prop)) then
        allocate (new%prop, source = channel%prop)
     end if
   end subroutine phs_channel_collection_push
 
 @ %def phs_channel_collection_push
 @ Return the number of collected distinct channels.
 <<PHS base: phs channel collection: TBP>>=
   procedure :: get_n => phs_channel_collection_get_n
 <<PHS base: procedures>>=
   function phs_channel_collection_get_n (coll) result (n)
     class(phs_channel_collection_t), intent(in) :: coll
     integer :: n
     n = coll%n
   end function phs_channel_collection_get_n
 
 @ %def phs_channel_collection_get_n
 @ Return a specific channel (property object).
 <<PHS base: phs channel collection: TBP>>=
   procedure :: get_entry => phs_channel_collection_get_entry
 <<PHS base: procedures>>=
   subroutine phs_channel_collection_get_entry (coll, i, prop)
     class(phs_channel_collection_t), intent(in) :: coll
     integer, intent(in) :: i
     class(channel_prop_t), intent(out), allocatable :: prop
     type(prop_entry_t), pointer :: entry
     integer :: k
     if (i > 0 .and. i <= coll%n) then
        entry => coll%first
        do k = 2, i
           entry => entry%next
        end do
        if (allocated (entry%prop)) then
           if (allocated (prop))  deallocate (prop)
           allocate (prop, source = entry%prop)
        end if
     else
        call msg_bug ("PHS channel collection: get entry: illegal index")
     end if
   end subroutine phs_channel_collection_get_entry
 
 @ %def phs_channel_collection_get_entry
 @
 \subsection{Kinematics configuration}
 Here, we store the universal information that is specifically relevant
 for phase-space generation.  It is a subset of the process data,
 supplemented by basic information on phase-space parameterization
 channels.
 
 A concrete implementation will contain more data, that describe the
 phase space in detail.
 
 MD5 sums: the phase space setup depends on the process, it depends on
 the model parameters (the masses, that is), and on the configuration
 parameters.  (It does not depend on the QCD setup.)
 <<PHS base: public>>=
   public :: phs_config_t
 <<PHS base: types>>=
   type, abstract :: phs_config_t
      ! private
      type(string_t) :: id
      integer :: n_in = 0
      integer :: n_out = 0
      integer :: n_tot = 0
      integer :: n_state = 0
      integer :: n_par = 0
      integer :: n_channel = 0
      real(default) :: sqrts = 0
      logical :: sqrts_fixed = .true.
      logical :: cm_frame = .true.
      logical :: azimuthal_dependence = .false.
      integer, dimension(:), allocatable :: dim_flat
      logical :: provides_equivalences = .false.
      logical :: provides_chains = .false.
      logical :: vis_channels = .false.
      integer, dimension(:), allocatable :: chain
      class(model_data_t), pointer :: model => null ()
      type(flavor_t), dimension(:,:), allocatable :: flv
      type(phs_channel_t), dimension(:), allocatable :: channel
      character(32) :: md5sum_process = ""
      character(32) :: md5sum_model_par = ""
      character(32) :: md5sum_phs_config = ""
      integer :: nlo_type
    contains
    <<PHS base: phs config: TBP>>
   end type phs_config_t
 
 @ %def phs_config_t
 @ Finalizer, deferred.
 <<PHS base: phs config: TBP>>=
   procedure (phs_config_final), deferred :: final
 <<PHS base: interfaces>>=
   abstract interface
      subroutine phs_config_final (object)
        import
        class(phs_config_t), intent(inout) :: object
      end subroutine phs_config_final
   end interface
 
 @ %def phs_config_final
 @ Output.  We provide an implementation for the output of the base-type
 contents and an interface for the actual write method.
 <<PHS base: phs config: TBP>>=
   procedure (phs_config_write), deferred :: write
   procedure :: base_write => phs_config_write
 <<PHS base: procedures>>=
   subroutine phs_config_write (object, unit, include_id)
     class(phs_config_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: include_id
     integer :: u, i, j
     integer :: n_tot_flv
     logical :: use_id
     n_tot_flv = object%n_tot
     u = given_output_unit (unit)
     use_id = .true.; if (present (include_id)) use_id = include_id
     if (use_id) write (u, "(3x,A,A,A)") "ID        = '", char (object%id), "'"
     write (u, "(3x,A,I0)")  "n_in      = ", object%n_in
     write (u, "(3x,A,I0)")  "n_out     = ", object%n_out
     write (u, "(3x,A,I0)")  "n_tot     = ", object%n_tot
     write (u, "(3x,A,I0)")  "n_state   = ", object%n_state
     write (u, "(3x,A,I0)")  "n_par     = ", object%n_par
     write (u, "(3x,A,I0)")  "n_channel = ", object%n_channel
     write (u, "(3x,A," // FMT_19 // ")")  "sqrts     = ", object%sqrts
     write (u, "(3x,A,L1)")  "s_fixed   = ", object%sqrts_fixed
     write (u, "(3x,A,L1)")  "cm_frame  = ", object%cm_frame
     write (u, "(3x,A,L1)")  "azim.dep. = ", object%azimuthal_dependence
     if (allocated (object%dim_flat)) then
        write (u, "(3x,A,I0)")  "flat dim. = ", object%dim_flat
     end if
     write (u, "(1x,A)")  "Flavor combinations:"
     do i = 1, object%n_state
        write (u, "(3x,I0,':')", advance="no")  i
 !       do j = 1, object%n_tot
        do j = 1, n_tot_flv
           write (u, "(1x,A)", advance="no")  char (object%flv(j,i)%get_name ())
        end do
        write (u, "(A)")
     end do
     if (allocated (object%channel)) then
        write (u, "(1x,A)")  "Phase-space / structure-function channels:"
        do i = 1, object%n_channel
           write (u, "(3x,I0,':')", advance="no") i
           call object%channel(i)%write (u)
        end do
     end if
     if (object%md5sum_process /= "") then
        write (u, "(3x,A,A,A)") "MD5 sum (process)    = '", &
             object%md5sum_process, "'"
     end if
     if (object%md5sum_model_par /= "") then
        write (u, "(3x,A,A,A)") "MD5 sum (model par)  = '", &
             object%md5sum_model_par, "'"
     end if
     if (object%md5sum_phs_config /= "") then
        write (u, "(3x,A,A,A)") "MD5 sum (phs config) = '", &
             object%md5sum_phs_config, "'"
     end if
   end subroutine phs_config_write
 
 @ %def phs_config_write
 @ Similarly, a basic initializer and an interface.  The model pointer is taken
 as an argument; we may verify that this has the expected model name.
 
 The intent is [[inout]].  We want to be able to set parameters in advance.
 <<PHS base: phs config: TBP>>=
   procedure :: init => phs_config_init
 <<PHS base: procedures>>=
   subroutine phs_config_init (phs_config, data, model)
     class(phs_config_t), intent(inout) :: phs_config
     type(process_constants_t), intent(in) :: data
     class(model_data_t), intent(in), target :: model
     integer :: i, j
     phs_config%id = data%id
     phs_config%n_in  = data%n_in
     phs_config%n_out = data%n_out
     phs_config%n_tot = data%n_in + data%n_out
     phs_config%n_state = data%n_flv
     if (data%model_name == model%get_name ()) then
        phs_config%model => model
     else
        call msg_bug ("phs_config_init: model name mismatch")
     end if
     allocate (phs_config%flv (phs_config%n_tot, phs_config%n_state))
     do i = 1, phs_config%n_state
        do j = 1, phs_config%n_tot
           call phs_config%flv(j,i)%init (data%flv_state(j,i), &
                phs_config%model)
        end do
     end do
     phs_config%md5sum_process = data%md5sum
   end subroutine phs_config_init
 
 @ %def phs_config_init
 @
 WK 2018-04-05: This procedure appears to be redundant?
 <<XXX PHS base: phs config: TBP>>=
   procedure :: set_component_index => phs_config_set_component_index
 <<XXX PHS base: procedures>>=
   subroutine phs_config_set_component_index (phs_config, index)
     class(phs_config_t), intent(inout) :: phs_config
     integer, intent(in) :: index
     type(string_t), dimension(:), allocatable :: id
     type(string_t) :: suffix
     integer :: i, n
     suffix = var_str ('i') // int2string (index)
     call split_string (phs_config%id, var_str ('_'), id)
     phs_config%id = var_str ('')
     n = size (id) - 1
     do i = 1, n
        phs_config%id = phs_config%id // id(i) // var_str ('_')
     end do
     phs_config%id = phs_config%id // suffix
   end subroutine phs_config_set_component_index
 
 @ %def phs_config_set_component_index
 @ This procedure should complete the phase-space configuration.  We
 need the [[sqrts]] value as overall scale, which is known only after
 the beams have been defined.  The procedure should determine the number of
 channels, their properties (if any), and allocate and fill the [[channel]]
 array accordingly.
 <<PHS base: phs config: TBP>>=
   procedure (phs_config_configure), deferred :: configure
 <<PHS base: interfaces>>=
   abstract interface
      subroutine phs_config_configure (phs_config, sqrts, &
           sqrts_fixed, cm_frame, azimuthal_dependence, rebuild, ignore_mismatch, &
           nlo_type, subdir)
        import
        class(phs_config_t), intent(inout) :: phs_config
        real(default), intent(in) :: sqrts
        logical, intent(in), optional :: sqrts_fixed
        logical, intent(in), optional :: cm_frame
        logical, intent(in), optional :: azimuthal_dependence
        logical, intent(in), optional :: rebuild
        logical, intent(in), optional :: ignore_mismatch
        integer, intent(in), optional :: nlo_type
        type(string_t), intent(in), optional :: subdir
      end subroutine phs_config_configure
   end interface
 
 @ %def phs_config_configure
 @ Manually assign structure-function channel indices to the phase-space
 channel objects.  (Used by a test routine.)
 <<PHS base: phs config: TBP>>=
   procedure :: set_sf_channel => phs_config_set_sf_channel
 <<PHS base: procedures>>=
   subroutine phs_config_set_sf_channel (phs_config, sf_channel)
     class(phs_config_t), intent(inout) :: phs_config
     integer, dimension(:), intent(in) :: sf_channel
     phs_config%channel%sf_channel = sf_channel
   end subroutine phs_config_set_sf_channel
 
 @ %def phs_config_set_sf_channel
 @ Collect new channels not yet in the collection from this phase-space
 configuration object.  At the same time, assign structure-function channels.
 <<PHS base: phs config: TBP>>=
   procedure :: collect_channels => phs_config_collect_channels
 <<PHS base: procedures>>=
   subroutine phs_config_collect_channels (phs_config, coll)
     class(phs_config_t), intent(inout) :: phs_config
     type(phs_channel_collection_t), intent(inout) :: coll
     integer :: c
     do c = 1, phs_config%n_channel
        call coll%push (phs_config%channel(c))
     end do
   end subroutine phs_config_collect_channels
 
 @ %def phs_config_collect_channels
 @ Compute the MD5 sum.  We abuse the [[write]] method.  In
 type implementations, [[write]] should only display information that is
 relevant for the MD5 sum.  The data include the process MD5 sum which is taken
 from the process constants, and the MD5 sum of the model parameters.  This may
 change, so it is computed here.
 <<PHS base: phs config: TBP>>=
   procedure :: compute_md5sum => phs_config_compute_md5sum
 <<PHS base: procedures>>=
   subroutine phs_config_compute_md5sum (phs_config, include_id)
     class(phs_config_t), intent(inout) :: phs_config
     logical, intent(in), optional :: include_id
     integer :: u
     phs_config%md5sum_model_par = phs_config%model%get_parameters_md5sum ()
     phs_config%md5sum_phs_config = ""
     u = free_unit ()
     open (u, status = "scratch", action = "readwrite")
     call phs_config%write (u, include_id)
     rewind (u)
     phs_config%md5sum_phs_config = md5sum (u)
     close (u)
   end subroutine phs_config_compute_md5sum
 
 @ %def phs_config_compute_md5sum
 @ Print an informative message after phase-space configuration.
 <<PHS base: phs config: TBP>>=
   procedure (phs_startup_message), deferred :: startup_message
   procedure :: base_startup_message => phs_startup_message
 <<PHS base: procedures>>=
   subroutine phs_startup_message (phs_config, unit)
     class(phs_config_t), intent(in) :: phs_config
     integer, intent(in), optional :: unit
     write (msg_buffer, "(A,3(1x,I0,1x,A))") &
          "Phase space:", &
          phs_config%n_channel, "channels,", &
          phs_config%n_par, "dimensions"
     call msg_message (unit = unit)
   end subroutine phs_startup_message
 
 @ %def phs_startup_message
 @ This procedure should be implemented such that the phase-space
 configuration object allocates a phase-space instance of matching type.
 <<PHS base: phs config: TBP>>=
   procedure (phs_config_allocate_instance), nopass, deferred :: &
        allocate_instance
 <<PHS base: interfaces>>=
   abstract interface
      subroutine phs_config_allocate_instance (phs)
        import
        class(phs_t), intent(inout), pointer :: phs
      end subroutine phs_config_allocate_instance
   end interface
 
 @ %def phs_config_allocate_instance
 @
 \subsection{Extract data}
 Return the number of MC input parameters.
 <<PHS base: phs config: TBP>>=
   procedure :: get_n_par => phs_config_get_n_par
 <<PHS base: procedures>>=
   function phs_config_get_n_par (phs_config) result (n)
     class(phs_config_t), intent(in) :: phs_config
     integer :: n
     n = phs_config%n_par
   end function phs_config_get_n_par
 
 @ %def phs_config_get_n_par
 @ Return dimensions (parameter indices) for which the phase-space
 dimension is flat, so integration and event generation can be simplified.
 <<PHS base: phs config: TBP>>=
   procedure :: get_flat_dimensions => phs_config_get_flat_dimensions
 <<PHS base: procedures>>=
   function phs_config_get_flat_dimensions (phs_config) result (dim_flat)
     class(phs_config_t), intent(in) :: phs_config
     integer, dimension(:), allocatable :: dim_flat
     if (allocated (phs_config%dim_flat)) then
        allocate (dim_flat (size (phs_config%dim_flat)))
        dim_flat = phs_config%dim_flat
     else
        allocate (dim_flat (0))
     end if
   end function phs_config_get_flat_dimensions
 
 @ %def phs_config_get_flat_dimensions
 @ Return the number of phase-space channels.
 <<PHS base: phs config: TBP>>=
   procedure :: get_n_channel => phs_config_get_n_channel
 <<PHS base: procedures>>=
   function phs_config_get_n_channel (phs_config) result (n)
     class(phs_config_t), intent(in) :: phs_config
     integer :: n
     n = phs_config%n_channel
   end function phs_config_get_n_channel
 
 @ %def phs_config_get_n_channel
 @ Return the structure-function channel that corresponds to the
 phase-space channel [[c]].  If the channel array is not allocated (which
 happens if there is no structure function), return zero.
 <<PHS base: phs config: TBP>>=
   procedure :: get_sf_channel => phs_config_get_sf_channel
 <<PHS base: procedures>>=
   function phs_config_get_sf_channel (phs_config, c) result (c_sf)
     class(phs_config_t), intent(in) :: phs_config
     integer, intent(in) :: c
     integer :: c_sf
     if (allocated (phs_config%channel)) then
        c_sf = phs_config%channel(c)%sf_channel
     else
        c_sf = 0
     end if
   end function phs_config_get_sf_channel
 
 @ %def phs_config_get_sf_channel
 @ Return the mass(es) of the incoming particle(s).  We take the first flavor
 combination in the array, assuming that masses must be degenerate among
 flavors.
 <<PHS base: phs config: TBP>>=
   procedure :: get_masses_in => phs_config_get_masses_in
 <<PHS base: procedures>>=
   subroutine phs_config_get_masses_in (phs_config, m)
     class(phs_config_t), intent(in) :: phs_config
     real(default), dimension(:), intent(out) :: m
     integer :: i
     do i = 1, phs_config%n_in
        m(i) = phs_config%flv(i,1)%get_mass ()
     end do
   end subroutine phs_config_get_masses_in
 
 @ %def phs_config_get_masses_in
 @ Return the MD5 sum of the configuration.
 <<PHS base: phs config: TBP>>=
   procedure :: get_md5sum => phs_config_get_md5sum
 <<PHS base: procedures>>=
   function phs_config_get_md5sum (phs_config) result (md5sum)
     class(phs_config_t), intent(in) :: phs_config
     character(32) :: md5sum
     md5sum = phs_config%md5sum_phs_config
   end function phs_config_get_md5sum
 
 @ %def phs_config_get_md5sum
 @
 \subsection{Phase-space point instance}
 The [[phs_t]] object holds the workspace for phase-space generation.
 In the base object, we have the MC input parameters [[r]] and the
 Jacobian factor [[f]], for each channel, and the incoming and outgoing
 momenta.
 
 Note: The [[active_channel]] array is not used yet, all elements are
 initialized with [[.true.]].  It should be touched by the integrator if it
 decides to drop irrelevant channels.
 <<PHS base: public>>=
   public :: phs_t
 <<PHS base: types>>=
   type, abstract :: phs_t
      class(phs_config_t), pointer :: config => null ()
      logical :: r_defined = .false.
      integer :: selected_channel = 0
      logical, dimension(:), allocatable :: active_channel
      real(default), dimension(:,:), allocatable :: r
      real(default), dimension(:), allocatable :: f
      real(default), dimension(:), allocatable :: m_in
      real(default), dimension(:), allocatable :: m_out
      real(default) :: flux = 0
      real(default) :: volume = 0
      type(lorentz_transformation_t) :: lt_cm_to_lab
      logical :: p_defined = .false.
      real(default) :: sqrts_hat = 0
      type(vector4_t), dimension(:), allocatable :: p
      logical :: q_defined = .false.
      type(vector4_t), dimension(:), allocatable :: q
    contains
    <<PHS base: phs: TBP>>
   end type phs_t
 
 @ %def phs_t
 @ Output.  Since phase space may get complicated, we include a
 [[verbose]] option for the abstract [[write]] procedure.
 <<PHS base: phs: TBP>>=
   procedure (phs_write), deferred :: write
 <<PHS base: interfaces>>=
   abstract interface
      subroutine phs_write (object, unit, verbose)
        import
        class(phs_t), intent(in) :: object
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: verbose
      end subroutine phs_write
   end interface
 
 @ %def phs_write
 @ This procedure can be called to print the contents of the base type.
 <<PHS base: phs: TBP>>=
   procedure :: base_write => phs_base_write
 <<PHS base: procedures>>=
   subroutine phs_base_write (object, unit)
     class(phs_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u, c, i
     u = given_output_unit (unit)
     write (u, "(1x,A)", advance="no")  "Partonic phase space: parameters"
     if (object%r_defined) then
        write (u, *)
     else
        write (u, "(1x,A)")  "[undefined]"
     end if
     write (u, "(3x,A,999(1x," // FMT_19 // "))") "m_in    =", object%m_in
     write (u, "(3x,A,999(1x," // FMT_19 // "))") "m_out   =", object%m_out
     write (u, "(3x,A," // FMT_19 // ")")  "Flux   = ", object%flux
     write (u, "(3x,A," // FMT_19 // ")")  "Volume = ", object%volume
     if (allocated (object%f)) then
        do c = 1, size (object%r, 2)
           write (u, "(1x,A,I0,A)", advance="no")  "Channel #", c, ":"
           if (c == object%selected_channel) then
              write (u, "(1x,A)")  "[selected]"
           else
              write (u, *)
           end if
           write (u, "(3x,A)", advance="no")  "r ="
           do i = 1, size (object%r, 1)
              write (u, "(1x,F9.7)", advance="no")  object%r(i,c)
           end do
           write (u, *)
           write (u, "(3x,A,1x,ES13.7)")  "f =", object%f(c)
        end do
     end if
     write (u, "(1x,A)")  "Partonic phase space: momenta"
     if (object%p_defined) then
        write (u, "(3x,A," // FMT_19 // ")")  "sqrts  = ", object%sqrts_hat
     end if
     write (u, "(1x,A)", advance="no")  "Incoming:"
     if (object%p_defined) then
        write (u, *)
     else
        write (u, "(1x,A)")  "[undefined]"
     end if
     if (allocated (object%p)) then
        do i = 1, size (object%p)
           call vector4_write (object%p(i), u)
        end do
     end if
     write (u, "(1x,A)", advance="no")  "Outgoing:"
     if (object%q_defined) then
        write (u, *)
     else
        write (u, "(1x,A)")  "[undefined]"
     end if
     if (allocated (object%q)) then
        do i = 1, size (object%q)
           call vector4_write (object%q(i), u)
        end do
     end if
     if (object%p_defined .and. .not. object%config%cm_frame) then
        write (u, "(1x,A)")  "Transformation c.m -> lab frame"
        call lorentz_transformation_write (object%lt_cm_to_lab, u)
     end if
   end subroutine phs_base_write
 
 @ %def phs_base_write
 @ Finalizer.  The base type does not need it, but extensions may.
 <<PHS base: phs: TBP>>=
   procedure (phs_final), deferred :: final
 <<PHS base: interfaces>>=
   abstract interface
      subroutine phs_final (object)
        import
        class(phs_t), intent(inout) :: object
      end subroutine phs_final
   end interface
 
 @ %def phs_final
 @ Initializer.  Everything should be contained in the [[process_data]]
 configuration object, so we can require a universal interface.
 <<PHS base: phs: TBP>>=
   procedure (phs_init), deferred :: init
 <<PHS base: interfaces>>=
   abstract interface
      subroutine phs_init (phs, phs_config)
        import
        class(phs_t), intent(out) :: phs
        class(phs_config_t), intent(in), target :: phs_config
      end subroutine phs_init
   end interface
 
 @ %def phs_init
 @ The base version will just allocate the arrays.  It should be called
 at the beginning of the implementation of [[phs_init]].
 <<PHS base: phs: TBP>>=
   procedure :: base_init => phs_base_init
 <<PHS base: procedures>>=
   subroutine phs_base_init (phs, phs_config)
     class(phs_t), intent(out) :: phs
     class(phs_config_t), intent(in), target :: phs_config
     real(default), dimension(phs_config%n_in) :: m_in
     real(default), dimension(phs_config%n_out) :: m_out
     phs%config => phs_config
     allocate (phs%active_channel (phs%config%n_channel))
     phs%active_channel = .true.
     allocate (phs%r (phs%config%n_par, phs%config%n_channel));  phs%r = 0
     allocate (phs%f (phs%config%n_channel));                    phs%f = 0
     allocate (phs%p (phs%config%n_in))
     !!! !!! !!! Workaround for gfortran 5.0 ICE
     m_in  = phs_config%flv(:phs_config%n_in, 1)%get_mass ()
     m_out = phs_config%flv(phs_config%n_in+1:, 1)%get_mass ()
     allocate (phs%m_in  (phs%config%n_in), source = m_in)
     !!! allocate (phs%m_in  (phs%config%n_in), &
     !!!      source = phs_config%flv(:phs_config%n_in, 1)%get_mass ())
     allocate (phs%q (phs%config%n_out))
     allocate (phs%m_out (phs%config%n_out), source = m_out)
     !!! allocate (phs%m_out (phs%config%n_out), &
     !!!      source = phs_config%flv(phs_config%n_in+1:, 1)%get_mass ())
     call phs%compute_flux ()
   end subroutine phs_base_init
 
 @ %def phs_base_init
 @ Manually select a channel.
 <<PHS base: phs: TBP>>=
   procedure :: select_channel => phs_base_select_channel
 <<PHS base: procedures>>=
   subroutine phs_base_select_channel (phs, channel)
     class(phs_t), intent(inout) :: phs
     integer, intent(in), optional :: channel
     if (present (channel)) then
        phs%selected_channel = channel
     else
        phs%selected_channel = 0
     end if
   end subroutine phs_base_select_channel
 
 @ %def phs_base_select_channel
 @ Set incoming momenta.  Assume that array shapes match.  If
 requested, compute the Lorentz transformation from the c.m.\ to the
 lab frame and apply that transformation to the incoming momenta.
 
 In the c.m.\ frame, the sum of three-momenta is zero.  In a scattering
 process, the $z$ axis is the direction of the first beam, the second
 beam is along the negative $z$ axis.  The transformation from the
 c.m.\ to the lab frame is a rotation from the $z$ axis to the boost
 axis followed by a boost, such that the c.m.\ momenta are transformed
 into the lab-frame momenta.  In a decay process, we just boost along
 the flight direction, without rotation.
 <<PHS base: phs: TBP>>=
   procedure :: set_incoming_momenta => phs_set_incoming_momenta
 <<PHS base: procedures>>=
   subroutine phs_set_incoming_momenta (phs, p)
     class(phs_t), intent(inout) :: phs
     type(vector4_t), dimension(:), intent(in) :: p
     type(vector4_t) :: p0, p1
     type(lorentz_transformation_t) :: lt0
     integer :: i
     phs%p = p
     if (phs%config%cm_frame) then
        phs%sqrts_hat = phs%config%sqrts
        phs%p = p
        phs%lt_cm_to_lab = identity
     else
        p0 = sum (p)
        if (phs%config%sqrts_fixed) then
           phs%sqrts_hat = phs%config%sqrts
        else
           phs%sqrts_hat = p0 ** 1
        end if
        lt0 = boost (p0, phs%sqrts_hat)
        select case (phs%config%n_in)
        case (1)
           phs%lt_cm_to_lab = lt0
        case (2)
           p1 = inverse (lt0) * p(1)
           phs%lt_cm_to_lab = lt0 * rotation_to_2nd (3, space_part (p1))
        end select
        phs%p = inverse (phs%lt_cm_to_lab) * p
     end if
     phs%p_defined = .true.
   end subroutine phs_set_incoming_momenta
 
 @ %def phs_set_incoming_momenta
 @ Set outgoing momenta.  Assume that array shapes match.  The incoming
 momenta must be known, so can apply the Lorentz transformation from
 c.m.\ to lab (inverse) to the momenta.
 <<PHS base: phs: TBP>>=
   procedure :: set_outgoing_momenta => phs_set_outgoing_momenta
 <<PHS base: procedures>>=
   subroutine phs_set_outgoing_momenta (phs, q)
     class(phs_t), intent(inout) :: phs
     type(vector4_t), dimension(:), intent(in) :: q
     integer :: i
     if (phs%p_defined) then
        if (phs%config%cm_frame) then
           phs%q = q
        else
           phs%q = inverse (phs%lt_cm_to_lab) * q
        end if
        phs%q_defined = .true.
     end if
   end subroutine phs_set_outgoing_momenta
 
 @ %def phs_set_outgoing_momenta
 @ Return outgoing momenta.  Apply the c.m.\ to lab transformation if
 necessary.
 <<PHS base: phs: TBP>>=
   procedure :: get_outgoing_momenta => phs_get_outgoing_momenta
 <<PHS base: procedures>>=
   subroutine phs_get_outgoing_momenta (phs, q)
     class(phs_t), intent(in) :: phs
     type(vector4_t), dimension(:), intent(out) :: q
     if (phs%p_defined .and. phs%q_defined) then
        if (phs%config%cm_frame) then
           q = phs%q
        else
           q = phs%lt_cm_to_lab * phs%q
        end if
     else
        q = vector4_null
     end if
   end subroutine phs_get_outgoing_momenta
 
 @ %def phs_get_outgoing_momenta
 @
 <<PHS base: phs: TBP>>=
   procedure :: is_cm_frame => phs_is_cm_frame
 <<PHS base: procedures>>=
   function phs_is_cm_frame (phs) result (cm_frame)
     logical :: cm_frame
     class(phs_t), intent(in) :: phs
     cm_frame = phs%config%cm_frame
   end function phs_is_cm_frame
 
 @ %def phs_is_cm_frame
 @
 <<PHS base: phs: TBP>>=
   procedure :: get_n_tot => phs_get_n_tot
 <<PHS base: procedures>>=
   elemental function phs_get_n_tot (phs) result (n_tot)
     integer :: n_tot
     class(phs_t), intent(in) :: phs
     n_tot = phs%config%n_tot
   end function phs_get_n_tot
 
 @ %def phs_get_n_tot
 @
 <<PHS base: phs: TBP>>=
   procedure :: set_lorentz_transformation => phs_set_lorentz_transformation
 <<PHS base: procedures>>=
   subroutine phs_set_lorentz_transformation (phs, lt)
     class(phs_t), intent(inout) :: phs
     type(lorentz_transformation_t), intent(in) :: lt
     phs%lt_cm_to_lab = lt
   end subroutine phs_set_lorentz_transformation
 
 @ %def phs_set_lorentz_transformation
 @
 <<PHS base: phs: TBP>>=
   procedure :: get_lorentz_transformation => phs_get_lorentz_transformation
 <<PHS base: procedures>>=
   function phs_get_lorentz_transformation (phs) result (lt)
     type(lorentz_transformation_t) :: lt
     class(phs_t), intent(in) :: phs
     lt = phs%lt_cm_to_lab
   end function phs_get_lorentz_transformation
 
 @ %def phs_get_lorentz_transformation
 @ Return the input parameter array for a channel.
 <<PHS base: phs: TBP>>=
   procedure :: get_mcpar => phs_get_mcpar
 <<PHS base: procedures>>=
   subroutine phs_get_mcpar (phs, c, r)
     class(phs_t), intent(in) :: phs
     integer, intent(in) :: c
     real(default), dimension(:), intent(out) :: r
     if (phs%r_defined) then
        r = phs%r(:,c)
     else
        r = 0
     end if
   end subroutine phs_get_mcpar
 
 @ %def phs_get_mcpar
 @ Return the Jacobian factor for a channel.
 <<PHS base: phs: TBP>>=
   procedure :: get_f => phs_get_f
 <<PHS base: procedures>>=
   function phs_get_f (phs, c) result (f)
     class(phs_t), intent(in) :: phs
     integer, intent(in) :: c
     real(default) :: f
     if (phs%r_defined) then
        f = phs%f(c)
     else
        f = 0
     end if
   end function phs_get_f
 
 @ %def phs_get_f
 @ Return the overall factor, which is the product of the flux factor for the
 incoming partons and the phase-space volume for the outgoing partons.
 <<PHS base: phs: TBP>>=
   procedure :: get_overall_factor => phs_get_overall_factor
 <<PHS base: procedures>>=
   function phs_get_overall_factor (phs) result (f)
     class(phs_t), intent(in) :: phs
     real(default) :: f
     f = phs%flux * phs%volume
   end function phs_get_overall_factor
 
 @ %def phs_get_overall_factor
 @ Compute flux factor.  We do this during initialization (when the
 incoming momenta [[p]] are undefined), unless [[sqrts]] is variable.  We do
 this again once for each phase-space point, but then we skip the calculation
 if [[sqrts]] is fixed.
 
 There are three different flux factors.
 \begin{enumerate}
 \item
   For a decaying massive particle, the factor is
   \begin{equation}
     f = (2\pi)^4 / (2M)
   \end{equation}
 \item
   For a $2\to n$ scattering process with $n>1$, the factor is
   \begin{equation}
     f = (2\pi)^4 / (2\sqrt{\lambda})
   \end{equation}
   where for massless incoming particles, $\sqrt{\lambda} = s$.
 \item For a $2\to 1$ on-shell production process, the factor includes
   an extra $1/(2\pi)^3$ factor and a $1/m^2$ factor from the
   phase-space delta function $\delta (x_1x_2 - m^2/s)$, which
   originate from the one-particle phase space that we integrate out.
   \begin{equation}
     f = 2\pi / (2s m^2)
   \end{equation}
   The delta function is handled by the structure-function
   parameterization.
 \end{enumerate}
 <<PHS base: phs: TBP>>=
   procedure :: compute_flux => phs_compute_flux
 <<PHS base: procedures>>=
   subroutine phs_compute_flux (phs)
     class(phs_t), intent(inout) :: phs
     real(default) :: s_hat, lda
     select case (phs%config%n_in)
     case (1)
        if (.not. phs%p_defined) then
           phs%flux = twopi4 / (2 * phs%m_in(1))
        end if
     case (2)
        if (phs%p_defined) then
           if (phs%config%sqrts_fixed) then
              return
           else
              s_hat = sum (phs%p) ** 2
           end if
        else
           if (phs%config%sqrts_fixed) then
              s_hat = phs%config%sqrts ** 2
           else
              return
           end if
        end if
        select case (phs%config%n_out)
        case (2:)
           lda = lambda (s_hat, phs%m_in(1) ** 2, phs%m_in(2) ** 2)
           if (lda > 0) then
              phs%flux = conv * twopi4 / (2 * sqrt (lda))
           else
              phs%flux = 0
           end if
        case (1)
           phs%flux = conv * twopi &
                / (2 * phs%config%sqrts ** 2 * phs%m_out(1) ** 2)
        case default
           phs%flux = 0
        end select
     end select
   end subroutine phs_compute_flux
 
 @ %def phs_compute_flux
 @ Evaluate the phase-space point for a particular channel and compute momenta,
 Jacobian, and phase-space volume. This is, of course, deferred to
 the implementation.
 <<PHS base: phs: TBP>>=
   procedure (phs_evaluate_selected_channel), deferred :: &
        evaluate_selected_channel
 <<PHS base: interfaces>>=
   abstract interface
      subroutine phs_evaluate_selected_channel (phs, c_in, r_in)
        import
        class(phs_t), intent(inout) :: phs
        integer, intent(in) :: c_in
        real(default), dimension(:), intent(in) :: r_in
      end subroutine phs_evaluate_selected_channel
   end interface
 
 @ %def phs_evaluate_selected_channel
 @ Compute the inverse mappings to completely fill the [[r]] and [[f]] arrays,
 for the non-selected channels.
 <<PHS base: phs: TBP>>=
   procedure (phs_evaluate_other_channels), deferred :: &
        evaluate_other_channels
 <<PHS base: interfaces>>=
   abstract interface
      subroutine phs_evaluate_other_channels (phs, c_in)
        import
        class(phs_t), intent(inout) :: phs
        integer, intent(in) :: c_in
      end subroutine phs_evaluate_other_channels
   end interface
 
 @ %def phs_evaluate_other_channels
 @ Inverse evaluation.  If all momenta are known, we compute the
 inverse mappings to fill the [[r]] and [[f]] arrays.
 <<PHS base: phs: TBP>>=
   procedure (phs_inverse), deferred :: inverse
 <<PHS base: interfaces>>=
   abstract interface
      subroutine phs_inverse (phs)
        import
        class(phs_t), intent(inout) :: phs
      end subroutine phs_inverse
   end interface
 
 @ %def phs_inverse
 @
 <<PHS base: phs: TBP>>=
   procedure :: get_sqrts => phs_get_sqrts
 <<PHS base: procedures>>=
   function phs_get_sqrts (phs) result (sqrts)
     real(default) :: sqrts
     class(phs_t), intent(in) :: phs
     sqrts = phs%config%sqrts
   end function phs_get_sqrts
 
 @ %def phs_get_sqrts
 @
 \subsubsection{Uniform angular distribution}
 These procedures implement the uniform angular distribution, generated
 from two parameters $x_1$ and $x_2$:
 \begin{equation}
   \cos\theta = 1 - 2x_1, \qquad \phi = 2\pi x_2
 \end{equation}
 We generate a rotation (Lorentz transformation) which rotates the
 positive $z$ axis into this point on the unit sphere.  This rotation
 is applied to the [[p]] momenta, which are assumed to be
 back-to-back, on-shell, and with the correct mass.
 
 We do not compute a Jacobian (constant).  The uniform distribution is
 assumed to be normalized.
 <<PHS base: public>>=
   public :: compute_kinematics_solid_angle
 <<PHS base: procedures>>=
   subroutine compute_kinematics_solid_angle (p, q, x)
     type(vector4_t), dimension(2), intent(in) :: p
     type(vector4_t), dimension(2), intent(out) :: q
     real(default), dimension(2), intent(in) :: x
     real(default) :: ct, st, phi
     type(lorentz_transformation_t) :: rot
     integer :: i
     ct = 1 - 2*x(1)
     st = sqrt (1 - ct**2)
     phi = twopi * x(2)
     rot = rotation (phi, 3) * rotation (ct, st, 2)
     do i = 1, 2
        q(i) = rot * p(i)
     end do
   end subroutine compute_kinematics_solid_angle
 
 @ %def compute_kinematics_solid_angle
 @ This is the inverse transformation.  We assume that the outgoing
 momenta are rotated versions of the incoming momenta, back-to-back.
 Thus, we determine the angles from $q(1)$ alone.  [[p]] is unused.
 <<PHS base: public>>=
   public :: inverse_kinematics_solid_angle
 <<PHS base: procedures>>=
   subroutine inverse_kinematics_solid_angle (p, q, x)
     type(vector4_t), dimension(:), intent(in) :: p
     type(vector4_t), dimension(2), intent(in) :: q
     real(default), dimension(2), intent(out) :: x
     real(default) :: ct, phi
     ct = polar_angle_ct (q(1))
     phi = azimuthal_angle (q(1))
     x(1) = (1 - ct) / 2
     x(2) = phi / twopi
   end subroutine inverse_kinematics_solid_angle
 
 @ %def inverse_kinematics_solid_angle
 @
 \subsection{Auxiliary stuff}
 The [[pacify]] subroutine, which is provided by the Lorentz module,
 has the purpose of setting numbers to zero which are (by comparing
 with a [[tolerance]] parameter) considered equivalent with zero.  This
 is useful for numerical checks.
 <<PHS base: public>>=
   public :: pacify
 <<PHS base: interfaces>>=
   interface pacify
      module procedure pacify_phs
   end interface pacify
 
 <<PHS base: procedures>>=
   subroutine pacify_phs (phs)
     class(phs_t), intent(inout) :: phs
     if (phs%p_defined) then
        call pacify (phs%p, 30 * epsilon (1._default) * phs%config%sqrts)
        call pacify (phs%lt_cm_to_lab, 30 * epsilon (1._default))
     end if
     if (phs%q_defined) then
        call pacify (phs%q, 30 * epsilon (1._default) * phs%config%sqrts)
     end if
   end subroutine pacify_phs
 
 @ %def pacify
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[phs_base_ut.f90]]>>=
 <<File header>>
 
 module phs_base_ut
   use unit_tests
   use phs_base_uti
 
 <<Standard module head>>
 
 <<PHS base: public test>>
 
 <<PHS base: public test auxiliary>>
 
 contains
 
 <<PHS base: test driver>>
 
 end module phs_base_ut
 @ %def phs_base_ut
 @
 <<[[phs_base_uti.f90]]>>=
 <<File header>>
 
 module phs_base_uti
 
 <<Use kinds>>
 <<Use strings>>
   use diagnostics
   use io_units
   use format_defs, only: FMT_19
   use physics_defs, only: BORN
   use lorentz
   use flavors
   use model_data
   use process_constants
 
   use phs_base
 
 <<Standard module head>>
 
 <<PHS base: public test auxiliary>>
 
 <<PHS base: test declarations>>
 
 <<PHS base: test types>>
 
 contains
 
 <<PHS base: tests>>
 
 <<PHS base: test auxiliary>>
 
 end module phs_base_uti
 @ %def phs_base_ut
 @ API: driver for the unit tests below.
 <<PHS base: public test>>=
   public :: phs_base_test
 <<PHS base: test driver>>=
   subroutine phs_base_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<PHS base: execute tests>>
   end subroutine phs_base_test
 
 @ %def phs_base_test
 @
 \subsubsection{Test process data}
 We provide a procedure that initializes a test case for the process
 constants.  This set of process data contains just the minimal
 contents that we need for the phase space.  The rest is left
 uninitialized.
 <<PHS base: public test auxiliary>>=
   public :: init_test_process_data
 <<PHS base: test auxiliary>>=
   subroutine init_test_process_data (id, data)
     type(process_constants_t), intent(out) :: data
     type(string_t), intent(in), optional :: id
     if (present (id)) then
        data%id = id
     else
        data%id = "testproc"
     end if
     data%model_name = "Test"
     data%n_in = 2
     data%n_out = 2
     data%n_flv = 1
     allocate (data%flv_state (data%n_in + data%n_out, data%n_flv))
     data%flv_state = 25
   end subroutine init_test_process_data
 
 @ %def init_test_process_data
 @ This is the variant for a decay process.
 <<PHS base: public test auxiliary>>=
   public :: init_test_decay_data
 <<PHS base: test auxiliary>>=
   subroutine init_test_decay_data (id, data)
     type(process_constants_t), intent(out) :: data
     type(string_t), intent(in), optional :: id
     if (present (id)) then
        data%id = id
     else
        data%id = "testproc"
     end if
     data%model_name = "Test"
     data%n_in = 1
     data%n_out = 2
     data%n_flv = 1
     allocate (data%flv_state (data%n_in + data%n_out, data%n_flv))
     data%flv_state(:,1) = [25, 6, -6]
   end subroutine init_test_decay_data
 
 @ %def init_test_decay_data
 @
 \subsubsection{Test kinematics configuration}
 This is a trivial implementation of the [[phs_config_t]] configuration object.
 <<PHS base: public test auxiliary>>=
   public :: phs_test_config_t
 <<PHS base: test types>>=
   type, extends (phs_config_t) :: phs_test_config_t
      logical :: create_equivalences = .false.
    contains
      procedure :: final => phs_test_config_final
      procedure :: write => phs_test_config_write
      procedure :: configure => phs_test_config_configure
      procedure :: startup_message => phs_test_config_startup_message
      procedure, nopass :: allocate_instance => phs_test_config_allocate_instance
   end type phs_test_config_t
 
 @ %def phs_test_config_t
 @ The finalizer is empty.
 <<PHS base: test auxiliary>>=
   subroutine phs_test_config_final (object)
     class(phs_test_config_t), intent(inout) :: object
   end subroutine phs_test_config_final
 
 @ %def phs_test_config_final
 @ The [[cm_frame]] parameter is not tested here; we defer this to the
 [[phs_single]] implementation.
 <<PHS base: test auxiliary>>=
   subroutine phs_test_config_write (object, unit, include_id)
     class(phs_test_config_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: include_id
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Partonic phase-space configuration:"
     call object%base_write (unit)
   end subroutine phs_test_config_write
 
   subroutine phs_test_config_configure (phs_config, sqrts, &
        sqrts_fixed, cm_frame, azimuthal_dependence, rebuild, &
        ignore_mismatch, nlo_type, subdir)
     class(phs_test_config_t), intent(inout) :: phs_config
     real(default), intent(in) :: sqrts
     logical, intent(in), optional :: sqrts_fixed
     logical, intent(in), optional :: cm_frame
     logical, intent(in), optional :: azimuthal_dependence
     logical, intent(in), optional :: rebuild
     logical, intent(in), optional :: ignore_mismatch
     integer, intent(in), optional :: nlo_type
     type(string_t), intent(in), optional :: subdir
     phs_config%n_channel = 2
     phs_config%n_par = 2
     phs_config%sqrts = sqrts
     if (.not. present (nlo_type)) &
       phs_config%nlo_type = BORN
     if (present (sqrts_fixed)) then
        phs_config%sqrts_fixed = sqrts_fixed
     end if
     if (present (cm_frame)) then
        phs_config%cm_frame = cm_frame
     end if
     if (present (azimuthal_dependence)) then
        phs_config%azimuthal_dependence = azimuthal_dependence
     end if
     if (allocated (phs_config%channel))  deallocate (phs_config%channel)
     allocate (phs_config%channel (phs_config%n_channel))
     if (phs_config%create_equivalences) then
        call setup_test_equivalences (phs_config)
        call setup_test_channel_props (phs_config)
     end if
     call phs_config%compute_md5sum ()
   end subroutine phs_test_config_configure
 
 @ %def phs_test_config_write
 @ %def phs_test_config_configure
 @ If requested, we make up an arbitrary set of equivalences.
 <<PHS base: test auxiliary>>=
   subroutine setup_test_equivalences (phs_config)
     class(phs_test_config_t), intent(inout) :: phs_config
     integer :: i
     associate (channel => phs_config%channel(1))
       allocate (channel%eq (2))
       do i = 1, size (channel%eq)
          call channel%eq(i)%init (phs_config%n_par)
       end do
       associate (eq => channel%eq(1))
         eq%c = 1;  eq%perm = [1, 2];  eq%mode = [EQ_IDENTITY, EQ_SYMMETRIC]
       end associate
       associate (eq => channel%eq(2))
         eq%c = 2;  eq%perm = [2, 1];  eq%mode = [EQ_INVARIANT, EQ_IDENTITY]
       end associate
     end associate
   end subroutine setup_test_equivalences
 
 @ %def setup_test_equivalences
 @ Ditto, for channel properties.
 <<PHS base: test auxiliary>>=
   subroutine setup_test_channel_props (phs_config)
     class(phs_test_config_t), intent(inout) :: phs_config
     associate (channel => phs_config%channel(2))
       call channel%set_resonant (140._default, 3.1415_default)
     end associate
   end subroutine setup_test_channel_props
 
 @ %def setup_test_channel_props
 @ Startup message
 <<PHS base: test auxiliary>>=
   subroutine phs_test_config_startup_message (phs_config, unit)
     class(phs_test_config_t), intent(in) :: phs_config
     integer, intent(in), optional :: unit
     call phs_config%base_startup_message (unit)
     write (msg_buffer, "(A)") "Phase space: Test"
     call msg_message (unit = unit)
   end subroutine phs_test_config_startup_message
 
 @ %def phs_test_config_startup_message
 @ The instance type that matches [[phs_test_config_t]] is [[phs_test_t]].
 <<PHS base: test auxiliary>>=
   subroutine phs_test_config_allocate_instance (phs)
     class(phs_t), intent(inout), pointer :: phs
     allocate (phs_test_t :: phs)
   end subroutine phs_test_config_allocate_instance
 
 @ %def phs_test_config_allocate_instance
 @
 \subsubsection{Test kinematics implementation}
 This implementation of kinematics generates a simple two-particle
 configuration from the incoming momenta.  The incoming momenta must be
 in the c.m.\ system, all masses equal.
 
 There are two channels: one generates $\cos\theta$ and $\phi$
 uniformly, in the other channel we map the $r_1$ parameter which
 belongs to $\cos\theta$.
 
 We should store the mass parameter that we need.
 <<PHS base: public test auxiliary>>=
   public :: phs_test_t
 <<PHS base: test types>>=
   type, extends (phs_t) :: phs_test_t
      real(default) :: m = 0
      real(default), dimension(:), allocatable :: x
    contains
    <<PHS base: phs test: TBP>>
   end type phs_test_t
 
 @ %def phs_test_t
 @ Output.  The specific data are displayed only if [[verbose]] is set.
 <<PHS base: phs test: TBP>>=
   procedure :: write => phs_test_write
 <<PHS base: test auxiliary>>=
   subroutine phs_test_write (object, unit, verbose)
     class(phs_test_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     logical :: verb
     u = given_output_unit (unit)
     verb = .false.;  if (present (verbose))  verb = verbose
     if (verb) then
        write (u, "(1x,A)")  "Partonic phase space: data"
        write (u, "(3x,A," // FMT_19 // ")")  "m = ", object%m
     end if
     call object%base_write (u)
   end subroutine phs_test_write
 
 @ %def phs_test_write
 @ The finalizer is empty.
 <<PHS base: phs test: TBP>>=
   procedure :: final => phs_test_final
 <<PHS base: test auxiliary>>=
   subroutine phs_test_final (object)
     class(phs_test_t), intent(inout) :: object
   end subroutine phs_test_final
 
 @ %def phs_test_final
 @ Initialization: set the mass value.
 <<PHS base: phs test: TBP>>=
   procedure :: init => phs_test_init
 <<PHS base: test auxiliary>>=
   subroutine phs_test_init (phs, phs_config)
     class(phs_test_t), intent(out) :: phs
     class(phs_config_t), intent(in), target :: phs_config
     call phs%base_init (phs_config)
     phs%m = phs%config%flv(1,1)%get_mass ()
     allocate (phs%x (phs_config%n_par), source = 0._default)
   end subroutine phs_test_init
 
 @ %def phs_test_init
 @ Evaluation.  In channel 1, we uniformly generate $\cos\theta$ and
 $\phi$, with Jacobian normalized to one.  In channel 2, we prepend a
 mapping $r_1 \to r_1^(1/3)$ with Jacobian $f=3r_1^2$.
 
 The component [[x]] is allocated in the first subroutine, used and deallocated
 in the second one.
 <<PHS base: phs test: TBP>>=
   procedure :: evaluate_selected_channel => phs_test_evaluate_selected_channel
   procedure :: evaluate_other_channels => phs_test_evaluate_other_channels
 <<PHS base: test auxiliary>>=
   subroutine phs_test_evaluate_selected_channel (phs, c_in, r_in)
     class(phs_test_t), intent(inout) :: phs
     integer, intent(in) :: c_in
     real(default), intent(in), dimension(:) :: r_in
     if (phs%p_defined) then
        call phs%select_channel (c_in)
        phs%r(:,c_in) = r_in
        select case (c_in)
        case (1)
           phs%x = r_in
        case (2)
           phs%x(1) = r_in(1) ** (1 / 3._default)
           phs%x(2) = r_in(2)
        end select
        call compute_kinematics_solid_angle (phs%p, phs%q, phs%x)
        phs%volume = 1
        phs%q_defined = .true.
     end if
   end subroutine phs_test_evaluate_selected_channel
 
   subroutine phs_test_evaluate_other_channels (phs, c_in)
     class(phs_test_t), intent(inout) :: phs
     integer, intent(in) :: c_in
     integer :: c, n_channel
     if (phs%p_defined) then
        n_channel = phs%config%n_channel
        do c = 1, n_channel
           if (c /= c_in) then
              call inverse_kinematics_solid_angle (phs%p, phs%q, phs%x)
              select case (c)
              case (1)
                 phs%r(:,c) = phs%x
              case (2)
                 phs%r(1,c) = phs%x(1) ** 3
                 phs%r(2,c) = phs%x(2)
              end select
           end if
        end do
        phs%f(1) = 1
        if (phs%r(1,2) /= 0) then
           phs%f(2) = 1 / (3 * phs%r(1,2) ** (2/3._default))
        else
           phs%f(2) = 0
        end if
        phs%r_defined = .true.
     end if
   end subroutine phs_test_evaluate_other_channels
 
 @ %def phs_test_evaluate_selected_channels
 @ %def phs_test_evaluate_other_channels
 @ Inverse evaluation.
 <<PHS base: phs test: TBP>>=
   procedure :: inverse => phs_test_inverse
 <<PHS base: test auxiliary>>=
   subroutine phs_test_inverse (phs)
     class(phs_test_t), intent(inout) :: phs
     integer :: c, n_channel
     real(default), dimension(:), allocatable :: x
     if (phs%p_defined .and. phs%q_defined) then
        call phs%select_channel ()
        n_channel = phs%config%n_channel
        allocate (x (phs%config%n_par))
        do c = 1, n_channel
           call inverse_kinematics_solid_angle (phs%p, phs%q, x)
           select case (c)
           case (1)
              phs%r(:,c) = x
           case (2)
              phs%r(1,c) = x(1) ** 3
              phs%r(2,c) = x(2)
           end select
        end do
        phs%f(1) = 1
        if (phs%r(1,2) /= 0) then
           phs%f(2) = 1 / (3 * phs%r(1,2) ** (2/3._default))
        else
           phs%f(2) = 0
        end if
        phs%volume = 1
        phs%r_defined = .true.
     end if
   end subroutine phs_test_inverse
 
 @ %def phs_test_inverse
 @
 \subsubsection{Phase-space configuration data}
 Construct and display a test phase-space configuration object.
 <<PHS base: execute tests>>=
   call test (phs_base_1, "phs_base_1", &
        "phase-space configuration", &
        u, results)
 <<PHS base: test declarations>>=
   public :: phs_base_1
 <<PHS base: tests>>=
   subroutine phs_base_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(process_constants_t) :: process_data
     class(phs_config_t), allocatable :: phs_data
 
     write (u, "(A)")  "* Test output: phs_base_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &test phase-space configuration data"
     write (u, "(A)")
 
     call model%init_test ()
 
     write (u, "(A)")  "* Initialize a process and a matching &
          &phase-space configuration"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_base_1"), process_data)
 
     allocate (phs_test_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     call phs_data%write (u)
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_base_1"
 
   end subroutine phs_base_1
 
 @ %def phs_base_1
 @
 \subsubsection{Phase space evaluation}
 Compute kinematics for given parameters, also invert the calculation.
 <<PHS base: execute tests>>=
   call test (phs_base_2, "phs_base_2", &
        "phase-space evaluation", &
        u, results)
 <<PHS base: test declarations>>=
   public :: phs_base_2
 <<PHS base: tests>>=
   subroutine phs_base_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(process_constants_t) :: process_data
     real(default) :: sqrts, E
     class(phs_config_t), allocatable, target :: phs_data
     class(phs_t), pointer :: phs => null ()
     type(vector4_t), dimension(2) :: p, q
 
     write (u, "(A)")  "* Test output: phs_base_2"
     write (u, "(A)")  "*   Purpose: test simple two-channel phase space"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
 
     write (u, "(A)")  "* Initialize a process and a matching &
          &phase-space configuration"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_base_2"), process_data)
 
     allocate (phs_test_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     sqrts = 1000._default
     call phs_data%configure (sqrts)
 
     call phs_data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize the phase-space instance"
     write (u, "(A)")
 
     call phs_data%allocate_instance (phs)
     select type (phs)
     type is (phs_test_t)
        call phs%init (phs_data)
     end select
 
     call phs%write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Set incoming momenta"
     write (u, "(A)")
 
     E = sqrts / 2
     p(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     p(2) = vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
     call phs%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute phase-space point in channel 1 &
          &for x = 0.5, 0.125"
     write (u, "(A)")
 
     call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
     call phs%evaluate_other_channels (1)
     call phs%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute phase-space point in channel 2 &
          &for x = 0.125, 0.125"
     write (u, "(A)")
 
     call phs%evaluate_selected_channel (2, [0.125_default, 0.125_default])
     call phs%evaluate_other_channels (2)
     call phs%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Inverse kinematics"
     write (u, "(A)")
 
     call phs%get_outgoing_momenta (q)
     deallocate (phs)
     call phs_data%allocate_instance (phs)
     call phs%init (phs_data)
 
     sqrts = 1000._default
     select type (phs_data)
     type is (phs_test_config_t)
        call phs_data%configure (sqrts)
     end select
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
     call phs%set_outgoing_momenta (q)
 
     call phs%inverse ()
     call phs%write (u)
 
     call phs%final ()
     deallocate (phs)
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_base_2"
 
   end subroutine phs_base_2
 
 @ %def phs_base_2
 @
 \subsubsection{Phase-space equivalences}
 Construct a test phase-space configuration which contains channel
 equivalences.
 <<PHS base: execute tests>>=
   call test (phs_base_3, "phs_base_3", &
        "channel equivalences", &
        u, results)
 <<PHS base: test declarations>>=
   public :: phs_base_3
 <<PHS base: tests>>=
   subroutine phs_base_3 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(process_constants_t) :: process_data
     class(phs_config_t), allocatable :: phs_data
 
     write (u, "(A)")  "* Test output: phs_base_3"
     write (u, "(A)")  "*   Purpose: construct phase-space configuration data &
          &with equivalences"
     write (u, "(A)")
 
     call model%init_test ()
 
     write (u, "(A)")  "* Initialize a process and a matching &
          &phase-space configuration"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_base_3"), process_data)
 
     allocate (phs_test_config_t :: phs_data)
     call phs_data%init (process_data, model)
     select type (phs_data)
     type is (phs_test_config_t)
        phs_data%create_equivalences = .true.
     end select
 
     call phs_data%configure (1000._default)
     call phs_data%write (u)
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_base_3"
 
   end subroutine phs_base_3
 
 @ %def phs_base_3
 @
 \subsubsection{MD5 sum checks}
 Construct a test phase-space configuration, compute and compare MD5 sums.
 <<PHS base: execute tests>>=
   call test (phs_base_4, "phs_base_4", &
        "MD5 sum", &
        u, results)
 <<PHS base: test declarations>>=
   public :: phs_base_4
 <<PHS base: tests>>=
   subroutine phs_base_4 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(process_constants_t) :: process_data
     class(phs_config_t), allocatable :: phs_data
 
     write (u, "(A)")  "* Test output: phs_base_4"
     write (u, "(A)")  "*   Purpose: compute and compare MD5 sums"
     write (u, "(A)")
 
     call model%init_test ()
 
     write (u, "(A)")  "* Model parameters"
     write (u, "(A)")
 
     call model%write (unit = u, &
          show_parameters = .true., &
          show_particles = .false., show_vertices = .false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize a process and a matching &
          &phase-space configuration"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_base_4"), process_data)
     process_data%md5sum = "test_process_data_m6sum_12345678"
 
     allocate (phs_test_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     call phs_data%compute_md5sum ()
     call phs_data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Modify model parameter"
     write (u, "(A)")
 
     call model%set_par (var_str ("ms"), 100._default)
     call model%write (show_parameters = .true., &
          show_particles = .false., show_vertices = .false.)
 
     write (u, "(A)")
     write (u, "(A)")  "* PHS configuration"
     write (u, "(A)")
 
     call phs_data%compute_md5sum ()
     call phs_data%write (u)
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_base_4"
 
   end subroutine phs_base_4
 
 @ %def phs_base_4
 @
 \subsubsection{Phase-space channel collection}
 Set up an array of various phase-space channels and collect them in a list.
 <<PHS base: execute tests>>=
   call test (phs_base_5, "phs_base_5", &
        "channel collection", &
        u, results)
 <<PHS base: test declarations>>=
   public :: phs_base_5
 <<PHS base: tests>>=
   subroutine phs_base_5 (u)
     integer, intent(in) :: u
     type(phs_channel_t), dimension(:), allocatable :: channel
     type(phs_channel_collection_t) :: coll
     integer :: i, n
 
     write (u, "(A)")  "* Test output: phs_base_5"
     write (u, "(A)")  "*   Purpose: collect channel properties"
     write (u, "(A)")
 
     write (u, "(A)")  "* Set up an array of channels"
     write (u, "(A)")
 
     n = 6
 
     allocate (channel (n))
     call channel(2)%set_resonant (75._default, 3._default)
     call channel(4)%set_resonant (130._default, 1._default)
     call channel(5)%set_resonant (75._default, 3._default)
     call channel(6)%set_on_shell (33._default)
 
     do i = 1, n
        write (u, "(1x,I0)", advance="no")  i
        call channel(i)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Collect distinct properties"
     write (u, "(A)")
 
     do i = 1, n
        call coll%push (channel(i))
     end do
 
     write (u, "(1x,A,I0)")  "n = ", coll%get_n ()
     write (u, "(A)")
 
     call coll%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Channel array with collection index assigned"
     write (u, "(A)")
 
     do i = 1, n
        write (u, "(1x,I0)", advance="no")  i
        call channel(i)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call coll%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_base_5"
 
   end subroutine phs_base_5
 
 @ %def phs_base_5
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \clearpage
 \section{Dummy phase space}
 
 This module implements a dummy phase space module for cases where the
 program structure demands the existence of a phase-space module, but
 no phase space integration is performed.
 
 <<[[phs_none.f90]]>>=
 <<File header>>
 
 module phs_none
 
 <<Use kinds>>
 <<Use strings>>
   use io_units, only: given_output_unit
   use diagnostics, only: msg_message, msg_fatal
   use phs_base, only: phs_config_t, phs_t
 
 <<Standard module head>>
 
 <<PHS none: public>>
 
 <<PHS none: types>>
 
 contains
 
 <<PHS none: procedures>>
 
 end module phs_none
 @ %def phs_none
 @
 \subsection{Configuration}
 Nothing to configure, but we provide the type and methods.
 <<PHS none: public>>=
   public :: phs_none_config_t
 <<PHS none: types>>=
   type, extends (phs_config_t) :: phs_none_config_t
   contains
   <<PHS none: phs none config: TBP>>
   end type phs_none_config_t
 
 @ %def phs_none_config_t
 @ The finalizer is empty.
 <<PHS none: phs none config: TBP>>=
   procedure :: final => phs_none_config_final
 <<PHS none: procedures>>=
   subroutine phs_none_config_final (object)
     class(phs_none_config_t), intent(inout) :: object
   end subroutine phs_none_config_final
 
 @ %def phs_none_final
 @ Output.  No contents, just an informative line.
 <<PHS none: phs none config: TBP>>=
   procedure :: write => phs_none_config_write
 <<PHS none: procedures>>=
   subroutine phs_none_config_write (object, unit, include_id)
     class(phs_none_config_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: include_id
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Partonic phase-space configuration: non-functional dummy"
   end subroutine phs_none_config_write
 
 @ %def phs_none_config_write
 @ Configuration: we have to implement this method, but it obviously does nothing.
 <<PHS none: phs none config: TBP>>=
   procedure :: configure => phs_none_config_configure
 <<PHS none: procedures>>=
   subroutine phs_none_config_configure (phs_config, sqrts, &
        sqrts_fixed, cm_frame, azimuthal_dependence, rebuild, ignore_mismatch, &
        nlo_type, subdir)
     class(phs_none_config_t), intent(inout) :: phs_config
     real(default), intent(in) :: sqrts
     logical, intent(in), optional :: sqrts_fixed
     logical, intent(in), optional :: cm_frame
     logical, intent(in), optional :: azimuthal_dependence
     logical, intent(in), optional :: rebuild
     logical, intent(in), optional :: ignore_mismatch
     integer, intent(in), optional :: nlo_type
     type(string_t), intent(in), optional :: subdir
   end subroutine phs_none_config_configure
 
 @ %def phs_none_config_configure
 @ Startup message, after configuration is complete.
 <<PHS none: phs none config: TBP>>=
   procedure :: startup_message => phs_none_config_startup_message
 <<PHS none: procedures>>=
   subroutine phs_none_config_startup_message (phs_config, unit)
     class(phs_none_config_t), intent(in) :: phs_config
     integer, intent(in), optional :: unit
     call msg_message ("Phase space: none")
   end subroutine phs_none_config_startup_message
 
 @ %def phs_none_config_startup_message
 @ Allocate an instance: the actual phase-space object.
 <<PHS none: phs none config: TBP>>=
   procedure, nopass :: allocate_instance => phs_none_config_allocate_instance
 <<PHS none: procedures>>=
   subroutine phs_none_config_allocate_instance (phs)
     class(phs_t), intent(inout), pointer :: phs
     allocate (phs_none_t :: phs)
   end subroutine phs_none_config_allocate_instance
 
 @ %def phs_none_config_allocate_instance
 @
 \subsection{Kinematics implementation}
 This is considered as empty, but we have to implement the minimal set of methods.
 <<PHS none: public>>=
   public :: phs_none_t
 <<PHS none: types>>=
   type, extends (phs_t) :: phs_none_t
    contains
    <<PHS none: phs none: TBP>>
   end type phs_none_t
 
 @ %def phs_none_t
 @ Output.
 <<PHS none: phs none: TBP>>=
   procedure :: write => phs_none_write
 <<PHS none: procedures>>=
   subroutine phs_none_write (object, unit, verbose)
     class(phs_none_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     u = given_output_unit (unit)
     write (u, "(A)")  "Partonic phase space: none"
   end subroutine phs_none_write
 
 @ %def phs_none_write
 @ The finalizer is empty.
 <<PHS none: phs none: TBP>>=
   procedure :: final => phs_none_final
 <<PHS none: procedures>>=
   subroutine phs_none_final (object)
     class(phs_none_t), intent(inout) :: object
   end subroutine phs_none_final
 
 @ %def phs_none_final
 @ Initialization, trivial.
 <<PHS none: phs none: TBP>>=
   procedure :: init => phs_none_init
 <<PHS none: procedures>>=
   subroutine phs_none_init (phs, phs_config)
     class(phs_none_t), intent(out) :: phs
     class(phs_config_t), intent(in), target :: phs_config
     call phs%base_init (phs_config)
   end subroutine phs_none_init
 
 @ %def phs_none_init
 @ Evaluation.  This must not be called at all.
 <<PHS none: phs none: TBP>>=
   procedure :: evaluate_selected_channel => phs_none_evaluate_selected_channel
   procedure :: evaluate_other_channels => phs_none_evaluate_other_channels
 <<PHS none: procedures>>=
   subroutine phs_none_evaluate_selected_channel (phs, c_in, r_in)
     class(phs_none_t), intent(inout) :: phs
     integer, intent(in) :: c_in
     real(default), intent(in), dimension(:) :: r_in
     call msg_fatal ("Phase space: attempt to evaluate with the 'phs_none' method")
   end subroutine phs_none_evaluate_selected_channel
 
   subroutine phs_none_evaluate_other_channels (phs, c_in)
     class(phs_none_t), intent(inout) :: phs
     integer, intent(in) :: c_in
   end subroutine phs_none_evaluate_other_channels
 
 @ %def phs_none_evaluate_selected_channel
 @ %def phs_none_evaluate_other_channels
 @ Inverse evaluation, likewise.
 <<PHS none: phs none: TBP>>=
   procedure :: inverse => phs_none_inverse
 <<PHS none: procedures>>=
   subroutine phs_none_inverse (phs)
     class(phs_none_t), intent(inout) :: phs
     call msg_fatal ("Phase space: attempt to evaluate inverse with the 'phs_none' method")
   end subroutine phs_none_inverse
 
 @ %def phs_none_inverse
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[phs_none_ut.f90]]>>=
 <<File header>>
 
 module phs_none_ut
   use unit_tests
   use phs_none_uti
 
 <<Standard module head>>
 
 <<PHS none: public test>>
 
 contains
 
 <<PHS none: test driver>>
 
 end module phs_none_ut
 @ %def phs_none_ut
 @
 <<[[phs_none_uti.f90]]>>=
 <<File header>>
 
 module phs_none_uti
 
 <<Use kinds>>
 <<Use strings>>
   use flavors
   use lorentz
   use model_data
   use process_constants
   use phs_base
 
   use phs_none
 
   use phs_base_ut, only: init_test_process_data, init_test_decay_data
 
 <<Standard module head>>
 
 <<PHS none: test declarations>>
 
 contains
 
 <<PHS none: tests>>
 
 end module phs_none_uti
 @ %def phs_none_ut
 @ API: driver for the unit tests below.
 <<PHS none: public test>>=
   public :: phs_none_test
 <<PHS none: test driver>>=
   subroutine phs_none_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<PHS none: execute tests>>
   end subroutine phs_none_test
 
 @ %def phs_none_test
 @
 \subsubsection{Phase-space configuration data}
 Construct and display a test phase-space configuration object.  Also
 check the [[azimuthal_dependence]] flag.
 <<PHS none: execute tests>>=
   call test (phs_none_1, "phs_none_1", &
        "phase-space configuration dummy", &
        u, results)
 <<PHS none: test declarations>>=
   public :: phs_none_1
 <<PHS none: tests>>=
   subroutine phs_none_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(process_constants_t) :: process_data
     class(phs_config_t), allocatable :: phs_data
     real(default) :: sqrts
 
     write (u, "(A)")  "* Test output: phs_none_1"
     write (u, "(A)")  "*   Purpose: display &
          &phase-space configuration data"
     write (u, "(A)")
 
     allocate (phs_none_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     sqrts = 1000._default
     call phs_data%configure (sqrts, azimuthal_dependence=.false.)
 
     call phs_data%write (u)
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_none_1"
 
   end subroutine phs_none_1
 
 @ %def phs_none_1
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \clearpage
 \section{Single-particle phase space}
 
 This module implements the phase space for a single particle, i.e., the solid
 angle, in a straightforward parameterization with a single channel.  The
 phase-space implementation may be used either for $1\to 2$ decays or for $2\to
 2$ scattering processes, so the number of incoming particles is the only free
 parameter in the configuration.  In the latter case, we should restrict its
 use to non-resonant s-channel processes, because there is no mapping of the
 scattering angle.
 
 (We might extend this later to account for generic $2\to 2$ situations, e.g.,
 account for a Coulomb singularity or detect an s-channel resonance structure
 that requires matching structure-function mappings.)
 
 This is derived from the [[phs_test]] implementation in the
 [[phs_base]] module above, even more simplified, but intended for
 actual use.
 <<[[phs_single.f90]]>>=
 <<File header>>
 
 module phs_single
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use constants
   use numeric_utils
   use diagnostics
   use os_interface
   use lorentz
   use physics_defs
   use model_data
   use flavors
   use process_constants
   use phs_base
 
 <<Standard module head>>
 
 <<PHS single: public>>
 
 <<PHS single: types>>
 
 contains
 
 <<PHS single: procedures>>
 
 end module phs_single
 @ %def phs_single
 @
 \subsection{Configuration}
 <<PHS single: public>>=
   public :: phs_single_config_t
 <<PHS single: types>>=
   type, extends (phs_config_t) :: phs_single_config_t
   contains
   <<PHS single: phs single config: TBP>>
   end type phs_single_config_t
 
 @ %def phs_single_config_t
 @ The finalizer is empty.
 <<PHS single: phs single config: TBP>>=
   procedure :: final => phs_single_config_final
 <<PHS single: procedures>>=
   subroutine phs_single_config_final (object)
     class(phs_single_config_t), intent(inout) :: object
   end subroutine phs_single_config_final
 
 @ %def phs_single_final
 @ Output.
 <<PHS single: phs single config: TBP>>=
   procedure :: write => phs_single_config_write
 <<PHS single: procedures>>=
   subroutine phs_single_config_write (object, unit, include_id)
     class(phs_single_config_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: include_id
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)")  "Partonic phase-space configuration (single-particle):"
     call object%base_write (unit)
   end subroutine phs_single_config_write
 
 @ %def phs_single_config_write
 @ Configuration: there is only one channel and two parameters.  The
 second parameter is the azimuthal angle, which may be a flat dimension.
 <<PHS single: phs single config: TBP>>=
   procedure :: configure => phs_single_config_configure
 <<PHS single: procedures>>=
   subroutine phs_single_config_configure (phs_config, sqrts, &
        sqrts_fixed, cm_frame, azimuthal_dependence, rebuild, ignore_mismatch, &
        nlo_type, subdir)
     class(phs_single_config_t), intent(inout) :: phs_config
     real(default), intent(in) :: sqrts
     logical, intent(in), optional :: sqrts_fixed
     logical, intent(in), optional :: cm_frame
     logical, intent(in), optional :: azimuthal_dependence
     logical, intent(in), optional :: rebuild
     logical, intent(in), optional :: ignore_mismatch
     integer, intent(in), optional :: nlo_type
     type(string_t), intent(in), optional :: subdir
     if (.not. present (nlo_type)) &
       phs_config%nlo_type = BORN
     if (phs_config%n_out == 2) then
        phs_config%n_channel = 1
        phs_config%n_par = 2
        phs_config%sqrts = sqrts
        if (present (sqrts_fixed))  phs_config%sqrts_fixed = sqrts_fixed
        if (present (cm_frame))  phs_config%cm_frame = cm_frame
        if (present (azimuthal_dependence)) then
           phs_config%azimuthal_dependence = azimuthal_dependence
           if (.not. azimuthal_dependence) then
              allocate (phs_config%dim_flat (1))
              phs_config%dim_flat(1) = 2
           end if
        end if
        if (allocated (phs_config%channel))  deallocate (phs_config%channel)
        allocate (phs_config%channel (1))
        call phs_config%compute_md5sum ()
     else
        call msg_fatal ("Single-particle phase space requires n_out = 2")
     end if
   end subroutine phs_single_config_configure
 
 @ %def phs_single_config_configure
 @ Startup message, after configuration is complete.
 <<PHS single: phs single config: TBP>>=
   procedure :: startup_message => phs_single_config_startup_message
 <<PHS single: procedures>>=
   subroutine phs_single_config_startup_message (phs_config, unit)
     class(phs_single_config_t), intent(in) :: phs_config
     integer, intent(in), optional :: unit
     call phs_config%base_startup_message (unit)
     write (msg_buffer, "(A,2(1x,I0,1x,A))") &
          "Phase space: single-particle"
     call msg_message (unit = unit)
   end subroutine phs_single_config_startup_message
 
 @ %def phs_single_config_startup_message
 @ Allocate an instance: the actual phase-space object.
 <<PHS single: phs single config: TBP>>=
   procedure, nopass :: allocate_instance => phs_single_config_allocate_instance
 <<PHS single: procedures>>=
   subroutine phs_single_config_allocate_instance (phs)
     class(phs_t), intent(inout), pointer :: phs
     allocate (phs_single_t :: phs)
   end subroutine phs_single_config_allocate_instance
 
 @ %def phs_single_config_allocate_instance
 @
 \subsection{Kinematics implementation}
 We generate $\cos\theta$ and $\phi$ uniformly, covering the solid angle.
 
 Note: The incoming momenta must be in the c.m. system.
 <<PHS single: public>>=
   public :: phs_single_t
 <<PHS single: types>>=
   type, extends (phs_t) :: phs_single_t
    contains
    <<PHS single: phs single: TBP>>
   end type phs_single_t
 
 @ %def phs_single_t
 @ Output.  The [[verbose]] setting is irrelevant, we just display the contents
 of the base object.
 <<PHS single: phs single: TBP>>=
   procedure :: write => phs_single_write
 <<PHS single: procedures>>=
   subroutine phs_single_write (object, unit, verbose)
     class(phs_single_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     u = given_output_unit (unit)
     call object%base_write (u)
   end subroutine phs_single_write
 
 @ %def phs_single_write
 @ The finalizer is empty.
 <<PHS single: phs single: TBP>>=
   procedure :: final => phs_single_final
 <<PHS single: procedures>>=
   subroutine phs_single_final (object)
     class(phs_single_t), intent(inout) :: object
   end subroutine phs_single_final
 
 @ %def phs_single_final
 @ Initialization.  We allocate arrays ([[base_init]]) and adjust the
 phase-space volume.  The massless two-particle phase space volume is
 \begin{equation}
   \Phi_2 = \frac{1}{4(2\pi)^5} = 2.55294034614 \times 10^{-5}
 \end{equation}
 For a decay with nonvanishing masses ($m_3$, $m_4$), there is a correction
 factor
 \begin{equation}
   \Phi_2(m) / \Phi_2(0) = \frac{1}{\hat s}
   \lambda^{1/2}(\hat s, m_3^2, m_4^2).
 \end{equation}
 For a scattering process with nonvanishing masses, the correction
 factor is
 \begin{equation}
   \Phi_2(m) / \Phi_2(0) = \frac{1}{\hat s ^ 2}
   \lambda^{1/2}(\hat s, m_1^2, m_2^2)\,
   \lambda^{1/2}(\hat s, m_3^2, m_4^2).
 \end{equation}
 If the energy is fixed, this is constant.  Otherwise, we have to account for
 varying $\hat s$.
 <<PHS single: phs single: TBP>>=
   procedure :: init => phs_single_init
 <<PHS single: procedures>>=
   subroutine phs_single_init (phs, phs_config)
     class(phs_single_t), intent(out) :: phs
     class(phs_config_t), intent(in), target :: phs_config
     call phs%base_init (phs_config)
     phs%volume = 1 / (4 * twopi5)
     call phs%compute_factor ()
   end subroutine phs_single_init
 
 @ %def phs_single_init
 @ Compute the correction factor for nonzero masses.  We do this during
 initialization (when the incoming momenta [[p]] are undefined), unless
 [[sqrts]] is variable.  We do this again once for each phase-space point, but
 then we skip the calculation if [[sqrts]] is fixed.
 <<PHS single: phs single: TBP>>=
   procedure :: compute_factor => phs_single_compute_factor
 <<PHS single: procedures>>=
   subroutine phs_single_compute_factor (phs)
     class(phs_single_t), intent(inout) :: phs
     real(default) :: s_hat
     select case (phs%config%n_in)
     case (1)
        if (.not. phs%p_defined) then
           if (sum (phs%m_out) < phs%m_in(1)) then
              s_hat = phs%m_in(1) ** 2
              phs%f(1) = 1 / s_hat &
                   * sqrt (lambda (s_hat, phs%m_out(1)**2, phs%m_out(2)**2))
           else
              print *, "m_in  = ", phs%m_in
              print *, "m_out = ", phs%m_out
              call msg_fatal ("Decay is kinematically forbidden")
           end if
        end if
     case (2)
        if (phs%config%sqrts_fixed) then
           if (phs%p_defined)  return
           s_hat = phs%config%sqrts ** 2
        else
           if (.not. phs%p_defined)  return
           s_hat = sum (phs%p) ** 2
        end if
        if (sum (phs%m_in)**2 < s_hat .and. sum (phs%m_out)**2 < s_hat) then
           phs%f(1) = 1 / s_hat * &
                ( lambda (s_hat, phs%m_in (1)**2, phs%m_in (2)**2)   &
                * lambda (s_hat, phs%m_out(1)**2, phs%m_out(2)**2) ) &
                ** 0.25_default
        else
           phs%f(1) = 0
        end if
     end select
   end subroutine phs_single_compute_factor
 
 @ %def phs_single_compute_factor
 @ Evaluation.  We uniformly generate $\cos\theta$ and
 $\phi$, with Jacobian normalized to one.
 
 There is only a single channel, so the second subroutine does nothing.
 
 Note: the current implementation works for elastic scattering only.
 <<PHS single: phs single: TBP>>=
   procedure :: evaluate_selected_channel => phs_single_evaluate_selected_channel
   procedure :: evaluate_other_channels => phs_single_evaluate_other_channels
 <<PHS single: procedures>>=
   subroutine phs_single_evaluate_selected_channel (phs, c_in, r_in)
     class(phs_single_t), intent(inout) :: phs
     integer, intent(in) :: c_in
     real(default), intent(in), dimension(:) :: r_in
     !!! !!! !!! Catching a gfortran bogus warning
     type(vector4_t), dimension(2) :: p_dum
     if (phs%p_defined) then
        call phs%select_channel (c_in)
        phs%r(:,c_in) = r_in
        select case (phs%config%n_in)
        case (2)
           if (all (phs%m_in == phs%m_out)) then
              call compute_kinematics_solid_angle (phs%p, phs%q, r_in)
           else
              call msg_bug ("PHS single: inelastic scattering not implemented")
           end if
        case (1)
           !!! !!! !!! Catching a gfortran bogus warning
           !!! call compute_kinematics_solid_angle (phs%decay_p (), phs%q, x)
           p_dum = phs%decay_p ()
           call compute_kinematics_solid_angle (p_dum, phs%q, r_in)
        end select
        call phs%compute_factor ()
        phs%q_defined = .true.
        phs%r_defined = .true.
     end if
   end subroutine phs_single_evaluate_selected_channel
 
   subroutine phs_single_evaluate_other_channels (phs, c_in)
     class(phs_single_t), intent(inout) :: phs
     integer, intent(in) :: c_in
   end subroutine phs_single_evaluate_other_channels
 
 @ %def phs_single_evaluate_selected_channel
 @ %def phs_single_evaluate_other_channels
 @ Auxiliary: split a decaying particle at rest into the decay products,
 aligned along the $z$ axis.
 <<PHS single: phs single: TBP>>=
   procedure :: decay_p => phs_single_decay_p
 <<PHS single: procedures>>=
   function phs_single_decay_p (phs) result (p)
     class(phs_single_t), intent(in) :: phs
     type(vector4_t), dimension(2) :: p
     real(default) :: k
     real(default), dimension(2) :: E
     k = sqrt (lambda (phs%m_in(1) ** 2, phs%m_out(1) ** 2, phs%m_out(2) ** 2)) &
          / (2 * phs%m_in(1))
     E = sqrt (phs%m_out ** 2 + k ** 2)
     p(1) = vector4_moving (E(1), k, 3)
     p(2) = vector4_moving (E(2),-k, 3)
   end function phs_single_decay_p
 
 @ %def phs_single_decay_p
 @ Inverse evaluation.
 <<PHS single: phs single: TBP>>=
   procedure :: inverse => phs_single_inverse
 <<PHS single: procedures>>=
   subroutine phs_single_inverse (phs)
     class(phs_single_t), intent(inout) :: phs
     real(default), dimension(:), allocatable :: x
     if (phs%p_defined .and. phs%q_defined) then
        call phs%select_channel ()
        allocate (x (phs%config%n_par))
        call inverse_kinematics_solid_angle (phs%p, phs%q, x)
        phs%r(:,1) = x
        call phs%compute_factor ()
        phs%r_defined = .true.
     end if
   end subroutine phs_single_inverse
 
 @ %def phs_single_inverse
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[phs_single_ut.f90]]>>=
 <<File header>>
 
 module phs_single_ut
   use unit_tests
   use phs_single_uti
 
 <<Standard module head>>
 
 <<PHS single: public test>>
 
 contains
 
 <<PHS single: test driver>>
 
 end module phs_single_ut
 @ %def phs_single_ut
 @
 <<[[phs_single_uti.f90]]>>=
 <<File header>>
 
 module phs_single_uti
 
 <<Use kinds>>
 <<Use strings>>
   use flavors
   use lorentz
   use model_data
   use process_constants
   use phs_base
 
   use phs_single
 
   use phs_base_ut, only: init_test_process_data, init_test_decay_data
 
 <<Standard module head>>
 
 <<PHS single: test declarations>>
 
 contains
 
 <<PHS single: tests>>
 
 end module phs_single_uti
 @ %def phs_single_ut
 @ API: driver for the unit tests below.
 <<PHS single: public test>>=
   public :: phs_single_test
 <<PHS single: test driver>>=
   subroutine phs_single_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<PHS single: execute tests>>
   end subroutine phs_single_test
 
 @ %def phs_single_test
 @
 \subsubsection{Phase-space configuration data}
 Construct and display a test phase-space configuration object.  Also
 check the [[azimuthal_dependence]] flag.
 <<PHS single: execute tests>>=
   call test (phs_single_1, "phs_single_1", &
        "phase-space configuration", &
        u, results)
 <<PHS single: test declarations>>=
   public :: phs_single_1
 <<PHS single: tests>>=
   subroutine phs_single_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(process_constants_t) :: process_data
     class(phs_config_t), allocatable :: phs_data
     real(default) :: sqrts
 
     write (u, "(A)")  "* Test output: phs_single_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &phase-space configuration data"
     write (u, "(A)")
 
     call model%init_test ()
 
     write (u, "(A)")  "* Initialize a process and a matching &
          &phase-space configuration"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_single_1"), process_data)
 
     allocate (phs_single_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     sqrts = 1000._default
     call phs_data%configure (sqrts, azimuthal_dependence=.false.)
 
     call phs_data%write (u)
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_single_1"
 
   end subroutine phs_single_1
 
 @ %def phs_single_1
 @
 \subsubsection{Phase space evaluation}
 Compute kinematics for given parameters, also invert the calculation.
 <<PHS single: execute tests>>=
   call test (phs_single_2, "phs_single_2", &
        "phase-space evaluation", &
        u, results)
 <<PHS single: test declarations>>=
   public :: phs_single_2
 <<PHS single: tests>>=
   subroutine phs_single_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(process_constants_t) :: process_data
     real(default) :: sqrts, E
     class(phs_config_t), allocatable, target :: phs_data
     class(phs_t), pointer :: phs => null ()
     type(vector4_t), dimension(2) :: p, q
 
     write (u, "(A)")  "* Test output: phs_single_2"
     write (u, "(A)")  "*   Purpose: test simple two-channel phase space"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
 
     write (u, "(A)")  "* Initialize a process and a matching &
          &phase-space configuration"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_single_2"), process_data)
 
     allocate (phs_single_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     sqrts = 1000._default
     call phs_data%configure (sqrts)
 
     call phs_data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize the phase-space instance"
     write (u, "(A)")
 
     call phs_data%allocate_instance (phs)
     call phs%init (phs_data)
 
     call phs%write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Set incoming momenta"
     write (u, "(A)")
 
     E = sqrts / 2
     p(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     p(2) = vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
     call phs%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute phase-space point &
          &for x = 0.5, 0.125"
     write (u, "(A)")
 
     call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
     call phs%evaluate_other_channels (1)
     call phs%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Inverse kinematics"
     write (u, "(A)")
 
     call phs%get_outgoing_momenta (q)
     deallocate (phs)
     call phs_data%allocate_instance (phs)
     call phs%init (phs_data)
 
     sqrts = 1000._default
     call phs_data%configure (sqrts)
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
     call phs%set_outgoing_momenta (q)
 
     call phs%inverse ()
     call phs%write (u)
 
     call phs%final ()
     deallocate (phs)
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_single_2"
 
   end subroutine phs_single_2
 
 @ %def phs_single_2
 @
 \subsubsection{Phase space for non-c.m. system}
 Compute kinematics for given parameters, also invert the calculation.
 Since this will involve cancellations, we call [[pacify]] to eliminate
 numerical noise.
 <<PHS single: execute tests>>=
   call test (phs_single_3, "phs_single_3", &
        "phase-space evaluation in lab frame", &
        u, results)
 <<PHS single: test declarations>>=
   public :: phs_single_3
 <<PHS single: tests>>=
   subroutine phs_single_3 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(process_constants_t) :: process_data
     real(default) :: sqrts, E
     class(phs_config_t), allocatable, target :: phs_data
     class(phs_t), pointer :: phs => null ()
     type(vector4_t), dimension(2) :: p, q
     type(lorentz_transformation_t) :: lt
 
     write (u, "(A)")  "* Test output: phs_single_3"
     write (u, "(A)")  "*   Purpose: test simple two-channel phase space"
     write (u, "(A)")  "*            without c.m. kinematics assumption"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
 
     write (u, "(A)")  "* Initialize a process and a matching &
          &phase-space configuration"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_single_3"), process_data)
 
     allocate (phs_single_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     sqrts = 1000._default
     call phs_data%configure (sqrts, cm_frame=.false., sqrts_fixed=.false.)
 
     call phs_data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize the phase-space instance"
     write (u, "(A)")
 
     call phs_data%allocate_instance (phs)
     call phs%init (phs_data)
 
     call phs%write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Set incoming momenta in lab system"
     write (u, "(A)")
 
     lt = boost (0.1_default, 1) * boost (0.3_default, 3)
 
     E = sqrts / 2
     p(1) = lt * vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     p(2) = lt * vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
 
     call vector4_write (p(1), u)
     call vector4_write (p(2), u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute phase-space point &
          &for x = 0.5, 0.125"
     write (u, "(A)")
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
 
     call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
     call phs%evaluate_other_channels (1)
     call pacify (phs)
     call phs%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract outgoing momenta in lab system"
     write (u, "(A)")
 
     call phs%get_outgoing_momenta (q)
     call vector4_write (q(1), u)
     call vector4_write (q(2), u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Inverse kinematics"
     write (u, "(A)")
 
     deallocate (phs)
     call phs_data%allocate_instance (phs)
     call phs%init (phs_data)
 
     sqrts = 1000._default
     call phs_data%configure (sqrts)
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
     call phs%set_outgoing_momenta (q)
 
     call phs%inverse ()
     call pacify (phs)
     call phs%write (u)
 
     call phs%final ()
     deallocate (phs)
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_single_3"
 
   end subroutine phs_single_3
 
 @ %def phs_single_3
 @
 \subsubsection{Decay Phase space evaluation}
 Compute kinematics for given parameters, also invert the calculation.  This
 time, implement a decay process.
 <<PHS single: execute tests>>=
   call test (phs_single_4, "phs_single_4", &
        "decay phase-space evaluation", &
        u, results)
 <<PHS single: test declarations>>=
   public :: phs_single_4
 <<PHS single: tests>>=
   subroutine phs_single_4 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(process_constants_t) :: process_data
     class(phs_config_t), allocatable, target :: phs_data
     class(phs_t), pointer :: phs => null ()
     type(vector4_t), dimension(1) :: p
     type(vector4_t), dimension(2) :: q
 
     write (u, "(A)")  "* Test output: phs_single_4"
     write (u, "(A)")  "*   Purpose: test simple two-channel phase space"
     write (u, "(A)")
 
     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")))
     call flv%init (25, model)
 
     write (u, "(A)")  "* Initialize a decay and a matching &
          &phase-space configuration"
     write (u, "(A)")
 
     call init_test_decay_data (var_str ("phs_single_4"), process_data)
 
     allocate (phs_single_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     call phs_data%configure (flv%get_mass ())
 
     call phs_data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize the phase-space instance"
     write (u, "(A)")
 
     call phs_data%allocate_instance (phs)
     call phs%init (phs_data)
 
     call phs%write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Set incoming momenta"
     write (u, "(A)")
 
     p(1) = vector4_at_rest (flv%get_mass ())
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
     call phs%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute phase-space point &
          &for x = 0.5, 0.125"
     write (u, "(A)")
 
     call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
     call phs%evaluate_other_channels (1)
     call phs%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Inverse kinematics"
     write (u, "(A)")
 
     call phs%get_outgoing_momenta (q)
     deallocate (phs)
     call phs_data%allocate_instance (phs)
     call phs%init (phs_data)
 
     call phs_data%configure (flv%get_mass ())
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
     call phs%set_outgoing_momenta (q)
 
     call phs%inverse ()
     call phs%write (u)
 
     call phs%final ()
     deallocate (phs)
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_single_4"
 
   end subroutine phs_single_4
 
 @ %def phs_single_4
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{Flat RAMBO phase space}
+
+This module implements the flat \texttt{RAMBO} phase space for massless and massive particles using the minimal d.o.f $3n - 4$ in a straightforward parameterization with a single channel.
+We generate $n$ mass systems $M_i$ with $M_0 = \sqrt{s}$ and $M_{n} = 0$.
+We let each mass system decay $1 \rightarrow 2$ in a four-momentum conserving way.
+The four-momenta of the two particles are generated back-to-back where we map the d.o.f. to energy, azimuthal and polar angle.
+The particle momenta are then boosted to CMS by an appriopriate boost using the kinematics of the parent mass system.
+
+<<[[phs_rambo.f90]]>>=
+<<File header>>
+
+module phs_rambo
+
+<<Use kinds>>
+<<Use strings>>
+  use io_units
+  use constants
+  use numeric_utils
+  use format_defs, only: FMT_19
+  use permutations, only: factorial
+  use diagnostics
+  use os_interface
+  use lorentz
+  use physics_defs
+  use model_data
+  use flavors
+  use process_constants
+  use phs_base
+
+<<Standard module head>>
+
+<<PHS rambo: parameters>>
+
+<<PHS rambo: types>>
+
+<<PHS rambo: public>>
+
+contains
+
+<<PHS rambo: procedures>>
+
+end module phs_rambo
+@ %def phs_rambo
+@
+\subsection{Configuration}
+<<PHS rambo: public>>=
+  public :: phs_rambo_config_t
+<<PHS rambo: types>>=
+  type, extends (phs_config_t) :: phs_rambo_config_t
+  contains
+  <<PHS rambo: phs rambo config: TBP>>
+  end type phs_rambo_config_t
+
+@ %def phs_rambo_config_t
+@ The finalizer is empty.
+<<PHS rambo: phs rambo config: TBP>>=
+  procedure :: final => phs_rambo_config_final
+<<PHS rambo: procedures>>=
+  subroutine phs_rambo_config_final (object)
+    class(phs_rambo_config_t), intent(inout) :: object
+  end subroutine phs_rambo_config_final
+
+@ %def phs_rambo_final
+@ Output.
+<<PHS rambo: phs rambo config: TBP>>=
+  procedure :: write => phs_rambo_config_write
+<<PHS rambo: procedures>>=
+  subroutine phs_rambo_config_write (object, unit, include_id)
+    class(phs_rambo_config_t), intent(in) :: object
+    integer, intent(in), optional :: unit
+    logical, intent(in), optional :: include_id
+    integer :: u
+    u = given_output_unit (unit)
+    write (u, "(1x,A)")  "Partonic, flat phase-space configuration (RAMBO):"
+    call object%base_write (unit)
+  end subroutine phs_rambo_config_write
+
+@ %def phs_rambo_config_write
+@ Configuration: there is only one channel and $3n - 4$ parameters.
+<<PHS rambo: phs rambo config: TBP>>=
+  procedure :: configure => phs_rambo_config_configure
+<<PHS rambo: procedures>>=
+  subroutine phs_rambo_config_configure (phs_config, sqrts, &
+       sqrts_fixed, cm_frame, azimuthal_dependence, rebuild, ignore_mismatch, &
+       nlo_type, subdir)
+    class(phs_rambo_config_t), intent(inout) :: phs_config
+    real(default), intent(in) :: sqrts
+    logical, intent(in), optional :: sqrts_fixed
+    logical, intent(in), optional :: cm_frame
+    logical, intent(in), optional :: azimuthal_dependence
+    logical, intent(in), optional :: rebuild
+    logical, intent(in), optional :: ignore_mismatch
+    integer, intent(in), optional :: nlo_type
+    type(string_t), intent(in), optional :: subdir
+    if (.not. present (nlo_type)) &
+      phs_config%nlo_type = BORN
+    if (phs_config%n_out < 2) then
+       call msg_fatal ("RAMBO phase space requires n_out >= 2")
+    end if
+    phs_config%n_channel = 1
+    phs_config%n_par = 3 * phs_config%n_out - 4
+    phs_config%sqrts = sqrts
+    if (present (sqrts_fixed))  phs_config%sqrts_fixed = sqrts_fixed
+    if (present (cm_frame))  phs_config%cm_frame = cm_frame
+    if (allocated (phs_config%channel))  deallocate (phs_config%channel)
+    allocate (phs_config%channel (1))
+    call phs_config%compute_md5sum ()
+  end subroutine phs_rambo_config_configure
+
+@ %def phs_rambo_config_configure
+@ Startup message, after configuration is complete.
+<<PHS rambo: phs rambo config: TBP>>=
+  procedure :: startup_message => phs_rambo_config_startup_message
+<<PHS rambo: procedures>>=
+  subroutine phs_rambo_config_startup_message (phs_config, unit)
+    class(phs_rambo_config_t), intent(in) :: phs_config
+    integer, intent(in), optional :: unit
+    call phs_config%base_startup_message (unit)
+    write (msg_buffer, "(A,2(1x,I0,1x,A))") &
+         "Phase space: flat (RAMBO)"
+    call msg_message (unit = unit)
+  end subroutine phs_rambo_config_startup_message
+
+@ %def phs_rambo_config_startup_message
+@ Allocate an instance: the actual phase-space object.
+<<PHS rambo: phs rambo config: TBP>>=
+  procedure, nopass :: allocate_instance => phs_rambo_config_allocate_instance
+<<PHS rambo: procedures>>=
+  subroutine phs_rambo_config_allocate_instance (phs)
+    class(phs_t), intent(inout), pointer :: phs
+    allocate (phs_rambo_t :: phs)
+  end subroutine phs_rambo_config_allocate_instance
+
+@ %def phs_rambo_config_allocate_instance
+@
+\subsection{Kinematics implementation}
+
+We generate $n - 2$ mass systems $M_i$ with $M_0 = \sqrt{s}$ and $M_n = 0$...
+
+Note: The incoming momenta must be in the c.m. system.
+<<PHS rambo: public>>=
+  public :: phs_rambo_t
+<<PHS rambo: types>>=
+  type, extends (phs_t) :: phs_rambo_t
+     real(default), dimension(:), allocatable :: k
+     real(default), dimension(:), allocatable :: m
+   contains
+   <<PHS rambo: phs rambo: TBP>>
+  end type phs_rambo_t
+
+@ %def phs_rambo_t
+@ Output.
+<<PHS rambo: phs rambo: TBP>>=
+procedure :: write => phs_rambo_write
+<<PHS rambo: procedures>>=
+  subroutine phs_rambo_write (object, unit, verbose)
+    class(phs_rambo_t), intent(in) :: object
+    integer, intent(in), optional :: unit
+    logical, intent(in), optional :: verbose
+    integer :: u
+    u = given_output_unit (unit)
+    call object%base_write (u)
+    write (u, "(1X,A)") "Intermediate masses (massless):"
+    write (u, "(3X,999(" // FMT_19 // "))") object%k
+    write (u, "(1X,A)") "Intermediate masses (massive):"
+    write (u, "(3X,999(" // FMT_19 // "))") object%m
+  end subroutine phs_rambo_write
+
+@ %def phs_rambo_write
+@ The finalizer is empty.
+<<PHS rambo: phs rambo: TBP>>=
+  procedure :: final => phs_rambo_final
+<<PHS rambo: procedures>>=
+  subroutine phs_rambo_final (object)
+    class(phs_rambo_t), intent(inout) :: object
+  end subroutine phs_rambo_final
+
+@ %def phs_rambo_final
+@ Initialization.  We allocate arrays ([[base_init]]) and adjust the
+phase-space volume.
+The energy dependent factor of $s^{n - 2}$ is applied later.
+<<PHS rambo: phs rambo: TBP>>=
+  procedure :: init => phs_rambo_init
+<<PHS rambo: procedures>>=
+  subroutine phs_rambo_init (phs, phs_config)
+    class(phs_rambo_t), intent(out) :: phs
+    class(phs_config_t), intent(in), target :: phs_config
+    call phs%base_init (phs_config)
+    associate (n => phs%config%n_out)
+      select case (n)
+      case (1)
+         if (sum (phs%m_out) > phs%m_in (1)) then
+            print *, "m_in = ", phs%m_in
+            print *, "m_out = ", phs%m_out
+            call msg_fatal ("[phs_rambo_init] Decay is kinematically forbidden.")
+         end if
+      end select
+      allocate (phs%k(n), source = 0._default)
+      allocate (phs%m(n), source = 0._default)
+      phs%volume = 1. / (twopi)**(3 * n) &
+           * (pi / 2.)**(n - 1) / (factorial(n - 1) * factorial(n - 2))
+    end associate
+  end subroutine phs_rambo_init
+
+@ %def phs_rambo_init
+@ Evaluation. There is only one channel for RAMBO, so the second subroutine does nothing.
+
+Note: the current implementation works for elastic scattering only.
+<<PHS rambo: phs rambo: TBP>>=
+  procedure :: evaluate_selected_channel => phs_rambo_evaluate_selected_channel
+  procedure :: evaluate_other_channels => phs_rambo_evaluate_other_channels
+<<PHS rambo: procedures>>=
+  subroutine phs_rambo_evaluate_selected_channel (phs, c_in, r_in)
+    class(phs_rambo_t), intent(inout) :: phs
+    integer, intent(in) :: c_in
+    real(default), intent(in), dimension(:) :: r_in
+    type(vector4_t), dimension(2) :: p_rest, p_boosted
+    type(vector4_t) :: q
+    real(default), dimension(2) :: r_angle
+    integer :: i
+    if (.not. phs%p_defined) return
+    call phs%select_channel (c_in)
+    phs%r(:,c_in) = r_in
+    associate (n => phs%config%n_out, m => phs%m)
+      call phs%generate_intermediates (r_in(:n - 2))
+      q = sum (phs%p)
+      do i = 2, n
+         r_angle(1) = r_in(n - 5 + 2 * i)
+         r_angle(2) = r_in(n - 4 + 2 * i)
+         call phs%decay_intermediate (i, r_angle, p_rest)
+         p_boosted = boost(q, m(i - 1)) * p_rest
+         q = p_boosted(1)
+         phs%q(i - 1)  = p_boosted(2)
+      end do
+      phs%q(n) = q
+    end associate
+    phs%q_defined = .true.
+    phs%r_defined = .true.
+  end subroutine phs_rambo_evaluate_selected_channel
+
+  subroutine phs_rambo_evaluate_other_channels (phs, c_in)
+    class(phs_rambo_t), intent(inout) :: phs
+    integer, intent(in) :: c_in
+  end subroutine phs_rambo_evaluate_other_channels
+
+@ %def phs_rambo_evaluate_selected_channel
+@ %def phs_rambo_evaluate_other_channels
+@ Decay intermediate mass system $M_{i - 1}$ into a on-shell particle with mass
+$m_{i - 1}$ and subsequent intermediate mass system with fixed $M_i$.
+<<PHS rambo: phs rambo: TBP>>=
+  procedure, private :: decay_intermediate => phs_rambo_decay_intermediate
+<<PHS rambo: procedures>>=
+  subroutine phs_rambo_decay_intermediate (phs, i, r_angle, p)
+    class(phs_rambo_t), intent(in) :: phs
+    integer, intent(in) :: i
+    real(default), dimension(2), intent(in) :: r_angle
+    type(vector4_t), dimension(2), intent(out) :: p
+    real(default) :: k_abs, cos_theta, phi
+    type(vector3_t):: k
+    real(default), dimension(2) :: E
+    cos_theta = 2. * r_angle(1) - 1.
+    phi = twopi * r_angle(2)
+    if (phi > pi) phi = phi - twopi
+    k_abs = sqrt (lambda (phs%m(i - 1)**2, phs%m(i)**2, phs%m_out(i - 1)**2)) &
+         / (2. * phs%m(i - 1))
+    k = k_abs * [cos(phi) * sqrt(1. - cos_theta**2), &
+         sin(phi) * sqrt(1. - cos_theta**2), cos_theta]
+    E(1) = sqrt (phs%m(i)**2 + k_abs**2)
+    E(2) = sqrt (phs%m_out(i - 1)**2 + k_abs**2)
+    p(1) = vector4_moving (E(1), -k)
+    p(2) = vector4_moving (E(2), k)
+  end subroutine phs_rambo_decay_intermediate
+
+@ %def phs_rambo_decay_intermediate
+@ Generate intermediate masses.
+<<PHS rambo: parameters>>=
+  integer, parameter :: BISECT_MAX_ITERATIONS = 1000
+  real(default), parameter :: BISECT_MIN_PRECISION = tiny_10
+<<PHS rambo: phs rambo: TBP>>=
+  procedure, private :: generate_intermediates => phs_rambo_generate_intermediates
+  procedure, private :: invert_intermediates => phs_rambo_invert_intermediates
+<<PHS rambo: procedures>>=
+ subroutine phs_rambo_generate_intermediates (phs, r)
+    class(phs_rambo_t), intent(inout) :: phs
+    real(default), dimension(:), intent(in) :: r
+    integer :: i, j
+    associate (n => phs%config%n_out, k => phs%k, m => phs%m)
+      m(1) = invariant_mass (sum (phs%p))
+      m(n) = phs%m_out (n)
+      call calculate_k (r)
+      do i = 2, n - 1
+         m(i) = k(i) + sum (phs%m_out (i:n))
+      end do
+      ! Massless volume times reweighting for massive volume
+      phs%f(1) = k(1)**(2 * n - 4) &
+           * 8. * rho(m(n - 1), phs%m_out(n), phs%m_out(n - 1))
+      do i = 2, n - 1
+         phs%f(1) = phs%f(1) * &
+              rho(m(i - 1), m(i), phs%m_out(i - 1)) / &
+              rho(k(i - 1), k(i), 0._default) * &
+              M(i) / K(i)
+      end do
+    end associate
+  contains
+    subroutine calculate_k (r)
+      real(default), dimension(:), intent(in) :: r
+      real(default), dimension(:), allocatable :: u
+      integer :: i
+      associate (n => phs%config%n_out, k => phs%k, m => phs%m)
+        k = 0
+        k(1) = m(1) - sum(phs%m_out(1:n))
+        allocate (u(2:n - 1), source=0._default)
+        call solve_for_u (r, u)
+        do i = 2, n - 1
+           k(i) = sqrt (u(i) * k(i - 1)**2)
+        end do
+      end associate
+    end subroutine calculate_k
+
+    subroutine solve_for_u (r, u)
+      real(default), dimension(phs%config%n_out - 2), intent(in) :: r
+      real(default), dimension(2:phs%config%n_out - 1), intent(out) :: u
+      integer :: i, j
+      real(default) :: f, f_mid, xl, xr, xmid
+      associate (n => phs%config%n_out)
+        do i = 2, n - 1
+           xl = 0
+           xr = 1
+           if (r(i - 1) == 1 .or. r(i - 1) == 0) then
+              u(i) = r(i - 1)
+           else
+              do j = 1, BISECT_MAX_ITERATIONS
+                 xmid = (xl + xr) / 2.
+                 f = f_rambo (xl, n - i) - r(i - 1)
+                 f_mid = f_rambo (xmid, n - i) - r(i - 1)
+                 if (f * f_mid > 0) then
+                    xl = xmid
+                 else
+                    xr = xmid
+                 end if
+                 if (abs(xl - xr) < BISECT_MIN_PRECISION) exit
+              end do
+              u(i) = xmid
+           end if
+        end do
+      end associate
+    end subroutine solve_for_u
+
+    real(default) function f_rambo(u, n)
+      real(default), intent(in) :: u
+      integer, intent(in) :: n
+      f_rambo = (n + 1) * u**n - n * u**(n + 1)
+    end function f_rambo
+
+    real(default) function rho (M1, M2, m)
+      real(default), intent(in) :: M1, M2, m
+      real(default) :: MP, MM
+      rho = sqrt ((M1**2 - (M2 + m)**2) * (M1**2 - (M2 - m)**2))
+      ! MP = (M1 - (M2 + m)) * (M1 + (M2 + m))
+      ! MM = (M1 - (M2 - m)) * (M1 + (M2 - m))
+      ! rho = sqrt (MP) * sqrt (MM)
+      rho = rho / (8._default * M1**2)
+    end function rho
+
+  end subroutine phs_rambo_generate_intermediates
+
+  subroutine phs_rambo_invert_intermediates (phs)
+    class(phs_rambo_t), intent(inout) :: phs
+    real(default) :: u
+    integer :: i
+    associate (n => phs%config%n_out, k => phs%k, m => phs%m)
+      k = m
+      do i = 1, n - 1
+         k(i) = k(i) - sum (phs%m_out(i:n))
+      end do
+      do i = 2, n - 1
+         u = (k(i) / k(i - 1))**2
+         phs%r(i - 1, 1) = (n + 1 - i) * u**(n - i) &
+              - (n - i) * u**(n + 1 - i)
+      end do
+    end associate
+  end subroutine phs_rambo_invert_intermediates
+@ %def phs_rambo_generate_intermediates
+@ Inverse evaluation.
+<<PHS rambo: phs rambo: TBP>>=
+  procedure :: inverse => phs_rambo_inverse
+<<PHS rambo: procedures>>=
+  subroutine phs_rambo_inverse (phs)
+    class(phs_rambo_t), intent(inout) :: phs
+    type(vector4_t), dimension(:), allocatable :: q
+    type(vector4_t) :: p
+    type(lorentz_transformation_t) :: L
+    real(default) :: phi, cos_theta
+    integer :: i
+    if (.not. (phs%p_defined .and. phs%q_defined)) return
+    call phs%select_channel ()
+    associate (n => phs%config%n_out, m => phs%m)
+      allocate(q(n))
+      m(1) = invariant_mass (sum (phs%p))
+      q(1) = vector4_at_rest (m(1))
+      q(n) = phs%q(n)
+      do i = 2, n - 1
+         q(i) = q(i) + sum (phs%q(i:n))
+         m(i) = invariant_mass (q(i))
+      end do
+      call phs%invert_intermediates ()
+      do i = 2, n
+         L = inverse (boost (q(i - 1), m(i - 1)))
+         p = L * phs%q(i - 1)
+         phi = azimuthal_angle (p); cos_theta = polar_angle_ct (p)
+         phs%r(n - 5 + 2 * i, 1) = (cos_theta + 1.) / 2.
+         phs%r(n - 4 + 2 * i, 1) = phi / twopi
+      end do
+    end associate
+       phs%r_defined = .true.
+  end subroutine phs_rambo_inverse
+
+@ %def phs_rambo_inverse
+@
+\subsection{Unit tests}
+Test module, followed by the corresponding implementation module.
+<<[[phs_rambo_ut.f90]]>>=
+<<File header>>
+
+module phs_rambo_ut
+  use unit_tests
+  use phs_rambo_uti
+
+<<Standard module head>>
+
+<<PHS rambo: public test>>
+
+contains
+
+<<PHS rambo: test driver>>
+
+end module phs_rambo_ut
+@ %def phs_rambo_ut
+@
+<<[[phs_rambo_uti.f90]]>>=
+<<File header>>
+
+module phs_rambo_uti
+
+<<Use kinds>>
+<<Use strings>>
+  use flavors
+  use lorentz
+  use model_data
+  use process_constants
+  use phs_base
+
+  use phs_rambo
+
+  use phs_base_ut, only: init_test_process_data, init_test_decay_data
+
+<<Standard module head>>
+
+<<PHS rambo: test declarations>>
+
+contains
+
+<<PHS rambo: tests>>
+
+end module phs_rambo_uti
+@ %def phs_rambo_ut
+@ API: driver for the unit tests below.
+<<PHS rambo: public test>>=
+  public :: phs_rambo_test
+<<PHS rambo: test driver>>=
+  subroutine phs_rambo_test (u, results)
+    integer, intent(in) :: u
+    type(test_results_t), intent(inout) :: results
+  <<PHS rambo: execute tests>>
+  end subroutine phs_rambo_test
+
+@ %def phs_rambo_test
+@
+\subsubsection{Phase-space configuration data}
+Construct and display a test phase-space configuration object.  Also
+check the [[azimuthal_dependence]] flag.
+<<PHS rambo: execute tests>>=
+  call test (phs_rambo_1, "phs_rambo_1", &
+       "phase-space configuration", &
+       u, results)
+<<PHS rambo: test declarations>>=
+  public :: phs_rambo_1
+<<PHS rambo: tests>>=
+  subroutine phs_rambo_1 (u)
+    integer, intent(in) :: u
+    type(model_data_t), target :: model
+    type(process_constants_t) :: process_data
+    class(phs_config_t), allocatable :: phs_data
+    real(default) :: sqrts
+
+    write (u, "(A)")  "* Test output: phs_rambo_1"
+    write (u, "(A)")  "*   Purpose: initialize and display &
+         &phase-space configuration data"
+    write (u, "(A)")
+
+    call model%init_test ()
+
+    write (u, "(A)")  "* Initialize a process and a matching &
+         &phase-space configuration"
+    write (u, "(A)")
+
+    call init_test_process_data (var_str ("phs_rambo_1"), process_data)
+
+    allocate (phs_rambo_config_t :: phs_data)
+    call phs_data%init (process_data, model)
+
+    sqrts = 1000._default
+    call phs_data%configure (sqrts)
+
+    call phs_data%write (u)
+
+    call phs_data%final ()
+    call model%final ()
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Test output end: phs_rambo_1"
+
+  end subroutine phs_rambo_1
+
+@ %def phs_rambo_1
+@
+\subsubsection{Phase space evaluation}
+Compute kinematics for given parameters, also invert the calculation.
+<<PHS rambo: execute tests>>=
+  call test (phs_rambo_2, "phs_rambo_2", &
+       "phase-space evaluation", &
+       u, results)
+<<PHS rambo: test declarations>>=
+  public :: phs_rambo_2
+<<PHS rambo: tests>>=
+  subroutine phs_rambo_2 (u)
+    integer, intent(in) :: u
+    type(model_data_t), target :: model
+    type(flavor_t) :: flv
+    type(process_constants_t) :: process_data
+    real(default) :: sqrts, E
+    class(phs_config_t), allocatable, target :: phs_data
+    class(phs_t), pointer :: phs => null ()
+    type(vector4_t), dimension(2) :: p, q
+
+    write (u, "(A)")  "* Test output: phs_rambo_2"
+    write (u, "(A)")  "*   Purpose: test simple two-channel phase space"
+    write (u, "(A)")
+
+    call model%init_test ()
+    call flv%init (25, model)
+
+    write (u, "(A)")  "* Initialize a process and a matching &
+         &phase-space configuration"
+    write (u, "(A)")
+
+    call init_test_process_data (var_str ("phs_rambo_2"), process_data)
+
+    allocate (phs_rambo_config_t :: phs_data)
+    call phs_data%init (process_data, model)
+
+    sqrts = 1000._default
+    call phs_data%configure (sqrts)
+
+    call phs_data%write (u)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Initialize the phase-space instance"
+    write (u, "(A)")
+
+    call phs_data%allocate_instance (phs)
+    call phs%init (phs_data)
+
+    call phs%write (u, verbose=.true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Set incoming momenta"
+    write (u, "(A)")
+
+    E = sqrts / 2
+    p(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
+    p(2) = vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
+
+    call phs%set_incoming_momenta (p)
+    call phs%compute_flux ()
+    call phs%write (u)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Compute phase-space point &
+         &for x = 0.5, 0.125"
+    write (u, "(A)")
+
+    call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
+    call phs%evaluate_other_channels (1)
+    call phs%write (u)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Inverse kinematics"
+    write (u, "(A)")
+
+    call phs%get_outgoing_momenta (q)
+    deallocate (phs)
+    call phs_data%allocate_instance (phs)
+    call phs%init (phs_data)
+
+    sqrts = 1000._default
+    call phs_data%configure (sqrts)
+
+    call phs%set_incoming_momenta (p)
+    call phs%compute_flux ()
+    call phs%set_outgoing_momenta (q)
+
+    call phs%inverse ()
+    call phs%write (u)
+
+    call phs%final ()
+    deallocate (phs)
+
+    call phs_data%final ()
+    call model%final ()
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Test output end: phs_rambo_2"
+
+  end subroutine phs_rambo_2
+
+@ %def phs_rambo_2
+@
+\subsubsection{Phase space for non-c.m. system}
+Compute kinematics for given parameters, also invert the calculation.
+Since this will involve cancellations, we call [[pacify]] to eliminate
+numerical noise.
+<<PHS rambo: execute tests>>=
+  call test (phs_rambo_3, "phs_rambo_3", &
+       "phase-space evaluation in lab frame", &
+       u, results)
+<<PHS rambo: test declarations>>=
+  public :: phs_rambo_3
+<<PHS rambo: tests>>=
+  subroutine phs_rambo_3 (u)
+    integer, intent(in) :: u
+    type(model_data_t), target :: model
+    type(flavor_t) :: flv
+    type(process_constants_t) :: process_data
+    real(default) :: sqrts, E
+    class(phs_config_t), allocatable, target :: phs_data
+    class(phs_t), pointer :: phs => null ()
+    type(vector4_t), dimension(2) :: p, q
+    type(lorentz_transformation_t) :: lt
+
+    write (u, "(A)")  "* Test output: phs_rambo_3"
+    write (u, "(A)")  "*   Purpose: phase-space evaluation in lab frame"
+    write (u, "(A)")
+
+    call model%init_test ()
+    call flv%init (25, model)
+
+    write (u, "(A)")  "* Initialize a process and a matching &
+         &phase-space configuration"
+    write (u, "(A)")
+
+    call init_test_process_data (var_str ("phs_rambo_3"), process_data)
+
+    allocate (phs_rambo_config_t :: phs_data)
+    call phs_data%init (process_data, model)
+
+    sqrts = 1000._default
+    call phs_data%configure (sqrts, cm_frame=.false., sqrts_fixed=.false.)
+
+    call phs_data%write (u)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Initialize the phase-space instance"
+    write (u, "(A)")
+
+    call phs_data%allocate_instance (phs)
+    call phs%init (phs_data)
+
+    call phs%write (u, verbose=.true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Set incoming momenta in lab system"
+    write (u, "(A)")
+
+    lt = boost (0.1_default, 1) * boost (0.3_default, 3)
+
+    E = sqrts / 2
+    p(1) = lt * vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
+    p(2) = lt * vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
+
+    call vector4_write (p(1), u)
+    call vector4_write (p(2), u)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Compute phase-space point &
+         &for x = 0.5, 0.125"
+    write (u, "(A)")
+
+    call phs%set_incoming_momenta (p)
+    call phs%compute_flux ()
+
+    call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
+    call phs%evaluate_other_channels (1)
+    call pacify (phs)
+    call phs%write (u)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Extract outgoing momenta in lab system"
+    write (u, "(A)")
+
+    call phs%get_outgoing_momenta (q)
+    call vector4_write (q(1), u)
+    call vector4_write (q(2), u)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Inverse kinematics"
+    write (u, "(A)")
+
+    deallocate (phs)
+    call phs_data%allocate_instance (phs)
+    call phs%init (phs_data)
+
+    sqrts = 1000._default
+    call phs_data%configure (sqrts)
+
+    call phs%set_incoming_momenta (p)
+    call phs%compute_flux ()
+    call phs%set_outgoing_momenta (q)
+
+    call phs%inverse ()
+    call pacify (phs)
+    call phs%write (u)
+
+    call phs%final ()
+    deallocate (phs)
+
+    call phs_data%final ()
+    call model%final ()
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Test output end: phs_rambo_3"
+
+  end subroutine phs_rambo_3
+
+@ %def phs_rambo_3
+@
+\subsubsection{Decay Phase space evaluation}
+Compute kinematics for given parameters, also invert the calculation.  This
+time, implement a decay process.
+<<PHS rambo: execute tests>>=
+  call test (phs_rambo_4, "phs_rambo_4", &
+       "decay phase-space evaluation", &
+       u, results)
+<<PHS rambo: test declarations>>=
+  public :: phs_rambo_4
+<<PHS rambo: tests>>=
+  subroutine phs_rambo_4 (u)
+    integer, intent(in) :: u
+    type(model_data_t), target :: model
+    type(flavor_t) :: flv
+    type(process_constants_t) :: process_data
+    class(phs_config_t), allocatable, target :: phs_data
+    class(phs_t), pointer :: phs => null ()
+    type(vector4_t), dimension(1) :: p
+    type(vector4_t), dimension(2) :: q
+
+    write (u, "(A)")  "* Test output: phs_rambo_4"
+    write (u, "(A)")  "*   Purpose: test simple two-channel phase space"
+    write (u, "(A)")
+
+    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")))
+    call flv%init (25, model)
+
+    write (u, "(A)")  "* Initialize a decay and a matching &
+         &phase-space configuration"
+    write (u, "(A)")
+
+    call init_test_decay_data (var_str ("phs_rambo_4"), process_data)
+
+    allocate (phs_rambo_config_t :: phs_data)
+    call phs_data%init (process_data, model)
+
+    call phs_data%configure (flv%get_mass ())
+
+    call phs_data%write (u)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Initialize the phase-space instance"
+    write (u, "(A)")
+
+    call phs_data%allocate_instance (phs)
+    call phs%init (phs_data)
+
+    call phs%write (u, verbose=.true.)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Set incoming momenta"
+    write (u, "(A)")
+
+    p(1) = vector4_at_rest (flv%get_mass ())
+
+    call phs%set_incoming_momenta (p)
+    call phs%compute_flux ()
+    call phs%write (u)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Compute phase-space point &
+         &for x = 0.5, 0.125"
+    write (u, "(A)")
+
+    call phs%evaluate_selected_channel (1, [0.5_default, 0.125_default])
+    call phs%evaluate_other_channels (1)
+    call phs%write (u)
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Inverse kinematics"
+    write (u, "(A)")
+
+    call phs%get_outgoing_momenta (q)
+    deallocate (phs)
+    call phs_data%allocate_instance (phs)
+    call phs%init (phs_data)
+
+    call phs_data%configure (flv%get_mass ())
+
+    call phs%set_incoming_momenta (p)
+    call phs%compute_flux ()
+    call phs%set_outgoing_momenta (q)
+
+    call phs%inverse ()
+    call phs%write (u)
+
+    call phs%final ()
+    deallocate (phs)
+
+    call phs_data%final ()
+    call model%final ()
+
+    write (u, "(A)")
+    write (u, "(A)")  "* Test output end: phs_rambo_4"
+
+  end subroutine phs_rambo_4
+
+@ %def phs_rambo_4
+@
+\clearpage
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Resonance Handler}
 For various purposes (e.g., shower histories), we should extract the set of
 resonances and resonant channels from a phase-space tree set.  A few methods
 do kinematics calculations specifically for those resonance data.
 <<[[resonances.f90]]>>=
 <<File header>>
 
 module resonances
 
 <<Use kinds>>
 <<Use strings>>
   use string_utils, only: str
   use format_utils, only: write_indent
   use io_units
   use diagnostics
   use lorentz
   use constants, only: one
   use model_data, only: model_data_t
   use flavors, only: flavor_t
 
 <<Standard module head>>
 
 <<Resonances: public>>
 
 <<Resonances: parameters>>
 
 <<Resonances: types>>
 
 contains
 
 <<Resonances: procedures>>
 
 end module resonances
 @ %def resonances
 @
 \subsection{Decay products (contributors)}
 This stores the indices of the particles that contribute to a resonance, i.e.,
 the decay products.
 <<Resonances: public>>=
   public :: resonance_contributors_t
 <<Resonances: types>>=
   type :: resonance_contributors_t
      integer, dimension(:), allocatable :: c
    contains
    <<Resonances: resonance contributors: TBP>>
   end type resonance_contributors_t
 
 @ %def resonance_contributors_t
 @ Equality (comparison)
 <<Resonances: resonance contributors: TBP>>=
   procedure, private :: resonance_contributors_equal
   generic :: operator(==) => resonance_contributors_equal
 <<Resonances: procedures>>=
   elemental function resonance_contributors_equal (c1, c2) result (equal)
     logical :: equal
     class(resonance_contributors_t), intent(in) :: c1, c2
     equal = allocated (c1%c) .and. allocated (c2%c)
     if (equal) equal = size (c1%c) == size (c2%c)
     if (equal) equal = all (c1%c == c2%c)
   end function resonance_contributors_equal
 
 @ %def resonance_contributors_equal
 @ Assignment
 <<Resonances: resonance contributors: TBP>>=
   procedure, private :: resonance_contributors_assign
   generic :: assignment(=) => resonance_contributors_assign
 <<Resonances: procedures>>=
   pure subroutine resonance_contributors_assign (contributors_out, contributors_in)
     class(resonance_contributors_t), intent(inout) :: contributors_out
     class(resonance_contributors_t), intent(in) :: contributors_in
     if (allocated (contributors_out%c))  deallocate (contributors_out%c)
     if (allocated (contributors_in%c)) then
        allocate (contributors_out%c (size (contributors_in%c)))
        contributors_out%c = contributors_in%c
     end if
   end subroutine resonance_contributors_assign
 
 @ %def resonance_contributors_assign
 @
 \subsection{Resonance info object}
 This data structure augments the set of resonance contributors by a flavor
 object, such that we can perform calculations that take into
 account the particle properties, including mass and width.
 
 Avoiding nameclash with similar but different [[resonance_t]] of
 [[phs_base]]:
 <<Resonances: public>>=
   public :: resonance_info_t
 <<Resonances: types>>=
   type :: resonance_info_t
      type(flavor_t) :: flavor
      type(resonance_contributors_t) :: contributors
   contains
    <<Resonances: resonance info: TBP>>
   end type resonance_info_t
 
 @ %def resonance_info_t
 @
 <<Resonances: resonance info: TBP>>=
   procedure :: copy => resonance_info_copy
 <<Resonances: procedures>>=
   subroutine resonance_info_copy (resonance_in, resonance_out)
     class(resonance_info_t), intent(in) :: resonance_in
     type(resonance_info_t), intent(out) :: resonance_out
     resonance_out%flavor = resonance_in%flavor
     if (allocated (resonance_in%contributors%c)) then
        associate (c => resonance_in%contributors%c)
           allocate (resonance_out%contributors%c (size (c)))
           resonance_out%contributors%c = c
        end associate
     end if
   end subroutine resonance_info_copy
 
 @ %def resonance_info_copy
 @
 <<Resonances: resonance info: TBP>>=
   procedure :: write => resonance_info_write
 <<Resonances: procedures>>=
   subroutine resonance_info_write (resonance, unit, verbose)
     class(resonance_info_t), intent(in) :: resonance
     integer, optional, intent(in) :: unit
     logical, optional, intent(in) :: verbose
     integer :: u, i
     logical :: verb
     u = given_output_unit (unit);  if (u < 0)  return
     verb = .true.;  if (present (verbose))  verb = verbose
     if (verb) then
        write (u, '(A)', advance='no') "Resonance contributors: "
     else
        write (u, '(1x)', advance="no")
     end if
     if (allocated (resonance%contributors%c)) then
        do i = 1, size(resonance%contributors%c)
           write (u, '(I0,1X)', advance='no') resonance%contributors%c(i)
        end do
     else if (verb) then
        write (u, "(A)", advance="no")  "[not allocated]"
     end if
     if (resonance%flavor%is_defined ()) call resonance%flavor%write (u)
     write (u, '(A)')
   end subroutine resonance_info_write
 
 @ %def resonance_info_write
 @ Create a resonance-info object.  The particle info may be available
 in term of a flavor object or as a PDG code; in the latter case we
 have to require a model data object that provides mass and width information.
 <<Resonances: resonance info: TBP>>=
   procedure, private :: resonance_info_init_pdg
   procedure, private :: resonance_info_init_flv
   generic :: init => resonance_info_init_pdg, resonance_info_init_flv
 <<Resonances: procedures>>=
   subroutine resonance_info_init_pdg (resonance, mom_id, pdg, model, n_out)
     class(resonance_info_t), intent(out) :: resonance
     integer, intent(in) :: mom_id
     integer, intent(in) :: pdg, n_out
     class(model_data_t), intent(in), target :: model
     type(flavor_t) :: flv
     call msg_debug (D_PHASESPACE, "resonance_info_init_pdg")
     call flv%init (pdg, model)
     call resonance%init (mom_id, flv, n_out)
   end subroutine resonance_info_init_pdg
 
   subroutine resonance_info_init_flv (resonance, mom_id, flv, n_out)
     class(resonance_info_t), intent(out) :: resonance
     integer, intent(in) :: mom_id
     type(flavor_t), intent(in) :: flv
     integer, intent(in) :: n_out
     integer :: i
     logical, dimension(n_out) :: contrib
     integer, dimension(n_out) :: tmp
     call msg_debug (D_PHASESPACE, "resonance_info_init_flv")
     resonance%flavor = flv
     do i = 1, n_out
        tmp(i) = i
     end do
     contrib = btest (mom_id, tmp - 1)
     allocate (resonance%contributors%c (count (contrib)))
     resonance%contributors%c = pack (tmp, contrib)
   end subroutine resonance_info_init_flv
 
 @ %def resonance_info_init
 @
 <<Resonances: resonance info: TBP>>=
   procedure, private :: resonance_info_equal
   generic :: operator(==) => resonance_info_equal
 <<Resonances: procedures>>=
   elemental function resonance_info_equal (r1, r2) result (equal)
     logical :: equal
     class(resonance_info_t), intent(in) :: r1, r2
     equal = r1%flavor == r2%flavor .and. r1%contributors == r2%contributors
   end function resonance_info_equal
 
 @ %def resonance_info_equal
 @ With each resonance region we associate a Breit-Wigner function
 \begin{equation*}
   P = \frac{M_{res}^4}{(s - M_{res}^2)^2 + \Gamma_{res}^2 M_{res}^2},
 \end{equation*}
 where $s$ denotes the invariant mass of the outgoing momenta originating
 from this resonance. Note that the $M_{res}^4$ in the nominator makes
 the mapping a dimensionless quantity.
 <<Resonances: resonance info: TBP>>=
   procedure :: mapping => resonance_info_mapping
 <<Resonances: procedures>>=
   function resonance_info_mapping (resonance, s) result (bw)
     real(default) :: bw
     class(resonance_info_t), intent(in) :: resonance
     real(default), intent(in) :: s
     real(default) :: m, gamma
     if (resonance%flavor%is_defined ()) then
        m = resonance%flavor%get_mass ()
        gamma = resonance%flavor%get_width ()
        bw = m**4 / ((s - m**2)**2 + gamma**2 * m**2)
     else
        bw = one
     end if
   end function resonance_info_mapping
 
 @ %def resonance_info_mapping
 @ Used for building a resonance tree below.
 <<Resonances: resonance info: TBP>>=
   procedure, private :: get_n_contributors => resonance_info_get_n_contributors
   procedure, private :: contains => resonance_info_contains
 <<Resonances: procedures>>=
   elemental function resonance_info_get_n_contributors (resonance) result (n)
     class(resonance_info_t), intent(in) :: resonance
     integer :: n
     if (allocated (resonance%contributors%c)) then
        n = size (resonance%contributors%c)
     else
        n = 0
     end if
   end function resonance_info_get_n_contributors
 
   elemental function resonance_info_contains (resonance, c) result (flag)
     class(resonance_info_t), intent(in) :: resonance
     integer, intent(in) :: c
     logical :: flag
     if (allocated (resonance%contributors%c)) then
        flag = any (resonance%contributors%c == c)
     else
        flag = .false.
     end if
   end function resonance_info_contains
 
 @ %def resonance_info_get_n_contributors
 @ %def resonance_info_contains
 @
 \subsection{Resonance history object}
 This data structure stores a set of resonances, i.e., the resonances that
 appear in a particular Feynman graph or, in the context of phase space, phase
 space diagram.
 <<Resonances: public>>=
   public :: resonance_history_t
 <<Resonances: types>>=
   type :: resonance_history_t
      type(resonance_info_t), dimension(:), allocatable :: resonances
      integer :: n_resonances = 0
   contains
    <<Resonances: resonance history: TBP>>
   end type resonance_history_t
 
 @ %def resonance_history_t
 @ Clear the resonance history.  Assuming that there are no
 pointer-allocated parts, a straightforward [[intent(out)]] will do.
 <<Resonances: resonance history: TBP>>=
   procedure :: clear => resonance_history_clear
 <<Resonances: procedures>>=
   subroutine resonance_history_clear (res_hist)
     class(resonance_history_t), intent(out) :: res_hist
   end subroutine resonance_history_clear
 
 @ %def resonance_history_clear
 @
 <<Resonances: resonance history: TBP>>=
   procedure :: copy => resonance_history_copy
 <<Resonances: procedures>>=
   subroutine resonance_history_copy (res_hist_in, res_hist_out)
     class(resonance_history_t), intent(in) :: res_hist_in
     type(resonance_history_t), intent(out) :: res_hist_out
     integer :: i
     res_hist_out%n_resonances = res_hist_in%n_resonances
     allocate (res_hist_out%resonances (size (res_hist_in%resonances)))
     do i = 1, size (res_hist_in%resonances)
        call res_hist_in%resonances(i)%copy (res_hist_out%resonances(i))
     end do
   end subroutine resonance_history_copy
 
 @ %def resonance_history_copy
 @
 <<Resonances: resonance history: TBP>>=
   procedure :: write => resonance_history_write
 <<Resonances: procedures>>=
   subroutine resonance_history_write (res_hist, unit, verbose, indent)
     class(resonance_history_t), intent(in) :: res_hist
     integer, optional, intent(in) :: unit
     logical, optional, intent(in) :: verbose
     integer, optional, intent(in) :: indent
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     call write_indent (u, indent)
     write(u, '(A,I0,A)') "Resonance history with ", &
          res_hist%n_resonances, " resonances:"
     do i = 1, res_hist%n_resonances
        call write_indent (u, indent)
        write (u, "(2x)", advance="no")
        call res_hist%resonances(i)%write (u, verbose)
     end do
   end subroutine resonance_history_write
 
 @ %def resonance_history_write
 @ Assignment.  Indirectly calls type-bound assignment for the contributors.
 
 Strictly speaking, this is redundant.  But NAGfor 6.208 intrinsic assignment
 crashes under certain conditions.
 <<Resonances: resonance history: TBP>>=
   procedure, private :: resonance_history_assign
   generic :: assignment(=) => resonance_history_assign
 <<Resonances: procedures>>=
   subroutine resonance_history_assign (res_hist_out, res_hist_in)
     class(resonance_history_t), intent(out) :: res_hist_out
     class(resonance_history_t), intent(in) :: res_hist_in
     if (allocated (res_hist_in%resonances)) then
        res_hist_out%resonances = res_hist_in%resonances
        res_hist_out%n_resonances = res_hist_in%n_resonances
     end if
   end subroutine resonance_history_assign
 
 @ %def resonance_history_assign
 @ Equality.  If this turns out to slow down the program, we should
 change the implementation or use hash codes.
 <<Resonances: resonance history: TBP>>=
   procedure, private :: resonance_history_equal
   generic :: operator(==) => resonance_history_equal
 <<Resonances: procedures>>=
   elemental function resonance_history_equal (rh1, rh2) result (equal)
     logical :: equal
     class(resonance_history_t), intent(in) :: rh1, rh2
     integer :: i
     equal = .false.
     if (rh1%n_resonances == rh2%n_resonances) then
        do i = 1, rh1%n_resonances
           if (.not. rh1%resonances(i) == rh2%resonances(i)) then
              return
           end if
        end do
        equal = .true.
     end if
   end function resonance_history_equal
 
 @ %def resonance_history_equal
 @ Check if a resonance history is a strict superset of another one.  This is
 true if the first one is nonempty and the second one is empty.
 Otherwise, we check if each entry of the second argument appears in
 the first one.
 <<Resonances: resonance history: TBP>>=
   procedure, private :: resonance_history_contains
   generic :: operator(.contains.) => resonance_history_contains
 @
 <<Resonances: procedures>>=
   elemental function resonance_history_contains (rh1, rh2) result (flag)
     logical :: flag
     class(resonance_history_t), intent(in) :: rh1, rh2
     integer :: i
     if (rh1%n_resonances > rh2%n_resonances) then
        flag = .true.
        do i = 1, rh2%n_resonances
           flag = flag .and. any (rh1%resonances == rh2%resonances(i))
        end do
     else
        flag = .false.
     end if
   end function resonance_history_contains
 
 @ %def resonance_history_contains
 @ Number of entries for dynamically extending the resonance-info array.
 <<Resonances: parameters>>=
   integer, parameter :: n_max_resonances = 10
 @
 <<Resonances: resonance history: TBP>>=
   procedure :: add_resonance => resonance_history_add_resonance
 <<Resonances: procedures>>=
   subroutine resonance_history_add_resonance (res_hist, resonance)
     class(resonance_history_t), intent(inout) :: res_hist
     type(resonance_info_t), intent(in) :: resonance
     type(resonance_info_t), dimension(:), allocatable :: tmp
     integer :: n, i
     call msg_debug (D_PHASESPACE, "resonance_history_add_resonance")
     if (.not. allocated (res_hist%resonances)) then
        n = 0
        allocate (res_hist%resonances (1))
     else
        n = res_hist%n_resonances
        allocate (tmp (n))
        do i = 1, n
           call res_hist%resonances(i)%copy (tmp(i))
        end do
        deallocate (res_hist%resonances)
        allocate (res_hist%resonances (n+1))
        do i = 1, n
           call tmp(i)%copy (res_hist%resonances(i))
        end do
        deallocate (tmp)
     end if
     call resonance%copy (res_hist%resonances(n+1))
     res_hist%n_resonances = n + 1
     call msg_debug &
          (D_PHASESPACE, "res_hist%n_resonances", res_hist%n_resonances)
   end subroutine resonance_history_add_resonance
 
 @ %def resonance_history_add_resonance
 @
 <<Resonances: resonance history: TBP>>=
   procedure :: remove_resonance => resonance_history_remove_resonance
 <<Resonances: procedures>>=
   subroutine resonance_history_remove_resonance (res_hist, i_res)
     class(resonance_history_t), intent(inout) :: res_hist
     integer, intent(in) :: i_res
     type(resonance_info_t), dimension(:), allocatable :: tmp_1, tmp_2
     integer :: i, j, n
     n = res_hist%n_resonances
     res_hist%n_resonances = n - 1
     if (res_hist%n_resonances == 0) then
        deallocate (res_hist%resonances)
     else
        if (i_res > 1) allocate (tmp_1(1:i_res-1))
        if (i_res < n) allocate (tmp_2(i_res+1:n))
        if (allocated (tmp_1)) then
           do i = 1, i_res - 1
              call res_hist%resonances(i)%copy (tmp_1(i))
           end do
        end if
        if (allocated (tmp_2)) then
           do i = i_res + 1, n
              call res_hist%resonances(i)%copy (tmp_2(i))
           end do
        end if
        deallocate (res_hist%resonances)
        allocate (res_hist%resonances (res_hist%n_resonances))
        j = 1
        if (allocated (tmp_1)) then
           do i = 1, i_res - 1
              call tmp_1(i)%copy (res_hist%resonances(j))
              j = j + 1
           end do
           deallocate (tmp_1)
        end if
        if (allocated (tmp_2)) then
           do i = i_res + 1, n
              call tmp_2(i)%copy (res_hist%resonances(j))
              j = j + 1
           end do
           deallocate (tmp_2)
        end if
     end if
   end subroutine resonance_history_remove_resonance
 
 @ %def resonance_history_remove_resonance
 @
 <<Resonances: resonance history: TBP>>=
   procedure :: add_offset => resonance_history_add_offset
 <<Resonances: procedures>>=
   subroutine resonance_history_add_offset (res_hist, n)
     class(resonance_history_t), intent(inout) :: res_hist
     integer, intent(in) :: n
     integer :: i_res
     do i_res = 1, res_hist%n_resonances
        associate (contributors => res_hist%resonances(i_res)%contributors%c)
           contributors = contributors + n
        end associate
     end do
   end subroutine resonance_history_add_offset
 
 @ %def resonance_history_add_offset
 @
 <<Resonances: resonance history: TBP>>=
   procedure :: contains_leg => resonance_history_contains_leg
 <<Resonances: procedures>>=
   function resonance_history_contains_leg (res_hist, i_leg) result (val)
     logical :: val
     class(resonance_history_t), intent(in) :: res_hist
     integer, intent(in) :: i_leg
     integer :: i_res
     val = .false.
     do i_res = 1, res_hist%n_resonances
        if (any (res_hist%resonances(i_res)%contributors%c == i_leg)) then
           val = .true.
           exit
        end if
     end do
   end function resonance_history_contains_leg
 
 @ %def resonance_history_contains_leg
 @
 <<Resonances: resonance history: TBP>>=
   procedure :: mapping => resonance_history_mapping
 <<Resonances: procedures>>=
   function resonance_history_mapping (res_hist, p, i_gluon) result (p_map)
     real(default) :: p_map
     class(resonance_history_t), intent(in) :: res_hist
     type(vector4_t), intent(in), dimension(:) :: p
     integer, intent(in), optional :: i_gluon
     integer :: i_res
     real(default) :: s
     p_map = one
     do i_res = 1, res_hist%n_resonances
        associate (res => res_hist%resonances(i_res))
           s = compute_resonance_mass (p, res%contributors%c, i_gluon)**2
           p_map = p_map * res%mapping (s)
        end associate
     end do
   end function resonance_history_mapping
 
 @ %def resonance_history_mapping
 @ This predicate is true if all resonances in the history have exactly
 [[n]] contributors.  For instance, if $n=2$, all resonances have a
 two-particle decay.
 <<Resonances: resonance history: TBP>>=
   procedure :: only_has_n_contributors => resonance_history_only_has_n_contributors
 <<Resonances: procedures>>=
   function resonance_history_only_has_n_contributors (res_hist, n) result (value)
     logical :: value
     class(resonance_history_t), intent(in) :: res_hist
     integer, intent(in) :: n
     integer :: i_res
     value = .true.
     do i_res = 1, res_hist%n_resonances
        associate (res => res_hist%resonances(i_res))
           value = value .and. size (res%contributors%c) == n
        end associate
     end do
   end function resonance_history_only_has_n_contributors
 
 @ %def resonance_history_only_has_n_contributors
 @
 <<Resonances: resonance history: TBP>>=
   procedure :: has_flavor => resonance_history_has_flavor
 <<Resonances: procedures>>=
   function resonance_history_has_flavor (res_hist, flv) result (has_flv)
     logical :: has_flv
     class(resonance_history_t), intent(in) :: res_hist
     type(flavor_t), intent(in) :: flv
     integer :: i
     has_flv = .false.
     do i = 1, res_hist%n_resonances
        has_flv = has_flv .or. res_hist%resonances(i)%flavor == flv
     end do
   end function resonance_history_has_flavor
 
 @ %def resonance_history_has_flavor
 @
 \subsection{Kinematics}
 Evaluate the distance from a resonance.  The distance is given by
 $|p^2-m^2|/(m\Gamma)$.  For $\Gamma\ll m$, this is the relative
 distance from the resonance peak in units of the half-width.
 <<Resonances: resonance info: TBP>>=
   procedure :: evaluate_distance => resonance_info_evaluate_distance
 <<Resonances: procedures>>=
   subroutine resonance_info_evaluate_distance (res_info, p, dist)
     class(resonance_info_t), intent(in) :: res_info
     type(vector4_t), dimension(:), intent(in) :: p
     real(default), intent(out) :: dist
     real(default) :: m, w
     type(vector4_t) :: q
     m = res_info%flavor%get_mass ()
     w = res_info%flavor%get_width ()
     q = sum (p(res_info%contributors%c))
     dist = abs (q**2 - m**2) / (m * w)
   end subroutine resonance_info_evaluate_distance
 
 @ %def resonance_info_evaluate_distance
 @
 Evaluate the array of distances from a resonance history.  We assume that the
 array has been allocated with correct size, namely the number of resonances in
 this history.
 <<Resonances: resonance history: TBP>>=
   procedure :: evaluate_distances => resonance_history_evaluate_distances
 <<Resonances: procedures>>=
   subroutine resonance_history_evaluate_distances (res_hist, p, dist)
     class(resonance_history_t), intent(in) :: res_hist
     type(vector4_t), dimension(:), intent(in) :: p
     real(default), dimension(:), intent(out) :: dist
     integer :: i
     do i = 1, res_hist%n_resonances
        call res_hist%resonances(i)%evaluate_distance (p, dist(i))
     end do
   end subroutine resonance_history_evaluate_distances
 
 @ %def resonance_history_evaluate_distances
 @ Use the distance to determine a Gaussian turnoff factor for a
 resonance.  The factor is given by a Gaussian function
 $e^{-d^2/\sigma^2}$, where $\sigma$ is the [[gw]] parameter multiplied
 by the resonance width, and $d$ is the distance (see above).  So, for
 $d=\sigma$, the factor is $0.37$, and for $d=2\sigma$ we get $0.018$.
 
 If the [[gw]] factor is less or equal to zero, return $1$.
 <<Resonances: resonance info: TBP>>=
   procedure :: evaluate_gaussian => resonance_info_evaluate_gaussian
 <<Resonances: procedures>>=
   function resonance_info_evaluate_gaussian (res_info, p, gw) result (factor)
     class(resonance_info_t), intent(in) :: res_info
     type(vector4_t), dimension(:), intent(in) :: p
     real(default), intent(in) :: gw
     real(default) :: factor
     real(default) :: dist, w
     if (gw > 0) then
        w = res_info%flavor%get_width ()
        call res_info%evaluate_distance (p, dist)
        factor = exp (- (dist / (gw * w)) **2)
     else
        factor = 1
     end if
   end function resonance_info_evaluate_gaussian
 
 @ %def resonance_info_evaluate_gaussian
 @ The Gaussian factor of the history is the product of all factors.
 <<Resonances: resonance history: TBP>>=
   procedure :: evaluate_gaussian => resonance_history_evaluate_gaussian
 <<Resonances: procedures>>=
   function resonance_history_evaluate_gaussian (res_hist, p, gw) result (factor)
     class(resonance_history_t), intent(in) :: res_hist
     type(vector4_t), dimension(:), intent(in) :: p
     real(default), intent(in) :: gw
     real(default), dimension(:), allocatable :: dist
     real(default) :: factor
     integer :: i
     factor = 1
     do i = 1, res_hist%n_resonances
        factor = factor * res_hist%resonances(i)%evaluate_gaussian (p, gw)
     end do
   end function resonance_history_evaluate_gaussian
 
 @ %def resonance_history_evaluate_gaussian
 @
 Use the distances to determine whether the resonance history can qualify as
 on-shell.  The criterion is whether the distance is greater than the number of
 width values as given by [[on_shell_limit]].
 <<Resonances: resonance info: TBP>>=
   procedure :: is_on_shell => resonance_info_is_on_shell
 <<Resonances: procedures>>=
   function resonance_info_is_on_shell (res_info, p, on_shell_limit) &
        result (flag)
     class(resonance_info_t), intent(in) :: res_info
     type(vector4_t), dimension(:), intent(in) :: p
     real(default), intent(in) :: on_shell_limit
     logical :: flag
     real(default) :: dist
     call res_info%evaluate_distance (p, dist)
     flag = dist < on_shell_limit
   end function resonance_info_is_on_shell
 
 @ %def resonance_info_is_on_shell
 @
 <<Resonances: resonance history: TBP>>=
   procedure :: is_on_shell => resonance_history_is_on_shell
 <<Resonances: procedures>>=
   function resonance_history_is_on_shell (res_hist, p, on_shell_limit) &
        result (flag)
     class(resonance_history_t), intent(in) :: res_hist
     type(vector4_t), dimension(:), intent(in) :: p
     real(default), intent(in) :: on_shell_limit
     logical :: flag
     integer :: i
     flag = .true.
     do i = 1, res_hist%n_resonances
        flag = flag .and. res_hist%resonances(i)%is_on_shell (p, on_shell_limit)
     end do
   end function resonance_history_is_on_shell
 
 @ %def resonance_history_is_on_shell
 @
 \subsection{OMega restriction strings}
 One application of the resonance module is creating restriction
 strings that can be fed into process definitions with the OMega
 generator.  Since OMega counts the incoming particles first, we have
 to supply [[n_in]] as an offset.
 <<Resonances: resonance info: TBP>>=
   procedure :: as_omega_string => resonance_info_as_omega_string
 <<Resonances: resonance history: TBP>>=
   procedure :: as_omega_string => resonance_history_as_omega_string
 <<Resonances: procedures>>=
   function resonance_info_as_omega_string (res_info, n_in) result (string)
     class(resonance_info_t), intent(in) :: res_info
     integer, intent(in) :: n_in
     type(string_t) :: string
     integer :: i
     string = ""
     if (allocated (res_info%contributors%c)) then
        do i = 1, size (res_info%contributors%c)
           if (i > 1)  string = string // "+"
           string = string // str (res_info%contributors%c(i) + n_in)
        end do
        string = string // "~" // res_info%flavor%get_name ()
     end if
   end function resonance_info_as_omega_string
 
   function resonance_history_as_omega_string (res_hist, n_in) result (string)
     class(resonance_history_t), intent(in) :: res_hist
     integer, intent(in) :: n_in
     type(string_t) :: string
     integer :: i
     string = ""
     do i = 1, res_hist%n_resonances
        if (i > 1)  string = string // " && "
        string = string // res_hist%resonances(i)%as_omega_string (n_in)
     end do
   end function resonance_history_as_omega_string
 
 @ %def resonance_info_as_omega_string
 @ %def resonance_history_as_omega_string
 @
 \subsection{Resonance history as tree}
 If we want to organize the resonances and their decay products, it can be
 useful to have them explicitly as a tree structure.  We implement this in the
 traditional event-record form with the resonances sorted by decreasing number
 of contributors, and their decay products added as an extra array.
 <<Resonances: public>>=
   public :: resonance_tree_t
 <<Resonances: types>>=
   type :: resonance_branch_t
      integer :: i = 0
      type(flavor_t) :: flv
      integer, dimension(:), allocatable :: r_child
      integer, dimension(:), allocatable :: o_child
   end type resonance_branch_t
 
   type :: resonance_tree_t
      private
      integer :: n = 0
      type(resonance_branch_t), dimension(:), allocatable :: branch
    contains
    <<Resonances: resonance tree: TBP>>
   end type resonance_tree_t
 
 
 @ %def resonance_branch_t resonance_tree_t
 @
 <<Resonances: resonance tree: TBP>>=
   procedure :: write => resonance_tree_write
 <<Resonances: procedures>>=
   subroutine resonance_tree_write (tree, unit, indent)
     class(resonance_tree_t), intent(in) :: tree
     integer, intent(in), optional :: unit, indent
     integer :: u, b, c
     u = given_output_unit (unit)
     call write_indent (u, indent)
     write (u, "(A)", advance="no")  "Resonance tree:"
     if (tree%n > 0) then
        write (u, *)
        do b = 1, tree%n
           call write_indent (u, indent)
           write (u, "(2x,'r',I0,':',1x)", advance="no")  b
           associate (branch => tree%branch(b))
             call branch%flv%write (u)
             write (u, "(1x,'=>')", advance="no")
             if (allocated (branch%r_child)) then
                do c = 1, size (branch%r_child)
                   write (u, "(1x,'r',I0)", advance="no")  branch%r_child(c)
                end do
             end if
             if (allocated (branch%o_child)) then
                do c = 1, size (branch%o_child)
                   write (u, "(1x,I0)", advance="no")  branch%o_child(c)
                end do
             end if
             write (u, *)
           end associate
        end do
     else
        write (u, "(1x,A)")  "[empty]"
     end if
   end subroutine resonance_tree_write
 
 @ %def resonance_tree_write
 @ Contents.
 <<Resonances: resonance tree: TBP>>=
   procedure :: get_n_resonances => resonance_tree_get_n_resonances
   procedure :: get_flv => resonance_tree_get_flv
 <<Resonances: procedures>>=
   function resonance_tree_get_n_resonances (tree) result (n)
     class(resonance_tree_t), intent(in) :: tree
     integer :: n
     n = tree%n
   end function resonance_tree_get_n_resonances
 
   function resonance_tree_get_flv (tree, i) result (flv)
     class(resonance_tree_t), intent(in) :: tree
     integer, intent(in) :: i
     type(flavor_t) :: flv
     flv = tree%branch(i)%flv
   end function resonance_tree_get_flv
 
 @ %def resonance_tree_get_n_resonances
 @ %def resonance_tree_get_flv
 @ Return the shifted indices of the resonance children for branch [[i]].  For
 a child which is itself a resonance, add [[offset_r]] to the index value.  For
 the others, add [[offset_o]].  Combine both in a single array.
 <<Resonances: resonance tree: TBP>>=
   procedure :: get_children => resonance_tree_get_children
 <<Resonances: procedures>>=
   function resonance_tree_get_children (tree, i, offset_r, offset_o) &
        result (child)
     class(resonance_tree_t), intent(in) :: tree
     integer, intent(in) :: i, offset_r, offset_o
     integer, dimension(:), allocatable :: child
     integer :: nr, no
     associate (branch => tree%branch(i))
       nr = size (branch%r_child)
       no = size (branch%o_child)
       allocate (child (nr + no))
       child(1:nr) = branch%r_child + offset_r
       child(nr+1:nr+no) = branch%o_child + offset_o
     end associate
   end function resonance_tree_get_children
 
 @ %def resonance_tree_get_children
 @ Transform a resonance history into a resonance tree.
 Algorithm:
 \begin{enumerate}
 \item
   Determine a mapping of the resonance array, such that in the new array the
   resonances are ordered by decreasing number of contributors.
 \item
   Copy the flavor entries to the mapped array.
 \item
   Scan all resonances and, for each one, find a resonance that is its parent.
   Since the resonances are ordered, later matches overwrite earlier ones.  The
   last match is the correct one.  Then scan again and, for each resonance,
   collect the resonances that have it as parent.  This is the set of child
   resonances.
 \item
   Analogously, scan all outgoing particles that appear in any of the
   contributors list.  Determine their immediate parent as above, and set the
   child outgoing parents for the resonances, as above.
 \end{enumerate}
 <<Resonances: resonance history: TBP>>=
   procedure :: to_tree => resonance_history_to_tree
 <<Resonances: procedures>>=
   subroutine resonance_history_to_tree (res_hist, tree)
     class(resonance_history_t), intent(in) :: res_hist
     type(resonance_tree_t), intent(out) :: tree
     integer :: nr
     integer, dimension(:), allocatable :: r_branch, r_source
 
     nr = res_hist%n_resonances
     tree%n = nr
     allocate (tree%branch (tree%n), r_branch (tree%n), r_source (tree%n))
     if (tree%n > 0) then
        call find_branch_ordering ()
        call set_flavors ()
        call set_child_resonances ()
        call set_child_outgoing ()
     end if
 
   contains
 
     subroutine find_branch_ordering ()
       integer, dimension(:), allocatable :: nc_array
       integer :: r, ir, nc
       allocate (nc_array (tree%n))
       nc_array(:) = res_hist%resonances%get_n_contributors ()
       ir = 0
       do nc = maxval (nc_array), minval (nc_array), -1
          do r = 1, nr
             if (nc_array(r) == nc) then
                ir = ir + 1
                r_branch(r) = ir
                r_source(ir) = r
             end if
          end do
       end do
     end subroutine find_branch_ordering
 
     subroutine set_flavors ()
       integer :: r
       do r = 1, nr
          tree%branch(r_branch(r))%flv = res_hist%resonances(r)%flavor
       end do
     end subroutine set_flavors
 
     subroutine set_child_resonances ()
       integer, dimension(:), allocatable :: r_child, r_parent
       integer :: r, ir, pr
       allocate (r_parent (nr), source = 0)
       SCAN_RES: do r = 1, nr
          associate (this_res => res_hist%resonances(r))
            SCAN_PARENT: do ir = 1, nr
               pr = r_source(ir)
               if (pr == r)  cycle SCAN_PARENT
               if (all (res_hist%resonances(pr)%contains &
                    (this_res%contributors%c))) then
                  r_parent (r) = pr
               end if
            end do SCAN_PARENT
          end associate
       end do SCAN_RES
       allocate (r_child (nr), source = [(r, r = 1, nr)])
       do r = 1, nr
          ir = r_branch(r)
          tree%branch(ir)%r_child = r_branch (pack (r_child, r_parent == r))
       end do
     end subroutine set_child_resonances
 
     subroutine set_child_outgoing ()
       integer, dimension(:), allocatable :: o_child, o_parent
       integer :: o_max, r, o, ir
       o_max = 0
       do r = 1, nr
          associate (this_res => res_hist%resonances(r))
            o_max = max (o_max, maxval (this_res%contributors%c))
          end associate
       end do
       allocate (o_parent (o_max), source=0)
       SCAN_OUT: do o = 1, o_max
          SCAN_PARENT: do ir = 1, nr
             r = r_source(ir)
             associate (this_res => res_hist%resonances(r))
               if (this_res%contains (o))  o_parent(o) = r
             end associate
          end do SCAN_PARENT
       end do SCAN_OUT
       allocate (o_child (o_max), source = [(o, o = 1, o_max)])
       do r = 1, nr
          ir = r_branch(r)
          tree%branch(ir)%o_child = pack (o_child, o_parent == r)
       end do
     end subroutine set_child_outgoing
 
   end subroutine resonance_history_to_tree
 
 @ %def resonance_history_to_tree
 @
 \subsection{Resonance history set}
 This is an array of resonance histories.  The elements are supposed to
 be unique.  That is, entering a new element is successful only if the
 element does not already exist.
 
 The current implementation uses a straightforward linear search for
 comparison.  If this should become an issue, we may change the
 implementation to a hash table.  To keep this freedom, the set should
 be an opaque object.  In fact, we expect to use it as a transient data
 structure.  Once the set is complete, we transform it into a
 contiguous array.
 <<Resonances: public>>=
   public :: resonance_history_set_t
 <<Resonances: types>>=
   type :: index_array_t
      integer, dimension(:), allocatable :: i
   end type index_array_t
 
   type :: resonance_history_set_t
      private
      logical :: complete = .false.
      integer :: n_filter = 0
      type(resonance_history_t), dimension(:), allocatable :: history
      type(index_array_t), dimension(:), allocatable :: contains_this
      type(resonance_tree_t), dimension(:), allocatable :: tree
      integer :: last = 0
    contains
    <<Resonances: resonance history set: TBP>>
   end type resonance_history_set_t
 
 @ %def resonance_history_set_t
 @ Display.
 
 The tree-format version of the histories is displayed only upon request.
 <<Resonances: resonance history set: TBP>>=
   procedure :: write => resonance_history_set_write
 <<Resonances: procedures>>=
   subroutine resonance_history_set_write (res_set, unit, indent, show_trees)
     class(resonance_history_set_t), intent(in) :: res_set
     integer, intent(in), optional :: unit
     integer, intent(in), optional :: indent
     logical, intent(in), optional :: show_trees
     logical :: s_trees
     integer :: u, i, j, ind
     u = given_output_unit (unit)
     s_trees = .false.;  if (present (show_trees))  s_trees = show_trees
     ind = 0;  if (present (indent))  ind = indent
     call write_indent (u, indent)
     write (u, "(A)", advance="no")  "Resonance history set:"
     if (res_set%complete) then
        write (u, *)
     else
        write (u, "(1x,A)")  "[incomplete]"
     end if
     do i = 1, res_set%last
        write (u, "(1x,I0,1x)", advance="no")  i
        call res_set%history(i)%write (u, verbose=.false., indent=indent)
        if (allocated (res_set%contains_this)) then
           call write_indent (u, indent)
           write (u, "(3x,A)", advance="no")  "contained in ("
           do j = 1, size (res_set%contains_this(i)%i)
              if (j>1)  write (u, "(',')", advance="no")
              write (u, "(I0)", advance="no")  res_set%contains_this(i)%i(j)
           end do
           write (u, "(A)")  ")"
        end if
        if (s_trees .and. allocated (res_set%tree)) then
           call res_set%tree(i)%write (u, ind + 1)
        end if
     end do
   end subroutine resonance_history_set_write
 
 @ %def resonance_history_set_write
 @ Initialization.  The default initial size is 16 elements, to be doubled in
 size repeatedly as needed.
 <<Resonances: parameters>>=
   integer, parameter :: resonance_history_set_initial_size = 16
 @ %def resonance_history_set_initial_size = 16
 <<Resonances: resonance history set: TBP>>=
   procedure :: init => resonance_history_set_init
 <<Resonances: procedures>>=
   subroutine resonance_history_set_init (res_set, n_filter, initial_size)
     class(resonance_history_set_t), intent(out) :: res_set
     integer, intent(in), optional :: n_filter
     integer, intent(in), optional :: initial_size
     if (present (n_filter))  res_set%n_filter = n_filter
     if (present (initial_size)) then
        allocate (res_set%history (initial_size))
     else
        allocate (res_set%history (resonance_history_set_initial_size))
     end if
   end subroutine resonance_history_set_init
 
 @ %def resonance_history_set_init
 @ Enter an entry: append to the array if it does not yet exist, expand
 as needed.  If a [[n_filter]] value has been provided, enter the
 resonance only if it fulfils the requirement.
 
 An empty resonance history is entered only if the [[trivial]] flag is set.
 <<Resonances: resonance history set: TBP>>=
   procedure :: enter => resonance_history_set_enter
 <<Resonances: procedures>>=
   subroutine resonance_history_set_enter (res_set, res_history, trivial)
     class(resonance_history_set_t), intent(inout) :: res_set
     type(resonance_history_t), intent(in) :: res_history
     logical, intent(in), optional :: trivial
     integer :: i, new
     if (res_history%n_resonances == 0) then
        if (present (trivial)) then
           if (.not. trivial) return
        else
           return
        end if
     end if
     if (res_set%n_filter > 0) then
        if (.not. res_history%only_has_n_contributors (res_set%n_filter))  return
     end if
     do i = 1, res_set%last
        if (res_set%history(i) == res_history)  return
     end do
     new = res_set%last + 1
     if (new > size (res_set%history))  call res_set%expand ()
     res_set%history(new) = res_history
     res_set%last = new
   end subroutine resonance_history_set_enter
 
 @ %def resonance_history_set_enter
 @ Freeze the resonance history set: determine the array that determines
 in which other resonance histories a particular history is contained.
 
 This can only be done once, and once this is done, no further histories can be
 entered.
 <<Resonances: resonance history set: TBP>>=
   procedure :: freeze => resonance_history_set_freeze
 <<Resonances: procedures>>=
   subroutine resonance_history_set_freeze (res_set)
     class(resonance_history_set_t), intent(inout) :: res_set
     integer :: i, n, c
     logical, dimension(:), allocatable :: contains_this
     integer, dimension(:), allocatable :: index_array
     n = res_set%last
     allocate (contains_this (n))
     allocate (index_array (n), source = [(i, i=1, n)])
     allocate (res_set%contains_this (n))
     do i = 1, n
        contains_this = resonance_history_contains &
             (res_set%history(1:n), res_set%history(i))
        c = count (contains_this)
        allocate (res_set%contains_this(i)%i (c))
        res_set%contains_this(i)%i = pack (index_array, contains_this)
     end do
     allocate (res_set%tree (n))
     do i = 1, n
        call res_set%history(i)%to_tree (res_set%tree(i))
     end do
     res_set%complete = .true.
   end subroutine resonance_history_set_freeze
 
 @ %def resonance_history_set_freeze
 @ Determine the histories (in form of their indices in the array) that can be
 considered on-shell, given a set of momenta and a maximum distance.  The
 distance from the resonance is measured in multiples of the resonance width.
 
 Note that the momentum array must only contain the outgoing particles.
 
 If a particular history is on-shell, but there is another history which
 contains this and also is on-shell, only the latter is retained.
 <<Resonances: resonance history set: TBP>>=
   procedure :: determine_on_shell_histories &
        => resonance_history_set_determine_on_shell_histories
 <<Resonances: procedures>>=
   subroutine resonance_history_set_determine_on_shell_histories &
        (res_set, p, on_shell_limit, index_array)
     class(resonance_history_set_t), intent(in) :: res_set
     type(vector4_t), dimension(:), intent(in) :: p
     real(default), intent(in) :: on_shell_limit
     integer, dimension(:), allocatable, intent(out) :: index_array
     integer :: n, i
     integer, dimension(:), allocatable :: i_array
     if (res_set%complete) then
        n = res_set%last
        allocate (i_array (n), source=0)
        do i = 1, n
           if (res_set%history(i)%is_on_shell (p, on_shell_limit))  i_array(i) = i
        end do
        do i = 1, n
           if (any (i_array(res_set%contains_this(i)%i) /= 0)) then
              i_array(i) = 0
           end if
        end do
        allocate (index_array (count (i_array /= 0)))
        index_array(:) = pack (i_array, i_array /= 0)
     end if
   end subroutine resonance_history_set_determine_on_shell_histories
 
 @ %def resonance_history_set_determine_on_shell_histories
 @ For the selected history, compute the Gaussian turnoff factor.
 The turnoff parameter is [[gw]].
 <<Resonances: resonance history set: TBP>>=
   procedure :: evaluate_gaussian => resonance_history_set_evaluate_gaussian
 <<Resonances: procedures>>=
   function resonance_history_set_evaluate_gaussian (res_set, p, gw, i) &
        result (factor)
     class(resonance_history_set_t), intent(in) :: res_set
     type(vector4_t), dimension(:), intent(in) :: p
     real(default), intent(in) :: gw
     integer, intent(in) :: i
     real(default) :: factor
     factor = res_set%history(i)%evaluate_gaussian (p, gw)
   end function resonance_history_set_evaluate_gaussian
 
 @ %def resonance_history_set_evaluate_gaussian
 @ Return the number of histories.  This is zero if there are none, or
 if [[freeze]] has not been called yet.
 <<Resonances: resonance history set: TBP>>=
   procedure :: get_n_history => resonance_history_set_get_n_history
 <<Resonances: procedures>>=
   function resonance_history_set_get_n_history (res_set) result (n)
     class(resonance_history_set_t), intent(in) :: res_set
     integer :: n
     if (res_set%complete) then
        n = res_set%last
     else
        n = 0
     end if
   end function resonance_history_set_get_n_history
 
 @ %def resonance_history_set_get_n_history
 @ Return a single history.
 <<Resonances: resonance history set: TBP>>=
   procedure :: get_history => resonance_history_set_get_history
 <<Resonances: procedures>>=
   function resonance_history_set_get_history (res_set, i) result (res_history)
     class(resonance_history_set_t), intent(in) :: res_set
     integer, intent(in) :: i
     type(resonance_history_t) :: res_history
     if (res_set%complete .and. i <= res_set%last) then
        res_history = res_set%history(i)
     end if
   end function resonance_history_set_get_history
 
 @ %def resonance_history_set_get_history
 @ Conversion to a plain array, sized correctly.
 <<Resonances: resonance history set: TBP>>=
   procedure :: to_array => resonance_history_set_to_array
 <<Resonances: procedures>>=
   subroutine resonance_history_set_to_array (res_set, res_history)
     class(resonance_history_set_t), intent(in) :: res_set
     type(resonance_history_t), dimension(:), allocatable, intent(out) :: res_history
     if (res_set%complete) then
        allocate (res_history (res_set%last))
        res_history(:) = res_set%history(1:res_set%last)
     end if
   end subroutine resonance_history_set_to_array
 
 @ %def resonance_history_set_to_array
 @ Return a selected history in tree form.
 <<Resonances: resonance history set: TBP>>=
   procedure :: get_tree => resonance_history_set_get_tree
 <<Resonances: procedures>>=
   subroutine resonance_history_set_get_tree (res_set, i, res_tree)
     class(resonance_history_set_t), intent(in) :: res_set
     integer, intent(in) :: i
     type(resonance_tree_t), intent(out) :: res_tree
     if (res_set%complete) then
        res_tree = res_set%tree(i)
     end if
   end subroutine resonance_history_set_get_tree
 
 @ %def resonance_history_set_to_array
 @ Expand: double the size of the array.  We do not need this in the API.
 <<Resonances: resonance history set: TBP>>=
   procedure, private :: expand => resonance_history_set_expand
 <<Resonances: procedures>>=
   subroutine resonance_history_set_expand (res_set)
     class(resonance_history_set_t), intent(inout) :: res_set
     type(resonance_history_t), dimension(:), allocatable :: history_new
     integer :: s
     s = size (res_set%history)
     allocate (history_new (2 * s))
     history_new(1:s) = res_set%history(1:s)
     call move_alloc (history_new, res_set%history)
   end subroutine resonance_history_set_expand
 
 @ %def resonance_history_set_expand
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[resonances_ut.f90]]>>=
 <<File header>>
 
 module resonances_ut
   use unit_tests
   use resonances_uti
 
 <<Standard module head>>
 
 <<Resonances: public test>>
 
 contains
 
 <<Resonances: test driver>>
 
 end module resonances_ut
 @ %def resonances_ut
 @
 <<[[resonances_uti.f90]]>>=
 <<File header>>
 
 module resonances_uti
 
 <<Use kinds>>
 <<Use strings>>
   use format_defs, only: FMF_12
   use lorentz, only: vector4_t, vector4_at_rest
   use model_data, only: model_data_t
   use flavors, only: flavor_t
 
   use resonances, only: resonance_history_t
 
   use resonances
 
 <<Standard module head>>
 
 <<Resonances: test declarations>>
 
 contains
 
 <<Resonances: tests>>
 
 end module resonances_uti
 @ %def resonances_ut
 @ API: driver for the unit tests below.
 <<Resonances: public test>>=
   public :: resonances_test
 <<Resonances: test driver>>=
   subroutine resonances_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Resonances: execute tests>>
   end subroutine resonances_test
 
 @  %def resonances_test
 @ Basic operations on a resonance history object.
 <<Resonances: execute tests>>=
   call test (resonances_1, "resonances_1", &
        "check resonance history setup", &
        u, results)
 <<Resonances: test declarations>>=
   public :: resonances_1
 <<Resonances: tests>>=
   subroutine resonances_1 (u)
     integer, intent(in) :: u
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(model_data_t), target :: model
 
     write (u, "(A)")  "* Test output: resonances_1"
     write (u, "(A)")  "*   Purpose: test resonance history setup"
     write (u, "(A)")
 
     write (u, "(A)")  "* Read model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Empty resonance history"
     write (u, "(A)")
 
     call res_history%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Add resonance"
     write (u, "(A)")
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Add another resonance"
     write (u, "(A)")
 
     call res_info%init (7, 23, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Remove resonance"
     write (u, "(A)")
 
     call res_history%remove_resonance (1)
     call res_history%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonances_1"
 
   end subroutine resonances_1
 
 @ %def resonances_1
 @ Basic operations on a resonance history object.
 <<Resonances: execute tests>>=
   call test (resonances_2, "resonances_2", &
        "check O'Mega restriction strings", &
        u, results)
 <<Resonances: test declarations>>=
   public :: resonances_2
 <<Resonances: tests>>=
   subroutine resonances_2 (u)
     integer, intent(in) :: u
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(model_data_t), target :: model
     type(string_t) :: restrictions
 
     write (u, "(A)")  "* Test output: resonances_2"
     write (u, "(A)")  "*   Purpose: test OMega restrictions strings &
          &for resonance history"
     write (u, "(A)")
 
     write (u, "(A)")  "* Read model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Empty resonance history"
     write (u, "(A)")
 
     restrictions = res_history%as_omega_string (2)
     write (u, "(A,A,A)")  "restrictions = '", char (restrictions), "'"
 
     write (u, "(A)")
     write (u, "(A)")  "* Add resonance"
     write (u, "(A)")
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     restrictions = res_history%as_omega_string (2)
     write (u, "(A,A,A)")  "restrictions = '", char (restrictions), "'"
 
     write (u, "(A)")
     write (u, "(A)")  "* Add another resonance"
     write (u, "(A)")
 
     call res_info%init (7, 23, model, 5)
     call res_history%add_resonance (res_info)
     restrictions = res_history%as_omega_string (2)
     write (u, "(A,A,A)")  "restrictions = '", char (restrictions), "'"
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonances_2"
 
   end subroutine resonances_2
 
 @ %def resonances_2
 @ Basic operations on a resonance history set.
 <<Resonances: execute tests>>=
   call test (resonances_3, "resonances_3", &
        "check resonance history set", &
        u, results)
 <<Resonances: test declarations>>=
   public :: resonances_3
 <<Resonances: tests>>=
   subroutine resonances_3 (u)
     integer, intent(in) :: u
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(resonance_history_t), dimension(:), allocatable :: res_histories
     type(resonance_history_set_t) :: res_set
     type(model_data_t), target :: model
     integer :: i
 
     write (u, "(A)")  "* Test output: resonances_3"
     write (u, "(A)")  "*   Purpose: test resonance history set"
     write (u, "(A)")
 
     write (u, "(A)")  "* Read model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize resonance history set"
     write (u, "(A)")
 
     call res_set%init (initial_size = 2)
 
     write (u, "(A)")  "* Add resonance histories, one at a time"
     write (u, "(A)")
 
     call res_history%write (u)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     write (u, *)
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     write (u, *)
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_info%init (7, 23, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     write (u, *)
 
     call res_info%init (7, 23, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     write (u, *)
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     write (u, *)
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_info%init (7, 25, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     call res_set%freeze ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Result"
     write (u, "(A)")
 
     call res_set%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Queries"
     write (u, "(A)")
 
     write (u, "(A,1x,I0)")  "n_history =", res_set%get_n_history ()
 
     write (u, "(A)")
     write (u, "(A)")  "History #2:"
 
     res_history = res_set%get_history (2)
     call res_history%write (u, indent=1)
     call res_history%clear ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Result in array form"
 
     call res_set%to_array (res_histories)
     do i = 1, size (res_histories)
        write (u, *)
        call res_histories(i)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Re-initialize resonance history set with filter n=2"
     write (u, "(A)")
 
     call res_set%init (n_filter = 2)
 
     write (u, "(A)")  "* Add resonance histories, one at a time"
     write (u, "(A)")
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     write (u, *)
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_info%init (7, 23, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     write (u, *)
 
     call res_info%init (7, 23, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     write (u, *)
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     call res_set%freeze ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Result"
     write (u, "(A)")
 
     call res_set%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonances_3"
 
   end subroutine resonances_3
 
 @ %def resonances_3
 @ Probe momenta for resonance histories
 <<Resonances: execute tests>>=
   call test (resonances_4, "resonances_4", &
        "resonance history: distance evaluation", &
        u, results)
 <<Resonances: test declarations>>=
   public :: resonances_4
 <<Resonances: tests>>=
   subroutine resonances_4 (u)
     integer, intent(in) :: u
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(model_data_t), target :: model
     type(flavor_t) :: fw, fz
     real(default) :: mw, mz, ww, wz
     type(vector4_t), dimension(3) :: p
     real(default), dimension(2) :: dist
     real(default) :: gw, factor
     integer :: i
 
     write (u, "(A)")  "* Test output: resonances_4"
     write (u, "(A)")  "*   Purpose: test resonance history evaluation"
     write (u, "(A)")
 
     write (u, "(A)")  "* Read model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* W and Z parameters"
     write (u, "(A)")
 
     call fw%init (24, model)
     call fz%init (23, model)
     mw = fw%get_mass ()
     ww = fw%get_width ()
     mz = fz%get_mass ()
     wz = fz%get_width ()
 
     write (u, "(A,1x," // FMF_12 // ")")  "mW  =", mw
     write (u, "(A,1x," // FMF_12 // ")")  "wW  =", ww
     write (u, "(A,1x," // FMF_12 // ")")  "mZ  =", mz
     write (u, "(A,1x," // FMF_12 // ")")  "wZ  =", wz
 
     write (u, "(A)")
     write (u, "(A)")  "* Gaussian width parameter"
     write (u, "(A)")
 
     gw = 2
     write (u, "(A,1x," // FMF_12 // ")")  "gw  =", gw
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup resonance histories"
     write (u, "(A)")
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
 
     call res_info%init (7, 23, model, 5)
     call res_history%add_resonance (res_info)
 
     call res_history%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup zero momenta"
     write (u, "(A)")
 
     do i = 1, 3
        call p(i)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate distances from resonances"
     write (u, "(A)")
 
     call res_history%evaluate_distances (p, dist)
     write (u, "(A,1x," // FMF_12 // ")")  "distance (W) =", dist(1)
     write (u, "(A,1x," // FMF_12 // ")")  "m/w (W)      =", mw / ww
     write (u, "(A,1x," // FMF_12 // ")")  "distance (Z) =", dist(2)
     write (u, "(A,1x," // FMF_12 // ")")  "m/w (Z)      =", mz / wz
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate Gaussian turnoff factor"
     write (u, "(A)")
 
     factor = res_history%evaluate_gaussian (p, gw)
     write (u, "(A,1x," // FMF_12 // ")")  "gaussian fac =", factor
 
     write (u, "(A)")
     write (u, "(A)")  "* Set momenta on W peak"
     write (u, "(A)")
 
     p(1) = vector4_at_rest (mw/2)
     p(2) = vector4_at_rest (mw/2)
     do i = 1, 3
        call p(i)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate distances from resonances"
     write (u, "(A)")
 
     call res_history%evaluate_distances (p, dist)
     write (u, "(A,1x," // FMF_12 // ")")  "distance (W) =", dist(1)
     write (u, "(A,1x," // FMF_12 // ")")  "distance (Z) =", dist(2)
     write (u, "(A,1x," // FMF_12 // ")")  "expected     =", &
          abs (mz**2 - mw**2) / (mz*wz)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate Gaussian turnoff factor"
     write (u, "(A)")
 
     factor = res_history%evaluate_gaussian (p, gw)
     write (u, "(A,1x," // FMF_12 // ")")  "gaussian fac =", factor
     write (u, "(A,1x," // FMF_12 // ")")  "expected     =", &
          exp (- (abs (mz**2 - mw**2) / (mz*wz))**2 / (gw * wz)**2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Set momenta on both peaks"
     write (u, "(A)")
 
     p(3) = vector4_at_rest (mz - mw)
     do i = 1, 3
        call p(i)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate distances from resonances"
     write (u, "(A)")
 
     call res_history%evaluate_distances (p, dist)
     write (u, "(A,1x," // FMF_12 // ")")  "distance (W) =", dist(1)
     write (u, "(A,1x," // FMF_12 // ")")  "distance (Z) =", dist(2)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluate Gaussian turnoff factor"
     write (u, "(A)")
 
     factor = res_history%evaluate_gaussian (p, gw)
     write (u, "(A,1x," // FMF_12 // ")")  "gaussian fac =", factor
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonances_4"
 
   end subroutine resonances_4
 
 @ %def resonances_4
 @ Probe on-shell test for resonance histories
 <<Resonances: execute tests>>=
   call test (resonances_5, "resonances_5", &
        "resonance history: on-shell test", &
        u, results)
 <<Resonances: test declarations>>=
   public :: resonances_5
 <<Resonances: tests>>=
   subroutine resonances_5 (u)
     integer, intent(in) :: u
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(resonance_history_set_t) :: res_set
     type(model_data_t), target :: model
     type(flavor_t) :: fw, fz
     real(default) :: mw, mz, ww, wz
     real(default) :: on_shell_limit
     integer, dimension(:), allocatable :: on_shell
     type(vector4_t), dimension(4) :: p
 
     write (u, "(A)")  "* Test output: resonances_5"
     write (u, "(A)")  "*   Purpose: resonance history on-shell test"
     write (u, "(A)")
 
     write (u, "(A)")  "* Read model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* W and Z parameters"
     write (u, "(A)")
 
     call fw%init (24, model)
     call fz%init (23, model)
     mw = fw%get_mass ()
     ww = fw%get_width ()
     mz = fz%get_mass ()
     wz = fz%get_width ()
 
     write (u, "(A,1x," // FMF_12 // ")")  "mW  =", mw
     write (u, "(A,1x," // FMF_12 // ")")  "wW  =", ww
     write (u, "(A,1x," // FMF_12 // ")")  "mZ  =", mz
     write (u, "(A,1x," // FMF_12 // ")")  "wZ  =", wz
 
     write (u, "(A)")
     write (u, "(A)")  "* On-shell parameter: distance as multiple of width"
     write (u, "(A)")
 
     on_shell_limit = 3
     write (u, "(A,1x," // FMF_12 // ")")  "on-shell limit =", on_shell_limit
 
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup resonance history set"
     write (u, "(A)")
 
     call res_set%init ()
 
     call res_info%init (3, -24, model, 6)
     call res_history%add_resonance (res_info)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     call res_info%init (12, 24, model, 6)
     call res_history%add_resonance (res_info)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     call res_info%init (15, 23, model, 6)
     call res_history%add_resonance (res_info)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     call res_info%init (3, -24, model, 6)
     call res_history%add_resonance (res_info)
     call res_info%init (15, 23, model, 6)
     call res_history%add_resonance (res_info)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     call res_info%init (12, 24, model, 6)
     call res_history%add_resonance (res_info)
     call res_info%init (15, 23, model, 6)
     call res_history%add_resonance (res_info)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     call res_set%freeze ()
     call res_set%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup zero momenta"
     write (u, "(A)")
 
     call write_momenta (p)
 
     call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
     call write_on_shell_histories (on_shell)
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup momenta near W- resonance (2 widths off)"
     write (u, "(A)")
 
     p(1) = vector4_at_rest (82.5_default)
     call write_momenta (p)
 
     call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
     call write_on_shell_histories (on_shell)
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup momenta near W- resonance (4 widths off)"
     write (u, "(A)")
 
     p(1) = vector4_at_rest (84.5_default)
     call write_momenta (p)
 
     call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
     call write_on_shell_histories (on_shell)
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup momenta near Z resonance"
     write (u, "(A)")
 
     p(1) = vector4_at_rest (45._default)
     p(3) = vector4_at_rest (45._default)
     call write_momenta (p)
 
     call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
     call write_on_shell_histories (on_shell)
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup momenta near W- and W+ resonances"
     write (u, "(A)")
 
     p(1) = vector4_at_rest (40._default)
     p(2) = vector4_at_rest (40._default)
     p(3) = vector4_at_rest (40._default)
     p(4) = vector4_at_rest (40._default)
     call write_momenta (p)
 
     call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
     call write_on_shell_histories (on_shell)
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup momenta near W- and Z resonances, &
          &shadowing single resonances"
     write (u, "(A)")
 
     p(1) = vector4_at_rest (40._default)
     p(2) = vector4_at_rest (40._default)
     p(3) = vector4_at_rest (10._default)
     p(4) = vector4_at_rest ( 0._default)
     call write_momenta (p)
 
     call res_set%determine_on_shell_histories (p, on_shell_limit, on_shell)
     call write_on_shell_histories (on_shell)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonances_5"
 
   contains
 
     subroutine write_momenta (p)
       type(vector4_t), dimension(:), intent(in) :: p
       integer :: i
       do i = 1, size (p)
          call p(i)%write (u)
       end do
     end subroutine write_momenta
 
     subroutine write_on_shell_histories (on_shell)
       integer, dimension(:), intent(in) :: on_shell
       integer :: i
       write (u, *)
       write (u, "(A)", advance="no")  "on-shell = ("
       do i = 1, size (on_shell)
          if (i > 1)  write (u, "(',')", advance="no")
          write (u, "(I0)", advance="no")  on_shell(i)
       end do
       write (u, "(')')")
     end subroutine write_on_shell_histories
 
   end subroutine resonances_5
 
 @ %def resonances_5
 @ Organize the resonance history as a tree structure.
 <<Resonances: execute tests>>=
   call test (resonances_6, "resonances_6", &
        "check resonance history setup", &
        u, results)
 <<Resonances: test declarations>>=
   public :: resonances_6
 <<Resonances: tests>>=
   subroutine resonances_6 (u)
     integer, intent(in) :: u
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(resonance_tree_t) :: res_tree
     type(model_data_t), target :: model
 
     write (u, "(A)")  "* Test output: resonances_6"
     write (u, "(A)")  "*   Purpose: retrieve resonance histories as trees"
     write (u, "(A)")
 
     write (u, "(A)")  "* Read model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Empty resonance history"
     write (u, "(A)")
 
     call res_history%write (u)
 
     write (u, "(A)")
     call res_history%to_tree (res_tree)
     call res_tree%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Single resonance"
     write (u, "(A)")
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
 
     write (u, "(A)")
     call res_history%to_tree (res_tree)
     call res_tree%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Nested resonances"
     write (u, "(A)")
 
     call res_info%init (7, 23, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%write (u)
 
     write (u, "(A)")
     call res_history%to_tree (res_tree)
     call res_tree%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Disjunct resonances"
     write (u, "(A)")
 
     call res_history%clear ()
 
     call res_info%init (5, 24, model, 7)
     call res_history%add_resonance (res_info)
 
     call res_info%init (7, 6, model, 7)
     call res_history%add_resonance (res_info)
 
     call res_info%init (80, -24, model, 7)
     call res_history%add_resonance (res_info)
 
     call res_info%init (112, -6, model, 7)
     call res_history%add_resonance (res_info)
 
     call res_history%write (u)
 
     write (u, "(A)")
     call res_history%to_tree (res_tree)
     call res_tree%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonances_6"
 
   end subroutine resonances_6
 
 @ %def resonances_6
 @ Basic operations on a resonance history set.
 <<Resonances: execute tests>>=
   call test (resonances_7, "resonances_7", &
        "display tree format of history set elements", &
        u, results)
 <<Resonances: test declarations>>=
   public :: resonances_7
 <<Resonances: tests>>=
   subroutine resonances_7 (u)
     integer, intent(in) :: u
     type(resonance_info_t) :: res_info
     type(resonance_history_t) :: res_history
     type(resonance_tree_t) :: res_tree
     type(resonance_history_set_t) :: res_set
     type(model_data_t), target :: model
     type(flavor_t) :: flv
 
     write (u, "(A)")  "* Test output: resonances_7"
     write (u, "(A)")  "*   Purpose: test tree format"
     write (u, "(A)")
 
     write (u, "(A)")  "* Read model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize, fill and freeze resonance history set"
     write (u, "(A)")
 
     call res_set%init (initial_size = 2)
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_history%clear ()
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_info%init (7, 23, model, 5)
     call res_history%add_resonance (res_info)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     call res_info%init (7, 23, model, 5)
     call res_history%add_resonance (res_info)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     call res_info%init (3, -24, model, 5)
     call res_history%add_resonance (res_info)
     call res_info%init (7, 25, model, 5)
     call res_history%add_resonance (res_info)
     call res_set%enter (res_history)
     call res_history%clear ()
 
     call res_set%freeze ()
 
     call res_set%write (u, show_trees = .true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract tree #1"
     write (u, "(A)")
 
     call res_set%get_tree (1, res_tree)
     call res_tree%write (u)
 
     write (u, *)
     write (u, "(1x,A,1x,I0)")  "n_resonances =", res_tree%get_n_resonances ()
 
     write (u, *)
     write (u, "(1x,A,1x)", advance="no")  "flv(r1) ="
     flv = res_tree%get_flv (1)
     call flv%write (u)
     write (u, *)
     write (u, "(1x,A,1x)", advance="no")  "flv(r2) ="
     flv = res_tree%get_flv (2)
     call flv%write (u)
     write (u, *)
 
     write (u, *)
     write (u, "(1x,A)")  "[offset = 2, 4]"
     write (u, "(1x,A,9(1x,I0))")  "children(r1) =", &
          res_tree%get_children(1, 2, 4)
     write (u, "(1x,A,9(1x,I0))")  "children(r2) =", &
          res_tree%get_children(2, 2, 4)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: resonances_7"
 
   end subroutine resonances_7
 
 @ %def resonances_7
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \clearpage
 \section{Mappings}
 
 Mappings are objects that encode the transformation of the interval
 $(0,1)$ to a physical variable $m^2$ or $\cos\theta$ (and back), as it
 is used in the phase space parameterization.  The mapping objects
 contain fixed parameters, the associated methods implement the mapping
 and inverse mapping operations, including the computation of the
 Jacobian (phase space factor).
 <<[[mappings.f90]]>>=
 <<File header>>
 
 module mappings
 
 <<Use kinds>>
   use kinds, only: TC
 <<Use strings>>
   use io_units
   use constants, only: pi
   use format_defs, only: FMT_19
   use diagnostics
   use md5
   use model_data
   use flavors
 
 <<Standard module head>>
 
 <<Mappings: public>>
 
 <<Mappings: parameters>>
 
 <<Mappings: types>>
 
 <<Mappings: interfaces>>
 
 contains
 
 <<Mappings: procedures>>
 
 end module mappings
 @ %def mappings
 @
 \subsection{Default parameters}
 This type holds the default parameters, needed for setting the scale
 in cases where no mass parameter is available.  The contents are public.
 <<Mappings: public>>=
   public :: mapping_defaults_t
 <<Mappings: types>>=
   type :: mapping_defaults_t
      real(default) :: energy_scale = 10
      real(default) :: invariant_mass_scale = 10
      real(default) :: momentum_transfer_scale = 10
      logical :: step_mapping = .true.
      logical :: step_mapping_exp = .true.
      logical :: enable_s_mapping = .false.
    contains
    <<Mappings: mapping defaults: TBP>>
   end type mapping_defaults_t
 
 @ %def mapping_defaults_t
 @ Output.
 <<Mappings: mapping defaults: TBP>>=
   procedure :: write => mapping_defaults_write
 <<Mappings: procedures>>=
   subroutine mapping_defaults_write (object, unit)
     class(mapping_defaults_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(3x,A," // FMT_19 // ")") "energy scale  = ", &
          object%energy_scale
     write (u, "(3x,A," // FMT_19 // ")") "mass scale    = ", &
          object%invariant_mass_scale
     write (u, "(3x,A," // FMT_19 // ")") "q scale       = ", &
          object%momentum_transfer_scale
     write (u, "(3x,A,L1)") "step mapping     = ", &
          object%step_mapping
     write (u, "(3x,A,L1)") "step exp. mode   = ", &
          object%step_mapping_exp
     write (u, "(3x,A,L1)") "allow s mapping  = ", &
          object%enable_s_mapping
   end subroutine mapping_defaults_write
 
 @ %def mapping_defaults_write
 @
 <<Mappings: public>>=
   public :: mapping_defaults_md5sum
 <<Mappings: procedures>>=
   function mapping_defaults_md5sum (mapping_defaults) result (md5sum_map)
     character(32) :: md5sum_map
     type(mapping_defaults_t), intent(in) :: mapping_defaults
     integer :: u
     u = free_unit ()
     open (u, status = "scratch")
     write (u, *)  mapping_defaults%energy_scale
     write (u, *)  mapping_defaults%invariant_mass_scale
     write (u, *)  mapping_defaults%momentum_transfer_scale
     write (u, *)  mapping_defaults%step_mapping
     write (u, *)  mapping_defaults%step_mapping_exp
     write (u, *)  mapping_defaults%enable_s_mapping
     rewind (u)
     md5sum_map = md5sum (u)
     close (u)
   end function mapping_defaults_md5sum
 
 @ %def mapping_defaults_md5sum
 @
 \subsection{The Mapping type}
 Each mapping has a type (e.g., s-channel, infrared), a binary code
 (redundant, but useful for debugging), and a reference particle.  The
 flavor code of this particle is stored for bookkeeping reasons, what
 matters are the mass and width of this particle.  Furthermore,
 depending on the type, various mapping parameters can be set and used.
 
 The parameters [[a1]] to [[a3]] (for $m^2$ mappings) and [[b1]] to
 [[b3]] (for $\cos\theta$ mappings) are values that are stored once to
 speed up the calculation, if [[variable_limits]] is false.  The exact
 meaning of these parameters depends on the mapping type.  The limits
 are fixed if there is a fixed c.m. energy.
 <<Mappings: public>>=
   public :: mapping_t
 <<Mappings: types>>=
   type :: mapping_t
      private
      integer :: type = NO_MAPPING
      integer(TC) :: bincode
      type(flavor_t) :: flv
      real(default) :: mass = 0
      real(default) :: width = 0
      logical :: a_unknown = .true.
      real(default) :: a1 = 0
      real(default) :: a2 = 0
      real(default) :: a3 = 0
      logical :: b_unknown = .true.
      real(default) :: b1 = 0
      real(default) :: b2 = 0
      real(default) :: b3 = 0
      logical :: variable_limits = .true.
    contains
    <<Mappings: mapping: TBP>>
   end type mapping_t
 
 @ %def mapping_t
 @ The valid mapping types.  The extra type [[STEP_MAPPING]] is used
 only internally.
 <<Mappings: parameters>>=
 <<Mapping modes>>
 @
 \subsection{Screen output}
 Do not write empty mappings.
 <<Mappings: public>>=
   public :: mapping_write
 <<Mappings: procedures>>=
   subroutine mapping_write (map, unit, verbose)
     type(mapping_t), intent(in) :: map
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     character(len=9) :: str
     u = given_output_unit (unit);  if (u < 0)  return
     select case(map%type)
     case(S_CHANNEL); str = "s_channel"
     case(COLLINEAR); str = "collinear"
     case(INFRARED);  str = "infrared "
     case(RADIATION); str = "radiation"
     case(T_CHANNEL); str = "t_channel"
     case(U_CHANNEL); str = "u_channel"
     case(STEP_MAPPING_E);  str = "step_exp"
     case(STEP_MAPPING_H);  str = "step_hyp"
     case(ON_SHELL);  str = "on_shell"
     case default;    str = "????????"
     end select
     if (map%type /= NO_MAPPING) then
        write (u, '(1x,A,I4,A)') &
             "Branch #", map%bincode, ":  " // &
             "Mapping (" // str // ") for particle " // &
             '"' // char (map%flv%get_name ()) // '"'
        if (present (verbose)) then
           if (verbose) then
              select case (map%type)
              case (S_CHANNEL, RADIATION, STEP_MAPPING_E, STEP_MAPPING_H)
                 write (u, "(1x,A,3(" // FMT_19 // "))")  &
                      "  m/w    = ", map%mass, map%width
              case default
                 write (u, "(1x,A,3(" // FMT_19 // "))")  &
                      "  m      = ", map%mass
              end select
              select case (map%type)
              case (S_CHANNEL, T_CHANNEL, U_CHANNEL, &
                   STEP_MAPPING_E, STEP_MAPPING_H, &
                   COLLINEAR, INFRARED, RADIATION)
                 write (u, "(1x,A,3(" // FMT_19 // "))")  &
                      "  a1/2/3 = ", map%a1, map%a2, map%a3
              end select
              select case (map%type)
              case (T_CHANNEL, U_CHANNEL, COLLINEAR)
                 write (u, "(1x,A,3(" // FMT_19 // "))")  &
                      "  b1/2/3 = ", map%b1, map%b2, map%b3
              end select
           end if
        end if
     end if
   end subroutine mapping_write
 
 @ %def mapping_write
 @
 \subsection{Define a mapping}
 The initialization routine sets the mapping type and the particle
 (binary code and flavor code) for which the mapping applies (e.g., a
 $Z$ resonance in branch \#3).
 <<Mappings: public>>=
   public :: mapping_init
 <<Mappings: procedures>>=
   subroutine mapping_init (mapping, bincode, type, f, model)
     type(mapping_t), intent(inout) :: mapping
     integer(TC), intent(in) :: bincode
     type(string_t), intent(in) :: type
     integer, intent(in), optional :: f
     class(model_data_t), intent(in), optional, target :: model
     mapping%bincode = bincode
     select case (char (type))
     case ("s_channel");  mapping%type = S_CHANNEL
     case ("collinear");  mapping%type = COLLINEAR
     case ("infrared");   mapping%type = INFRARED
     case ("radiation");  mapping%type = RADIATION
     case ("t_channel");  mapping%type = T_CHANNEL
     case ("u_channel");  mapping%type = U_CHANNEL
     case ("step_exp");  mapping%type = STEP_MAPPING_E
     case ("step_hyp");  mapping%type = STEP_MAPPING_H
     case ("on_shell");  mapping%type = ON_SHELL
     case default
        call msg_bug ("Mappings: encountered undefined mapping key '" &
             // char (type) // "'")
     end select
     if (present (f) .and. present (model))  call mapping%flv%init (f, model)
   end subroutine mapping_init
 
 @ %def mapping_init
 @ This sets the actual mass and width, using a parameter set.  Since
 the auxiliary parameters will only be determined when the mapping is
 first called, they are marked as unknown.
 <<Mappings: public>>=
   public :: mapping_set_parameters
 <<Mappings: procedures>>=
   subroutine mapping_set_parameters (map, mapping_defaults, variable_limits)
     type(mapping_t), intent(inout) :: map
     type(mapping_defaults_t), intent(in) :: mapping_defaults
     logical, intent(in) :: variable_limits
     if (map%type /= NO_MAPPING) then
        map%mass  = map%flv%get_mass ()
        map%width = map%flv%get_width ()
        map%variable_limits = variable_limits
        map%a_unknown = .true.
        map%b_unknown = .true.
        select case (map%type)
        case (S_CHANNEL)
           if (map%mass <= 0) then
              call mapping_write (map)
              call msg_fatal &
                   & (" S-channel resonance must have positive mass")
           else if (map%width <= 0) then
              call mapping_write (map)
              call msg_fatal &
                   & (" S-channel resonance must have positive width")
           end if
        case (RADIATION)
           map%width = max (map%width, mapping_defaults%energy_scale)
        case (INFRARED, COLLINEAR)
           map%mass = max (map%mass, mapping_defaults%invariant_mass_scale)
        case (T_CHANNEL, U_CHANNEL)
           map%mass = max (map%mass, mapping_defaults%momentum_transfer_scale)
        end select
     end if
   end subroutine mapping_set_parameters
 
 @ %def mapping_set_code mapping_set_parameters
 @ For a step mapping the mass and width are set directly, instead of
 being determined from the flavor parameter (which is meaningless
 here).  They correspond to the effective upper bound of phase space
 due to a resonance, as opposed to the absolute upper bound.
 <<Mappings: public>>=
   public :: mapping_set_step_mapping_parameters
 <<Mappings: procedures>>=
   subroutine mapping_set_step_mapping_parameters (map, &
        mass, width, variable_limits)
     type(mapping_t), intent(inout) :: map
     real(default), intent(in) :: mass, width
     logical, intent(in) :: variable_limits
     select case (map%type)
     case (STEP_MAPPING_E, STEP_MAPPING_H)
        map%variable_limits = variable_limits
        map%a_unknown = .true.
        map%b_unknown = .true.
        map%mass = mass
        map%width = width
     end select
   end subroutine mapping_set_step_mapping_parameters
 
 @ %def mapping_set_step_mapping_parameters
 @
 \subsection{Retrieve contents}
 Return true if there is any / an s-channel mapping.
 <<Mappings: public>>=
   public :: mapping_is_set
   public :: mapping_is_s_channel
   public :: mapping_is_on_shell
 <<Mappings: mapping: TBP>>=
   procedure :: is_set => mapping_is_set
   procedure :: is_s_channel => mapping_is_s_channel
   procedure :: is_on_shell => mapping_is_on_shell
 <<Mappings: procedures>>=
   function mapping_is_set (mapping) result (flag)
     class(mapping_t), intent(in) :: mapping
     logical :: flag
     flag = mapping%type /= NO_MAPPING
   end function mapping_is_set
 
   function mapping_is_s_channel (mapping) result (flag)
     class(mapping_t), intent(in) :: mapping
     logical :: flag
     flag = mapping%type == S_CHANNEL
   end function mapping_is_s_channel
 
   function mapping_is_on_shell (mapping) result (flag)
     class(mapping_t), intent(in) :: mapping
     logical :: flag
     flag = mapping%type == ON_SHELL
   end function mapping_is_on_shell
 
 @ %def mapping_is_set
 @ %def mapping_is_s_channel
 @ %def mapping_is_on_shell
 @ Return the binary code for the mapped particle.
 <<Mappings: mapping: TBP>>=
   procedure :: get_bincode => mapping_get_bincode
 <<Mappings: procedures>>=
   function mapping_get_bincode (mapping) result (bincode)
     class(mapping_t), intent(in) :: mapping
     integer(TC) :: bincode
     bincode = mapping%bincode
   end function mapping_get_bincode
 
 @ %def mapping_get_bincode
 @ Return the flavor object for the mapped particle.
 <<Mappings: mapping: TBP>>=
   procedure :: get_flv => mapping_get_flv
 <<Mappings: procedures>>=
   function mapping_get_flv (mapping) result (flv)
     class(mapping_t), intent(in) :: mapping
     type(flavor_t) :: flv
     flv = mapping%flv
   end function mapping_get_flv
 
 @ %def mapping_get_flv
 @ Return stored mass and width, respectively.
 <<Mappings: public>>=
   public :: mapping_get_mass
   public :: mapping_get_width
 <<Mappings: procedures>>=
   function mapping_get_mass (mapping) result (mass)
     real(default) :: mass
     type(mapping_t), intent(in) :: mapping
     mass = mapping%mass
   end function mapping_get_mass
 
   function mapping_get_width (mapping) result (width)
     real(default) :: width
     type(mapping_t), intent(in) :: mapping
     width = mapping%width
   end function mapping_get_width
 
 @ %def mapping_get_mass
 @ %def mapping_get_width
 @
 \subsection{Compare mappings}
 Equality for single mappings and arrays
 <<Mappings: public>>=
   public :: operator(==)
 <<Mappings: interfaces>>=
   interface operator(==)
      module procedure mapping_equal
   end interface
 <<Mappings: procedures>>=
   function mapping_equal (m1, m2) result (equal)
     type(mapping_t), intent(in) :: m1, m2
     logical :: equal
     if (m1%type == m2%type) then
        select case (m1%type)
        case (NO_MAPPING)
           equal = .true.
        case (S_CHANNEL, RADIATION, STEP_MAPPING_E, STEP_MAPPING_H)
           equal = (m1%mass == m2%mass) .and. (m1%width == m2%width)
        case default
           equal = (m1%mass == m2%mass)
        end select
     else
        equal = .false.
     end if
   end function mapping_equal
 
 @ %def mapping_equal
 @
 \subsection{Mappings of the invariant mass}
 Inserting an $x$ value between 0 and 1, we want to compute the
 corresponding invariant mass $m^2(x)$ and the jacobian, aka phase
 space factor $f(x)$.  We also need the reverse operation.
 
 In general, the phase space factor $f$ is defined by
 \begin{equation}
   \frac{1}{s}\int_{m^2_{\textrm{min}}}^{m^2_{\textrm{max}}} dm^2\,g(m^2)
   = \int_0^1 dx\,\frac{1}{s}\,\frac{dm^2}{dx}\,g(m^2(x))
   = \int_0^1 dx\,f(x)\,g(x),
 \end{equation}
 where thus
 \begin{equation}
   f(x) = \frac{1}{s}\,\frac{dm^2}{dx}.
 \end{equation}
 With this mapping, a function of the form
 \begin{equation}
   g(m^2) = c\frac{dx(m^2)}{dm^2}
 \end{equation}
 is mapped to a constant:
 \begin{equation}
   \frac{1}{s}\int_{m^2_{\textrm{min}}}^{m^2_{\textrm{max}}} dm^2\,g(m^2)
   = \int_0^1 dx\,f(x)\,g(m^2(x)) = \int_0^1 dx\,\frac{c}{s}.
 \end{equation}
 
 Here is the mapping routine.  Input are the available energy
 squared [[s]], the limits for $m^2$, and the $x$ value.  Output are
 the $m^2$ value and the phase space factor $f$.
 <<Mappings: public>>=
   public :: mapping_compute_msq_from_x
 <<Mappings: procedures>>=
   subroutine mapping_compute_msq_from_x (map, s, msq_min, msq_max, msq, f, x)
     type(mapping_t), intent(inout) :: map
     real(default), intent(in) :: s, msq_min, msq_max
     real(default), intent(out) :: msq, f
     real(default), intent(in) :: x
     real(default) :: z, msq0, msq1, tmp
     integer :: type
     type = map%type
     if (s == 0) &
          call msg_fatal (" Applying msq mapping for zero energy")
   <<Modify mapping type if necessary>>
     select case(type)
     case (NO_MAPPING)
      <<Constants for trivial msq mapping>>
      <<Apply trivial msq mapping>>
     case (S_CHANNEL)
      <<Constants for s-channel resonance mapping>>
      <<Apply s-channel resonance mapping>>
     case (COLLINEAR, INFRARED, RADIATION)
      <<Constants for s-channel pole mapping>>
      <<Apply s-channel pole mapping>>
     case (T_CHANNEL, U_CHANNEL)
      <<Constants for t-channel pole mapping>>
      <<Apply t-channel pole mapping>>
     case (STEP_MAPPING_E)
      <<Constants for exponential step mapping>>
      <<Apply exponential step mapping>>
     case (STEP_MAPPING_H)
      <<Constants for hyperbolic step mapping>>
      <<Apply hyperbolic step mapping>>
     case default
        call msg_fatal ( " Attempt to apply undefined msq mapping")
     end select
   end subroutine mapping_compute_msq_from_x
 
 @ %def mapping_compute_msq_from_x
 @ The inverse mapping
 <<Mappings: public>>=
   public :: mapping_compute_x_from_msq
 <<Mappings: procedures>>=
   subroutine mapping_compute_x_from_msq (map, s, msq_min, msq_max, msq, f, x)
     type(mapping_t), intent(inout) :: map
     real(default), intent(in) :: s, msq_min, msq_max
     real(default), intent(in) :: msq
     real(default), intent(out) :: f, x
     real(default) :: msq0, msq1, tmp, z
     integer :: type
     type = map%type
     if (s == 0) &
          call msg_fatal (" Applying inverse msq mapping for zero energy")
   <<Modify mapping type if necessary>>
     select case (type)
     case (NO_MAPPING)
      <<Constants for trivial msq mapping>>
      <<Apply inverse trivial msq mapping>>
     case (S_CHANNEL)
      <<Constants for s-channel resonance mapping>>
      <<Apply inverse s-channel resonance mapping>>
     case (COLLINEAR, INFRARED, RADIATION)
      <<Constants for s-channel pole mapping>>
      <<Apply inverse s-channel pole mapping>>
     case (T_CHANNEL, U_CHANNEL)
      <<Constants for t-channel pole mapping>>
      <<Apply inverse t-channel pole mapping>>
     case (STEP_MAPPING_E)
      <<Constants for exponential step mapping>>
      <<Apply inverse exponential step mapping>>
     case (STEP_MAPPING_H)
      <<Constants for hyperbolic step mapping>>
      <<Apply inverse hyperbolic step mapping>>
     case default
        call msg_fatal ( " Attempt to apply undefined msq mapping")
     end select
   end subroutine mapping_compute_x_from_msq
 
 @ %def mapping_compute_x_from_msq
 @
 \subsubsection{Trivial mapping}
 We simply map the boundaries of the interval $(m_{\textrm{min}},
 m_{\textrm{max}})$ to $(0,1)$:
 \begin{equation}
   m^2 = (1-x) m_{\textrm{min}}^2 + x m_{\textrm{max}}^2;
 \end{equation}
 the inverse is
 \begin{equation}
   x = \frac{m^2 - m_{\textrm{min}}^2}{m_{\textrm{max}}^2- m_{\textrm{min}}^2}.
 \end{equation}
 Hence
 \begin{equation}
   f(x) = \frac{m_{\textrm{max}}^2 - m_{\textrm{min}}^2}{s},
 \end{equation}
 and we have, as required,
 \begin{equation}
   f(x)\,\frac{dx}{dm^2} = \frac{1}{s}.
 \end{equation}
 
 We store the constant parameters the first time the mapping is called
 -- or, if limits vary, recompute them each time.
 <<Constants for trivial msq mapping>>=
   if (map%variable_limits .or. map%a_unknown) then
      map%a1 = 0
      map%a2 = msq_max - msq_min
      map%a3 = map%a2 / s
      map%a_unknown = .false.
   end if
 <<Apply trivial msq mapping>>=
   msq = (1-x) * msq_min + x * msq_max
   f = map%a3
 <<Apply inverse trivial msq mapping>>=
   if (map%a2 /= 0) then
      x = (msq - msq_min) / map%a2
   else
      x = 0
   end if
   f = map%a3
 @ Resonance or step mapping does not make much sense if the resonance mass is
 outside the kinematical bounds.  If this is the case, revert to
 [[NO_MAPPING]].  This is possible even if the kinematical bounds vary
 from event to event.
 <<Modify mapping type if necessary>>=
   select case (type)
   case (S_CHANNEL, STEP_MAPPING_E, STEP_MAPPING_H)
      msq0 = map%mass**2
      if (msq0 < msq_min .or. msq0 > msq_max)  type = NO_MAPPING
   end select
 @
 \subsubsection{Breit-Wigner mapping}
 A Breit-Wigner resonance with mass $M$ and width $\Gamma$ is flattened
 by the following mapping:
 
 This mapping does not make much sense if the resonance mass is too low.
 If this is the case, revert to [[NO_MAPPING]].  There is a tricky
 point with this if the mass is too high: [[msq_max]] is not a
 constant if structure functions are around.  However, switching the
 type depending on the overall energy does not change the integral, it
 is just another branching point.
 \begin{equation}
   m^2 = M(M+t\Gamma),
 \end{equation}
 where
 \begin{equation}
   t = \tan\left[(1-x)\arctan\frac{m^2_{\textrm{min}} - M^2}{M\Gamma}
                 + x  \arctan\frac{m^2_{\textrm{max}} - M^2}{M\Gamma}\right].
 \end{equation}
 The inverse:
 \begin{equation}
   x = \frac{  \arctan\frac{m^2 - M^2}{M\Gamma}
             - \arctan\frac{m^2_{\textrm{min}} - M^2}{M\Gamma}}
            {  \arctan\frac{m^2_{\textrm{max}} - M^2}{M\Gamma}
             - \arctan\frac{m^2_{\textrm{min}} - M^2}{M\Gamma}}
 \end{equation}
 The phase-space factor of this transformation is
 \begin{equation}
   f(x) = \frac{M\Gamma}{s}\left(
            \arctan\frac{m^2_{\textrm{max}} - M^2}{M\Gamma}
          - \arctan\frac{m^2_{\textrm{min}} - M^2}{M\Gamma}\right)
          (1 + t^2).
 \end{equation}
 This maps any function proportional to
 \begin{equation}
   g(m^2) = \frac{M\Gamma}{(m^2-M^2)^2 + M^2\Gamma^2}
 \end{equation}
 to a constant times $1/s$.
 <<Constants for s-channel resonance mapping>>=
   if (map%variable_limits .or. map%a_unknown) then
      msq0 = map%mass ** 2
      map%a1 = atan ((msq_min - msq0) / (map%mass * map%width))
      map%a2 = atan ((msq_max - msq0) / (map%mass * map%width))
      map%a3 = (map%a2 - map%a1) * (map%mass * map%width) / s
      map%a_unknown = .false.
   end if
 <<Apply s-channel resonance mapping>>=
   z = (1-x) * map%a1 + x * map%a2
   if (-pi/2 < z .and. z < pi/2) then
      tmp = tan (z)
      msq = map%mass * (map%mass + map%width * tmp)
      f = map%a3 * (1 + tmp**2)
   else
      msq = 0
      f = 0
   end if
 <<Apply inverse s-channel resonance mapping>>=
   tmp = (msq - msq0) / (map%mass * map%width)
   x = (atan (tmp) - map%a1) / (map%a2 - map%a1)
   f = map%a3 * (1 + tmp**2)
 @
 \subsubsection{Mapping for massless splittings}
 This mapping accounts for approximately scale-invariant behavior where
 $\ln M^2$ is evenly distributed.
 \begin{equation}
   m^2 = m_{\textrm{min}}^2 + M^2\left(\exp(xL)-1\right)
 \end{equation}
 where
 \begin{equation}
   L = \ln\left(\frac{m_{\textrm{max}}^2 - m_{\textrm{min}}^2}{M^2} + 1\right).
 \end{equation}
 The inverse:
 \begin{equation}
   x = \frac1L\ln\left(\frac{m^2-m_{\textrm{min}}^2}{M^2} + 1\right)
 \end{equation}
 The constant $M$ is a characteristic scale.  Above this scale
 ($m^2-m_{\textrm{min}}^2 \gg M^2$), this mapping behaves like
 $x\propto\ln m^2$, while below the scale it reverts to a linear
 mapping.
 
 The phase-space factor is
 \begin{equation}
   f(x) = \frac{M^2}{s}\,\exp(xL)\,L.
 \end{equation}
 A function proportional to
 \begin{equation}
   g(m^2) = \frac{1}{(m^2-m_{\textrm{min}}^2) + M^2}
 \end{equation}
 is mapped to a constant, i.e., a simple pole near $m_{\textrm{min}}$
 with a regulator mass $M$.
 
 This type of mapping is useful for massless collinear and infrared
 singularities, where the scale is stored as the mass parameter.  In
 the radiation case (IR radiation off massive particle), the heavy
 particle width is the characteristic scale.
 <<Constants for s-channel pole mapping>>=
   if (map%variable_limits .or. map%a_unknown) then
      if (type == RADIATION) then
         msq0 = map%width**2
      else
         msq0 = map%mass**2
      end if
      map%a1 = msq0
      map%a2 = log ((msq_max - msq_min) / msq0 + 1)
      map%a3 = map%a2 / s
      map%a_unknown = .false.
   end if
 <<Apply s-channel pole mapping>>=
   msq1 = map%a1 * exp (x * map%a2)
   msq = msq1 - map%a1 + msq_min
   f = map%a3 * msq1
 <<Apply inverse s-channel pole mapping>>=
   msq1 = msq - msq_min + map%a1
   x = log (msq1 / map%a1) / map%a2
   f = map%a3 * msq1
 @
 \subsubsection{Mapping for t-channel poles}
 This is also approximately scale-invariant, and we use the same type
 of mapping as before.  However, we map $1/x$ singularities at both
 ends of the interval; again, the mapping becomes linear when the
 distance is less than $M^2$:
 \begin{equation}
   m^2 =
   \begin{cases}
     m_{\textrm{min}}^2 + M^2\left(\exp(xL)-1\right)
     &
     \text{for $0 < x < \frac12$}
     \\
     m_{\textrm{max}}^2 - M^2\left(\exp((1-x)L)-1\right)
     &
     \text{for $\frac12 \leq x < 1$}
   \end{cases}
 \end{equation}
 where
 \begin{equation}
   L = 2\ln\left(\frac{m_{\textrm{max}}^2 - m_{\textrm{min}}^2}{2M^2}
                 + 1\right).
 \end{equation}
 The inverse:
 \begin{equation}
   x =
   \begin{cases}
     \frac1L\ln\left(\frac{m^2-m_{\textrm{min}}^2}{M^2} + 1\right)
     &
     \text{for $m^2 < (m_{\textrm{max}}^2 - m_{\textrm{min}}^2)/2$}
     \\
     1 - \frac1L\ln\left(\frac{m_{\textrm{max}}-m^2}{M^2} + 1\right)
     &
     \text{for $m^2 \geq (m_{\textrm{max}}^2 - m_{\textrm{min}}^2)/2$}
   \end{cases}
 \end{equation}
 The phase-space factor is
 \begin{equation}
   f(x) =
   \begin{cases}
     \frac{M^2}{s}\,\exp(xL)\,L.
     &
     \text{for $0 < x < \frac12$}
     \\
     \frac{M^2}{s}\,\exp((1-x)L)\,L.
     &
     \text{for $\frac12 \leq x < 1$}
   \end{cases}
 \end{equation}
 A (continuous) function proportional to
 \begin{equation}
   g(m^2) =
   \begin{cases}
     1/(m^2-m_{\textrm{min}}^2) + M^2)
     &
     \text{for $m^2 < (m_{\textrm{max}}^2 - m_{\textrm{min}}^2)/2$}
     \\
     1/((m_{\textrm{max}}^2 - m^2) + M^2)
     &
     \text{for $m^2 \leq (m_{\textrm{max}}^2 - m_{\textrm{min}}^2)/2$}
   \end{cases}
 \end{equation}
 is mapped to a constant by this mapping, i.e., poles near both ends of
 the interval.
 <<Constants for t-channel pole mapping>>=
   if (map%variable_limits .or. map%a_unknown) then
      msq0 = map%mass**2
      map%a1 = msq0
      map%a2 = 2 * log ((msq_max - msq_min)/(2*msq0) + 1)
      map%a3 = map%a2 / s
      map%a_unknown = .false.
   end if
 <<Apply t-channel pole mapping>>=
   if (x < .5_default) then
      msq1 = map%a1 * exp (x * map%a2)
      msq = msq1 - map%a1 + msq_min
   else
      msq1 = map%a1 * exp ((1-x) * map%a2)
      msq = -(msq1 - map%a1) + msq_max
   end if
   f = map%a3 * msq1
 <<Apply inverse t-channel pole mapping>>=
   if (msq < (msq_max + msq_min)/2) then
      msq1 = msq - msq_min + map%a1
      x = log (msq1/map%a1) / map%a2
   else
      msq1 = msq_max - msq + map%a1
      x = 1 - log (msq1/map%a1) / map%a2
   end if
   f = map%a3 * msq1
 @
 \subsection{Step mapping}
 Step mapping is useful when the allowed range for a squared-mass
 variable is large, but only a fraction at the lower end is populated
 because the particle in question is an (off-shell) decay product of a
 narrow resonance.  I.e., if the resonance was forced to be on-shell,
 the upper end of the range would be the resonance mass, minus the
 effective (real or resonance) mass of the particle(s) in the sibling
 branch of the decay.
 
 The edge of this phase space section has a width which is determined
 by the width of the parent, plus the width of the sibling branch.  (The
 widths might be added in quadrature, but this precision is probably
 not important.)
 
 \subsubsection{Fermi function}
 
 A possible mapping is derived from the Fermi function which has
 precisely this behavior.  The Fermi function is given by
 \begin{equation}
   f(x) = \frac{1}{1 + \exp\frac{x-\mu}{\gamma}}
 \end{equation}
 where $x$ is taken as the invariant mass squared, $\mu$ is the
 invariant mass squared of the edge, and $\gamma$ is the effective
 width which is given by the widths of the parent and the sibling
 branch.  (Widths might be added in quadrature, but we do not require
 this level of precision.)
 \begin{align}
   x &= \frac{m^2 - m_{\text{min}}^2}{\Delta m^2}
 \\
   \mu &=
   \frac{m_{\text{max,eff}}^2 - m_{\text{min}}^2}
           {\Delta m^2}
 \\
   \gamma &= \frac{2m_{\text{max,eff}}\Gamma}{\Delta m^2}
 \end{align}
 with
 \begin{equation}
   \Delta m^2 = m_{\text{max}}^2 - m_{\text{min}}^2
 \end{equation}
 $m^2$ is thus given by
 \begin{equation}
   m^2(x) = xm_{\text{max}}^2 + (1-x)m_{\text{min}}^2
 \end{equation}
 For the mapping, we compute the integral $g(x)$ of the Fermi function,
 normalized such that $g(0)=0$ and $g(1)=1$.  We introduce the abbreviations
 \begin{align}
   \alpha &= 1 - \gamma\ln\frac{1 + \beta e^{1/\gamma}}{1 + \beta}
 \\
   \beta  &= e^{- \mu/\gamma}
 \end{align}
 and obtain
 \begin{equation}
   g(x) = \frac{1}{\alpha}
          \left(x - \gamma\ln\frac{1 + \beta e^{x/\gamma}}
                                  {1 + \beta}\right)
 \end{equation}
 The actual mapping is the inverse function $h(y) = g^{-1}(y)$,
 \begin{equation}
   h(y) = -\gamma\ln\left(e^{-\alpha y/\gamma}(1 + \beta) - \beta\right)
 \end{equation}
 The Jacobian is
 \begin{equation}
   \frac{dh}{dy} = \alpha\left(1 - e^{\alpha y/\gamma}
                                   \frac{\beta}{1 + \beta}\right)^{-1}
 \end{equation}
 which is equal to $1/(dg/dx)$, namely
 \begin{equation}
   \frac{dg}{dx} = \frac{1}{\alpha}\,\frac{1}{1 + \beta e^{x/\gamma}}
 \end{equation}
 The final result is
 \begin{align}
   \int_{m_{\text{min}}^2}^{m_{\text{max}}^2} dm^2\,F(m^2)
   &= \Delta m^2\int_0^1\,dx\,F(m^2(x))
 \\
   &= \Delta m^2\int_0^1\,dy\,F(m^2(h(y)))\,\frac{dh}{dy}
 \end{align}
 Here is the implementation.  We fill [[a1]], [[a2]], [[a3]] with
 $\alpha,\beta,\gamma$, respectively.
 <<Constants for exponential step mapping>>=
   if (map%variable_limits .or. map%a_unknown) then
      map%a3 = max (2 * map%mass * map%width / (msq_max - msq_min), 0.01_default)
      map%a2 = exp (- (map%mass**2 - msq_min) / (msq_max - msq_min) &
                      / map%a3)
      map%a1 = 1 - map%a3 * log ((1 + map%a2 * exp (1 / map%a3)) / (1 + map%a2))
   end if
 <<Apply exponential step mapping>>=
   tmp = exp (- x * map%a1 / map%a3) * (1 + map%a2)
   z = - map%a3 * log (tmp - map%a2)
   msq  = z * msq_max + (1 - z) * msq_min
   f = map%a1 / (1 - map%a2 / tmp) * (msq_max - msq_min) / s
 <<Apply inverse exponential step mapping>>=
   z = (msq - msq_min) / (msq_max - msq_min)
   tmp = 1 + map%a2 * exp (z / map%a3)
   x = (z - map%a3 * log (tmp / (1 + map%a2))) &
       / map%a1
   f = map%a1 * tmp * (msq_max - msq_min) / s
 @
 \subsubsection{Hyperbolic mapping}
 
 The Fermi function has the drawback that it decreases exponentially.
 It might be preferable to take a function with a power-law decrease,
 such that the high-mass region is not completely depopulated.
 
 Here, we start with the actual mapping which we take as
 \begin{equation}
   h(y) = \frac{b}{a-y} - \frac{b}{a} + \mu y
 \end{equation}
 with the abbreviation
 \begin{equation}
   a = \frac12\left(1 + \sqrt{1 + \frac{4b}{1-\mu}}\right)
 \end{equation}
 This is a hyperbola in the $xy$ plane.  The derivative is
 \begin{equation}
   \frac{dh}{dy} = \frac{b}{(a-y)^2} + \mu
 \end{equation}
 The constants correspond to
 \begin{align}
   \mu &=
   \frac{m_{\text{max,eff}}^2 - m_{\text{min}}^2}
           {\Delta m^2}
 \\
   b &= \frac{1}{\mu}\left(\frac{2m_{\text{max,eff}}\Gamma}{\Delta m^2}\right)^2
 \end{align}
 The inverse function is the solution of a quadratic equation,
 \begin{equation}
   g(x) = \frac{1}{2}
          \left[\left(a + \frac{x}{\mu} + \frac{b}{a\mu}\right)
                - \sqrt{\left(a-\frac{x}{\mu}\right)^2
                        + 2\frac{b}{a\mu}\left(a + \frac{x}{\mu}\right)
                        + \left(\frac{b}{a\mu}\right)^2}\right]
 \end{equation}
 The constants $a_{1,2,3}$ are identified with $a,b,\mu$.
 <<Constants for hyperbolic step mapping>>=
   if (map%variable_limits .or. map%a_unknown) then
      map%a3 = (map%mass**2 - msq_min) / (msq_max - msq_min)
      map%a2 = max ((2 * map%mass * map%width / (msq_max - msq_min))**2 &
                    / map%a3, 1e-6_default)
      map%a1 = (1 + sqrt (1 + 4 * map%a2 / (1 - map%a3))) / 2
   end if
 <<Apply hyperbolic step mapping>>=
   z = map%a2 / (map%a1 - x) - map%a2 / map%a1 + map%a3 * x
   msq = z * msq_max + (1 - z) * msq_min
   f = (map%a2 / (map%a1 - x)**2 + map%a3) * (msq_max - msq_min) / s
 <<Apply inverse hyperbolic step mapping>>=
   z = (msq - msq_min) / (msq_max - msq_min)
   tmp = map%a2 / (map%a1 * map%a3)
   x = ((map%a1 + z / map%a3 + tmp) &
        - sqrt ((map%a1 - z / map%a3)**2 + 2 * tmp * (map%a1 + z / map%a3) &
                + tmp**2)) / 2
   f = (map%a2 / (map%a1 - x)**2 + map%a3) * (msq_max - msq_min) / s
 @
 \subsection{Mappings of the polar angle}
 The other type of singularity, a simple pole just outside the
 integration region, can occur in the integration over $\cos\theta$.
 This applies to exchange of massless (or light) particles.
 
 Double poles (Coulomb scattering) are also possible, but only in
 certain cases.  These are also handled by the single-pole mapping.
 
 The mapping is analogous to the previous $m^2$ pole mapping, but with
 a different normalization and notation of variables:
 \begin{equation}
   \frac12\int_{-1}^1 d\cos\theta\,g(\theta)
   = \int_0^1 dx\,\frac{d\cos\theta}{dx}\,g(\theta(x))
   = \int_0^1 dx\,f(x)\,g(x),
 \end{equation}
 where thus
 \begin{equation}
   f(x) = \frac12\,\frac{d\cos\theta}{dx}.
 \end{equation}
 With this mapping, a function of the form
 \begin{equation}
   g(\theta) = c\frac{dx(\cos\theta)}{d\cos\theta}
 \end{equation}
 is mapped to a constant:
 \begin{equation}
   \int_{-1}^1 d\cos\theta\,g(\theta)
   = \int_0^1 dx\,f(x)\,g(\theta(x)) = \int_0^1 dx\,c.
 \end{equation}
 <<Mappings: public>>=
   public :: mapping_compute_ct_from_x
 <<Mappings: procedures>>=
   subroutine mapping_compute_ct_from_x (map, s, ct, st, f, x)
     type(mapping_t), intent(inout) :: map
     real(default), intent(in) :: s
     real(default), intent(out) :: ct, st, f
     real(default), intent(in) :: x
     real(default) :: tmp, ct1
     select case (map%type)
     case (NO_MAPPING, S_CHANNEL, INFRARED, RADIATION, &
          STEP_MAPPING_E, STEP_MAPPING_H)
      <<Apply trivial ct mapping>>
     case (T_CHANNEL, U_CHANNEL, COLLINEAR)
      <<Constants for ct pole mapping>>
      <<Apply ct pole mapping>>
     case default
        call msg_fatal (" Attempt to apply undefined ct mapping")
     end select
   end subroutine mapping_compute_ct_from_x
 
 @ %def mapping_compute_ct_from_x
 <<Mappings: public>>=
   public :: mapping_compute_x_from_ct
 <<Mappings: procedures>>=
   subroutine mapping_compute_x_from_ct (map, s, ct, f, x)
     type(mapping_t), intent(inout) :: map
     real(default), intent(in) :: s
     real(default), intent(in) :: ct
     real(default), intent(out) :: f, x
     real(default) :: ct1
     select case (map%type)
     case (NO_MAPPING, S_CHANNEL, INFRARED, RADIATION, &
          STEP_MAPPING_E, STEP_MAPPING_H)
      <<Apply inverse trivial ct mapping>>
     case (T_CHANNEL, U_CHANNEL, COLLINEAR)
      <<Constants for ct pole mapping>>
      <<Apply inverse ct pole mapping>>
     case default
        call msg_fatal (" Attempt to apply undefined inverse ct mapping")
     end select
   end subroutine mapping_compute_x_from_ct
 
 @ %def mapping_compute_x_from_ct
 @
 \subsubsection{Trivial mapping}
 This is just the mapping of the interval $(-1,1)$ to $(0,1)$:
 \begin{equation}
   \cos\theta = -1 + 2x
 \end{equation}
 and
 \begin{equation}
   f(x) = 1
 \end{equation}
 with the inverse
 \begin{equation}
   x = \frac{1+\cos\theta}{2}
 \end{equation}
 <<Apply trivial ct mapping>>=
   tmp = 2 * (1-x)
   ct = 1 - tmp
   st = sqrt (tmp * (2-tmp))
   f = 1
 <<Apply inverse trivial ct mapping>>=
   x = (ct + 1) / 2
   f = 1
 @
 \subsubsection{Pole mapping}
 As above for $m^2$, we simultaneously map poles at both ends of the
 $\cos\theta$ interval.  The formulae are completely analogous:
 \begin{equation}
   \cos\theta =
   \begin{cases}
     \frac{M^2}{s}\left[\exp(xL)-1\right] - 1
     &
     \text{for $x<\frac12$}
     \\
     -\frac{M^2}{s}\left[\exp((1-x)L)-1\right] + 1
     &
     \text{for $x\geq\frac12$}
   \end{cases}
 \end{equation}
 where
 \begin{equation}
   L = 2\ln\frac{M^2+s}{M^2}.
 \end{equation}
 Inverse:
 \begin{equation}
   x =
   \begin{cases}
     \frac{1}{2L}\ln\frac{1 + \cos\theta + M^2/s}{M^2/s}
     &
     \text{for $\cos\theta < 0$}
     \\
     1 - \frac{1}{2L}\ln\frac{1 - \cos\theta + M^2/s}{M^2/s}
     &
     \text{for $\cos\theta \geq 0$}
   \end{cases}
 \end{equation}
 The phase-space factor:
 \begin{equation}
   f(x) =
   \begin{cases}
     \frac{M^2}{s}\exp(xL)\,L
     &
     \text{for $x<\frac12$}
     \\
     \frac{M^2}{s}\exp((1-x)L)\,L
     &
     \text{for $x\geq\frac12$}
   \end{cases}
 \end{equation}
 <<Constants for ct pole mapping>>=
   if (map%variable_limits .or. map%b_unknown) then
      map%b1 = map%mass**2 / s
      map%b2 = log ((map%b1 + 1) / map%b1)
      map%b3 = 0
      map%b_unknown = .false.
   end if
 <<Apply ct pole mapping>>=
   if (x < .5_default) then
      ct1 = map%b1 * exp (2 * x * map%b2)
      ct = ct1 - map%b1 - 1
   else
      ct1 = map%b1 * exp (2 * (1-x) * map%b2)
      ct = -(ct1 - map%b1) + 1
   end if
   if (ct >= -1 .and. ct <= 1) then
      st = sqrt (1 - ct**2)
      f = ct1 * map%b2
   else
      ct = 1;  st = 0;  f = 0
   end if
 <<Apply inverse ct pole mapping>>=
   if (ct < 0) then
      ct1 = ct + map%b1 + 1
      x = log (ct1 / map%b1) / (2 * map%b2)
   else
      ct1 = -ct + map%b1 + 1
      x = 1 - log (ct1 / map%b1) / (2 * map%b2)
   end if
   f = ct1 * map%b2
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \clearpage
 \section{Phase-space trees}
 The phase space evaluation is organized in terms of trees, where each
 branch corresponds to three integrations: $m^2$, $\cos\theta$, and
 $\phi$.  The complete tree thus makes up a specific parameterization
 of the multidimensional phase-space integral.  For the multi-channel
 integration, the phase-space tree is a single channel.
 
 The trees imply mappings of formal Feynman tree graphs into arrays of
 integer numbers: Each branch, corresponding to a particular line in
 the graph, is assigned an integer code $c$ (with kind value [[TC]] =
 tree code).
 
 In this integer, each bit determines whether a particular external
 momentum flows through the line.  The external branches therefore have
 codes $1,2,4,8,\ldots$.  An internal branch has those bits ORed
 corresponding to the momenta flowing through it.  For example, a
 branch with momentum $p_1+p_4$ has code $2^0+2^3=1+8=9$.
 
 There is a two-fold ambiguity: Momentum conservation implies that the
 branch with code
 \begin{equation}
   c_0 = \sum_{i=1}^{n(\rm{ext})} 2^{i-1}
 \end{equation}
 i.e. the branch with momentum $p_1+p_2+\ldots p_n$ has momentum zero,
 which is equivalent to tree code $0$ by definition.  Correspondingly,
 \begin{equation}
   c \quad\textrm{and}\quad c_0 - c = c\;\textrm{XOR}\;c_0
 \end{equation}
 are equivalent.  E.g., if there are five externals with codes
 $c=1,2,4,8,16$, then $c=9$ and $\bar c=31-9=22$ are equivalent.
 
 This ambiguity may be used to assign a direction to the line: If all
 momenta are understood as outgoing, $c=9$ in the example above means
 $p_1+p_4$, but $c=22$ means $p_2+p_3+p_5 = -(p_1+p_4)$.
 
 Here we make use of the ambiguity in a slightly different way.  First,
 the initial particles are singled out as those externals with the
 highest bits, the IN-bits.  (Here: $8$ and $16$ for a $2\to 3$
 scattering process, $16$ only for a $1\to 4$ decay.)  Then we invert
 those codes where all IN-bits are set.  For a decay process this maps
 each tree of an equivalence class onto a unique representative (that one
 with the smallest integer codes).  For a scattering process we proceed
 further:
 
 The ambiguity remains in all branches where only one IN-bit is set,
 including the initial particles.  If there are only externals with
 this property, we have an $s$-channel graph which we leave as it is.
 In all other cases, an internal with only one IN-bit is a $t$-channel
 line, which for phase space integration should be associated with one
 of the initial momenta as a reference axis.  We take that one whose
 bit is set in the current tree code.  (E.g., for branch $c=9$ we use
 the initial particle $c=8$ as reference axis, whereas for the same
 branch we would take $c=16$ if it had been assigned $\bar c=31-9=22$
 as tree code.) Thus, different ways of coding the same $t$-channel
 graph imply different phase space parameterizations.
 
 $s$-channel graphs have a unique parameterization.  The same sets of
 parameterizations are used for $t$-channel graphs, except for the
 reference frames of their angular parts.  We map each
 $t$-channel graph onto an $s$-channel graph as follows:
 
 Working in ascending order, for each $t$-channel line (whose code has
 exactly one IN-bit set) the attached initial line is flipped upstream,
 while the outgoing line is flipped downstream.  (This works only if
 $t$-channel graphs are always parameterized beginning at their outer
 vertices, which we require as a restriction.)  After all possible
 flips have been applied, we have an $s$-channel graph.  We only have
 to remember the initial particle a vertex was originally attached to.
 <<[[phs_trees.f90]]>>=
 <<File header>>
 
 module phs_trees
 
 <<Use kinds>>
   use kinds, only: TC
 <<Use strings>>
   use io_units
   use constants, only: twopi, twopi2, twopi5
   use format_defs, only: FMT_19
   use numeric_utils, only: vanishes
   use diagnostics
   use lorentz
   use permutations, only: permutation_t, permutation_size
   use permutations, only: permutation_init, permutation_find
   use permutations, only: tc_decay_level, tc_permute
   use model_data
   use flavors
   use resonances, only: resonance_history_t, resonance_info_t
   use mappings
 
 <<Standard module head>>
 
 <<PHS trees: public>>
 
 <<PHS trees: types>>
 
 contains
 
 <<PHS trees: procedures>>
 
 end module phs_trees
 @ %def phs_trees
 @
 \subsection{Particles}
 We define a particle type which contains only four-momentum and
 invariant mass squared, and a flag that tells whether the momentum is
 filled or not.
 <<PHS trees: public>>=
   public :: phs_prt_t
 <<PHS trees: types>>=
   type :: phs_prt_t
      private
      logical :: defined = .false.
      type(vector4_t) :: p
      real(default) :: p2
   end type phs_prt_t
 
 @ %def phs_prt_t
 @ Set contents:
 <<PHS trees: public>>=
   public :: phs_prt_set_defined
   public :: phs_prt_set_undefined
   public :: phs_prt_set_momentum
   public :: phs_prt_set_msq
 <<PHS trees: procedures>>=
   elemental subroutine phs_prt_set_defined (prt)
     type(phs_prt_t), intent(inout) :: prt
     prt%defined = .true.
   end subroutine phs_prt_set_defined
 
   elemental subroutine phs_prt_set_undefined (prt)
     type(phs_prt_t), intent(inout) :: prt
     prt%defined = .false.
   end subroutine phs_prt_set_undefined
 
   elemental subroutine phs_prt_set_momentum (prt, p)
     type(phs_prt_t), intent(inout) :: prt
     type(vector4_t), intent(in) :: p
     prt%p = p
   end subroutine phs_prt_set_momentum
 
   elemental subroutine phs_prt_set_msq (prt, p2)
     type(phs_prt_t), intent(inout) :: prt
     real(default), intent(in) :: p2
     prt%p2 = p2
   end subroutine phs_prt_set_msq
 
 @ %def phs_prt_set_defined phs_prt_set_momentum phs_prt_set_msq
 @ Access methods:
 <<PHS trees: public>>=
   public :: phs_prt_is_defined
   public :: phs_prt_get_momentum
   public :: phs_prt_get_msq
 <<PHS trees: procedures>>=
   elemental function phs_prt_is_defined (prt) result (defined)
     logical :: defined
     type(phs_prt_t), intent(in) :: prt
     defined = prt%defined
   end function phs_prt_is_defined
 
   elemental function phs_prt_get_momentum (prt) result (p)
     type(vector4_t) :: p
     type(phs_prt_t), intent(in) :: prt
     p = prt%p
   end function phs_prt_get_momentum
 
   elemental function phs_prt_get_msq (prt) result (p2)
     real(default) :: p2
     type(phs_prt_t), intent(in) :: prt
     p2 = prt%p2
   end function phs_prt_get_msq
 
 @ %def phs_prt_is_defined phs_prt_get_momentum phs_prt_get_msq
 @ Addition of momenta (invariant mass square is computed).
 <<PHS trees: public>>=
   public :: phs_prt_combine
 <<PHS trees: procedures>>=
   elemental subroutine phs_prt_combine (prt, prt1, prt2)
     type(phs_prt_t), intent(inout) :: prt
     type(phs_prt_t), intent(in) :: prt1, prt2
     prt%defined = .true.
     prt%p = prt1%p + prt2%p
     prt%p2 = prt%p ** 2
     call phs_prt_check (prt)
   end subroutine phs_prt_combine
 
 @ %def phs_prt_combine
 @ Output
 <<PHS trees: public>>=
   public :: phs_prt_write
 <<PHS trees: procedures>>=
   subroutine phs_prt_write (prt, unit)
     type(phs_prt_t), intent(in) :: prt
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     if (prt%defined) then
        call vector4_write (prt%p, u)
        write (u, "(1x,A,1x," // FMT_19 // ")") "T = ", prt%p2
     else
        write (u, "(3x,A)") "[undefined]"
     end if
   end subroutine phs_prt_write
 
 @ %def phs_prt_write
 <<PHS trees: public>>=
   public :: phs_prt_check
 <<PHS trees: procedures>>=
   elemental subroutine phs_prt_check (prt)
     type(phs_prt_t), intent(inout) :: prt
     if (prt%p2 < 0._default) then
        prt%p2 = 0._default
     end if
   end subroutine phs_prt_check
 
 @ %def phs_prt_check
 @
 \subsection{The phase-space tree type}
 \subsubsection{Definition}
 In the concrete implementation, each branch $c$ may have two
 \emph{daughters} $c_1$ and $c_2$ such that $c_1+c_2=c$, a
 \emph{sibling} $c_s$ and a \emph{mother} $c_m$ such that $c+c_s =
 c_m$, and a \emph{friend} which is kept during flips, such that it can
 indicate a fixed reference frame.  Absent entries are set $c=0$.
 
 First, declare the branch type.  There is some need to have this
 public. Give initializations for all components, so no [[init]]
 routine is necessary.  The branch has some information about the
 associated coordinates and about connections.
 <<PHS trees: types>>=
   type :: phs_branch_t
      private
      logical :: set = .false.
      logical :: inverted_decay = .false.
      logical :: inverted_axis = .false.
      integer(TC) :: mother = 0
      integer(TC) :: sibling = 0
      integer(TC) :: friend = 0
      integer(TC) :: origin = 0
      integer(TC), dimension(2) :: daughter = 0
      integer :: firstborn = 0
      logical :: has_children = .false.
      logical :: has_friend = .false.
      logical :: is_real = .false.
   end type phs_branch_t
 
 @ %def phs_branch_t
 @ The tree type: No initialization, this is done by
 [[phs_tree_init]].  In addition to the branch array which
 
 The branches are collected in an array which holds all possible
 branches, of which only a few are set.  After flips have been applied,
 the branch $c_M=\sum_{i=1}^{n({\rm fin})}2^{i-1}$ must be there,
 indicating the mother of all decay products.  In addition, we should
 check for consistency at the beginning.
 
 [[n_branches]] is the number of those actually set.  [[n_externals]]
 defines the number of significant bit, and [[mask]] is a code where all
 bits are set.  Analogous: [[n_in]] and [[mask_in]] for the incoming
 particles.
 
 The [[mapping]] array contains the mappings associated to the branches
 (corresponding indices).  The array [[mass_sum]] contains the sum of
 the real masses of the external final-state particles associated to
 the branch.  During phase-space evaluation, this determines the
 boundaries.
 <<PHS trees: public>>=
   public :: phs_tree_t
 <<PHS trees: types>>=
   type :: phs_tree_t
      private
      integer :: n_branches, n_externals, n_in, n_msq, n_angles
      integer(TC) :: n_branches_tot, n_branches_out
      integer(TC) :: mask, mask_in, mask_out
      type(phs_branch_t), dimension(:), allocatable :: branch
      type(mapping_t), dimension(:), allocatable :: mapping
      real(default), dimension(:), allocatable :: mass_sum
      real(default), dimension(:), allocatable :: effective_mass
      real(default), dimension(:), allocatable :: effective_width
      logical :: real_phsp = .false.
      integer, dimension(:), allocatable :: momentum_link
    contains
    <<PHS trees: phs tree: TBP>>
   end type phs_tree_t
 
 @ %def phs_tree_t
 @ The maximum number of external particles that can be represented is
 related to the bit size of the integer that stores binary codes.  With
 the default integer of 32 bit on common machines, this is more than
 enough space.  If [[TC]] is actually the default integer kind, there
 is no need to keep it separate, but doing so marks this as a
 special type of integer.  So, just state that the maximum number is 32:
 <<Limits: public parameters>>=
   integer, parameter, public :: MAX_EXTERNAL = 32
 @ %def MAX_EXTERNAL
 @
 \subsubsection{Constructor and destructor}
 Allocate memory for a phase-space tree with given number of externals and
 incoming.  The number of allocated branches can easily become large,
 but appears manageable for realistic cases, e.g., for [[n_in=2]] and
 [[n_out=8]] we get $2^{10}-1=1023$.
 <<PHS trees: public>>=
   public :: phs_tree_init
   public :: phs_tree_final
 @ Here we set the masks for incoming and for all externals.
 <<PHS trees: phs tree: TBP>>=
   procedure :: init => phs_tree_init
   procedure :: final => phs_tree_final
 <<PHS trees: procedures>>=
   elemental subroutine phs_tree_init (tree, n_in, n_out, n_masses, n_angles)
     class(phs_tree_t), intent(inout) :: tree
     integer, intent(in) :: n_in, n_out, n_masses, n_angles
     integer(TC) :: i
     tree%n_externals = n_in + n_out
     tree%n_branches_tot = 2**(n_in+n_out) - 1
     tree%n_branches_out = 2**n_out - 1
     tree%mask = 0
     do i = 0, n_in + n_out - 1
        tree%mask = ibset (tree%mask, i)
     end do
     tree%n_in = n_in
     tree%mask_in = 0
     do i = n_out, n_in + n_out - 1
        tree%mask_in = ibset (tree%mask_in, i)
     end do
     tree%mask_out = ieor (tree%mask, tree%mask_in)
     tree%n_msq = n_masses
     tree%n_angles = n_angles
     allocate (tree%branch (tree%n_branches_tot))
     tree%n_branches  = 0
     allocate (tree%mapping (tree%n_branches_out))
     allocate (tree%mass_sum (tree%n_branches_out))
     allocate (tree%effective_mass (tree%n_branches_out))
     allocate (tree%effective_width (tree%n_branches_out))
   end subroutine phs_tree_init
 
   elemental subroutine phs_tree_final (tree)
     class(phs_tree_t), intent(inout) :: tree
     deallocate (tree%branch)
     deallocate (tree%mapping)
     deallocate (tree%mass_sum)
     deallocate (tree%effective_mass)
     deallocate (tree%effective_width)
   end subroutine phs_tree_final
 
 @ %def phs_tree_init phs_tree_final
 @
 \subsubsection{Screen output}
 Write only the branches that are set:
 <<PHS trees: public>>=
   public :: phs_tree_write
 <<PHS trees: phs tree: TBP>>=
   procedure :: write => phs_tree_write
 <<PHS trees: procedures>>=
   subroutine phs_tree_write (tree, unit)
     class(phs_tree_t), intent(in) :: tree
     integer, intent(in), optional :: unit
     integer :: u
     integer(TC) :: k
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, '(3X,A,1x,I0,5X,A,I3)') &
          'External:', tree%n_externals, 'Mask:', tree%mask
     write (u, '(3X,A,1x,I0,5X,A,I3)') &
          'Incoming:', tree%n_in, 'Mask:', tree%mask_in
     write (u, '(3X,A,1x,I0,5X,A,I3)') &
          'Branches:', tree%n_branches
     do k = size (tree%branch), 1, -1
        if (tree%branch(k)%set) &
             call phs_branch_write (tree%branch(k), unit=unit, kval=k)
     end do
     do k = 1, size (tree%mapping)
        call mapping_write (tree%mapping (k), unit, verbose=.true.)
     end do
     write (u, "(3x,A)") "Arrays: mass_sum, effective_mass, effective_width"
     do k = 1, size (tree%mass_sum)
        if (tree%branch(k)%set) then
           write (u, "(5x,I0,3(2x," // FMT_19 // "))") k, tree%mass_sum(k), &
                tree%effective_mass(k), tree%effective_width(k)
        end if
     end do
   end subroutine phs_tree_write
 
   subroutine phs_branch_write (b, unit, kval)
     type(phs_branch_t), intent(in) :: b
     integer, intent(in), optional :: unit
     integer(TC), intent(in), optional :: kval
     integer :: u
     integer(TC) :: k
     character(len=6) :: tmp
     character(len=1) :: firstborn(2), sign_decay, sign_axis
     integer :: i
     u = given_output_unit (unit);  if (u < 0)  return
     k = 0;  if (present (kval))  k = kval
     if (b%origin /= 0) then
        write(tmp, '(A,I4,A)') '(', b%origin, ')'
     else
        tmp = ' '
     end if
     do i=1, 2
        if (b%firstborn == i) then
           firstborn(i) = "*"
        else
           firstborn(i) = " "
        end if
     end do
     if (b%inverted_decay) then
        sign_decay = "-"
     else
        sign_decay = "+"
     end if
     if (b%inverted_axis) then
        sign_axis = "-"
     else
        sign_axis = "+"
     end if
     if (b%has_children) then
        if (b%has_friend) then
           write(u,'(4X,A1,I0,3x,A,1X,A,I0,A1,1x,I0,A1,1X,A1,1X,A,1x,I0)') &
                &   '*', k, tmp, &
                &   'Daughters: ', &
                &   b%daughter(1), firstborn(1), &
                &   b%daughter(2), firstborn(2), sign_decay, &
                &   'Friend:    ', b%friend
        else
           write(u,'(4X,A1,I0,3x,A,1X,A,I0,A1,1x,I0,A1,1X,A1,1X,A)') &
                &   '*', k, tmp, &
                &   'Daughters: ', &
                &   b%daughter(1), firstborn(1), &
                &   b%daughter(2), firstborn(2), sign_decay, &
                &   '(axis '//sign_axis//')'
        end if
     else
        write(u,'(5X,I0)') k
     end if
   end subroutine phs_branch_write
 
 @ %def phs_tree_write phs_branch_write
 @
 \subsection{PHS tree setup}
 \subsubsection{Transformation into an array of branch codes and back}
 Assume that the tree/array has been created before with the
 appropriate length and is empty.
 <<PHS trees: public>>=
   public :: phs_tree_from_array
 <<PHS trees: phs tree: TBP>>=
   procedure :: from_array => phs_tree_from_array
 <<PHS trees: procedures>>=
   subroutine phs_tree_from_array (tree, a)
     class(phs_tree_t), intent(inout) :: tree
     integer(TC), dimension(:), intent(in) :: a
     integer :: i
     integer(TC) :: k
   <<Set branches from array [[a]]>>
   <<Set external branches if necessary>>
   <<Check number of branches>>
   <<Determine the connections>>
   contains
   <<Subroutine: set relatives>>
   end subroutine phs_tree_from_array
 
 @ %def phs_tree_from_array
 @ First, set all branches specified by the user.  If all IN-bits
 are set, we invert the branch code.
 <<Set branches from array [[a]]>>=
   do i=1, size(a)
      k = a(i)
      if (iand(k, tree%mask_in) == tree%mask_in)  k = ieor(tree%mask, k)
      tree%branch(k)%set = .true.
      tree%n_branches = tree%n_branches+1
   end do
 @ The external branches are understood, so set them now if not yet
 done.  In all cases ensure that the representative with one bit set is
 used, except for decays where the in-particle is represented by all
 OUT-bits set instead.
 <<Set external branches if necessary>>=
   do i=0, tree%n_externals-1
      k = ibset(0,i)
      if (iand(k, tree%mask_in) == tree%mask_in)  k = ieor(tree%mask, k)
      if (tree%branch(ieor(tree%mask, k))%set) then
         tree%branch(ieor(tree%mask, k))%set = .false.
         tree%branch(k)%set = .true.
      else if (.not.tree%branch(k)%set) then
         tree%branch(k)%set = .true.
         tree%n_branches = tree%n_branches+1
      end if
   end do
 @ Now the number of branches set can be checked.  Here we assume that
 the tree is binary.  For three externals there are three branches in
 total, and for each additional external branch we get another internal
 one.
 <<Check number of branches>>=
   if (tree%n_branches /= tree%n_externals*2-3) then
      call phs_tree_write (tree)
      call msg_bug &
           & (" Wrong number of branches set in phase space tree")
   end if
 @ For all branches that are set, except for the externals, we try to
 find the daughter branches:
 <<Determine the connections>>=
   do k=1, size (tree%branch)
      if (tree%branch(k)%set .and. tc_decay_level (k) /= 1) then
         call branch_set_relatives(k)
      end if
   end do
 @ To this end, we scan all codes less than the current code, whether
 we can find two branches which are set and which together give the
 current code.  After that, the tree may still not be connected, but at
 least we know if a branch does not have daughters: This indicates some
 inconsistency.
 
 The algorithm ensures that, at this stage, the first daughter has a
 smaller code value than the second one.
 <<Subroutine: set relatives>>=
   subroutine branch_set_relatives (k)
     integer(TC), intent(in) :: k
     integer(TC) :: m,n
     do m=1, k-1
        if(iand(k,m)==m) then
           n = ieor(k,m)
           if ( tree%branch(m)%set .and. tree%branch(n)%set ) then
              tree%branch(k)%daughter(1) = m;  tree%branch(k)%daughter(2) = n
              tree%branch(m)%mother      = k;  tree%branch(n)%mother      = k
              tree%branch(m)%sibling     = n;  tree%branch(n)%sibling     = m
              tree%branch(k)%has_children = .true.
              return
           end if
        end if
     end do
     call phs_tree_write (tree)
     call msg_bug &
          & (" Missing daughter branch(es) in phase space tree")
   end subroutine branch_set_relatives
 
 @ The inverse: this is trivial, fortunately.
 @
 \subsubsection{Flip $t$-channel into $s$-channel}
 Flipping the tree is done upwards, beginning from the decay products.
 First we select a $t$-channel branch [[k]]: one which is set, which
 does have an IN-bit, and which is not an external particle.
 
 Next, we determine the adjacent in-particle (called the 'friend' [[f]]
 here, since it will provide the reference axis for the angular
 integration).  In addition, we look for the 'mother' and 'sibling' of
 this particle.  If the latter field is empty, we select the (unique)
 other out-particle which has no mother, calling the internal
 subroutine [[find_orphan]].
 
 The flip is done as follows: We assume that the first daughter [[d]]
 is an $s$-channel line, which is true if the daughters are sorted.
 This will stay the first daughter.  The second one is a $t$-channel
 line; it is exchanged with the 'sibling' [[s]].  The new line which
 replaces the branch [[k]] is just the sum of [[s]] and [[d]].  In
 addition, we have to rearrange the relatives of [[s]] and [[d]], as
 well of [[f]].
 
 Finally, we flip 'sibling' and 'friend' and set the new $s$-channel
 branch [[n]] which replaces the $t$-channel branch [[k]].  After this
 is complete, we are ready to execute another flip.
 
 [Although the friend is not needed for the final flip, since it would
 be an initial particle anyway, we need to know whether we have $t$- or
 $u$-channel.]
 <<PHS trees: public>>=
   public :: phs_tree_flip_t_to_s_channel
 <<PHS trees: procedures>>=
   subroutine phs_tree_flip_t_to_s_channel (tree)
     type(phs_tree_t), intent(inout) :: tree
     integer(TC) :: k, f, m, n, d, s
     if (tree%n_in == 2) then
        FLIP: do k=3, tree%mask-1
           if (.not. tree%branch(k)%set) cycle FLIP
           f = iand(k,tree%mask_in)
           if (f==0 .or. f==k) cycle FLIP
           m = tree%branch(k)%mother
           s = tree%branch(k)%sibling
           if (s==0) call find_orphan(s)
           d = tree%branch(k)%daughter(1)
           n = ior(d,s)
           tree%branch(k)%set = .false.
           tree%branch(n)%set = .true.
           tree%branch(n)%origin = k
           tree%branch(n)%daughter(1) = d; tree%branch(d)%mother  = n
           tree%branch(n)%daughter(2) = s; tree%branch(s)%mother  = n
           tree%branch(n)%has_children = .true.
           tree%branch(d)%sibling = s;  tree%branch(s)%sibling = d
           tree%branch(n)%sibling = f;  tree%branch(f)%sibling = n
           tree%branch(n)%mother      = m
           tree%branch(f)%mother      = m
           if (m/=0) then
              tree%branch(m)%daughter(1) = n
              tree%branch(m)%daughter(2) = f
           end if
           tree%branch(n)%friend = f
           tree%branch(n)%has_friend = .true.
           tree%branch(n)%firstborn = 2
        end do FLIP
     end if
   contains
     subroutine find_orphan(s)
       integer(TC) :: s
       do s=1, tree%mask_out
          if (tree%branch(s)%set .and. tree%branch(s)%mother==0) return
       end do
       call phs_tree_write (tree)
       call msg_bug (" Can't flip phase space tree to channel")
     end subroutine find_orphan
   end subroutine phs_tree_flip_t_to_s_channel
 
 @ %def phs_tree_flip_t_to_s_channel
 @ After the tree has been flipped, one may need to determine what has
 become of a particular $t$-channel branch.  This function gives the
 bincode of the flipped tree.  If the original bincode does not contain
 IN-bits, we leave it as it is.
 <<PHS trees: procedures>>=
   function tc_flipped (tree, kt) result (ks)
     type(phs_tree_t), intent(in) :: tree
     integer(TC), intent(in) :: kt
     integer(TC) :: ks
     if (iand (kt, tree%mask_in) == 0) then
        ks = kt
     else
        ks = tree%branch(iand (kt, tree%mask_out))%mother
     end if
   end function tc_flipped
 
 @ %def tc_flipped
 @ Scan a tree and make sure that the first daughter has always a
 smaller code than the second one.  Furthermore, delete any [[friend]]
 entry in the root branch -- this branching has the incoming particle
 direction as axis anyway.  Keep track of reordering by updating
 [[inverted_axis]], [[inverted_decay]] and [[firstborn]].
 <<PHS trees: public>>=
   public :: phs_tree_canonicalize
 <<PHS trees: procedures>>=
   subroutine phs_tree_canonicalize (tree)
     type(phs_tree_t), intent(inout) :: tree
     integer :: n_out
     integer(TC) :: k_out
     call branch_canonicalize (tree%branch(tree%mask_out))
     n_out = tree%n_externals - tree%n_in
     k_out = tree%mask_out
     if (tree%branch(k_out)%has_friend &
          & .and. tree%branch(k_out)%friend == ibset (0, n_out)) then
        tree%branch(k_out)%inverted_axis = .not.tree%branch(k_out)%inverted_axis
     end if
     tree%branch(k_out)%has_friend = .false.
     tree%branch(k_out)%friend = 0
   contains
     recursive subroutine branch_canonicalize (b)
       type(phs_branch_t), intent(inout) :: b
       integer(TC) :: d1, d2
       if (b%has_children) then
          d1 = b%daughter(1)
          d2 = b%daughter(2)
          if (d1 > d2) then
             b%daughter(1) = d2
             b%daughter(2) = d1
             b%inverted_decay = .not.b%inverted_decay
             if (b%firstborn /= 0)  b%firstborn = 3 - b%firstborn
          end if
          call branch_canonicalize (tree%branch(b%daughter(1)))
          call branch_canonicalize (tree%branch(b%daughter(2)))
       end if
     end subroutine branch_canonicalize
   end subroutine phs_tree_canonicalize
 
 @ %def phs_tree_canonicalize
 @
 \subsubsection{Mappings}
 Initialize a mapping for the current tree.  This is done while reading
 from file, so the mapping parameters are read, but applied to the
 flipped tree.  Thus, the size of the array of mappings is given by the
 number of outgoing particles only.
 <<PHS trees: public>>=
   public :: phs_tree_init_mapping
 <<PHS trees: phs tree: TBP>>=
   procedure :: init_mapping => phs_tree_init_mapping
 <<PHS trees: procedures>>=
   subroutine phs_tree_init_mapping (tree, k, type, pdg, model)
     class(phs_tree_t), intent(inout) :: tree
     integer(TC), intent(in) :: k
     type(string_t), intent(in) :: type
     integer, intent(in) :: pdg
     class(model_data_t), intent(in), target :: model
     integer(TC) :: kk
     kk = tc_flipped (tree, k)
     call mapping_init (tree%mapping(kk), kk, type, pdg, model)
   end subroutine phs_tree_init_mapping
 
 @ %def phs_tree_init_mapping
 @ Set the physical parameters for the mapping, using a specific
 parameter set.  Also set the mass sum array.
 <<PHS trees: public>>=
   public :: phs_tree_set_mapping_parameters
 <<PHS trees: phs tree: TBP>>=
   procedure :: set_mapping_parameters => phs_tree_set_mapping_parameters
 <<PHS trees: procedures>>=
   subroutine phs_tree_set_mapping_parameters &
        (tree, mapping_defaults, variable_limits)
     class(phs_tree_t), intent(inout) :: tree
     type(mapping_defaults_t), intent(in) :: mapping_defaults
     logical, intent(in) :: variable_limits
     integer(TC) :: k
     do k = 1, tree%n_branches_out
        call mapping_set_parameters &
             (tree%mapping(k), mapping_defaults, variable_limits)
     end do
   end subroutine phs_tree_set_mapping_parameters
 
 @ %def phs_tree_set_mapping_parameters
 @ Return the mapping for the sum of all outgoing particles.  This
 should either be no mapping or a global s-channel mapping.
 <<PHS trees: public>>=
   public :: phs_tree_assign_s_mapping
 <<PHS trees: procedures>>=
   subroutine phs_tree_assign_s_mapping (tree, mapping)
     type(phs_tree_t), intent(in) :: tree
     type(mapping_t), intent(out) :: mapping
     mapping = tree%mapping(tree%mask_out)
   end subroutine phs_tree_assign_s_mapping
 
 @ %def phs_tree_assign_s_mapping
 @
 \subsubsection{Kinematics}
 Fill the mass sum array, starting from the external particles and
 working down to the tree root.  For each bincode [[k]] we scan the
 bits in [[k]]; if only one is set, we take the physical mass of the
 corresponding external particle; if more then one is set, we sum up
 the two masses (which we know have already been set).
 <<PHS trees: public>>=
   public :: phs_tree_set_mass_sum
 <<PHS trees: phs tree: TBP>>=
   procedure :: set_mass_sum => phs_tree_set_mass_sum
 <<PHS trees: procedures>>=
   subroutine phs_tree_set_mass_sum (tree, flv)
     class(phs_tree_t), intent(inout) :: tree
     type(flavor_t), dimension(:), intent(in) :: flv
     integer(TC) :: k
     integer :: i
     tree%mass_sum = 0
     do k = 1, tree%n_branches_out
        do i = 0, size (flv) - 1
           if (btest(k,i)) then
              if (ibclr(k,i) == 0) then
                 tree%mass_sum(k) = flv(i+1)%get_mass ()
              else
                 tree%mass_sum(k) = &
                      tree%mass_sum(ibclr(k,i)) + tree%mass_sum(ibset(0,i))
              end if
              exit
           end if
        end do
     end do
   end subroutine phs_tree_set_mass_sum
 
 @ %def phs_tree_set_mass_sum
 @ Set the effective masses and widths.  For each non-resonant branch
 in a tree, the effective mass is equal to the sum of the effective
 masses of the children (and analogous for the width).  External
 particles have their real mass and width zero.  For resonant branches,
 we insert mass and width from the corresponding mapping.
 
 This routine has [[phs_tree_set_mass_sum]] and
 [[phs_tree_set_mapping_parameters]] as prerequisites.
 <<PHS trees: public>>=
   public :: phs_tree_set_effective_masses
 <<PHS trees: phs tree: TBP>>=
   procedure :: set_effective_masses => phs_tree_set_effective_masses
 <<PHS trees: procedures>>=
   subroutine phs_tree_set_effective_masses (tree)
     class(phs_tree_t), intent(inout) :: tree
     tree%effective_mass = 0
     tree%effective_width = 0
     call set_masses_x (tree%mask_out)
   contains
     recursive subroutine set_masses_x (k)
       integer(TC), intent(in) :: k
       integer(TC) :: k1, k2
       if (tree%branch(k)%has_children) then
          k1 = tree%branch(k)%daughter(1)
          k2 = tree%branch(k)%daughter(2)
          call set_masses_x (k1)
          call set_masses_x (k2)
          if (mapping_is_s_channel (tree%mapping(k))) then
             tree%effective_mass(k) = mapping_get_mass (tree%mapping(k))
             tree%effective_width(k) = mapping_get_width (tree%mapping(k))
          else
             tree%effective_mass(k) = &
                  tree%effective_mass(k1) + tree%effective_mass(k2)
             tree%effective_width(k) = &
                  tree%effective_width(k1) + tree%effective_width(k2)
          end if
       else
          tree%effective_mass(k) = tree%mass_sum(k)
       end if
     end subroutine set_masses_x
   end subroutine phs_tree_set_effective_masses
 
 @ %def phs_tree_set_effective_masses
 @ Define step mappings, recursively, for the decay products of all
 intermediate resonances.  Step mappings account for the fact that a
 branch may originate from a resonance, which almost replaces the
 upper limit on the possible invariant mass.  The step
 mapping implements a smooth cutoff that interpolates between the
 resonance and the real kinematic limit.  The mapping width determines
 the sharpness of the cutoff.
 
 Step mappings are inserted only for branches that are not mapped
 otherwise.
 
 At each branch, we record the mass that is effectively available for
 phase space, by taking the previous limit and subtracting the
 effective mass of the sibling branch.  Widths are added, not subtracted.
 
 If we encounter a resonance decay, we discard the previous limit and
 replace it by the mass and width of the resonance, also subtracting
 the sibling branch.
 
 Initially, the limit is zero, so it becomes negative at any branch.  Only
 if there is a resonance, the limit becomes positive.  Whenever the
 limit is positive, and the current branch decays, we activate a step
 mapping for the current branch.
 
 As a result, step mappings are implemented for all internal lines that
 originate from an intermediate resonance decay.
 
 The flag [[variable_limits]] applies to the ultimate limit from the
 available energy, not to the intermediate resonances whose masses are
 always fixed.
 
 This routine requires [[phs_tree_set_effective_masses]]
 <<PHS trees: public>>=
   public :: phs_tree_set_step_mappings
 <<PHS trees: procedures>>=
   subroutine phs_tree_set_step_mappings (tree, exp_type, variable_limits)
     type(phs_tree_t), intent(inout) :: tree
     logical, intent(in) :: exp_type
     logical, intent(in) :: variable_limits
     type(string_t) :: map_str
     integer(TC) :: k
     if (exp_type) then
        map_str = "step_exp"
     else
        map_str = "step_hyp"
     end if
     k = tree%mask_out
     call set_step_mappings_x (k, 0._default, 0._default)
   contains
     recursive subroutine set_step_mappings_x (k, m_limit, w_limit)
       integer(TC), intent(in) :: k
       real(default), intent(in) :: m_limit, w_limit
       integer(TC), dimension(2) :: kk
       real(default), dimension(2) :: m, w
       if (tree%branch(k)%has_children) then
          if (m_limit > 0) then
             if (.not. mapping_is_set (tree%mapping(k))) then
                call mapping_init (tree%mapping(k), k, map_str)
                call mapping_set_step_mapping_parameters (tree%mapping(k), &
                     m_limit, w_limit, &
                     variable_limits)
             end if
          end if
          kk = tree%branch(k)%daughter
          m = tree%effective_mass(kk)
          w = tree%effective_width(kk)
          if (mapping_is_s_channel (tree%mapping(k))) then
             call set_step_mappings_x (kk(1), &
                  mapping_get_mass (tree%mapping(k)) - m(2), &
                  mapping_get_width (tree%mapping(k)) + w(2))
             call set_step_mappings_x (kk(2), &
                  mapping_get_mass (tree%mapping(k)) - m(1), &
                  mapping_get_width (tree%mapping(k)) + w(1))
          else if (m_limit > 0) then
             call set_step_mappings_x (kk(1), &
                  m_limit - m(2), &
                  w_limit + w(2))
             call set_step_mappings_x (kk(2), &
                  m_limit - m(1), &
                  w_limit + w(1))
          else
             call set_step_mappings_x (kk(1), &
                  - m(2), &
                  + w(2))
             call set_step_mappings_x (kk(2), &
                  - m(1), &
                  + w(1))
          end if
       end if
     end subroutine set_step_mappings_x
   end subroutine phs_tree_set_step_mappings
 
 @ %def phs_tree_set_step_mappings
 @
 \subsubsection{Resonance structure}
 We identify the resonances within a tree as the set of s-channel
 mappings.  The [[resonance_history_t]] type serves as the result
 container.
 <<PHS trees: phs tree: TBP>>=
   procedure :: extract_resonance_history => phs_tree_extract_resonance_history
 <<PHS trees: procedures>>=
   subroutine phs_tree_extract_resonance_history (tree, res_history)
     class(phs_tree_t), intent(in) :: tree
     type(resonance_history_t), intent(out) :: res_history
     type(resonance_info_t) :: res_info
     integer :: i
     if (allocated (tree%mapping)) then
        do i = 1, size (tree%mapping)
           associate (mapping => tree%mapping(i))
              if (mapping%is_s_channel ()) then
                 call res_info%init (mapping%get_bincode (), mapping%get_flv (), &
                      n_out = tree%n_externals - tree%n_in)
                 call res_history%add_resonance (res_info)
              end if
           end associate
        end do
     end if
   end subroutine phs_tree_extract_resonance_history
 
 @ %def phs_tree_extract_resonance_history
 @
 \subsubsection{Structural comparison}
 This function allows to check whether one tree is the permutation of
 another one.  The permutation is applied to the second tree in the
 argument list.  We do not make up a temporary permuted tree, but
 compare the two trees directly.  The branches are scanned recursively,
 where for each daughter we check the friend and the mapping as well.
 Once a discrepancy is found, the recursion is exited immediately.
 <<PHS trees: public>>=
   public :: phs_tree_equivalent
 <<PHS trees: procedures>>=
   function phs_tree_equivalent (t1, t2, perm) result (is_equal)
     type(phs_tree_t), intent(in) :: t1, t2
     type(permutation_t), intent(in) :: perm
     logical :: equal, is_equal
     integer(TC) :: k1, k2, mask_in
     k1 = t1%mask_out
     k2 = t2%mask_out
     mask_in = t1%mask_in
     equal = .true.
     call check (t1%branch(k1), t2%branch(k2), k1, k2)
     is_equal = equal
   contains
     recursive subroutine check (b1, b2, k1, k2)
       type(phs_branch_t), intent(in) :: b1, b2
       integer(TC), intent(in) :: k1, k2
       integer(TC), dimension(2) :: d1, d2, pd2
       integer :: i
       if (.not.b1%has_friend .and. .not.b2%has_friend) then
          equal = .true.
       else if (b1%has_friend .and. b2%has_friend) then
          equal = (b1%friend == tc_permute (b2%friend, perm, mask_in))
       end if
       if (equal) then
          if (b1%has_children .and. b2%has_children) then
             d1 = b1%daughter
             d2 = b2%daughter
             do i=1, 2
                pd2(i) = tc_permute (d2(i), perm, mask_in)
             end do
             if (d1(1)==pd2(1) .and. d1(2)==pd2(2)) then
                equal = (b1%firstborn == b2%firstborn)
                if (equal) call check &
                     &     (t1%branch(d1(1)), t2%branch(d2(1)), d1(1), d2(1))
                if (equal) call check &
                     &     (t1%branch(d1(2)), t2%branch(d2(2)), d1(2), d2(2))
             else if (d1(1)==pd2(2) .and. d1(2)==pd2(1)) then
                equal = ( (b1%firstborn == 0 .and. b2%firstborn == 0) &
                     &   .or. (b1%firstborn == 3 - b2%firstborn) )
                if (equal) call check &
                     &     (t1%branch(d1(1)), t2%branch(d2(2)), d1(1), d2(2))
                if (equal) call check &
                     &     (t1%branch(d1(2)), t2%branch(d2(1)), d1(2), d2(1))
             else
                equal = .false.
             end if
          end if
       end if
       if (equal) then
          equal = (t1%mapping(k1) == t2%mapping(k2))
       end if
     end subroutine check
   end function phs_tree_equivalent
 
 @ %def phs_tree_equivalent
 @ Scan two decay trees and determine the correspondence of mass
 variables, i.e., the permutation that transfers the ordered list of
 mass variables belonging to the second tree into the first one.  Mass
 variables are assigned beginning from branches and ending at the root.
 <<PHS trees: public>>=
   public :: phs_tree_find_msq_permutation
 <<PHS trees: procedures>>=
   subroutine phs_tree_find_msq_permutation (tree1, tree2, perm2, msq_perm)
     type(phs_tree_t), intent(in) :: tree1, tree2
     type(permutation_t), intent(in) :: perm2
     type(permutation_t), intent(out) :: msq_perm
     type(permutation_t) :: perm1
     integer(TC) :: mask_in, root
     integer(TC), dimension(:), allocatable :: index1, index2
     integer :: i
     allocate (index1 (tree1%n_msq), index2 (tree2%n_msq))
     call permutation_init (perm1, permutation_size (perm2))
     mask_in = tree1%mask_in
     root = tree1%mask_out
     i = 0
     call tree_scan (tree1, root, perm1, index1)
     i = 0
     call tree_scan (tree2, root, perm2, index2)
     call permutation_find (msq_perm, index1, index2)
   contains
     recursive subroutine tree_scan (tree, k, perm, index)
       type(phs_tree_t), intent(in) :: tree
       integer(TC), intent(in) :: k
       type(permutation_t), intent(in) :: perm
       integer, dimension(:), intent(inout) :: index
       if (tree%branch(k)%has_children) then
          call tree_scan (tree, tree%branch(k)%daughter(1), perm, index)
          call tree_scan (tree, tree%branch(k)%daughter(2), perm, index)
          i = i + 1
          if (i <= size (index))  index(i) = tc_permute (k, perm, mask_in)
       end if
     end subroutine tree_scan
   end subroutine phs_tree_find_msq_permutation
 
 @ %def phs_tree_find_msq_permutation
 <<PHS trees: public>>=
   public :: phs_tree_find_angle_permutation
 <<PHS trees: procedures>>=
   subroutine phs_tree_find_angle_permutation &
        (tree1, tree2, perm2, angle_perm, sig2)
     type(phs_tree_t), intent(in) :: tree1, tree2
     type(permutation_t), intent(in) :: perm2
     type(permutation_t), intent(out) :: angle_perm
     logical, dimension(:), allocatable, intent(out) :: sig2
     type(permutation_t) :: perm1
     integer(TC) :: mask_in, root
     integer(TC), dimension(:), allocatable :: index1, index2
     logical, dimension(:), allocatable :: sig1
     integer :: i
     allocate (index1 (tree1%n_angles), index2 (tree2%n_angles))
     allocate (sig1 (tree1%n_angles), sig2 (tree2%n_angles))
     call permutation_init (perm1, permutation_size (perm2))
     mask_in = tree1%mask_in
     root = tree1%mask_out
     i = 0
     call tree_scan (tree1, root, perm1, index1, sig1)
     i = 0
     call tree_scan (tree2, root, perm2, index2, sig2)
     call permutation_find (angle_perm, index1, index2)
   contains
     recursive subroutine tree_scan (tree, k, perm, index, sig)
       type(phs_tree_t), intent(in) :: tree
       integer(TC), intent(in) :: k
       type(permutation_t), intent(in) :: perm
       integer, dimension(:), intent(inout) :: index
       logical, dimension(:), intent(inout) :: sig
       integer(TC) :: k1, k2, kp
       logical :: s
       if (tree%branch(k)%has_children) then
          k1 = tree%branch(k)%daughter(1)
          k2 = tree%branch(k)%daughter(2)
          s = (tc_permute(k1, perm, mask_in) < tc_permute(k2, perm, mask_in))
          kp = tc_permute (k, perm, mask_in)
          i = i + 1
          index(i) = kp
          sig(i) = s
          i = i + 1
          index(i) = - kp
          sig(i) = s
          call tree_scan (tree, k1, perm, index, sig)
          call tree_scan (tree, k2, perm, index, sig)
       end if
     end subroutine tree_scan
   end subroutine phs_tree_find_angle_permutation
 
 @ %def phs_tree_find_angle_permutation
 @
 \subsection{Phase-space evaluation}
 \subsubsection{Phase-space volume}
 We compute the phase-space volume recursively, following the same path
 as for computing other kinematical variables.  However, the volume
 depends just on $\sqrt{\hat s}$, not on the momentum configuration.
 
 Note: counting branches, we may replace this by a simple formula.
 <<PHS trees: public>>=
   public :: phs_tree_compute_volume
 <<PHS trees: procedures>>=
   subroutine phs_tree_compute_volume (tree, sqrts, volume)
     type(phs_tree_t), intent(in) :: tree
     real(default), intent(in) :: sqrts
     real(default), intent(out) :: volume
     integer(TC) :: k
     k  = tree%mask_out
     if (tree%branch(k)%has_children) then
        call compute_volume_x (tree%branch(k), k, volume, .true.)
     else
        volume = 1
     end if
   contains
     recursive subroutine compute_volume_x (b, k, volume, initial)
       type(phs_branch_t), intent(in) :: b
       integer(TC), intent(in) :: k
       real(default), intent(out) :: volume
       logical, intent(in) :: initial
       integer(TC) :: k1, k2
       real(default) :: v1, v2
       k1 = b%daughter(1);  k2 = b%daughter(2)
       if (tree%branch(k1)%has_children) then
          call compute_volume_x (tree%branch(k1), k1, v1, .false.)
       else
          v1 = 1
       end if
       if (tree%branch(k2)%has_children) then
          call compute_volume_x (tree%branch(k2), k2, v2, .false.)
       else
          v2 = 1
       end if
       if (initial) then
          volume = v1 * v2 / (4 * twopi5)
       else
          volume = v1 * v2 * sqrts**2 / (4 * twopi2)
       end if
     end subroutine compute_volume_x
   end subroutine phs_tree_compute_volume
 
 @ %def phs_tree_compute_volume
 @
 \subsubsection{Determine momenta}
 This is done in two steps: First the masses are determined.  This step
 may fail, in which case [[ok]] is set to false.  If successful, we
 generate angles and the actual momenta.  The array [[decay_p]] serves
 for transferring the individual three-momenta of the daughter
 particles in their mother rest frame from the mass generation to the
 momentum generation step.
 <<PHS trees: public>>=
   public :: phs_tree_compute_momenta_from_x
 <<PHS trees: procedures>>=
   subroutine phs_tree_compute_momenta_from_x &
        (tree, prt, factor, volume, sqrts, x, ok)
     type(phs_tree_t), intent(inout) :: tree
     type(phs_prt_t), dimension(:), intent(inout) :: prt
     real(default), intent(out) :: factor, volume
     real(default), intent(in) :: sqrts
     real(default), dimension(:), intent(in) :: x
     logical, intent(out) :: ok
     real(default), dimension(tree%mask_out) :: decay_p
     integer :: n1, n2
     integer :: n_out
     if (tree%real_phsp) then
       n_out = tree%n_externals - tree%n_in - 1
       n1 = max (n_out-2, 0)
       n2 = n1 + max (2*n_out, 0)
     else
       n1 = tree%n_msq
       n2 = n1 + tree%n_angles
     end if
     call phs_tree_set_msq &
          (tree, prt, factor, volume, decay_p, sqrts, x(1:n1), ok)
     if (ok) call phs_tree_set_angles &
          (tree, prt, factor, decay_p, sqrts, x(n1+1:n2))
   end subroutine phs_tree_compute_momenta_from_x
 
 @ %def phs_tree_compute_momenta_from_x
 @ Mass generation is done recursively.  The [[ok]] flag causes the
 filled tree to be discarded if set to [[.false.]].  This happens if a
 three-momentum turns out to be imaginary, indicating impossible
 kinematics.  The index [[ix]] tells us how far we have used up the
 input array [[x]].
 <<PHS trees: procedures>>=
   subroutine phs_tree_set_msq &
        (tree, prt, factor, volume, decay_p, sqrts, x, ok)
     type(phs_tree_t), intent(inout) :: tree
     type(phs_prt_t), dimension(:), intent(inout) :: prt
     real(default), intent(out) :: factor, volume
     real(default), dimension(:), intent(out) :: decay_p
     real(default), intent(in) :: sqrts
     real(default), dimension(:), intent(in) :: x
     logical, intent(out) :: ok
     integer :: ix
     integer(TC) :: k
     real(default) :: m_tot
     ok =.true.
     ix = 1
     k  = tree%mask_out
     m_tot = tree%mass_sum(k)
     decay_p(k) = 0.
     if (m_tot < sqrts .or. k == 1) then
        if (tree%branch(k)%has_children) then
           call set_msq_x (tree%branch(k), k, factor, volume, .true.)
        else
           factor = 1
           volume = 1
        end if
     else
        ok = .false.
     end if
   contains
     recursive subroutine set_msq_x (b, k, factor, volume, initial)
       type(phs_branch_t), intent(in) :: b
       integer(TC), intent(in) :: k
       real(default), intent(out) :: factor, volume
       logical, intent(in) :: initial
       real(default) :: msq, m, m_min, m_max, m1, m2, msq1, msq2, lda, rlda
       integer(TC) :: k1, k2
       real(default) :: f1, f2, v1, v2
       k1 = b%daughter(1);  k2 = b%daughter(2)
       if (tree%branch(k1)%has_children) then
          call set_msq_x (tree%branch(k1), k1, f1, v1, .false.)
          if (.not.ok) return
       else
          f1 = 1;  v1 = 1
       end if
       if (tree%branch(k2)%has_children) then
          call set_msq_x (tree%branch(k2), k2, f2, v2, .false.)
          if (.not.ok) return
       else
          f2 = 1;  v2 = 1
       end if
       m_min = tree%mass_sum(k)
       if (initial) then
          msq = sqrts**2
          m = sqrts
          m_max = sqrts
          factor = f1 * f2
          volume = v1 * v2 / (4 * twopi5)
       else
          m_max = sqrts - m_tot + m_min
          call mapping_compute_msq_from_x &
               (tree%mapping(k), sqrts**2, m_min**2, m_max**2, msq, factor, &
                x(ix)); ix = ix + 1
          if (msq >= 0) then
             m = sqrt (msq)
             factor = f1 * f2 * factor
             volume = v1 * v2 * sqrts**2 / (4 * twopi2)
             call phs_prt_set_msq (prt(k), msq)
             call phs_prt_set_defined (prt(k))
          else
             ok = .false.
          end if
       end if
       if (ok) then
          msq1 = phs_prt_get_msq (prt(k1));  m1 = sqrt (msq1)
          msq2 = phs_prt_get_msq (prt(k2));  m2 = sqrt (msq2)
          lda = lambda (msq, msq1, msq2)
          if (lda > 0 .and. m > m1 + m2 .and. m <= m_max) then
             rlda = sqrt (lda)
             decay_p(k1) = rlda / (2*m)
             decay_p(k2) = - decay_p(k1)
             factor = rlda / msq * factor
          else
             ok = .false.
          end if
       end if
     end subroutine set_msq_x
 
   end subroutine phs_tree_set_msq
 
 @ %def phs_tree_set_msq
 @
 The heart of phase space generation: Now we have the invariant masses,
 let us generate angles.  At each branch, we take a Lorentz
 transformation and augment it by a boost to the current particle
 rest frame, and by rotations $\phi$ and $\theta$ around the $z$ and
 $y$ axis, respectively.  This transformation is passed down to the
 daughter particles, if present.
 <<PHS trees: procedures>>=
   subroutine phs_tree_set_angles (tree, prt, factor, decay_p, sqrts, x)
     type(phs_tree_t), intent(inout) :: tree
     type(phs_prt_t), dimension(:), intent(inout) :: prt
     real(default), intent(inout) :: factor
     real(default), dimension(:), intent(in) :: decay_p
     real(default), intent(in) :: sqrts
     real(default), dimension(:), intent(in) :: x
     integer :: ix
     integer(TC) :: k
     ix = 1
     k  = tree%mask_out
     call set_angles_x (tree%branch(k), k)
   contains
     recursive subroutine set_angles_x (b, k, L0)
       type(phs_branch_t), intent(in) :: b
       integer(TC), intent(in) :: k
       type(lorentz_transformation_t), intent(in), optional :: L0
       real(default) :: m, msq, ct, st, phi, f, E, p, bg
       type(lorentz_transformation_t) :: L, LL
       integer(TC) :: k1, k2
       type(vector3_t) :: axis
       p = decay_p(k)
       msq = phs_prt_get_msq (prt(k));  m = sqrt (msq)
       E = sqrt (msq + p**2)
       if (present (L0)) then
          call phs_prt_set_momentum (prt(k), L0 * vector4_moving (E,p,3))
       else
          call phs_prt_set_momentum (prt(k), vector4_moving (E,p,3))
       end if
       call phs_prt_set_defined (prt(k))
       if (b%has_children) then
          k1 = b%daughter(1)
          k2 = b%daughter(2)
          if (m > 0) then
             bg = p / m
          else
             bg = 0
          end if
          phi = x(ix) * twopi;  ix = ix + 1
          call mapping_compute_ct_from_x &
               (tree%mapping(k), sqrts**2, ct, st, f, x(ix));  ix = ix + 1
          factor = factor * f
          if (.not. b%has_friend) then
             L = LT_compose_r2_r3_b3 (ct, st, cos(phi), sin(phi), bg)
             !!! The function above is equivalent to:
             ! L = boost (bg,3) * rotation (phi,3) * rotation (ct,st,2)
          else
             LL = boost (-bg,3);  if (present (L0))  LL = LL * inverse(L0)
             axis = space_part ( &
                  LL * phs_prt_get_momentum (prt(tree%branch(k)%friend)) )
             L = boost(bg,3) * rotation_to_2nd (vector3_canonical(3), axis) &
                  * LT_compose_r2_r3_b3 (ct, st, cos(phi), sin(phi), 0._default)
          end if
          if (present (L0))  L = L0 * L
          call set_angles_x (tree%branch(k1), k1, L)
          call set_angles_x (tree%branch(k2), k2, L)
       end if
     end subroutine set_angles_x
 
   end subroutine phs_tree_set_angles
 
 @ %def phs_tree_set_angles
 @
 \subsubsection{Recover random numbers}
 For the other channels we want to compute the random numbers that
 would have generated the momenta that we already know.
 <<PHS trees: public>>=
   public :: phs_tree_compute_x_from_momenta
 <<PHS trees: procedures>>=
   subroutine phs_tree_compute_x_from_momenta (tree, prt, factor, sqrts, x)
     type(phs_tree_t), intent(inout) :: tree
     type(phs_prt_t), dimension(:), intent(in) :: prt
     real(default), intent(out) :: factor
     real(default), intent(in) :: sqrts
     real(default), dimension(:), intent(inout) :: x
     real(default), dimension(tree%mask_out) :: decay_p
     integer :: n1, n2
     n1 = tree%n_msq
     n2 = n1 + tree%n_angles
     call phs_tree_get_msq &
          (tree, prt, factor, decay_p, sqrts, x(1:n1))
     call phs_tree_get_angles &
          (tree, prt, factor, decay_p, sqrts, x(n1+1:n2))
   end subroutine phs_tree_compute_x_from_momenta
 
 @ %def phs_tree_compute_x_from_momenta
 @ The inverse operation follows exactly the same steps.  The tree is
 [[inout]] because it contains mappings whose parameters can be reset
 when the mapping is applied.
 <<PHS trees: procedures>>=
   subroutine phs_tree_get_msq (tree, prt, factor, decay_p, sqrts, x)
     type(phs_tree_t), intent(inout) :: tree
     type(phs_prt_t), dimension(:), intent(in) :: prt
     real(default), intent(out) :: factor
     real(default), dimension(:), intent(out) :: decay_p
     real(default), intent(in) :: sqrts
     real(default), dimension(:), intent(inout) :: x
     integer :: ix
     integer(TC) :: k
     real(default) :: m_tot
     ix = 1
     k  = tree%mask_out
     m_tot = tree%mass_sum(k)
     decay_p(k) = 0.
     if (tree%branch(k)%has_children) then
        call get_msq_x (tree%branch(k), k, factor, .true.)
     else
        factor = 1
     end if
   contains
     recursive subroutine get_msq_x (b, k, factor, initial)
       type(phs_branch_t), intent(in) :: b
       integer(TC), intent(in) :: k
       real(default), intent(out) :: factor
       logical, intent(in) :: initial
       real(default) :: msq, m, m_min, m_max, msq1, msq2, lda, rlda
       integer(TC) :: k1, k2
       real(default) :: f1, f2
       k1 = b%daughter(1);  k2 = b%daughter(2)
       if (tree%branch(k1)%has_children) then
          call get_msq_x (tree%branch(k1), k1, f1, .false.)
       else
          f1 = 1
       end if
       if (tree%branch(k2)%has_children) then
          call get_msq_x (tree%branch(k2), k2, f2, .false.)
       else
          f2 = 1
       end if
       m_min = tree%mass_sum(k)
       m_max = sqrts - m_tot + m_min
       msq = phs_prt_get_msq (prt(k));  m = sqrt (msq)
       if (initial) then
          factor = f1 * f2
       else
          call mapping_compute_x_from_msq &
               (tree%mapping(k), sqrts**2, m_min**2, m_max**2, msq, factor, &
                x(ix));  ix = ix + 1
          factor = f1 * f2 * factor
       end if
       msq1 = phs_prt_get_msq (prt(k1))
       msq2 = phs_prt_get_msq (prt(k2))
       lda = lambda (msq, msq1, msq2)
       if (lda > 0) then
          rlda = sqrt (lda)
          decay_p(k1) = rlda / (2 * m)
          decay_p(k2) = - decay_p(k1)
          factor = rlda / msq * factor
       else
          decay_p(k1) = 0
          decay_p(k2) = 0
          factor = 0
       end if
     end subroutine get_msq_x
 
   end subroutine phs_tree_get_msq
 
 @ %def phs_tree_get_msq
 @ This subroutine is the most time-critical part of the whole
 program.  Therefore, we do not exactly parallel the angle generation
 routine above but make sure that things get evaluated only if they are
 really needed, at the expense of readability.  Particularly important
 is to have as few multiplications of Lorentz transformations as
 possible.
 <<PHS trees: procedures>>=
   subroutine phs_tree_get_angles (tree, prt, factor, decay_p, sqrts, x)
     type(phs_tree_t), intent(inout) :: tree
     type(phs_prt_t), dimension(:), intent(in) :: prt
     real(default), intent(inout) :: factor
     real(default), dimension(:), intent(in) :: decay_p
     real(default), intent(in) :: sqrts
     real(default), dimension(:), intent(out) :: x
     integer :: ix
     integer(TC) :: k
     ix = 1
     k  = tree%mask_out
     if (tree%branch(k)%has_children) then
        call get_angles_x (tree%branch(k), k)
     end if
   contains
     recursive subroutine get_angles_x (b, k, ct0, st0, phi0, L0)
       type(phs_branch_t), intent(in) :: b
       integer(TC), intent(in) :: k
       real(default), intent(in), optional :: ct0, st0, phi0
       type(lorentz_transformation_t), intent(in), optional :: L0
       real(default) :: cp0, sp0, m, msq, ct, st, phi, bg, f
       type(lorentz_transformation_t) :: L, LL
       type(vector4_t) :: p1, pf
       type(vector3_t) :: n, axis
       integer(TC) :: k1, k2, kf
       logical :: has_friend, need_L
       k1 = b%daughter(1)
       k2 = b%daughter(2)
       kf = b%friend
       has_friend = b%has_friend
       if (present(L0)) then
          p1 = L0 * phs_prt_get_momentum (prt(k1))
          if (has_friend)  pf = L0 * phs_prt_get_momentum (prt(kf))
       else
          p1 = phs_prt_get_momentum (prt(k1))
          if (has_friend)  pf = phs_prt_get_momentum (prt(kf))
       end if
       if (present(phi0)) then
          cp0 = cos (phi0)
          sp0 = sin (phi0)
       end if
       msq = phs_prt_get_msq (prt(k));  m = sqrt (msq)
       if (m > 0) then
          bg = decay_p(k) / m
       else
          bg = 0
       end if
       if (has_friend) then
          if (present (phi0)) then
             axis = axis_from_p_r3_r2_b3 (pf, cp0, -sp0, ct0, -st0, -bg)
             LL = rotation_to_2nd (axis, vector3_canonical (3)) &
                  * LT_compose_r3_r2_b3 (cp0, -sp0, ct0, -st0, -bg)
          else
             axis = axis_from_p_b3 (pf, -bg)
             LL = rotation_to_2nd (axis, vector3_canonical(3))
             if (.not. vanishes (bg))  LL = LL * boost(-bg, 3)
          end if
          n = space_part (LL * p1)
       else if (present (phi0)) then
          n = axis_from_p_r3_r2_b3 (p1, cp0, -sp0, ct0, -st0, -bg)
       else
          n = axis_from_p_b3 (p1, -bg)
       end if
       phi = azimuthal_angle (n)
       x(ix) = phi / twopi;  ix = ix + 1
       ct = polar_angle_ct (n)
       st = sqrt (1 - ct**2)
       call mapping_compute_x_from_ct (tree%mapping(k), sqrts**2, ct, f, &
            x(ix));  ix = ix + 1
       factor = factor * f
       if (tree%branch(k1)%has_children .or. tree%branch(k2)%has_children) then
          need_L = .true.
          if (has_friend) then
             if (present (L0)) then
                L = LL * L0
             else
                L = LL
             end if
          else if (present (L0)) then
             L = LT_compose_r3_r2_b3 (cp0, -sp0, ct0, -st0, -bg) * L0
          else if (present (phi0)) then
             L = LT_compose_r3_r2_b3 (cp0, -sp0, ct0, -st0, -bg)
          else if (bg /= 0) then
             L = boost(-bg, 3)
          else
             need_L = .false.
          end if
          if (need_L) then
             if (tree%branch(k1)%has_children) &
                  call get_angles_x (tree%branch(k1), k1, ct, st, phi, L)
             if (tree%branch(k2)%has_children) &
                  call get_angles_x (tree%branch(k2), k2, ct, st, phi, L)
          else
             if (tree%branch(k1)%has_children) &
                  call get_angles_x (tree%branch(k1), k1, ct, st, phi)
             if (tree%branch(k2)%has_children) &
                  call get_angles_x (tree%branch(k2), k2, ct, st, phi)
          end if
       end if
     end subroutine get_angles_x
   end subroutine phs_tree_get_angles
 
 @ %def phs_tree_get_angles
 @
 \subsubsection{Auxiliary stuff}
 This calculates all momenta that are not yet known by summing up
 daughter particle momenta.  The external particles must be known.
 Only composite particles not yet known are calculated.
 <<PHS trees: public>>=
   public :: phs_tree_combine_particles
 <<PHS trees: procedures>>=
   subroutine phs_tree_combine_particles (tree, prt)
     type(phs_tree_t), intent(in) :: tree
     type(phs_prt_t), dimension(:), intent(inout) :: prt
     call combine_particles_x (tree%mask_out)
   contains
     recursive subroutine combine_particles_x (k)
       integer(TC), intent(in) :: k
       integer :: k1, k2
       if (tree%branch(k)%has_children) then
          k1 = tree%branch(k)%daughter(1);  k2 = tree%branch(k)%daughter(2)
          call combine_particles_x (k1)
          call combine_particles_x (k2)
          if (.not. prt(k)%defined) then
             call phs_prt_combine (prt(k), prt(k1), prt(k2))
          end if
       end if
     end subroutine combine_particles_x
   end subroutine phs_tree_combine_particles
 
 @ %def phs_tree_combine_particles
 @ The previous routine is to be evaluated at runtime.  Instead of
 scanning trees, we can as well set up a multiplication table.  This is
 generated here.  Note that the table is [[intent(out)]].
 <<PHS trees: public>>=
   public :: phs_tree_setup_prt_combinations
 <<PHS trees: procedures>>=
   subroutine phs_tree_setup_prt_combinations (tree, comb)
     type(phs_tree_t), intent(in) :: tree
     integer, dimension(:,:), intent(out) :: comb
     comb = 0
     call setup_prt_combinations_x (tree%mask_out)
   contains
     recursive subroutine setup_prt_combinations_x (k)
       integer(TC), intent(in) :: k
       integer, dimension(2) :: kk
       if (tree%branch(k)%has_children) then
          kk = tree%branch(k)%daughter
          call setup_prt_combinations_x (kk(1))
          call setup_prt_combinations_x (kk(2))
          comb(:,k) = kk
       end if
     end subroutine setup_prt_combinations_x
   end subroutine phs_tree_setup_prt_combinations
 
 @ %def phs_tree_setup_prt_combinations
 @
 <<PHS trees: public>>=
   public :: phs_tree_reshuffle_mappings
 <<PHS trees: procedures>>=
   subroutine phs_tree_reshuffle_mappings (tree)
    type(phs_tree_t), intent(inout) :: tree
    integer(TC) :: k0, k_old, k_new, k2
    integer :: i
    type(mapping_t) :: mapping_tmp
    real(default) :: mass_tmp
    do i = 1, size (tree%momentum_link)
      if (i /= tree%momentum_link (i)) then
        k_old = 2**(i-tree%n_in-1)
        k_new = 2**(tree%momentum_link(i)-tree%n_in-1)
        k0 = tree%branch(k_old)%mother
        k2 = k_new + tree%branch(k_old)%sibling
        mapping_tmp = tree%mapping(k0)
        mass_tmp = tree%mass_sum(k0)
        tree%mapping(k0) = tree%mapping(k2)
        tree%mapping(k2) = mapping_tmp
        tree%mass_sum(k0) = tree%mass_sum(k2)
        tree%mass_sum(k2) = mass_tmp
      end if
    end do
   end subroutine phs_tree_reshuffle_mappings
 
 @ %def phs_tree_reshuffle_mappings
 @
 <<PHS trees: public>>=
   public :: phs_tree_set_momentum_links
 <<PHS trees: procedures>>=
   subroutine phs_tree_set_momentum_links (tree, list)
     type(phs_tree_t), intent(inout) :: tree
     integer, dimension(:), allocatable :: list
     tree%momentum_link = list
   end subroutine phs_tree_set_momentum_links
 
 @ %def phs_tree_set_momentum_links
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[phs_trees_ut.f90]]>>=
 <<File header>>
 
 module phs_trees_ut
   use unit_tests
   use phs_trees_uti
 
 <<Standard module head>>
 
 <<PHS trees: public test>>
 
 contains
 
 <<PHS trees: test driver>>
 
 end module phs_trees_ut
 @ %def phs_trees_ut
 @
 <<[[phs_trees_uti.f90]]>>=
 <<File header>>
 
 module phs_trees_uti
 
 !!!<<Use kinds>>
   use kinds, only: TC
 <<Use strings>>
   use flavors, only: flavor_t
   use model_data, only: model_data_t
 
   use resonances, only: resonance_history_t
   use mappings, only: mapping_defaults_t
 
   use phs_trees
 
 <<Standard module head>>
 
 <<PHS trees: test declarations>>
 
 contains
 
 <<PHS trees: tests>>
 
 end module phs_trees_uti
 @ %def phs_trees_ut
 @ API: driver for the unit tests below.
 <<PHS trees: public test>>=
   public :: phs_trees_test
 <<PHS trees: test driver>>=
   subroutine phs_trees_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<PHS trees: execute tests>>
   end subroutine phs_trees_test
 
 @  %def phs_trees_test
 @
 Create a simple $2\to 3$ PHS tree and display it.
 <<PHS trees: execute tests>>=
   call test (phs_tree_1, "phs_tree_1", &
        "check phs tree setup", &
        u, results)
 <<PHS trees: test declarations>>=
   public :: phs_tree_1
 <<PHS trees: tests>>=
   subroutine phs_tree_1 (u)
     integer, intent(in) :: u
     type(phs_tree_t) :: tree
     type(model_data_t), target :: model
     type(flavor_t), dimension(5) :: flv
     integer :: i
 
     write (u, "(A)")  "* Test output: phs_tree_1"
     write (u, "(A)")  "*   Purpose: test PHS tree routines"
     write (u, "(A)")
 
     write (u, "(A)")  "* Read model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Set up flavors"
     write (u, "(A)")
 
     call flv%init ([1, -2, 24, 5, -5], model)
     do i = 1, 5
        write (u, "(1x)", advance="no")
        call flv(i)%write (u)
     end do
     write (u, *)
 
     write (u, "(A)")
     write (u, "(A)")  "* Create tree"
     write (u, "(A)")
 
     call tree%init (2, 3, 0, 0)
     call tree%from_array ([integer(TC) :: 1, 2, 3, 4, 7, 8, 16])
     call tree%set_mass_sum (flv)
     call tree%set_effective_masses ()
 
     call tree%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call tree%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_tree_1"
 
   end subroutine phs_tree_1
 
 @ %def phs_tree_1
 @ The analogous tree with resonance (s-channel) mappings.
 <<PHS trees: execute tests>>=
   call test (phs_tree_2, "phs_tree_2", &
        "check phs tree with resonances", &
        u, results)
 <<PHS trees: test declarations>>=
   public :: phs_tree_2
 <<PHS trees: tests>>=
   subroutine phs_tree_2 (u)
     integer, intent(in) :: u
     type(phs_tree_t) :: tree
     type(model_data_t), target :: model
     type(mapping_defaults_t) :: mapping_defaults
     type(flavor_t), dimension(5) :: flv
     type(resonance_history_t) :: res_history
     integer :: i
 
     write (u, "(A)")  "* Test output: phs_tree_2"
     write (u, "(A)")  "*   Purpose: test PHS tree with resonances"
     write (u, "(A)")
 
     write (u, "(A)")  "* Read model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Set up flavors"
     write (u, "(A)")
 
     call flv%init ([1, -2, 24, 5, -5], model)
     do i = 1, 5
        write (u, "(1x)", advance="no")
        call flv(i)%write (u)
     end do
     write (u, *)
 
     write (u, "(A)")
     write (u, "(A)")  "* Create tree with mappings"
     write (u, "(A)")
 
     call tree%init (2, 3, 0, 0)
     call tree%from_array ([integer(TC) :: 1, 2, 3, 4, 7, 8, 16])
     call tree%set_mass_sum (flv)
 
     call tree%init_mapping (3_TC, var_str ("s_channel"), -24, model)
     call tree%init_mapping (7_TC, var_str ("s_channel"), 23, model)
 
     call tree%set_mapping_parameters (mapping_defaults, variable_limits=.false.)
     call tree%set_effective_masses ()
 
     call tree%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract resonances from mappings"
     write (u, "(A)")
 
     call tree%extract_resonance_history (res_history)
     call res_history%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call tree%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_tree_2"
 
   end subroutine phs_tree_2
 
 @ %def phs_tree_2
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{The phase-space forest}
 Simply stated, a phase-space forest is a collection of phase-space
 trees.  More precisely, a [[phs_forest]] object contains all
 parameterizations of phase space that \whizard\ will use for a single
 hard process, prepared in the form of [[phs_tree]] objects.  This is
 suitable for evaluation by the \vamp\ integration package:  each
 parameterization (tree) is a valid channel in the multi-channel
 adaptive integration, and each variable in a tree corresponds to an
 integration dimension, defined by an appropriate mapping of the
 $(0,1)$ interval to the allowed range of the integration variable.
 
 The trees are grouped in groves.  The trees (integration channels)
 within a grove share a common weight, assuming that they are related
 by some approximate symmetry.
 
 Trees/channels that are related by an exact symmetry are connected by
 an array of equivalences; each equivalence object holds the data that
 relate one channel to another.
 
 The phase-space setup, i.e., the detailed structure of trees and
 forest, are read from a file.  Therefore, this module also contains
 the syntax definition and the parser needed for interpreting this
 file.
 <<[[phs_forests.f90]]>>=
 <<File header>>
 
 module phs_forests
 
 <<Use kinds>>
   use kinds, only: TC
 <<Use strings>>
   use io_units
   use format_defs, only: FMT_19
   use diagnostics
   use lorentz
   use numeric_utils
   use permutations
   use ifiles
   use syntax_rules
   use lexers
   use parser
   use model_data
   use model_data
   use flavors
   use interactions
 
   use phs_base
   use resonances, only: resonance_history_t
   use resonances, only: resonance_history_set_t
   use mappings
   use phs_trees
 
 <<Standard module head>>
 
 <<PHS forests: public>>
 
 <<PHS forests: types>>
 
 <<PHS forests: interfaces>>
 
 <<PHS forests: variables>>
 
 contains
 
 <<PHS forests: procedures>>
 
 end module phs_forests
 @ %def phs_forests
 @
 \subsection{Phase-space setup parameters}
 This transparent container holds the parameters that the algorithm
 needs for phase-space setup, with reasonable defaults.
 
 The threshold mass (for considering a particle as effectively
 massless) is specified separately for s- and t-channel. The default is
 to treat $W$ and $Z$ bosons as massive in the s-channel, but as
 massless in the t-channel.  The $b$-quark is treated always massless,
 the $t$-quark always massive.
 <<PHS forests: public>>=
   public :: phs_parameters_t
 <<PHS forests: types>>=
   type :: phs_parameters_t
      real(default) :: sqrts = 0
      real(default) :: m_threshold_s = 50._default
      real(default) :: m_threshold_t = 100._default
      integer :: off_shell = 1
      integer :: t_channel = 2
      logical :: keep_nonresonant = .true.
   end type phs_parameters_t
 
 @ %def phs_parameters_t
 @ Write phase-space parameters to file.
 <<PHS forests: public>>=
   public :: phs_parameters_write
 <<PHS forests: procedures>>=
   subroutine phs_parameters_write (phs_par, unit)
     type(phs_parameters_t), intent(in) :: phs_par
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     write (u, "(3x,A," // FMT_19 // ")") "sqrts         = ", phs_par%sqrts
     write (u, "(3x,A," // FMT_19 // ")") "m_threshold_s = ", phs_par%m_threshold_s
     write (u, "(3x,A," // FMT_19 // ")") "m_threshold_t = ", phs_par%m_threshold_t
     write (u, "(3x,A,I0)") "off_shell = ", phs_par%off_shell
     write (u, "(3x,A,I0)") "t_channel = ", phs_par%t_channel
     write (u, "(3x,A,L1)") "keep_nonresonant = ", phs_par%keep_nonresonant
   end subroutine phs_parameters_write
 
 @ %def phs_parameters_write
 @ Read phase-space parameters from file.
 <<PHS forests: public>>=
   public :: phs_parameters_read
 <<PHS forests: procedures>>=
   subroutine phs_parameters_read (phs_par, unit)
     type(phs_parameters_t), intent(out) :: phs_par
     integer, intent(in) :: unit
     character(20) :: dummy
     character :: equals
     read (unit, *)  dummy, equals, phs_par%sqrts
     read (unit, *)  dummy, equals, phs_par%m_threshold_s
     read (unit, *)  dummy, equals, phs_par%m_threshold_t
     read (unit, *)  dummy, equals, phs_par%off_shell
     read (unit, *)  dummy, equals, phs_par%t_channel
     read (unit, *)  dummy, equals, phs_par%keep_nonresonant
   end subroutine phs_parameters_read
 
 @ %def phs_parameters_write
 @ Comparison.
 <<PHS forests: interfaces>>=
   interface operator(==)
      module procedure phs_parameters_eq
   end interface
   interface operator(/=)
      module procedure phs_parameters_ne
   end interface
 <<PHS forests: procedures>>=
   function phs_parameters_eq (phs_par1, phs_par2) result (equal)
     logical :: equal
     type(phs_parameters_t), intent(in) :: phs_par1, phs_par2
     equal = phs_par1%sqrts == phs_par2%sqrts &
          .and. phs_par1%m_threshold_s == phs_par2%m_threshold_s &
          .and. phs_par1%m_threshold_t == phs_par2%m_threshold_t &
          .and. phs_par1%off_shell == phs_par2%off_shell &
          .and. phs_par1%t_channel == phs_par2%t_channel &
          .and.(phs_par1%keep_nonresonant .eqv. phs_par2%keep_nonresonant)
   end function phs_parameters_eq
 
   function phs_parameters_ne (phs_par1, phs_par2) result (ne)
     logical :: ne
     type(phs_parameters_t), intent(in) :: phs_par1, phs_par2
     ne = phs_par1%sqrts /= phs_par2%sqrts &
          .or. phs_par1%m_threshold_s /= phs_par2%m_threshold_s &
          .or. phs_par1%m_threshold_t /= phs_par2%m_threshold_t &
          .or. phs_par1%off_shell /= phs_par2%off_shell &
          .or. phs_par1%t_channel /= phs_par2%t_channel &
          .or.(phs_par1%keep_nonresonant .neqv. phs_par2%keep_nonresonant)
   end function phs_parameters_ne
 
 @ %def phs_parameters_eq phs_parameters_ne
 @
 \subsection{Equivalences}
 This type holds information about equivalences between phase-space
 trees.  We make a linked list, where each node contains the two
 trees which are equivalent and the corresponding permutation of
 external particles.  Two more arrays are to be filled: The permutation
 of mass variables and the permutation of angular variables, where the
 signature indicates a necessary exchange of daughter branches.
 <<PHS forests: types>>=
   type :: equivalence_t
      private
      integer :: left, right
      type(permutation_t) :: perm
      type(permutation_t) :: msq_perm, angle_perm
      logical, dimension(:), allocatable :: angle_sig
      type(equivalence_t), pointer :: next => null ()
   end type equivalence_t
 
 @ %def equivalence_t
 <<PHS forests: types>>=
   type :: equivalence_list_t
      private
      integer :: length = 0
      type(equivalence_t), pointer :: first => null ()
      type(equivalence_t), pointer :: last => null ()
   end type equivalence_list_t
 
 @ %def equivalence_list_t
 @ Append an equivalence to the list
 <<PHS forests: procedures>>=
   subroutine equivalence_list_add (eql, left, right, perm)
     type(equivalence_list_t), intent(inout) :: eql
     integer, intent(in) :: left, right
     type(permutation_t), intent(in) :: perm
     type(equivalence_t), pointer :: eq
     allocate (eq)
     eq%left = left
     eq%right = right
     eq%perm = perm
     if (associated (eql%last)) then
        eql%last%next => eq
     else
        eql%first => eq
     end if
     eql%last => eq
     eql%length = eql%length + 1
   end subroutine equivalence_list_add
 
 @ %def equivalence_list_add
 @ Delete the list contents.  Has to be pure because it is called from
 an elemental subroutine.
 <<PHS forests: procedures>>=
   pure subroutine equivalence_list_final (eql)
     type(equivalence_list_t), intent(inout) :: eql
     type(equivalence_t), pointer :: eq
     do while (associated (eql%first))
        eq => eql%first
        eql%first => eql%first%next
        deallocate (eq)
     end do
     eql%last => null ()
     eql%length = 0
   end subroutine equivalence_list_final
 
 @ %def equivalence_list_final
 @ Make a deep copy of the equivalence list.  This allows for deep
 copies of groves and forests.
 <<PHS forests: interfaces>>=
   interface assignment(=)
      module procedure equivalence_list_assign
   end interface
 
 <<PHS forests: procedures>>=
   subroutine equivalence_list_assign (eql_out, eql_in)
     type(equivalence_list_t), intent(out) :: eql_out
     type(equivalence_list_t), intent(in) :: eql_in
     type(equivalence_t), pointer :: eq, eq_copy
     eq => eql_in%first
     do while (associated (eq))
        allocate (eq_copy)
        eq_copy = eq
        eq_copy%next => null ()
        if (associated (eql_out%first)) then
           eql_out%last%next => eq_copy
        else
           eql_out%first => eq_copy
        end if
        eql_out%last => eq_copy
        eq => eq%next
     end do
   end subroutine equivalence_list_assign
 
 @ %def equivalence_list_assign
 @ The number of list entries
 <<PHS forests: procedures>>=
   elemental function equivalence_list_length (eql) result (length)
     integer :: length
     type(equivalence_list_t), intent(in) :: eql
     length = eql%length
   end function equivalence_list_length
 
 @ %def equivalence_list_length
 @ Recursively write the equivalences list
 <<PHS forests: procedures>>=
   subroutine equivalence_list_write (eql, unit)
     type(equivalence_list_t), intent(in) :: eql
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit);  if (u < 0)  return
     if (associated (eql%first)) then
        call equivalence_write_rec (eql%first, u)
     else
        write (u, *) " [empty]"
     end if
   contains
     recursive subroutine equivalence_write_rec (eq, u)
       type(equivalence_t), intent(in) :: eq
       integer, intent(in) :: u
       integer :: i
       write (u, "(3x,A,1x,I0,1x,I0,2x,A)", advance="no") &
            "Equivalence:", eq%left, eq%right, "Final state permutation:"
       call permutation_write (eq%perm, u)
       write (u, "(1x,12x,1x,A,1x)", advance="no") &
            "       msq permutation:  "
       call permutation_write (eq%msq_perm, u)
       write (u, "(1x,12x,1x,A,1x)", advance="no") &
            "       angle permutation:"
       call permutation_write (eq%angle_perm, u)
       write (u, "(1x,12x,1x,26x)", advance="no")
       do i = 1, size (eq%angle_sig)
          if (eq%angle_sig(i)) then
             write (u, "(1x,A)", advance="no") "+"
          else
             write (u, "(1x,A)", advance="no") "-"
          end if
       end do
       write (u, *)
       if (associated (eq%next))  call equivalence_write_rec (eq%next, u)
     end subroutine equivalence_write_rec
   end subroutine equivalence_list_write
 
 @ %def equivalence_list_write
 @
 \subsection{Groves}
 A grove is a group of trees (phase-space channels) that share a common
 weight in the integration.  Within a grove, channels can be declared
 equivalent, so they also share their integration grids (up to
 symmetries).  The grove contains a list of equivalences.  The
 [[tree_count_offset]] is the total number of trees of the preceding
 groves; when the trees are counted per forest (integration channels),
 the offset has to be added to all tree indices.
 <<PHS forests: types>>=
   type :: phs_grove_t
      private
      integer :: tree_count_offset
      type(phs_tree_t), dimension(:), allocatable :: tree
      type(equivalence_list_t) :: equivalence_list
   end type phs_grove_t
 
 @ %def phs_grove_t
 @ Call [[phs_tree_init]] which is also elemental:
 <<PHS forests: procedures>>=
   elemental subroutine phs_grove_init &
        (grove, n_trees, n_in, n_out, n_masses, n_angles)
     type(phs_grove_t), intent(inout) :: grove
     integer, intent(in) :: n_trees, n_in, n_out, n_masses, n_angles
     grove%tree_count_offset = 0
     allocate (grove%tree (n_trees))
     call phs_tree_init (grove%tree, n_in, n_out, n_masses, n_angles)
   end subroutine phs_grove_init
 
 @ %def phs_grove_init
 @ The trees do not have pointer components, thus no call to
 [[phs_tree_final]]:
 <<PHS forests: procedures>>=
   elemental subroutine phs_grove_final (grove)
     type(phs_grove_t), intent(inout) :: grove
     deallocate (grove%tree)
     call equivalence_list_final (grove%equivalence_list)
   end subroutine phs_grove_final
 
 @ %def phs_grove_final
 @ Deep copy.
 <<PHS forests: interfaces>>=
   interface assignment(=)
      module procedure phs_grove_assign0
      module procedure phs_grove_assign1
   end interface
 
 <<PHS forests: procedures>>=
   subroutine phs_grove_assign0 (grove_out, grove_in)
     type(phs_grove_t), intent(out) :: grove_out
     type(phs_grove_t), intent(in) :: grove_in
     grove_out%tree_count_offset = grove_in%tree_count_offset
     if (allocated (grove_in%tree)) then
        allocate (grove_out%tree (size (grove_in%tree)))
        grove_out%tree = grove_in%tree
     end if
     grove_out%equivalence_list = grove_in%equivalence_list
   end subroutine phs_grove_assign0
 
   subroutine phs_grove_assign1 (grove_out, grove_in)
     type(phs_grove_t), dimension(:), intent(out) :: grove_out
     type(phs_grove_t), dimension(:), intent(in) :: grove_in
     integer :: i
     do i = 1, size (grove_in)
        call phs_grove_assign0 (grove_out(i), grove_in(i))
     end do
   end subroutine phs_grove_assign1
 
 @ %def phs_grove_assign
 @ Get the global (s-channel) mappings.  Implemented as a subroutine
 which returns an array (slice).
 <<PHS forests: procedures>>=
   subroutine phs_grove_assign_s_mappings (grove, mapping)
     type(phs_grove_t), intent(in) :: grove
     type(mapping_t), dimension(:), intent(out) :: mapping
     integer :: i
     if (size (mapping) == size (grove%tree)) then
        do i = 1, size (mapping)
           call phs_tree_assign_s_mapping (grove%tree(i), mapping(i))
        end do
     else
        call msg_bug ("phs_grove_assign_s_mappings: array size mismatch")
     end if
   end subroutine phs_grove_assign_s_mappings
 
 @ %def phs_grove_assign_s_mappings
 @
 \subsection{The forest type}
 This is a collection of trees and associated particles.  In a given
 tree, each branch code corresponds to a particle in the [[prt]] array.
 Furthermore, we have an array of mass sums which is independent of the
 decay tree and of the particular event.  The mappings directly
 correspond to the decay trees, and the decay groves collect the trees
 in classes.  The permutation list consists of all permutations of
 outgoing particles that map the decay forest onto itself.
 
 The particle codes [[flv]] (one for each external particle) are needed
 for determining masses and such.  The trees and associated information
 are collected in the [[grove]] array, together with a lookup table
 that associates tree indices to groves.  Finally, the [[prt]] array
 serves as workspace for phase-space evaluation.
 
 The [[prt_combination]] is a list of index pairs, namely the particle
 momenta pairs that need to be combined in order to provide all
 momentum combinations that the phase-space trees need to know.
 <<PHS forests: public>>=
   public :: phs_forest_t
 <<PHS forests: types>>=
   type :: phs_forest_t
      private
      integer :: n_in, n_out, n_tot
      integer :: n_masses, n_angles, n_dimensions
      integer :: n_trees, n_equivalences
      type(flavor_t), dimension(:), allocatable :: flv
      type(phs_grove_t), dimension(:), allocatable :: grove
      integer, dimension(:), allocatable :: grove_lookup
      type(phs_prt_t), dimension(:), allocatable :: prt_in
      type(phs_prt_t), dimension(:), allocatable :: prt_out
      type(phs_prt_t), dimension(:), allocatable :: prt
      integer(TC), dimension(:,:), allocatable :: prt_combination
      type(mapping_t), dimension(:), allocatable :: s_mapping
    contains
    <<PHS forests: phs forest: TBP>>
   end type phs_forest_t
 
 @ %def phs_forest_t
 @
 The initialization merely allocates memory.  We have to know how many
 trees there are in each grove, so we can initialize everything.  The
 number of groves is the size of the [[n_tree]] array.
 
 In the [[grove_lookup]] table we store the grove index that belongs to
 each absolute tree index.  The difference between the absolute index
 and the relative (to the grove) index is stored, for each grove, as
 [[tree_count_offset]].
 
 The particle array is allocated according to the total number of
 branches each tree has, but not filled.
 <<PHS forests: public>>=
   public :: phs_forest_init
 <<PHS forests: procedures>>=
   subroutine phs_forest_init (forest, n_tree, n_in, n_out)
     type(phs_forest_t), intent(inout) :: forest
     integer, dimension(:), intent(in) :: n_tree
     integer, intent(in) :: n_in, n_out
     integer :: g, count, k_root
     forest%n_in = n_in
     forest%n_out = n_out
     forest%n_tot = n_in + n_out
     forest%n_masses = max (n_out - 2, 0)
     forest%n_angles = max (2*n_out - 2, 0)
     forest%n_dimensions = forest%n_masses + forest%n_angles
     forest%n_trees = sum (n_tree)
     forest%n_equivalences = 0
     allocate (forest%grove (size (n_tree)))
     call phs_grove_init &
          (forest%grove, n_tree, n_in, n_out, forest%n_masses, &
           forest%n_angles)
     allocate (forest%grove_lookup (forest%n_trees))
     count = 0
     do g = 1, size (forest%grove)
        forest%grove(g)%tree_count_offset = count
        forest%grove_lookup (count+1:count+n_tree(g)) = g
        count = count + n_tree(g)
     end do
     allocate (forest%prt_in  (n_in))
     allocate (forest%prt_out (forest%n_out))
     k_root = 2**forest%n_tot - 1
     allocate (forest%prt (k_root))
     allocate (forest%prt_combination (2, k_root))
     allocate (forest%s_mapping (forest%n_trees))
   end subroutine phs_forest_init
 
 @ %def phs_forest_init
 @ Assign the global (s-channel) mappings.
 <<PHS forests: public>>=
   public :: phs_forest_set_s_mappings
 <<PHS forests: procedures>>=
   subroutine phs_forest_set_s_mappings (forest)
     type(phs_forest_t), intent(inout) :: forest
     integer :: g, i0, i1, n
     do g = 1, size (forest%grove)
        call phs_forest_get_grove_bounds (forest, g, i0, i1, n)
        call phs_grove_assign_s_mappings &
             (forest%grove(g), forest%s_mapping(i0:i1))
     end do
   end subroutine phs_forest_set_s_mappings
 
 @ %def phs_forest_set_s_mappings
 @ The grove finalizer is called because it contains the equivalence list:
 <<PHS forests: public>>=
   public :: phs_forest_final
 <<PHS forests: procedures>>=
   subroutine phs_forest_final (forest)
     type(phs_forest_t), intent(inout) :: forest
     if (allocated (forest%grove)) then
        call phs_grove_final (forest%grove)
        deallocate (forest%grove)
     end if
     if (allocated (forest%grove_lookup))  deallocate (forest%grove_lookup)
     if (allocated (forest%prt))  deallocate (forest%prt)
     if (allocated (forest%s_mapping))  deallocate (forest%s_mapping)
   end subroutine phs_forest_final
 
 @ %def phs_forest_final
 @
 \subsection{Screen output}
 Write the particles that are non-null, then the trees which point to
 them:
 <<PHS forests: public>>=
   public :: phs_forest_write
 <<PHS forests: phs forest: TBP>>=
   procedure :: write => phs_forest_write
 <<PHS forests: procedures>>=
   subroutine phs_forest_write (forest, unit)
     class(phs_forest_t), intent(in) :: forest
     integer, intent(in), optional :: unit
     integer :: u
     integer :: i, g, k
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)") "Phase space forest:"
     write (u, "(3x,A,I0)") "n_in  = ", forest%n_in
     write (u, "(3x,A,I0)") "n_out = ", forest%n_out
     write (u, "(3x,A,I0)") "n_tot = ", forest%n_tot
     write (u, "(3x,A,I0)") "n_masses = ", forest%n_masses
     write (u, "(3x,A,I0)") "n_angles = ", forest%n_angles
     write (u, "(3x,A,I0)") "n_dim    = ", forest%n_dimensions
     write (u, "(3x,A,I0)") "n_trees  = ", forest%n_trees
     write (u, "(3x,A,I0)") "n_equiv  = ", forest%n_equivalences
     write (u, "(3x,A)", advance="no") "flavors  ="
     if (allocated (forest%flv)) then
        do i = 1, size (forest%flv)
           write (u, "(1x,I0)", advance="no")  forest%flv(i)%get_pdg ()
        end do
        write (u, "(A)")
     else
        write (u, "(1x,A)") "[empty]"
     end if
     write (u, "(1x,A)") "Particle combinations:"
     if (allocated (forest%prt_combination)) then
        do k = 1, size (forest%prt_combination, 2)
           if (forest%prt_combination(1, k) /= 0) then
              write (u, "(3x,I0,1x,'<=',1x,I0,1x,'+',1x,I0)") &
                   k, forest%prt_combination(:,k)
           end if
        end do
     else
        write (u, "(3x,A)") "  [empty]"
     end if
     write (u, "(1x,A)") "Groves and trees:"
     if (allocated (forest%grove)) then
        do g = 1, size (forest%grove)
           write (u, "(3x,A,1x,I0)") "Grove    ", g
           call phs_grove_write (forest%grove(g), unit)
        end do
     else
        write (u, "(3x,A)") "  [empty]"
     end if
     write (u, "(1x,A,I0)") "Total number of equivalences: ", &
          forest%n_equivalences
     write (u, "(A)")
     write (u, "(1x,A)") "Global s-channel mappings:"
     if (allocated (forest%s_mapping)) then
        do i = 1, size (forest%s_mapping)
           associate (mapping => forest%s_mapping(i))
             if (mapping_is_s_channel (mapping) &
                  .or. mapping_is_on_shell (mapping)) then
                write (u, "(1x,I0,':',1x)", advance="no")  i
                call mapping_write (forest%s_mapping(i), unit)
             end if
           end associate
        end do
     else
        write (u, "(3x,A)") "  [empty]"
     end if
     write (u, "(A)")
     write (u, "(1x,A)") "Incoming particles:"
     if (allocated (forest%prt_in)) then
        if (any (phs_prt_is_defined (forest%prt_in))) then
           do i = 1, size (forest%prt_in)
              if (phs_prt_is_defined (forest%prt_in(i))) then
                 write (u, "(1x,A,1x,I0)")  "Particle", i
                 call phs_prt_write (forest%prt_in(i), u)
              end if
           end do
        else
           write (u, "(3x,A)")  "[all undefined]"
        end if
     else
        write (u, "(3x,A)")  "  [empty]"
     end if
     write (u, "(A)")
     write (u, "(1x,A)") "Outgoing particles:"
     if (allocated (forest%prt_out)) then
        if (any (phs_prt_is_defined (forest%prt_out))) then
           do i = 1, size (forest%prt_out)
              if (phs_prt_is_defined (forest%prt_out(i))) then
                 write (u, "(1x,A,1x,I0)")  "Particle", i
                 call phs_prt_write (forest%prt_out(i), u)
              end if
           end do
        else
           write (u, "(3x,A)")  "[all undefined]"
        end if
     else
        write (u, "(1x,A)")  "  [empty]"
     end if
     write (u, "(A)")
     write (u, "(1x,A)") "Tree particles:"
     if (allocated (forest%prt)) then
        if (any (phs_prt_is_defined (forest%prt))) then
           do i = 1, size (forest%prt)
              if (phs_prt_is_defined (forest%prt(i))) then
                 write (u, "(1x,A,1x,I0)")  "Particle", i
                 call phs_prt_write (forest%prt(i), u)
              end if
           end do
        else
           write (u, "(3x,A)")  "[all undefined]"
        end if
     else
        write (u, "(3x,A)")  "  [empty]"
     end if
   end subroutine phs_forest_write
 
   subroutine phs_grove_write (grove, unit)
     type(phs_grove_t), intent(in) :: grove
     integer, intent(in), optional :: unit
     integer :: u
     integer :: t
     u = given_output_unit (unit);  if (u < 0)  return
     do t = 1, size (grove%tree)
        write (u, "(3x,A,I0)") "Tree      ", t
        call phs_tree_write (grove%tree(t), unit)
     end do
     write (u, "(1x,A)") "Equivalence list:"
     call equivalence_list_write (grove%equivalence_list, unit)
   end subroutine phs_grove_write
 
 @ %def phs_grove_write phs_forest_write
 @ Deep copy.
 <<PHS forests: public>>=
   public :: assignment(=)
 <<PHS forests: interfaces>>=
   interface assignment(=)
      module procedure phs_forest_assign
   end interface
 
 <<PHS forests: procedures>>=
   subroutine phs_forest_assign (forest_out, forest_in)
     type(phs_forest_t), intent(out) :: forest_out
     type(phs_forest_t), intent(in) :: forest_in
     forest_out%n_in  = forest_in%n_in
     forest_out%n_out = forest_in%n_out
     forest_out%n_tot = forest_in%n_tot
     forest_out%n_masses = forest_in%n_masses
     forest_out%n_angles = forest_in%n_angles
     forest_out%n_dimensions  = forest_in%n_dimensions
     forest_out%n_trees  = forest_in%n_trees
     forest_out%n_equivalences  = forest_in%n_equivalences
     if (allocated (forest_in%flv)) then
        allocate (forest_out%flv (size (forest_in%flv)))
        forest_out%flv = forest_in%flv
     end if
     if (allocated (forest_in%grove)) then
        allocate (forest_out%grove (size (forest_in%grove)))
        forest_out%grove = forest_in%grove
     end if
     if (allocated (forest_in%grove_lookup)) then
        allocate (forest_out%grove_lookup (size (forest_in%grove_lookup)))
        forest_out%grove_lookup = forest_in%grove_lookup
     end if
     if (allocated (forest_in%prt_in)) then
        allocate (forest_out%prt_in (size (forest_in%prt_in)))
        forest_out%prt_in = forest_in%prt_in
     end if
     if (allocated (forest_in%prt_out)) then
        allocate (forest_out%prt_out (size (forest_in%prt_out)))
        forest_out%prt_out = forest_in%prt_out
     end if
     if (allocated (forest_in%prt)) then
        allocate (forest_out%prt (size (forest_in%prt)))
        forest_out%prt = forest_in%prt
     end if
     if (allocated (forest_in%s_mapping)) then
        allocate (forest_out%s_mapping (size (forest_in%s_mapping)))
        forest_out%s_mapping = forest_in%s_mapping
     end if
     if (allocated (forest_in%prt_combination)) then
        allocate (forest_out%prt_combination &
             (2, size (forest_in%prt_combination, 2)))
        forest_out%prt_combination = forest_in%prt_combination
     end if
   end subroutine phs_forest_assign
 
 @ %def phs_forest_assign
 @
 \subsection{Accessing contents}
 Get the number of integration parameters
 <<PHS forests: public>>=
   public :: phs_forest_get_n_parameters
 <<PHS forests: procedures>>=
   function phs_forest_get_n_parameters (forest) result (n)
     integer :: n
     type(phs_forest_t), intent(in) :: forest
     n = forest%n_dimensions
   end function phs_forest_get_n_parameters
 
 @ %def phs_forest_get_n_parameters
 @ Get the number of integration channels
 <<PHS forests: public>>=
   public :: phs_forest_get_n_channels
 <<PHS forests: procedures>>=
   function phs_forest_get_n_channels (forest) result (n)
     integer :: n
     type(phs_forest_t), intent(in) :: forest
     n = forest%n_trees
   end function phs_forest_get_n_channels
 
 @ %def phs_forest_get_n_channels
 @ Get the number of groves
 <<PHS forests: public>>=
   public :: phs_forest_get_n_groves
 <<PHS forests: procedures>>=
   function phs_forest_get_n_groves (forest) result (n)
     integer :: n
     type(phs_forest_t), intent(in) :: forest
     n = size (forest%grove)
   end function phs_forest_get_n_groves
 
 @ %def phs_forest_get_n_groves
 @ Get the index bounds for a specific grove.
 <<PHS forests: public>>=
   public :: phs_forest_get_grove_bounds
 <<PHS forests: procedures>>=
   subroutine phs_forest_get_grove_bounds (forest, g, i0, i1, n)
     type(phs_forest_t), intent(in) :: forest
     integer, intent(in) :: g
     integer, intent(out) :: i0, i1, n
     n = size (forest%grove(g)%tree)
     i0 = forest%grove(g)%tree_count_offset + 1
     i1 = forest%grove(g)%tree_count_offset + n
   end subroutine phs_forest_get_grove_bounds
 
 @ %def phs_forest_get_grove_bounds
 @ Get the number of equivalences
 <<PHS forests: public>>=
   public :: phs_forest_get_n_equivalences
 <<PHS forests: procedures>>=
   function phs_forest_get_n_equivalences (forest) result (n)
     integer :: n
     type(phs_forest_t), intent(in) :: forest
     n = forest%n_equivalences
   end function phs_forest_get_n_equivalences
 
 @ %def phs_forest_get_n_equivalences
 @ Return true if a particular channel has a global (s-channel)
 mapping; also return the resonance mass and width for this mapping.
 <<PHS forests: public>>=
   public :: phs_forest_get_s_mapping
   public :: phs_forest_get_on_shell
 <<PHS forests: procedures>>=
   subroutine phs_forest_get_s_mapping (forest, channel, flag, mass, width)
     type(phs_forest_t), intent(in) :: forest
     integer, intent(in) :: channel
     logical, intent(out) :: flag
     real(default), intent(out) :: mass, width
     flag = mapping_is_s_channel (forest%s_mapping(channel))
     if (flag) then
        mass = mapping_get_mass (forest%s_mapping(channel))
        width = mapping_get_width (forest%s_mapping(channel))
     else
        mass = 0
        width = 0
     end if
   end subroutine phs_forest_get_s_mapping
 
   subroutine phs_forest_get_on_shell (forest, channel, flag, mass)
     type(phs_forest_t), intent(in) :: forest
     integer, intent(in) :: channel
     logical, intent(out) :: flag
     real(default), intent(out) :: mass
     flag = mapping_is_on_shell (forest%s_mapping(channel))
     if (flag) then
        mass = mapping_get_mass (forest%s_mapping(channel))
     else
        mass = 0
     end if
   end subroutine phs_forest_get_on_shell
 
 @ %def phs_forest_get_s_mapping
 @ %def phs_forest_get_on_shell
 @
 Extract the set of unique resonance histories, in form of an array.
 <<PHS forests: phs forest: TBP>>=
   procedure :: extract_resonance_history_set &
        => phs_forest_extract_resonance_history_set
 <<PHS forests: procedures>>=
   subroutine phs_forest_extract_resonance_history_set &
        (forest, res_set, include_trivial)
     class(phs_forest_t), intent(in) :: forest
     type(resonance_history_set_t), intent(out) :: res_set
     logical, intent(in), optional :: include_trivial
     type(resonance_history_t) :: rh
     integer :: g, t
     logical :: triv
     triv = .false.;  if (present (include_trivial))  triv = include_trivial
     call res_set%init ()
     do g = 1, size (forest%grove)
        associate (grove => forest%grove(g))
           do t = 1, size (grove%tree)
              call grove%tree(t)%extract_resonance_history (rh)
              call res_set%enter (rh, include_trivial)
           end do
        end associate
     end do
     call res_set%freeze ()
   end subroutine phs_forest_extract_resonance_history_set
 
 @ %def phs_forest_extract_resonance_history_set
 @
 \subsection{Read the phase space setup from file}
 The phase space setup is stored in a file.  The file may be generated
 by the [[cascades]] module below, or by other means.  This file has to
 be read and parsed to create the PHS forest as the internal
 phase-space representation.
 
 Create lexer and syntax:
 <<PHS forests: procedures>>=
   subroutine define_phs_forest_syntax (ifile)
     type(ifile_t) :: ifile
     call ifile_append (ifile, "SEQ phase_space_list = process_phase_space*")
     call ifile_append (ifile, "SEQ process_phase_space = " &
          // "process_def process_header phase_space")
     call ifile_append (ifile, "SEQ process_def = process process_list")
     call ifile_append (ifile, "KEY process")
     call ifile_append (ifile, "LIS process_list = process_tag*")
     call ifile_append (ifile, "IDE process_tag")
     call ifile_append (ifile, "SEQ process_header = " &
          // "md5sum_process = md5sum " &
          // "md5sum_model_par = md5sum " &
          // "md5sum_phs_config = md5sum " &
          // "sqrts = real " &
          // "m_threshold_s = real " &
          // "m_threshold_t = real " &
          // "off_shell = integer " &
          // "t_channel = integer " &
          // "keep_nonresonant = logical")
     call ifile_append (ifile, "KEY '='")
     call ifile_append (ifile, "KEY '-'")
     call ifile_append (ifile, "KEY md5sum_process")
     call ifile_append (ifile, "KEY md5sum_model_par")
     call ifile_append (ifile, "KEY md5sum_phs_config")
     call ifile_append (ifile, "KEY sqrts")
     call ifile_append (ifile, "KEY m_threshold_s")
     call ifile_append (ifile, "KEY m_threshold_t")
     call ifile_append (ifile, "KEY off_shell")
     call ifile_append (ifile, "KEY t_channel")
     call ifile_append (ifile, "KEY keep_nonresonant")
     call ifile_append (ifile, "QUO md5sum = '""' ... '""'")
     call ifile_append (ifile, "REA real")
     call ifile_append (ifile, "INT integer")
     call ifile_append (ifile, "IDE logical")
     call ifile_append (ifile, "SEQ phase_space = grove_def+")
     call ifile_append (ifile, "SEQ grove_def = grove tree_def+")
     call ifile_append (ifile, "KEY grove")
     call ifile_append (ifile, "SEQ tree_def = tree bincodes mapping*")
     call ifile_append (ifile, "KEY tree")
     call ifile_append (ifile, "SEQ bincodes = bincode*")
     call ifile_append (ifile, "INT bincode")
     call ifile_append (ifile, "SEQ mapping = map bincode channel signed_pdg")
     call ifile_append (ifile, "KEY map")
     call ifile_append (ifile, "ALT channel = &
          &s_channel | t_channel | u_channel | &
          &collinear | infrared | radiation | on_shell")
     call ifile_append (ifile, "KEY s_channel")
     ! call ifile_append (ifile, "KEY t_channel")   !!! Key already exists
     call ifile_append (ifile, "KEY u_channel")
     call ifile_append (ifile, "KEY collinear")
     call ifile_append (ifile, "KEY infrared")
     call ifile_append (ifile, "KEY radiation")
     call ifile_append (ifile, "KEY on_shell")
     call ifile_append (ifile, "ALT signed_pdg = &
          &pdg | negative_pdg")
     call ifile_append (ifile, "SEQ negative_pdg = '-' pdg")
     call ifile_append (ifile, "INT pdg")
   end subroutine define_phs_forest_syntax
 
 @ %def define_phs_forest_syntax
 @ The model-file syntax and lexer are fixed, therefore stored as
 module variables:
 <<PHS forests: variables>>=
   type(syntax_t), target, save :: syntax_phs_forest
 
 @ %def syntax_phs_forest
 <<PHS forests: public>>=
   public :: syntax_phs_forest_init
 <<PHS forests: procedures>>=
   subroutine syntax_phs_forest_init ()
     type(ifile_t) :: ifile
     call define_phs_forest_syntax (ifile)
     call syntax_init (syntax_phs_forest, ifile)
     call ifile_final (ifile)
   end subroutine syntax_phs_forest_init
 
 @ %def syntax_phs_forest_init
 <<PHS forests: procedures>>=
   subroutine lexer_init_phs_forest (lexer)
     type(lexer_t), intent(out) :: lexer
     call lexer_init (lexer, &
          comment_chars = "#!", &
          quote_chars = '"', &
          quote_match = '"', &
          single_chars = "-", &
          special_class = ["="] , &
          keyword_list = syntax_get_keyword_list_ptr (syntax_phs_forest))
   end subroutine lexer_init_phs_forest
 
 @ %def lexer_init_phs_forest
 <<PHS forests: public>>=
   public :: syntax_phs_forest_final
 <<PHS forests: procedures>>=
   subroutine syntax_phs_forest_final ()
     call syntax_final (syntax_phs_forest)
   end subroutine syntax_phs_forest_final
 
 @ %def syntax_phs_forest_final
 <<PHS forests: public>>=
   public :: syntax_phs_forest_write
 <<PHS forests: procedures>>=
   subroutine syntax_phs_forest_write (unit)
     integer, intent(in), optional :: unit
     call syntax_write (syntax_phs_forest, unit)
   end subroutine syntax_phs_forest_write
 
 @ %def syntax_phs_forest_write
 @ The concrete parser and interpreter.  Generate an input stream for
 the external [[unit]], read the parse tree (with given [[syntax]] and
 [[lexer]]) from this stream, and transfer the contents of the parse
 tree to the PHS [[forest]].
 
 We look for the matching [[process]] tag, count groves and trees for
 initializing the [[forest]], and fill the trees.
 
 If the optional parameters are set, compare the parameters stored in
 the file to those.  Set [[match]] true if everything agrees.
 <<PHS forests: public>>=
   public :: phs_forest_read
 <<PHS forests: interfaces>>=
   interface phs_forest_read
      module procedure phs_forest_read_file
      module procedure phs_forest_read_unit
      module procedure phs_forest_read_parse_tree
   end interface
 
 <<PHS forests: procedures>>=
   subroutine phs_forest_read_file &
        (forest, filename, process_id, n_in, n_out, model, found, &
         md5sum_process, md5sum_model_par, &
         md5sum_phs_config, phs_par, match)
     type(phs_forest_t), intent(out) :: forest
     type(string_t), intent(in) :: filename
     type(string_t), intent(in) :: process_id
     integer, intent(in) :: n_in, n_out
     class(model_data_t), intent(in), target :: model
     logical, intent(out) :: found
     character(32), intent(in), optional :: &
          md5sum_process, md5sum_model_par, md5sum_phs_config
     type(phs_parameters_t), intent(in), optional :: phs_par
     logical, intent(out), optional :: match
     type(parse_tree_t), target :: parse_tree
     type(stream_t), target :: stream
     type(lexer_t) :: lexer
     call lexer_init_phs_forest (lexer)
     call stream_init (stream, char (filename))
     call lexer_assign_stream (lexer, stream)
     call parse_tree_init (parse_tree, syntax_phs_forest, lexer)
     call phs_forest_read (forest, parse_tree, &
          process_id, n_in, n_out, model, found, &
          md5sum_process, md5sum_model_par, md5sum_phs_config, phs_par, match)
     call stream_final (stream)
     call lexer_final (lexer)
     call parse_tree_final (parse_tree)
   end subroutine phs_forest_read_file
 
   subroutine phs_forest_read_unit &
        (forest, unit, process_id, n_in, n_out, model, found, &
         md5sum_process, md5sum_model_par, md5sum_phs_config, &
         phs_par, match)
     type(phs_forest_t), intent(out) :: forest
     integer, intent(in) :: unit
     type(string_t), intent(in) :: process_id
     integer, intent(in) :: n_in, n_out
     class(model_data_t), intent(in), target :: model
     logical, intent(out) :: found
     character(32), intent(in), optional :: &
          md5sum_process, md5sum_model_par, md5sum_phs_config
     type(phs_parameters_t), intent(in), optional :: phs_par
     logical, intent(out), optional :: match
     type(parse_tree_t), target :: parse_tree
     type(stream_t), target :: stream
     type(lexer_t) :: lexer
     call lexer_init_phs_forest (lexer)
     call stream_init (stream, unit)
     call lexer_assign_stream (lexer, stream)
     call parse_tree_init (parse_tree, syntax_phs_forest, lexer)
     call phs_forest_read (forest, parse_tree, &
          process_id, n_in, n_out, model, found, &
          md5sum_process, md5sum_model_par, md5sum_phs_config, &
          phs_par, match)
     call stream_final (stream)
     call lexer_final (lexer)
     call parse_tree_final (parse_tree)
   end subroutine phs_forest_read_unit
 
   subroutine phs_forest_read_parse_tree &
        (forest, parse_tree, process_id, n_in, n_out, model, found, &
         md5sum_process, md5sum_model_par, md5sum_phs_config, &
         phs_par, match)
     type(phs_forest_t), intent(out) :: forest
     type(parse_tree_t), intent(in), target :: parse_tree
     type(string_t), intent(in) :: process_id
     integer, intent(in) :: n_in, n_out
     class(model_data_t), intent(in), target :: model
     logical, intent(out) :: found
     character(32), intent(in), optional :: &
          md5sum_process, md5sum_model_par, md5sum_phs_config
     type(phs_parameters_t), intent(in), optional :: phs_par
     logical, intent(out), optional :: match
     type(parse_node_t), pointer :: node_header, node_phs, node_grove
     integer :: n_grove, g
     integer, dimension(:), allocatable :: n_tree
     integer :: t
     node_header => parse_tree_get_process_ptr (parse_tree, process_id)
     found = associated (node_header);  if (.not. found)  return
     if (present (match)) then
        call phs_forest_check_input (node_header, &
             md5sum_process, md5sum_model_par, md5sum_phs_config, phs_par, match)
        if (.not. match)  return
     end if
     node_phs => parse_node_get_next_ptr (node_header)
     n_grove = parse_node_get_n_sub (node_phs)
     allocate (n_tree (n_grove))
     do g = 1, n_grove
        node_grove => parse_node_get_sub_ptr (node_phs, g)
        n_tree(g) = parse_node_get_n_sub (node_grove) - 1
     end do
     call phs_forest_init (forest, n_tree, n_in, n_out)
     do g = 1, n_grove
        node_grove => parse_node_get_sub_ptr (node_phs, g)
        do t = 1, n_tree(g)
           call phs_tree_set (forest%grove(g)%tree(t), &
                parse_node_get_sub_ptr (node_grove, t+1), model)
        end do
     end do
   end subroutine phs_forest_read_parse_tree
 
 @ %def phs_forest
 @ Check the input for consistency.  If any MD5 sum or phase-space
 parameter disagrees, the phase-space file cannot be used.  The MD5
 sum checks are skipped if the stored MD5 sum is empty.
 <<PHS forests: procedures>>=
   subroutine phs_forest_check_input (pn_header, &
        md5sum_process, md5sum_model_par, md5sum_phs_config, phs_par, match)
     type(parse_node_t), intent(in), target :: pn_header
     character(32), intent(in) :: &
          md5sum_process, md5sum_model_par, md5sum_phs_config
     type(phs_parameters_t), intent(in), optional :: phs_par
     logical, intent(out) :: match
     type(parse_node_t), pointer :: pn_md5sum, pn_rval, pn_ival, pn_lval
     character(32) :: md5sum
     type(phs_parameters_t) :: phs_par_old
     character(1) :: lstr
     pn_md5sum => parse_node_get_sub_ptr (pn_header, 3)
     md5sum = parse_node_get_string (pn_md5sum)
     if (md5sum /= "" .and. md5sum /= md5sum_process) then
        call msg_message ("Phase space: discarding old configuration &
             &(process changed)")
        match = .false.;  return
     end if
     pn_md5sum => parse_node_get_next_ptr (pn_md5sum, 3)
     md5sum = parse_node_get_string (pn_md5sum)
     if (md5sum /= "" .and. md5sum /= md5sum_model_par) then
        call msg_message ("Phase space: discarding old configuration &
             &(model parameters changed)")
        match = .false.;  return
     end if
     pn_md5sum => parse_node_get_next_ptr (pn_md5sum, 3)
     md5sum = parse_node_get_string (pn_md5sum)
     if (md5sum /= "" .and. md5sum /= md5sum_phs_config) then
        call msg_message ("Phase space: discarding old configuration &
             &(configuration parameters changed)")
        match = .false.;  return
     end if
     if (present (phs_par)) then
        pn_rval => parse_node_get_next_ptr (pn_md5sum, 3)
        phs_par_old%sqrts = parse_node_get_real (pn_rval)
        pn_rval => parse_node_get_next_ptr (pn_rval, 3)
        phs_par_old%m_threshold_s = parse_node_get_real (pn_rval)
        pn_rval => parse_node_get_next_ptr (pn_rval, 3)
        phs_par_old%m_threshold_t = parse_node_get_real (pn_rval)
        pn_ival => parse_node_get_next_ptr (pn_rval, 3)
        phs_par_old%off_shell = parse_node_get_integer (pn_ival)
        pn_ival => parse_node_get_next_ptr (pn_ival, 3)
        phs_par_old%t_channel = parse_node_get_integer (pn_ival)
        pn_lval => parse_node_get_next_ptr (pn_ival, 3)
        lstr = parse_node_get_string (pn_lval)
        read (lstr, "(L1)")  phs_par_old%keep_nonresonant
        if (phs_par_old /= phs_par) then
           call msg_message &
                ("Phase space: discarding old configuration &
                &(configuration parameters changed)")
           match = .false.;  return
        end if
     end if
     match = .true.
   end subroutine phs_forest_check_input
 
 @ %def phs_forest_check_input
 @ Initialize a specific tree in the forest, using the contents of the
 'tree' node.  First, count the bincodes, allocate an array and read
 them in, and make the tree.  Each $t$-channel tree is flipped to
 $s$-channel.  Then, find mappings and initialize them.
 <<PHS forests: procedures>>=
   subroutine phs_tree_set (tree, node, model)
     type(phs_tree_t), intent(inout) :: tree
     type(parse_node_t), intent(in), target :: node
     class(model_data_t), intent(in), target :: model
     type(parse_node_t), pointer :: node_bincodes, node_mapping, pn_pdg
     integer :: n_bincodes, offset
     integer(TC), dimension(:), allocatable :: bincode
     integer :: b, n_mappings, m
     integer(TC) :: k
     type(string_t) :: type
     integer :: pdg
     node_bincodes => parse_node_get_sub_ptr (node, 2)
     if (associated (node_bincodes)) then
        select case (char (parse_node_get_rule_key (node_bincodes)))
        case ("bincodes")
           n_bincodes = parse_node_get_n_sub (node_bincodes)
           offset = 2
        case default
           n_bincodes = 0
           offset = 1
        end select
     else
        n_bincodes = 0
        offset = 2
     end if
     allocate (bincode (n_bincodes))
     do b = 1, n_bincodes
        bincode(b) = parse_node_get_integer &
             (parse_node_get_sub_ptr (node_bincodes, b))
     end do
     call phs_tree_from_array (tree, bincode)
     call phs_tree_flip_t_to_s_channel (tree)
     call phs_tree_canonicalize (tree)
     n_mappings = parse_node_get_n_sub (node) - offset
     do m = 1, n_mappings
        node_mapping => parse_node_get_sub_ptr (node, m + offset)
        k = parse_node_get_integer &
             (parse_node_get_sub_ptr (node_mapping, 2))
        type = parse_node_get_key &
             (parse_node_get_sub_ptr (node_mapping, 3))
        pn_pdg => parse_node_get_sub_ptr (node_mapping, 4)
        select case (char (pn_pdg%get_rule_key ()))
        case ("pdg")
           pdg = pn_pdg%get_integer ()
        case ("negative_pdg")
           pdg = - parse_node_get_integer (pn_pdg%get_sub_ptr (2))
        end select
        call phs_tree_init_mapping (tree, k, type, pdg, model)
     end do
   end subroutine phs_tree_set
 
 @ %def phs_tree_set
 @
 \subsection{Preparation}
 The trees that we read from file do not carry flavor information.
 This is set separately:
 
 The flavor list must be unique for a unique set of masses; if a given
 particle can have different flavor, the mass must be degenerate, so we
 can choose one of the possible flavor combinations.
 <<PHS forests: public>>=
   public :: phs_forest_set_flavors
 <<PHS forests: procedures>>=
   subroutine phs_forest_set_flavors (forest, flv, reshuffle, flv_extra)
     type(phs_forest_t), intent(inout) :: forest
     type(flavor_t), dimension(:), intent(in) :: flv
     integer, intent(in), dimension(:), allocatable, optional :: reshuffle
     type(flavor_t), intent(in), optional :: flv_extra
     integer :: i, n_flv0
     if (present (reshuffle) .and. present (flv_extra)) then
        n_flv0 = size (flv)
        do i = 1, n_flv0
           if (reshuffle(i) <= n_flv0) then
              forest%flv(i) = flv (reshuffle(i))
           else
              forest%flv(i) = flv_extra
           end if
        end do
     else
        allocate (forest%flv (size (flv)))
        forest%flv = flv
     end if
   end subroutine phs_forest_set_flavors
 
 @ %def phs_forest_set_flavors
 @
 <<PHS forests: public>>=
   public :: phs_forest_set_momentum_links
 <<PHS forests: procedures>>=
   subroutine phs_forest_set_momentum_links (forest, list)
     type(phs_forest_t), intent(inout) :: forest
     integer, intent(in), dimension(:), allocatable :: list
     integer :: g, t
     do g = 1, size (forest%grove)
       do t = 1, size (forest%grove(g)%tree)
         associate (tree => forest%grove(g)%tree(t))
           call phs_tree_set_momentum_links (tree, list)
 !!!          call phs_tree_reshuffle_mappings (tree)
         end associate
       end do
     end do
   end subroutine phs_forest_set_momentum_links
 
 @ %def phs_forest_set_momentum_links
 @ Once the parameter set is fixed, the masses and the widths of the
 particles are known and the [[mass_sum]] arrays as well as the mapping
 parameters can be computed.  Note that order is important: we first
 compute the mass sums, then the ordinary mappings.  The resonances
 obtained here determine the effective masses, which in turn are used
 to implement step mappings for resonance decay products that are not
 mapped otherwise.
 <<PHS forests: public>>=
   public :: phs_forest_set_parameters
 <<PHS forests: procedures>>=
   subroutine phs_forest_set_parameters &
        (forest, mapping_defaults, variable_limits)
     type(phs_forest_t), intent(inout) :: forest
     type(mapping_defaults_t), intent(in) :: mapping_defaults
     logical, intent(in) :: variable_limits
     integer :: g, t
     do g = 1, size (forest%grove)
        do t = 1, size (forest%grove(g)%tree)
           call phs_tree_set_mass_sum &
                (forest%grove(g)%tree(t), forest%flv(forest%n_in+1:))
           call phs_tree_set_mapping_parameters (forest%grove(g)%tree(t), &
                mapping_defaults, variable_limits)
           call phs_tree_set_effective_masses (forest%grove(g)%tree(t))
           if (mapping_defaults%step_mapping) then
              call phs_tree_set_step_mappings (forest%grove(g)%tree(t), &
                   mapping_defaults%step_mapping_exp, variable_limits)
           end if
        end do
     end do
   end subroutine phs_forest_set_parameters
 
 @ %def phs_forest_set_parameters
 @ Generate the particle combination table.  Scan all trees and merge
 their individual combination tables.  At the end, valid entries are
 non-zero, and they indicate the indices of a pair of particles to be
 combined to a new particle.  If a particle is accessible by more than
 one tree (this is usual), only keep the first possibility.
 <<PHS forests: public>>=
   public :: phs_forest_setup_prt_combinations
 <<PHS forests: procedures>>=
   subroutine phs_forest_setup_prt_combinations (forest)
     type(phs_forest_t), intent(inout) :: forest
     integer :: g, t
     integer, dimension(:,:), allocatable :: tree_prt_combination
     forest%prt_combination = 0
     allocate (tree_prt_combination (2, size (forest%prt_combination, 2)))
     do g = 1, size (forest%grove)
        do t = 1, size (forest%grove(g)%tree)
           call phs_tree_setup_prt_combinations &
                (forest%grove(g)%tree(t), tree_prt_combination)
           where (tree_prt_combination /= 0 .and. forest%prt_combination == 0)
              forest%prt_combination = tree_prt_combination
           end where
        end do
     end do
   end subroutine phs_forest_setup_prt_combinations
 
 @ %def phs_forest_setup_prt_combinations
 @
 \subsection{Accessing the particle arrays}
 Set the incoming particles from the contents of an interaction.
 <<PHS forests: public>>=
   public :: phs_forest_set_prt_in
 <<PHS forests: interfaces>>=
   interface phs_forest_set_prt_in
      module procedure phs_forest_set_prt_in_int, phs_forest_set_prt_in_mom
   end interface phs_forest_set_prt_in
 <<PHS forests: procedures>>=
   subroutine phs_forest_set_prt_in_int (forest, int, lt_cm_to_lab)
     type(phs_forest_t), intent(inout) :: forest
     type(interaction_t), intent(in) :: int
     type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
     if (present (lt_cm_to_lab)) then
        call phs_prt_set_momentum (forest%prt_in, &
             inverse (lt_cm_to_lab) * &
             int%get_momenta (outgoing=.false.))
     else
        call phs_prt_set_momentum (forest%prt_in, &
             int%get_momenta (outgoing=.false.))
     end if
     associate (m_in => forest%flv(:forest%n_in)%get_mass ())
       call phs_prt_set_msq (forest%prt_in, m_in ** 2)
     end associate
     call phs_prt_set_defined (forest%prt_in)
   end subroutine phs_forest_set_prt_in_int
 
   subroutine phs_forest_set_prt_in_mom (forest, mom, lt_cm_to_lab)
     type(phs_forest_t), intent(inout) :: forest
     type(vector4_t), dimension(size (forest%prt_in)), intent(in) :: mom
     type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
     if (present (lt_cm_to_lab)) then
        call phs_prt_set_momentum (forest%prt_in, &
             inverse (lt_cm_to_lab) * mom)
     else
        call phs_prt_set_momentum (forest%prt_in, mom)
     end if
     associate (m_in => forest%flv(:forest%n_in)%get_mass ())
       call phs_prt_set_msq (forest%prt_in, m_in ** 2)
     end associate
     call phs_prt_set_defined (forest%prt_in)
   end subroutine phs_forest_set_prt_in_mom
 
 @ %def phs_forest_set_prt_in
 @ Set the outgoing particles from the contents of an interaction.
 <<PHS forests: public>>=
   public :: phs_forest_set_prt_out
 <<PHS forests: interfaces>>=
   interface phs_forest_set_prt_out
      module procedure phs_forest_set_prt_out_int, phs_forest_set_prt_out_mom
   end interface phs_forest_set_prt_out
 <<PHS forests: procedures>>=
   subroutine phs_forest_set_prt_out_int (forest, int, lt_cm_to_lab)
     type(phs_forest_t), intent(inout) :: forest
     type(interaction_t), intent(in) :: int
     type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
     if (present (lt_cm_to_lab)) then
        call phs_prt_set_momentum (forest%prt_out, &
             inverse (lt_cm_to_lab) * &
             int%get_momenta (outgoing=.true.))
     else
        call phs_prt_set_momentum (forest%prt_out, &
             int%get_momenta (outgoing=.true.))
     end if
     associate (m_out => forest%flv(forest%n_in+1:)%get_mass ())
       call phs_prt_set_msq (forest%prt_out, m_out ** 2)
     end associate
     call phs_prt_set_defined (forest%prt_out)
   end subroutine phs_forest_set_prt_out_int
 
   subroutine phs_forest_set_prt_out_mom (forest, mom, lt_cm_to_lab)
     type(phs_forest_t), intent(inout) :: forest
     type(vector4_t), dimension(size (forest%prt_out)), intent(in) :: mom
     type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
     if (present (lt_cm_to_lab)) then
        call phs_prt_set_momentum (forest%prt_out, &
             inverse (lt_cm_to_lab) * mom)
     else
        call phs_prt_set_momentum (forest%prt_out, mom)
     end if
     associate (m_out => forest%flv(forest%n_in+1:)%get_mass ())
       call phs_prt_set_msq (forest%prt_out, m_out ** 2)
     end associate
     call phs_prt_set_defined (forest%prt_out)
   end subroutine phs_forest_set_prt_out_mom
 
 @ %def phs_forest_set_prt_out
 @ Combine particles as described by the particle combination table.
 Particle momentum sums will be calculated only if the resulting
 particle is contained in at least one of the trees in the current
 forest.  The others are kept undefined.
 <<PHS forests: public>>=
   public :: phs_forest_combine_particles
 <<PHS forests: procedures>>=
   subroutine phs_forest_combine_particles (forest)
     type(phs_forest_t), intent(inout) :: forest
     integer :: k
     integer, dimension(2) :: kk
     do k = 1, size (forest%prt_combination, 2)
        kk = forest%prt_combination(:,k)
        if (kk(1) /= 0) then
           call phs_prt_combine (forest%prt(k), &
                forest%prt(kk(1)), forest%prt(kk(2)))
        end if
     end do
   end subroutine phs_forest_combine_particles
 
 @ %def phs_forest_combine_particles
 @ Extract the outgoing particles and insert into an interaction.
 <<PHS forests: public>>=
   public :: phs_forest_get_prt_out
 <<PHS forests: procedures>>=
   subroutine phs_forest_get_prt_out (forest, int, lt_cm_to_lab)
     type(phs_forest_t), intent(in) :: forest
     type(interaction_t), intent(inout) :: int
     type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
     if (present (lt_cm_to_lab)) then
        call int%set_momenta (lt_cm_to_lab * &
             phs_prt_get_momentum (forest%prt_out), outgoing=.true.)
     else
        call int%set_momenta (phs_prt_get_momentum (forest%prt_out), &
             outgoing=.true.)
     end if
   end subroutine phs_forest_get_prt_out
 
 @ %def phs_forest_get_prt_out
 @ Extract the outgoing particle momenta
 <<PHS forests: public>>=
   public :: phs_forest_get_momenta_out
 <<PHS forests: procedures>>=
   function phs_forest_get_momenta_out (forest, lt_cm_to_lab) result (p)
     type(phs_forest_t), intent(in) :: forest
     type(lorentz_transformation_t), intent(in), optional :: lt_cm_to_lab
     type(vector4_t), dimension(size (forest%prt_out)) :: p
     p = phs_prt_get_momentum (forest%prt_out)
     if (present (lt_cm_to_lab)) p = p * lt_cm_to_lab
   end function phs_forest_get_momenta_out
 
 @ %def phs_forest_get_momenta_out
 @
 \subsection{Find equivalences among phase-space trees}
 Scan phase space for equivalences.  We generate the complete set of
 unique permutations for the given list of outgoing particles, and use
 this for scanning equivalences within each grove.
 @ We scan all pairs of trees, using all permutations.  This implies
 that trivial equivalences are included, and equivalences between
 different trees are recorded twice.  This is intentional.
 <<PHS forests: procedures>>=
   subroutine phs_grove_set_equivalences (grove, perm_array)
     type(phs_grove_t), intent(inout) :: grove
     type(permutation_t), dimension(:), intent(in) :: perm_array
     type(equivalence_t), pointer :: eq
     integer :: t1, t2, i
     do t1 = 1, size (grove%tree)
        do t2 = 1, size (grove%tree)
           SCAN_PERM: do i = 1, size (perm_array)
              if (phs_tree_equivalent &
                   (grove%tree(t1), grove%tree(t2), perm_array(i))) then
                 call equivalence_list_add &
                      (grove%equivalence_list, t1, t2, perm_array(i))
                 eq => grove%equivalence_list%last
                 call phs_tree_find_msq_permutation &
                      (grove%tree(t1), grove%tree(t2), eq%perm, &
                       eq%msq_perm)
                 call phs_tree_find_angle_permutation &
                      (grove%tree(t1), grove%tree(t2), eq%perm, &
                       eq%angle_perm, eq%angle_sig)
              end if
           end do SCAN_PERM
        end do
     end do
   end subroutine phs_grove_set_equivalences
 
 @ %def phs_grove_set_equivalences
 <<PHS forests: public>>=
   public :: phs_forest_set_equivalences
 <<PHS forests: procedures>>=
   subroutine phs_forest_set_equivalences (forest)
     type(phs_forest_t), intent(inout) :: forest
     type(permutation_t), dimension(:), allocatable :: perm_array
     integer :: i
     call permutation_array_make &
          (perm_array, forest%flv(forest%n_in+1:)%get_pdg ())
     do i = 1, size (forest%grove)
        call phs_grove_set_equivalences (forest%grove(i), perm_array)
     end do
     forest%n_equivalences = sum (forest%grove%equivalence_list%length)
   end subroutine phs_forest_set_equivalences
 
 @ %def phs_forest_set_equivalences
 @
 \subsection{Interface for channel equivalences}
 Here, we store the equivalence list in the appropriate containers that
 the [[phs_base]] module provides.  There is one separate list for each
 channel.
 <<PHS forests: public>>=
   public :: phs_forest_get_equivalences
 <<PHS forests: procedures>>=
   subroutine phs_forest_get_equivalences (forest, channel, azimuthal_dependence)
     type(phs_forest_t), intent(in) :: forest
     type(phs_channel_t), dimension(:), intent(out) :: channel
     logical, intent(in) :: azimuthal_dependence
     integer :: n_masses, n_angles
     integer :: mode_azimuthal_angle
     integer, dimension(:), allocatable :: n_eq
     type(equivalence_t), pointer :: eq
     integer, dimension(:), allocatable :: perm, mode
     integer :: g, c, j, left, right
     n_masses = forest%n_masses
     n_angles = forest%n_angles
     allocate (n_eq (forest%n_trees), source = 0)
     allocate (perm (forest%n_dimensions))
     allocate (mode (forest%n_dimensions), source = EQ_IDENTITY)
     do g = 1, size (forest%grove)
        eq => forest%grove(g)%equivalence_list%first
        do while (associated (eq))
           left = eq%left + forest%grove(g)%tree_count_offset
           n_eq(left) = n_eq(left) + 1
           eq => eq%next
        end do
     end do
     do c = 1, size (channel)
        allocate (channel(c)%eq (n_eq(c)))
        do j = 1, n_eq(c)
           call channel(c)%eq(j)%init (forest%n_dimensions)
        end do
     end do
     n_eq = 0
     if (azimuthal_dependence) then
        mode_azimuthal_angle = EQ_IDENTITY
     else
        mode_azimuthal_angle = EQ_INVARIANT
     end if
     do g = 1, size (forest%grove)
        eq => forest%grove(g)%equivalence_list%first
        do while (associated (eq))
           left = eq%left + forest%grove(g)%tree_count_offset
           right = eq%right + forest%grove(g)%tree_count_offset
           do j = 1, n_masses
              perm(j) = permute (j, eq%msq_perm)
              mode(j) = EQ_IDENTITY
           end do
           do j = 1, n_angles
              perm(n_masses+j) = n_masses + permute (j, eq%angle_perm)
              if (j == 1) then
                 mode(n_masses+j) = mode_azimuthal_angle   ! first az. angle
              else if (mod(j,2) == 1) then
                 mode(n_masses+j) = EQ_SYMMETRIC          ! other az. angles
              else if (eq%angle_sig(j)) then
                 mode(n_masses+j) = EQ_IDENTITY           ! polar angle +
              else
                 mode(n_masses+j) = EQ_INVERT             ! polar angle -
              end if
           end do
           n_eq(left) = n_eq(left) + 1
           associate (eq_cur => channel(left)%eq(n_eq(left)))
             eq_cur%c = right
             eq_cur%perm = perm
             eq_cur%mode = mode
           end associate
           eq => eq%next
        end do
     end do
   end subroutine phs_forest_get_equivalences
 
 @ %def phs_forest_get_equivalences
 @
 \subsection{Phase-space evaluation}
 Given one row of the [[x]] parameter array and the corresponding
 channel index, compute first all relevant momenta and then recover the
 remainder of the [[x]] array, the Jacobians [[phs_factor]], and the
 phase-space [[volume]].
 
 The output argument [[ok]] indicates whether this was successful.
 <<PHS forests: public>>=
   public :: phs_forest_evaluate_selected_channel
 <<PHS forests: procedures>>=
   subroutine phs_forest_evaluate_selected_channel &
        (forest, channel, active, sqrts, x, phs_factor, volume, ok)
     type(phs_forest_t), intent(inout) :: forest
     integer, intent(in) :: channel
     logical, dimension(:), intent(in) :: active
     real(default), intent(in) :: sqrts
     real(default), dimension(:,:), intent(inout) :: x
     real(default), dimension(:), intent(out) :: phs_factor
     real(default), intent(out) :: volume
     logical, intent(out) :: ok
     integer :: g, t
     integer(TC) :: k, k_root, k_in
 
     g = forest%grove_lookup (channel)
     t = channel - forest%grove(g)%tree_count_offset
     call phs_prt_set_undefined (forest%prt)
     call phs_prt_set_undefined (forest%prt_out)
     k_in = forest%n_tot
 
     do k = 1,forest%n_in
        forest%prt(ibset(0,k_in-k)) = forest%prt_in(k)
     end do
 
     do k = 1, forest%n_out
        call phs_prt_set_msq (forest%prt(ibset(0,k-1)), &
             forest%flv(forest%n_in+k)%get_mass () ** 2)
     end do
 
 
     k_root = 2**forest%n_out - 1
     select case (forest%n_in)
     case (1)
        forest%prt(k_root) = forest%prt_in(1)
     case (2)
        call phs_prt_combine &
             (forest%prt(k_root), forest%prt_in(1), forest%prt_in(2))
     end select
     call phs_tree_compute_momenta_from_x (forest%grove(g)%tree(t), &
          forest%prt, phs_factor(channel), volume, sqrts, x(:,channel), ok)
     if (ok) then
        do k = 1, forest%n_out
           forest%prt_out(k) = forest%prt(ibset(0,k-1))
        end do
     end if
   end subroutine phs_forest_evaluate_selected_channel
 
 @ %def phs_forest_evaluate_selected_channel
 @ The remainder: recover $x$ values for all channels except for the current
 channel.
 
 NOTE: OpenMP not used for the first loop.  [[combine_particles]] is not a
 channel-local operation.
 <<PHS forests: public>>=
   public :: phs_forest_evaluate_other_channels
 <<PHS forests: procedures>>=
   subroutine phs_forest_evaluate_other_channels &
        (forest, channel, active, sqrts, x, phs_factor, combine)
     type(phs_forest_t), intent(inout) :: forest
     integer, intent(in) :: channel
     logical, dimension(:), intent(in) :: active
     real(default), intent(in) :: sqrts
     real(default), dimension(:,:), intent(inout) :: x
     real(default), dimension(:), intent(inout) :: phs_factor
     logical, intent(in) :: combine
     integer :: g, t, ch, n_channel
 
     g = forest%grove_lookup (channel)
     t = channel - forest%grove(g)%tree_count_offset
 
     n_channel = forest%n_trees
     if (combine) then
        do ch = 1, n_channel
           if (ch == channel)  cycle
           if (active(ch)) then
              g = forest%grove_lookup(ch)
              t = ch - forest%grove(g)%tree_count_offset
              call phs_tree_combine_particles &
                   (forest%grove(g)%tree(t), forest%prt)
           end if
        end do
     end if
 
     !OMP PARALLEL PRIVATE (g,t,ch) SHARED(active,forest,sqrts,x,channel)
     !OMP DO SCHEDULE(STATIC)
     do ch = 1, n_channel
        if (ch == channel)  cycle
        if (active(ch)) then
           g = forest%grove_lookup(ch)
           t = ch - forest%grove(g)%tree_count_offset
           call phs_tree_compute_x_from_momenta &
                (forest%grove(g)%tree(t), &
                forest%prt, phs_factor(ch), sqrts, x(:,ch))
        end if
     end do
     !OMP END DO
     !OMP END PARALLEL
 
   end subroutine phs_forest_evaluate_other_channels
 
 @ %def phs_forest_evaluate_other_channels
 @ The complement: recover one row of the [[x]] array and the
 associated Jacobian entry, corresponding to
 [[channel]], from incoming and outgoing momenta.  Also compute the
 phase-space volume.
 <<PHS forests: public>>=
   public :: phs_forest_recover_channel
 <<PHS forests: procedures>>=
   subroutine phs_forest_recover_channel &
        (forest, channel, sqrts, x, phs_factor, volume)
     type(phs_forest_t), intent(inout) :: forest
     integer, intent(in) :: channel
     real(default), intent(in) :: sqrts
     real(default), dimension(:,:), intent(inout) :: x
     real(default), dimension(:), intent(inout) :: phs_factor
     real(default), intent(out) :: volume
     integer :: g, t
     integer(TC) :: k, k_in
     g = forest%grove_lookup (channel)
     t = channel - forest%grove(g)%tree_count_offset
     call phs_prt_set_undefined (forest%prt)
     k_in = forest%n_tot
     forall (k = 1:forest%n_in)
        forest%prt(ibset(0,k_in-k)) = forest%prt_in(k)
     end forall
     forall (k = 1:forest%n_out)
        forest%prt(ibset(0,k-1)) = forest%prt_out(k)
     end forall
     call phs_forest_combine_particles (forest)
     call phs_tree_compute_volume &
          (forest%grove(g)%tree(t), sqrts, volume)
     call phs_tree_compute_x_from_momenta &
          (forest%grove(g)%tree(t), &
          forest%prt, phs_factor(channel), sqrts, x(:,channel))
   end subroutine phs_forest_recover_channel
 
 @ %def phs_forest_recover_channel
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[phs_forests_ut.f90]]>>=
 <<File header>>
 
 module phs_forests_ut
   use unit_tests
   use phs_forests_uti
 
 <<Standard module head>>
 
 <<PHS forests: public test>>
 
 contains
 
 <<PHS forests: test driver>>
 
 end module phs_forests_ut
 @ %def phs_forests_ut
 @
 <<[[phs_forests_uti.f90]]>>=
 <<File header>>
 
 module phs_forests_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use format_defs, only: FMT_12
   use lorentz
   use flavors
   use interactions
   use model_data
   use mappings
   use phs_base
   use resonances, only: resonance_history_set_t
 
   use phs_forests
 
 <<Standard module head>>
 
 <<PHS forests: test declarations>>
 
 contains
 
 <<PHS forests: tests>>
 
 end module phs_forests_uti
 @ %def phs_forests_ut
 @ API: driver for the unit tests below.
 <<PHS forests: public test>>=
   public :: phs_forests_test
 <<PHS forests: test driver>>=
   subroutine phs_forests_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<PHS forests: execute tests>>
   end subroutine phs_forests_test
 
 @  %def phs_forests_test
 @
 \subsubsection{Basic universal test}
 Write a possible phase-space file for a $2\to 3$ process and make the
 corresponding forest, print the forest. Choose some in-particle
 momenta and a random-number array and evaluate out-particles and
 phase-space factors.
 <<PHS forests: execute tests>>=
   call test (phs_forest_1, "phs_forest_1", &
        "check phs forest setup", &
        u, results)
 <<PHS forests: test declarations>>=
   public :: phs_forest_1
 <<PHS forests: tests>>=
   subroutine phs_forest_1 (u)
     use os_interface
     integer, intent(in) :: u
     type(phs_forest_t) :: forest
     type(phs_channel_t), dimension(:), allocatable :: channel
     type(model_data_t), target :: model
     type(string_t) :: process_id
     type(flavor_t), dimension(5) :: flv
     type(string_t) :: filename
     type(interaction_t) :: int
     integer :: unit_fix
     type(mapping_defaults_t) :: mapping_defaults
     logical :: found_process, ok
     integer :: n_channel, ch, i
     logical, dimension(4) :: active = .true.
     real(default) :: sqrts = 1000
     real(default), dimension(5,4) :: x
     real(default), dimension(4) :: factor
     real(default) :: volume
 
     write (u, "(A)")  "* Test output: PHS forest"
     write (u, "(A)")  "*   Purpose: test PHS forest routines"
     write (u, "(A)")
 
     write (u, "(A)")  "* Reading model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Create phase-space file 'phs_forest_test.phs'"
     write (u, "(A)")
 
     call flv%init ([11, -11, 11, -11, 22], model)
     unit_fix = free_unit ()
     open (file="phs_forest_test.phs", unit=unit_fix, action="write")
     write (unit_fix, *) "process foo"
     write (unit_fix, *) 'md5sum_process    = "6ABA33BC2927925D0F073B1C1170780A"'
     write (unit_fix, *) 'md5sum_model_par  = "1A0B151EE6E2DEB92D880320355A3EAB"'
     write (unit_fix, *) 'md5sum_phs_config = "B6A8877058809A8BDD54753CDAB83ACE"'
     write (unit_fix, *) "sqrts         =    100.00000000000000"
     write (unit_fix, *) "m_threshold_s =    50.000000000000000"
     write (unit_fix, *) "m_threshold_t =    100.00000000000000"
     write (unit_fix, *) "off_shell =            2"
     write (unit_fix, *) "t_channel =            6"
     write (unit_fix, *) "keep_nonresonant =  F"
     write (unit_fix, *) ""
     write (unit_fix, *) "  grove"
     write (unit_fix, *) "    tree 3 7"
     write (unit_fix, *) "      map 3 s_channel 23"
     write (unit_fix, *) "    tree 5 7"
     write (unit_fix, *) "    tree 6 7"
     write (unit_fix, *) "  grove"
     write (unit_fix, *) "    tree 9 11"
     write (unit_fix, *) "      map 9 t_channel 22"
     close (unit_fix)
 
     write (u, "(A)")
     write (u, "(A)")  "* Read phase-space file 'phs_forest_test.phs'"
 
     call syntax_phs_forest_init ()
     process_id = "foo"
     filename = "phs_forest_test.phs"
     call phs_forest_read &
          (forest, filename, process_id, 2, 3, model, found_process)
 
     write (u, "(A)")
     write (u, "(A)")  "* Set parameters, flavors, equiv, momenta"
     write (u, "(A)")
 
     call phs_forest_set_flavors (forest, flv)
     call phs_forest_set_parameters (forest, mapping_defaults, .false.)
     call phs_forest_setup_prt_combinations (forest)
     call phs_forest_set_equivalences (forest)
     call int%basic_init (2, 0, 3)
     call int%set_momentum &
          (vector4_moving (500._default, 500._default, 3), 1)
     call int%set_momentum &
          (vector4_moving (500._default,-500._default, 3), 2)
     call phs_forest_set_prt_in (forest, int)
     n_channel = 2
     x = 0
     x(:,n_channel) = [0.3, 0.4, 0.1, 0.9, 0.6]
     write (u, "(A)")  "   Input values:"
     write (u, "(3x,5(1x," // FMT_12 // "))")  x(:,n_channel)
 
     write (u, "(A)")
     write (u, "(A)")  "* Evaluating phase space"
 
     call phs_forest_evaluate_selected_channel (forest, &
          n_channel, active, sqrts, x, factor, volume, ok)
     call phs_forest_evaluate_other_channels (forest, &
          n_channel, active, sqrts, x, factor, combine=.true.)
     call phs_forest_get_prt_out (forest, int)
     write (u, "(A)")  "   Output values:"
     do ch = 1, 4
        write (u, "(3x,5(1x," // FMT_12 // "))")  x(:,ch)
     end do
     call int%basic_write (u)
     write (u, "(A)")  "   Factors:"
     write (u, "(3x,5(1x," // FMT_12 // "))")  factor
     write (u, "(A)")  "   Volume:"
     write (u, "(3x,5(1x," // FMT_12 // "))")  volume
     call phs_forest_write (forest, u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute equivalences"
 
     n_channel = 4
     allocate (channel (n_channel))
     call phs_forest_get_equivalences (forest, &
          channel, .true.)
     do i = 1, n_channel
        write (u, "(1x,I0,':')", advance = "no")  ch
        call channel(i)%write (u)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
     call phs_forest_final (forest)
     call syntax_phs_forest_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_forest_1"
 
   end subroutine phs_forest_1
 
 @ %def phs_forest_1
 @
 \subsubsection{Resonance histories}
 Read a suitably nontrivial forest from file and recover the set of
 resonance histories.
 <<PHS forests: execute tests>>=
   call test (phs_forest_2, "phs_forest_2", &
        "handle phs forest resonance content", &
        u, results)
 <<PHS forests: test declarations>>=
   public :: phs_forest_2
 <<PHS forests: tests>>=
   subroutine phs_forest_2 (u)
     use os_interface
     integer, intent(in) :: u
     integer :: unit_fix
     type(phs_forest_t) :: forest
     type(model_data_t), target :: model
     type(string_t) :: process_id
     type(string_t) :: filename
     logical :: found_process
     type(resonance_history_set_t) :: res_set
     integer :: i
 
     write (u, "(A)")  "* Test output: phs_forest_2"
     write (u, "(A)")  "*   Purpose: test PHS forest routines"
     write (u, "(A)")
 
     write (u, "(A)")  "* Reading model file"
 
     call model%init_sm_test ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Create phase-space file 'phs_forest_2.phs'"
     write (u, "(A)")
 
     unit_fix = free_unit ()
     open (file="phs_forest_2.phs", unit=unit_fix, action="write")
     write (unit_fix, *) "process foo"
     write (unit_fix, *) 'md5sum_process    = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"'
     write (unit_fix, *) 'md5sum_model_par  = "1A0B151EE6E2DEB92D880320355A3EAB"'
     write (unit_fix, *) 'md5sum_phs_config = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"'
     write (unit_fix, *) "sqrts         =    100.00000000000000"
     write (unit_fix, *) "m_threshold_s =    50.000000000000000"
     write (unit_fix, *) "m_threshold_t =    100.00000000000000"
     write (unit_fix, *) "off_shell =            2"
     write (unit_fix, *) "t_channel =            6"
     write (unit_fix, *) "keep_nonresonant =  F"
     write (unit_fix, *) ""
     write (unit_fix, *) "  grove"
     write (unit_fix, *) "    tree 3 7"
     write (unit_fix, *) "    tree 3 7"
     write (unit_fix, *) "      map 3 s_channel -24"
     write (unit_fix, *) "    tree 5 7"
     write (unit_fix, *) "    tree 3 7"
     write (unit_fix, *) "      map 3 s_channel -24"
     write (unit_fix, *) "      map 7 s_channel 23"
     write (unit_fix, *) "    tree 5 7"
     write (unit_fix, *) "      map 7 s_channel 25"
     write (unit_fix, *) "    tree 3 11"
     write (unit_fix, *) "      map 3 s_channel -24"
     close (unit_fix)
 
     write (u, "(A)")  "* Read phase-space file 'phs_forest_2.phs'"
 
     call syntax_phs_forest_init ()
     process_id = "foo"
     filename = "phs_forest_2.phs"
     call phs_forest_read &
          (forest, filename, process_id, 2, 3, model, found_process)
 
     write (u, "(A)")
     write (u, "(A)")  "* Extract resonance history set"
     write (u, "(A)")
 
     call forest%extract_resonance_history_set (res_set)
     call res_set%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call model%final ()
     call phs_forest_final (forest)
     call syntax_phs_forest_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_forest_2"
 
   end subroutine phs_forest_2
 
 @ %def phs_forest_2
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{Finding phase space parameterizations}
 If the phase space configuration is not found in the appropriate file,
 we should generate one.
 
 The idea is to construct all Feynman diagrams subject to certain
 constraints which eliminate everything that is probably irrelevant for
 the integration.  These Feynman diagrams (cascades) are grouped in
 groves by finding equivalence classes related by symmetry and ordered
 with respect to their importance (resonances).  Finally, the result
 (or part of it) is written to file and used for the integration.
 
 This module may eventually disappear and be replaced by CAML code.
 In particular, we need here a set of Feynman rules (vertices with
 particle codes, but not the factors).  Thus, the module works for the
 Standard Model only.
 
 Note that this module is stand-alone, it communicates to the main
 program only via the generated ASCII phase-space configuration file.
 <<[[cascades.f90]]>>=
 <<File header>>
 
 module cascades
 
 <<Use kinds>>
   use kinds, only: TC, i8, i32
 <<Use strings>>
   use io_units
   use constants, only: one
   use format_defs, only: FMT_12, FMT_19
   use numeric_utils
   use diagnostics
   use hashes
   use sorting
   use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
   use physics_defs, only: UNDEFINED
   use model_data
   use flavors
   use lorentz
 
   use resonances, only: resonance_info_t
   use resonances, only: resonance_history_t
   use resonances, only: resonance_history_set_t
   use phs_forests
 
 <<Standard module head>>
 
 <<Cascades: public>>
 
 <<Cascades: parameters>>
 
 <<Cascades: types>>
 
 <<Cascades: interfaces>>
 
 contains
 
 <<Cascades: procedures>>
 
 end module cascades
 @ %def cascades
 @
 \subsection{The mapping modes}
 The valid mapping modes, to be used below.  We will make use of the convention
 that mappings of internal particles have a positive value.  Only for positive
 values, the flavor code is propagated when combining cascades.
 <<Mapping modes>>=
   integer, parameter :: &
        & EXTERNAL_PRT = -1, &
        & NO_MAPPING = 0, S_CHANNEL = 1, T_CHANNEL =  2, U_CHANNEL = 3, &
        & RADIATION = 4, COLLINEAR = 5, INFRARED = 6, &
        & STEP_MAPPING_E = 11, STEP_MAPPING_H = 12, &
        & ON_SHELL = 99
 @ %def EXTERNAL_PRT
 @ %def NO_MAPPING S_CHANNEL T_CHANNEL U_CHANNEL
 @ %def RADIATION COLLINEAR INFRARED
 @ %def STEP_MAPPING_E STEP_MAPPING_H
 @ %def ON_SHELL
 <<Cascades: parameters>>=
 <<Mapping modes>>
 @
 \subsection{The cascade type}
 A cascade is essentially the same as a decay tree (both definitions
 may be merged in a later version).  It contains a linked tree of
 nodes, each of which representing an internal particle.  In contrast
 to decay trees, each node has a definite particle code.  These nodes
 need not be modified, therefore we can use pointers and do not have to
 copy them.  Thus, physically each cascades has only a single node, the
 mother particle.  However, to be able to compare trees quickly, we
 store in addition an array of binary codes which is always sorted in
 ascending order.  This is accompanied by a corresponding list of
 particle codes.  The index is the location of the corresponding
 cascade in the cascade set, this may be used to access the daughters
 directly.
 
 The real mass is the particle mass belonging to the particle code.
 The minimal mass is the sum of the real masses of all its daughters;
 this is the kinematical cutoff.  The effective mass may be zero if the
 particle mass is below a certain threshold; it may be the real mass if
 the particle is resonant; or it may be some other value.
 
 The logical [[t_channel]] is set if this a $t$-channel line, while
 [[initial]] is true only for an initial particle.  Note that both
 initial particles are also [[t_channel]] by definition, and that they
 are distinguished by the direction of the tree:  One of them decays
 and is the root of the tree, while the other one is one of the leaves.
 
 The cascade is a list of nodes (particles) which are linked via the
 [[daughter]] entries.  The node is the mother particle of
 the decay cascade.  Much of the information in the nodes is repeated
 in arrays, to be accessible more easily.  The arrays will be kept
 sorted by binary codes.
 
 The counter [[n_off_shell]] is increased for each internal line that
 is neither resonant nor log-enhanced.  It is set to zero if the
 current line is resonant, since this implies on-shell particle production
 and subsequent decay.
 
 The counter [[n_t_channel]] is non-negative once an initial particle
 is included in the tree: then, it counts the number of $t$-channel lines.
 
 The [[multiplicity]] is the number of branchings to follow until all
 daughters are on-shell.  A resonant or non-decaying particle has
 multiplicity one.  Merging nodes, the multiplicities add unless the
 mother is a resonance.  An initial or final node has multiplicity
 zero.
 
 The arrays correspond to the subnode tree [[tree]] of the current
 cascade.  PDG codes are stored only for those positions which are
 resonant, with the exception of the last entry, i.e., the current node.
 Other positions, in particular external legs, are assigned undefined
 PDG code.
 
 A cascade is uniquely identified by its tree, the tree of PDG codes,
 and the tree of mappings.  The tree of resonances is kept only to mask
 the PDG tree as described above.
 <<Cascades: types>>=
   type :: cascade_t
      private
      ! counters
      integer :: index = 0
      integer :: grove = 0
      ! status
      logical :: active = .false.
      logical :: complete = .false.
      logical :: incoming = .false.
      ! this node
      integer(TC) :: bincode = 0
      type(flavor_t) :: flv
      integer :: pdg = UNDEFINED
      logical :: is_vector = .false.
      real(default) :: m_min = 0
      real(default) :: m_rea = 0
      real(default) :: m_eff = 0
      integer :: mapping = NO_MAPPING
      logical :: on_shell = .false.
      logical :: resonant = .false.
      logical :: log_enhanced = .false.
      logical :: t_channel = .false.
      ! global tree properties
      integer :: multiplicity = 0
      integer :: internal = 0
      integer :: n_off_shell = 0
      integer :: n_resonances = 0
      integer :: n_log_enhanced = 0
      integer :: n_t_channel = 0
      integer :: res_hash = 0
      ! the sub-node tree
      integer :: depth = 0
      integer(TC), dimension(:), allocatable :: tree
      integer, dimension(:), allocatable :: tree_pdg
      integer, dimension(:), allocatable :: tree_mapping
      logical, dimension(:), allocatable :: tree_resonant
      ! branch connections
      logical :: has_children = .false.
      type(cascade_t), pointer :: daughter1 => null ()
      type(cascade_t), pointer :: daughter2 => null ()
      type(cascade_t), pointer :: mother => null ()
      ! next in list
      type(cascade_t), pointer :: next => null ()
    contains
    <<Cascades: cascade: TBP>>
   end type cascade_t
 
 @ %def cascade_t
 <<Cascades: procedures>>=
   subroutine cascade_init (cascade, depth)
     type(cascade_t), intent(out) :: cascade
     integer, intent(in) :: depth
     integer, save :: index = 0
     index = cascade_index ()
     cascade%index = index
     cascade%depth = depth
     cascade%active = .true.
     allocate (cascade%tree (depth))
     allocate (cascade%tree_pdg (depth))
     allocate (cascade%tree_mapping (depth))
     allocate (cascade%tree_resonant (depth))
   end subroutine cascade_init
 @ %def cascade_init
 @ Keep and increment a global index
 <<Cascades: procedures>>=
   function cascade_index (seed) result (index)
     integer :: index
     integer, intent(in), optional :: seed
     integer, save :: i = 0
     if (present (seed))  i = seed
     i = i + 1
     index = i
   end function cascade_index
 
 @ %def cascade_index
 @ We need three versions of writing cascades.  This goes to the
 phase-space file.
 
 For t/u channel mappings, we use the absolute value of the PDG code.
 <<Cascades: procedures>>=
   subroutine cascade_write_file_format (cascade, model, unit)
     type(cascade_t), intent(in) :: cascade
     class(model_data_t), intent(in), target :: model
     integer, intent(in), optional :: unit
     type(flavor_t) :: flv
     integer :: u, i
 2   format(3x,A,1x,I3,1x,A,1x,I9,1x,'!',1x,A)
     u = given_output_unit (unit);  if (u < 0)  return
     call write_reduced (cascade%tree, u)
     write (u, "(A)")
     do i = 1, cascade%depth
        call flv%init (cascade%tree_pdg(i), model)
        select case (cascade%tree_mapping(i))
        case (NO_MAPPING, EXTERNAL_PRT)
        case (S_CHANNEL)
           write(u,2) 'map', &
                cascade%tree(i), 's_channel', cascade%tree_pdg(i), &
                char (flv%get_name ())
        case (T_CHANNEL)
           write(u,2) 'map', &
                cascade%tree(i), 't_channel', abs (cascade%tree_pdg(i)), &
                char (flv%get_name ())
        case (U_CHANNEL)
           write(u,2) 'map', &
                cascade%tree(i), 'u_channel', abs (cascade%tree_pdg(i)), &
                char (flv%get_name ())
        case (RADIATION)
           write(u,2) 'map', &
                cascade%tree(i), 'radiation', cascade%tree_pdg(i), &
                char (flv%get_name ())
        case (COLLINEAR)
           write(u,2) 'map', &
                cascade%tree(i), 'collinear', cascade%tree_pdg(i), &
                char (flv%get_name ())
        case (INFRARED)
           write(u,2) 'map', &
                cascade%tree(i), 'infrared ', cascade%tree_pdg(i), &
                char (flv%get_name ())
        case (ON_SHELL)
           write(u,2) 'map', &
                cascade%tree(i), 'on_shell ', cascade%tree_pdg(i), &
                char (flv%get_name ())
        case default
           call msg_bug (" Impossible mapping mode encountered")
        end select
     end do
   contains
     subroutine write_reduced (array, unit)
       integer(TC), dimension(:), intent(in) :: array
       integer, intent(in) :: unit
       integer :: i
       write (u, "(3x,A,1x)", advance="no")  "tree"
       do i = 1, size (array)
          if (decay_level (array(i)) > 1) then
             write (u, "(1x,I0)", advance="no")  array(i)
          end if
       end do
     end subroutine write_reduced
 
     elemental function decay_level (k) result (l)
       integer(TC), intent(in) :: k
       integer :: l
       integer :: i
       l = 0
       do i = 0, bit_size(k) - 1
          if (btest(k,i)) l = l + 1
       end do
     end function decay_level
     subroutine start_comment (u)
       integer, intent(in) :: u
       write(u, '(1x,A)', advance='no') '!'
     end subroutine start_comment
   end subroutine cascade_write_file_format
 
 @ %def cascade_write_file_format
 @ This creates metapost source for graphical display:
 <<Cascades: procedures>>=
   subroutine cascade_write_graph_format (cascade, count, unit)
     type(cascade_t), intent(in) :: cascade
     integer, intent(in) :: count
     integer, intent(in), optional :: unit
     integer :: u
     integer(TC) :: mask
     type(string_t) :: left_str, right_str
     u = given_output_unit (unit);  if (u < 0)  return
     mask = 2**((cascade%depth+3)/2) - 1
     left_str = ""
     right_str = ""
     write (u, '(A)') "\begin{minipage}{105pt}"
     write (u, '(A)') "\vspace{30pt}"
     write (u, '(A)') "\begin{center}"
     write (u, '(A)') "\begin{fmfgraph*}(55,55)"
     call graph_write (cascade, mask)
     write (u, '(A)') "\fmfleft{" // char (extract (left_str, 2)) // "}"
     write (u, '(A)') "\fmfright{" // char (extract (right_str, 2)) // "}"
     write (u, '(A)') "\end{fmfgraph*}\\"
     write (u, '(A,I5,A)') "\fbox{$", count, "$}"
     write (u, '(A)') "\end{center}"
     write (u, '(A)') "\end{minipage}"
     write (u, '(A)') "%"
   contains
     recursive subroutine graph_write (cascade, mask, reverse)
       type(cascade_t), intent(in) :: cascade
       integer(TC), intent(in) :: mask
       logical, intent(in), optional :: reverse
       type(flavor_t) :: anti
       logical :: rev
       rev = .false.;  if (present(reverse))  rev = reverse
       if (cascade%has_children) then
          if (.not.rev) then
             call vertex_write (cascade, cascade%daughter1, mask)
             call vertex_write (cascade, cascade%daughter2, mask)
          else
             call vertex_write (cascade, cascade%daughter2, mask, .true.)
             call vertex_write (cascade, cascade%daughter1, mask, .true.)
          end if
          if (cascade%complete) then
             call vertex_write (cascade, cascade%mother, mask, .true.)
             write (u, '(A,I0,A)') "\fmfv{d.shape=square}{v0}"
          end if
       else
          if (cascade%incoming) then
             anti = cascade%flv%anti ()
             call external_write (cascade%bincode, anti%get_tex_name (), &
                  left_str)
          else
             call external_write (cascade%bincode, cascade%flv%get_tex_name (), &
                  right_str)
          end if
       end if
     end subroutine graph_write
     recursive subroutine vertex_write (cascade, daughter, mask, reverse)
       type(cascade_t), intent(in) :: cascade, daughter
       integer(TC), intent(in) :: mask
       logical, intent(in), optional :: reverse
       integer :: bincode
       if (cascade%complete) then
          bincode = 0
       else
          bincode = cascade%bincode
       end if
       call graph_write (daughter, mask, reverse)
       if (daughter%has_children) then
          call line_write (bincode, daughter%bincode, daughter%flv, &
               mapping=daughter%mapping)
       else
          call line_write (bincode, daughter%bincode, daughter%flv)
       end if
     end subroutine vertex_write
     subroutine line_write (i1, i2, flv, mapping)
       integer(TC), intent(in) :: i1, i2
       type(flavor_t), intent(in) :: flv
       integer, intent(in), optional :: mapping
       integer :: k1, k2
       type(string_t) :: prt_type
       select case (flv%get_spin_type ())
       case (SCALAR);       prt_type = "plain"
       case (SPINOR);       prt_type = "fermion"
       case (VECTOR);       prt_type = "boson"
       case (VECTORSPINOR); prt_type = "fermion"
       case (TENSOR);       prt_type = "dbl_wiggly"
       case default;        prt_type = "dashes"
       end select
       if (flv%is_antiparticle ()) then
          k1 = i2;  k2 = i1
       else
          k1 = i1;  k2 = i2
       end if
       if (present (mapping)) then
          select case (mapping)
          case (S_CHANNEL)
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=blue,lab=\sm\blue$" // &
                  & char (flv%get_tex_name ()) // "$}" // &
                  & "{v", k1, ",v", k2, "}"
          case (T_CHANNEL, U_CHANNEL)
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=cyan,lab=\sm\cyan$" // &
                  & char (flv%get_tex_name ()) // "$}" // &
                  & "{v", k1, ",v", k2, "}"
          case (RADIATION)
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=green,lab=\sm\green$" // &
                  & char (flv%get_tex_name ()) // "$}" // &
                  & "{v", k1, ",v", k2, "}"
          case (COLLINEAR)
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=magenta,lab=\sm\magenta$" // &
                  & char (flv%get_tex_name ()) // "$}" // &
                  & "{v", k1, ",v", k2, "}"
          case (INFRARED)
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=red,lab=\sm\red$" // &
                  & char (flv%get_tex_name ()) // "$}" // &
                  & "{v", k1, ",v", k2, "}"
          case default
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=black}" // &
                  & "{v", k1, ",v", k2, "}"
          end select
       else
          write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & "}" // &
                  & "{v", k1, ",v", k2, "}"
       end if
     end subroutine line_write
     subroutine external_write (bincode, name, ext_str)
       integer(TC), intent(in) :: bincode
       type(string_t), intent(in) :: name
       type(string_t), intent(inout) :: ext_str
       character(len=20) :: str
       write (str, '(A2,I0)') ",v", bincode
       ext_str = ext_str // trim (str)
       write (u, '(A,I0,A,I0,A)') "\fmflabel{\sm$" &
         // char (name) &
         // "\,(", bincode, ")" &
         // "$}{v", bincode, "}"
     end subroutine external_write
   end subroutine cascade_write_graph_format
 
 @ %def cascade_write_graph_format
 @ This is for screen/debugging output:
 <<Cascades: procedures>>=
   subroutine cascade_write (cascade, unit)
     type(cascade_t), intent(in) :: cascade
     integer, intent(in), optional :: unit
     integer :: u
     character(9) :: depth
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(A,(1x,I7))") 'Cascade #', cascade%index
     write (u, "(A,(1x,I7))") '  Grove:       #', cascade%grove
     write (u, "(A,3(1x,L1))") '  act/cmp/inc:  ', &
          cascade%active, cascade%complete, cascade%incoming
     write (u, "(A,I0)") '  Bincode:      ', cascade%bincode
     write (u, "(A)", advance="no") '  Flavor:       '
     call cascade%flv%write (unit)
     write (u, "(A,I9)") '  Active flavor:', cascade%pdg
     write (u, "(A,L1)") '  Is vector:    ', cascade%is_vector
     write (u, "(A,3(1x," // FMT_19 // "))") '  Mass (m/r/e): ', &
          cascade%m_min, cascade%m_rea, cascade%m_eff
     write (u, "(A,I1)") '  Mapping:      ', cascade%mapping
     write (u, "(A,3(1x,L1))") '  res/log/tch:  ', &
          cascade%resonant, cascade%log_enhanced, cascade%t_channel
     write (u, "(A,(1x,I7))") '  Multiplicity: ', cascade%multiplicity
     write (u, "(A,2(1x,I7))") '  n intern/off: ', &
          cascade%internal, cascade%n_off_shell
     write (u, "(A,3(1x,I7))") '  n res/log/tch:', &
          cascade%n_resonances, cascade%n_log_enhanced, cascade%n_t_channel
     write (u, "(A,I7)") '  Depth:        ', cascade%depth
     write (depth, "(I7)") cascade%depth
     write (u, "(A," // depth // "(1x,I7))") &
        '  Tree:         ', cascade%tree
     write (u, "(A," // depth // "(1x,I7))") &
        '  Tree(PDG):    ', cascade%tree_pdg
     write (u, "(A," // depth // "(1x,I7))") &
        '  Tree(mapping):', cascade%tree_mapping
     write (u, "(A," // depth // "(1x,L1))") &
        '  Tree(res):    ', cascade%tree_resonant
     if (cascade%has_children) then
        write (u, "(A,I7,1x,I7)") '  Daughter1/2:  ', &
             cascade%daughter1%index, cascade%daughter2%index
     end if
     if (associated (cascade%mother)) then
        write (u, "(A,I7)") '  Mother:       ', cascade%mother%index
     end if
   end subroutine cascade_write
 
 @ %def cascade_write
 @
 \subsection{Creating new cascades}
 This initializes a single-particle cascade (external, final state).
 The PDG entry in the tree is set undefined because the cascade is not
 resonant.  However, the flavor entry is set, so the cascade flavor
 is identified nevertheless.
 <<Cascades: procedures>>=
   subroutine cascade_init_outgoing (cascade, flv, pos, m_thr)
     type(cascade_t), intent(out) :: cascade
     type(flavor_t), intent(in) :: flv
     integer, intent(in) :: pos
     real(default), intent(in) :: m_thr
     call cascade_init (cascade, 1)
     cascade%bincode = ibset (0_TC, pos-1)
     cascade%flv = flv
     cascade%pdg = cascade%flv%get_pdg ()
     cascade%is_vector = flv%get_spin_type () == VECTOR
     cascade%m_min = flv%get_mass ()
     cascade%m_rea = cascade%m_min
     if (cascade%m_rea >= m_thr) then
        cascade%m_eff = cascade%m_rea
     end if
     cascade%on_shell = .true.
     cascade%multiplicity = 1
     cascade%tree(1) = cascade%bincode
     cascade%tree_pdg(1) = cascade%pdg
     cascade%tree_mapping(1) = EXTERNAL_PRT
     cascade%tree_resonant(1) = .false.
   end subroutine cascade_init_outgoing
 
 @ %def cascade_init_outgoing
 @ The same for an incoming line:
 <<Cascades: procedures>>=
   subroutine cascade_init_incoming (cascade, flv, pos, m_thr)
     type(cascade_t), intent(out) :: cascade
     type(flavor_t), intent(in) :: flv
     integer, intent(in) :: pos
     real(default), intent(in) :: m_thr
     call cascade_init (cascade, 1)
     cascade%incoming = .true.
     cascade%bincode = ibset (0_TC, pos-1)
     cascade%flv = flv%anti ()
     cascade%pdg = cascade%flv%get_pdg ()
     cascade%is_vector = flv%get_spin_type () == VECTOR
     cascade%m_min = flv%get_mass ()
     cascade%m_rea = cascade%m_min
     if (cascade%m_rea >= m_thr) then
        cascade%m_eff = cascade%m_rea
     end if
     cascade%on_shell = .true.
     cascade%n_t_channel = 0
     cascade%n_off_shell = 0
     cascade%tree(1) = cascade%bincode
     cascade%tree_pdg(1) = cascade%pdg
     cascade%tree_mapping(1) = EXTERNAL_PRT
     cascade%tree_resonant(1) = .false.
   end subroutine cascade_init_incoming
 
 @ %def cascade_init_outgoing
 @
 \subsection{Tools}
 This function returns true if the two cascades share no common
 external particle.  This is a requirement for joining them.
 <<Cascades: interfaces>>=
   interface operator(.disjunct.)
      module procedure cascade_disjunct
   end interface
 
 <<Cascades: procedures>>=
   function cascade_disjunct (cascade1, cascade2) result (flag)
     logical :: flag
     type(cascade_t), intent(in) :: cascade1, cascade2
     flag = iand (cascade1%bincode, cascade2%bincode) == 0
   end function cascade_disjunct
 
 @ %def cascade_disjunct
 @ %def .disjunct.
 @ Compute a hash code for the resonance pattern of a cascade.  We count the
 number of times each particle appears as a resonance.
 
 We pack the PDG codes of the resonances in two arrays (s-channel and
 t-channel), sort them both, concatenate the results, transfer to
 [[i8]] integers, and compute the hash code from this byte stream.
 
 For t/u-channel, we remove the sign for antiparticles since this is not
 well-defined.
 <<Cascades: procedures>>=
   subroutine cascade_assign_resonance_hash (cascade)
     type(cascade_t), intent(inout) :: cascade
     integer(i8), dimension(1) :: mold
     cascade%res_hash = hash (transfer &
          ([sort (pack (cascade%tree_pdg, &
                  cascade%tree_resonant)), &
            sort (pack (abs (cascade%tree_pdg), &
                  cascade%tree_mapping == T_CHANNEL .or. &
                  cascade%tree_mapping == U_CHANNEL))], &
           mold))
   end subroutine cascade_assign_resonance_hash
 
 @ %def cascade_assign_resonance_hash
 @
 \subsection{Hash entries for cascades}
 We will set up a hash array which contains keys of and pointers to
 cascades.  We hold a list of cascade (pointers) within each bucket.
 This is not for collision resolution, but for keeping similar, but
 unequal cascades together.
 <<Cascades: types>>=
   type :: cascade_p
      type(cascade_t), pointer :: cascade => null ()
      type(cascade_p), pointer :: next => null ()
   end type cascade_p
 
 @ %def cascade_p
 @ Here is the bucket or hash entry type:
 <<Cascades: types>>=
   type :: hash_entry_t
      integer(i32) :: hashval = 0
      integer(i8), dimension(:), allocatable :: key
      type(cascade_p), pointer :: first => null ()
      type(cascade_p), pointer :: last => null ()
   end type hash_entry_t
 
 @ %def hash_entry_t
 <<Cascades: public>>=
   public :: hash_entry_init
 <<Cascades: procedures>>=
   subroutine hash_entry_init (entry, entry_in)
     type(hash_entry_t), intent(out) :: entry
     type(hash_entry_t), intent(in) :: entry_in
     type(cascade_p), pointer :: casc_iter, casc_copy
     entry%hashval = entry_in%hashval
     entry%key = entry_in%key
     casc_iter => entry_in%first
     do while (associated (casc_iter))
        allocate (casc_copy)
        casc_copy = casc_iter
        casc_copy%next => null ()
        if (associated (entry%first)) then
           entry%last%next => casc_copy
        else
           entry%first => casc_copy
        end if
        entry%last => casc_copy
        casc_iter => casc_iter%next
     end do
   end subroutine hash_entry_init
 
 @ %def hash_entry_init
 @ Finalize: just deallocate the list; the contents are just pointers.
 <<Cascades: procedures>>=
   subroutine hash_entry_final (hash_entry)
     type(hash_entry_t), intent(inout) :: hash_entry
     type(cascade_p), pointer :: current
     do while (associated (hash_entry%first))
        current => hash_entry%first
        hash_entry%first => current%next
        deallocate (current)
     end do
   end subroutine hash_entry_final
 
 @ %def hash_entry_final
 @ Output: concise format for debugging, just list cascade indices.
 <<Cascades: procedures>>=
   subroutine hash_entry_write (hash_entry, unit)
     type(hash_entry_t), intent(in) :: hash_entry
     integer, intent(in), optional :: unit
     type(cascade_p), pointer :: current
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, "(1x,A)", advance="no")  "Entry:"
     do i = 1, size (hash_entry%key)
        write (u, "(1x,I0)", advance="no")  hash_entry%key(i)
     end do
     write (u, "(1x,A)", advance="no")  "->"
     current => hash_entry%first
     do while (associated (current))
        write (u, "(1x,I7)", advance="no") current%cascade%index
        current => current%next
     end do
     write (u, *)
   end subroutine hash_entry_write
 
 @ %def hash_entry_write
 @ This function adds a cascade pointer to the bucket.  If [[ok]] is
 present, check first if it is already there and return failure if yes.
 If [[cascade_ptr]] is also present, set it to the current cascade if
 successful.  If not, set it to the cascade that is already there.
 <<Cascades: procedures>>=
   subroutine hash_entry_add_cascade_ptr (hash_entry, cascade, ok, cascade_ptr)
     type(hash_entry_t), intent(inout) :: hash_entry
     type(cascade_t), intent(in), target :: cascade
     logical, intent(out), optional :: ok
     type(cascade_t), optional, pointer :: cascade_ptr
     type(cascade_p), pointer :: current
     if (present (ok)) then
        call hash_entry_check_cascade (hash_entry, cascade, ok, cascade_ptr)
        if (.not. ok)  return
     end if
     allocate (current)
     current%cascade => cascade
     if (associated (hash_entry%last)) then
        hash_entry%last%next => current
     else
        hash_entry%first => current
     end if
     hash_entry%last => current
   end subroutine hash_entry_add_cascade_ptr
 
 @ %def hash_entry_add_cascade_ptr
 @ This function checks whether a cascade is already in the bucket.
 For incomplete cascades, we look for an exact match. It should suffice
 to verify the tree, the PDG codes, and the mapping modes.  This is the
 information that is written to the phase space file.
 
 For complete cascades, we ignore the PDG code at positions with
 mappings infrared, collinear, or t/u-channel.  Thus a cascade which is
 distinguished only by PDG code at such places, is flagged existent.
 If the convention is followed that light particles come before heavier
 ones (in the model definition), this ensures that the lightest
 particle is kept in the appropriate place, corresponding to the
 strongest peak.
 
 For external cascades (incoming/outgoing) we take the PDG code into
 account even though it is zeroed in the PDG-code tree.
 <<Cascades: procedures>>=
   subroutine hash_entry_check_cascade (hash_entry, cascade, ok, cascade_ptr)
     type(hash_entry_t), intent(in), target :: hash_entry
     type(cascade_t), intent(in), target :: cascade
     logical, intent(out) :: ok
     type(cascade_t), optional, pointer :: cascade_ptr
     type(cascade_p), pointer :: current
     integer, dimension(:), allocatable :: tree_pdg
     ok = .true.
     allocate (tree_pdg (size (cascade%tree_pdg)))
     if (cascade%complete) then
        where (cascade%tree_mapping == INFRARED .or. &
             cascade%tree_mapping == COLLINEAR .or. &
             cascade%tree_mapping == T_CHANNEL .or. &
             cascade%tree_mapping == U_CHANNEL)
           tree_pdg = 0
        elsewhere
           tree_pdg = cascade%tree_pdg
        end where
     else
        tree_pdg = cascade%tree_pdg
     end if
     current => hash_entry%first
     do while (associated (current))
        if (current%cascade%depth == cascade%depth) then
           if (all (current%cascade%tree == cascade%tree)) then
              if (all (current%cascade%tree_mapping == cascade%tree_mapping)) &
                   then
                 if (all (current%cascade%tree_pdg .match. tree_pdg)) then
                    if (present (cascade_ptr))  cascade_ptr => current%cascade
                    ok = .false.;  return
                 end if
              end if
           end if
        end if
        current => current%next
     end do
     if (present (cascade_ptr))  cascade_ptr => cascade
   end subroutine hash_entry_check_cascade
 
 @ %def hash_entry_check_cascade
 @ For PDG codes, we specify that the undefined code matches any code.
 This is already defined for flavor objects, but here we need it for
 the codes themselves.
 <<Cascades: interfaces>>=
   interface operator(.match.)
      module procedure pdg_match
   end interface
 <<Cascades: procedures>>=
   elemental function pdg_match (pdg1, pdg2) result (flag)
     logical :: flag
     integer(TC), intent(in) :: pdg1, pdg2
     select case (pdg1)
     case (0)
        flag = .true.
     case default
        select case (pdg2)
        case (0)
           flag = .true.
        case default
           flag = pdg1 == pdg2
        end select
     end select
   end function pdg_match
 
 @ %def .match.
 @
 \subsection{The cascade set}
 The cascade set will later be transformed into the decay forest.  It
 is set up as a linked list.  In addition to the usual [[first]] and
 [[last]] pointers, there is a [[first_t]] pointer which points to the
 first t-channel cascade (after all s-channel cascades), and a
 [[first_k]] pointer which points to the first final cascade (with a
 keystone).
 
 As an auxiliary device, the object contains a hash array with
 associated parameters where an additional pointer is stored for each
 cascade.  The keys are made from the relevant cascade data.  This hash
 is used for fast detection (and thus avoidance) of double entries in
 the cascade list.
 <<Cascades: public>>=
   public :: cascade_set_t
 <<Cascades: types>>=
   type :: cascade_set_t
      private
      class(model_data_t), pointer :: model
      integer :: n_in, n_out, n_tot
      type(flavor_t), dimension(:,:), allocatable :: flv
      integer :: depth_out, depth_tot
      real(default) :: sqrts = 0
      real(default) :: m_threshold_s = 0
      real(default) :: m_threshold_t = 0
      integer :: off_shell = 0
      integer :: t_channel = 0
      logical :: keep_nonresonant
      integer :: n_groves = 0
      ! The cascade list
      type(cascade_t), pointer :: first => null ()
      type(cascade_t), pointer :: last => null ()
      type(cascade_t), pointer :: first_t => null ()
      type(cascade_t), pointer :: first_k => null ()
      ! The hashtable
      integer :: n_entries = 0
      real :: fill_ratio = 0
      integer :: n_entries_max = 0
      integer(i32) :: mask = 0
      logical :: fatal_beam_decay = .true.
      type(hash_entry_t), dimension(:), allocatable :: entry
   end type cascade_set_t
 
 @ %def cascade_set_t
 @
 <<Cascades: public>>=
   interface cascade_set_init
      module procedure cascade_set_init_base
      module procedure cascade_set_init_from_cascade
   end interface
 @ %def cascade_set_init
 @ This might be broken. Test before using.
 <<Cascades: procedures>>=
   subroutine cascade_set_init_from_cascade (cascade_set, cascade_set_in)
     type(cascade_set_t), intent(out) :: cascade_set
     type(cascade_set_t), intent(in), target :: cascade_set_in
     type(cascade_t), pointer :: casc_iter, casc_copy
     cascade_set%model => cascade_set_in%model
     cascade_set%n_in = cascade_set_in%n_in
     cascade_set%n_out = cascade_set_in%n_out
     cascade_set%n_tot = cascade_set_in%n_tot
     cascade_set%flv = cascade_set_in%flv
     cascade_set%depth_out = cascade_set_in%depth_out
     cascade_set%depth_tot = cascade_set_in%depth_tot
     cascade_set%sqrts = cascade_set_in%sqrts
     cascade_set%m_threshold_s = cascade_set_in%m_threshold_s
     cascade_set%m_threshold_t = cascade_set_in%m_threshold_t
     cascade_set%off_shell = cascade_set_in%off_shell
     cascade_set%t_channel = cascade_set_in%t_channel
     cascade_set%keep_nonresonant = cascade_set_in%keep_nonresonant
     cascade_set%n_groves = cascade_set_in%n_groves
 
     casc_iter => cascade_set_in%first
     do while (associated (casc_iter))
        allocate (casc_copy)
        casc_copy = casc_iter
        casc_copy%next => null ()
        if (associated (cascade_set%first)) then
           cascade_set%last%next => casc_copy
        else
           cascade_set%first => casc_copy
        end if
        cascade_set%last => casc_copy
        casc_iter => casc_iter%next
     end do
 
     cascade_set%n_entries = cascade_set_in%n_entries
     cascade_set%fill_ratio = cascade_set_in%fill_ratio
     cascade_set%n_entries_max = cascade_set_in%n_entries_max
     cascade_set%mask = cascade_set_in%mask
     cascade_set%fatal_beam_decay = cascade_set_in%fatal_beam_decay
     allocate (cascade_set%entry (0:cascade_set%mask))
     cascade_set%entry = cascade_set_in%entry
   end subroutine cascade_set_init_from_cascade
 
 @ %def cascade_set_init_from_cascade
 @ Return true if there are cascades which are active and complete, so
 the phase space file would be nonempty.
 <<Cascades: public>>=
   public :: cascade_set_is_valid
 <<Cascades: procedures>>=
   function cascade_set_is_valid (cascade_set) result (flag)
     logical :: flag
     type(cascade_set_t), intent(in) :: cascade_set
     type(cascade_t), pointer :: cascade
     flag = .false.
     cascade => cascade_set%first_k
     do while (associated (cascade))
        if (cascade%active .and. cascade%complete) then
           flag = .true.
           return
        end if
        cascade => cascade%next
     end do
   end function cascade_set_is_valid
 
 @ %def cascade_set_is_valid
 @ The initializer sets up the hash table with some initial size
 guessed by looking at the number of external particles.  We choose 256
 for 3 external particles and a factor of 4 for each additional
 particle, limited at $2^{30}$=1G.
 
 Note: the explicit initialization loop might be avoided (ELEMENTAL),
 but a bug in nagfor 5.3.2 prevents this.
 <<Cascades: parameters>>=
   real, parameter, public :: CASCADE_SET_FILL_RATIO = 0.1
 <<Cascades: procedures>>=
   subroutine cascade_set_init_base (cascade_set, model, n_in, n_out, phs_par, &
         fatal_beam_decay, flv)
     type(cascade_set_t), intent(out) :: cascade_set
     class(model_data_t), intent(in), target :: model
     integer, intent(in) :: n_in, n_out
     type(phs_parameters_t), intent(in) :: phs_par
     logical, intent(in) :: fatal_beam_decay
     type(flavor_t), dimension(:,:), intent(in), optional :: flv
     integer :: size_guess
     integer :: i, j
     cascade_set%model => model
     cascade_set%n_in = n_in
     cascade_set%n_out = n_out
     cascade_set%n_tot = n_in + n_out
     if (present (flv)) then
        allocate (cascade_set%flv (size (flv, 1), size (flv, 2)))
        do i = 1, size (flv, 2)
           do j = 1, size (flv, 1)
              call cascade_set%flv(j,i)%init (flv(j,i)%get_pdg (), model)
           end do
        end do
     end if
     select case (n_in)
     case (1);  cascade_set%depth_out = 2 * n_out - 3
     case (2);  cascade_set%depth_out = 2 * n_out - 1
     end select
     cascade_set%depth_tot = 2 * cascade_set%n_tot - 3
     cascade_set%sqrts = phs_par%sqrts
     cascade_set%m_threshold_s = phs_par%m_threshold_s
     cascade_set%m_threshold_t = phs_par%m_threshold_t
     cascade_set%off_shell = phs_par%off_shell
     cascade_set%t_channel = phs_par%t_channel
     cascade_set%keep_nonresonant = phs_par%keep_nonresonant
     cascade_set%fill_ratio = CASCADE_SET_FILL_RATIO
     size_guess = ishft (256, min (2 * (cascade_set%n_tot - 3), 22))
     cascade_set%n_entries_max = size_guess * cascade_set%fill_ratio
     cascade_set%mask = size_guess - 1
     allocate (cascade_set%entry (0:cascade_set%mask))
     cascade_set%fatal_beam_decay = fatal_beam_decay
   end subroutine cascade_set_init_base
 
 @ %def cascade_set_init_base
 @ The finalizer has to delete both the hash and the list.
 <<Cascades: public>>=
   public :: cascade_set_final
 <<Cascades: procedures>>=
   subroutine cascade_set_final (cascade_set)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), pointer :: current
     integer :: i
     if (allocated (cascade_set%entry)) then
        do i = 0, cascade_set%mask
           call hash_entry_final (cascade_set%entry(i))
        end do
        deallocate (cascade_set%entry)
     end if
     do while (associated (cascade_set%first))
        current => cascade_set%first
        cascade_set%first => cascade_set%first%next
        deallocate (current)
     end do
   end subroutine cascade_set_final
 
 @ %def cascade_set_final
 @ Write the process in ASCII format, in columns that are headed by the
 corresponding bincode.
 <<Cascades: public>>=
   public :: cascade_set_write_process_bincode_format
 <<Cascades: procedures>>=
   subroutine cascade_set_write_process_bincode_format (cascade_set, unit)
     type(cascade_set_t), intent(in), target :: cascade_set
     integer, intent(in), optional :: unit
     integer, dimension(:), allocatable :: bincode, field_width
     integer :: n_in, n_out, n_tot, n_flv
     integer :: u, f, i, bc
     character(20) :: str
     type(string_t) :: fmt_head
     type(string_t), dimension(:), allocatable :: fmt_proc
     u = given_output_unit (unit);  if (u < 0)  return
     if (.not. allocated (cascade_set%flv)) return
     write (u, "('!',1x,A)")  "List of subprocesses with particle bincodes:"
     n_in  = cascade_set%n_in
     n_out = cascade_set%n_out
     n_tot = cascade_set%n_tot
     n_flv = size (cascade_set%flv, 2)
     allocate (bincode (n_tot), field_width (n_tot), fmt_proc (n_tot))
     bc = 1
     do i = 1, n_out
        bincode(n_in + i) = bc
        bc = 2 * bc
     end do
     do i = n_in, 1, -1
        bincode(i) = bc
        bc = 2 * bc
     end do
     do i = 1, n_tot
        write (str, "(I0)")  bincode(i)
        field_width(i) = len_trim (str)
        do f = 1, n_flv
           field_width(i) = max (field_width(i), &
                len (cascade_set%flv(i,f)%get_name ()))
        end do
     end do
     fmt_head = "('!'"
     do i = 1, n_tot
        fmt_head = fmt_head // ",1x,"
        fmt_proc(i) = "(1x,"
        write (str, "(I0)")  field_width(i)
        fmt_head = fmt_head // "I" // trim(str)
        fmt_proc(i) = fmt_proc(i) // "A" // trim(str)
        if (i == n_in) then
           fmt_head = fmt_head // ",1x,'  '"
        end if
     end do
     do i = 1, n_tot
        fmt_proc(i) = fmt_proc(i) // ")"
     end do
     fmt_head = fmt_head // ")"
     write (u, char (fmt_head))  bincode
     do f = 1, n_flv
        write (u, "('!')", advance="no")
        do i = 1, n_tot
           write (u, char (fmt_proc(i)), advance="no") &
                char (cascade_set%flv(i,f)%get_name ())
           if (i == n_in)  write (u, "(1x,'=>')", advance="no")
        end do
        write (u, *)
     end do
     write (u, char (fmt_head))  bincode
   end subroutine cascade_set_write_process_bincode_format
 
 @ %def cascade_set_write_process_tex_format
 @ Write the process as a \LaTeX\ expression.
 <<Cascades: procedures>>=
   subroutine cascade_set_write_process_tex_format (cascade_set, unit)
     type(cascade_set_t), intent(in), target :: cascade_set
     integer, intent(in), optional :: unit
     integer :: u, f, i
     u = given_output_unit (unit);  if (u < 0)  return
     if (.not. allocated (cascade_set%flv)) return
     write (u, "(A)")  "\begin{align*}"
     do f = 1, size (cascade_set%flv, 2)
        do i = 1, cascade_set%n_in
           if (i > 1)  write (u, "(A)", advance="no") "\quad "
           write (u, "(A)", advance="no") &
                char (cascade_set%flv(i,f)%get_tex_name ())
        end do
        write (u, "(A)", advance="no")  "\quad &\to\quad "
        do i = cascade_set%n_in + 1, cascade_set%n_tot
           if (i > cascade_set%n_in + 1)  write (u, "(A)", advance="no") "\quad "
           write (u, "(A)", advance="no") &
                char (cascade_set%flv(i,f)%get_tex_name ())
        end do
        if (f < size (cascade_set%flv, 2)) then
           write (u, "(A)")  "\\"
        else
           write (u, "(A)")  ""
        end if
     end do
     write (u, "(A)")  "\end{align*}"
   end subroutine cascade_set_write_process_tex_format
 
 @ %def cascade_set_write_process_tex_format
 @ Three output routines: phase-space file, graph source code, and
 screen output.
 
 This version generates the phase space file.  It deals only with
 complete cascades.
 <<Cascades: public>>=
   public :: cascade_set_write_file_format
 <<Cascades: procedures>>=
   subroutine cascade_set_write_file_format (cascade_set, unit)
     type(cascade_set_t), intent(in), target :: cascade_set
     integer, intent(in), optional :: unit
     type(cascade_t), pointer :: cascade
     integer :: u, grove, count
     logical :: first_in_grove
     u = given_output_unit (unit);  if (u < 0)  return
     count = 0
     do grove = 1, cascade_set%n_groves
        first_in_grove = .true.
        cascade => cascade_set%first_k
        do while (associated (cascade))
           if (cascade%active .and. cascade%complete) then
              if (cascade%grove == grove) then
                 if (first_in_grove) then
                    first_in_grove = .false.
                    write (u, "(A)")
                    write (u, "(1x,'!',1x,A,1x,I0,A)", advance='no') &
                       'Multiplicity =', cascade%multiplicity, ","
                    select case (cascade%n_resonances)
                    case (0)
                       write (u, '(1x,A)', advance='no') 'no resonances, '
                    case (1)
                       write (u, '(1x,A)', advance='no') '1 resonance,  '
                    case default
                       write (u, '(1x,I0,1x,A)', advance='no') &
                            cascade%n_resonances, 'resonances, '
                    end select
                    write (u, '(1x,I0,1x,A)', advance='no') &
                         cascade%n_log_enhanced, 'logs, '
                    write (u, '(1x,I0,1x,A)', advance='no') &
                         cascade%n_off_shell, 'off-shell, '
                    select case (cascade%n_t_channel)
                    case (0);  write (u, '(1x,A)') 's-channel graph'
                    case (1);  write (u, '(1x,A)') '1 t-channel line'
                    case default
                       write(u,'(1x,I0,1x,A)') &
                            cascade%n_t_channel, 't-channel lines'
                    end select
                    write (u, '(1x,A,I0)') 'grove #', grove
                 end if
                 count = count + 1
                 write (u, "(1x,'!',1x,A,I0)")  "Channel #", count
                 call cascade_write_file_format (cascade, cascade_set%model, u)
              end if
           end if
           cascade => cascade%next
        end do
     end do
   end subroutine cascade_set_write_file_format
 
 @ %def cascade_set_write_file_format
 @ This is the graph output format, the driver-file
 <<Cascades: public>>=
   public :: cascade_set_write_graph_format
 <<Cascades: procedures>>=
   subroutine cascade_set_write_graph_format &
       (cascade_set, filename, process_id, unit)
     type(cascade_set_t), intent(in), target :: cascade_set
     type(string_t), intent(in) :: filename, process_id
     integer, intent(in), optional :: unit
     type(cascade_t), pointer :: cascade
     integer :: u, grove, count, pgcount
     logical :: first_in_grove
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, '(A)') "\documentclass[10pt]{article}"
     write (u, '(A)') "\usepackage{amsmath}"
     write (u, '(A)') "\usepackage{feynmp}"
     write (u, '(A)') "\usepackage{url}"
     write (u, '(A)') "\usepackage{color}"
     write (u, *)
     write (u, '(A)') "\textwidth 18.5cm"
     write (u, '(A)') "\evensidemargin -1.5cm"
     write (u, '(A)') "\oddsidemargin -1.5cm"
     write (u, *)
     write (u, '(A)') "\newcommand{\blue}{\color{blue}}"
     write (u, '(A)') "\newcommand{\green}{\color{green}}"
     write (u, '(A)') "\newcommand{\red}{\color{red}}"
     write (u, '(A)') "\newcommand{\magenta}{\color{magenta}}"
     write (u, '(A)') "\newcommand{\cyan}{\color{cyan}}"
     write (u, '(A)') "\newcommand{\sm}{\footnotesize}"
     write (u, '(A)') "\setlength{\parindent}{0pt}"
     write (u, '(A)') "\setlength{\parsep}{20pt}"
     write (u, *)
     write (u, '(A)') "\begin{document}"
     write (u, '(A)') "\begin{fmffile}{" // char (filename) // "}"
     write (u, '(A)') "\fmfcmd{color magenta; magenta = red + blue;}"
     write (u, '(A)') "\fmfcmd{color cyan; cyan = green + blue;}"
     write (u, '(A)') "\begin{fmfshrink}{0.5}"
     write (u, '(A)') "\begin{flushleft}"
     write (u, *)
     write (u, '(A)') "\noindent" // &
          & "\textbf{\large\texttt{WHIZARD} phase space channels}" // &
          & "\hfill\today"
     write (u, *)
     write (u, '(A)') "\vspace{10pt}"
     write (u, '(A)') "\noindent" // &
          & "\textbf{Process:} \url{" // char (process_id) // "}"
     call cascade_set_write_process_tex_format (cascade_set, u)
     write (u, *)
     write (u, '(A)') "\noindent" // &
          & "\textbf{Note:} These are pseudo Feynman graphs that "
     write (u, '(A)') "visualize phase-space parameterizations " // &
          & "(``integration channels'').  "
     write (u, '(A)') "They do \emph{not} indicate Feynman graphs used for the " // &
          & "matrix element."
     write (u, *)
     write (u, '(A)') "\textbf{Color code:} " // &
          & "{\blue resonance,} " // &
          & "{\cyan t-channel,} " // &
          & "{\green radiation,} "
     write (u, '(A)') "{\red infrared,} " // &
          & "{\magenta collinear,} " // &
          & "external/off-shell"
     write (u, *)
     write (u, '(A)') "\noindent" // &
          & "\textbf{Black square:} Keystone, indicates ordering of " // &
          & "phase space parameters."
     write (u, *)
     write (u, '(A)') "\vspace{-20pt}"
     count = 0
     pgcount = 0
     do grove = 1, cascade_set%n_groves
        first_in_grove = .true.
        cascade => cascade_set%first
        do while (associated (cascade))
           if (cascade%active .and. cascade%complete) then
              if (cascade%grove == grove) then
                 if (first_in_grove) then
                    first_in_grove = .false.
                    write (u, *)
                    write (u, '(A)') "\vspace{20pt}"
                    write (u, '(A)') "\begin{tabular}{l}"
                    write (u, '(A,I5,A)') &
                         & "\fbox{\bf Grove \boldmath$", grove, "$} \\[10pt]"
                    write (u, '(A,I1,A)') "Multiplicity: ", &
                         cascade%multiplicity, "\\"
                    write (u, '(A,I1,A)') "Resonances:   ", &
                         cascade%n_resonances, "\\"
                    write (u, '(A,I1,A)') "Log-enhanced: ", &
                         cascade%n_log_enhanced, "\\"
                    write (u, '(A,I1,A)') "Off-shell:    ", &
                         cascade%n_off_shell, "\\"
                    write (u, '(A,I1,A)') "t-channel:    ", &
                         cascade%n_t_channel, ""
                    write (u, '(A)') "\end{tabular}"
                 end if
                 count = count + 1
                 call cascade_write_graph_format (cascade, count, unit)
                 if (pgcount >= 250) then
                    write (u, '(A)') "\clearpage"
                    pgcount = 0
                 end if
              end if
           end if
           cascade => cascade%next
        end do
     end do
     write (u, '(A)') "\end{flushleft}"
     write (u, '(A)') "\end{fmfshrink}"
     write (u, '(A)') "\end{fmffile}"
     write (u, '(A)') "\end{document}"
  end subroutine cascade_set_write_graph_format
 
 @ %def cascade_set_write_graph_format
 @ This is for screen output and debugging:
 <<Cascades: public>>=
   public :: cascade_set_write
 <<Cascades: procedures>>=
   subroutine cascade_set_write (cascade_set, unit, active_only, complete_only)
     type(cascade_set_t), intent(in), target :: cascade_set
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: active_only, complete_only
     logical :: active, complete
     type(cascade_t), pointer :: cascade
     integer :: u, i
     u = given_output_unit (unit);  if (u < 0)  return
     active = .true.;  if (present (active_only))  active = active_only
     complete = .false.;  if (present (complete_only))  complete = complete_only
     write (u, "(A)") "Cascade set:"
     write (u, "(3x,A)", advance="no")  "Model:"
     if (associated (cascade_set%model)) then
        write (u, "(1x,A)") char (cascade_set%model%get_name ())
     else
        write (u, "(1x,A)") "[none]"
     end if
     write (u, "(3x,A)", advance="no")  "n_in/out/tot  ="
     write (u, "(3(1x,I7))")  &
          cascade_set%n_in, cascade_set%n_out, cascade_set%n_tot
     write (u, "(3x,A)", advance="no")  "depth_out/tot ="
     write (u, "(2(1x,I7))")  cascade_set%depth_out, cascade_set%depth_tot
     write (u, "(3x,A)", advance="no")  "mass thr(s/t) ="
     write (u, "(2(1x," // FMT_19 // "))")  &
          cascade_set%m_threshold_s, cascade_set%m_threshold_t
     write (u, "(3x,A)", advance="no")  "off shell     ="
     write (u, "(1x,I7)")  cascade_set%off_shell
     write (u, "(3x,A)", advance="no")  "keep_nonreson ="
     write (u, "(1x,L1)")  cascade_set%keep_nonresonant
     write (u, "(3x,A)", advance="no")  "n_groves      ="
     write (u, "(1x,I7)")  cascade_set%n_groves
     write (u, "(A)")
     write (u, "(A)") "Cascade list:"
     if (associated (cascade_set%first)) then
        cascade => cascade_set%first
        do while (associated (cascade))
           if (active .and. .not. cascade%active)  cycle
           if (complete .and. .not. cascade%complete)  cycle
           call cascade_write (cascade, unit)
           cascade => cascade%next
        end do
     else
        write (u, "(A)") "[empty]"
     end if
     write (u, "(A)") "Hash array"
     write (u, "(3x,A)", advance="no")  "n_entries     ="
     write (u, "(1x,I7)")  cascade_set%n_entries
     write (u, "(3x,A)", advance="no")  "fill_ratio    ="
     write (u, "(1x," // FMT_12 // ")")  cascade_set%fill_ratio
     write (u, "(3x,A)", advance="no")  "n_entries_max ="
     write (u, "(1x,I7)")  cascade_set%n_entries_max
     write (u, "(3x,A)", advance="no")  "mask          ="
     write (u, "(1x,I0)")  cascade_set%mask
     do i = 0, ubound (cascade_set%entry, 1)
        if (allocated (cascade_set%entry(i)%key)) then
           write (u, "(1x,I7)") i
           call hash_entry_write (cascade_set%entry(i), u)
        end if
     end do
   end subroutine cascade_set_write
 
 @ %def cascade_set_write
 @
 \subsection{Adding cascades}
 Add a deep copy of a cascade to the set.  The copy has all content of the
 original, but the pointers are nullified.  We do not care whether insertion
 was successful or not.  The pointer argument, if present, is assigned to the
 input cascade, or to the hash entry if it is already present.
 
 The procedure is recursive: any daughter or mother entries are also
 deep-copied and added to the cascade set before the current copy is added.
 <<Cascades: procedures>>=
   recursive subroutine cascade_set_add_copy &
        (cascade_set, cascade_in, cascade_ptr)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), intent(in) :: cascade_in
     type(cascade_t), optional, pointer :: cascade_ptr
     type(cascade_t), pointer :: cascade
     logical :: ok
     allocate (cascade)
     cascade = cascade_in
     if (associated (cascade_in%daughter1))  call cascade_set_add_copy &
          (cascade_set, cascade_in%daughter1, cascade%daughter1)
     if (associated (cascade_in%daughter2))  call cascade_set_add_copy &
          (cascade_set, cascade_in%daughter2, cascade%daughter2)
     if (associated (cascade_in%mother))  call cascade_set_add_copy &
          (cascade_set, cascade_in%mother, cascade%mother)
     cascade%next => null ()
     call cascade_set_add (cascade_set, cascade, ok, cascade_ptr)
     if (.not. ok)  deallocate (cascade)
   end subroutine cascade_set_add_copy
 
 @ %def cascade_set_add_copy
 @ Add a cascade to the set.  This does not deep-copy.  We first try to insert
 it in the hash array.  If successful, add it to the list.  Failure indicates
 that it is already present, and we drop it.
 
 The hash key is built solely from the tree array, so neither particle
 codes nor resonances count, just topology.
 
 Technically, hash and list receive only pointers, so the cascade can
 be considered as being in either of both.  We treat it as part of the
 list.
 <<Cascades: procedures>>=
   subroutine cascade_set_add (cascade_set, cascade, ok, cascade_ptr)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), intent(in), target :: cascade
     logical, intent(out) :: ok
     type(cascade_t), optional, pointer :: cascade_ptr
     integer(i8), dimension(1) :: mold
     call cascade_set_hash_insert &
          (cascade_set, transfer (cascade%tree, mold), cascade, ok, cascade_ptr)
     if (ok)  call cascade_set_list_add (cascade_set, cascade)
   end subroutine cascade_set_add
 
 @ %def cascade_set_add
 @ Add a new cascade to the list:
 <<Cascades: procedures>>=
   subroutine cascade_set_list_add (cascade_set, cascade)
     type(cascade_set_t), intent(inout) :: cascade_set
     type(cascade_t), intent(in), target :: cascade
     if (associated (cascade_set%last)) then
        cascade_set%last%next => cascade
     else
        cascade_set%first => cascade
     end if
     cascade_set%last => cascade
   end subroutine cascade_set_list_add
 
 @ %def cascade_set_list_add
 @ Add a cascade entry to the hash array:
 <<Cascades: procedures>>=
   subroutine cascade_set_hash_insert &
        (cascade_set, key, cascade, ok, cascade_ptr)
     type(cascade_set_t), intent(inout), target :: cascade_set
     integer(i8), dimension(:), intent(in) :: key
     type(cascade_t), intent(in), target :: cascade
     logical, intent(out) :: ok
     type(cascade_t), optional, pointer :: cascade_ptr
     integer(i32) :: h
     if (cascade_set%n_entries >= cascade_set%n_entries_max) &
          call cascade_set_hash_expand (cascade_set)
     h = hash (key)
     call cascade_set_hash_insert_rec &
          (cascade_set, h, h, key, cascade, ok, cascade_ptr)
   end subroutine cascade_set_hash_insert
 
 @ %def cascade_set_hash_insert
 @ Double the hashtable size when necesssary:
 <<Cascades: procedures>>=
   subroutine cascade_set_hash_expand (cascade_set)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(hash_entry_t), dimension(:), allocatable, target :: table_tmp
     type(cascade_p), pointer :: current
     integer :: i, s
     allocate (table_tmp (0:cascade_set%mask))
     table_tmp = cascade_set%entry
     deallocate (cascade_set%entry)
     s = 2 * size (table_tmp)
     cascade_set%n_entries = 0
     cascade_set%n_entries_max = s * cascade_set%fill_ratio
     cascade_set%mask = s - 1
     allocate (cascade_set%entry (0:cascade_set%mask))
     do i = 0, ubound (table_tmp, 1)
        current => table_tmp(i)%first
        do while (associated (current))
           call cascade_set_hash_insert_rec &
                (cascade_set, table_tmp(i)%hashval, table_tmp(i)%hashval, &
                 table_tmp(i)%key, current%cascade)
           current => current%next
        end do
     end do
   end subroutine cascade_set_hash_expand
 
 @ %def cascade_set_hash_expand
 @ Insert the cascade at the bucket determined by the hash value.  If
 the bucket is filled, check first for a collision (unequal keys).  In
 that case, choose the following bucket and repeat.  Otherwise, add the
 cascade to the bucket.
 
 If the bucket is empty, record the hash value, allocate and store the
 key, and then add the cascade to the bucket.
 
 If [[ok]] is present, before insertion we check whether the cascade is
 already stored, and return failure if yes.
 <<Cascades: procedures>>=
   recursive subroutine cascade_set_hash_insert_rec &
        (cascade_set, h, hashval, key, cascade, ok, cascade_ptr)
     type(cascade_set_t), intent(inout) :: cascade_set
     integer(i32), intent(in) :: h, hashval
     integer(i8), dimension(:), intent(in) :: key
     type(cascade_t), intent(in), target :: cascade
     logical, intent(out), optional :: ok
     type(cascade_t), optional, pointer :: cascade_ptr
     integer(i32) :: i
     i = iand (h, cascade_set%mask)
     if (allocated (cascade_set%entry(i)%key)) then
        if (size (cascade_set%entry(i)%key) /= size (key)) then
           call cascade_set_hash_insert_rec &
                (cascade_set, h + 1, hashval, key, cascade, ok, cascade_ptr)
        else if (any (cascade_set%entry(i)%key /= key)) then
           call cascade_set_hash_insert_rec &
                (cascade_set, h + 1, hashval, key, cascade, ok, cascade_ptr)
        else
           call hash_entry_add_cascade_ptr &
                (cascade_set%entry(i), cascade, ok, cascade_ptr)
        end if
     else
        cascade_set%entry(i)%hashval = hashval
        allocate (cascade_set%entry(i)%key (size (key)))
        cascade_set%entry(i)%key = key
        call hash_entry_add_cascade_ptr &
             (cascade_set%entry(i), cascade, ok, cascade_ptr)
        cascade_set%n_entries = cascade_set%n_entries + 1
     end if
   end subroutine cascade_set_hash_insert_rec
 
 @ %def cascade_set_hash_insert_rec
 @
 \subsection{External particles}
 We want to initialize the cascade set with the outgoing particles.  In
 case of multiple processes, initial cascades are prepared for all of
 them.  The hash array check ensures that no particle appears more than
 once at the same place.
 <<Cascades: interfaces>>=
   interface cascade_set_add_outgoing
      module procedure cascade_set_add_outgoing1
      module procedure cascade_set_add_outgoing2
   end interface
 
 <<Cascades: procedures>>=
   subroutine cascade_set_add_outgoing2 (cascade_set, flv)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(flavor_t), dimension(:,:), intent(in) :: flv
     integer :: pos, prc, n_out, n_prc
     type(cascade_t), pointer :: cascade
     logical :: ok
     n_out = size (flv, dim=1)
     n_prc = size (flv, dim=2)
     do prc = 1, n_prc
        do pos = 1, n_out
           allocate (cascade)
           call cascade_init_outgoing &
                (cascade, flv(pos,prc), pos, cascade_set%m_threshold_s)
           call cascade_set_add (cascade_set, cascade, ok)
           if (.not. ok) then
              deallocate (cascade)
           end if
        end do
     end do
   end subroutine cascade_set_add_outgoing2
 
   subroutine cascade_set_add_outgoing1 (cascade_set, flv)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(flavor_t), dimension(:), intent(in) :: flv
     integer :: pos, n_out
     type(cascade_t), pointer :: cascade
     logical :: ok
     n_out = size (flv, dim=1)
     do pos = 1, n_out
        allocate (cascade)
        call cascade_init_outgoing &
             (cascade, flv(pos), pos, cascade_set%m_threshold_s)
        call cascade_set_add (cascade_set, cascade, ok)
        if (.not. ok) then
           deallocate (cascade)
        end if
     end do
   end subroutine cascade_set_add_outgoing1
 
 @ %def cascade_set_add_outgoing
 @ The incoming particles are added one at a time.  Nevertheless, we
 may have several processes which are looped over.  At the first
 opportunity, we set the pointer [[first_t]] in the cascade set which
 should point to the first t-channel cascade.
 
 Return the indices of the first and last cascade generated.
 <<Cascades: interfaces>>=
   interface cascade_set_add_incoming
      module procedure cascade_set_add_incoming0
      module procedure cascade_set_add_incoming1
   end interface
 
 <<Cascades: procedures>>=
   subroutine cascade_set_add_incoming1 (cascade_set, n1, n2, pos, flv)
     type(cascade_set_t), intent(inout), target :: cascade_set
     integer, intent(out) :: n1, n2
     integer, intent(in) :: pos
     type(flavor_t), dimension(:), intent(in) :: flv
     integer :: prc, n_prc
     type(cascade_t), pointer :: cascade
     logical :: ok
     n1 = 0
     n2 = 0
     n_prc = size (flv)
     do prc = 1, n_prc
        allocate (cascade)
        call cascade_init_incoming &
             (cascade, flv(prc), pos, cascade_set%m_threshold_t)
        call cascade_set_add (cascade_set, cascade, ok)
        if (ok) then
           if (n1 == 0)  n1 = cascade%index
           n2 = cascade%index
           if (.not. associated (cascade_set%first_t)) then
              cascade_set%first_t => cascade
           end if
        else
           deallocate (cascade)
        end if
     end do
   end subroutine cascade_set_add_incoming1
 
   subroutine cascade_set_add_incoming0 (cascade_set, n1, n2, pos, flv)
     type(cascade_set_t), intent(inout), target :: cascade_set
     integer, intent(out) :: n1, n2
     integer, intent(in) :: pos
     type(flavor_t), intent(in) :: flv
     type(cascade_t), pointer :: cascade
     logical :: ok
     n1 = 0
     n2 = 0
     allocate (cascade)
     call cascade_init_incoming &
          (cascade, flv, pos, cascade_set%m_threshold_t)
     call cascade_set_add (cascade_set, cascade, ok)
     if (ok) then
        if (n1 == 0)  n1 = cascade%index
        n2 = cascade%index
        if (.not. associated (cascade_set%first_t)) then
           cascade_set%first_t => cascade
        end if
     else
        deallocate (cascade)
     end if
   end subroutine cascade_set_add_incoming0
 
 @ %def cascade_set_add_incoming
 @
 \subsection{Cascade combination I: flavor assignment}
 We have two disjunct cascades, now use the vertex table to determine
 the possible flavors of the combination cascade.  For each
 possibility, try to generate a new cascade.  The total cascade depth
 has to be one less than the limit, because this is reached by setting
 the keystone.
 <<Cascades: procedures>>=
   subroutine cascade_match_pair (cascade_set, cascade1, cascade2, s_channel)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), intent(in), target :: cascade1, cascade2
     logical, intent(in) :: s_channel
     integer, dimension(:), allocatable :: pdg3
     integer :: i, depth_max
     type(flavor_t) :: flv
     if (s_channel) then
        depth_max = cascade_set%depth_out
     else
        depth_max = cascade_set%depth_tot
     end if
     if (cascade1%depth + cascade2%depth < depth_max) then
        call cascade_set%model%match_vertex ( &
             cascade1%flv%get_pdg (), &
             cascade2%flv%get_pdg (), &
             pdg3)
        do i = 1, size (pdg3)
           call flv%init (pdg3(i), cascade_set%model)
           if (s_channel) then
              call cascade_combine_s (cascade_set, cascade1, cascade2, flv)
           else
              call cascade_combine_t (cascade_set, cascade1, cascade2, flv)
           end if
        end do
        deallocate (pdg3)
     end if
   end subroutine cascade_match_pair
 
 @ %def cascade_match_pair
 @ The triplet version takes a third cascade, and we check whether this
 triplet has a matching vertex in the database.  If yes, we make a
 keystone cascade.
 <<Cascades: procedures>>=
   subroutine cascade_match_triplet &
        (cascade_set, cascade1, cascade2, cascade3, s_channel)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), intent(in), target :: cascade1, cascade2, cascade3
     logical, intent(in) :: s_channel
     integer :: depth_max
     depth_max = cascade_set%depth_tot
     if (cascade1%depth + cascade2%depth + cascade3%depth == depth_max) then
        if (cascade_set%model%check_vertex ( &
             cascade1%flv%get_pdg (), &
             cascade2%flv%get_pdg (), &
             cascade3%flv%get_pdg ())) then
           call cascade_combine_keystone &
                (cascade_set, cascade1, cascade2, cascade3, s_channel)
        end if
     end if
   end subroutine cascade_match_triplet
 
 @ %def cascade_match_triplet
 @
 \subsection{Cascade combination II: kinematics setup and check}
 Having three matching flavors, we start constructing the combination
 cascade.  We look at the mass hierarchies and determine whether the
 cascade is to be kept.  In passing we set mapping modes, resonance
 properties and such.
 
 If successful, the cascade is finalized.  For a resonant cascade, we
 prepare in addition a copy without the resonance.
 <<Cascades: procedures>>=
   subroutine cascade_combine_s (cascade_set, cascade1, cascade2, flv)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), intent(in), target :: cascade1, cascade2
     type(flavor_t), intent(in) :: flv
     type(cascade_t), pointer :: cascade3, cascade4
     logical :: keep
     keep = .false.
     allocate (cascade3)
     call cascade_init (cascade3, cascade1%depth + cascade2%depth + 1)
     cascade3%bincode = ior (cascade1%bincode, cascade2%bincode)
     cascade3%flv = flv%anti ()
     cascade3%pdg = cascade3%flv%get_pdg ()
     cascade3%is_vector = flv%get_spin_type () == VECTOR
     cascade3%m_min = cascade1%m_min + cascade2%m_min
     cascade3%m_rea = flv%get_mass ()
     if (cascade3%m_rea > cascade_set%m_threshold_s) then
        cascade3%m_eff = cascade3%m_rea
     end if
     ! Potentially resonant cases [sqrts = m_rea for on-shell decay]
     if (cascade3%m_rea > cascade3%m_min &
          .and. cascade3%m_rea <= cascade_set%sqrts) then
        if (flv%get_width () /= 0) then
           if (cascade1%on_shell .or. cascade2%on_shell) then
              keep = .true.
              cascade3%mapping = S_CHANNEL
              cascade3%resonant = .true.
           end if
        else
           call warn_decay (flv)
        end if
     ! Collinear and IR singular cases
     else if (cascade3%m_rea < cascade_set%sqrts) then
        ! Massless splitting
        if (cascade1%m_eff == 0 .and. cascade2%m_eff == 0 &
             .and. cascade3%depth <= 3) then
           keep = .true.
           cascade3%log_enhanced = .true.
           if (cascade3%is_vector) then
              if (cascade1%is_vector .and. cascade2%is_vector) then
                 cascade3%mapping = COLLINEAR   ! three-vector-vertex
              else
                 cascade3%mapping = INFRARED    ! vector splitting into matter
              end if
           else
              if (cascade1%is_vector .or. cascade2%is_vector) then
                 cascade3%mapping = COLLINEAR   ! vector radiation off matter
              else
                 cascade3%mapping = INFRARED    ! scalar radiation/splitting
              end if
           end if
        ! IR radiation off massive particle
        else if (cascade3%m_eff > 0 .and. cascade1%m_eff > 0 &
             .and. cascade2%m_eff == 0 &
             .and. (cascade1%on_shell .or. cascade1%mapping == RADIATION) &
             .and. abs (cascade3%m_eff - cascade1%m_eff) &
                        < cascade_set%m_threshold_s) &
             then
           keep = .true.
           cascade3%log_enhanced = .true.
           cascade3%mapping = RADIATION
        else if (cascade3%m_eff > 0 .and. cascade2%m_eff > 0 &
             .and. cascade1%m_eff == 0 &
             .and. (cascade2%on_shell .or. cascade2%mapping == RADIATION) &
             .and. abs (cascade3%m_eff - cascade2%m_eff) &
                   < cascade_set%m_threshold_s) &
             then
           keep = .true.
           cascade3%log_enhanced = .true.
           cascade3%mapping = RADIATION
        end if
     end if
     ! Non-singular cases, including failed resonances
     if (.not. keep) then
        ! Two on-shell particles from a virtual mother
        if (cascade1%on_shell .or. cascade2%on_shell) then
           keep = .true.
           cascade3%m_eff = max (cascade3%m_min, &
                                 cascade1%m_eff + cascade2%m_eff)
           if (cascade3%m_eff < cascade_set%m_threshold_s) then
              cascade3%m_eff = 0
           end if
        end if
     end if
     ! Complete and register the cascade (two in case of resonance)
     if (keep) then
        cascade3%on_shell = cascade3%resonant .or. cascade3%log_enhanced
        if (cascade3%resonant) then
           cascade3%pdg = cascade3%flv%get_pdg ()
           if (cascade_set%keep_nonresonant) then
              allocate (cascade4)
              cascade4 = cascade3
              cascade4%index = cascade_index ()
              cascade4%pdg = UNDEFINED
              cascade4%mapping = NO_MAPPING
              cascade4%resonant = .false.
              cascade4%on_shell = .false.
           end if
           cascade3%m_min = cascade3%m_rea
           call cascade_fusion (cascade_set, cascade1, cascade2, cascade3)
           if (cascade_set%keep_nonresonant) then
              call cascade_fusion (cascade_set, cascade1, cascade2, cascade4)
           end if
        else
           call cascade_fusion (cascade_set, cascade1, cascade2, cascade3)
        end if
     else
        deallocate (cascade3)
     end if
   contains
     subroutine warn_decay (flv)
       type(flavor_t), intent(in) :: flv
       integer :: i
       integer, dimension(MAX_WARN_RESONANCE), save :: warned_code = 0
       LOOP_WARNED: do i = 1, MAX_WARN_RESONANCE
          if (warned_code(i) == 0) then
             warned_code(i) = flv%get_pdg ()
             write (msg_buffer, "(A)") &
                  & " Intermediate decay of zero-width particle " &
                  & // char (flv%get_name ()) &
                  & // " may be possible."
             call msg_warning
             exit LOOP_WARNED
          else if (warned_code(i) == flv%get_pdg ()) then
             exit LOOP_WARNED
          end if
       end do LOOP_WARNED
     end subroutine warn_decay
   end subroutine cascade_combine_s
 
 @ %def cascade_combine_s
 <<Cascades: parameters>>=
   integer, parameter, public :: MAX_WARN_RESONANCE = 50
 @ %def MAX_WARN_RESONANCE
 @ This is the t-channel version.  [[cascade1]] is t-channel and
 contains the seed, [[cascade2]] is s-channel.  We check for
 kinematically allowed beam decay (which is a fatal error), or massless
 splitting / soft radiation.  The cascade is kept in all remaining
 cases and submitted for registration.
 <<Cascades: procedures>>=
   subroutine cascade_combine_t (cascade_set, cascade1, cascade2, flv)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), intent(in), target :: cascade1, cascade2
     type(flavor_t), intent(in) :: flv
     type(cascade_t), pointer :: cascade3
     allocate (cascade3)
     call cascade_init (cascade3, cascade1%depth + cascade2%depth + 1)
     cascade3%bincode = ior (cascade1%bincode, cascade2%bincode)
     cascade3%flv = flv%anti ()
     cascade3%pdg = abs (cascade3%flv%get_pdg ())
     cascade3%is_vector = flv%get_spin_type () == VECTOR
     if (cascade1%incoming) then
        cascade3%m_min = cascade2%m_min
     else
        cascade3%m_min = cascade1%m_min + cascade2%m_min
     end if
     cascade3%m_rea = flv%get_mass ()
     if (cascade3%m_rea > cascade_set%m_threshold_t) then
        cascade3%m_eff = max (cascade3%m_rea, cascade2%m_eff)
     else if (cascade2%m_eff > cascade_set%m_threshold_t) then
        cascade3%m_eff = cascade2%m_eff
     else
        cascade3%m_eff = 0
     end if
     ! Allowed decay of beam particle
     if (cascade1%incoming &
          .and. cascade1%m_rea > cascade2%m_rea + cascade3%m_rea) then
          call beam_decay (cascade_set%fatal_beam_decay)
     ! Massless splitting
     else if (cascade1%m_eff == 0 &
          .and. cascade2%m_eff < cascade_set%m_threshold_t &
          .and. cascade3%m_eff == 0) then
        cascade3%mapping = U_CHANNEL
        cascade3%log_enhanced = .true.
     ! IR radiation off massive particle
     else if (cascade1%m_eff /= 0 .and. cascade2%m_eff == 0 &
          .and. cascade3%m_eff /= 0 &
          .and. (cascade1%on_shell .or. cascade1%mapping == RADIATION) &
          .and. abs (cascade1%m_eff - cascade3%m_eff) &
                < cascade_set%m_threshold_t) &
          then
        cascade3%pdg = flv%get_pdg ()
        cascade3%log_enhanced = .true.
        cascade3%mapping = RADIATION
     end if
     cascade3%t_channel = .true.
     call cascade_fusion (cascade_set, cascade1, cascade2, cascade3)
   contains
     subroutine beam_decay (fatal_beam_decay)
       logical, intent(in) :: fatal_beam_decay
       write (msg_buffer, "(1x,A,1x,'->',1x,A,1x,A)") &
            char (cascade1%flv%get_name ()), &
            char (cascade3%flv%get_name ()), &
            char (cascade2%flv%get_name ())
       call msg_message
       write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
            char (cascade1%flv%get_name ()), cascade1%m_rea
       call msg_message
       write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
            char (cascade3%flv%get_name ()), cascade3%m_rea
       call msg_message
       write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
            char (cascade2%flv%get_name ()), cascade2%m_rea
       call msg_message
       if (fatal_beam_decay) then
          call msg_fatal (" Phase space: Initial beam particle can decay")
       else
          call msg_warning (" Phase space: Initial beam particle can decay")
       end if
     end subroutine beam_decay
   end subroutine cascade_combine_t
 
 @ %def cascade_combine_t
 @ Here we complete a decay cascade.  The third input is the
 single-particle cascade for the initial particle.  There is no
 resonance or mapping assignment.  The only condition for keeping the
 cascade is the mass sum of the final state, which must be less than
 the available energy.
 
 Two modifications are necessary for scattering cascades: a pure
 s-channel diagram (cascade1 is the incoming particle) do not have a
 logarithmic mapping at top-level.  And in a t-channel diagram, the
 last line exchanged is mapped t-channel, not u-channel.  Finally, we
 can encounter the case of a $2\to 1$ process, where cascade1 is
 incoming, and cascade2 is the outgoing particle.  In all three cases
 we register a new cascade with the modified mapping.
 <<Cascades: procedures>>=
   subroutine cascade_combine_keystone &
        (cascade_set, cascade1, cascade2, cascade3, s_channel)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), intent(in), target :: cascade1, cascade2, cascade3
     logical, intent(in) :: s_channel
     type(cascade_t), pointer :: cascade4, cascade0
     logical :: keep, ok
     keep = .false.
     allocate (cascade4)
     call cascade_init &
          (cascade4, cascade1%depth + cascade2%depth + cascade3%depth)
     cascade4%complete = .true.
     if (s_channel) then
        cascade4%bincode = ior (cascade1%bincode, cascade2%bincode)
     else
        cascade4%bincode = cascade3%bincode
     end if
     cascade4%flv = cascade3%flv
     cascade4%pdg = cascade3%pdg
     cascade4%mapping = EXTERNAL_PRT
     cascade4%is_vector = cascade3%is_vector
     cascade4%m_min = cascade1%m_min + cascade2%m_min
     cascade4%m_rea = cascade3%m_rea
     cascade4%m_eff = cascade3%m_rea
     if (cascade4%m_min < cascade_set%sqrts) then
        keep = .true.
     end if
     if (keep) then
        if (cascade1%incoming .and. cascade2%log_enhanced) then
           allocate (cascade0)
           cascade0 = cascade2
           cascade0%next => null ()
           cascade0%index = cascade_index ()
           cascade0%mapping = NO_MAPPING
           cascade0%log_enhanced = .false.
           cascade0%n_log_enhanced = cascade0%n_log_enhanced - 1
           cascade0%tree_mapping(cascade0%depth) = NO_MAPPING
           call cascade_keystone &
                (cascade_set, cascade1, cascade0, cascade3, cascade4, ok)
           if (ok) then
              call cascade_set_add (cascade_set, cascade0, ok)
           else
              deallocate (cascade0)
           end if
        else if (cascade1%t_channel .and. cascade1%mapping == U_CHANNEL) then
           allocate (cascade0)
           cascade0 = cascade1
           cascade0%next => null ()
           cascade0%index = cascade_index ()
           cascade0%mapping = T_CHANNEL
           cascade0%tree_mapping(cascade0%depth) = T_CHANNEL
           call cascade_keystone &
                (cascade_set, cascade0, cascade2, cascade3, cascade4, ok)
           if (ok) then
              call cascade_set_add (cascade_set, cascade0, ok)
           else
              deallocate (cascade0)
           end if
        else if (cascade1%incoming .and. cascade2%depth == 1) then
           allocate (cascade0)
           cascade0 = cascade2
           cascade0%next => null ()
           cascade0%index = cascade_index ()
           cascade0%mapping = ON_SHELL
           cascade0%tree_mapping(cascade0%depth) = ON_SHELL
           call cascade_keystone &
                (cascade_set, cascade1, cascade0, cascade3, cascade4, ok)
           if (ok) then
              call cascade_set_add (cascade_set, cascade0, ok)
           else
              deallocate (cascade0)
           end if
        else
           call cascade_keystone &
                (cascade_set, cascade1, cascade2, cascade3, cascade4, ok)
        end if
     else
        deallocate (cascade4)
     end if
   end subroutine cascade_combine_keystone
 
 @ %def cascade_combine_keystone
 @
 \subsection{Cascade combination III: node connections and tree fusion}
 Here we assign global tree properties.  If the allowed number of
 off-shell lines is exceeded, discard the new cascade.  Otherwise,
 assign the trees, sort them, and assign connections.  Finally, append
 the cascade to the list.  This may fail (because in the hash array
 there is already an equivalent cascade).  On failure, discard the
 cascade.
 <<Cascades: procedures>>=
   subroutine cascade_fusion (cascade_set, cascade1, cascade2, cascade3)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), intent(in), target :: cascade1, cascade2
     type(cascade_t), pointer :: cascade3
     integer :: i1, i2, i3, i4
     logical :: ok
     cascade3%internal = (cascade3%depth - 3) / 2
     if (cascade3%resonant) then
        cascade3%multiplicity = 1
        cascade3%n_resonances = &
             cascade1%n_resonances + cascade2%n_resonances + 1
     else
        cascade3%multiplicity = cascade1%multiplicity + cascade2%multiplicity
        cascade3%n_resonances = cascade1%n_resonances + cascade2%n_resonances
     end if
     if (cascade3%log_enhanced) then
        cascade3%n_log_enhanced = &
             cascade1%n_log_enhanced + cascade2%n_log_enhanced + 1
     else
        cascade3%n_log_enhanced = &
             cascade1%n_log_enhanced + cascade2%n_log_enhanced
     end if
     if (cascade3%resonant) then
        cascade3%n_off_shell = 0
     else if (cascade3%log_enhanced) then
        cascade3%n_off_shell = cascade1%n_off_shell + cascade2%n_off_shell
     else
        cascade3%n_off_shell = cascade1%n_off_shell + cascade2%n_off_shell + 1
     end if
     if (cascade3%t_channel) then
        cascade3%n_t_channel = cascade1%n_t_channel + 1
     end if
     if (cascade3%n_off_shell > cascade_set%off_shell) then
        deallocate (cascade3)
     else if (cascade3%n_t_channel > cascade_set%t_channel) then
        deallocate (cascade3)
     else
        i1 = cascade1%depth
        i2 = i1 + 1
        i3 = i1 + cascade2%depth
        i4 = cascade3%depth
        cascade3%tree(:i1) = cascade1%tree
        where (cascade1%tree_mapping > NO_MAPPING)
           cascade3%tree_pdg(:i1) = cascade1%tree_pdg
        elsewhere
           cascade3%tree_pdg(:i1) = UNDEFINED
        end where
        cascade3%tree_mapping(:i1) = cascade1%tree_mapping
        cascade3%tree_resonant(:i1) = cascade1%tree_resonant
        cascade3%tree(i2:i3) = cascade2%tree
        where (cascade2%tree_mapping > NO_MAPPING)
           cascade3%tree_pdg(i2:i3) = cascade2%tree_pdg
        elsewhere
           cascade3%tree_pdg(i2:i3) = UNDEFINED
        end where
        cascade3%tree_mapping(i2:i3) = cascade2%tree_mapping
        cascade3%tree_resonant(i2:i3) = cascade2%tree_resonant
        cascade3%tree(i4) = cascade3%bincode
        cascade3%tree_pdg(i4) = cascade3%pdg
        cascade3%tree_mapping(i4) = cascade3%mapping
        cascade3%tree_resonant(i4) = cascade3%resonant
        call tree_sort (cascade3%tree, &
             cascade3%tree_pdg, cascade3%tree_mapping, cascade3%tree_resonant)
        cascade3%has_children = .true.
        cascade3%daughter1 => cascade1
        cascade3%daughter2 => cascade2
        call cascade_set_add (cascade_set, cascade3, ok)
        if (.not. ok)  deallocate (cascade3)
     end if
   end subroutine cascade_fusion
 
 @ %def cascade_fusion
 @ Here we combine a cascade pair with an incoming particle, i.e., we
 set a keystone.  Otherwise, this is similar.  On the first
 opportunity, we set the [[first_k]] pointer in the cascade set.
 <<Cascades: procedures>>=
   subroutine cascade_keystone &
        (cascade_set, cascade1, cascade2, cascade3, cascade4, ok)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), intent(in), target :: cascade1, cascade2, cascade3
     type(cascade_t), pointer :: cascade4
     logical, intent(out) :: ok
     integer :: i1, i2, i3, i4
     cascade4%internal = (cascade4%depth - 3) / 2
     cascade4%multiplicity = cascade1%multiplicity + cascade2%multiplicity
     cascade4%n_resonances = cascade1%n_resonances + cascade2%n_resonances
     cascade4%n_off_shell = cascade1%n_off_shell + cascade2%n_off_shell
     cascade4%n_log_enhanced = &
             cascade1%n_log_enhanced + cascade2%n_log_enhanced
     cascade4%n_t_channel = cascade1%n_t_channel + cascade2%n_t_channel
     if (cascade4%n_off_shell > cascade_set%off_shell) then
        deallocate (cascade4)
        ok = .false.
     else if (cascade4%n_t_channel > cascade_set%t_channel) then
        deallocate (cascade4)
        ok = .false.
     else
        i1 = cascade1%depth
        i2 = i1 + 1
        i3 = i1 + cascade2%depth
        i4 = cascade4%depth
        cascade4%tree(:i1) = cascade1%tree
        where (cascade1%tree_mapping > NO_MAPPING)
           cascade4%tree_pdg(:i1) = cascade1%tree_pdg
        elsewhere
           cascade4%tree_pdg(:i1) = UNDEFINED
        end where
        cascade4%tree_mapping(:i1) = cascade1%tree_mapping
        cascade4%tree_resonant(:i1) = cascade1%tree_resonant
        cascade4%tree(i2:i3) = cascade2%tree
        where (cascade2%tree_mapping > NO_MAPPING)
           cascade4%tree_pdg(i2:i3) = cascade2%tree_pdg
        elsewhere
           cascade4%tree_pdg(i2:i3) = UNDEFINED
        end where
        cascade4%tree_mapping(i2:i3) = cascade2%tree_mapping
        cascade4%tree_resonant(i2:i3) = cascade2%tree_resonant
        cascade4%tree(i4) = cascade4%bincode
        cascade4%tree_pdg(i4) = UNDEFINED
        cascade4%tree_mapping(i4) = cascade4%mapping
        cascade4%tree_resonant(i4) = .false.
        call tree_sort (cascade4%tree, &
             cascade4%tree_pdg, cascade4%tree_mapping, cascade4%tree_resonant)
        cascade4%has_children = .true.
        cascade4%daughter1 => cascade1
        cascade4%daughter2 => cascade2
        cascade4%mother => cascade3
        call cascade_set_add (cascade_set, cascade4, ok)
        if (ok) then
           if (.not. associated (cascade_set%first_k)) then
              cascade_set%first_k => cascade4
           end if
        else
           deallocate (cascade4)
        end if
     end if
   end subroutine cascade_keystone
 
 @ %def cascade_keystone
 @
 Sort a tree (array of binary codes) and particle code array
 simultaneously, by ascending binary codes.  A convenient method is to
 use the [[maxloc]] function iteratively, to find and remove the
 largest entry in the tree array one by one.
 <<Cascades: procedures>>=
   subroutine tree_sort (tree, pdg, mapping, resonant)
     integer(TC), dimension(:), intent(inout) :: tree
     integer, dimension(:), intent(inout) :: pdg, mapping
     logical, dimension(:), intent(inout) :: resonant
     integer(TC), dimension(size(tree)) :: tree_tmp
     integer, dimension(size(pdg)) :: pdg_tmp, mapping_tmp
     logical, dimension(size(resonant)) :: resonant_tmp
     integer, dimension(1) :: pos
     integer :: i
     tree_tmp = tree
     pdg_tmp = pdg
     mapping_tmp = mapping
     resonant_tmp = resonant
     do i = size(tree),1,-1
        pos = maxloc (tree_tmp)
        tree(i) = tree_tmp (pos(1))
        pdg(i) = pdg_tmp (pos(1))
        mapping(i) = mapping_tmp (pos(1))
        resonant(i) = resonant_tmp (pos(1))
        tree_tmp(pos(1)) = 0
     end do
   end subroutine tree_sort
 
 @ %def tree_sort
 @
 \subsection{Cascade set generation}
 These procedures loop over cascades and build up the cascade set.  After each
 iteration of the innermost loop, we set a breakpoint.
 
 s-channel: We use a nested scan to combine all cascades with all other
 cascades.
 <<Cascades: procedures>>=
   subroutine cascade_set_generate_s (cascade_set)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), pointer :: cascade1, cascade2
     cascade1 => cascade_set%first
     LOOP1: do while (associated (cascade1))
        cascade2 => cascade_set%first
        LOOP2: do while (associated (cascade2))
           if (cascade2%index >= cascade1%index)  exit LOOP2
           if (cascade1 .disjunct. cascade2) then
              call cascade_match_pair (cascade_set, cascade1, cascade2, .true.)
           end if
           call terminate_now_if_signal ()
           cascade2 => cascade2%next
        end do LOOP2
        cascade1 => cascade1%next
     end do LOOP1
   end subroutine cascade_set_generate_s
 
 @ %def cascade_set_generate_s
 @ The t-channel cascades are directed and have a seed (one of the
 incoming particles) and a target (the other one).  We loop over all
 possible seeds and targets.  Inside this, we loop over all t-channel
 cascades ([[cascade1]]) and s-channel cascades ([[cascade2]]) and try
 to combine them.
 <<Cascades: procedures>>=
   subroutine cascade_set_generate_t (cascade_set, pos_seed, pos_target)
     type(cascade_set_t), intent(inout), target :: cascade_set
     integer, intent(in) :: pos_seed, pos_target
     type(cascade_t), pointer :: cascade_seed, cascade_target
     type(cascade_t), pointer :: cascade1, cascade2
     integer(TC) :: bc_seed, bc_target
     bc_seed = ibset (0_TC, pos_seed-1)
     bc_target = ibset (0_TC, pos_target-1)
     cascade_seed => cascade_set%first_t
     LOOP_SEED: do while (associated (cascade_seed))
        if (cascade_seed%bincode == bc_seed) then
           cascade_target => cascade_set%first_t
           LOOP_TARGET: do while (associated (cascade_target))
              if (cascade_target%bincode == bc_target) then
                 cascade1 => cascade_set%first_t
                 LOOP_T: do while (associated (cascade1))
                    if ((cascade1 .disjunct. cascade_target) &
                         .and. .not. (cascade1 .disjunct. cascade_seed)) then
                       cascade2 => cascade_set%first
                       LOOP_S: do while (associated (cascade2))
                          if ((cascade2 .disjunct. cascade_target) &
                               .and. (cascade2 .disjunct. cascade1)) then
                             call cascade_match_pair &
                                  (cascade_set, cascade1, cascade2, .false.)
                          end if
                          call terminate_now_if_signal ()
                          cascade2 => cascade2%next
                       end do LOOP_S
                    end if
                    call terminate_now_if_signal ()
                    cascade1 => cascade1%next
                 end do LOOP_T
              end if
              call terminate_now_if_signal ()
              cascade_target => cascade_target%next
           end do LOOP_TARGET
        end if
        call terminate_now_if_signal ()
        cascade_seed => cascade_seed%next
     end do LOOP_SEED
   end subroutine cascade_set_generate_t
 
 @ %def cascade_set_generate_t
 @ This part completes the phase space for decay processes.  It is
 similar to s-channel cascade generation, but combines two cascade with
 the particular cascade of the incoming particle.  This particular
 cascade is expected to be pointed at by [[first_t]].
 <<Cascades: procedures>>=
   subroutine cascade_set_generate_decay (cascade_set)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), pointer :: cascade1, cascade2
     type(cascade_t), pointer :: cascade_in
     cascade_in => cascade_set%first_t
     cascade1 => cascade_set%first
     do while (associated (cascade1))
        if (cascade1 .disjunct. cascade_in) then
           cascade2 => cascade1%next
           do while (associated (cascade2))
              if ((cascade2 .disjunct. cascade1) &
                   .and. (cascade2 .disjunct. cascade_in)) then
                 call cascade_match_triplet (cascade_set, &
                      cascade1, cascade2, cascade_in, .true.)
              end if
              call terminate_now_if_signal ()
              cascade2 => cascade2%next
           end do
        end if
        call terminate_now_if_signal ()
        cascade1 => cascade1%next
     end do
   end subroutine cascade_set_generate_decay
 
 @ %def cascade_set_generate_decay
 @ This part completes the phase space for scattering processes.  We
 combine a t-channel cascade (containing the seed) with a s-channel
 cascade and the target.
 <<Cascades: procedures>>=
   subroutine cascade_set_generate_scattering &
        (cascade_set, ns1, ns2, nt1, nt2, pos_seed, pos_target)
     type(cascade_set_t), intent(inout), target :: cascade_set
     integer, intent(in) :: pos_seed, pos_target
     integer, intent(in) :: ns1, ns2, nt1, nt2
     type(cascade_t), pointer :: cascade_seed, cascade_target
     type(cascade_t), pointer :: cascade1, cascade2
     integer(TC) :: bc_seed, bc_target
     bc_seed = ibset (0_TC, pos_seed-1)
     bc_target = ibset (0_TC, pos_target-1)
     cascade_seed => cascade_set%first_t
     LOOP_SEED: do while (associated (cascade_seed))
        if (cascade_seed%index < ns1) then
           cascade_seed => cascade_seed%next
           cycle LOOP_SEED
        else if (cascade_seed%index > ns2) then
           exit LOOP_SEED
        else if (cascade_seed%bincode == bc_seed) then
           cascade_target => cascade_set%first_t
           LOOP_TARGET: do while (associated (cascade_target))
              if (cascade_target%index < nt1) then
                 cascade_target => cascade_target%next
                 cycle LOOP_TARGET
              else if (cascade_target%index > nt2) then
                 exit LOOP_TARGET
              else if (cascade_target%bincode == bc_target) then
                 cascade1 => cascade_set%first_t
                 LOOP_T: do while (associated (cascade1))
                    if ((cascade1 .disjunct. cascade_target) &
                         .and. .not. (cascade1 .disjunct. cascade_seed)) then
                       cascade2 => cascade_set%first
                       LOOP_S: do while (associated (cascade2))
                          if ((cascade2 .disjunct. cascade_target) &
                               .and. (cascade2 .disjunct. cascade1)) then
                             call cascade_match_triplet (cascade_set, &
                                  cascade1, cascade2, cascade_target, .false.)
                          end if
                          call terminate_now_if_signal ()
                          cascade2 => cascade2%next
                       end do LOOP_S
                    end if
                    call terminate_now_if_signal ()
                    cascade1 => cascade1%next
                 end do LOOP_T
              end if
              call terminate_now_if_signal ()
              cascade_target => cascade_target%next
           end do LOOP_TARGET
        end if
        call terminate_now_if_signal ()
        cascade_seed => cascade_seed%next
     end do LOOP_SEED
   end subroutine cascade_set_generate_scattering
 
 @ %def cascade_set_generate_scattering
 @
 \subsection{Groves}
 Before assigning groves, assign hashcodes to the resonance patterns, so they
 can easily be compared.
 <<Cascades: procedures>>=
   subroutine cascade_set_assign_resonance_hash (cascade_set)
     type(cascade_set_t), intent(inout) :: cascade_set
     type(cascade_t), pointer :: cascade
     cascade => cascade_set%first_k
     do while (associated (cascade))
        call cascade_assign_resonance_hash (cascade)
        cascade => cascade%next
     end do
   end subroutine cascade_set_assign_resonance_hash
 
 @ %def cascade_assign_resonance_hash
 @ After all cascades are recorded, we group the complete cascades in
 groves.  A grove consists of cascades with identical multiplicity,
 number of resonances, log-enhanced, t-channel lines, and resonance flavors.
 <<Cascades: procedures>>=
   subroutine cascade_set_assign_groves (cascade_set)
     type(cascade_set_t), intent(inout), target :: cascade_set
     type(cascade_t), pointer :: cascade1, cascade2
     integer :: multiplicity
     integer :: n_resonances, n_log_enhanced, n_t_channel, n_off_shell
     integer :: res_hash
     integer :: grove
     grove = 0
     cascade1 => cascade_set%first_k
     do while (associated (cascade1))
        if (cascade1%active .and. cascade1%complete &
             .and. cascade1%grove == 0) then
           grove = grove + 1
           cascade1%grove = grove
           multiplicity = cascade1%multiplicity
           n_resonances = cascade1%n_resonances
           n_log_enhanced = cascade1%n_log_enhanced
           n_off_shell = cascade1%n_off_shell
           n_t_channel = cascade1%n_t_channel
           res_hash = cascade1%res_hash
           cascade2 => cascade1%next
           do while (associated (cascade2))
              if (cascade2%grove == 0) then
                 if (cascade2%multiplicity == multiplicity &
                      .and. cascade2%n_resonances == n_resonances &
                      .and. cascade2%n_log_enhanced == n_log_enhanced &
                      .and. cascade2%n_off_shell == n_off_shell &
                      .and. cascade2%n_t_channel == n_t_channel &
                      .and. cascade2%res_hash == res_hash) then
                    cascade2%grove = grove
                 end if
              end if
              call terminate_now_if_signal ()
              cascade2 => cascade2%next
           end do
        end if
        call terminate_now_if_signal ()
        cascade1 => cascade1%next
     end do
     cascade_set%n_groves = grove
   end subroutine cascade_set_assign_groves
 
 @ %def cascade_set_assign_groves
 @
 \subsection{Generate the phase space file}
 Generate a complete phase space configuration.
 
 For each flavor assignment: First, all s-channel
 graphs that can be built up from the outgoing particles.  Then we
 distinguish (1) decay, where we complete the s-channel graphs by
 connecting to the input line, and (2) scattering, where we now
 generate t-channel graphs by introducing an incoming particle, and
 complete this by connecting to the other incoming particle.
 
 After all cascade sets have been generated, merge them into a common set.
 This eliminates redunancies between flavor assignments.
 <<Cascades: public>>=
   public :: cascade_set_generate
 <<Cascades: procedures>>=
   subroutine cascade_set_generate &
        (cascade_set, model, n_in, n_out, flv, phs_par, fatal_beam_decay)
     type(cascade_set_t), intent(out) :: cascade_set
     class(model_data_t), intent(in), target :: model
     integer, intent(in) :: n_in, n_out
     type(flavor_t), dimension(:,:), intent(in) :: flv
     type(phs_parameters_t), intent(in) :: phs_par
     logical, intent(in) :: fatal_beam_decay
     type(cascade_set_t), dimension(:), allocatable :: cset
     type(cascade_t), pointer :: cascade
     integer :: i
     if (phase_space_vanishes (phs_par%sqrts, n_in, flv))  return
     call cascade_set_init (cascade_set, model, n_in, n_out, phs_par, &
        fatal_beam_decay, flv)
     allocate (cset (size (flv, 2)))
     do i = 1, size (cset)
        call cascade_set_generate_single (cset(i), &
             model, n_in, n_out, flv(:,i), phs_par, fatal_beam_decay)
        cascade => cset(i)%first_k
        do while (associated (cascade))
           if (cascade%active .and. cascade%complete) then
              call cascade_set_add_copy (cascade_set, cascade)
           end if
           cascade => cascade%next
        end do
        call cascade_set_final (cset(i))
     end do
     cascade_set%first_k => cascade_set%first
     call cascade_set_assign_resonance_hash (cascade_set)
     call cascade_set_assign_groves (cascade_set)
   end subroutine cascade_set_generate
 
 @ %def cascade_set_generate
 @ This generates phase space for a single channel, without assigning groves.
 <<Cascades: procedures>>=
   subroutine cascade_set_generate_single (cascade_set, &
       model, n_in, n_out, flv, phs_par, fatal_beam_decay)
     type(cascade_set_t), intent(out) :: cascade_set
     class(model_data_t), intent(in), target :: model
     integer, intent(in) :: n_in, n_out
     type(flavor_t), dimension(:), intent(in) :: flv
     type(phs_parameters_t), intent(in) :: phs_par
     logical, intent(in) :: fatal_beam_decay
     integer :: n11, n12, n21, n22
     call cascade_set_init (cascade_set, model, n_in, n_out, phs_par, &
        fatal_beam_decay)
     call cascade_set_add_outgoing (cascade_set, flv(n_in+1:))
     call cascade_set_generate_s (cascade_set)
     select case (n_in)
     case(1)
        call cascade_set_add_incoming &
             (cascade_set, n11, n12, n_out + 1, flv(1))
        call cascade_set_generate_decay (cascade_set)
     case(2)
        call cascade_set_add_incoming &
             (cascade_set, n11, n12, n_out + 1, flv(2))
        call cascade_set_add_incoming &
             (cascade_set, n21, n22, n_out + 2, flv(1))
        call cascade_set_generate_t (cascade_set, n_out + 1, n_out + 2)
        call cascade_set_generate_t (cascade_set, n_out + 2, n_out + 1)
        call cascade_set_generate_scattering &
             (cascade_set, n11, n12, n21, n22, n_out + 1, n_out + 2)
        call cascade_set_generate_scattering &
             (cascade_set, n21, n22, n11, n12, n_out + 2, n_out + 1)
     end select
   end subroutine cascade_set_generate_single
 
 @ %def cascade_set_generate_single
 @ Sanity check: Before anything else is done, check if there could
 possibly be any phase space.
 <<Cascades: public>>=
   public :: phase_space_vanishes
 <<Cascades: procedures>>=
   function phase_space_vanishes (sqrts, n_in, flv) result (flag)
     logical :: flag
     real(default), intent(in) :: sqrts
     integer, intent(in) :: n_in
     type(flavor_t), dimension(:,:), intent(in) :: flv
     real(default), dimension(:,:), allocatable :: mass
     real(default), dimension(:), allocatable :: mass_in, mass_out
     integer :: n_prt, n_flv, i, j
     flag = .false.
     if (sqrts <= 0) then
        call msg_error ("Phase space vanishes (sqrts must be positive)")
        flag = .true.;  return
     end if
     n_prt = size (flv, 1)
     n_flv = size (flv, 2)
     allocate (mass (n_prt, n_flv), mass_in (n_flv), mass_out (n_flv))
     mass = flv%get_mass ()
     mass_in = sum (mass(:n_in,:), 1)
     mass_out = sum (mass(n_in+1:,:), 1)
     if (any (mass_in > sqrts)) then
        call msg_error ("Mass sum of incoming particles " &
             // "is more than available energy")
        flag = .true.;  return
     end if
     if (any (mass_out > sqrts)) then
        call msg_error ("Mass sum of outgoing particles " &
             // "is more than available energy")
        flag = .true.;  return
     end if
   end function phase_space_vanishes
 
 @ %def phase_space_vanishes
 @
 \subsection{Return the resonance histories for subtraction}
 This appears to be essential (re-export of some imported assignment?)!
 <<Cascades: public>>=
   public :: assignment(=)
 @
 Extract the resonance set from a complete cascade.
 <<Cascades: cascade: TBP>>=
   procedure :: extract_resonance_history => cascade_extract_resonance_history
 <<Cascades: procedures>>=
   subroutine cascade_extract_resonance_history &
        (cascade, res_hist, model, n_out)
     class(cascade_t), intent(in), target :: cascade
     type(resonance_history_t), intent(out) :: res_hist
     class(model_data_t), intent(in), target :: model
     integer, intent(in) :: n_out
     type(resonance_info_t) :: resonance
     integer :: i, mom_id, pdg
     call msg_debug2 (D_PHASESPACE, "cascade_extract_resonance_history")
     if (cascade%n_resonances > 0) then
        if (cascade%has_children) then
           call msg_debug2 (D_PHASESPACE, "cascade has resonances and children")
           do i = 1, size(cascade%tree_resonant)
              if (cascade%tree_resonant (i)) then
                 mom_id = cascade%tree (i)
                 pdg = cascade%tree_pdg (i)
                 call resonance%init (mom_id, pdg, model, n_out)
                 if (debug2_active (D_PHASESPACE)) then
                    print *, 'D: Adding resonance'
                    call resonance%write ()
                 end if
                 call res_hist%add_resonance (resonance)
              end if
           end do
        end if
     end if
   end subroutine cascade_extract_resonance_history
 
 @ %def cascade_extract_resonance_history
 @
 <<Cascades: public>>=
   public :: cascade_set_get_n_trees
 <<Cascades: procedures>>=
   function cascade_set_get_n_trees (cascade_set) result (n)
     type(cascade_set_t), intent(in), target :: cascade_set
     integer :: n
     type(cascade_t), pointer :: cascade
     integer :: grove
     call msg_debug (D_PHASESPACE, "cascade_set_get_n_trees")
     n = 0
     do grove = 1, cascade_set%n_groves
        cascade => cascade_set%first_k
        do while (associated (cascade))
           if (cascade%active .and. cascade%complete) then
              if (cascade%grove == grove) then
                 n = n + 1
              end if
           end if
           cascade => cascade%next
        end do
     end do
     call msg_debug (D_PHASESPACE, "n", n)
   end function cascade_set_get_n_trees
 
 @ %def cascade_set_get_n_trees
 @ Distill the set of resonance histories from the cascade set.  The
 result is an array which contains each valid history exactly once.
 <<Cascades: public>>=
   public :: cascade_set_get_resonance_histories
 <<Cascades: procedures>>=
   subroutine cascade_set_get_resonance_histories (cascade_set, n_filter, res_hists)
     type(cascade_set_t), intent(in), target :: cascade_set
     integer, intent(in), optional :: n_filter
     type(resonance_history_t), dimension(:), allocatable, intent(out) :: res_hists
     type(resonance_history_t), dimension(:), allocatable :: tmp
     type(cascade_t), pointer :: cascade
     type(resonance_history_t) :: res_hist
     type(resonance_history_set_t) :: res_hist_set
     integer :: grove, i, n_hists
     logical :: included, add_to_list
     call msg_debug (D_PHASESPACE, "cascade_set_get_resonance_histories")
     call res_hist_set%init (n_filter = n_filter)
     do grove = 1, cascade_set%n_groves
        cascade => cascade_set%first_k
        do while (associated (cascade))
           if (cascade%active .and. cascade%complete) then
              if (cascade%grove == grove) then
                 call msg_debug2 (D_PHASESPACE, "grove", grove)
                 call cascade%extract_resonance_history &
                      (res_hist, cascade_set%model, cascade_set%n_out)
                 call res_hist_set%enter (res_hist)
              end if
           end if
           cascade => cascade%next
        end do
     end do
     call res_hist_set%freeze ()
     call res_hist_set%to_array (res_hists)
   end subroutine cascade_set_get_resonance_histories
 
 @ %def cascade_set_get_resonance_histories
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[cascades_ut.f90]]>>=
 <<File header>>
 
 module cascades_ut
   use unit_tests
   use cascades_uti
 
 <<Standard module head>>
 
 <<Cascades: public test>>
 
 contains
 
 <<Cascades: test driver>>
 
 end module cascades_ut
 @ %def cascades_ut
 @
 <<[[cascades_uti.f90]]>>=
 <<File header>>
 
 module cascades_uti
 
 <<Use kinds>>
 <<Use strings>>
   use numeric_utils
   use flavors
   use model_data
   use phs_forests, only: phs_parameters_t
   use resonances, only: resonance_history_t
 
   use cascades
 
 <<Standard module head>>
 
 <<Cascades: test declarations>>
 
 contains
 
 <<Cascades: tests>>
 
 end module cascades_uti
 @ %def cascades_ut
 @ API: driver for the unit tests below.
 <<Cascades: public test>>=
   public :: cascades_test
 <<Cascades: test driver>>=
   subroutine cascades_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Cascades: execute tests>>
   end subroutine cascades_test
 
 @ %def cascades_test
 \subsubsection{Check cascade setup}
 @ Checking the basic setup up of the phase space cascade parameterizations.
 <<Cascades: execute tests>>=
   call test (cascades_1, "cascades_1", &
        "check cascade setup", &
        u, results)
 <<Cascades: test declarations>>=
   public :: cascades_1
 <<Cascades: tests>>=
   subroutine cascades_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t), dimension(5,2) :: flv
     type(cascade_set_t) :: cascade_set
     type(phs_parameters_t) :: phs_par
 
     write (u, "(A)")  "* Test output: cascades_1"
     write (u, "(A)")  "*   Purpose: test cascade phase space functions"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initializing"
     write (u, "(A)")
 
     call model%init_sm_test ()
 
     call flv(1,1)%init ( 2, model)
     call flv(2,1)%init (-2, model)
     call flv(3,1)%init ( 1, model)
     call flv(4,1)%init (-1, model)
     call flv(5,1)%init (21, model)
     call flv(1,2)%init ( 2, model)
     call flv(2,2)%init (-2, model)
     call flv(3,2)%init ( 2, model)
     call flv(4,2)%init (-2, model)
     call flv(5,2)%init (21, model)
     phs_par%sqrts = 1000._default
     phs_par%off_shell = 2
 
     write (u, "(A)")
     write (u, "(A)")  "* Generating the cascades"
     write (u, "(A)")
 
     call cascade_set_generate (cascade_set, model, 2, 3, flv, phs_par,.true.)
     call cascade_set_write (cascade_set, u)
     call cascade_set_write_file_format (cascade_set, u)
 
     write (u, "(A)")  "* Cleanup"
     write (u, "(A)")
 
     call cascade_set_final (cascade_set)
     call model%final ()
 
     write (u, *)
     write (u, "(A)")  "* Test output end: cascades_1"
 
   end subroutine cascades_1
 
 @ %def cascades_1
 @
 \subsubsection{Check resonance history}
 <<Cascades: execute tests>>=
   call test(cascades_2, "cascades_2", &
             "Check resonance history", u, results)
 <<Cascades: test declarations>>=
   public :: cascades_2
 <<Cascades: tests>>=
   subroutine cascades_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t), dimension(5,1) :: flv
     type(cascade_set_t) :: cascade_set
     type(phs_parameters_t) :: phs_par
     type(resonance_history_t), dimension(:), allocatable :: res_hists
     integer :: n, i
     write (u, "(A)")  "* Test output: cascades_2"
     write (u, "(A)")  "*   Purpose: Check resonance history"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initializing"
     write (u, "(A)")
 
     call model%init_sm_test ()
 
     call flv(1,1)%init ( 2, model)
     call flv(2,1)%init (-2, model)
     call flv(3,1)%init ( 1, model)
     call flv(4,1)%init (-1, model)
     call flv(5,1)%init (22, model)
     phs_par%sqrts = 1000._default
     phs_par%off_shell = 2
 
     write (u, "(A)")
     write (u, "(A)")  "* Generating the cascades"
     write (u, "(A)")
 
     call cascade_set_generate (cascade_set, model, 2, 3, flv, phs_par,.true.)
     call cascade_set_get_resonance_histories (cascade_set, res_hists = res_hists)
     n = cascade_set_get_n_trees (cascade_set)
     call assert_equal (u, n, 24, "Number of trees")
     do i = 1, size(res_hists)
        call res_hists(i)%write (u)
        write (u, "(A)")
     end do
 
     write (u, "(A)")  "* Cleanup"
     write (u, "(A)")
 
     call cascade_set_final (cascade_set)
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: cascades_2"
   end subroutine cascades_2
 
 @ %def cascades_2
 @
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{WOOD phase space}
 
 This is the module that interfaces the [[phs_forests]] phase-space
 treatment and the [[cascades]] module for generating phase-space
 channels.  As an extension of the [[phs_base]] abstract type,
 the phase-space configuration and instance implement the standard API.
 
 (Currently, this is the only generic phase-space implementation of
 \whizard.  For trivial two-particle phase space, there is
 [[phs_wood]] as an alternative.)
 <<[[phs_wood.f90]]>>=
 <<File header>>
 
 module phs_wood
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use constants
   use numeric_utils
   use diagnostics
   use os_interface
   use md5
   use physics_defs
   use lorentz
   use model_data
   use flavors
   use process_constants
   use sf_mappings
   use sf_base
   use phs_base
   use mappings
   use resonances, only: resonance_history_set_t
   use phs_forests
   use cascades
   use cascades2
 
 <<Standard module head>>
 
 <<PHS wood: public>>
 
 <<PHS wood: parameters>>
 
 <<PHS wood: types>>
 
 contains
 
 <<PHS wood: procedures>>
 
 end module phs_wood
 @ %def phs_wood
 @
 \subsection{Configuration}
 <<PHS wood: parameters>>=
   integer, parameter, public :: EXTENSION_NONE = 0
   integer, parameter, public :: EXTENSION_DEFAULT = 1
   integer, parameter, public :: EXTENSION_DGLAP = 2
 
 <<PHS wood: public>>=
   public :: phs_wood_config_t
 <<PHS wood: types>>=
   type, extends (phs_config_t) :: phs_wood_config_t
      character(32) :: md5sum_forest = ""
      type(string_t) :: phs_path
      integer :: io_unit = 0
      logical :: io_unit_keep_open = .false.
      logical :: use_equivalences = .false.
      logical :: fatal_beam_decay = .true.
      type(mapping_defaults_t) :: mapping_defaults
      type(phs_parameters_t) :: par
      type(string_t) :: run_id
      type(cascade_set_t), allocatable :: cascade_set
      logical :: use_cascades2 = .false.
      type(feyngraph_set_t), allocatable :: feyngraph_set
      type(phs_forest_t) :: forest
      type(os_data_t) :: os_data
      integer :: extension_mode = EXTENSION_NONE
    contains
    <<PHS wood: phs wood config: TBP>>
   end type phs_wood_config_t
 
 @ %def phs_wood_config_t
 @ Finalizer.  We should delete the cascade set and the forest subobject.
 
 Also close the I/O unit, just in case.  (We assume that [[io_unit]] is
 not standard input/output.)
 <<PHS wood: phs wood config: TBP>>=
   procedure :: final => phs_wood_config_final
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_final (object)
     class(phs_wood_config_t), intent(inout) :: object
     logical :: opened
     if (object%io_unit /= 0) then
        inquire (unit = object%io_unit, opened = opened)
        if (opened)  close (object%io_unit)
     end if
     call object%clear_phase_space ()
     call phs_forest_final (object%forest)
   end subroutine phs_wood_config_final
 
 @ %def phs_wood_config_final
 @
 <<PHS wood: phs wood config: TBP>>=
   procedure :: increase_n_par => phs_wood_config_increase_n_par
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_increase_n_par (phs_config)
     class(phs_wood_config_t), intent(inout) :: phs_config
     select case (phs_config%extension_mode)
     case (EXTENSION_DEFAULT)
        phs_config%n_par = phs_config%n_par + 3
     case (EXTENSION_DGLAP)
        phs_config%n_par = phs_config%n_par + 4
     end select
   end subroutine phs_wood_config_increase_n_par
 
 @ %def phs_wood_config_increase_n_par
 @
 <<PHS wood: phs wood config: TBP>>=
   procedure :: set_extension_mode => phs_wood_config_set_extension_mode
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_set_extension_mode (phs_config, mode)
     class(phs_wood_config_t), intent(inout) :: phs_config
     integer, intent(in) :: mode
     phs_config%extension_mode = mode
   end subroutine phs_wood_config_set_extension_mode
 
 @ %def phs_wood_config_set_extension_mode
 @ Output.  The contents of the PHS forest are not printed explicitly.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: write => phs_wood_config_write
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_write (object, unit, include_id)
     class(phs_wood_config_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: include_id
     integer :: u
     u = given_output_unit (unit)
     write (u, "(1x,A)") &
          "Partonic phase-space configuration (phase-space forest):"
     call object%base_write (unit)
     write (u, "(1x,A)")    "Phase-space configuration parameters:"
     call phs_parameters_write (object%par, u)
     call object%mapping_defaults%write (u)
     write (u, "(3x,A,A,A)")  "Run ID: '", char (object%run_id), "'"
   end subroutine phs_wood_config_write
 
 @ %def phs_wood_config_write
 @ Print the PHS forest contents.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: write_forest => phs_wood_config_write_forest
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_write_forest (object, unit)
     class(phs_wood_config_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call phs_forest_write (object%forest, u)
   end subroutine phs_wood_config_write_forest
 
 @ %def phs_wood_config_write_forest
 @ Set the phase-space parameters that the configuration generator requests.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: set_parameters => phs_wood_config_set_parameters
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_set_parameters (phs_config, par)
     class(phs_wood_config_t), intent(inout) :: phs_config
     type(phs_parameters_t), intent(in) :: par
     phs_config%par = par
   end subroutine phs_wood_config_set_parameters
 
 @ %def phs_wood_config_set_parameters
 @ Enable the generation of channel equivalences (when calling [[configure]]).
 <<PHS wood: phs wood config: TBP>>=
   procedure :: enable_equivalences => phs_wood_config_enable_equivalences
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_enable_equivalences (phs_config)
     class(phs_wood_config_t), intent(inout) :: phs_config
     phs_config%use_equivalences = .true.
   end subroutine phs_wood_config_enable_equivalences
 
 @ %def phs_wood_config_enable_equivalences
 @ Set the phase-space mapping parameters that the configuration generator
 requests.g
 <<PHS wood: phs wood config: TBP>>=
   procedure :: set_mapping_defaults => phs_wood_config_set_mapping_defaults
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_set_mapping_defaults (phs_config, mapping_defaults)
     class(phs_wood_config_t), intent(inout) :: phs_config
     type(mapping_defaults_t), intent(in) :: mapping_defaults
     phs_config%mapping_defaults = mapping_defaults
   end subroutine phs_wood_config_set_mapping_defaults
 
 @ %def phs_wood_config_set_mapping_defaults
 @ Define the input stream for the phase-space file as an open logical unit.
 The unit must be connected.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: set_input => phs_wood_config_set_input
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_set_input (phs_config, unit)
     class(phs_wood_config_t), intent(inout) :: phs_config
     integer, intent(in) :: unit
     phs_config%io_unit = unit
     rewind (unit)
   end subroutine phs_wood_config_set_input
 
 @ %def phs_wood_config_set_input
 @
 \subsection{Phase-space generation}
 This subroutine generates a phase space configuration using the
 [[cascades]] module.   Note that this may take time, and the
 [[cascade_set]] subobject may consume a large amount of memory.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: generate_phase_space => phs_wood_config_generate_phase_space
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_generate_phase_space (phs_config)
     class(phs_wood_config_t), intent(inout) :: phs_config
     integer :: off_shell, extra_off_shell
     logical :: valid
     integer :: unit_fds
     type(string_t) :: file_name
     logical :: file_exists
     call msg_message ("Phase space: generating configuration ...")
     off_shell = phs_config%par%off_shell
     if (phs_config%use_cascades2) then
        file_name = char (phs_config%id) // ".fds"
        inquire (file=char (file_name), exist=file_exists)
        if (.not. file_exists) call msg_fatal &
             ("The O'Mega input file " // char (file_name) // &
             " does not exist. " // "Please make sure that the " // &
             "variable ?omega_write_phs_output has been set correctly.")
        unit_fds = free_unit ()
        open (unit=unit_fds, file=char(file_name), status='old', action='read')
        do extra_off_shell = 0, max (phs_config%n_tot - 3, 0)
           phs_config%par%off_shell = off_shell + extra_off_shell
           allocate (phs_config%feyngraph_set)
           call feyngraph_set_generate (phs_config%feyngraph_set, &
                phs_config%model, phs_config%n_in, phs_config%n_out, &
                phs_config%flv, &
                phs_config%par, phs_config%fatal_beam_decay, unit_fds, &
                phs_config%vis_channels)
           if (feyngraph_set_is_valid (phs_config%feyngraph_set)) then
              exit
           else
              call msg_message ("Phase space: ... failed.  &
                   &Increasing phs_off_shell ...")
              call phs_config%feyngraph_set%final ()
              deallocate (phs_config%feyngraph_set)
           end if
        end do
        close (unit_fds)
     else
        allocate (phs_config%cascade_set)
        do extra_off_shell = 0, max (phs_config%n_tot - 3, 0)
           phs_config%par%off_shell = off_shell + extra_off_shell
           call cascade_set_generate (phs_config%cascade_set, &
                phs_config%model, phs_config%n_in, phs_config%n_out, &
                phs_config%flv, &
                phs_config%par, phs_config%fatal_beam_decay)
           if (cascade_set_is_valid (phs_config%cascade_set)) then
              exit
           else
              call msg_message ("Phase space: ... failed.  &
                   &Increasing phs_off_shell ...")
           end if
        end do
     end if
     if (phs_config%use_cascades2) then
        valid = feyngraph_set_is_valid (phs_config%feyngraph_set)
     else
        valid = cascade_set_is_valid (phs_config%cascade_set)
     end if
     if (valid) then
        call msg_message ("Phase space: ... success.")
     else
        call msg_fatal ("Phase-space: generation failed")
     end if
   end subroutine phs_wood_config_generate_phase_space
 
 @ %def phs_wood_config_generate_phase_space
 @ Using the generated phase-space configuration, write an appropriate
 phase-space file to the stored (or explicitly specified) I/O unit.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: write_phase_space => phs_wood_config_write_phase_space
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_write_phase_space (phs_config, &
        filename_vis, unit)
     class(phs_wood_config_t), intent(in) :: phs_config
     integer, intent(in), optional :: unit
     type(string_t), intent(in), optional :: filename_vis
     type(string_t) :: setenv_tex, setenv_mp, pipe, pipe_dvi
     integer :: u, unit_tex, unit_dev, status
     if (allocated (phs_config%cascade_set) .or. allocated (phs_config%feyngraph_set)) then
        if (present (unit)) then
           u = unit
        else
           u = phs_config%io_unit
        end if
        write (u, "(1x,A,A)") "process ", char (phs_config%id)
        write (u, "(A)")
        if (phs_config%use_cascades2) then
           call feyngraph_set_write_process_bincode_format (phs_config%feyngraph_set, u)
        else
           call cascade_set_write_process_bincode_format (phs_config%cascade_set, u)
        end if
        write (u, "(A)")
        write (u, "(3x,A,A,A32,A)") "md5sum_process    = ", &
             '"', phs_config%md5sum_process, '"'
        write (u, "(3x,A,A,A32,A)") "md5sum_model_par  = ", &
             '"', phs_config%md5sum_model_par, '"'
        write (u, "(3x,A,A,A32,A)") "md5sum_phs_config = ", &
             '"', phs_config%md5sum_phs_config, '"'
        call phs_parameters_write (phs_config%par, u)
        if (phs_config%use_cascades2) then
           call feyngraph_set_write_file_format (phs_config%feyngraph_set, u)
        else
           call cascade_set_write_file_format (phs_config%cascade_set, u)
        end if
        if (phs_config%vis_channels) then
           unit_tex = free_unit ()
           open (unit=unit_tex, file=char(filename_vis // ".tex"), &
                action="write", status="replace")
           if (phs_config%use_cascades2) then
              call feyngraph_set_write_graph_format (phs_config%feyngraph_set, &
                   filename_vis // "-graphs", phs_config%id, unit_tex)
           else
              call cascade_set_write_graph_format (phs_config%cascade_set, &
                   filename_vis // "-graphs", phs_config%id, unit_tex)
           end if
           close (unit_tex)
           call msg_message ("Phase space: visualizing channels in file " &
                // char(trim(filename_vis)) // "...")
           if (phs_config%os_data%event_analysis_ps) then
              BLOCK: do
                 unit_dev = free_unit ()
                 open (file = "/dev/null", unit = unit_dev, &
                      action = "write", iostat = status)
                 if (status /= 0) then
                    pipe = ""
                    pipe_dvi = ""
                 else
                    pipe = " > /dev/null"
                    pipe_dvi = " 2>/dev/null 1>/dev/null"
                 end if
                 close (unit_dev)
                 if (phs_config%os_data%whizard_texpath /= "") then
                    setenv_tex = "TEXINPUTS=" // &
                         phs_config%os_data%whizard_texpath // ":$TEXINPUTS "
                    setenv_mp = "MPINPUTS=" // &
                         phs_config%os_data%whizard_texpath // ":$MPINPUTS "
                 else
                    setenv_tex = ""
                    setenv_mp = ""
                 end if
                 call os_system_call (setenv_tex // &
                      phs_config%os_data%latex // " " // &
                      filename_vis // ".tex " // pipe, status)
                 if (status /= 0)  exit BLOCK
                 if (phs_config%os_data%mpost /= "") then
                    call os_system_call (setenv_mp // &
                         phs_config%os_data%mpost // " " // &
                         filename_vis // "-graphs.mp" // pipe, status)
                 else
                    call msg_fatal ("Could not use MetaPOST.")
                 end if
                 if (status /= 0)  exit BLOCK
                 call os_system_call (setenv_tex // &
                      phs_config%os_data%latex // " " // &
                      filename_vis // ".tex" // pipe, status)
                 if (status /= 0)  exit BLOCK
                 call os_system_call &
                      (phs_config%os_data%dvips // " -o " // filename_vis &
                      // ".ps " // filename_vis // ".dvi" // pipe_dvi, status)
                 if (status /= 0)  exit BLOCK
                 if (phs_config%os_data%event_analysis_pdf) then
                    call os_system_call (phs_config%os_data%ps2pdf // " " // &
                         filename_vis // ".ps", status)
                    if (status /= 0)  exit BLOCK
                 end if
                 exit BLOCK
              end do BLOCK
              if (status /= 0) then
                 call msg_error ("Unable to compile analysis output file")
              end if
           end if
        end if
     else
        call msg_fatal ("Phase-space configuration: &
             &no phase space object generated")
     end if
   end subroutine phs_wood_config_write_phase_space
 
 @ %def phs_config_write_phase_space
 @ Clear the phase-space configuration.  This is useful since the
 object may become \emph{really} large.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: clear_phase_space => phs_wood_config_clear_phase_space
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_clear_phase_space (phs_config)
     class(phs_wood_config_t), intent(inout) :: phs_config
     if (allocated (phs_config%cascade_set)) then
        call cascade_set_final (phs_config%cascade_set)
        deallocate (phs_config%cascade_set)
     end if
     if (allocated (phs_config%feyngraph_set)) then
        call phs_config%feyngraph_set%final ()
        deallocate (phs_config%feyngraph_set)
     end if
   end subroutine phs_wood_config_clear_phase_space
 
 @ %def phs_wood_config_clear_phase_space
 @
 Extract the set of resonance histories
 <<PHS wood: phs wood config: TBP>>=
   procedure :: extract_resonance_history_set &
        => phs_wood_config_extract_resonance_history_set
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_extract_resonance_history_set &
        (phs_config, res_set, include_trivial)
     class(phs_wood_config_t), intent(in) :: phs_config
     type(resonance_history_set_t), intent(out) :: res_set
     logical, intent(in), optional :: include_trivial
     call phs_config%forest%extract_resonance_history_set &
          (res_set, include_trivial)
   end subroutine phs_wood_config_extract_resonance_history_set
 
 @ %def phs_wood_config_extract_resonance_history_set
 @
 \subsection{Phase-space configuration}
 We read the phase-space configuration from the stored I/O unit.  If
 this is not set, we assume that we have to generate a phase space
 configuration.  When done, we open a scratch file and write the
 configuration.
 
 If [[rebuild]] is set, we should trash any existing phase space file
 and build a new one.  Otherwise, we try to use an old one, which we
 check for existence and integrity.  If [[ignore_mismatch]] is set, we
 reuse an existing file even if it does not match the current setup.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: configure => phs_wood_config_configure
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_configure (phs_config, sqrts, &
        sqrts_fixed, cm_frame, azimuthal_dependence, rebuild, ignore_mismatch, &
        nlo_type, subdir)
     class(phs_wood_config_t), intent(inout) :: phs_config
     real(default), intent(in) :: sqrts
     logical, intent(in), optional :: sqrts_fixed
     logical, intent(in), optional :: cm_frame
     logical, intent(in), optional :: azimuthal_dependence
     logical, intent(in), optional :: rebuild
     logical, intent(in), optional :: ignore_mismatch
     integer, intent(in), optional :: nlo_type
     type(string_t), intent(in), optional :: subdir
     type(string_t) :: filename, filename_vis
     logical :: variable_limits
     logical :: ok, exist, found, check, match, rebuild_phs
     integer :: g, c0, c1, n
     if (present (nlo_type)) then
       phs_config%nlo_type = nlo_type
     else
       phs_config%nlo_type = BORN
     end if
     phs_config%sqrts = sqrts
     phs_config%par%sqrts = sqrts
     if (present (sqrts_fixed)) &
          phs_config%sqrts_fixed = sqrts_fixed
     if (present (cm_frame)) &
          phs_config%cm_frame = cm_frame
     if (present (azimuthal_dependence)) &
          phs_config%azimuthal_dependence = azimuthal_dependence
     if (present (rebuild)) then
        rebuild_phs = rebuild
     else
        rebuild_phs = .true.
     end if
     if (present (ignore_mismatch)) then
        check = .not. ignore_mismatch
        if (ignore_mismatch) &
             call msg_warning ("Reading phs file: MD5 sum check disabled")
     else
        check = .true.
     end if
     phs_config%md5sum_forest = ""
     call phs_config%compute_md5sum (include_id = .false.)
     if (phs_config%io_unit == 0) then
        filename = phs_config%make_phs_filename (subdir)
        filename_vis = phs_config%make_phs_filename (subdir) // "-vis"
        if (.not. rebuild_phs) then
           if (check) then
              call phs_config%read_phs_file (exist, found, match, subdir=subdir)
              rebuild_phs = .not. (exist .and. found .and. match)
           else
              call phs_config%read_phs_file (exist, found, subdir=subdir)
              rebuild_phs = .not. (exist .and. found)
           end if
        end if
        if (.not. mpi_is_comm_master ()) then
           rebuild_phs = .false.
           call msg_message ("MPI: Workers do not build phase space configuration.")
        end if
        if (rebuild_phs) then
           call phs_config%generate_phase_space ()
           phs_config%io_unit = free_unit ()
           if (phs_config%id /= "") then
              call msg_message ("Phase space: writing configuration file '" &
                   // char (filename) // "'")
              open (phs_config%io_unit, file = char (filename), &
                   status = "replace", action = "readwrite")
           else
              open (phs_config%io_unit, status = "scratch", action = "readwrite")
           end if
           call phs_config%write_phase_space (filename_vis)
           rewind (phs_config%io_unit)
        else
           call msg_message ("Phase space: keeping configuration file '" &
                // char (filename) // "'")
        end if
     end if
     if (phs_config%io_unit == 0) then
        ok = .true.
     else
       call phs_forest_read (phs_config%forest, phs_config%io_unit, &
             phs_config%id, phs_config%n_in, phs_config%n_out, &
             phs_config%model, ok)
        if (.not. phs_config%io_unit_keep_open) then
           close (phs_config%io_unit)
           phs_config%io_unit = 0
        end if
     end if
     if (ok) then
        call phs_forest_set_flavors (phs_config%forest, phs_config%flv(:,1))
        variable_limits = .not. phs_config%cm_frame
        call phs_forest_set_parameters &
             (phs_config%forest, phs_config%mapping_defaults, variable_limits)
        call phs_forest_setup_prt_combinations (phs_config%forest)
        phs_config%n_channel = phs_forest_get_n_channels (phs_config%forest)
        phs_config%n_par = phs_forest_get_n_parameters (phs_config%forest)
        allocate (phs_config%channel (phs_config%n_channel))
        if (phs_config%use_equivalences) then
           call phs_forest_set_equivalences (phs_config%forest)
           call phs_forest_get_equivalences (phs_config%forest, &
                phs_config%channel, phs_config%azimuthal_dependence)
           phs_config%provides_equivalences = .true.
        end if
        call phs_forest_set_s_mappings (phs_config%forest)
        call phs_config%record_on_shell ()
        if (phs_config%mapping_defaults%enable_s_mapping) then
           call phs_config%record_s_mappings ()
        end if
        allocate (phs_config%chain (phs_config%n_channel), source = 0)
        do g = 1, phs_forest_get_n_groves (phs_config%forest)
           call phs_forest_get_grove_bounds (phs_config%forest, g, c0, c1, n)
           phs_config%chain (c0:c1) = g
        end do
        phs_config%provides_chains = .true.
        call phs_config%compute_md5sum_forest ()
     else
        write (msg_buffer, "(A,A,A)") &
             "Phase space: process '", &
             char (phs_config%id), "' not found in configuration file"
        call msg_fatal ()
     end if
   end subroutine phs_wood_config_configure
 
 @ %def phs_wood_config_configure
 @ The MD5 sum of the forest is computed in addition to the MD5 sum of
 the configuration.  The reason is that the forest may depend on a
 user-provided external file.  On the other hand, this MD5 sum encodes
 all information that is relevant for further processing.  Therefore,
 the [[get_md5sum]] method returns this result, once it is available.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: compute_md5sum_forest => phs_wood_config_compute_md5sum_forest
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_compute_md5sum_forest (phs_config)
     class(phs_wood_config_t), intent(inout) :: phs_config
     integer :: u
     u = free_unit ()
     open (u, status = "scratch", action = "readwrite")
     call phs_config%write_forest (u)
     rewind (u)
     phs_config%md5sum_forest = md5sum (u)
     close (u)
   end subroutine phs_wood_config_compute_md5sum_forest
 
 @ %def phs_wood_config_compute_md5sum_forest
 @ Create filenames according to standard conventions.  The [[id]] is the
 process name including the suffix [[_iX]] where [[X]] stands for the component
 identifier (an integer).  The [[run_id]] may be set or unset.
 
 The convention for file names that include the run ID is to separate prefix, run
 ID, and any extensions by dots.  We construct the file name by concatenating
 the individual elements accordingly.  If there is no run ID, we nevertheless
 replace [[_iX]] by [[.iX]].
 <<PHS wood: phs wood config: TBP>>=
   procedure :: make_phs_filename => phs_wood_make_phs_filename
 <<PHS wood: procedures>>=
   function phs_wood_make_phs_filename (phs_config, subdir) result (filename)
     class(phs_wood_config_t), intent(in) :: phs_config
     type(string_t), intent(in), optional :: subdir
     type(string_t) :: filename
     type(string_t) :: basename, suffix, comp_code, comp_index
     basename = phs_config%id
     call split (basename, suffix, "_", back=.true.)
     comp_code = extract (suffix, 1, 1)
     comp_index = extract (suffix, 2)
     if (comp_code == "i" .and. verify (comp_index, "1234567890") == 0) then
        suffix = "." // comp_code // comp_index
     else
        basename = phs_config%id
        suffix = ""
     end if
     if (phs_config%run_id /= "") then
        filename = basename // "." // phs_config%run_id // suffix // ".phs"
     else
        filename = basename // suffix // ".phs"
     end if
     if (present (subdir)) then
        filename = subdir // "/" // filename
     end if
   end function phs_wood_make_phs_filename
     
 @ %def phs_wood_make_phs_filename
 @
 <<PHS wood: phs wood config: TBP>>=
   procedure :: reshuffle_flavors => phs_wood_config_reshuffle_flavors
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_reshuffle_flavors (phs_config, reshuffle, flv_extra)
     class(phs_wood_config_t), intent(inout) :: phs_config
     integer, intent(in), dimension(:), allocatable :: reshuffle
     type(flavor_t), intent(in) :: flv_extra
     call phs_forest_set_flavors (phs_config%forest, phs_config%flv(:,1), reshuffle, flv_extra)
   end subroutine phs_wood_config_reshuffle_flavors
 
 @ %def phs_wood_config_reshuffle_flavors
 @
 <<PHS wood: phs wood config: TBP>>=
   procedure :: set_momentum_links => phs_wood_config_set_momentum_links
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_set_momentum_links (phs_config, reshuffle)
     class(phs_wood_config_t), intent(inout) :: phs_config
     integer, intent(in), dimension(:), allocatable :: reshuffle
     call phs_forest_set_momentum_links (phs_config%forest, reshuffle)
   end subroutine phs_wood_config_set_momentum_links
 
 @ %def phs_wood_config_set_momentum_links
 @ Identify resonances which are marked by s-channel mappings for the
 whole phase space and report them to the channel array.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: record_s_mappings => phs_wood_config_record_s_mappings
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_record_s_mappings (phs_config)
     class(phs_wood_config_t), intent(inout) :: phs_config
     logical :: flag
     real(default) :: mass, width
     integer :: c
     do c = 1, phs_config%n_channel
        call phs_forest_get_s_mapping (phs_config%forest, c, flag, mass, width)
        if (flag) then
           if (mass == 0) then
              call msg_fatal ("Phase space: s-channel resonance " &
                   // " has zero mass")
           end if
           if (width == 0) then
              call msg_fatal ("Phase space: s-channel resonance " &
                   // " has zero width")
           end if
           call phs_config%channel(c)%set_resonant (mass, width)
        end if
     end do
   end subroutine phs_wood_config_record_s_mappings
 
 @ %def phs_wood_config_record_s_mappings
 @ Identify on-shell mappings for the whole phase space and report them
 to the channel array.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: record_on_shell => phs_wood_config_record_on_shell
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_record_on_shell (phs_config)
     class(phs_wood_config_t), intent(inout) :: phs_config
     logical :: flag
     real(default) :: mass
     integer :: c
     do c = 1, phs_config%n_channel
        call phs_forest_get_on_shell (phs_config%forest, c, flag, mass)
        if (flag) then
           call phs_config%channel(c)%set_on_shell (mass)
        end if
     end do
   end subroutine phs_wood_config_record_on_shell
 
 @ %def phs_wood_config_record_on_shell
 @ Return the most relevant MD5 sum.  This overrides the method of the
 base type.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: get_md5sum => phs_wood_config_get_md5sum
 <<PHS wood: procedures>>=
   function phs_wood_config_get_md5sum (phs_config) result (md5sum)
     class(phs_wood_config_t), intent(in) :: phs_config
     character(32) :: md5sum
     if (phs_config%md5sum_forest /= "") then
        md5sum = phs_config%md5sum_forest
     else
        md5sum = phs_config%md5sum_phs_config
     end if
   end function phs_wood_config_get_md5sum
 
 @ %def phs_wood_config_get_md5sum
 @ Check whether a phase-space configuration for the current process exists.
 We look for the phase-space file that should correspond to the current
 process.  If we find it, we check the MD5 sums stored in the file against the
 MD5 sums in the current configuration (if required).
 
 If successful, read the PHS file.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: read_phs_file => phs_wood_read_phs_file
 <<PHS wood: procedures>>=
   subroutine phs_wood_read_phs_file (phs_config, exist, found, match, subdir)
     class(phs_wood_config_t), intent(inout) :: phs_config
     logical, intent(out) :: exist
     logical, intent(out) :: found
     logical, intent(out), optional :: match
     type(string_t), intent(in), optional :: subdir
     type(string_t) :: filename
     integer :: u
     filename = phs_config%make_phs_filename (subdir)
     inquire (file = char (filename), exist = exist)
     if (exist) then
        u = free_unit ()
        open (u, file = char (filename), action = "read", status = "old")
        call phs_forest_read (phs_config%forest, u, &
             phs_config%id, phs_config%n_in, phs_config%n_out, &
             phs_config%model, found, &
             phs_config%md5sum_process, &
             phs_config%md5sum_model_par, &
             phs_config%md5sum_phs_config, &
             match = match)
        close (u)
     else
        found = .false.
        if (present (match))  match = .false.
     end if
   end subroutine phs_wood_read_phs_file
 
 @ %def phs_wood_read_phs_file
 @ Startup message, after configuration is complete.
 <<PHS wood: phs wood config: TBP>>=
   procedure :: startup_message => phs_wood_config_startup_message
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_startup_message (phs_config, unit)
     class(phs_wood_config_t), intent(in) :: phs_config
     integer, intent(in), optional :: unit
     integer :: n_groves, n_eq
     n_groves = phs_forest_get_n_groves (phs_config%forest)
     n_eq = phs_forest_get_n_equivalences (phs_config%forest)
     call phs_config%base_startup_message (unit)
     if (phs_config%n_channel == 1) then
        write (msg_buffer, "(A,2(I0,A))") &
             "Phase space: found ", phs_config%n_channel, &
             " channel, collected in ", n_groves, &
             " grove."
     else if (n_groves == 1) then
        write (msg_buffer, "(A,2(I0,A))") &
             "Phase space: found ", phs_config%n_channel, &
             " channels, collected in ", n_groves, &
             " grove."
        else
        write (msg_buffer, "(A,2(I0,A))") &
             "Phase space: found ", phs_config%n_channel, &
             " channels, collected in ", &
             phs_forest_get_n_groves (phs_config%forest), &
             " groves."
     end if
     call msg_message (unit = unit)
     if (phs_config%use_equivalences) then
        if (n_eq == 1) then
           write (msg_buffer, "(A,I0,A)") &
                "Phase space: Using ", n_eq, &
                " equivalence between channels."
        else
           write (msg_buffer, "(A,I0,A)") &
                "Phase space: Using ", n_eq, &
                " equivalences between channels."
        end if
     else
        write (msg_buffer, "(A)") &
             "Phase space: no equivalences between channels used."
     end if
     call msg_message (unit = unit)
     write (msg_buffer, "(A,2(1x,I0,1x,A))") &
          "Phase space: wood"
     call msg_message (unit = unit)
   end subroutine phs_wood_config_startup_message
 
 @ %def phs_wood_config_startup_message
 @ Allocate an instance: the actual phase-space object.
 <<PHS wood: phs wood config: TBP>>=
   procedure, nopass :: allocate_instance => phs_wood_config_allocate_instance
 <<PHS wood: procedures>>=
   subroutine phs_wood_config_allocate_instance (phs)
     class(phs_t), intent(inout), pointer :: phs
     allocate (phs_wood_t :: phs)
   end subroutine phs_wood_config_allocate_instance
 
 @ %def phs_wood_config_allocate_instance
 @
 \subsection{Kinematics implementation}
 We generate $\cos\theta$ and $\phi$ uniformly, covering the solid angle.
 <<PHS wood: public>>=
   public :: phs_wood_t
 <<PHS wood: types>>=
   type, extends (phs_t) :: phs_wood_t
      real(default) :: sqrts = 0
      type(phs_forest_t) :: forest
      real(default), dimension(3) :: r_real
      integer :: n_r_born = 0
    contains
    <<PHS wood: phs wood: TBP>>
   end type phs_wood_t
 
 @ %def phs_wood_t
 @ Output.  The [[verbose]] setting is irrelevant, we just display the contents
 of the base object.
 <<PHS wood: phs wood: TBP>>=
   procedure :: write => phs_wood_write
 <<PHS wood: procedures>>=
   subroutine phs_wood_write (object, unit, verbose)
     class(phs_wood_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u
     u = given_output_unit (unit)
     call object%base_write (u)
   end subroutine phs_wood_write
 
 @ %def phs_wood_write
 @ Write the forest separately.
 <<PHS wood: phs wood: TBP>>=
   procedure :: write_forest => phs_wood_write_forest
 <<PHS wood: procedures>>=
   subroutine phs_wood_write_forest (object, unit)
     class(phs_wood_t), intent(in) :: object
     integer, intent(in), optional :: unit
     integer :: u
     u = given_output_unit (unit)
     call phs_forest_write (object%forest, u)
   end subroutine phs_wood_write_forest
 
 @ %def phs_wood_write_forest
 @ Finalizer.
 <<PHS wood: phs wood: TBP>>=
   procedure :: final => phs_wood_final
 <<PHS wood: procedures>>=
   subroutine phs_wood_final (object)
     class(phs_wood_t), intent(inout) :: object
     call phs_forest_final (object%forest)
   end subroutine phs_wood_final
 
 @ %def phs_wood_final
 @ Initialization.  We allocate arrays ([[base_init]]) and adjust the
 phase-space volume.  The two-particle phase space volume is
 \begin{equation}
   \Phi_2 = \frac{1}{4(2\pi)^5} = 2.55294034614 \times 10^{-5}
 \end{equation}
 independent of the particle masses.
 <<PHS wood: phs wood: TBP>>=
   procedure :: init => phs_wood_init
 <<PHS wood: procedures>>=
   subroutine phs_wood_init (phs, phs_config)
     class(phs_wood_t), intent(out) :: phs
     class(phs_config_t), intent(in), target :: phs_config
     call phs%base_init (phs_config)
     select type (phs_config)
     type is (phs_wood_config_t)
        phs%forest = phs_config%forest
        select case (phs_config%extension_mode)
        case (EXTENSION_DEFAULT)
           phs%n_r_born = phs_config%n_par - 3
        case (EXTENSION_DGLAP)
           phs%n_r_born = phs_config%n_par - 4
        end select
     end select
   end subroutine phs_wood_init
 
 @ %def phs_wood_init
 @
 \subsection{Evaluation}
 We compute the outgoing momenta from the incoming momenta and
 the input parameter set [[r_in]] in channel [[r_in]].  We also compute the
 [[r]] parameters and Jacobians [[f]] for all other channels.
 
 We do \emph{not} need to a apply a transformation from/to the c.m.\ frame,
 because in [[phs_base]] the momenta are already boosted to the c.m.\ frame
 before assigning them in the [[phs]] object, and inversely boosted when
 extracting them.
 <<PHS wood: phs wood: TBP>>=
   procedure :: evaluate_selected_channel => phs_wood_evaluate_selected_channel
   procedure :: evaluate_other_channels => phs_wood_evaluate_other_channels
 <<PHS wood: procedures>>=
   subroutine phs_wood_evaluate_selected_channel (phs, c_in, r_in)
     class(phs_wood_t), intent(inout) :: phs
     integer, intent(in) :: c_in
     real(default), intent(in), dimension(:) :: r_in
     logical :: ok
     phs%q_defined = .false.
     if (phs%p_defined) then
        call phs_forest_set_prt_in (phs%forest, phs%p)
        phs%r(:,c_in) = r_in
        call phs_forest_evaluate_selected_channel (phs%forest, &
             c_in, phs%active_channel, &
             phs%sqrts_hat, phs%r, phs%f, phs%volume, ok)
        select type (config => phs%config)
        type is (phs_wood_config_t)
           if (config%extension_mode > EXTENSION_NONE) then
              if (phs%n_r_born > 0) then
                 phs%r_real = r_in (phs%n_r_born + 1 : phs%n_r_born + 3)
              else
                 call msg_fatal ("n_r_born should be larger than 0!")
              end if
           end if
        end select
        if (ok) then
           phs%q = phs_forest_get_momenta_out (phs%forest)
           phs%q_defined = .true.
        end if
     end if
   end subroutine phs_wood_evaluate_selected_channel
 
   subroutine phs_wood_evaluate_other_channels (phs, c_in)
     class(phs_wood_t), intent(inout) :: phs
     integer, intent(in) :: c_in
     integer :: c
     if (phs%q_defined) then
        call phs_forest_evaluate_other_channels (phs%forest, &
             c_in, phs%active_channel, &
             phs%sqrts_hat, phs%r, phs%f, combine=.true.)
        select type (config => phs%config)
        type is (phs_wood_config_t)
           if (config%extension_mode > EXTENSION_NONE) then
              if (phs%n_r_born > 0) then
                 do c = 1, size (phs%r, 2)
                    phs%r(phs%n_r_born + 1 : phs%n_r_born + 3, c) = phs%r_real
                 end do
              else
                 phs%r_defined = .false.
              end if
           end if
        end select
        phs%r_defined = .true.
     end if
   end subroutine phs_wood_evaluate_other_channels
 
 @ %def phs_wood_evaluate_selected_channel
 @ %def phs_wood_evaluate_other_channels
 @ Inverse evaluation.
 <<PHS wood: phs wood: TBP>>=
   procedure :: inverse => phs_wood_inverse
 <<PHS wood: procedures>>=
   subroutine phs_wood_inverse (phs)
     class(phs_wood_t), intent(inout) :: phs
     if (phs%p_defined .and. phs%q_defined) then
        call phs_forest_set_prt_in (phs%forest, phs%p)
        call phs_forest_set_prt_out (phs%forest, phs%q)
        call phs_forest_recover_channel (phs%forest, &
             1, &
             phs%sqrts_hat, phs%r, phs%f, phs%volume)
        call phs_forest_evaluate_other_channels (phs%forest, &
             1, phs%active_channel, &
             phs%sqrts_hat, phs%r, phs%f, combine=.false.)
        phs%r_defined = .true.
     end if
   end subroutine phs_wood_inverse
 
 @ %def phs_wood_inverse
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[phs_wood_ut.f90]]>>=
 <<File header>>
 
 module phs_wood_ut
   use unit_tests
   use phs_wood_uti
 
 <<Standard module head>>
 
 <<PHS wood: public test>>
 
 <<PHS wood: public test auxiliary>>
 
 contains
 
 <<PHS wood: test driver>>
 
 end module phs_wood_ut
 @ %def phs_wood_ut
 @
 <<[[phs_wood_uti.f90]]>>=
 <<File header>>
 
 module phs_wood_uti
 
 <<Use kinds>>
 <<Use strings>>
   use io_units
   use os_interface
   use lorentz
   use flavors
   use model_data
   use process_constants
   use mappings
   use phs_base
   use phs_forests
 
   use phs_wood
 
   use phs_base_ut, only: init_test_process_data, init_test_decay_data
 
 <<Standard module head>>
 
 <<PHS wood: public test auxiliary>>
 
 <<PHS wood: test declarations>>
 
 contains
 
 <<PHS wood: tests>>
 
 <<PHS wood: test auxiliary>>
 
 end module phs_wood_uti
 @ %def phs_wood_ut
 @ API: driver for the unit tests below.
 <<PHS wood: public test>>=
   public :: phs_wood_test
 <<PHS wood: test driver>>=
   subroutine phs_wood_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<PHS wood: execute tests>>
   end subroutine phs_wood_test
 
 @ %def phs_wood_test
 <<PHS wood: public test>>=
   public :: phs_wood_vis_test
 <<PHS wood: test driver>>=
   subroutine phs_wood_vis_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<PHS wood: execute vis tests>>
   end subroutine phs_wood_vis_test
 
 @ %def phs_wood_vis_test
 @
 \subsubsection{Phase-space configuration data}
 Construct and display a test phase-space configuration object.  Also
 check the [[azimuthal_dependence]] flag.
 
 This auxiliary routine writes a phase-space configuration file to unit
 [[u_phs]].
 <<PHS wood: public test auxiliary>>=
   public :: write_test_phs_file
 <<PHS wood: test auxiliary>>=
   subroutine write_test_phs_file (u_phs, procname)
     integer, intent(in) :: u_phs
     type(string_t), intent(in), optional :: procname
     if (present (procname)) then
        write (u_phs, "(A,A)")  "process ", char (procname)
     else
        write (u_phs, "(A)")  "process testproc"
     end if
     write (u_phs, "(A,A)")  "   md5sum_process    = ", '""'
     write (u_phs, "(A,A)")  "   md5sum_model_par  = ", '""'
     write (u_phs, "(A,A)")  "   md5sum_phs_config = ", '""'
     write (u_phs, "(A)")  "   sqrts         = 1000"
     write (u_phs, "(A)")  "   m_threshold_s =   50"
     write (u_phs, "(A)")  "   m_threshold_t =  100"
     write (u_phs, "(A)")  "   off_shell = 2"
     write (u_phs, "(A)")  "   t_channel = 6"
     write (u_phs, "(A)")  "   keep_nonresonant = T"
     write (u_phs, "(A)")  "  grove #1"
     write (u_phs, "(A)")  "    tree 3"
   end subroutine write_test_phs_file
 
 @ %def write_test_phs_file
 @
 <<PHS wood: execute tests>>=
   call test (phs_wood_1, "phs_wood_1", &
        "phase-space configuration", &
        u, results)
 <<PHS wood: test declarations>>=
   public :: phs_wood_1
 <<PHS wood: tests>>=
   subroutine phs_wood_1 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(process_constants_t) :: process_data
     class(phs_config_t), allocatable :: phs_data
     type(mapping_defaults_t) :: mapping_defaults
     real(default) :: sqrts
     integer :: u_phs, iostat
     character(32) :: buffer
 
     write (u, "(A)")  "* Test output: phs_wood_1"
     write (u, "(A)")  "*   Purpose: initialize and display &
          &phase-space configuration data"
     write (u, "(A)")
 
     call model%init_test ()
 
     call syntax_phs_forest_init ()
 
     write (u, "(A)")  "* Initialize a process"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_wood_1"), process_data)
 
     write (u, "(A)")  "* Create a scratch phase-space file"
     write (u, "(A)")
 
     u_phs = free_unit ()
     open (u_phs, status = "scratch", action = "readwrite")
     call write_test_phs_file (u_phs, var_str ("phs_wood_1"))
     rewind (u_phs)
     do
        read (u_phs, "(A)", iostat = iostat)  buffer
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup phase-space configuration object"
     write (u, "(A)")
 
     mapping_defaults%step_mapping = .false.
 
     allocate (phs_wood_config_t :: phs_data)
     call phs_data%init (process_data, model)
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_input (u_phs)
        call phs_data%set_mapping_defaults (mapping_defaults)
     end select
 
     sqrts = 1000._default
     call phs_data%configure (sqrts)
 
     call phs_data%write (u)
     write (u, "(A)")
 
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%write_forest (u)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     close (u_phs)
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_wood_1"
 
   end subroutine phs_wood_1
 
 @ %def phs_wood_1
 @
 \subsubsection{Phase space evaluation}
 Compute kinematics for given parameters, also invert the calculation.
 <<PHS wood: execute tests>>=
   call test (phs_wood_2, "phs_wood_2", &
        "phase-space evaluation", &
        u, results)
 <<PHS wood: test declarations>>=
   public :: phs_wood_2
 <<PHS wood: tests>>=
   subroutine phs_wood_2 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(flavor_t) :: flv
     type(process_constants_t) :: process_data
     real(default) :: sqrts, E
     class(phs_config_t), allocatable, target :: phs_data
     class(phs_t), pointer :: phs => null ()
     type(vector4_t), dimension(2) :: p, q
     integer :: u_phs
 
     write (u, "(A)")  "* Test output: phs_wood_2"
     write (u, "(A)")  "*   Purpose: test simple single-channel phase space"
     write (u, "(A)")
 
     call model%init_test ()
     call flv%init (25, model)
 
     write (u, "(A)")  "* Initialize a process and a matching &
          &phase-space configuration"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_wood_2"), process_data)
     u_phs = free_unit ()
     open (u_phs, status = "scratch", action = "readwrite")
     call write_test_phs_file (u_phs, var_str ("phs_wood_2"))
     rewind (u_phs)
 
     allocate (phs_wood_config_t :: phs_data)
     call phs_data%init (process_data, model)
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_input (u_phs)
     end select
 
     sqrts = 1000._default
     call phs_data%configure (sqrts)
 
     call phs_data%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize the phase-space instance"
     write (u, "(A)")
 
     call phs_data%allocate_instance (phs)
     call phs%init (phs_data)
 
     call phs%write (u, verbose=.true.)
 
     write (u, "(A)")
     write (u, "(A)")  "* Set incoming momenta"
     write (u, "(A)")
 
     E = sqrts / 2
     p(1) = vector4_moving (E, sqrt (E**2 - flv%get_mass ()**2), 3)
     p(2) = vector4_moving (E,-sqrt (E**2 - flv%get_mass ()**2), 3)
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
     call phs%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Compute phase-space point &
          &for x = 0.125, 0.5"
     write (u, "(A)")
 
     call phs%evaluate_selected_channel (1, [0.125_default, 0.5_default])
     call phs%evaluate_other_channels (1)
     call phs%write (u)
     write (u, "(A)")
     select type (phs)
     type is (phs_wood_t)
        call phs%write_forest (u)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Inverse kinematics"
     write (u, "(A)")
 
     call phs%get_outgoing_momenta (q)
     call phs%final ()
     deallocate (phs)
 
     call phs_data%allocate_instance (phs)
     call phs%init (phs_data)
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
     call phs%set_outgoing_momenta (q)
 
     call phs%inverse ()
     call phs%write (u)
     write (u, "(A)")
     select type (phs)
     type is (phs_wood_t)
        call phs%write_forest (u)
     end select
 
     call phs%final ()
     deallocate (phs)
 
     close (u_phs)
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_wood_2"
 
   end subroutine phs_wood_2
 
 @ %def phs_wood_2
 @
 \subsubsection{Phase-space generation}
 Generate phase space for a simple process.
 <<PHS wood: execute tests>>=
   call test (phs_wood_3, "phs_wood_3", &
        "phase-space generation", &
        u, results)
 <<PHS wood: test declarations>>=
   public :: phs_wood_3
 <<PHS wood: tests>>=
   subroutine phs_wood_3 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(process_constants_t) :: process_data
     type(phs_parameters_t) :: phs_par
     class(phs_config_t), allocatable :: phs_data
     integer :: iostat
     character(80) :: buffer
 
     write (u, "(A)")  "* Test output: phs_wood_3"
     write (u, "(A)")  "*   Purpose: generate a phase-space configuration"
     write (u, "(A)")
 
     call model%init_test ()
 
     call syntax_phs_forest_init ()
 
     write (u, "(A)")  "* Initialize a process and phase-space parameters"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_wood_3"), process_data)
     allocate (phs_wood_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     phs_par%sqrts = 1000
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_parameters (phs_par)
        phs_data%io_unit_keep_open = .true.
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate a scratch phase-space file"
     write (u, "(A)")
 
     call phs_data%configure (phs_par%sqrts)
 
     select type (phs_data)
     type is (phs_wood_config_t)
        rewind (phs_data%io_unit)
        do
           read (phs_data%io_unit, "(A)", iostat = iostat)  buffer
           if (iostat /= 0)  exit
           write (u, "(A)") trim (buffer)
        end do
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_wood_3"
 
   end subroutine phs_wood_3
 
 @ %def phs_wood_3
 @
 \subsubsection{Nontrivial process}
 Generate phase space for a $2\to 3$ process.
 <<PHS wood: execute tests>>=
   call test (phs_wood_4, "phs_wood_4", &
        "nontrivial process", &
        u, results)
 <<PHS wood: test declarations>>=
   public :: phs_wood_4
 <<PHS wood: tests>>=
   subroutine phs_wood_4 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(process_constants_t) :: process_data
     type(phs_parameters_t) :: phs_par
     class(phs_config_t), allocatable, target :: phs_data
     integer :: iostat
     character(80) :: buffer
     class(phs_t), pointer :: phs => null ()
     real(default) :: E, pL
     type(vector4_t), dimension(2) :: p
     type(vector4_t), dimension(3) :: q
 
     write (u, "(A)")  "* Test output: phs_wood_4"
     write (u, "(A)")  "*   Purpose: generate a phase-space configuration"
     write (u, "(A)")
 
     call model%init_test ()
 
     call syntax_phs_forest_init ()
 
     write (u, "(A)")  "* Initialize a process and phase-space parameters"
     write (u, "(A)")
 
     process_data%id = "phs_wood_4"
     process_data%model_name = "Test"
     process_data%n_in = 2
     process_data%n_out = 3
     process_data%n_flv = 1
     allocate (process_data%flv_state (process_data%n_in + process_data%n_out, &
          process_data%n_flv))
     process_data%flv_state(:,1) = [25, 25, 25, 6, -6]
 
     allocate (phs_wood_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     phs_par%sqrts = 1000
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_parameters (phs_par)
        phs_data%io_unit_keep_open = .true.
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate a scratch phase-space file"
     write (u, "(A)")
 
     call phs_data%configure (phs_par%sqrts)
 
     select type (phs_data)
     type is (phs_wood_config_t)
        rewind (phs_data%io_unit)
        do
           read (phs_data%io_unit, "(A)", iostat = iostat)  buffer
           if (iostat /= 0)  exit
           write (u, "(A)") trim (buffer)
        end do
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Initialize the phase-space instance"
     write (u, "(A)")
 
     call phs_data%allocate_instance (phs)
     call phs%init (phs_data)
 
     write (u, "(A)")  "* Set incoming momenta"
     write (u, "(A)")
 
     select type (phs_data)
     type is (phs_wood_config_t)
        E = phs_data%sqrts / 2
        pL = sqrt (E**2 - phs_data%flv(1,1)%get_mass ()**2)
     end select
     p(1) = vector4_moving (E, pL, 3)
     p(2) = vector4_moving (E, -pL, 3)
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
 
     write (u, "(A)")  "* Compute phase-space point &
          &for x = 0.1, 0.2, 0.3, 0.4, 0.5"
     write (u, "(A)")
 
     call phs%evaluate_selected_channel (1, &
          [0.1_default, 0.2_default, 0.3_default, 0.4_default, 0.5_default])
     call phs%evaluate_other_channels (1)
     call phs%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Inverse kinematics"
     write (u, "(A)")
 
     call phs%get_outgoing_momenta (q)
     call phs%final ()
     deallocate (phs)
 
     call phs_data%allocate_instance (phs)
     call phs%init (phs_data)
 
     call phs%set_incoming_momenta (p)
     call phs%compute_flux ()
     call phs%set_outgoing_momenta (q)
 
     call phs%inverse ()
     call phs%write (u)
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call phs%final ()
     deallocate (phs)
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_wood_4"
 
   end subroutine phs_wood_4
 
 @ %def phs_wood_4
 @
 \subsubsection{Equivalences}
 Generate phase space for a simple process, including channel equivalences.
 <<PHS wood: execute tests>>=
   call test (phs_wood_5, "phs_wood_5", &
        "equivalences", &
        u, results)
 <<PHS wood: test declarations>>=
   public :: phs_wood_5
 <<PHS wood: tests>>=
   subroutine phs_wood_5 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(process_constants_t) :: process_data
     type(phs_parameters_t) :: phs_par
     class(phs_config_t), allocatable :: phs_data
 
     write (u, "(A)")  "* Test output: phs_wood_5"
     write (u, "(A)")  "*   Purpose: generate a phase-space configuration"
     write (u, "(A)")
 
     call model%init_test ()
 
     call syntax_phs_forest_init ()
 
     write (u, "(A)")  "* Initialize a process and phase-space parameters"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_wood_5"), process_data)
     allocate (phs_wood_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     phs_par%sqrts = 1000
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_parameters (phs_par)
        call phs_data%enable_equivalences ()
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate a scratch phase-space file"
     write (u, "(A)")
 
     call phs_data%configure (phs_par%sqrts)
     call phs_data%write (u)
     write (u, "(A)")
 
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%write_forest (u)
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_wood_5"
 
   end subroutine phs_wood_5
 
 @ %def phs_wood_5
 @
 \subsubsection{MD5 sum checks}
 Generate phase space for a simple process.  Repeat this with and without
 parameter change.
 <<PHS wood: execute tests>>=
   call test (phs_wood_6, "phs_wood_6", &
        "phase-space generation", &
        u, results)
 <<PHS wood: test declarations>>=
   public :: phs_wood_6
 <<PHS wood: tests>>=
   subroutine phs_wood_6 (u)
     integer, intent(in) :: u
     type(model_data_t), target :: model
     type(process_constants_t) :: process_data
     type(phs_parameters_t) :: phs_par
     class(phs_config_t), allocatable :: phs_data
     logical :: exist, found, match
     integer :: u_phs
     character(*), parameter :: filename = "phs_wood_6_p.phs"
 
     write (u, "(A)")  "* Test output: phs_wood_6"
     write (u, "(A)")  "*   Purpose: generate and check  phase-space file"
     write (u, "(A)")
 
     call model%init_test ()
 
     call syntax_phs_forest_init ()
 
     write (u, "(A)")  "* Initialize a process and phase-space parameters"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_wood_6"), process_data)
     process_data%id = "phs_wood_6_p"
     process_data%md5sum = "1234567890abcdef1234567890abcdef"
     allocate (phs_wood_config_t :: phs_data)
     call phs_data%init (process_data, model)
 
     phs_par%sqrts = 1000
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_parameters (phs_par)
     end select
 
     write (u, "(A)")  "* Remove previous phs file, if any"
     write (u, "(A)")
 
     inquire (file = filename, exist = exist)
     if (exist) then
        u_phs = free_unit ()
        open (u_phs, file = filename, action = "write")
        close (u_phs, status = "delete")
     end if
 
     write (u, "(A)")  "* Check phase-space file (should fail)"
     write (u, "(A)")
 
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%read_phs_file (exist, found, match)
        write (u, "(1x,A,L1)")  "exist = ", exist
        write (u, "(1x,A,L1)")  "found = ", found
        write (u, "(1x,A,L1)")  "match = ", match
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Generate a phase-space file"
     write (u, "(A)")
 
     call phs_data%configure (phs_par%sqrts)
 
     write (u, "(1x,A,A,A)")  "MD5 sum (process)    = '", &
          phs_data%md5sum_process, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (model par)  = '", &
          phs_data%md5sum_model_par, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (phs config) = '", &
          phs_data%md5sum_phs_config, "'"
 
     write (u, "(A)")
     write (u, "(A)")  "* Check MD5 sum"
     write (u, "(A)")
 
     call phs_data%final ()
     deallocate (phs_data)
     allocate (phs_wood_config_t :: phs_data)
     call phs_data%init (process_data, model)
     phs_par%sqrts = 1000
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_parameters (phs_par)
        phs_data%sqrts = phs_par%sqrts
        phs_data%par%sqrts = phs_par%sqrts
     end select
     call phs_data%compute_md5sum ()
 
     write (u, "(1x,A,A,A)")  "MD5 sum (process)    = '", &
          phs_data%md5sum_process, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (model par)  = '", &
          phs_data%md5sum_model_par, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (phs config) = '", &
          phs_data%md5sum_phs_config, "'"
 
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%read_phs_file (exist, found, match)
        write (u, "(1x,A,L1)")  "exist = ", exist
        write (u, "(1x,A,L1)")  "found = ", found
        write (u, "(1x,A,L1)")  "match = ", match
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Modify sqrts and check MD5 sum"
     write (u, "(A)")
 
     call phs_data%final ()
     deallocate (phs_data)
     allocate (phs_wood_config_t :: phs_data)
     call phs_data%init (process_data, model)
     phs_par%sqrts = 500
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_parameters (phs_par)
        phs_data%sqrts = phs_par%sqrts
        phs_data%par%sqrts = phs_par%sqrts
     end select
     call phs_data%compute_md5sum ()
 
     write (u, "(1x,A,A,A)")  "MD5 sum (process)    = '", &
          phs_data%md5sum_process, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (model par)  = '", &
          phs_data%md5sum_model_par, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (phs config) = '", &
          phs_data%md5sum_phs_config, "'"
 
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%read_phs_file (exist, found, match)
        write (u, "(1x,A,L1)")  "exist = ", exist
        write (u, "(1x,A,L1)")  "found = ", found
        write (u, "(1x,A,L1)")  "match = ", match
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Modify process and check MD5 sum"
     write (u, "(A)")
 
     call phs_data%final ()
     deallocate (phs_data)
     process_data%md5sum = "77777777777777777777777777777777"
     allocate (phs_wood_config_t :: phs_data)
     call phs_data%init (process_data, model)
     phs_par%sqrts = 1000
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_parameters (phs_par)
        phs_data%sqrts = phs_par%sqrts
        phs_data%par%sqrts = phs_par%sqrts
     end select
     call phs_data%compute_md5sum ()
 
     write (u, "(1x,A,A,A)")  "MD5 sum (process)    = '", &
          phs_data%md5sum_process, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (model par)  = '", &
          phs_data%md5sum_model_par, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (phs config) = '", &
          phs_data%md5sum_phs_config, "'"
 
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%read_phs_file (exist, found, match)
        write (u, "(1x,A,L1)")  "exist = ", exist
        write (u, "(1x,A,L1)")  "found = ", found
        write (u, "(1x,A,L1)")  "match = ", match
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Modify phs parameter and check MD5 sum"
     write (u, "(A)")
 
     call phs_data%final ()
     deallocate (phs_data)
     allocate (phs_wood_config_t :: phs_data)
     process_data%md5sum = "1234567890abcdef1234567890abcdef"
     call phs_data%init (process_data, model)
     phs_par%sqrts = 1000
     phs_par%off_shell = 17
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_parameters (phs_par)
        phs_data%sqrts = phs_par%sqrts
        phs_data%par%sqrts = phs_par%sqrts
     end select
     call phs_data%compute_md5sum ()
 
     write (u, "(1x,A,A,A)")  "MD5 sum (process)    = '", &
          phs_data%md5sum_process, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (model par)  = '", &
          phs_data%md5sum_model_par, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (phs config) = '", &
          phs_data%md5sum_phs_config, "'"
 
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%read_phs_file (exist, found, match)
        write (u, "(1x,A,L1)")  "exist = ", exist
        write (u, "(1x,A,L1)")  "found = ", found
        write (u, "(1x,A,L1)")  "match = ", match
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Modify model parameter and check MD5 sum"
     write (u, "(A)")
 
     call phs_data%final ()
     deallocate (phs_data)
     allocate (phs_wood_config_t :: phs_data)
     call model%set_par (var_str ("ms"), 100._default)
     call phs_data%init (process_data, model)
     phs_par%sqrts = 1000
     phs_par%off_shell = 1
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_parameters (phs_par)
        phs_data%sqrts = phs_par%sqrts
        phs_data%par%sqrts = phs_par%sqrts
     end select
     call phs_data%compute_md5sum ()
 
     write (u, "(1x,A,A,A)")  "MD5 sum (process)    = '", &
          phs_data%md5sum_process, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (model par)  = '", &
          phs_data%md5sum_model_par, "'"
     write (u, "(1x,A,A,A)")  "MD5 sum (phs config) = '", &
          phs_data%md5sum_phs_config, "'"
 
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%read_phs_file (exist, found, match)
        write (u, "(1x,A,L1)")  "exist = ", exist
        write (u, "(1x,A,L1)")  "found = ", found
        write (u, "(1x,A,L1)")  "match = ", match
     end select
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_wood_6"
 
   end subroutine phs_wood_6
 
 @ %def phs_wood_6
 @
 <<PHS wood: execute vis tests>>=
   call test (phs_wood_vis_1, "phs_wood_vis_1", &
        "visualizing phase space channels", &
        u, results)
 <<PHS wood: test declarations>>=
   public :: phs_wood_vis_1
 <<PHS wood: tests>>=
   subroutine phs_wood_vis_1 (u)
     integer, intent(in) :: u
     type(os_data_t) :: os_data
     type(model_data_t), target :: model
     type(process_constants_t) :: process_data
     class(phs_config_t), allocatable :: phs_data
     type(mapping_defaults_t) :: mapping_defaults
     type(string_t) :: vis_file, pdf_file, ps_file
     real(default) :: sqrts
     logical :: exist, exist_pdf, exist_ps
     integer :: u_phs, iostat, u_vis
     character(95) :: buffer
 
     write (u, "(A)")  "* Test output: phs_wood_vis_1"
     write (u, "(A)")  "*   Purpose: visualizing the &
          &phase-space configuration"
     write (u, "(A)")
 
     call os_data_init (os_data)
     call model%init_test ()
 
     call syntax_phs_forest_init ()
 
     write (u, "(A)")  "* Initialize a process"
     write (u, "(A)")
 
     call init_test_process_data (var_str ("phs_wood_vis_1"), process_data)
 
     write (u, "(A)")  "* Create a scratch phase-space file"
     write (u, "(A)")
 
     u_phs = free_unit ()
     open (u_phs, status = "scratch", action = "readwrite")
     call write_test_phs_file (u_phs, var_str ("phs_wood_vis_1"))
     rewind (u_phs)
     do
        read (u_phs, "(A)", iostat = iostat)  buffer
        if (iostat /= 0)  exit
        write (u, "(A)") trim (buffer)
     end do
 
     write (u, "(A)")
     write (u, "(A)")  "* Setup phase-space configuration object"
     write (u, "(A)")
 
     mapping_defaults%step_mapping = .false.
 
     allocate (phs_wood_config_t :: phs_data)
     call phs_data%init (process_data, model)
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%set_input (u_phs)
        call phs_data%set_mapping_defaults (mapping_defaults)
        phs_data%os_data = os_data
        phs_data%io_unit = 0
        phs_data%io_unit_keep_open = .true.
        phs_data%vis_channels = .true.
     end select
 
     sqrts = 1000._default
     call phs_data%configure (sqrts)
 
     call phs_data%write (u)
     write (u, "(A)")
 
     select type (phs_data)
     type is (phs_wood_config_t)
        call phs_data%write_forest (u)
     end select
 
     vis_file = "phs_wood_vis_1.phs-vis.tex"
     ps_file  = "phs_wood_vis_1.phs-vis.ps"
     pdf_file = "phs_wood_vis_1.phs-vis.pdf"
     inquire (file = char (vis_file), exist = exist)
     if (exist) then
        u_vis = free_unit ()
        open (u_vis, file = char (vis_file), action = "read", status = "old")
        iostat = 0
        do while (iostat == 0)
           read (u_vis, "(A)", iostat = iostat)  buffer
           if (iostat == 0)  write (u, "(A)")  trim (buffer)
        end do
        close (u_vis)
     else
        write (u, "(A)")  "[Visualize LaTeX file is missing]"
     end if
     inquire (file = char (ps_file), exist = exist_ps)
     if (exist_ps) then
        write (u, "(A)")  "[Visualize Postscript file exists and is nonempty]"
     else
        write (u, "(A)")  "[Visualize Postscript file is missing/non-regular]"
     end if
     inquire (file = char (pdf_file), exist = exist_pdf)
     if (exist_pdf) then
        write (u, "(A)")  "[Visualize PDF file exists and is nonempty]"
     else
        write (u, "(A)")  "[Visualize PDF file is missing/non-regular]"
     end if
 
     write (u, "(A)")
     write (u, "(A)")  "* Cleanup"
 
     close (u_phs)
     call phs_data%final ()
     call model%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: phs_wood_vis_1"
 
   end subroutine phs_wood_vis_1
 
 @ %def phs_wood_vis_1
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{The FKS phase space}
 <<[[phs_fks.f90]]>>=
 <<File header>>
 
 module phs_fks
 
 <<Use kinds>>
 <<Use strings>>
   use constants
   use diagnostics
   use io_units, only: given_output_unit, free_unit
   use format_utils, only: write_separator
   use lorentz
   use physics_defs
   use flavors
   use pdg_arrays, only: is_colored
   use models, only: model_t
   use sf_mappings
   use sf_base
   use phs_base
   use resonances, only: resonance_contributors_t, resonance_history_t
   use phs_forests, only: phs_forest_final
   use phs_wood
   use cascades
   use cascades2
   use process_constants
   use process_libraries
   use ttv_formfactors, only: generate_on_shell_decay_threshold, m1s_to_mpole
 
 <<Standard module head>>
 
 <<phs fks: public>>
 
 <<phs fks: parameters>>
 
 <<phs fks: types>>
 
 <<phs fks: interfaces>>
 
 contains
 
 <<phs fks: procedures>>
 
 end module phs_fks
 
 @ %def phs_fks
 @
 @ A container for the $x_\oplus$- and $x_\ominus$-values for initial-state
 phase spaces.
 <<phs fks: public>>=
   public :: isr_kinematics_t
 <<phs fks: types>>=
   type :: isr_kinematics_t
     integer :: n_in
     real(default), dimension(2) :: x = one
     real(default), dimension(2) :: z = zero
     real(default), dimension(2) :: z_coll = zero
     real(default) :: sqrts_born = zero
     real(default) :: beam_energy = zero
     real(default) :: fac_scale = zero
     real(default), dimension(2) :: jacobian = one
     integer :: isr_mode = SQRTS_FIXED
   end type isr_kinematics_t
 
 @ %def type isr_kinematics_t
 @
 <<phs fks: public>>=
   public :: phs_point_set_t
 <<phs fks: types>>=
   type :: phs_point_set_t
      type(phs_point_t), dimension(:), allocatable :: phs_point
      logical :: initialized = .false.
   contains
   <<phs fks: phs point set: TBP>>
   end type phs_point_set_t
 
 @ %def phs_point_set_t
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: init => phs_point_set_init
 <<phs fks: procedures>>=
   subroutine phs_point_set_init (phs_point_set, n_particles, n_phs)
     class(phs_point_set_t), intent(out) :: phs_point_set
     integer, intent(in) :: n_particles, n_phs
     integer :: i_phs
     allocate (phs_point_set%phs_point (n_phs))
     do i_phs = 1, n_phs
        phs_point_set%phs_point(i_phs) = n_particles
     end do
     phs_point_set%initialized = .true.
   end subroutine phs_point_set_init
 
 @ %def phs_point_set_init
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: write => phs_point_set_write
 <<phs fks: procedures>>=
   subroutine phs_point_set_write (phs_point_set, i_phs, contributors, unit, show_mass, &
          testflag, check_conservation, ultra, n_in)
     class(phs_point_set_t), intent(in) :: phs_point_set
     integer, intent(in), optional :: i_phs
     integer, intent(in), dimension(:), optional :: contributors
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: show_mass
     logical, intent(in), optional :: testflag, ultra
     logical, intent(in), optional :: check_conservation
     integer, intent(in), optional :: n_in
     integer :: i, u
     type(vector4_t) :: p_sum
     u = given_output_unit (unit); if (u < 0) return
     if (present (i_phs)) then
        call phs_point_set%phs_point(i_phs)%write &
             (unit = u, show_mass = show_mass, testflag = testflag, &
             check_conservation = check_conservation, ultra = ultra, n_in = n_in)
     else
        do i = 1, size(phs_point_set%phs_point)
           call phs_point_set%phs_point(i)%write &
                (unit = u, show_mass = show_mass, testflag = testflag, &
                check_conservation = check_conservation, ultra = ultra, n_in = n_in)
        end do
     end if
     if (present (contributors)) then
        p_sum = vector4_null
        call msg_debug (D_SUBTRACTION, "Invariant masses for real emission: ")
        associate (p => phs_point_set%phs_point(i_phs)%p)
           do i = 1, size (contributors)
              p_sum = p_sum + p(contributors(i))
           end do
           p_sum = p_sum + p(size(p))
        end associate
        if (debug_active (D_SUBTRACTION)) &
             call vector4_write (p_sum, unit = unit, show_mass = show_mass, &
                  testflag = testflag, ultra = ultra)
     end if
   end subroutine phs_point_set_write
 
 @ %def phs_point_set_write
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: get_n_momenta => phs_point_set_get_n_momenta
 <<phs fks: procedures>>=
   elemental function phs_point_set_get_n_momenta (phs_point_set, i_res) result (n)
     integer :: n
     class(phs_point_set_t), intent(in) :: phs_point_set
     integer, intent(in) :: i_res
     n = phs_point_set%phs_point(i_res)%n_momenta
   end function phs_point_set_get_n_momenta
 
 @ %def phs_point_set_get_n_momenta
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: get_momenta => phs_point_set_get_momenta
 <<phs fks: procedures>>=
   pure function phs_point_set_get_momenta (phs_point_set, i_phs, n_in) result (p)
     type(vector4_t), dimension(:), allocatable :: p
     class(phs_point_set_t), intent(in) :: phs_point_set
     integer, intent(in) :: i_phs
     integer, intent(in), optional :: n_in
     if (present (n_in)) then
        allocate (p (n_in), source = phs_point_set%phs_point(i_phs)%p(1:n_in))
     else
        allocate (p (phs_point_set%phs_point(i_phs)%n_momenta), &
             source = phs_point_set%phs_point(i_phs)%p)
     end if
   end function phs_point_set_get_momenta
 
 @ %def phs_point_set_get_momenta
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: get_momentum => phs_point_set_get_momentum
 <<phs fks: procedures>>=
   pure function phs_point_set_get_momentum (phs_point_set, i_phs, i_mom) result (p)
     type(vector4_t) :: p
     class(phs_point_set_t), intent(in) :: phs_point_set
     integer, intent(in) :: i_phs, i_mom
     p = phs_point_set%phs_point(i_phs)%p(i_mom)
   end function phs_point_set_get_momentum
 
 @ %def phs_point_set_get_momentum
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: get_energy => phs_point_set_get_energy
 <<phs fks: procedures>>=
   pure function phs_point_set_get_energy (phs_point_set, i_phs, i_mom) result (E)
     real(default) :: E
     class(phs_point_set_t), intent(in) :: phs_point_set
     integer, intent(in) :: i_phs, i_mom
     E = phs_point_set%phs_point(i_phs)%p(i_mom)%p(0)
   end function phs_point_set_get_energy
 
 @ %def phs_point_set_get_energy
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: get_sqrts => phs_point_set_get_sqrts
 <<phs fks: procedures>>=
   function phs_point_set_get_sqrts (phs_point_set, i_phs) result (sqrts)
     real(default) :: sqrts
     class(phs_point_set_t), intent(in) :: phs_point_set
     integer, intent(in) :: i_phs
     associate (p => phs_point_set%phs_point(i_phs)%p)
        sqrts = (p(1) + p(2))**1
     end associate
   end function phs_point_set_get_sqrts
 
 @ %def phs_point_set_get_sqrts
 @
 <<phs fks: phs point set: TBP>>=
   generic :: set_momenta => set_momenta_p, set_momenta_phs_point
   procedure :: set_momenta_p => phs_point_set_set_momenta_p
 <<phs fks: procedures>>=
   subroutine phs_point_set_set_momenta_p (phs_point_set, i_phs, p)
     class(phs_point_set_t), intent(inout) :: phs_point_set
     integer, intent(in) :: i_phs
     type(vector4_t), intent(in), dimension(:) :: p
     phs_point_set%phs_point(i_phs)%p = p
   end subroutine phs_point_set_set_momenta_p
 
 @ %def phs_point_set_set_momenta_p
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: set_momenta_phs_point => phs_point_set_set_momenta_phs_point
 <<phs fks: procedures>>=
   subroutine phs_point_set_set_momenta_phs_point (phs_point_set, i_phs, p)
     class(phs_point_set_t), intent(inout) :: phs_point_set
     integer, intent(in) :: i_phs
     type(phs_point_t), intent(in) :: p
     phs_point_set%phs_point(i_phs) = p
   end subroutine phs_point_set_set_momenta_phs_point
 
 @ %def phs_point_set_set_momenta_phs_point
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: get_n_particles => phs_point_set_get_n_particles
 <<phs fks: procedures>>=
   function phs_point_set_get_n_particles (phs_point_set, i) result (n_particles)
     integer :: n_particles
     class(phs_point_set_t), intent(in) :: phs_point_set
     integer, intent(in), optional :: i
     integer :: j
     j = 1; if (present (i)) j = i
     n_particles = size (phs_point_set%phs_point(j)%p)
   end function phs_point_set_get_n_particles
 
 @ %def phs_point_set_get_n_particles
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: get_n_phs => phs_point_set_get_n_phs
 <<phs fks: procedures>>=
   function phs_point_set_get_n_phs (phs_point_set) result (n_phs)
     integer :: n_phs
     class(phs_point_set_t), intent(in) :: phs_point_set
     n_phs = size (phs_point_set%phs_point)
   end function phs_point_set_get_n_phs
 
 @ %def phs_point_set_get_n_phs
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: get_invariant_mass => phs_point_set_get_invariant_mass
 <<phs fks: procedures>>=
   function phs_point_set_get_invariant_mass (phs_point_set, i_phs, i_part) result (m2)
     real(default) :: m2
     class(phs_point_set_t), intent(in) :: phs_point_set
     integer, intent(in) :: i_phs
     integer, intent(in), dimension(:) :: i_part
     type(vector4_t) :: p
     integer :: i
     p = vector4_null
     do i = 1, size (i_part)
        p = p + phs_point_set%phs_point(i_phs)%p(i_part(i))
     end do
     m2 = p**2
   end function phs_point_set_get_invariant_mass
 
 @ %def phs_point_set_get_invariant_mass
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: write_phs_point => phs_point_set_write_phs_point
 <<phs fks: procedures>>=
   subroutine phs_point_set_write_phs_point (phs_point_set, i_phs, unit, show_mass, &
      testflag, check_conservation, ultra, n_in)
     class(phs_point_set_t), intent(in) :: phs_point_set
     integer, intent(in) :: i_phs
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: show_mass
     logical, intent(in), optional :: testflag, ultra
     logical, intent(in), optional :: check_conservation
     integer, intent(in), optional :: n_in
     call phs_point_set%phs_point(i_phs)%write (unit, show_mass, testflag, &
        check_conservation, ultra, n_in)
   end subroutine phs_point_set_write_phs_point
 
 @ %def phs_point_set_write_phs_point
 @
 <<phs fks: phs point set: TBP>>=
   procedure :: final => phs_point_set_final
 <<phs fks: procedures>>=
   subroutine phs_point_set_final (phs_point_set)
     class(phs_point_set_t), intent(inout) :: phs_point_set
     integer :: i
     do i = 1, size (phs_point_set%phs_point)
        call phs_point_set%phs_point(i)%final ()
     end do
     deallocate (phs_point_set%phs_point)
     phs_point_set%initialized = .false.
   end subroutine phs_point_set_final
 
 @ %def phs_point_set_final
 @
 <<phs fks: public>>=
   public :: real_jacobian_t
 <<phs fks: types>>=
   type :: real_jacobian_t
     real(default), dimension(4) :: jac = 1._default
   end type real_jacobian_t
 
 @ %def real_jacobian_t
 @
 <<phs fks: public>>=
   public :: real_kinematics_t
 <<phs fks: types>>=
   type :: real_kinematics_t
     logical :: supply_xi_max = .true.
     real(default) :: xi_tilde
     real(default) :: phi
     real(default), dimension(:), allocatable :: xi_max, y
     real(default) :: xi_mismatch, y_mismatch
     type(real_jacobian_t), dimension(:), allocatable :: jac
     real(default) :: jac_mismatch
     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(phs_point_set_t) :: p_born_onshell
     type(phs_point_set_t), dimension(2) :: p_real_onshell
     integer, dimension(:), allocatable :: alr_to_i_phs
     real(default), dimension(3) :: x_rad
     real(default), dimension(:), allocatable :: jac_rand
     real(default), dimension(:), allocatable :: y_soft
     real(default) :: cms_energy2
     type(vector4_t), dimension(:), allocatable :: xi_ref_momenta
   contains
   <<phs fks: real kinematics: TBP>>
   end type real_kinematics_t
 
 @ %def real_kinematics_t
 @
 <<phs fks: real kinematics: TBP>>=
   procedure :: init => real_kinematics_init
 <<phs fks: procedures>>=
   subroutine real_kinematics_init (r, n_tot, n_phs, n_alr, n_contr)
     class(real_kinematics_t), intent(inout) :: r
     integer, intent(in) :: n_tot, n_phs, n_alr, n_contr
     allocate (r%xi_max (n_phs))
     allocate (r%y (n_phs))
     allocate (r%y_soft (n_phs))
     call r%p_born_cms%init (n_tot - 1, 1)
     call r%p_born_lab%init (n_tot - 1, 1)
     call r%p_real_cms%init (n_tot, n_phs)
     call r%p_real_lab%init (n_tot, n_phs)
     allocate (r%jac (n_phs), r%jac_rand (n_phs))
     allocate (r%alr_to_i_phs (n_alr))
     allocate (r%xi_ref_momenta (n_contr))
     r%alr_to_i_phs = 0
     r%xi_tilde = zero; r%xi_mismatch = zero
     r%xi_max = zero
     r%y = zero; r%y_mismatch = zero
     r%y_soft = zero
     r%phi = zero
     r%cms_energy2 = zero
     r%xi_ref_momenta = vector4_null
     r%jac_mismatch = one
     r%jac_rand = one
   end subroutine real_kinematics_init
 
 @ %def real_kinematics_init
 @
 <<phs fks: real kinematics: TBP>>=
   procedure :: init_onshell => real_kinematics_init_onshell
 <<phs fks: procedures>>=
   subroutine real_kinematics_init_onshell (r, n_tot, n_phs)
     class(real_kinematics_t), intent(inout) :: r
     integer, intent(in) :: n_tot, n_phs
     call r%p_born_onshell%init (n_tot - 1, 1)
     call r%p_real_onshell(1)%init (n_tot, n_phs)
     call r%p_real_onshell(2)%init (n_tot, n_phs)
   end subroutine real_kinematics_init_onshell
 
 @ %def real_kinematics_init_onshell
 @
 <<phs fks: real kinematics: TBP>>=
   procedure :: write => real_kinematics_write
 <<phs fks: procedures>>=
   subroutine real_kinematics_write (r, unit)
     class(real_kinematics_t), intent(in) :: r
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit); if (u < 0) return
     write (u,"(A)") "Real kinematics: "
     write (u,"(A,F5.3)") "xi_tilde: ", r%xi_tilde
     write (u,"(A,F5.3)") "phi: ", r%phi
     do i = 1, size (r%xi_max)
        write (u,"(A,I1,1X)") "i_phs: ", i
        write (u,"(A,100F5.3,1X)") "xi_max: ", r%xi_max(i)
        write (u,"(A,100F5.3,1X)") "y: ", r%y(i)
        write (u,"(A,100F5.3,1X)") "jac_rand: ", r%jac_rand(i)
        write (u,"(A,100F5.3,1X)") "y_soft: ", r%y_soft(i)
     end do
     write (u, "(A)") "Born Momenta: "
     write (u, "(A)") "CMS: "
     call r%p_born_cms%write (unit = u)
     write (u, "(A)") "Lab: "
     call r%p_born_lab%write (unit = u)
     write (u, "(A)") "Real Momenta: "
     write (u, "(A)") "CMS: "
     call r%p_real_cms%write (unit = u)
     write (u, "(A)") "Lab: "
     call r%p_real_lab%write (unit = u)
   end subroutine real_kinematics_write
 
 @ %def real_kinematics_write
 @ The boost to the center-of-mass system only has a reasonable meaning
 above the threshold. Below the threshold, we do not apply boost at all, so
 that the top quarks stay in the rest frame. However, with top quarks exactly
 at rest, problems arise in the matrix elements (e.g. in the computation
 of angles). Therefore, we apply a boost which is not exactly 1, but has a
 tiny value differing from that.
 <<phs fks: public>>=
   public :: get_boost_for_threshold_projection
 <<phs fks: procedures>>=
   function get_boost_for_threshold_projection (p, sqrts, mtop) result (L)
     type(lorentz_transformation_t) :: L
     type(vector4_t), intent(in), dimension(:) :: p
     real(default), intent(in) :: sqrts, mtop
     type(vector4_t) :: p_tmp
     type(vector3_t) :: dir
     real(default) :: scale_factor, arg
     p_tmp = p(THR_POS_WP) + p(THR_POS_B)
     arg = sqrts**2 - four * mtop**2
     if (arg > zero) then
        scale_factor = sqrt (arg) / two
     else
        scale_factor = tiny_07*1000
     end if
     dir = scale_factor * create_unit_vector (p_tmp)
     p_tmp = [sqrts / two, dir%p]
     L = boost (p_tmp, mtop)
   end function get_boost_for_threshold_projection
 
 @ %def get_boost_for_threshold_projection
 @ This routine recomputes the value of $\phi$ used to generate the real phase space.
 <<phs fks: procedures>>=
   function get_generation_phi (p_born, p_real, emitter, i_gluon) result (phi)
     real(default) :: phi
     type(vector4_t), intent(in), dimension(:) :: p_born, p_real
     integer, intent(in) :: emitter, i_gluon
     type(vector4_t) :: p1, p2, pp
     type(lorentz_transformation_t) :: rot_to_gluon, rot_to_z
     type(vector3_t) :: dir, z
     real(default) :: cpsi
     pp = p_real(emitter) + p_real(i_gluon)
     cpsi = (space_part_norm (pp)**2 - space_part_norm (p_real(emitter))**2 &
            + space_part_norm (p_real(i_gluon))**2) / &
            (two * space_part_norm (pp) * space_part_norm (p_real(i_gluon)))
     dir = create_orthogonal (space_part (p_born(emitter)))
     rot_to_gluon = rotation (cpsi, sqrt (one - cpsi**2), dir)
     pp = rot_to_gluon * p_born(emitter)
     z%p = [0, 0, 1]
     rot_to_z = rotation_to_2nd &
          (space_part (p_born(emitter)) / space_part_norm (p_born(emitter)), z)
     p1 = rot_to_z * pp / space_part_norm (pp)
     p2 = rot_to_z * p_real(i_gluon)
     phi = azimuthal_distance (p1, p2)
     if (phi < zero) phi = twopi - abs(phi)
   end function get_generation_phi
 
 @ %def get_generation_phi
 @
 <<phs fks: real kinematics: TBP>>=
   procedure :: apply_threshold_projection_real => real_kinematics_apply_threshold_projection_real
 <<phs fks: procedures>>=
   subroutine real_kinematics_apply_threshold_projection_real (r, i_phs, mtop, L_to_cms, invert)
     class(real_kinematics_t), intent(inout) :: r
     integer, intent(in) :: i_phs
     real(default), intent(in) :: mtop
     type(lorentz_transformation_t), intent(in), dimension(:) :: L_to_cms
     logical, intent(in) :: invert
     integer :: leg, other_leg
     type(vector4_t), dimension(4) :: k_tmp
     type(vector4_t), dimension(4) :: k_decay_onshell_real
     type(vector4_t), dimension(3) :: k_decay_onshell_born
     do leg = 1, 2
        other_leg = 3 - leg
        associate (p_real => r%p_real_cms%phs_point(i_phs)%p, &
             p_real_onshell => r%p_real_onshell(leg)%phs_point(i_phs)%p)
           p_real_onshell(1:2) = p_real(1:2)
           k_tmp(1) = p_real(7)
           k_tmp(2) = p_real(ass_quark(leg))
           k_tmp(3) = p_real(ass_boson(leg))
           k_tmp(4) = [mtop, zero, zero, zero]
           call generate_on_shell_decay_threshold (k_tmp(1:3), &
                k_tmp(4), k_decay_onshell_real (2:4))
           k_decay_onshell_real (1) = k_tmp(4)
           k_tmp(1) = p_real(ass_quark(other_leg))
           k_tmp(2) = p_real(ass_boson(other_leg))
           k_decay_onshell_born = create_two_particle_decay (mtop**2, k_tmp(1), k_tmp(2))
           p_real_onshell(THR_POS_GLUON) = L_to_cms(leg) * k_decay_onshell_real (2)
           p_real_onshell(ass_quark(leg)) = L_to_cms(leg) * k_decay_onshell_real(3)
           p_real_onshell(ass_boson(leg)) = L_to_cms(leg) * k_decay_onshell_real(4)
           p_real_onshell(ass_quark(other_leg)) = L_to_cms(leg) * k_decay_onshell_born (2)
           p_real_onshell(ass_boson(other_leg)) = L_to_cms(leg) * k_decay_onshell_born (3)
           if (invert) then
              call vector4_invert_direction (p_real_onshell (ass_quark(other_leg)))
              call vector4_invert_direction (p_real_onshell (ass_boson(other_leg)))
           end if
        end associate
     end do
   end subroutine real_kinematics_apply_threshold_projection_real
 
 @ %def real_kinematics_apply_threshold_projection_real
 @
 <<phs fks: public>>=
   public :: threshold_projection_born
 <<phs fks: procedures>>=
   subroutine threshold_projection_born (mtop, L_to_cms, p_in, p_onshell)
     real(default), intent(in) :: mtop
     type(lorentz_transformation_t), intent(in) :: L_to_cms
     type(vector4_t), intent(in), dimension(:) :: p_in
     type(vector4_t), intent(out), dimension(:) :: p_onshell
     type(vector4_t), dimension(3) :: k_decay_onshell
     type(vector4_t) :: p_tmp_1, p_tmp_2
     type(lorentz_transformation_t) :: L_to_cms_inv
     p_onshell(1:2) = p_in(1:2)
     L_to_cms_inv = inverse (L_to_cms)
     p_tmp_1 = L_to_cms_inv * p_in(THR_POS_B)
     p_tmp_2 = L_to_cms_inv * p_in(THR_POS_WP)
     k_decay_onshell = create_two_particle_decay (mtop**2, &
          p_tmp_1, p_tmp_2)
     p_onshell([THR_POS_B, THR_POS_WP]) = k_decay_onshell([2, 3])
     p_tmp_1 = L_to_cms * p_in(THR_POS_BBAR)
     p_tmp_2 = L_to_cms * p_in(THR_POS_WM)
     k_decay_onshell = create_two_particle_decay (mtop**2, &
          p_tmp_1, p_tmp_2)
     p_onshell([THR_POS_BBAR, THR_POS_WM]) = k_decay_onshell([2, 3])
     p_onshell([THR_POS_WP, THR_POS_B]) = L_to_cms * p_onshell([THR_POS_WP, THR_POS_B])
     p_onshell([THR_POS_WM, THR_POS_BBAR]) = L_to_cms_inv * p_onshell([THR_POS_WM, THR_POS_BBAR])
   end subroutine threshold_projection_born
 
 @ %def threshold_projection_born
 @ This routine computes the bounds of the Dalitz region for massive emitters, see below.
 It is also used by [[Powheg]], so the routine is public.
 The input parameter [[m2]] corresponds to the squared mass of the emitter and [[p]] is the
 four-momentum of the emitter.
 <<phs fks: public>>=
   public :: compute_dalitz_bounds
 <<phs fks: procedures>>=
   pure subroutine compute_dalitz_bounds (q0, m2, mrec2, z1, z2, k0_rec_max)
     real(default), intent(in) :: q0, m2, mrec2
     real(default), intent(out) :: z1, z2, k0_rec_max
     k0_rec_max = (q0**2 - m2 + mrec2) / (two * q0)
     z1 = (k0_rec_max + sqrt(k0_rec_max**2 - mrec2)) / q0
     z2 = (k0_rec_max - sqrt(k0_rec_max**2 - mrec2)) / q0
   end subroutine compute_dalitz_bounds
 
 @ %def compute_dalitz_bounds
 @ Compute the [[kt2]] of a given emitter
 <<phs fks: real kinematics: TBP>>=
   procedure :: kt2 => real_kinematics_kt2
 <<phs fks: procedures>>=
   function real_kinematics_kt2 &
      (real_kinematics, i_phs, emitter, kt2_type, xi, y) result (kt2)
     real(default) :: kt2
     class(real_kinematics_t), intent(in) :: real_kinematics
     integer, intent(in) :: emitter, i_phs, kt2_type
     real(default), intent(in), optional :: xi, y
     real(default) :: xii, yy
     real(default) :: q, E_em, z, z1, z2, m2, mrec2, k0_rec_max
     type(vector4_t) :: p_emitter
     if (present (y)) then
        yy = y
     else
        yy = real_kinematics%y (i_phs)
     end if
     if (present (xi)) then
        xii = xi
     else
        xii = real_kinematics%xi_tilde * real_kinematics%xi_max (i_phs)
     end if
     select case (kt2_type)
     case (FSR_SIMPLE)
        kt2 = real_kinematics%cms_energy2 / two * xii**2 * (1 - yy)
     case (FSR_MASSIVE)
        q = sqrt (real_kinematics%cms_energy2)
        p_emitter = real_kinematics%p_born_cms%phs_point(1)%p(emitter)
        mrec2 = (q - p_emitter%p(0))**2 - sum (p_emitter%p(1:3)**2)
        m2 = p_emitter**2
        E_em = energy (p_emitter)
        call compute_dalitz_bounds (q, m2, mrec2, z1, z2, k0_rec_max)
        z = z2 - (z2 - z1) * (one + yy) / two
        kt2 = xii**2 * q**3 * (one - z) / &
           (two * E_em - z * xii * q)
     case (FSR_MASSLESS_RECOILER)
        kt2 = real_kinematics%cms_energy2 / two * xii**2 * (1 - yy**2) / two
     case default
        kt2 = zero
        call msg_bug ("kt2_type must be set to a known value")
     end select
   end function real_kinematics_kt2
 
 @ %def real_kinematics_kt2
 @
 <<phs fks: parameters>>=
   integer, parameter, public :: FSR_SIMPLE = 1
   integer, parameter, public :: FSR_MASSIVE = 2
   integer, parameter, public :: FSR_MASSLESS_RECOILER = 3
 @ %def FSR_SIMPLE FSR_MASSIVE FSR_MASSLESS_RECOILER
 @
 <<phs fks: real kinematics: TBP>>=
   procedure :: final => real_kinematics_final
 <<phs fks: procedures>>=
   subroutine real_kinematics_final (real_kin)
     class(real_kinematics_t), intent(inout) :: real_kin
     if (allocated (real_kin%xi_max)) deallocate (real_kin%xi_max)
     if (allocated (real_kin%y)) deallocate (real_kin%y)
     if (allocated (real_kin%alr_to_i_phs)) deallocate (real_kin%alr_to_i_phs)
     if (allocated (real_kin%jac_rand)) deallocate (real_kin%jac_rand)
     if (allocated (real_kin%y_soft)) deallocate (real_kin%y_soft)
     if (allocated (real_kin%xi_ref_momenta)) deallocate (real_kin%xi_ref_momenta)
     call real_kin%p_born_cms%final (); call real_kin%p_born_lab%final ()
     call real_kin%p_real_cms%final (); call real_kin%p_real_lab%final ()
   end subroutine real_kinematics_final
 
 @ %def real_kinematics_final
 @
 <<phs fks: parameters>>=
   integer, parameter, public :: I_XI = 1
   integer, parameter, public :: I_Y = 2
   integer, parameter, public :: I_PHI = 3
 
   integer, parameter, public :: PHS_MODE_UNDEFINED = 0
   integer, parameter, public :: PHS_MODE_ADDITIONAL_PARTICLE = 1
   integer, parameter, public :: PHS_MODE_COLLINEAR_REMNANT = 2
 
 @ %def parameters
 @
 <<phs fks: public>>=
   public :: phs_fks_config_t
 <<phs fks: types>>=
   type, extends (phs_wood_config_t) :: phs_fks_config_t
     integer :: mode = PHS_MODE_UNDEFINED
     character(32) :: md5sum_born_config
     logical :: make_dalitz_plot = .false.
   contains
   <<phs fks: fks config: TBP>>
   end type phs_fks_config_t
 
 @ %def phs_fks_config_t
 @
 <<phs fks: fks config: TBP>>=
   procedure :: clear_phase_space => fks_config_clear_phase_space
 <<phs fks: procedures>>=
   subroutine fks_config_clear_phase_space (phs_config)
     class(phs_fks_config_t), intent(inout) :: phs_config
   end subroutine fks_config_clear_phase_space
 
 @ %def fks_config_clear_phase_space
 @
 <<phs fks: fks config: TBP>>=
   procedure :: write => phs_fks_config_write
 <<phs fks: procedures>>=
   subroutine phs_fks_config_write (object, unit, include_id)
     class(phs_fks_config_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: include_id
     integer :: u
     u = given_output_unit (unit)
     call object%phs_wood_config_t%write (u)
     write (u, "(A,A)") "Extra Born md5sum: ", object%md5sum_born_config
   end subroutine phs_fks_config_write
 
 @ %def phs_fks_config_write
 @
 <<phs fks: fks config: TBP>>=
   procedure :: set_mode => phs_fks_config_set_mode
 <<phs fks: procedures>>=
   subroutine phs_fks_config_set_mode (phs_config, mode)
     class(phs_fks_config_t), intent(inout) :: phs_config
     integer, intent(in) :: mode
     select case (mode)
     case (NLO_REAL, NLO_MISMATCH)
        phs_config%mode = PHS_MODE_ADDITIONAL_PARTICLE
     case (NLO_DGLAP)
        phs_config%mode = PHS_MODE_COLLINEAR_REMNANT
     end select
   end subroutine phs_fks_config_set_mode
 
 @ %def phs_fks_config_set_mod
 @
 <<phs fks: fks config: TBP>>=
   procedure :: configure => phs_fks_config_configure
 <<phs fks: procedures>>=
   subroutine phs_fks_config_configure (phs_config, sqrts, &
         sqrts_fixed, cm_frame, azimuthal_dependence, rebuild, &
         ignore_mismatch, nlo_type, subdir)
     class(phs_fks_config_t), intent(inout) :: phs_config
     real(default), intent(in) :: sqrts
     logical, intent(in), optional :: sqrts_fixed
     logical, intent(in), optional :: cm_frame
     logical, intent(in), optional :: azimuthal_dependence
     logical, intent(in), optional :: rebuild
     logical, intent(in), optional :: ignore_mismatch
     integer, intent(in), optional :: nlo_type
     type(string_t), intent(in), optional :: subdir
     if (phs_config%extension_mode == EXTENSION_NONE) then
        select case (phs_config%mode)
        case (PHS_MODE_ADDITIONAL_PARTICLE)
           phs_config%n_par = phs_config%n_par + 3
        case (PHS_MODE_COLLINEAR_REMNANT)
           phs_config%n_par = phs_config%n_par + 1
        end select
     end if
 !!! Channel equivalences not accessible yet
     phs_config%provides_equivalences = .false.
     call phs_config%compute_md5sum ()
   end subroutine phs_fks_config_configure
 
 @ %def phs_fks_config_configure
 @
 <<phs fks: fks config: TBP>>=
   procedure :: startup_message => phs_fks_config_startup_message
 <<phs fks: procedures>>=
   subroutine phs_fks_config_startup_message (phs_config, unit)
     class(phs_fks_config_t), intent(in) :: phs_config
     integer, intent(in), optional :: unit
     call phs_config%phs_wood_config_t%startup_message (unit)
   end subroutine phs_fks_config_startup_message
 
 @ %def phs_fks_config_startup_message
 @
 <<phs fks: fks config: TBP>>=
   procedure, nopass :: allocate_instance => phs_fks_config_allocate_instance
 <<phs fks: procedures>>=
   subroutine phs_fks_config_allocate_instance (phs)
     class(phs_t), intent(inout), pointer :: phs
     allocate (phs_fks_t :: phs)
   end subroutine phs_fks_config_allocate_instance
 
 @ %def phs_fks_config_allocate_instance
 @ If the phase space is generated from file, but we want to have resonance
 histories, we must force the cascade sets to be generated. However, it must
 be assured that Born flavors are used for this.
 <<phs fks: fks config: TBP>>=
   procedure :: generate_phase_space_extra => phs_fks_config_generate_phase_space_extra
 <<phs fks: procedures>>=
   subroutine phs_fks_config_generate_phase_space_extra (phs_config)
     class(phs_fks_config_t), intent(inout) :: phs_config
     integer :: off_shell, extra_off_shell
     type(flavor_t), dimension(:,:), allocatable :: flv_born
     integer :: i, j
     integer :: n_state, n_flv_born
     integer :: unit_fds
     logical :: valid
     type(string_t) :: file_name
     logical :: file_exists
     if (phs_config%use_cascades2) then
        allocate (phs_config%feyngraph_set)
     else
        allocate (phs_config%cascade_set)
     end if
     n_flv_born = size (phs_config%flv, 1) - 1
     n_state = size (phs_config%flv, 2)
     allocate (flv_born (n_flv_born, n_state))
     do i = 1, n_flv_born
        do j = 1, n_state
           flv_born(i, j) = phs_config%flv(i, j)
        end do
     end do
     if (phs_config%use_cascades2) then
        file_name = char (phs_config%id) // ".fds"
        inquire (file=char (file_name), exist=file_exists)
        if (.not. file_exists) call msg_fatal &
             ("The O'Mega input file " // char (file_name) // &
             " does not exist. " // "Please make sure that the " // &
             "variable ?omega_write_phs_output has been set correctly.")
        unit_fds = free_unit ()
        open (unit=unit_fds, file=char(file_name), status='old', action='read')
     end if
     off_shell = phs_config%par%off_shell
     do extra_off_shell = 0, max (n_flv_born - 2, 0)
        phs_config%par%off_shell = off_shell + extra_off_shell
        if (phs_config%use_cascades2) then
           call feyngraph_set_generate (phs_config%feyngraph_set, &
                phs_config%model, phs_config%n_in, phs_config%n_out - 1, &
                flv_born, phs_config%par, phs_config%fatal_beam_decay, unit_fds, &
                phs_config%vis_channels)
           if (feyngraph_set_is_valid (phs_config%feyngraph_set)) exit
        else
           call cascade_set_generate (phs_config%cascade_set, &
                phs_config%model, phs_config%n_in, phs_config%n_out - 1, &
                flv_born, phs_config%par, phs_config%fatal_beam_decay)
           if (cascade_set_is_valid (phs_config%cascade_set)) exit
        end if
     end do
     if (phs_config%use_cascades2) then
        close (unit_fds)
        valid = feyngraph_set_is_valid (phs_config%feyngraph_set)
     else
        valid = cascade_set_is_valid (phs_config%cascade_set)
     end if
     if (.not. valid) &
        call msg_fatal ("Resonance extraction: Phase space generation failed")
   end subroutine phs_fks_config_generate_phase_space_extra
 
 @ %def phs_fks_config_generate_phase_space_extra
 @
 <<phs fks: fks config: TBP>>=
   procedure :: set_born_config => phs_fks_config_set_born_config
 <<phs fks: procedures>>=
   subroutine phs_fks_config_set_born_config (phs_config, phs_cfg_born)
     class(phs_fks_config_t), intent(inout) :: phs_config
     type(phs_wood_config_t), intent(in), target :: phs_cfg_born
     call msg_debug (D_PHASESPACE, "phs_fks_config_set_born_config")
     phs_config%forest = phs_cfg_born%forest
     phs_config%n_channel = phs_cfg_born%n_channel
     allocate (phs_config%channel (phs_config%n_channel))
     phs_config%channel = phs_cfg_born%channel
     phs_config%n_par = phs_cfg_born%n_par
     phs_config%n_state = phs_cfg_born%n_state
     phs_config%sqrts = phs_cfg_born%sqrts
     phs_config%par = phs_cfg_born%par
     phs_config%sqrts_fixed = phs_cfg_born%sqrts_fixed
     phs_config%azimuthal_dependence = phs_cfg_born%azimuthal_dependence
     phs_config%provides_chains = phs_cfg_born%provides_chains
     phs_config%cm_frame = phs_cfg_born%cm_frame
     phs_config%vis_channels = phs_cfg_born%vis_channels
     allocate (phs_config%chain (size (phs_cfg_born%chain)))
     phs_config%chain = phs_cfg_born%chain
     phs_config%model => phs_cfg_born%model
     phs_config%use_cascades2 = phs_cfg_born%use_cascades2
     if (allocated (phs_cfg_born%cascade_set)) then
        allocate (phs_config%cascade_set)
        phs_config%cascade_set = phs_cfg_born%cascade_set
     end if
     if (allocated (phs_cfg_born%feyngraph_set)) then
        allocate (phs_config%feyngraph_set)
        phs_config%feyngraph_set = phs_cfg_born%feyngraph_set
     end if
     phs_config%md5sum_born_config = phs_cfg_born%md5sum_phs_config
   end subroutine phs_fks_config_set_born_config
 
 @ %def phs_fks_config_set_born_config
 @
 <<phs fks: fks config: TBP>>=
   procedure :: get_resonance_histories => phs_fks_config_get_resonance_histories
 <<phs fks: procedures>>=
   function phs_fks_config_get_resonance_histories (phs_config) result (resonance_histories)
     type(resonance_history_t), dimension(:), allocatable :: resonance_histories
     class(phs_fks_config_t), intent(inout) :: phs_config
     if (allocated (phs_config%cascade_set)) then
        call cascade_set_get_resonance_histories &
           (phs_config%cascade_set, n_filter = 2, res_hists = resonance_histories)
     else if (allocated (phs_config%feyngraph_set)) then
        call feyngraph_set_get_resonance_histories &
             (phs_config%feyngraph_set, n_filter = 2, res_hists = resonance_histories)
     else
        call msg_debug (D_PHASESPACE, "Have to rebuild phase space for resonance histories")
        call phs_config%generate_phase_space_extra ()
        if (phs_config%use_cascades2) then
           call feyngraph_set_get_resonance_histories &
                (phs_config%feyngraph_set, n_filter = 2, res_hists = resonance_histories)
        else
           call cascade_set_get_resonance_histories &
                (phs_config%cascade_set, n_filter = 2, res_hists = resonance_histories)
        end if
     end if
   end function phs_fks_config_get_resonance_histories
 
 @ %def phs_fks_config_get_resonance_histories
 @
 <<phs fks: public>>=
   public :: dalitz_plot_t
 <<phs fks: types>>=
   type :: dalitz_plot_t
      integer :: unit = -1
      type(string_t) :: filename
      logical :: active = .false.
      logical :: inverse = .false.
   contains
   <<phs fks: dalitz plot: TBP>>
   end type dalitz_plot_t
 
 @ %def dalitz_plot_t
 @
 <<phs fks: dalitz plot: TBP>>=
   procedure :: init => dalitz_plot_init
 <<phs fks: procedures>>=
   subroutine dalitz_plot_init (plot, unit, filename, inverse)
     class(dalitz_plot_t), intent(inout) :: plot
     integer, intent(in) :: unit
     type(string_t), intent(in) :: filename
     logical, intent(in) :: inverse
     plot%active = .true.
     plot%unit = unit
     plot%inverse = inverse
     open (plot%unit, file = char (filename), action = "write")
   end subroutine dalitz_plot_init
 
 @ %def daltiz_plot_init
 @
 <<phs fks: dalitz plot: TBP>>=
   procedure :: write_header => dalitz_plot_write_header
 <<phs fks: procedures>>=
   subroutine dalitz_plot_write_header (plot)
     class(dalitz_plot_t), intent(in) :: plot
     write (plot%unit, "(A36)") "### Dalitz plot generated by WHIZARD"
     if (plot%inverse) then
        write (plot%unit, "(A10,1x,A4)") "### k0_n+1", "k0_n"
     else
        write (plot%unit, "(A8,1x,A6)") "### k0_n", "k0_n+1"
     end if
   end subroutine dalitz_plot_write_header
 
 @ %def dalitz_plot_write_header
 @
 <<phs fks: dalitz plot: TBP>>=
   procedure :: register => dalitz_plot_register
 <<phs fks: procedures>>=
   subroutine dalitz_plot_register (plot, k0_n, k0_np1)
     class(dalitz_plot_t), intent(in) :: plot
     real(default), intent(in) :: k0_n, k0_np1
     if (plot%inverse) then
        write (plot%unit, "(F8.4,1X,F8.4)") k0_np1, k0_n
     else
        write (plot%unit, "(F8.4,1X,F8.4)") k0_np1, k0_n
     end if
   end subroutine dalitz_plot_register
 
 @ %def dalitz_plot_register
 @
 <<phs fks: dalitz plot: TBP>>=
   procedure :: final => dalitz_plot_final
 <<phs fks: procedures>>=
   subroutine dalitz_plot_final (plot)
     class(dalitz_plot_t), intent(inout) :: plot
     logical :: opened
     plot%active = .false.
     plot%inverse = .false.
     if (plot%unit >= 0) then
        inquire (unit = plot%unit, opened = opened)
        if (opened) close (plot%unit)
     end if
     plot%filename = var_str ('')
     plot%unit = -1
   end subroutine dalitz_plot_final
 
 @ %def dalitz_plot_final
 @
 <<phs fks: parameters>>=
   integer, parameter, public :: GEN_REAL_PHASE_SPACE = 1
   integer, parameter, public :: GEN_SOFT_MISMATCH = 2
   integer, parameter, public :: GEN_SOFT_LIMIT_TEST = 3
   integer, parameter, public :: GEN_COLL_LIMIT_TEST = 4
   integer, parameter, public :: GEN_ANTI_COLL_LIMIT_TEST = 5
   integer, parameter, public :: GEN_SOFT_COLL_LIMIT_TEST = 6
   integer, parameter, public :: GEN_SOFT_ANTI_COLL_LIMIT_TEST = 7
 
   integer, parameter, public :: SQRTS_FIXED = 1
   integer, parameter, public :: SQRTS_VAR = 2
 
   real(default), parameter :: xi_tilde_test_soft = 0.0001_default
   real(default), parameter :: xi_tilde_test_coll = 0.5_default
   real(default), parameter :: y_test_soft = 0.5_default
   real(default), parameter :: y_test_coll = 0.999999_default
 
 @
 @ Very soft or collinear phase-space points can become a problem for
 matrix elements providers, as some scalar products cannot be evaluated
 properly. Here, a nonsensical result can spoil the whole integration.
 We therefore check the scalar products appearing to be below a certain
 tolerance.
 <<phs fks: public>>=
   public :: check_scalar_products
 <<phs fks: procedures>>=
   function check_scalar_products (p) result (valid)
     logical :: valid
     type(vector4_t), intent(in), dimension(:) :: p
     real(default), parameter :: tolerance = 1E-6_default
     integer :: i, j
     valid = .true.
     do i = 1, size (p)
        do j = i, size (p)
           if (i /= j) then
              if (abs(p(i) * p(j)) < tolerance) then
                 valid = .false.
                 exit
              end if
           end if
        end do
     end do
   end function check_scalar_products
 
 @ %def check_scalar_products
 @ [[xi_min]] should be set to a non-zero value in order to avoid
 phase-space points with [[p_real(emitter) = 0]].
 <<phs fks: public>>=
   public :: phs_fks_generator_t
 <<phs fks: types>>=
   type :: phs_fks_generator_t
     integer, dimension(:), allocatable :: emitters
     type(real_kinematics_t), pointer :: real_kinematics => null()
     type(isr_kinematics_t), pointer :: isr_kinematics => null()
     integer :: n_in
     real(default) :: xi_min = tiny_07
     real(default) :: y_max = one
     real(default) :: sqrts
     real(default) :: E_gluon
     real(default) :: mrec2
     real(default), dimension(:), allocatable :: m2
     logical :: massive_phsp = .false.
     logical, dimension(:), allocatable :: is_massive
     logical :: singular_jacobian = .false.
     integer :: i_fsr_first = -1
     type(resonance_contributors_t), dimension(:), allocatable :: resonance_contributors !!! Put somewhere else?
     integer :: mode = GEN_REAL_PHASE_SPACE
   contains
   <<phs fks: phs fks generator: TBP>>
   end type phs_fks_generator_t
 
 @ %def phs_fks_generator_t
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: connect_kinematics => phs_fks_generator_connect_kinematics
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_connect_kinematics &
          (generator, isr_kinematics, real_kinematics, massive_phsp)
     class(phs_fks_generator_t), intent(inout) :: generator
     type(isr_kinematics_t), intent(in), pointer :: isr_kinematics
     type(real_kinematics_t), intent(in), pointer :: real_kinematics
     logical, intent(in) :: massive_phsp
     generator%real_kinematics => real_kinematics
     generator%isr_kinematics => isr_kinematics
     generator%massive_phsp = massive_phsp
   end subroutine phs_fks_generator_connect_kinematics
 
 @ %def phs_fks_generator_connect_kinematics
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: compute_isr_kinematics => phs_fks_generator_compute_isr_kinematics
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_compute_isr_kinematics (generator, r, p_in)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), intent(in) :: r
     type(vector4_t), dimension(2), intent(in), optional :: p_in
     integer :: em
     type(vector4_t), dimension(2) :: p
 
     if (present (p_in)) then
        p = p_in
     else
        p = generator%real_kinematics%p_born_lab%phs_point(1)%p(1:2)
     end if
 
     associate (isr => generator%isr_kinematics)
        do em = 1, 2
           isr%x(em) = p(em)%p(0) / isr%beam_energy
           isr%z(em) = one - (one - isr%x(em)) * r
           isr%jacobian(em) =  one - isr%x(em)
        end do
        isr%sqrts_born = (p(1) + p(2))**1
     end associate
   end subroutine phs_fks_generator_compute_isr_kinematics
 
 @ %def phs_fks_generator_compute_isr_kinematics
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: final => phs_fks_generator_final
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_final (generator)
     class(phs_fks_generator_t), intent(inout) :: generator
     if (allocated (generator%emitters)) deallocate (generator%emitters)
     if (associated (generator%real_kinematics)) nullify (generator%real_kinematics)
     if (associated (generator%isr_kinematics)) nullify (generator%isr_kinematics)
     if (allocated (generator%m2)) deallocate (generator%m2)
     generator%massive_phsp = .false.
     if (allocated (generator%is_massive)) deallocate (generator%is_massive)
     generator%singular_jacobian = .false.
     generator%i_fsr_first = -1
     if (allocated (generator%resonance_contributors)) &
            deallocate (generator%resonance_contributors)
     generator%mode = GEN_REAL_PHASE_SPACE
   end subroutine phs_fks_generator_final
 
 @ %def phs_fks_generator_final
 @ A resonance phase space is uniquely specified via the resonance contributors and the
 corresponding emitters. The [[phs_identifier]] type also checks whether
 the given contributor-emitter configuration has already been evaluated to
 avoid duplicate computations.
 <<phs fks: public>>=
   public :: phs_identifier_t
 <<phs fks: types>>=
   type :: phs_identifier_t
      integer, dimension(:), allocatable :: contributors
      integer :: emitter = -1
      logical :: evaluated = .false.
   contains
   <<phs fks: phs identifier: TBP>>
   end type phs_identifier_t
 
 @ %def phs_identifier_t
 @
 <<phs fks: phs identifier: TBP>>=
   generic :: init => init_from_emitter, init_from_emitter_and_contributors
   procedure :: init_from_emitter => phs_identifier_init_from_emitter
   procedure :: init_from_emitter_and_contributors &
      => phs_identifier_init_from_emitter_and_contributors
 <<phs fks: procedures>>=
   subroutine phs_identifier_init_from_emitter (phs_id, emitter)
     class(phs_identifier_t), intent(out) :: phs_id
     integer, intent(in) :: emitter
     phs_id%emitter = emitter
   end subroutine phs_identifier_init_from_emitter
 
   subroutine phs_identifier_init_from_emitter_and_contributors &
      (phs_id, emitter, contributors)
      class(phs_identifier_t), intent(out) :: phs_id
      integer, intent(in) :: emitter
      integer, intent(in), dimension(:) :: contributors
      allocate (phs_id%contributors (size (contributors)))
      phs_id%contributors = contributors
      phs_id%emitter = emitter
   end subroutine phs_identifier_init_from_emitter_and_contributors
 @ %def phs_identifier_init_from_emitter
 @ %def phs_identifier_init_from_emitter_and_contributors
 @
 <<phs fks: phs identifier: TBP>>=
   procedure :: check => phs_identifier_check
 <<phs fks: procedures>>=
   function phs_identifier_check (phs_id, emitter, contributors) result (check)
     logical :: check
     class(phs_identifier_t), intent(in) :: phs_id
     integer, intent(in) :: emitter
     integer, intent(in), dimension(:), optional :: contributors
     check = phs_id%emitter == emitter
     if (present (contributors)) then
        if (.not. allocated (phs_id%contributors)) &
           call msg_fatal ("Phs identifier: contributors not allocated!")
        check = check .and. all (phs_id%contributors == contributors)
     end if
   end function phs_identifier_check
 
 @ %def phs_identifier_check
 @
 <<phs fks: phs identifier: TBP>>=
   procedure :: write => phs_identifier_write
 <<phs fks: procedures>>=
   subroutine phs_identifier_write (phs_id, unit)
     class(phs_identifier_t), intent(in) :: phs_id
     integer, intent(in), optional :: unit
     integer :: u, i
     u = given_output_unit (unit); if (u < 0) return
     write (u, '(A)') 'phs_identifier: '
     write (u, '(A,1X,I1)') 'Emitter: ', phs_id%emitter
     if (allocated (phs_id%contributors)) then
        write (u, '(A)', advance = 'no') 'Resonance contributors: '
        do i = 1, size (phs_id%contributors)
           write (u, '(I1,1X)', advance = 'no') phs_id%contributors(i)
        end do
     else
        write (u, '(A)') 'No Contributors allocated'
     end if
   end subroutine phs_identifier_write
 
 @ %def phs_identifier_write
 @
 <<phs fks: public>>=
   public :: check_for_phs_identifier
 <<phs fks: procedures>>=
   subroutine check_for_phs_identifier (phs_id, n_in, emitter, contributors, phs_exist, i_phs)
      type(phs_identifier_t), intent(in), dimension(:) :: phs_id
      integer, intent(in) :: n_in, emitter
      integer, intent(in), dimension(:), optional :: contributors
      logical, intent(out) :: phs_exist
      integer, intent(out) :: i_phs
      integer :: i
      phs_exist = .false.
      i_phs = -1
      do i = 1, size (phs_id)
         if (phs_id(i)%emitter < 0) then
            i_phs = i
            exit
         end if
         phs_exist = phs_id(i)%emitter == emitter
         if (present (contributors)) &
            phs_exist = phs_exist .and. all (phs_id(i)%contributors == contributors)
         if (phs_exist) then
            i_phs = i
            exit
         end if
      end do
   end subroutine check_for_phs_identifier
 
 @ %def check_for_phs_identifier
 @
 @ The fks phase space type contains the wood phase space and
 separately the in- and outcoming momenta for the real process and the
 corresponding Born momenta. Additionally, there are the variables
 $\xi$,$\xi_{max}$, $y$ and $\phi$ which are used to create the real
 phase space, as well as the jacobian and its corresponding soft and
 collinear limit. Lastly, the array \texttt{ch\_to\_em} connects each
 channel with an emitter.
 <<phs fks: public>>=
   public :: phs_fks_t
 <<phs fks: types>>=
   type, extends (phs_wood_t) :: phs_fks_t
     integer :: mode = PHS_MODE_UNDEFINED
     type(vector4_t), dimension(:), allocatable :: p_born
     type(vector4_t), dimension(:), allocatable :: q_born
     type(vector4_t), dimension(:), allocatable :: p_real
     type(vector4_t), dimension(:), allocatable :: q_real
     type(vector4_t), dimension(:), allocatable :: p_born_tot
     type(phs_fks_generator_t) :: generator
     logical :: perform_generation = .true.
     real(default) :: r_isr
     type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
   contains
   <<phs fks: phs fks: TBP>>
   end type phs_fks_t
 
 @ %def phs_fks_t
 @
 <<phs fks: interfaces>>=
 
   interface compute_beta
     module procedure compute_beta_massless
     module procedure compute_beta_massive
   end interface
 
   interface get_xi_max_fsr
     module procedure get_xi_max_fsr_massless
     module procedure get_xi_max_fsr_massive
   end interface
 
 @ %def interfaces
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: write => phs_fks_write
 <<phs fks: procedures>>=
   subroutine phs_fks_write (object, unit, verbose)
     class(phs_fks_t), intent(in) :: object
     integer, intent(in), optional :: unit
     logical, intent(in), optional :: verbose
     integer :: u, i, n_id
     u = given_output_unit (unit)
     call object%base_write ()
     n_id = size (object%phs_identifiers)
     if (n_id == 0) then
        write (u, "(A)") "No phs identifiers allocated! "
     else
        do i = 1, n_id
           call object%phs_identifiers(i)%write (u)
        end do
     end if
   end subroutine phs_fks_write
 
 @ %def phs_fks_write
 @ Initializer for the phase space. Calls the initialization of the
 corresponding Born phase space, sets up the
 channel-emitter-association and allocates space for the momenta.
 <<phs fks: phs fks: TBP>>=
   procedure :: init => phs_fks_init
 <<phs fks: procedures>>=
   subroutine phs_fks_init (phs, phs_config)
     class(phs_fks_t), intent(out) :: phs
     class(phs_config_t), intent(in), target :: phs_config
 
     call phs%base_init (phs_config)
     select type (phs_config)
     type is (phs_fks_config_t)
        phs%config => phs_config
        phs%forest = phs_config%forest
     end select
 
     select type(phs)
     type is (phs_fks_t)
       select type (phs_config)
       type is (phs_fks_config_t)
          phs%mode = phs_config%mode
       end select
 
       select case (phs%mode)
       case (PHS_MODE_ADDITIONAL_PARTICLE)
          phs%n_r_born = phs%config%n_par - 3
       case (PHS_MODE_COLLINEAR_REMNANT)
          phs%n_r_born = phs%config%n_par - 1
       end select
     end select
   end subroutine phs_fks_init
 
 @ %def phs_fks_init
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: allocate_momenta => phs_fks_allocate_momenta
 <<phs fks: procedures>>=
   subroutine phs_fks_allocate_momenta (phs, phs_config, data_is_born)
     class(phs_fks_t), intent(inout) :: phs
     class(phs_config_t), intent(in) :: phs_config
     logical, intent(in) :: data_is_born
     integer :: n_out_born
     allocate (phs%p_born (phs_config%n_in))
     allocate (phs%p_real (phs_config%n_in))
     select case (phs%mode)
     case (PHS_MODE_ADDITIONAL_PARTICLE)
        if (data_is_born) then
           n_out_born = phs_config%n_out
        else
           n_out_born = phs_config%n_out - 1
        end if
        allocate (phs%q_born (n_out_born))
        allocate (phs%q_real (n_out_born + 1))
        allocate (phs%p_born_tot (phs_config%n_in + n_out_born))
     end select
   end subroutine phs_fks_allocate_momenta
 
 @ %def phs_fks_allocate_momenta
 @ Evaluate selected channel. First, the subroutine calls the
 evaluation procedure of the underlying Born phase space, using $n_r -
 3$ random numbers. Then, the remaining three random numbers are used
 to create $\xi$, $y$ and $\phi$, from which the real momenta are
 calculated from the Born momenta.
 <<phs fks: phs fks: TBP>>=
   procedure :: evaluate_selected_channel => phs_fks_evaluate_selected_channel
 <<phs fks: procedures>>=
   subroutine phs_fks_evaluate_selected_channel (phs, c_in, r_in)
     class(phs_fks_t), intent(inout) :: phs
     integer, intent(in) :: c_in
     real(default), intent(in), dimension(:) :: r_in
     integer :: n_in
 
     call phs%phs_wood_t%evaluate_selected_channel (c_in, r_in)
     phs%r(:,c_in) = r_in
 
     phs%q_defined = phs%phs_wood_t%q_defined
     if (.not. phs%q_defined) return
 
     if (phs%perform_generation) then
        select case (phs%mode)
        case (PHS_MODE_ADDITIONAL_PARTICLE)
           n_in = phs%config%n_in
           phs%p_born = phs%phs_wood_t%p
           phs%q_born = phs%phs_wood_t%q
           phs%p_born_tot (1: n_in) = phs%p_born
           phs%p_born_tot (n_in + 1 :) = phs%q_born
           call phs%set_reference_frames (.true.)
           call phs%set_isr_kinematics (.true.)
        case (PHS_MODE_COLLINEAR_REMNANT)
           call phs%compute_isr_kinematics (r_in(phs%n_r_born + 1))
           phs%r_isr = r_in(phs%n_r_born + 1)
        end select
     end if
   end subroutine phs_fks_evaluate_selected_channel
 
 @ %def phs_fks_evaluate_selected_channel
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: evaluate_other_channels => phs_fks_evaluate_other_channels
 <<phs fks: procedures>>=
   subroutine phs_fks_evaluate_other_channels (phs, c_in)
     class(phs_fks_t), intent(inout) :: phs
     integer, intent(in) :: c_in
     call phs%phs_wood_t%evaluate_other_channels (c_in)
     phs%r_defined = .true.
   end subroutine phs_fks_evaluate_other_channels
 
 @ %def phs_fks_evaluate_other_channels
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: get_mcpar => phs_fks_get_mcpar
 <<phs fks: procedures>>=
   subroutine phs_fks_get_mcpar (phs, c, r)
     class(phs_fks_t), intent(in) :: phs
     integer, intent(in) :: c
     real(default), dimension(:), intent(out) :: r
     r(1 : phs%n_r_born) = phs%r(1 : phs%n_r_born,c)
     select case (phs%mode)
     case (PHS_MODE_ADDITIONAL_PARTICLE)
        r(phs%n_r_born + 1 :) = phs%r_real
     case (PHS_MODE_COLLINEAR_REMNANT)
        r(phs%n_r_born + 1 :) = phs%r_isr
     end select
   end subroutine phs_fks_get_mcpar
 
 @ %def phs_fks_get_mcpar
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: set_beam_energy => phs_fks_set_beam_energy
 <<phs fks: procedures>>=
   subroutine phs_fks_set_beam_energy (phs)
     class(phs_fks_t), intent(inout) :: phs
     call phs%generator%set_sqrts_hat (phs%config%sqrts)
   end subroutine phs_fks_set_beam_energy
 
 @ %def phs_fks_set_beam_energy
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: set_emitters => phs_fks_set_emitters
 <<phs fks: procedures>>=
   subroutine phs_fks_set_emitters (phs, emitters)
     class(phs_fks_t), intent(inout) :: phs
     integer, intent(in), dimension(:), allocatable :: emitters
     call phs%generator%set_emitters (emitters)
   end subroutine phs_fks_set_emitters
 
 @ %def phs_fks_set_emitters
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: set_momenta => phs_fks_set_momenta
 <<phs fks: procedures>>=
   subroutine phs_fks_set_momenta (phs, p)
     class(phs_fks_t), intent(inout) :: phs
     type(vector4_t), intent(in), dimension(:) :: p
     integer :: n_in, n_tot_born
     select case (phs%mode)
     case (PHS_MODE_ADDITIONAL_PARTICLE)
        n_in = phs%config%n_in; n_tot_born = phs%config%n_tot - 1
        phs%p_born = p(1 : n_in)
        phs%q_born = p(n_in + 1 : n_tot_born)
        phs%p_born_tot = p
     end select
   end subroutine phs_fks_set_momenta
 
 @ %def phs_fks_set_momenta
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: setup_masses => phs_fks_setup_masses
 <<phs fks: procedures>>=
   subroutine phs_fks_setup_masses (phs, n_tot)
     class(phs_fks_t), intent(inout) :: phs
     integer, intent(in) :: n_tot
     call phs%generator%setup_masses (n_tot)
   end subroutine phs_fks_setup_masses
 
 @ %def phs_fks_setup_masses
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: get_born_momenta => phs_fks_get_born_momenta
 <<phs fks: procedures>>=
   subroutine phs_fks_get_born_momenta (phs, p)
     class(phs_fks_t), intent(inout) :: phs
     type(vector4_t), intent(out), dimension(:) :: p
     select case (phs%mode)
     case (PHS_MODE_ADDITIONAL_PARTICLE)
        p(1 : phs%config%n_in) = phs%p_born
        p(phs%config%n_in + 1 :) = phs%q_born
     case (PHS_MODE_COLLINEAR_REMNANT)
        p(1:phs%config%n_in) = phs%phs_wood_t%p
        p(phs%config%n_in + 1 : ) = phs%phs_wood_t%q
     end select
     if (.not. phs%config%cm_frame)  p = phs%lt_cm_to_lab * p
   end subroutine phs_fks_get_born_momenta
 
 @ %def phs_fks_get_born_momenta
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: get_outgoing_momenta => phs_fks_get_outgoing_momenta
 <<phs fks: procedures>>=
   subroutine phs_fks_get_outgoing_momenta (phs, q)
     class(phs_fks_t), intent(in) :: phs
     type(vector4_t), intent(out), dimension(:) :: q
     select case (phs%mode)
     case (PHS_MODE_ADDITIONAL_PARTICLE)
        q = phs%q_real
     case (PHS_MODE_COLLINEAR_REMNANT)
        q = phs%phs_wood_t%q
     end select
   end subroutine phs_fks_get_outgoing_momenta
 
 @ %def phs_fks_get_outgoing_momenta
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: get_incoming_momenta => phs_fks_get_incoming_momenta
 <<phs fks: procedures>>=
   subroutine phs_fks_get_incoming_momenta (phs, p)
     class(phs_fks_t), intent(in) :: phs
     type(vector4_t), intent(inout), dimension(:), allocatable :: p
     p = phs%p_real
   end subroutine phs_fks_get_incoming_momenta
 
 @ %def phs_fks_get_incoming_momenta
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: set_isr_kinematics => phs_fks_set_isr_kinematics
 <<phs fks: procedures>>=
   subroutine phs_fks_set_isr_kinematics (phs, requires_boost)
     class(phs_fks_t), intent(inout) :: phs
     logical, intent(in) :: requires_boost
     type(vector4_t), dimension(2) :: p
     if (phs%generator%isr_kinematics%isr_mode == SQRTS_VAR) then
        if (requires_boost) then
           p = phs%lt_cm_to_lab * phs%generator%real_kinematics%p_born_cms%phs_point(1)%p(1:2)
        else
           p = phs%generator%real_kinematics%p_born_lab%phs_point(1)%p(1:2)
        end if
        call phs%generator%set_isr_kinematics (p)
     end if
   end subroutine phs_fks_set_isr_kinematics
 
 @ %def phs_fks_set_isr_kinematics
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: generate_radiation_variables => &
      phs_fks_generate_radiation_variables
 <<phs fks: procedures>>=
   subroutine phs_fks_generate_radiation_variables (phs, r_in, threshold)
     class(phs_fks_t), intent(inout) :: phs
     real(default), intent(in), dimension(:) :: r_in
     logical, intent(in) :: threshold
     type(vector4_t), dimension(:), allocatable :: p_born
     if (size (r_in) /= 3) call msg_fatal &
          ("Real kinematics need to be generated using three random numbers!")
     select case (phs%mode)
     case (PHS_MODE_ADDITIONAL_PARTICLE)
        allocate (p_born (size (phs%p_born_tot)))
        if (threshold) then
           p_born = phs%get_onshell_projected_momenta ()
        else
           p_born = phs%p_born_tot
        if (.not. phs%is_cm_frame ()) &
             p_born = inverse (phs%lt_cm_to_lab) * p_born
        end if
        call phs%generator%generate_radiation_variables &
             (r_in, p_born, phs%phs_identifiers, threshold)
        phs%r_real = r_in
     end select
   end subroutine phs_fks_generate_radiation_variables
 
 @ %def phs_fks_generate_radiation_variables
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: compute_xi_ref_momenta => phs_fks_compute_xi_ref_momenta
 <<phs fks: procedures>>=
   subroutine phs_fks_compute_xi_ref_momenta (phs, p_in, contributors)
     class(phs_fks_t), intent(inout) :: phs
     type(vector4_t), intent(in), dimension(:), optional :: p_in
     type(resonance_contributors_t), intent(in), dimension(:), optional :: contributors
     if (phs%mode == PHS_MODE_ADDITIONAL_PARTICLE) then
        if (present (p_in)) then
           call phs%generator%compute_xi_ref_momenta (p_in, contributors)
        else
           call phs%generator%compute_xi_ref_momenta (phs%p_born_tot, contributors)
        end if
     end if
   end subroutine phs_fks_compute_xi_ref_momenta
 
 @ %def phs_fks_compute_xi_ref_momenta
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: compute_xi_ref_momenta_threshold => phs_fks_compute_xi_ref_momenta_threshold
 <<phs fks: procedures>>=
   subroutine phs_fks_compute_xi_ref_momenta_threshold (phs)
     class(phs_fks_t), intent(inout) :: phs
     select case (phs%mode)
     case (PHS_MODE_ADDITIONAL_PARTICLE)
        call phs%generator%compute_xi_ref_momenta_threshold &
             (phs%get_onshell_projected_momenta ())
     end select
   end subroutine phs_fks_compute_xi_ref_momenta_threshold
 
 @ %def phs_fks_compute_xi_ref_momenta
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: compute_cms_energy => phs_fks_compute_cms_energy
 <<phs fks: procedures>>=
   subroutine phs_fks_compute_cms_energy (phs)
     class(phs_fks_t), intent(inout) :: phs
     if (phs%mode == PHS_MODE_ADDITIONAL_PARTICLE) &
          call phs%generator%compute_cms_energy (phs%p_born_tot)
   end subroutine phs_fks_compute_cms_energy
 
 @ %def phs_fks_compute_cms_energy
 @ When initial-state radiation is involved, either due to beamnstrahlung or
 QCD corrections, it is important to have access to both the phase space points
 in the center-of-mass and lab frame.
 <<phs fks: phs fks: TBP>>=
   procedure :: set_reference_frames => phs_fks_set_reference_frames
 <<phs fks: procedures>>=
   subroutine phs_fks_set_reference_frames (phs, is_cms)
     class(phs_fks_t), intent(inout) :: phs
     logical, intent(in) :: is_cms
     type(lorentz_transformation_t) :: lt
     associate (real_kinematics => phs%generator%real_kinematics)
        if (phs%config%cm_frame) then
           real_kinematics%p_born_cms%phs_point(1)%p = phs%p_born_tot
           real_kinematics%p_born_lab%phs_point(1)%p = phs%p_born_tot
        else
           if (is_cms) then
              real_kinematics%p_born_cms%phs_point(1)%p = phs%p_born_tot
              lt = phs%lt_cm_to_lab
              real_kinematics%p_born_lab%phs_point(1)%p = &
                   lt * phs%p_born_tot
           else
              real_kinematics%p_born_lab%phs_point(1)%p = phs%p_born_tot
              lt = inverse (phs%lt_cm_to_lab)
              real_kinematics%p_born_cms%phs_point(1)%p = &
                   lt * phs%p_born_tot
           end if
        end if
     end associate
   end subroutine phs_fks_set_reference_frames
 
 @ %def phs_fks_set_reference_frames
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: i_phs_is_isr => phs_fks_i_phs_is_isr
 <<phs fks: procedures>>=
   function phs_fks_i_phs_is_isr (phs, i_phs) result (is_isr)
     logical :: is_isr
     class(phs_fks_t), intent(in) :: phs
     integer, intent(in) :: i_phs
     is_isr = phs%phs_identifiers(i_phs)%emitter <= phs%generator%n_in
   end function phs_fks_i_phs_is_isr
 
 @ %def phs_fks_i_phs_is_isr
 @
 \subsection{Creation of the real phase space - FSR}
 At this point, the Born phase space has been generated, as well as the
 three random variables $\xi$, $y$ and $\phi$. The question is how the
 real phase space is generated for a final-state emission
 configuration. We work with two different sets of momenta, the Born
 configuration $\Bigl\{ \bar{k}_{\oplus}, \bar{k}_{\ominus}, \bar{k}_{1}, ...,
 \bar{k}_{n} \Bigr\}$ and the real configuration $\Bigl\{ k_{\oplus},
 k_{\ominus}, k_1,..., k_n, k_{n+1} \Bigr\}$. We define the momentum of
 the emitter to be on the $n$-th position and the momentum of the
 radiated particle to be at position $n+1$. The magnitude of the
 spatial component of k is denoted by $\underline{k}$.
 
 For final-state emissions, it is $\bar{k}_\oplus = k_\oplus$ and
 $\bar{k}_\ominus = k_\ominus$. Thus, the center-of-mass systems
 coincide and it is
 \begin{equation}
   q = \sum_{i=1}^n \bar{k}_i = \sum_{i=1}^{n+1} k_i,
 \end{equation}
 with $\vec{q} = 0$ and $q^2 = \left(q^0\right)^2$.
 
 We want to construct the real phase space from the Born phase space
 using three random numbers. They are defined as follows:
 \begin{itemize}
 \item $\xi = \frac{2k_{n+1}^0}{\sqrt{s}} \in [0, \xi_{max}]$, where
   $k_{n+1}$ denotes the four-momentum of the radiated particle.
 \item $y = \cos\theta = \frac{\vec{k}_n \cdot
     \vec{k}_{n+1}}{\underline{k}_n \underline{k}_{n+1}}$ is the
   splitting angle.
 \item The angle between tho two splitting particles in the transversal
   plane, $phi \in [0,2\pi]$.
 \end{itemize}
 Further, $k_{rec} = \sum_{i=1}^{n-1} k_i$ denotes the sum of all
 recoiling momenta.
 <<phs fks: phs fks generator: TBP>>=
   generic :: generate_fsr => generate_fsr_default, generate_fsr_resonances
 <<phs fks: phs fks generator: TBP>>=
   procedure :: generate_fsr_default => phs_fks_generator_generate_fsr_default
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_generate_fsr_default (generator, emitter, i_phs, &
      p_born, p_real, xi_y_phi, no_jacobians)
     class(phs_fks_generator_t), intent(inout) :: generator
     integer, intent(in) :: emitter, i_phs
     type(vector4_t), intent(in), dimension(:) :: p_born
     type(vector4_t), intent(inout), dimension(:) :: p_real
     real(default), intent(in), dimension(3), optional :: xi_y_phi
     logical, intent(in), optional :: no_jacobians
     real(default) :: q0
 
     call generator%generate_fsr_in (p_born, p_real)
     q0 = sum (p_born(1:generator%n_in))**1
 
     generator%i_fsr_first = generator%n_in + 1
     call generator%generate_fsr_out (emitter, i_phs, p_born, p_real, q0, &
          xi_y_phi = xi_y_phi, no_jacobians = no_jacobians)
     if (debug_active (D_PHASESPACE)) then
        call vector4_check_momentum_conservation (p_real, generator%n_in, &
            rel_smallness = 1000 * tiny_07, abs_smallness = tiny_07)
     end if
   end subroutine phs_fks_generator_generate_fsr_default
 
 @ %def phs_fks_generator_generate_fsr
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: generate_fsr_resonances => phs_fks_generator_generate_fsr_resonances
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_generate_fsr_resonances (generator, &
        emitter, i_phs, i_con, p_born, p_real, xi_y_phi, no_jacobians)
     class(phs_fks_generator_t), intent(inout) :: generator
     integer, intent(in) :: emitter, i_phs
     integer, intent(in) :: i_con
     type(vector4_t), intent(in), dimension(:) :: p_born
     type(vector4_t), intent(inout), dimension(:) :: p_real
     real(default), intent(in), dimension(3), optional :: xi_y_phi
     logical, intent(in), optional :: no_jacobians
     integer, dimension(:), allocatable :: resonance_list
     integer, dimension(size(p_born)) :: inv_resonance_list
     type(vector4_t), dimension(:), allocatable :: p_tmp_born
     type(vector4_t), dimension(:), allocatable :: p_tmp_real
     type(vector4_t) :: p_resonance
     real(default) :: q0
     integer :: i, j, nlegborn, nlegreal
     integer :: i_emitter
     type(lorentz_transformation_t) :: boost_to_resonance
     integer :: n_resonant_particles
     call msg_debug2 (D_PHASESPACE, "phs_fks_generator_generate_fsr_resonances")
     nlegborn = size (p_born); nlegreal = nlegborn + 1
     allocate (resonance_list (size (generator%resonance_contributors(i_con)%c)))
     resonance_list = generator%resonance_contributors(i_con)%c
     n_resonant_particles = size (resonance_list)
 
     if (.not. any (resonance_list == emitter)) then
        call msg_fatal ("Emitter must be included in the resonance list!")
     else
        do i = 1, n_resonant_particles
           if (resonance_list (i) == emitter) i_emitter = i
        end do
     end if
 
     inv_resonance_list = &
        create_inverse_resonance_list (nlegborn, resonance_list)
 
     allocate (p_tmp_born (n_resonant_particles))
     allocate (p_tmp_real (n_resonant_particles + 1))
     p_tmp_born = vector4_null
     p_tmp_real = vector4_null
     j = 1
     do i = 1, n_resonant_particles
        p_tmp_born(j) = p_born(resonance_list(i))
        j = j + 1
     end do
 
     call generator%generate_fsr_in (p_born, p_real)
 
     p_resonance = generator%real_kinematics%xi_ref_momenta(i_con)
     q0 = p_resonance**1
 
     boost_to_resonance = inverse (boost (p_resonance, q0))
     p_tmp_born = boost_to_resonance * p_tmp_born
 
     generator%i_fsr_first = 1
     call generator%generate_fsr_out (emitter, i_phs, p_tmp_born, p_tmp_real, &
          q0, i_emitter, xi_y_phi)
     p_tmp_real = inverse (boost_to_resonance) * p_tmp_real
 
     do i = generator%n_in + 1, nlegborn
        if (any (resonance_list == i)) then
           p_real(i) = p_tmp_real(inv_resonance_list (i))
        else
           p_real(i) = p_born (i)
        end if
     end do
     p_real(nlegreal) = p_tmp_real (n_resonant_particles + 1)
 
     if (debug_active (D_PHASESPACE)) then
        call vector4_check_momentum_conservation (p_real, generator%n_in, &
             rel_smallness = 1000 * tiny_07, abs_smallness = tiny_07)
     end if
 
   contains
 
     function create_inverse_resonance_list (nlegborn, resonance_list) &
        result (inv_resonance_list)
        integer, intent(in) :: nlegborn
        integer, intent(in), dimension(:) :: resonance_list
        integer, dimension(nlegborn) :: inv_resonance_list
        integer :: i, j
        inv_resonance_list = 0
        j = 1
        do i = 1, nlegborn
           if (any (i == resonance_list)) then
              inv_resonance_list (i) = j
              j = j + 1
           end if
        end do
     end function create_inverse_resonance_list
 
     function boosted_energy () result (E)
       real(default) :: E
       type(vector4_t) :: p_boost
       p_boost = boost_to_resonance * p_resonance
       E = p_boost%p(0)
     end function boosted_energy
   end subroutine phs_fks_generator_generate_fsr_resonances
 
 @ %def phs_fks_generator_generate_fsr_resonances
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: generate_fsr_threshold => phs_fks_generator_generate_fsr_threshold
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_generate_fsr_threshold (generator, &
        emitter, i_phs, p_born, p_real, xi_y_phi)
     class(phs_fks_generator_t), intent(inout) :: generator
     integer, intent(in) :: emitter, i_phs
     type(vector4_t), intent(in), dimension(:) :: p_born
     type(vector4_t), intent(inout), dimension(:) :: p_real
     real(default), intent(in), dimension(3), optional :: xi_y_phi
     type(vector4_t), dimension(2) :: p_tmp_born
     type(vector4_t), dimension(3) :: p_tmp_real
     integer :: nlegborn, nlegreal
     type(vector4_t) :: p_top
     real(default) :: q0
     type(lorentz_transformation_t) :: boost_to_top
     integer :: leg, other_leg
     real(default) :: sqrts, mtop
     call msg_debug2 (D_PHASESPACE, "phs_fks_generator_generate_fsr_resonances")
     nlegborn = size (p_born); nlegreal = nlegborn + 1
 
     leg = thr_leg(emitter); other_leg = 3 - leg
 
     p_tmp_born(1) = p_born (ass_boson(leg))
     p_tmp_born(2) = p_born (ass_quark(leg))
 
     call generator%generate_fsr_in (p_born, p_real)
 
     p_top = generator%real_kinematics%xi_ref_momenta(leg)
 
     q0 = p_top**1
     sqrts = two * p_born(1)%p(0)
     mtop = m1s_to_mpole (sqrts)
     if (sqrts**2 - four * mtop**2 > zero) then
        boost_to_top = inverse (boost (p_top, q0))
     else
        boost_to_top = identity
     end if
     p_tmp_born = boost_to_top * p_tmp_born
 
     generator%i_fsr_first = 1
     call generator%generate_fsr_out (emitter, i_phs, p_tmp_born, &
          p_tmp_real, q0, 2, xi_y_phi)
     p_tmp_real = inverse (boost_to_top) * p_tmp_real
 
     p_real(ass_boson(leg)) = p_tmp_real(1)
     p_real(ass_quark(leg)) = p_tmp_real(2)
     p_real(ass_boson(other_leg)) = p_born(ass_boson(other_leg))
     p_real(ass_quark(other_leg)) = p_born(ass_quark(other_leg))
     p_real(THR_POS_GLUON) = p_tmp_real(3)
 
   end subroutine phs_fks_generator_generate_fsr_threshold
 
 @ %def phs_fks_generator_generate_fsr_threshold
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: generate_fsr_in => phs_fks_generator_generate_fsr_in
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_generate_fsr_in (generator, p_born, p_real)
     class(phs_fks_generator_t), intent(inout) :: generator
     type(vector4_t), intent(in), dimension(:) :: p_born
     type(vector4_t), intent(inout), dimension(:) :: p_real
     integer :: i
     do i = 1, generator%n_in
        p_real(i) = p_born(i)
     end do
   end subroutine phs_fks_generator_generate_fsr_in
 
 @ %def phs_fks_generator_generate_fsr_in
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: generate_fsr_out => phs_fks_generator_generate_fsr_out
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_generate_fsr_out (generator, &
       emitter, i_phs, p_born, p_real, q0, p_emitter_index, xi_y_phi, no_jacobians)
     class(phs_fks_generator_t), intent(inout) :: generator
     integer, intent(in) :: emitter, i_phs
     type(vector4_t), intent(in), dimension(:) :: p_born
     type(vector4_t), intent(inout), dimension(:) :: p_real
     real(default), intent(in) :: q0
     integer, intent(in), optional :: p_emitter_index
     real(default), intent(in), dimension(3), optional :: xi_y_phi
     logical, intent(in), optional :: no_jacobians
     real(default) :: xi, y, phi
     integer :: nlegborn, nlegreal
     real(default) :: uk_np1, uk_n
     real(default) :: uk_rec, k_rec0
     type(vector3_t) :: k_n_born, k
     real(default) :: uk_n_born, uk, k2, k0_n
     real(default) :: cpsi, beta
     type(vector3_t) :: vec, vec_orth
     type(lorentz_transformation_t) :: rot
     integer :: i, p_em
     logical :: compute_jac
     p_em = emitter; if (present (p_emitter_index)) p_em = p_emitter_index
     compute_jac = .true.
     if (present (no_jacobians)) compute_jac = .not. no_jacobians
     if (generator%i_fsr_first < 0) &
        call msg_fatal ("FSR generator is called for outgoing particles but "&
             &"i_fsr_first is not set!")
 
     if (present (xi_y_phi)) then
        xi = xi_y_phi(I_XI)
        y = xi_y_phi(I_Y)
        phi = xi_y_phi(I_PHI)
     else
        associate (rad_var => generator%real_kinematics)
           xi = rad_var%xi_tilde
           if (rad_var%supply_xi_max) xi = xi * rad_var%xi_max(i_phs)
           y = rad_var%y(i_phs)
           phi = rad_var%phi
        end associate
     end if
 
     nlegborn = size (p_born)
     nlegreal = nlegborn + 1
     generator%E_gluon = q0 * xi / two
     uk_np1 = generator%E_gluon
     k_n_born = p_born(p_em)%p(1:3)
     uk_n_born = k_n_born**1
 
     generator%mrec2 = (q0 - p_born(p_em)%p(0))**2 &
          - space_part_norm(p_born(p_em))**2
     if (generator%is_massive(emitter)) then
        call generator%compute_emitter_kinematics (y, emitter, &
             i_phs, q0, k0_n, uk_n, uk, compute_jac)
     else
        call generator%compute_emitter_kinematics (y, q0, uk_n, uk)
        generator%real_kinematics%y_soft(i_phs) = y
        k0_n = uk_n
     end if
 
     call msg_debug2 (D_PHASESPACE, "phs_fks_generator_generate_fsr_out")
     call debug_input_values ()
 
     vec = uk_n / uk_n_born * k_n_born
     vec_orth = create_orthogonal (vec)
     p_real(p_em)%p(0) = k0_n
     p_real(p_em)%p(1:3) = vec%p(1:3)
     cpsi = (uk_n**2 + uk**2 - uk_np1**2) / (two * uk_n * uk)
     !!! This is to catch the case where cpsi = 1, but numerically
     !!! turns out to be slightly larger than 1.
     call check_cpsi_bound (cpsi)
     rot = rotation (cpsi, - sqrt (one - cpsi**2), vec_orth)
     p_real(p_em) = rot * p_real(p_em)
     vec = uk_np1 / uk_n_born * k_n_born
     vec_orth = create_orthogonal (vec)
     p_real(nlegreal)%p(0) = uk_np1
     p_real(nlegreal)%p(1:3) = vec%p(1:3)
     cpsi = (uk_np1**2 + uk**2 - uk_n**2) / (two * uk_np1 * uk)
     call check_cpsi_bound (cpsi)
     rot = rotation (cpsi, sqrt (one - cpsi**2), vec_orth)
     p_real(nlegreal) = rot * p_real(nlegreal)
     call construct_recoiling_momenta ()
     if (compute_jac) call compute_jacobians ()
 
   contains
 
 <<phs fks: generator generate fsr out procedures>>
 
   end subroutine phs_fks_generator_generate_fsr_out
 
 @ %def phs_fks_generator_generate_fsr_out
 @
 <<phs fks: generator generate fsr out procedures>>=
   subroutine debug_input_values ()
     if (debug2_active (D_PHASESPACE)) then
        call generator%write ()
        print *, 'emitter =    ', emitter
        print *, 'p_born:'
        call vector4_write_set (p_born)
        print *, 'p_real:'
        call vector4_write_set (p_real)
        print *, 'q0 =    ', q0
        if (present(p_emitter_index)) then
           print *, 'p_emitter_index =    ', p_emitter_index
        else
           print *, 'p_emitter_index not given'
        end if
     end if
   end subroutine debug_input_values
 
 <<phs fks: generator generate fsr out procedures>>=
   subroutine check_cpsi_bound (cpsi)
     real(default), intent(inout) :: cpsi
     if (cpsi > one) then
        cpsi = one
     else if (cpsi < -one) then
        cpsi = - one
     end if
   end subroutine check_cpsi_bound
 
 @ Construction of the recoiling momenta. The reshuffling of momenta
 must not change the invariant mass of the recoiling system, which
 means $k_{\rm{rec}}^2 = \bar{k_{\rm{rec}}}^2$. Therefore, the momenta
 are related by a boost, $\bar{k}_i = \Lambda k_i$. The boost parameter
 is
 \begin{equation*}
   \beta = \frac{q^2 - (k_{\rm{rec}}^0 +
     \underline{k}_{\rm{rec}})^2}{q^2 + (k_{\rm{rec}}^0 +
     \underline{k}_{\rm{rec}})^2}
 \end{equation*}
 <<phs fks: generator generate fsr out procedures>>=
   subroutine construct_recoiling_momenta ()
     type(lorentz_transformation_t) :: lambda
     k_rec0 = q0 - p_real(p_em)%p(0) - p_real(nlegreal)%p(0)
     uk_rec = sqrt (k_rec0**2 - generator%mrec2)
     if (generator%is_massive(emitter)) then
        beta = compute_beta (q0**2, k_rec0, uk_rec, &
               p_born(p_em)%p(0), uk_n_born)
     else
        beta = compute_beta (q0**2, k_rec0, uk_rec)
     end if
     k = p_real(p_em)%p(1:3) + p_real(nlegreal)%p(1:3)
     vec%p(1:3) = one / uk * k%p(1:3)
     lambda = boost (beta / sqrt(one - beta**2), vec)
     do i = generator%i_fsr_first, nlegborn
       if (i /= p_em) then
          p_real(i) = lambda * p_born(i)
       end if
     end do
     vec%p(1:3) = p_born(p_em)%p(1:3) / uk_n_born
     rot = rotation (cos(phi), sin(phi), vec)
     p_real(nlegreal) = rot * p_real(nlegreal)
     p_real(p_em) = rot * p_real(p_em)
   end subroutine construct_recoiling_momenta
 
 @ The factor $\frac{q^2}{(4\pi)^3}$ is not included here since it is
 supplied during phase space generation. Also, we already divide by
 $\xi$.
 <<phs fks: generator generate fsr out procedures>>=
   subroutine compute_jacobians ()
     associate (jac => generator%real_kinematics%jac(i_phs))
        if (generator%is_massive(emitter)) then
           jac%jac(1) = jac%jac(1) * four / q0 / uk_n_born / xi
        else
           k2 = two * uk_n * uk_np1* (one - y)
           jac%jac(1) = uk_n**2 / uk_n_born / (uk_n - k2 / (two * q0))
        end if
        jac%jac(2) = one
        jac%jac(3) = one - xi / two * q0 / uk_n_born
     end associate
   end subroutine compute_jacobians
 
 @ %def compute_jacobians
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: generate_fsr_in => phs_fks_generate_fsr_in
 <<phs fks: procedures>>=
   subroutine phs_fks_generate_fsr_in (phs)
     class(phs_fks_t), intent(inout) :: phs
     type(vector4_t), dimension(:), allocatable :: p
     p = phs%generator%real_kinematics%p_born_lab%get_momenta (1, phs%generator%n_in)
   end subroutine phs_fks_generate_fsr_in
 
 @ %def phs_fks_generate_fsr_in
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: generate_fsr => phs_fks_generate_fsr
 <<phs fks: procedures>>=
   subroutine phs_fks_generate_fsr (phs, emitter, i_phs, p_real, i_con, &
          xi_y_phi, no_jacobians)
     class(phs_fks_t), intent(inout) :: phs
     integer, intent(in) :: emitter, i_phs
     type(vector4_t), intent(inout), dimension(:) :: p_real
     integer, intent(in), optional :: i_con
     real(default), intent(in), dimension(3), optional :: xi_y_phi
     logical, intent(in), optional :: no_jacobians
     type(vector4_t), dimension(:), allocatable :: p
     associate (generator => phs%generator)
        allocate (p (1:generator%real_kinematics%p_born_cms%get_n_particles()), &
             source = generator%real_kinematics%p_born_cms%phs_point(1)%p)
        generator%real_kinematics%supply_xi_max = .true.
        if (present (i_con)) then
           call generator%generate_fsr (emitter, i_phs, i_con, p, p_real, &
                xi_y_phi, no_jacobians)
        else
           call generator%generate_fsr (emitter, i_phs, p, p_real, &
                xi_y_phi, no_jacobians)
        end if
        generator%real_kinematics%p_real_cms%phs_point(i_phs)%p = p_real
        if (.not. phs%config%cm_frame)  p_real = phs%lt_cm_to_lab * p_real
        generator%real_kinematics%p_real_lab%phs_point(i_phs)%p = p_real
     end associate
   end subroutine phs_fks_generate_fsr
 
 @ %def phs_fks_generate_fsr
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: get_onshell_projected_momenta => phs_fks_get_onshell_projected_momenta
 <<phs fks: procedures>>=
   pure function phs_fks_get_onshell_projected_momenta (phs) result (p)
     type(vector4_t), dimension(:), allocatable :: p
     class(phs_fks_t), intent(in) :: phs
     p = phs%generator%real_kinematics%p_born_onshell%phs_point(1)%p
   end function phs_fks_get_onshell_projected_momenta
 
 @ %def phs_fks_get_onshell_projected_momenta
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: generate_fsr_threshold => phs_fks_generate_fsr_threshold
 <<phs fks: procedures>>=
   subroutine phs_fks_generate_fsr_threshold (phs, emitter, i_phs, p_real)
     class(phs_fks_t), intent(inout) :: phs
     integer, intent(in) :: emitter, i_phs
     type(vector4_t), intent(inout), dimension(:), optional :: p_real
     type(vector4_t), dimension(:), allocatable :: p_born
     type(vector4_t), dimension(:), allocatable :: pp
     integer :: leg
     associate (generator => phs%generator)
        generator%real_kinematics%supply_xi_max = .true.
        allocate (p_born (1 : generator%real_kinematics%p_born_cms%get_n_particles()))
        p_born = generator%real_kinematics%p_born_onshell%get_momenta (1)
        allocate (pp (size (p_born) + 1))
        call generator%generate_fsr_threshold (emitter, i_phs, p_born, pp)
        leg = thr_leg (emitter)
        call generator%real_kinematics%p_real_onshell(leg)%set_momenta (i_phs, pp)
        if (present (p_real))  p_real = pp
     end associate
   end subroutine phs_fks_generate_fsr_threshold
 
 @ %def phs_fks_generate_fsr_threshold
 @
 <<phs fks: phs fks: TBP>>=
   generic :: compute_xi_max => compute_xi_max_internal, compute_xi_max_with_output
   procedure :: compute_xi_max_internal => phs_fks_compute_xi_max_internal
 <<phs fks: procedures>>=
   subroutine phs_fks_compute_xi_max_internal (phs, p, threshold)
     class(phs_fks_t), intent(inout) :: phs
     type(vector4_t), intent(in), dimension(:) :: p
     logical, intent(in) :: threshold
     integer :: i_phs, i_con, emitter
     do i_phs = 1, size (phs%phs_identifiers)
        associate (phs_id => phs%phs_identifiers(i_phs), generator => phs%generator)
           emitter = phs_id%emitter
           if (threshold) then
              call generator%compute_xi_max (emitter, i_phs, p, &
                   generator%real_kinematics%xi_max(i_phs), i_con = thr_leg(emitter))
           else if (allocated (phs_id%contributors)) then
              do i_con = 1, size (phs_id%contributors)
                 call generator%compute_xi_max (emitter, i_phs, p, &
                      generator%real_kinematics%xi_max(i_phs), i_con = 1)
              end do
           else
              call generator%compute_xi_max (emitter, i_phs, p, &
                   generator%real_kinematics%xi_max(i_phs))
           end if
        end associate
     end do
   end subroutine phs_fks_compute_xi_max_internal
 
 @ %def phs_fks_compute_xi_max
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: compute_xi_max_with_output => phs_fks_compute_xi_max_with_output
 <<phs fks: procedures>>=
   subroutine phs_fks_compute_xi_max_with_output (phs, emitter, i_phs, y, p, xi_max)
     class(phs_fks_t), intent(inout) :: phs
     integer, intent(in) :: i_phs, emitter
     real(default), intent(in) :: y
     type(vector4_t), intent(in), dimension(:) :: p
     real(default), intent(out) :: xi_max
     call phs%generator%compute_xi_max (emitter, i_phs, p, xi_max, y_in = y)
   end subroutine phs_fks_compute_xi_max_with_output
 
 @ %def phs_fks_compute_xi_max_with_output
 @
 <<phs fks: phs fks generator: TBP>>=
   generic :: compute_emitter_kinematics => &
      compute_emitter_kinematics_massless, &
      compute_emitter_kinematics_massive
   procedure :: compute_emitter_kinematics_massless => &
      phs_fks_generator_compute_emitter_kinematics_massless
   procedure :: compute_emitter_kinematics_massive => &
      phs_fks_generator_compute_emitter_kinematics_massive
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_compute_emitter_kinematics_massless &
      (generator, y, q0, uk_em, uk)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), intent(in) :: y, q0
     real(default), intent(out) :: uk_em, uk
     real(default) :: k0_np1, q2
 
     k0_np1 = generator%E_gluon
     q2 = q0**2
 
     uk_em = (q2 - generator%mrec2 - two * q0 * k0_np1) / (two * (q0 - k0_np1 * (one - y)))
     uk = sqrt (uk_em**2 + k0_np1**2 + two * uk_em * k0_np1 * y)
   end subroutine phs_fks_generator_compute_emitter_kinematics_massless
 
   subroutine phs_fks_generator_compute_emitter_kinematics_massive &
       (generator, y, em, i_phs, q0, k0_em, uk_em, uk, compute_jac)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), intent(in) :: y
     integer, intent(in) :: em, i_phs
     real(default), intent(in) :: q0
     real(default), intent(inout) :: k0_em, uk_em, uk
     logical, intent(in) :: compute_jac
     real(default) :: k0_np1, q2, mrec2, m2
     real(default) :: k0_rec_max, k0_em_max, k0_rec, uk_rec
     real(default) :: z, z1, z2
 
     k0_np1 = generator%E_gluon
     q2 = q0**2
     mrec2 = generator%mrec2
     m2 = generator%m2(em)
 
     k0_rec_max = (q2 - m2 + mrec2) / (two * q0)
     k0_em_max = (q2 + m2 - mrec2)  /(two * q0)
     z1 = (k0_rec_max + sqrt (k0_rec_max**2 - mrec2)) / q0
     z2 = (k0_rec_max - sqrt (k0_rec_max**2 - mrec2)) / q0
     z = z2 - (z2 - z1) * (one + y) / two
     k0_em = k0_em_max - k0_np1 * z
     k0_rec = q0 - k0_np1 - k0_em
     uk_em = sqrt(k0_em**2 - m2)
     uk_rec = sqrt(k0_rec**2 - mrec2)
     uk = uk_rec
     if (compute_jac) &
          generator%real_kinematics%jac(i_phs)%jac = q0 * (z1 - z2) / four * k0_np1
     generator%real_kinematics%y_soft(i_phs) = &
        (two * q2 * z - q2 - mrec2 + m2) / (sqrt(k0_em_max**2 - m2) * q0) / two
   end subroutine phs_fks_generator_compute_emitter_kinematics_massive
 
 @ %def phs_fks_generator_compute_emitter_kinematics
 @
 <<phs fks: procedures>>=
   function recompute_xi_max (q0, mrec2, m2, y) result (xi_max)
     real(default) :: xi_max
     real(default), intent(in) :: q0, mrec2, m2, y
     real(default) :: q2, k0_np1_max, k0_rec_max
     real(default) :: z1, z2, z
     q2 = q0**2
     k0_rec_max = (q2 - m2 + mrec2) / (two * q0)
     z1 = (k0_rec_max + sqrt (k0_rec_max**2 - mrec2)) / q0
     z2 = (k0_rec_max - sqrt (k0_rec_max**2 - mrec2)) / q0
     z = z2 - (z2 - z1) * (one + y) / 2
     k0_np1_max = - (q2 * z**2 - two * q0 * k0_rec_max * z + mrec2) / (two * q0 * z * (one - z))
     xi_max = two * k0_np1_max / q0
   end function recompute_xi_max
 
 @ %def recompute_xi_max
 @
 <<phs fks: procedures>>=
   function compute_beta_massless (q2, k0_rec, uk_rec) result (beta)
     real(default), intent(in) :: q2, k0_rec, uk_rec
     real(default) :: beta
     beta = (q2 - (k0_rec + uk_rec)**2) / (q2 + (k0_rec + uk_rec)**2)
   end function compute_beta_massless
 
   function compute_beta_massive (q2, k0_rec, uk_rec, &
      k0_em_born, uk_em_born) result (beta)
     real(default), intent(in) :: q2, k0_rec, uk_rec
     real(default), intent(in) :: k0_em_born, uk_em_born
     real(default) :: beta
     real(default) :: k0_rec_born, uk_rec_born, alpha
     k0_rec_born = sqrt(q2) - k0_em_born
     uk_rec_born = uk_em_born
     alpha = (k0_rec + uk_rec) / (k0_rec_born + uk_rec_born)
     beta = (one - alpha**2) / (one + alpha**2)
   end function compute_beta_massive
 
 @ %def compute_beta
 @ The momentum of the radiated particle is computed according to
 \begin{equation}
   \label{eq:phs fks:compute k_n}
   \underline{k}_n = \frac{q^2 - M_{\rm{rec}}^2 -
     2q^0\underline{k}_{n+1}}{2(q^0 - \underline{k}_{n+1}(1-y))},
 \end{equation}
 with $k = k_n + k_{n+1}$ and $M_{\rm{rec}}^2 = k_{\rm{rec}}^2 =
 \left(q-k\right)^2$. Because of $\boldsymbol{\bar{k}}_n \parallel
 \boldsymbol{k}_n + \boldsymbol{k}_{n+1}$ we find $M_{\rm{rec}}^2 =
 \left(q-\bar{k}_n\right)^2$.
 Equation \ref{eq:phs fks: compute k_n} follows from the fact that
 $\left(\boldsymbol{k} - \boldsymbol{k}_n\right)^2 =
 \boldsymbol{k}_{n+1}^2$, which is equivalent to $\boldsymbol{k}_n
 \cdot \boldsymbol{k} = \frac{1}{2} \left(\underline{k}_n^2 +
   \underline{k}^2 - \underline{k}_{n+1}^2\right)$.\\
 $\boldsymbol{k}_n$ and $\boldsymbol{k}_{n+1}$ are obtained by first
 setting up vectors parallel to $\boldsymbol{\bar{k}}_n$,
 \begin{equation*}
   \boldsymbol{k}_n' = \underline{k}_n
   \frac{\bar{\pmb{k}}_n}{\underline{\bar{k}}_n}, \quad \pmb{k}_{n+1}'
   = \underline{k}_{n+1}\frac{\bar{\pmb{k}}_n}{\underline{\bar{k}}_n},
 \end{equation*}
 and then rotating these vectors by an amount of $\cos\psi_n =
 \frac{\boldsymbol{k}_n\cdot\pmb{k}}{\underline{k}_n \underline{k}}$.
 @ The emitted particle cannot have more momentum than the emitter has
 in the Born phase space. Thus, there is an upper bound for $\xi$,
 determined by the condition $k_{n+1}^0 = \underline{\bar{k}}_n$, which
 is equal to
 \begin{equation*}
 \xi_{\rm{max}} = \frac{2}{\underline{\bar{k}}_n}{q^0}.
 \end{equation*}
 <<phs fks: procedures>>=
   pure function get_xi_max_fsr_massless (p_born, q0, emitter) result (xi_max)
     type(vector4_t), intent(in), dimension(:) :: p_born
     real(default), intent(in) :: q0
     integer, intent(in) :: emitter
     real(default) :: xi_max
     real(default) :: uk_n_born
     uk_n_born = space_part_norm (p_born(emitter))
     xi_max = two * uk_n_born / q0
   end function get_xi_max_fsr_massless
 
 @ %def get_xi_max_fsr_massless
 @ The computation of $\xi_{\rm{max}}$ for massive emitters is described
 in arXiv:1202.0465. Let's recapitulate it here.
 
 We consider the Dalitz-domain created by $k_{n+1}^0$, $k_n^0$ and
 $k_{\rm{rec}}^0$ and introduce the parameterization
 \begin{equation*}
   k_n^0 = \bar{k}_n^0 - zk_{n+1}^0
 \end{equation*}
 Then, for each value of $z$, there exists a maximum value of
 $\underline{k}_{n+1}$ from which $\xi_{\rm{max}}$ can be extracted via
 $\xi_{\rm{max}} = 2k_{n+1}^0/q$. It is determined by the condition
 \begin{equation*}
   \underline{k}_{n+1} \pm \underline{k}_n \pm \underline{k}_{\rm{rec}} = 0.
 \end{equation*}
 This can be manipulated to yield
 \begin{equation*}
   \left(\underline{k}_{n+1}^2 + \underline{k}_n^2 -
   \underline{k}_{\rm{rec}}^2\right)^2 =
   4\underline{k}^2_{n+1}\underline{k}_n^2.
 \end{equation*}
 Here we can use $\underline{k}_n^2 = \left(k_n^0\right)^2 - m^2$ and
 $\underline{k}_{\rm{rec}}^2 = \left(q - k_n^0 - k_{n+1}^0\right)^2 -
 M_{\rm{rec}}^2$, as well as the above parameterization of $k_n^0$, to
 obtain
 \begin{equation*}
   4\underline{k}_{n+1}^2\left(2\underline{k}_{n+1}qz(1-z) +
   q^2z^2 - 2q\bar{k}_{\rm{rec}}^0z + M_{\rm{rec}}^2\right) = 0.
 \end{equation*}
 Solving for $k_{n+1}^0$ gives
 \begin{equation}
   k_{n+1}^0 = \frac{2q\bar{k}^0_{\rm{rec}}z - q^2z^2 - M_{\rm{rec}}^2}{2qz(1-z)}.
   \label{XiMaxMassive}
 \end{equation}
 It is still open how to compute $z$. For this, consider that the
 right-hand-side of equation (\ref{XiMaxMassive}) vanishes for
 \begin{equation*}
   z_{1,2} = \left(\bar{k}_{\rm{rec}}^0 \pm
   \sqrt{\left(\bar{k}_{\rm{rec}}^0\right)^2 - M_{\rm{rec}}^2}\right)/q,
 \end{equation*}
 which corresponds to the borders of the Dalitz-region where the gluon
 momentum vanishes. Thus we define
 \begin{equation*}
   z = z_2 - \frac{1}{2} (z_2 - z_1)(1+y).
 \end{equation*}
 <<phs fks: procedures>>=
   pure function get_xi_max_fsr_massive (p_born, q0, emitter, m2, y) result (xi_max)
     real(default) :: xi_max
     type(vector4_t), intent(in), dimension(:) :: p_born
     real(default), intent(in) :: q0
     integer, intent(in) :: emitter
     real(default), intent(in) :: m2, y
     real(default) :: mrec2
     real(default) :: k0_rec_max
     real(default) :: z, z1, z2
     real(default) :: k0_np1_max
     associate (p => p_born(emitter)%p)
        mrec2 = (q0 - p(0))**2 - p(1)**2 - p(2)**2 - p(3)**2
     end associate
     call compute_dalitz_bounds (q0, m2, mrec2, z1, z2, k0_rec_max)
     z = z2 - (z2 - z1) * (one + y) / two
     k0_np1_max = - (q0**2 * z**2 - two * q0 * k0_rec_max * z + mrec2) &
        / (two * q0 * z * (one - z))
     xi_max = two * k0_np1_max / q0
   end function get_xi_max_fsr_massive
 
 @ %def get_xi_max_fsr_massive
 @
 <<phs fks: parameters>>=
   integer, parameter, public :: I_PLUS = 1
   integer, parameter, public :: I_MINUS = 2
 
 @ %def parameters
 @
 <<phs fks: procedures>>=
   function get_xi_max_isr (xb, y) result (xi_max)
     real(default) :: xi_max
     real(default), dimension(2), intent(in) :: xb
     real(default), intent(in) :: y
     xi_max = one - max (xi_max_isr_plus (xb(I_PLUS), y), xi_max_isr_minus (xb(I_MINUS), y))
   end function get_xi_max_isr
 
 @ %def get_xi_max_isr
 @
 <<phs fks: procedures>>=
   function xi_max_isr_plus (x, y)
     real(default) :: xi_max_isr_plus
     real(default), intent(in) :: x, y
     real(default) :: deno
     deno = sqrt ((one + x**2)**2 * (one - y)**2 + 16 * y * x**2) + (one - y) * (1 - x**2)
     xi_max_isr_plus = two * (one + y) * x**2 / deno
   end function xi_max_isr_plus
 
   function xi_max_isr_minus (x, y)
     real(default) :: xi_max_isr_minus
     real(default), intent(in) :: x, y
     real(default) :: deno
     deno = sqrt ((one + x**2)**2 * (one + y)**2 - 16 * y * x**2) + (one + y) * (1 - x**2)
     xi_max_isr_minus = two * (one - y) * x**2 / deno
   end function xi_max_isr_minus
 
 
 @ %def xi_max_isr_plus, xi_max_isr_minus
 @
 <<phs fks: procedures>>=
   recursive function get_xi_max_isr_decay (p) result (xi_max)
      real(default) :: xi_max
      type(vector4_t), dimension(:), intent(in) :: p
      integer :: n_tot
      type(vector4_t), dimension(:), allocatable :: p_dec_new
      n_tot = size (p)
      if (n_tot == 3) then
         xi_max = xi_max_one_to_two (p(1), p(2), p(3))
      else
         allocate (p_dec_new (n_tot - 1))
         p_dec_new(1) = sum (p (3 : ))
         p_dec_new(2 : n_tot - 1) = p (3 : n_tot)
         xi_max = min (xi_max_one_to_two (p(1), p(2), sum(p(3 : ))), &
              get_xi_max_isr_decay (p_dec_new))
      end if
   contains
     function xi_max_one_to_two (p_in, p_out1, p_out2) result (xi_max)
       real(default) :: xi_max
       type(vector4_t), intent(in) :: p_in, p_out1, p_out2
       real(default) :: m_in, m_out1, m_out2
       m_in = p_in**1
       m_out1 = p_out1**1; m_out2 = p_out2**1
       xi_max = one - (m_out1 + m_out2)**2 / m_in**2
     end function xi_max_one_to_two
   end function get_xi_max_isr_decay
 
 @ %def get_xi_max_isr_decay
 @
 \subsection{Creation of the real phase space - ISR}
 <<phs fks: phs fks: TBP>>=
   procedure :: generate_isr => phs_fks_generate_isr
 <<phs fks: procedures>>=
   subroutine phs_fks_generate_isr (phs, i_phs, p_real)
     class(phs_fks_t), intent(inout) :: phs
     integer, intent(in) :: i_phs
     type(vector4_t), intent(inout), dimension(:) :: p_real
     type(vector4_t) :: p0, p1
     type(lorentz_transformation_t) :: lt
     real(default) :: sqrts_hat
     type(vector4_t), dimension(:), allocatable :: p_work
 
     associate (generator => phs%generator)
        select case (generator%n_in)
        case (1)
           allocate (p_work (1:generator%real_kinematics%p_born_cms%get_n_particles()), &
                source = generator%real_kinematics%p_born_cms%phs_point(1)%p)
           call generator%generate_isr_fixed_beam_energy (i_phs, p_work, p_real)
           phs%config%cm_frame = .true.
        case (2)
           select case (generator%isr_kinematics%isr_mode)
           case (SQRTS_FIXED)
              allocate (p_work (1:generator%real_kinematics%p_born_cms%get_n_particles()), &
                   source = generator%real_kinematics%p_born_cms%phs_point(1)%p)
              call generator%generate_isr_fixed_beam_energy (i_phs, p_work, p_real)
           case (SQRTS_VAR)
              allocate (p_work (1:generator%real_kinematics%p_born_lab%get_n_particles()), &
                   source = generator%real_kinematics%p_born_lab%phs_point(1)%p)
              call generator%generate_isr (i_phs, p_work, p_real)
           end select
        end select
        generator%real_kinematics%p_real_lab%phs_point(i_phs)%p = p_real
        if (.not. phs%config%cm_frame) then
           sqrts_hat = (p_real(1) + p_real(2))**1
           p0 = p_real(1) + p_real(2)
           lt = boost (p0, sqrts_hat)
           p1 = inverse(lt) * p_real(1)
           lt = lt * rotation_to_2nd (3, space_part (p1))
           phs%generator%real_kinematics%p_real_cms%phs_point(i_phs)%p = &
                inverse (lt) * p_real
        else
           phs%generator%real_kinematics%p_real_cms%phs_point(i_phs)%p = p_real
        end if
      end associate
   end subroutine phs_fks_generate_isr
 
 @ %def phs_fks_generate_isr
 @ The real phase space for an inital-state emission involved in a decay
 process is generated by first setting the gluon momentum like in the
 scattering case by using its angular coordinates $y$ and $\phi$ and then
 adjusting the gluon energy with $\xi$. The emitter momentum is kept
 identical to the Born case, i.e.  $p_{\rm{in}} = \bar{p}_{\rm{in}}$, so
 that after the emission it has momentum $p_{\rm{virt}} = p_{\rm{in}} -
 p_{\rm{g}}$ and invariant mass $m^2 = p_{\rm{virt}}^2$.  Note that the
 final state momenta have to remain on-shell, so that $p_1^2 =
 \bar{p}_1^2 = m_1^2$ and $p_2^2 = \bar{p}_2^2 = m_2^2$. Let $\Lambda$ be
 the boost from into the rest frame of the emitter after emission, i.e.
 $\Lambda p_{\rm{virt}} = \left(m, 0, 0, 0\right)$.  In this reference
 frame, the spatial components of the final-state momenta sum up to zero,
 and their magnitude is
 \begin{equation*}
   p = \frac{\sqrt {\lambda (m^2, m_1^2, m_2^2)}}{2m},
 \end{equation*}
 a fact already used in the evaluation of the phase space trees of
 [[phs_forest]].  Obviously, from this, the final-state energies can be
 deferred via $E_i^2 = m_i^2 - p^2$.  In the next step, the $p_{1,2}$ are
 set up as vectors $(E,0,0,\pm p)$ along the z-axis and then rotated
 about the same azimuthal and polar angles as in the Born system.
 Finally, the momenta are boosted out of the rest frame by multiplying
 with $\Lambda$.
 <<phs fks: phs fks generator: TBP>>=
   procedure :: generate_isr_fixed_beam_energy => phs_fks_generator_generate_isr_fixed_beam_energy
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_generate_isr_fixed_beam_energy (generator, i_phs, p_born, p_real)
      class(phs_fks_generator_t), intent(inout) :: generator
      integer, intent(in) :: i_phs
      type(vector4_t), intent(in), dimension(:) :: p_born
      type(vector4_t), intent(inout), dimension(:) :: p_real
      real(default) :: xi_max, xi, y, phi
      integer :: nlegborn, nlegreal, i
      real(default) :: k0_np1
      real(default) :: msq_in
      type(vector4_t) :: p_virt
      real(default) :: jac_real
 
      associate (rad_var => generator%real_kinematics)
         xi_max = rad_var%xi_max(i_phs)
         xi = rad_var%xi_tilde * xi_max
         y = rad_var%y(i_phs)
         phi = rad_var%phi
         rad_var%y_soft(i_phs) = y
      end associate
 
      nlegborn = size (p_born)
      nlegreal = nlegborn + 1
 
      msq_in = sum (p_born(1:generator%n_in))**2
      generator%real_kinematics%jac(i_phs)%jac = one
 
      p_real(1) = p_born(1)
      if (generator%n_in > 1) p_real(2) = p_born(2)
      k0_np1 = zero
      do i = 1, generator%n_in
         k0_np1 = k0_np1 + p_real(i)%p(0) * xi / two
      end do
      p_real(nlegreal)%p(0) = k0_np1
      p_real(nlegreal)%p(1) = k0_np1 * sqrt(one - y**2) * sin(phi)
      p_real(nlegreal)%p(2) = k0_np1 * sqrt(one - y**2) * cos(phi)
      p_real(nlegreal)%p(3) = k0_np1 * y
 
      p_virt = sum (p_real(1:generator%n_in)) - p_real(nlegreal)
 
      jac_real = one
      call generate_on_shell_decay (p_virt, &
           p_born(generator%n_in + 1 : nlegborn), p_real(generator%n_in + 1 : nlegreal - 1), &
           1, msq_in, jac_real)
 
      associate (jac => generator%real_kinematics%jac(i_phs))
         jac%jac(1) = jac_real
         jac%jac(2) = one
      end associate
 
   end subroutine phs_fks_generator_generate_isr_fixed_beam_energy
 
 @ %def phs_fks_generator_generate_isr_fixed_beam_energy
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: generate_isr_factorized => phs_fks_generator_generate_isr_factorized
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_generate_isr_factorized (generator, i_phs, emitter, p_born, p_real)
     class(phs_fks_generator_t), intent(inout) :: generator
     integer, intent(in) :: i_phs, emitter
     type(vector4_t), intent(in), dimension(:) :: p_born
     type(vector4_t), intent(inout), dimension(:) :: p_real
     type(vector4_t), dimension(3) :: p_tmp_born
     type(vector4_t), dimension(4) :: p_tmp_real
     type(vector4_t) :: p_top
     type(lorentz_transformation_t) :: boost_to_rest_frame
     integer, parameter :: nlegreal = 7 !!! Factorized phase space so far only required for ee -> bwbw
 
     p_tmp_born = vector4_null; p_tmp_real = vector4_null
     p_real(1:2) = p_born(1:2)
     if (emitter == THR_POS_B) then
        p_top = p_born (THR_POS_WP) + p_born (THR_POS_B)
        p_tmp_born(2) = p_born (THR_POS_WP)
        p_tmp_born(3) = p_born (THR_POS_B)
     else if (emitter == THR_POS_BBAR) then
        p_top = p_born (THR_POS_WM) + p_born (THR_POS_BBAR)
        p_tmp_born(2) = p_born (THR_POS_WM)
        p_tmp_born(3) = p_born (THR_POS_BBAR)
     else
        call msg_fatal ("Threshold computation requires emitters to be at position 5 and 6 " // &
           "Please check if your process specification fulfills this requirement.")
     end if
     p_tmp_born (1) = p_top
     boost_to_rest_frame = inverse (boost (p_top, p_top**1))
     p_tmp_born = boost_to_rest_frame * p_tmp_born
     call generator%compute_xi_max_isr_factorized (i_phs, p_tmp_born)
     call generator%generate_isr_fixed_beam_energy (i_phs, p_tmp_born, p_tmp_real)
     p_tmp_real = inverse (boost_to_rest_frame) * p_tmp_real
     if (emitter == THR_POS_B) then
        p_real(THR_POS_WP) = p_tmp_real(2)
        p_real(THR_POS_B) = p_tmp_real(3)
        p_real(THR_POS_WM) = p_born(THR_POS_WM)
        p_real(THR_POS_BBAR) = p_born(THR_POS_BBAR)
     !!! Exception has been handled above
     else
        p_real(THR_POS_WM) = p_tmp_real(2)
        p_real(THR_POS_BBAR) = p_tmp_real(3)
        p_real(THR_POS_WP) = p_born(THR_POS_WP)
        p_real(THR_POS_B) = p_born(THR_POS_B)
     end if
     p_real(nlegreal) = p_tmp_real(4)
   end subroutine phs_fks_generator_generate_isr_factorized
 
 @ %def phs_fks_generator_generate_isr_factorized
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: generate_isr => phs_fks_generator_generate_isr
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_generate_isr (generator, i_phs, p_born, p_real)
     !!! Important: Import momenta in the lab frame
     class(phs_fks_generator_t), intent(inout) :: generator
     integer, intent(in) :: i_phs
     type(vector4_t), intent(in) , dimension(:) :: p_born
     type(vector4_t), intent(inout), dimension(:) :: p_real
     real(default) :: xi_max, xi_tilde, xi, y, phi
     integer :: nlegborn, nlegreal
     real(default) :: sqrts_real
     real(default) :: k0_np1
     type(lorentz_transformation_t) :: lambda_transv, lambda_longit, lambda_longit_inv
     real(default) :: x_plus, x_minus, xb_plus, xb_minus
     real(default) :: onemy, onepy
     integer :: i
     real(default) :: xi_plus, xi_minus
     real(default) :: beta_gamma
     type(vector3_t) :: beta_vec
 
     associate (rad_var => generator%real_kinematics)
        xi_max = rad_var%xi_max(i_phs)
        xi_tilde = rad_var%xi_tilde
        xi = xi_tilde * xi_max
        y = rad_var%y(i_phs)
        onemy = one - y; onepy = one + y
        phi = rad_var%phi
        rad_var%y_soft(i_phs) = y
     end associate
 
     nlegborn = size (p_born)
     nlegreal = nlegborn + 1
     generator%isr_kinematics%sqrts_born = (p_born(1) + p_born(2))**1
 
     !!! Initial state real momenta
     xb_plus = generator%isr_kinematics%x(I_PLUS)
     xb_minus = generator%isr_kinematics%x(I_MINUS)
     x_plus = xb_plus / sqrt(one - xi) * sqrt ((two - xi * onemy) / (two - xi * onepy))
     x_minus = xb_minus / sqrt(one - xi) * sqrt ((two - xi * onepy) / (two - xi * onemy))
     xi_plus = xi_tilde * (one - xb_plus)
     xi_minus = xi_tilde * (one - xb_minus)
     p_real(I_PLUS) = x_plus / xb_plus * p_born(I_PLUS)
     p_real(I_MINUS) = x_minus / xb_minus * p_born(I_MINUS)
     generator%isr_kinematics%z(I_PLUS) = x_plus / xb_plus
     generator%isr_kinematics%z(I_MINUS) = x_minus / xb_minus
     generator%isr_kinematics%z_coll(I_PLUS) = one / (one - xi_plus)
     generator%isr_kinematics%z_coll(I_MINUS) = one / (one - xi_minus)
 
     !!! Create radiation momentum
     sqrts_real = generator%isr_kinematics%sqrts_born / sqrt (one - xi)
     k0_np1 = sqrts_real * xi / two
     p_real(nlegreal)%p(0) = k0_np1
     p_real(nlegreal)%p(1) = k0_np1 * sqrt (one - y**2) * sin(phi)
     p_real(nlegreal)%p(2) = k0_np1 * sqrt (one - y**2) * cos(phi)
     p_real(nlegreal)%p(3) = k0_np1 * y
 
     call get_boost_parameters (p_real, beta_gamma, beta_vec)
     lambda_longit = create_longitudinal_boost (beta_gamma, beta_vec, inverse = .true.)
     p_real(nlegreal) = lambda_longit * p_real(nlegreal)
 
     call get_boost_parameters (p_born, beta_gamma, beta_vec)
     lambda_longit = create_longitudinal_boost (beta_gamma, beta_vec, inverse = .false.)
     forall (i = 3 : nlegborn)  p_real(i) = lambda_longit * p_born(i)
 
     lambda_transv = create_transversal_boost (p_real(nlegreal), xi, sqrts_real)
     forall (i = 3 : nlegborn)  p_real(i) = lambda_transv * p_real(i)
 
     lambda_longit_inv = create_longitudinal_boost (beta_gamma, beta_vec, inverse = .true.)
     forall (i = 3 : nlegborn)  p_real(i) = lambda_longit_inv * p_real(i)
 
     !!! Compute jacobians
     associate (jac => generator%real_kinematics%jac(i_phs))
        !!! Additional 1 / (1 - xi) factor because in the real jacobian,
        !!! there is s_real in the numerator
        !!! We also have to adapt the flux factor, which is 1/2s_real for the real component
        !!! The reweighting factor is s_born / s_real, cancelling the (1-x) factor from above
        jac%jac(1) = one / (one - xi)
        jac%jac(2) = one
        jac%jac(3) = one / (one - xi_plus)**2
        jac%jac(4) = one / (one - xi_minus)**2
     end associate
   contains
     subroutine get_boost_parameters (p, beta_gamma, beta_vec)
        type(vector4_t), intent(in), dimension(:) :: p
        real(default), intent(out) :: beta_gamma
        type(vector3_t), intent(out) :: beta_vec
        beta_vec = (p(1)%p(1:3) + p(2)%p(1:3)) / (p(1)%p(0) + p(2)%p(0))
        beta_gamma = beta_vec**1 / sqrt (one - beta_vec**2)
        beta_vec = beta_vec / beta_vec**1
     end subroutine get_boost_parameters
 
     function create_longitudinal_boost (beta_gamma, beta_vec, inverse) result (lambda)
        real(default), intent(in) :: beta_gamma
        type(vector3_t), intent(in) :: beta_vec
        logical, intent(in) :: inverse
        type(lorentz_transformation_t) :: lambda
        if (inverse) then
           lambda = boost (beta_gamma, beta_vec)
        else
           lambda = boost (-beta_gamma, beta_vec)
        end if
     end function create_longitudinal_boost
 
     function create_transversal_boost (p_rad, xi, sqrts_real) result (lambda)
        type(vector4_t), intent(in) :: p_rad
        real(default), intent(in) :: xi, sqrts_real
        type(lorentz_transformation_t) :: lambda
        type(vector3_t) :: vec_transverse
        real(default) :: pt2, beta, beta_gamma
        pt2 = transverse_part (p_rad)**2
        beta = one / sqrt (one + sqrts_real**2 * (one - xi) / pt2)
        beta_gamma = beta / sqrt (one - beta**2)
        vec_transverse%p(1:2) = p_rad%p(1:2)
        vec_transverse%p(3) = zero
        vec_transverse = normalize (vec_transverse)
        lambda = boost (-beta_gamma, vec_transverse)
     end function create_transversal_boost
   end subroutine phs_fks_generator_generate_isr
 
 @ %def phs_fks_generator_generate_isr
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: set_sqrts_hat => phs_fks_generator_set_sqrts_hat
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_set_sqrts_hat (generator, sqrts)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), intent(in) :: sqrts
     generator%sqrts = sqrts
   end subroutine phs_fks_generator_set_sqrts_hat
 
 @ %def phs_fks_generator_set_sqrts_hat
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: set_emitters => phs_fks_generator_set_emitters
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_set_emitters (generator, emitters)
     class(phs_fks_generator_t), intent(inout) :: generator
     integer, intent(in), dimension(:), allocatable ::  emitters
     allocate (generator%emitters (size (emitters)))
     generator%emitters = emitters
   end subroutine phs_fks_generator_set_emitters
 
 @ %def phs_fks_generator_set_emitters
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: setup_masses => phs_fks_generator_setup_masses
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_setup_masses (generator, n_tot)
     class (phs_fks_generator_t), intent(inout) :: generator
     integer, intent(in) :: n_tot
     if (.not. allocated (generator%m2)) then
        allocate (generator%is_massive (n_tot))
        allocate (generator%m2 (n_tot))
        generator%is_massive = .false.
        generator%m2 = zero
     end if
   end subroutine phs_fks_generator_setup_masses
 
 @ %def phs_fks_generator_setup_masses
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: set_xi_and_y_bounds => phs_fks_generator_set_xi_and_y_bounds
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_set_xi_and_y_bounds (generator, xi_min, y_max)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), intent(in) :: xi_min, y_max
     generator%xi_min = xi_min
     generator%y_max = y_max
   end subroutine phs_fks_generator_set_xi_and_y_bounds
 
 @ %def phs_fks_generator_set_xi_and_y_bounds
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: set_isr_kinematics => phs_fks_generator_set_isr_kinematics
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_set_isr_kinematics (generator, p)
     class(phs_fks_generator_t), intent(inout) :: generator
     type(vector4_t), dimension(2), intent(in) :: p
 
     generator%isr_kinematics%x = p%p(0) / generator%isr_kinematics%beam_energy
   end subroutine phs_fks_generator_set_isr_kinematics
 
 @ %def phs_fks_generator_set_isr_kinematics
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: generate_radiation_variables => &
      phs_fks_generator_generate_radiation_variables
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_generate_radiation_variables &
      (generator, r_in, p_born, phs_identifiers, threshold)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), intent(in), dimension(:) :: r_in
     type(vector4_t), intent(in), dimension(:) :: p_born
     type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
     logical, intent(in), optional :: threshold
 
     associate (rad_var => generator%real_kinematics)
        rad_var%phi = r_in (I_PHI) * twopi
        select case (generator%mode)
        case (GEN_REAL_PHASE_SPACE)
           rad_var%jac_rand = twopi
           call generator%compute_y_real_phs (r_in(I_Y), p_born, phs_identifiers, &
                rad_var%jac_rand, rad_var%y, threshold)
        case (GEN_SOFT_MISMATCH)
           rad_var%jac_mismatch = twopi
           call generator%compute_y_mismatch (r_in(I_Y), rad_var%jac_mismatch, &
                rad_var%y_mismatch, rad_var%y_soft)
        case default
           call generator%compute_y_test (rad_var%y)
        end select
        call generator%compute_xi_tilde (r_in(I_XI))
        call generator%set_masses (p_born, phs_identifiers)
     end associate
   end subroutine phs_fks_generator_generate_radiation_variables
 
 @ %def phs_fks_generator_generate_radiation_variables
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: compute_xi_ref_momenta => phs_fks_generator_compute_xi_ref_momenta
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_compute_xi_ref_momenta &
          (generator, p_born, resonance_contributors)
     class(phs_fks_generator_t), intent(inout) :: generator
     type(vector4_t), intent(in), dimension(:) :: p_born
     type(resonance_contributors_t), intent(in), dimension(:), optional &
        :: resonance_contributors
     integer :: i_con, n_contributors
     if (present (resonance_contributors)) then
        n_contributors = size (resonance_contributors)
        if (.not. allocated (generator%resonance_contributors)) &
           allocate (generator%resonance_contributors (n_contributors))
        do i_con = 1, n_contributors
           generator%real_kinematics%xi_ref_momenta(i_con) = &
                get_resonance_momentum (p_born, resonance_contributors(i_con)%c)
           generator%resonance_contributors(i_con) = resonance_contributors(i_con)
        end do
     else
        generator%real_kinematics%xi_ref_momenta(1) = sum (p_born(1:generator%n_in))
     end if
   end subroutine phs_fks_generator_compute_xi_ref_momenta
 
 @ %def phs_fks_generator_compute_xi_ref_momenta
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: compute_xi_ref_momenta_threshold &
        => phs_fks_generator_compute_xi_ref_momenta_threshold
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_compute_xi_ref_momenta_threshold (generator, p_born)
     class(phs_fks_generator_t), intent(inout) :: generator
     type(vector4_t), intent(in), dimension(:) :: p_born
     generator%real_kinematics%xi_ref_momenta(1) = p_born(THR_POS_WP) + p_born(THR_POS_B)
     generator%real_kinematics%xi_ref_momenta(2) = p_born(THR_POS_WM) + p_born(THR_POS_BBAR)
   end subroutine phs_fks_generator_compute_xi_ref_momenta_threshold
 
 @ %def phs_fks_generator_compute_xi_ref_momenta
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: compute_cms_energy => phs_fks_generator_compute_cms_energy
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_compute_cms_energy (generator, p_born)
     class(phs_fks_generator_t), intent(inout) :: generator
     type(vector4_t), intent(in), dimension(:) :: p_born
     type(vector4_t) :: p_sum
     p_sum = sum (p_born (1 : generator%n_in))
     generator%real_kinematics%cms_energy2 = p_sum**2
   end subroutine phs_fks_generator_compute_cms_energy
 
 @ %def phs_fks_generator_compute_cms_energy
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: compute_xi_max => phs_fks_generator_compute_xi_max
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_compute_xi_max (generator, emitter, &
        i_phs, p, xi_max, i_con, y_in)
     class(phs_fks_generator_t), intent(inout) :: generator
     integer, intent(in) :: i_phs, emitter
     type(vector4_t), intent(in), dimension(:) :: p
     real(default), intent(out) :: xi_max
     integer, intent(in), optional :: i_con
     real(default), intent(in), optional :: y_in
     real(default) :: q0
     type(vector4_t), dimension(:), allocatable :: pp, pp_decay
     type(vector4_t) :: p_res
     type(lorentz_transformation_t) :: L_to_resonance
     real(default) :: y
     if (.not. any (generator%emitters == emitter)) return
     allocate (pp (size (p)))
     associate (rad_var => generator%real_kinematics)
        if (present (i_con)) then
           q0 = rad_var%xi_ref_momenta(i_con)**1
        else
           q0 = energy (sum (p(1:generator%n_in)))
        end if
        if (present (y_in)) then
           y = y_in
        else
           y = rad_var%y(i_phs)
        end if
        if (present (i_con)) then
           p_res = rad_var%xi_ref_momenta(i_con)
           L_to_resonance = inverse (boost (p_res, q0))
           pp = L_to_resonance * p
        else
           pp = p
        end if
        if (emitter <= generator%n_in) then
           select case (generator%isr_kinematics%isr_mode)
           case (SQRTS_FIXED)
              if (generator%n_in > 1) then
                 allocate (pp_decay (size (pp) - 1))
              else
                 allocate (pp_decay (size (pp)))
              end if
              pp_decay (1) = sum (pp(1:generator%n_in))
              pp_decay (2 : ) = pp (generator%n_in + 1 : )
              xi_max = get_xi_max_isr_decay (pp_decay)
              deallocate (pp_decay)
           case (SQRTS_VAR)
              xi_max = get_xi_max_isr (generator%isr_kinematics%x, y)
           end select
        else
           if (generator%is_massive(emitter)) then
              xi_max = get_xi_max_fsr (pp, q0, emitter, generator%m2(emitter), y)
           else
              xi_max = get_xi_max_fsr (pp, q0, emitter)
           end if
        end if
        deallocate (pp)
     end associate
   end subroutine phs_fks_generator_compute_xi_max
 
 @ %def phs_fks_generator_compute_xi_max
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: compute_xi_max_isr_factorized &
      => phs_fks_generator_compute_xi_max_isr_factorized
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_compute_xi_max_isr_factorized &
      (generator, i_phs, p)
     class(phs_fks_generator_t), intent(inout) :: generator
     integer, intent(in) :: i_phs
     type(vector4_t), intent(in), dimension(:) :: p
     generator%real_kinematics%xi_max(i_phs) = get_xi_max_isr_decay (p)
   end subroutine phs_fks_generator_compute_xi_max_isr_factorized
 
 @ %def phs_fks_generator_compute_xi_max_isr_factorized
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: set_masses => phs_fks_generator_set_masses
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_set_masses (generator, p, phs_identifiers)
     class(phs_fks_generator_t), intent(inout) :: generator
     type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
     type(vector4_t), intent(in), dimension(:) :: p
     integer :: emitter, i_phs
     do i_phs = 1, size (phs_identifiers)
        emitter = phs_identifiers(i_phs)%emitter
        if (any (generator%emitters == emitter) .and. emitter > 0) then
           if (generator%is_massive (emitter) .and. emitter > generator%n_in) &
              generator%m2(emitter) = p(emitter)**2
        end if
     end do
   end subroutine phs_fks_generator_set_masses
 
 @ %def phs_fhs_generator_set_masses
 @
 <<phs fks: public>>=
   public :: compute_y_from_emitter
 <<phs fks: procedures>>=
   subroutine compute_y_from_emitter (r_y, p, n_in, emitter, massive, &
          y_max, jac_rand, y, contributors, threshold)
     real(default), intent(in) :: r_y
     type(vector4_t), intent(in), dimension(:) :: p
     integer, intent(in) :: n_in
     integer, intent(in) :: emitter
     logical, intent(in) :: massive
     real(default), intent(in) :: y_max
     real(default), intent(inout) :: jac_rand
     real(default), intent(out) :: y
     integer, intent(in), dimension(:), allocatable, optional :: contributors
     logical, intent(in), optional :: threshold
     logical :: thr, resonance
     type(vector4_t) :: p_res, p_em
     real(default) :: q0
     type(lorentz_transformation_t) :: boost_to_resonance
     integer :: i
     real(default) :: beta, one_m_beta, one_p_beta
     thr = .false.; if (present (threshold)) thr = threshold
     p_res = vector4_null
     if (present (contributors)) then
        resonance = allocated (contributors)
     else
        resonance = .false.
     end if
     if (massive) then
        if (resonance) then
           do i = 1, size (contributors)
              p_res = p_res + p(contributors(i))
           end do
        else if (thr) then
           p_res = p(ass_boson(thr_leg(emitter))) + p(ass_quark(thr_leg(emitter)))
        else
           p_res = sum (p(1:n_in))
        end if
        q0 = p_res**1
        boost_to_resonance = inverse (boost (p_res, q0))
        p_em = boost_to_resonance * p(emitter)
        beta = beta_emitter (q0, p_em)
        one_m_beta = one - beta
        one_p_beta = one + beta
        y = one / beta * (one - one_p_beta * &
               exp ( - r_y * log(one_p_beta / one_m_beta)))
        jac_rand = jac_rand * &
               (one - beta * y) * log(one_p_beta / one_m_beta) / beta
     else
        y = (one - two * r_y) * y_max
        jac_rand = jac_rand * 3 * (one - y**2)
        y = 1.5_default * (y - y**3 / 3)
     end if
   end subroutine compute_y_from_emitter
 
 @ %def compute_y_from_emitter
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: compute_y_real_phs => phs_fks_generator_compute_y_real_phs
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_compute_y_real_phs (generator, r_y, p, phs_identifiers, &
        jac_rand, y, threshold)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), intent(in) :: r_y
     type(vector4_t), intent(in), dimension(:) :: p
     type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
     real(default), intent(inout), dimension(:) :: jac_rand
     real(default), intent(out), dimension(:) :: y
     logical, intent(in), optional :: threshold
     real(default) :: beta, one_p_beta, one_m_beta
     type(lorentz_transformation_t) :: boost_to_resonance
     real(default) :: q0
     type(vector4_t) :: p_res, p_em
     integer :: i, i_phs, emitter
     logical :: thr
     logical :: construct_massive_fsr
     construct_massive_fsr = .false.
     thr = .false.; if (present (threshold)) thr = threshold
     do i_phs = 1, size (phs_identifiers)
        emitter = phs_identifiers(i_phs)%emitter
        !!! We need this additional check because of decay phase spaces
        !!! t -> bW has a massive emitter at position 1, which should
        !!! not be treated here.
        construct_massive_fsr = emitter > generator%n_in
        if (construct_massive_fsr) construct_massive_fsr = &
             construct_massive_fsr .and. generator%is_massive (emitter)
        call compute_y_from_emitter (r_y, p, generator%n_in, emitter, construct_massive_fsr, &
             generator%y_max, jac_rand(i_phs), y(i_phs), &
             phs_identifiers(i_phs)%contributors, threshold)
     end do
   end subroutine phs_fks_generator_compute_y_real_phs
 
 @ %def phs_fks_generator_compute_y_real_phs
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: compute_y_mismatch => phs_fks_generator_compute_y_mismatch
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_compute_y_mismatch (generator, r_y, jac_rand, y, y_soft)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), intent(in) :: r_y
     real(default), intent(inout) :: jac_rand
     real(default), intent(out) :: y
     real(default), intent(out), dimension(:) :: y_soft
     y = (one - two * r_y) * generator%y_max
     jac_rand = jac_rand * 3 * (one - y**2)
     y = 1.5_default * (y - y**3 / 3)
     y_soft = y
   end subroutine phs_fks_generator_compute_y_mismatch
 
 @ %def phs_fks_generator_compute_y_mismatch
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: compute_y_test => phs_fks_generator_compute_y_test
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_compute_y_test (generator, y)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), intent(out), dimension(:):: y
     select case (generator%mode)
     case (GEN_SOFT_LIMIT_TEST)
        y = y_test_soft
     case (GEN_COLL_LIMIT_TEST)
        y = y_test_coll
     case (GEN_ANTI_COLL_LIMIT_TEST)
        y = - y_test_coll
     case (GEN_SOFT_COLL_LIMIT_TEST)
        y = y_test_coll
     case (GEN_SOFT_ANTI_COLL_LIMIT_TEST)
        y = - y_test_coll
     end select
   end subroutine phs_fks_generator_compute_y_test
 
 @ %def phs_fks_generator_compute_y_test
 @
 <<phs fks: public>>=
   public :: beta_emitter
 <<phs fks: procedures>>=
   pure function beta_emitter (q0, p) result (beta)
     real(default), intent(in) :: q0
     type(vector4_t), intent(in) :: p
     real(default) :: beta
     real(default) :: m2, mrec2, k0_max
     m2 = p**2
     mrec2 = (q0 - p%p(0))**2 - p%p(1)**2 - p%p(2)**2 - p%p(3)**2
     k0_max = (q0**2 - mrec2 + m2) / (two * q0)
     beta = sqrt(one - m2 / k0_max**2)
   end function beta_emitter
 
 @ %def beta_emitter
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: compute_xi_tilde => phs_fks_generator_compute_xi_tilde
 <<phs fks: procedures>>=
   pure subroutine phs_fks_generator_compute_xi_tilde (generator, r)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), intent(in) :: r
     real(default) :: deno
     associate (rad_var => generator%real_kinematics)
        select case (generator%mode)
        case (GEN_REAL_PHASE_SPACE)
           if (generator%singular_jacobian) then
              rad_var%xi_tilde = (one - generator%xi_min) - (one - r)**2 * &
                 (one - two * generator%xi_min)
              rad_var%jac_rand = rad_var%jac_rand * two * (one - r) * &
                 (one - two * generator%xi_min)
           else
              rad_var%xi_tilde = generator%xi_min + r * (one - generator%xi_min)
              rad_var%jac_rand = rad_var%jac_rand * (one - generator%xi_min)
           end if
        case (GEN_SOFT_MISMATCH)
           deno = one - r
           if (deno < tiny_13) deno = tiny_13
           rad_var%xi_mismatch = generator%xi_min + r / deno
           rad_var%jac_mismatch = rad_var%jac_mismatch / deno**2
        case (GEN_SOFT_LIMIT_TEST)
           rad_var%xi_tilde = r * two * xi_tilde_test_soft
           rad_var%jac_rand = two * xi_tilde_test_soft
        case (GEN_COLL_LIMIT_TEST)
           rad_var%xi_tilde = xi_tilde_test_coll
           rad_var%jac_rand = xi_tilde_test_coll
        case (GEN_ANTI_COLL_LIMIT_TEST)
           rad_var%xi_tilde = xi_tilde_test_coll
           rad_var%jac_rand = xi_tilde_test_coll
        case (GEN_SOFT_COLL_LIMIT_TEST)
           rad_var%xi_tilde = r * two * xi_tilde_test_soft
           rad_var%jac_rand = two * xi_tilde_test_soft
        case (GEN_SOFT_ANTI_COLL_LIMIT_TEST)
           rad_var%xi_tilde = r * two * xi_tilde_test_soft
           rad_var%jac_rand = two * xi_tilde_test_soft
        end select
     end associate
   end subroutine phs_fks_generator_compute_xi_tilde
 
 @ %def phs_fks_generator_compute_xi_tilde
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: prepare_generation => phs_fks_generator_prepare_generation
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_prepare_generation (generator, r_in, i_phs, &
      emitter, p_born, phs_identifiers, contributors, i_con)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), dimension(3), intent(in) :: r_in
     integer, intent(in) :: i_phs, emitter
     type(vector4_t), intent(in), dimension(:) :: p_born
     type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
     type(resonance_contributors_t), intent(in), dimension(:), optional :: contributors
     integer, intent(in), optional :: i_con
     call generator%generate_radiation_variables (r_in, p_born, phs_identifiers)
     call generator%compute_xi_ref_momenta (p_born, contributors)
     call generator%compute_xi_max (emitter, i_phs, p_born, &
          generator%real_kinematics%xi_max(i_phs), i_con = i_con)
   end subroutine phs_fks_generator_prepare_generation
 
 @ %def phs_fks_generator_prepare_generation
 @ Get [[xi]] and [[y]] from an external routine (e.g. [[powheg]]) and
 generate an FSR phase space. Note that the flag [[supply\_xi\_max]] is
 set to [[.false.]] because it is assumed that the upper bound on [[xi]]
 has already been taken into account during its generation.
 <<phs fks: phs fks generator: TBP>>=
   procedure :: generate_fsr_from_xi_and_y => &
      phs_fks_generator_generate_fsr_from_xi_and_y
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_generate_fsr_from_xi_and_y (generator, xi, y, &
      phi, emitter, i_phs, p_born, p_real)
     class(phs_fks_generator_t), intent(inout) :: generator
     real(default), intent(in) :: xi, y, phi
     integer, intent(in) :: emitter, i_phs
     type(vector4_t), intent(in), dimension(:) :: p_born
     type(vector4_t), intent(inout), dimension(:) :: p_real
     associate (rad_var => generator%real_kinematics)
        rad_var%supply_xi_max = .false.
        rad_var%xi_tilde = xi
        rad_var%y(i_phs) = y
        rad_var%phi = phi
     end associate
     call generator%set_sqrts_hat (p_born(1)%p(0) + p_born(2)%p(0))
     call generator%generate_fsr (emitter, i_phs, p_born, p_real)
   end subroutine phs_fks_generator_generate_fsr_from_xi_and_y
 
 @ %def phs_fks_generator_generate_fsr_from_xi_and_y
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: get_radiation_variables => &
      phs_fks_generator_get_radiation_variables
 <<phs fks: procedures>>=
   pure subroutine phs_fks_generator_get_radiation_variables (generator, &
      i_phs, xi, y, phi)
     class(phs_fks_generator_t), intent(in) :: generator
     integer, intent(in) :: i_phs
     real(default), intent(out) :: xi, y
     real(default), intent(out), optional :: phi
     associate (rad_var => generator%real_kinematics)
        xi = rad_var%xi_max(i_phs) * rad_var%xi_tilde
        y = rad_var%y(i_phs)
        if (present (phi)) phi = rad_var%phi
     end associate
   end subroutine phs_fks_generator_get_radiation_variables
 
 @ %def phs_fks_generator_get_radiation_variables
 @
 <<phs fks: phs fks generator: TBP>>=
   procedure :: write => phs_fks_generator_write
 <<phs fks: procedures>>=
   subroutine phs_fks_generator_write (generator, unit)
     class(phs_fks_generator_t), intent(in) :: generator
     integer, intent(in), optional :: unit
     integer :: u
     type(string_t) :: massive_phsp
     u = given_output_unit (unit); if (u < 0) return
     if (generator%massive_phsp) then
        massive_phsp = " massive "
     else
        massive_phsp = " massless "
     end if
     write (u, "(A)") char ("This is a generator for a" &
          // massive_phsp // "phase space")
     if (associated (generator%real_kinematics)) then
        call generator%real_kinematics%write ()
     else
        write (u, "(A)") "Warning: There are no real " // &
             "kinematics associated with this generator"
     end if
     call write_separator (u)
     write (u, "(A,F5.3)") "sqrts: ", generator%sqrts
     write (u, "(A,F5.3)") "E_gluon: ", generator%E_gluon
     write (u, "(A,F5.3)") "mrec2: ", generator%mrec2
   end subroutine phs_fks_generator_write
 
 @ %def phs_fks_generator_write
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: compute_isr_kinematics => phs_fks_compute_isr_kinematics
 <<phs fks: procedures>>=
   subroutine phs_fks_compute_isr_kinematics (phs, r)
     class(phs_fks_t), intent(inout) :: phs
     real(default), intent(in) :: r
     if (.not. phs%config%cm_frame) then
        call phs%generator%compute_isr_kinematics (r, phs%lt_cm_to_lab * phs%phs_wood_t%p)
     else
        call phs%generator%compute_isr_kinematics (r, phs%phs_wood_t%p)
     end if
   end subroutine phs_fks_compute_isr_kinematics
 
 @ %def phs_fks_compute_isr_kinematics
 @
 <<phs fks: phs fks: TBP>>=
   procedure :: final => phs_fks_final
 <<phs fks: procedures>>=
   subroutine phs_fks_final (object)
     class(phs_fks_t), intent(inout) :: object
     call phs_forest_final (object%forest)
     call object%generator%final ()
   end subroutine phs_fks_final
 
 @ %def phs_fks_final
 @
 <<phs fks: public>>=
   public :: get_filtered_resonance_histories
 <<phs fks: procedures>>=
   subroutine filter_particles_from_resonances (res_hist, exclusion_list, &
     model, res_hist_filtered)
     type(resonance_history_t), intent(in), dimension(:) :: res_hist
     type(string_t), intent(in), dimension(:) :: exclusion_list
     type(model_t), intent(in) :: model
     type(resonance_history_t), intent(out), dimension(:), allocatable :: res_hist_filtered
     integer :: i_hist, i_flv, i_new, n_orig
     logical, dimension(size (res_hist)) :: to_filter
     type(flavor_t) :: flv
     to_filter = .false.
     n_orig = size (res_hist)
     do i_flv = 1, size (exclusion_list)
        call flv%init (exclusion_list (i_flv), model)
        do i_hist = 1, size (res_hist)
           if (res_hist(i_hist)%has_flavor (flv)) to_filter (i_hist) = .true.
        end do
     end do
     allocate (res_hist_filtered (n_orig - count (to_filter)))
     i_new = 1
     do i_hist = 1, size (res_hist)
        if (.not. to_filter (i_hist)) then
           res_hist_filtered (i_new) = res_hist (i_hist)
           i_new = i_new + 1
        end if
     end do
   end subroutine filter_particles_from_resonances
 
 @ %def filter_particles_from_resonances
 @
 <<phs fks: procedures>>=
   subroutine clean_resonance_histories (res_hist, n_in, flv, res_hist_clean, success)
     type(resonance_history_t), intent(in), dimension(:) :: res_hist
     integer, intent(in) :: n_in
     integer, intent(in), dimension(:) :: flv
     type(resonance_history_t), intent(out), dimension(:), allocatable :: res_hist_clean
     logical, intent(out) :: success
     integer :: i_hist
     type(resonance_history_t), dimension(:), allocatable :: res_hist_colored, res_hist_contracted
 
     call msg_debug (D_SUBTRACTION, "resonance_mapping_init")
     if (debug_active (D_SUBTRACTION)) then
        call msg_debug (D_SUBTRACTION, "Original resonances:")
        do i_hist = 1, size(res_hist)
           call res_hist(i_hist)%write ()
        end do
     end if
 
     call remove_uncolored_resonances ()
     call contract_resonances (res_hist_colored, res_hist_contracted)
     call remove_subresonances (res_hist_contracted, res_hist_clean)
     !!! Here, we are still not sure whether we actually would rather use
     !!! call remove_multiple_resonances (res_hist_contracted, res_hist_clean)
     if (debug_active (D_SUBTRACTION)) then
        call msg_debug (D_SUBTRACTION, "Resonances after removing uncolored and duplicates: ")
        do i_hist = 1, size (res_hist_clean)
           call res_hist_clean(i_hist)%write ()
        end do
     end if
     if (size (res_hist_clean) == 0) then
        call msg_warning ("No resonances found. Proceed in usual FKS mode.")
        success = .false.
     else
        success = .true.
     end if
 
   contains
     subroutine remove_uncolored_resonances ()
       type(resonance_history_t), dimension(:), allocatable :: res_hist_tmp
       integer :: n_hist, nleg_out, n_removed
       integer :: i_res, i_hist
       n_hist = size (res_hist)
       nleg_out = size (flv) - n_in
       allocate (res_hist_tmp (n_hist))
       allocate (res_hist_colored (n_hist))
       do i_hist = 1, n_hist
          res_hist_tmp(i_hist) = res_hist(i_hist)
          call res_hist_tmp(i_hist)%add_offset (n_in)
          n_removed = 0
          do i_res = 1, res_hist_tmp(i_hist)%n_resonances
             associate (resonance => res_hist_tmp(i_hist)%resonances(i_res - n_removed))
                if (.not. any (is_colored (flv (resonance%contributors%c))) &
                   .or. size (resonance%contributors%c) == nleg_out) then
                      call res_hist_tmp(i_hist)%remove_resonance (i_res - n_removed)
                      n_removed = n_removed + 1
                end if
             end associate
          end do
          if (allocated (res_hist_tmp(i_hist)%resonances)) then
             if (any (res_hist_colored == res_hist_tmp(i_hist))) then
                cycle
             else
                do i_res = 1, res_hist_tmp(i_hist)%n_resonances
                   associate (resonance => res_hist_tmp(i_hist)%resonances(i_res))
                      call res_hist_colored(i_hist)%add_resonance (resonance)
                   end associate
                end do
             end if
          end if
       end do
     end subroutine remove_uncolored_resonances
 
     subroutine contract_resonances (res_history_in, res_history_out)
       type(resonance_history_t), intent(in), dimension(:) :: res_history_in
       type(resonance_history_t), intent(out), dimension(:), allocatable :: res_history_out
       logical, dimension(:), allocatable :: i_non_zero
       integer :: n_hist_non_zero, n_hist
       integer :: i_hist_new
       n_hist = size (res_history_in); n_hist_non_zero = 0
       allocate (i_non_zero (n_hist))
       i_non_zero = .false.
       do i_hist = 1, n_hist
          if (res_history_in(i_hist)%n_resonances /= 0) then
             n_hist_non_zero = n_hist_non_zero + 1
             i_non_zero(i_hist) = .true.
          end if
       end do
       allocate (res_history_out (n_hist_non_zero))
       i_hist_new = 1
       do i_hist = 1, n_hist
          if (i_non_zero (i_hist)) then
             res_history_out (i_hist_new) = res_history_in (i_hist)
             i_hist_new = i_hist_new + 1
          end if
       end do
     end subroutine contract_resonances
 
     subroutine remove_subresonances (res_history_in, res_history_out)
       type(resonance_history_t), intent(in), dimension(:) :: res_history_in
       type(resonance_history_t), intent(out), dimension(:), allocatable :: res_history_out
       logical, dimension(:), allocatable :: i_non_sub_res
       integer :: n_hist, n_hist_non_sub_res
       integer :: i_hist1, i_hist2
       logical :: is_not_subres
       n_hist = size (res_history_in); n_hist_non_sub_res = 0
       allocate (i_non_sub_res (n_hist)); i_non_sub_res = .false.
       do i_hist1 = 1, n_hist
          is_not_subres = .true.
          do i_hist2 = 1, n_hist
             if (i_hist1 == i_hist2) cycle
             is_not_subres = is_not_subres .and. &
                .not.(res_history_in(i_hist2) .contains. res_history_in(i_hist1))
          end do
          if (is_not_subres) then
             n_hist_non_sub_res = n_hist_non_sub_res + 1
             i_non_sub_res (i_hist1) = .true.
          end if
       end do
 
       allocate (res_history_out (n_hist_non_sub_res))
       i_hist2 = 1
       do i_hist1 = 1, n_hist
          if (i_non_sub_res (i_hist1)) then
             res_history_out (i_hist2) = res_history_in (i_hist1)
             i_hist2 = i_hist2 + 1
          end if
       end do
     end subroutine remove_subresonances
 
     subroutine remove_multiple_resonances (res_history_in, res_history_out)
       type(resonance_history_t), intent(in), dimension(:) :: res_history_in
       type(resonance_history_t), intent(out), dimension(:), allocatable :: res_history_out
       integer :: n_hist, n_hist_single
       logical, dimension(:), allocatable :: i_hist_single
       integer :: i_hist, j
       n_hist = size (res_history_in)
       n_hist_single = 0
       allocate (i_hist_single (n_hist)); i_hist_single = .false.
       do i_hist = 1, n_hist
          if (res_history_in(i_hist)%n_resonances == 1) then
             n_hist_single = n_hist_single + 1
             i_hist_single(i_hist) = .true.
          end if
       end do
 
       allocate (res_history_out (n_hist_single))
       j = 1
       do i_hist = 1, n_hist
          if (i_hist_single(i_hist)) then
             res_history_out(j) = res_history_in(i_hist)
             j = j + 1
          end if
       end do
     end subroutine remove_multiple_resonances
   end subroutine clean_resonance_histories
 
 @ %def clean_resonance_histories
 @
 <<phs fks: procedures>>=
   subroutine get_filtered_resonance_histories (phs_config, n_in, flv_state, model, &
      excluded_resonances, resonance_histories_filtered, success)
     type(phs_fks_config_t), intent(inout) :: phs_config
     integer, intent(in) :: n_in
     integer, intent(in), dimension(:,:), allocatable :: flv_state
     type(model_t), intent(in) :: model
     type(string_t), intent(in), dimension(:), allocatable :: excluded_resonances
     type(resonance_history_t), intent(out), dimension(:), &
        allocatable :: resonance_histories_filtered
     logical, intent(out) :: success
     type(resonance_history_t), dimension(:), allocatable :: resonance_histories
     type(resonance_history_t), dimension(:), allocatable :: &
        resonance_histories_clean!, resonance_histories_filtered
     allocate (resonance_histories (size (phs_config%get_resonance_histories ())))
     resonance_histories = phs_config%get_resonance_histories ()
     call clean_resonance_histories (resonance_histories, &
          n_in, flv_state (:,1), resonance_histories_clean, success)
     if (success .and. allocated (excluded_resonances)) then
        call filter_particles_from_resonances (resonance_histories_clean, &
             excluded_resonances, model, resonance_histories_filtered)
     else
        allocate (resonance_histories_filtered (size (resonance_histories_clean)))
        resonance_histories_filtered = resonance_histories_clean
     end if
   end subroutine get_filtered_resonance_histories
 
 @ %def get_filtered_resonance_histories
 @
 \clearpage
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \subsection{Unit tests}
 Test module for FKS phase space, followed by the corresponding implementation module.
 <<[[phs_fks_ut.f90]]>>=
 <<File header>>
 
 module phs_fks_ut
   use unit_tests
   use phs_fks_uti
 
 <<Standard module head>>
 
 <<phs fks: public test>>
 
 contains
 
 <<phs fks: test driver>>
 
 end module phs_fks_ut
 @ %def phs_fks_ut
 @
 <<[[phs_fks_uti.f90]]>>=
 <<File header>>
 
 module phs_fks_uti
 
 <<Use kinds>>
   use format_utils, only: write_separator, pac_fmt
   use format_defs, only: FMT_15, FMT_19
   use numeric_utils, only: nearly_equal
   use constants, only: tiny_07, zero, one, two
   use lorentz
 
   use physics_defs, only: THR_POS_B, THR_POS_BBAR, THR_POS_WP, THR_POS_WM, THR_POS_GLUON
   use physics_defs, only: thr_leg
 
   use resonances, only: resonance_contributors_t
   use phs_fks
 
 <<Standard module head>>
 
 <<phs fks: test declarations>>
 
 contains
 
 <<phs fks: tests>>
 
 end module phs_fks_uti
 @ %def phs_fks_uti
 @ API: driver for the unit tests below.
 <<phs fks: public test>>=
   public :: phs_fks_generator_test
 <<phs fks: test driver>>=
   subroutine phs_fks_generator_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
     call test(phs_fks_generator_1, "phs_fks_generator_1", &
          "Test the generation of FKS phase spaces", u, results)
     call test(phs_fks_generator_2, "phs_fks_generator_2", &
          "Test the generation of an ISR FKS phase space", u, results)
     call test(phs_fks_generator_3, "phs_fks_generator_3", &
          "Test the generation of a real phase space for decays", &
          u, results)
     call test(phs_fks_generator_4, "phs_fks_generator_4", &
          "Test the generation of an FSR phase space with "&
          &"conserved invariant resonance masses", u, results)
     call test(phs_fks_generator_5, "phs_fks_generator_5", &
          "Test on-shell projection of a Born phase space and the generation"&
          &" of a real phase-space from that", u, results)
     call test(phs_fks_generator_6, "phs_fks_generator_6", &
          "Test the generation of a real phase space for 1 -> 3 decays", &
          u, results)
     call test(phs_fks_generator_7, "phs_fks_generator_7", &
          "Test the generation of an ISR FKS phase space for fixed beam energy", &
          u, results)
   end subroutine phs_fks_generator_test
 
 @ %def phs_fks_generator_test
 @
 <<phs fks: test declarations>>=
   public :: phs_fks_generator_1
 <<phs fks: tests>>=
   subroutine phs_fks_generator_1 (u)
     integer, intent(in) :: u
     type(phs_fks_generator_t) :: generator
     type(vector4_t), dimension(:), allocatable :: p_born
     type(vector4_t), dimension(:), allocatable :: p_real
     integer :: emitter, i_phs
     real(default) :: x1, x2, x3
     real(default), parameter :: sqrts = 250.0_default
     type(phs_identifier_t), dimension(2) :: phs_identifiers
     write (u, "(A)") "* Test output: phs_fks_generator_1"
     write (u, "(A)") "* Purpose: Create massless fsr phase space"
     write (u, "(A)")
 
     allocate (p_born (4))
     p_born(1)%p(0) = 125.0_default
     p_born(1)%p(1:2) = 0.0_default
     p_born(1)%p(3) = 125.0_default
     p_born(2)%p(0) = 125.0_default
     p_born(2)%p(1:2) = 0.0_default
     p_born(2)%p(3) = -125.0_default
     p_born(3)%p(0) = 125.0_default
     p_born(3)%p(1) = -39.5618_default
     p_born(3)%p(2) = -20.0791_default
     p_born(3)%p(3) = -114.6957_default
     p_born(4)%p(0) = 125.0_default
     p_born(4)%p(1:3) = -p_born(3)%p(1:3)
 
     allocate (generator%isr_kinematics)
     generator%n_in = 2
     generator%isr_kinematics%isr_mode = SQRTS_FIXED
 
     call generator%set_sqrts_hat (sqrts)
 
     write (u, "(A)") "* Use four-particle phase space containing: "
     call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
     write (u, "(A)") "***********************"
     write (u, "(A)")
 
     x1 = 0.5_default; x2 = 0.25_default; x3 = 0.75_default
     write (u, "(A)" ) "* Use random numbers: "
     write (u, "(A,F3.2,1X,A,F3.2,1X,A,F3.2)") &
        "x1: ", x1, "x2: ", x2, "x3: ", x3
 
     allocate (generator%real_kinematics)
     call generator%real_kinematics%init (4, 2, 2, 1)
 
     allocate (generator%emitters (2))
     generator%emitters(1) = 3; generator%emitters(2) = 4
     allocate (generator%m2 (4))
     generator%m2 = zero
     allocate (generator%is_massive (4))
     generator%is_massive(1:2) = .false.
     generator%is_massive(3:4) = .true.
     phs_identifiers(1)%emitter = 3
     phs_identifiers(2)%emitter = 4
     call generator%compute_xi_ref_momenta (p_born)
     call generator%generate_radiation_variables ([x1,x2,x3], p_born, phs_identifiers)
     do i_phs = 1, 2
        emitter = phs_identifiers(i_phs)%emitter
        call generator%compute_xi_max (emitter, i_phs, p_born, &
             generator%real_kinematics%xi_max(i_phs))
     end do
     write (u, "(A)")  &
          "* With these, the following radiation variables have been produced:"
     associate (rad_var => generator%real_kinematics)
       write (u, "(A,F3.2)") "xi_tilde: ", rad_var%xi_tilde
       write (u, "(A,F3.2)") "y: " , rad_var%y(1)
       write (u, "(A,F3.2)") "phi: ", rad_var%phi
     end associate
     call write_separator (u)
     write (u, "(A)") "Produce real momenta: "
     i_phs = 1; emitter = phs_identifiers(i_phs)%emitter
     write (u, "(A,I1)") "emitter: ", emitter
 
     allocate (p_real (5))
     call generator%generate_fsr (emitter, i_phs, p_born, p_real)
     call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
     call write_separator (u)
     write (u, "(A)")
     write (u, "(A)") "* Test output end: phs_fks_generator_1"
 
   end subroutine phs_fks_generator_1
 
 @ %def phs_fks_generator_1
 @
 <<phs fks: test declarations>>=
   public :: phs_fks_generator_2
 <<phs fks: tests>>=
   subroutine phs_fks_generator_2 (u)
     integer, intent(in) :: u
     type(phs_fks_generator_t) :: generator
     type(vector4_t), dimension(:), allocatable :: p_born
     type(vector4_t), dimension(:), allocatable :: p_real
     integer :: emitter, i_phs
     real(default) :: x1, x2, x3
     real(default), parameter :: sqrts_hadronic = 250.0_default
     type(phs_identifier_t), dimension(2) :: phs_identifiers
     write (u, "(A)") "* Test output: phs_fks_generator_2"
     write (u, "(A)") "* Purpose: Create massless ISR phase space"
     write (u, "(A)")
 
 
     allocate (p_born (4))
     p_born(1)%p(0) = 114.661_default
     p_born(1)%p(1:2) = 0.0_default
     p_born(1)%p(3) = 114.661_default
     p_born(2)%p(0) = 121.784_default
     p_born(2)%p(1:2) = 0.0_default
     p_born(2)%p(3) = -121.784_default
     p_born(3)%p(0) = 115.148_default
     p_born(3)%p(1) = -46.250_default
     p_born(3)%p(2) = -37.711_default
     p_born(3)%p(3) = 98.478_default
     p_born(4)%p(0) = 121.296_default
     p_born(4)%p(1:2) = -p_born(3)%p(1:2)
     p_born(4)%p(3) = -105.601_default
 
     phs_identifiers(1)%emitter = 1
     phs_identifiers(2)%emitter = 2
 
     allocate (generator%emitters (2))
     allocate (generator%isr_kinematics)
     generator%emitters(1) = 1; generator%emitters(2) = 2
     generator%sqrts = sqrts_hadronic
     generator%isr_kinematics%beam_energy = sqrts_hadronic / two
     call generator%set_sqrts_hat (sqrts_hadronic)
     call generator%set_isr_kinematics (p_born)
     generator%n_in = 2
     generator%isr_kinematics%isr_mode = SQRTS_VAR
 
     write (u, "(A)") "* Use four-particle phase space containing: "
     call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
     write (u, "(A)") "***********************"
     write (u, "(A)")
 
     x1=0.5_default; x2=0.25_default; x3=0.65_default
     write (u, "(A)" ) "* Use random numbers: "
     write (u, "(A,F3.2,1X,A,F3.2,1X,A,F3.2)") &
        "x1: ", x1, "x2: ", x2, "x3: ", x3
 
     allocate (generator%real_kinematics)
     call generator%real_kinematics%init (4, 2, 2, 1)
     call generator%real_kinematics%p_born_lab%set_momenta (1, p_born)
 
     allocate (generator%m2 (2))
     generator%m2(1) = 0._default; generator%m2(2) = 0._default
     allocate (generator%is_massive (4))
     generator%is_massive = .false.
     call generator%generate_radiation_variables ([x1,x2,x3], p_born, phs_identifiers)
     call generator%compute_xi_ref_momenta (p_born)
     do i_phs = 1, 2
        emitter = phs_identifiers(i_phs)%emitter
        call generator%compute_xi_max (emitter, i_phs, p_born, &
             generator%real_kinematics%xi_max(i_phs))
     end do
     write (u, "(A)")  &
          "* With these, the following radiation variables have been produced:"
     associate (rad_var => generator%real_kinematics)
       write (u, "(A,F3.2)") "xi_tilde: ", rad_var%xi_tilde
       write (u, "(A,F3.2)") "y: " , rad_var%y(1)
       write (u, "(A,F3.2)") "phi: ", rad_var%phi
     end associate
     write (u, "(A)") "Initial-state momentum fractions: "
     associate (xb => generator%isr_kinematics%x)
        write (u, "(A,F3.2)") "x_born_plus: ", xb(1)
        write (u, "(A,F3.2)") "x_born_minus: ", xb(2)
     end associate
     call write_separator (u)
     write (u, "(A)") "Produce real momenta: "
     i_phs = 1; emitter = phs_identifiers(i_phs)%emitter
     write (u, "(A,I1)") "emitter: ", emitter
     allocate (p_real(5))
     call generator%generate_isr (i_phs, p_born, p_real)
     call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
     call write_separator (u)
     write (u, "(A)")
     write (u, "(A)") "* Test output end: phs_fks_generator_2"
 
   end subroutine phs_fks_generator_2
 
 @ %def phs_fks_generator_2
 @
 <<phs fks: test declarations>>=
   public :: phs_fks_generator_3
 <<phs fks: tests>>=
   subroutine phs_fks_generator_3 (u)
     integer, intent(in) :: u
     type(phs_fks_generator_t) :: generator
     type(vector4_t), dimension(:), allocatable :: p_born
     type(vector4_t), dimension(:), allocatable :: p_real
     real(default) :: x1, x2, x3
     real(default) :: mB, mW, mT
     integer :: i, emitter, i_phs
     type(phs_identifier_t), dimension(2) :: phs_identifiers
 
     write (u, "(A)") "* Test output: phs_fks_generator_3"
     write (u, "(A)") "* Puropse: Create real phase space for particle decays"
     write (u, "(A)")
 
     allocate (p_born(3))
     p_born(1)%p(0) = 172._default
     p_born(1)%p(1) = 0._default
     p_born(1)%p(2) = 0._default
     p_born(1)%p(3) = 0._default
     p_born(2)%p(0) = 104.72866679_default
     p_born(2)%p(1) = 45.028053213_default
     p_born(2)%p(2) = 29.450337581_default
     p_born(2)%p(3) = -5.910229156_default
     p_born(3)%p(0) = 67.271333209_default
     p_born(3)%p(1:3) = -p_born(2)%p(1:3)
 
     generator%n_in = 1
     allocate (generator%isr_kinematics)
     generator%isr_kinematics%isr_mode = SQRTS_FIXED
 
     mB = 4.2_default
     mW = 80.376_default
     mT = 172._default
 
     generator%sqrts = mT
 
     write (u, "(A)") "* Use three-particle phase space containing: "
     call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
     write (u, "(A)") "**********************"
     write (u, "(A)")
 
     x1 = 0.5_default; x2 = 0.25_default; x3 = 0.6_default
     write (u, "(A)") "* Use random numbers: "
     write (u, "(A,F3.2,1X,A,F3.2,A,1X,F3.2)") &
        "x1: ", x1, "x2: ", x2, "x3: ", x3
 
     allocate (generator%real_kinematics)
     call generator%real_kinematics%init (3, 2, 2, 1)
     call generator%real_kinematics%p_born_lab%set_momenta (1, p_born)
 
     allocate (generator%emitters(2))
     generator%emitters(1) = 1
     generator%emitters(2) = 3
     allocate (generator%m2 (3), generator%is_massive(3))
     generator%m2(1) = mT**2
     generator%m2(2) = mW**2
     generator%m2(3) = mB**2
     generator%is_massive = .true.
     phs_identifiers(1)%emitter = 1
     phs_identifiers(2)%emitter = 3
 
     call generator%generate_radiation_variables ([x1,x2,x3], p_born, phs_identifiers)
     call generator%compute_xi_ref_momenta (p_born)
     do i_phs = 1, 2
        emitter = phs_identifiers(i_phs)%emitter
        call generator%compute_xi_max (emitter, i_phs, p_born, &
             generator%real_kinematics%xi_max(i_phs))
     end do
 
     write (u, "(A)") &
        "* With these, the following radiation variables have been produced: "
     associate (rad_var => generator%real_kinematics)
       write (u, "(A,F4.2)") "xi_tilde: ", rad_var%xi_tilde
       do i = 1, 2
          write (u, "(A,I1,A,F5.2)") "i: ", i, "y: " , rad_var%y(i)
       end do
       write (u, "(A,F4.2)") "phi: ", rad_var%phi
     end associate
 
     call write_separator (u)
     write (u, "(A)") "Produce real momenta via initial-state emission: "
     i_phs = 1; emitter = phs_identifiers(i_phs)%emitter
     write (u, "(A,I1)") "emitter: ", emitter
     allocate (p_real (4))
     call generator%generate_isr_fixed_beam_energy (i_phs, p_born, p_real)
     call pacify (p_real, 1E-6_default)
     call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
     call write_separator(u)
     write (u, "(A)") "Produce real momenta via final-state emisson: "
     i_phs = 2; emitter = phs_identifiers(i_phs)%emitter
     write (u, "(A,I1)") "emitter: ", emitter
     call generator%generate_fsr (emitter, i_phs, p_born, p_real)
     call pacify (p_real, 1E-6_default)
     call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
     write (u, "(A)")
     write (u, "(A)") "* Test output end: phs_fks_generator_3"
 
   end subroutine phs_fks_generator_3
 
 @ %def phs_fks_generator_3
 @
 <<phs fks: test declarations>>=
   public :: phs_fks_generator_4
 <<phs fks: tests>>=
   subroutine phs_fks_generator_4 (u)
     integer, intent(in) :: u
     type(phs_fks_generator_t) :: generator
     type(vector4_t), dimension(:), allocatable :: p_born
     type(vector4_t), dimension(:), allocatable :: p_real
     integer, dimension(:), allocatable :: emitters
     integer, dimension(:,:), allocatable :: resonance_lists
     type(resonance_contributors_t), dimension(2) :: alr_contributors
     real(default) :: x1, x2, x3
     real(default), parameter :: sqrts = 250.0_default
     integer, parameter :: nlegborn = 6
     integer :: i_phs, i_con, emitter
     real(default) :: m_inv_born, m_inv_real
     character(len=7) :: fmt
     type(phs_identifier_t), dimension(2) :: phs_identifiers
 
     call pac_fmt (fmt, FMT_19, FMT_15, .true.)
 
     write (u, "(A)") "* Test output: phs_fks_generator_4"
     write (u, "(A)") "* Purpose: Create FSR phase space with fixed resonances"
     write (u, "(A)")
 
     allocate (p_born (nlegborn))
     p_born(1)%p(0) = 250._default
     p_born(1)%p(1) = 0._default
     p_born(1)%p(2) = 0._default
     p_born(1)%p(3) = 250._default
     p_born(2)%p(0) = 250._default
     p_born(2)%p(1) = 0._default
     p_born(2)%p(2) = 0._default
     p_born(2)%p(3) = -250._default
     p_born(3)%p(0) = 145.91184486_default
     p_born(3)%p(1) = 50.39727589_default
     p_born(3)%p(2) = 86.74156041_default
     p_born(3)%p(3) = -69.03608748_default
     p_born(4)%p(0) = 208.1064784_default
     p_born(4)%p(1) = -44.07610020_default
     p_born(4)%p(2) = -186.34264578_default
     p_born(4)%p(3) = 13.48038407_default
     p_born(5)%p(0) = 26.25614471_default
     p_born(5)%p(1) = -25.12258068_default
     p_born(5)%p(2) = -1.09540228_default
     p_born(5)%p(3) = -6.27703505_default
     p_born(6)%p(0) = 119.72553196_default
     p_born(6)%p(1) = 18.80140499_default
     p_born(6)%p(2) = 100.69648766_default
     p_born(6)%p(3) = 61.83273846_default
 
     allocate (generator%isr_kinematics)
     generator%n_in = 2
     generator%isr_kinematics%isr_mode = SQRTS_FIXED
 
     call generator%set_sqrts_hat (sqrts)
 
     write (u, "(A)") "* Test process: e+ e- -> W+ W- b b~"
     write (u, "(A)") "* Resonance pairs: (3,5) and (4,6)"
     write (u, "(A)") "* Use four-particle phase space containing: "
     call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
     write (u, "(A)") "******************************"
     write (u, "(A)")
 
     x1 = 0.5_default; x2 = 0.25_default; x3 = 0.75_default
     write (u, "(A)") "* Use random numbers: "
     write (u, "(A,F3.2,1X,A,F3.2,1X,A,F3.2)") &
        "x1: ", x1, "x2: ", x2, "x3: ", x3
 
     allocate (generator%real_kinematics)
     call generator%real_kinematics%init (nlegborn, 2, 2, 2)
 
     allocate (generator%emitters (2))
     generator%emitters(1) = 5; generator%emitters(2) = 6
     allocate (generator%m2 (nlegborn))
     generator%m2 = p_born**2
     allocate (generator%is_massive (nlegborn))
     generator%is_massive (1:2) = .false.
     generator%is_massive (3:6) = .true.
 
     phs_identifiers(1)%emitter = 5
     phs_identifiers(2)%emitter = 6
     do i_phs = 1, 2
        allocate (phs_identifiers(i_phs)%contributors (2))
     end do
     allocate (resonance_lists (2, 2))
     resonance_lists (1,:) = [3,5]
     resonance_lists (2,:) = [4,6]
     !!! Here is obviously some redundance. Surely we can improve on this.
     do i_phs = 1, 2
        phs_identifiers(i_phs)%contributors = resonance_lists(i_phs,:)
     end do
     do i_con = 1, 2
        allocate (alr_contributors(i_con)%c (size (resonance_lists(i_con,:))))
        alr_contributors(i_con)%c = resonance_lists(i_con,:)
     end do
     call generator%generate_radiation_variables &
        ([x1, x2, x3], p_born, phs_identifiers)
 
     allocate (p_real(nlegborn + 1))
     call generator%compute_xi_ref_momenta (p_born, alr_contributors)
     !!! Keep the distinction between i_phs and i_con because in general,
     !!! they are not the same.
     do i_phs = 1, 2
        i_con = i_phs
        emitter = phs_identifiers(i_phs)%emitter
        write (u, "(A,I1,1X,A,I1,A,I1,A)") &
             "* Generate FSR phase space for emitter ", emitter, &
             "and resonance pair (",  resonance_lists (i_con, 1), ",", &
             resonance_lists (i_con, 2), ")"
        call generator%compute_xi_max (emitter, i_phs, p_born, &
             generator%real_kinematics%xi_max(i_phs), i_con = i_con)
        call generator%generate_fsr (emitter, i_phs, i_con, p_born, p_real)
        call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
        call write_separator(u)
        write (u, "(A)") "* Check if resonance masses are conserved: "
        m_inv_born = compute_resonance_mass (p_born, resonance_lists (i_con,:))
        m_inv_real = compute_resonance_mass (p_real, resonance_lists (i_con,:), 7)
        write (u, "(A,1X, " // fmt // ")") "m_inv_born = ", m_inv_born
        write (u, "(A,1X, " // fmt // ")") "m_inv_real = ", m_inv_real
        if (abs (m_inv_born - m_inv_real) < tiny_07) then
           write (u, "(A)") " Success! "
        else
           write (u, "(A)") " Failure! "
        end if
        call write_separator(u)
        call write_separator(u)
     end do
     deallocate (p_real)
     write (u, "(A)")
     write (u, "(A)") "* Test output end: phs_fks_generator_4"
   end subroutine phs_fks_generator_4
 
 @ %def phs_fks_generator_4
 @
 <<phs fks: test declarations>>=
   public :: phs_fks_generator_5
 <<phs fks: tests>>=
   subroutine phs_fks_generator_5 (u)
     use ttv_formfactors, only: init_parameters
     integer, intent(in) :: u
     type(phs_fks_generator_t) :: generator
     type(vector4_t), dimension(:), allocatable :: p_born
     type(vector4_t), dimension(:), allocatable :: p_born_onshell
     type(vector4_t), dimension(:), allocatable :: p_real
     real(default) :: x1, x2, x3
     real(default) :: mB, mW, mtop, mcheck
     integer :: i, emitter, i_phs
     type(phs_identifier_t), dimension(2) :: phs_identifiers
     type(lorentz_transformation_t) :: L_to_cms
     real(default), parameter :: sqrts = 360._default
     real(default), parameter :: momentum_tolerance = 1E-10_default
     real(default) :: mpole, gam_out
 
     write (u, "(A)") "* Test output: phs_fks_generator_5"
     write (u, "(A)") "* Puropse: Perform threshold on-shell projection of "
     write (u, "(A)") "*          Born momenta and create a real phase-space "
     write (u, "(A)") "*          point from those. "
     write (u, "(A)")
 
     allocate (p_born(6), p_born_onshell(6))
     p_born(1)%p(0) = sqrts / two
     p_born(1)%p(1:2) = zero
     p_born(1)%p(3) = sqrts / two
     p_born(2)%p(0) = sqrts / two
     p_born(2)%p(1:2) = zero
     p_born(2)%p(3) = -sqrts / two
     p_born(3)%p(0) = 117.1179139230_default
     p_born(3)%p(1) = 56.91215483880_default
     p_born(3)%p(2) = -40.02386013017_default
     p_born(3)%p(3) = -49.07634310496_default
     p_born(4)%p(0) = 98.91904548743_default
     p_born(4)%p(1) = 56.02241403836_default
     p_born(4)%p(2) = -8.302977504723_default
     p_born(4)%p(3) = -10.50293716131_default
     p_born(5)%p(0) = 62.25884689208_default
     p_born(5)%p(1) = -60.00786540278_default
     p_born(5)%p(2) = 4.753602375910_default
     p_born(5)%p(3) = 15.32916731546_default
     p_born(6)%p(0) = 81.70419369751_default
     p_born(6)%p(1) = -52.92670347439_default
     p_born(6)%p(2) = 43.57323525898_default
     p_born(6)%p(3) = 44.25011295081_default
 
     generator%n_in = 2
     allocate (generator%isr_kinematics)
     generator%isr_kinematics%isr_mode = SQRTS_FIXED
 
     mB = 4.2_default
     mW = 80.376_default
     mtop = 172._default
 
     generator%sqrts = sqrts
 
     !!! Dummy-initialization of the threshold model because generate_fsr_threshold
     !!! uses m1s_to_mpole to determine if it is above or below threshold.
     call init_parameters (mpole, gam_out, mtop, one, one / 1.5_default, 125._default, &
          0.47_default, 0.118_default, 91._default, 80._default, 4.2_default, &
          one, one, one, one, zero, zero, zero, zero, zero, zero, .false., zero)
 
     write (u, "(A)") "* Use four-particle phase space containing: "
     call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
     call vector4_check_momentum_conservation &
          (p_born, 2, unit = u, abs_smallness = momentum_tolerance, verbose = .true.)
     write (u, "(A)") "**********************"
     write (u, "(A)")
 
     allocate (generator%real_kinematics)
     call generator%real_kinematics%init (7, 2, 2, 2)
     call generator%real_kinematics%init_onshell (7, 2)
     generator%real_kinematics%p_born_cms%phs_point(1)%p = p_born
 
     write (u, "(A)") "Get boost projection system -> CMS: "
     L_to_cms = get_boost_for_threshold_projection (p_born, sqrts, mtop)
     call L_to_cms%write (u, testflag = .true., ultra = .true.)
     write (u, "(A)") "**********************"
     write (u, "(A)")
 
     write (u, "(A)") "* Perform onshell-projection:"
     associate (p_born => generator%real_kinematics%p_born_cms%phs_point(1)%p, &
          p_born_onshell => generator%real_kinematics%p_born_onshell%phs_point(1)%p)
        call threshold_projection_born (mtop, L_to_cms, p_born, p_born_onshell)
     end associate
     call generator%real_kinematics%p_born_onshell%write (1, unit = u, testflag = .true., &
          ultra = .true.)
     associate (p => generator%real_kinematics%p_born_onshell%phs_point(1)%p)
        p_born_onshell = p
        call check_phsp (p, 0)
     end associate
 
     allocate (generator%emitters (2))
     generator%emitters(1) = THR_POS_B; generator%emitters(2) = THR_POS_BBAR
 
     allocate (generator%m2 (6), generator%is_massive(6))
     generator%m2 = p_born**2
     generator%is_massive (1:2) = .false.
     generator%is_massive (3:6) = .true.
 
     phs_identifiers(1)%emitter = THR_POS_B
     phs_identifiers(2)%emitter = THR_POS_BBAR
 
     x1 = 0.5_default; x2 = 0.25_default; x3 = 0.6_default
     write (u, "(A)") "* Use random numbers: "
     write (u, "(A,F3.2,1X,A,F3.2,A,1X,F3.2)") &
        "x1: ", x1, "x2: ", x2, "x3: ", x3
 
 
     call generator%generate_radiation_variables ([x1,x2,x3], p_born_onshell, phs_identifiers)
     do i_phs = 1, 2
        emitter = phs_identifiers(i_phs)%emitter
        call generator%compute_xi_ref_momenta_threshold (p_born_onshell)
        call generator%compute_xi_max (emitter, i_phs, p_born_onshell, &
             generator%real_kinematics%xi_max(i_phs), i_con = thr_leg(emitter))
     end do
     write (u, "(A)") &
        "* With these, the following radiation variables have been produced: "
     associate (rad_var => generator%real_kinematics)
       write (u, "(A,F4.2)") "xi_tilde: ", rad_var%xi_tilde
       write (u, "(A)") "xi_max: "
       write (u, "(2F5.2)") rad_var%xi_max(1), rad_var%xi_max(2)
       write (u, "(A)") "y: "
       write (u, "(2F5.2)") rad_var%y(1), rad_var%y(2)
       write (u, "(A,F4.2)") "phi: ", rad_var%phi
     end associate
 
     call write_separator (u)
     write (u, "(A)") "* Produce real momenta from on-shell phase space: "
     allocate (p_real(7))
     do i_phs = 1, 2
        emitter = phs_identifiers(i_phs)%emitter
        write (u, "(A,I1)") "emitter: ", emitter
        call generator%generate_fsr_threshold (emitter, i_phs, p_born_onshell, p_real)
        call check_phsp (p_real, emitter)
     end do
 
     call write_separator(u)
     write (u, "(A)")
     write (u, "(A)") "* Test output end: phs_fks_generator_5"
 
   contains
     subroutine check_phsp (p, emitter)
        type(vector4_t), intent(inout), dimension(:) :: p
        integer, intent(in) :: emitter
        type(vector4_t) :: pp
        real(default) :: E_tot
        logical :: check
        write (u, "(A)") "* Check momentum conservation: "
        call vector4_check_momentum_conservation &
             (p, 2, unit = u, abs_smallness = momentum_tolerance, verbose = .true.)
        write (u, "(A)") "* Check invariant masses: "
        write (u, "(A)", advance = "no") "inv(W+, b, gl): "
        pp = p(THR_POS_WP) + p(THR_POS_B)
        if (emitter == THR_POS_B) pp = pp + p(THR_POS_GLUON)
        if (nearly_equal (pp**1, mtop)) then
           write (u, "(A)") "CHECK"
        else
           write (u, "(A,F7.3)") "FAIL: ", pp**1
        end if
        write (u, "(A)", advance = "no") "inv(W-, bbar): "
        pp = p(THR_POS_WM) + p(THR_POS_BBAR)
        if (emitter == THR_POS_BBAR) pp = pp + p(THR_POS_GLUON)
        if (nearly_equal (pp**1, mtop)) then
           write (u, "(A)") "CHECK"
        else
           write (u, "(A,F7.3)") "FAIL: ", pp**1
        end if
        write (u, "(A)") "* Sum of energies equal to sqrts?"
        E_tot = sum(p(1:2)%p(0)); check = nearly_equal (E_tot, sqrts)
        write (u, "(A,L1)") "Initial state: ", check
        if (.not. check) write (u, "(A,F7.3)") "E_tot: ", E_tot
        if (emitter > 0) then
           E_tot = sum(p(3:7)%p(0))
        else
           E_tot = sum(p(3:6)%p(0))
        end if
        check = nearly_equal (E_tot, sqrts)
        write (u, "(A,L1)") "Final state  : ", check
        if (.not. check) write (u, "(A,F7.3)") "E_tot: ", E_tot
        call pacify (p, 1E-6_default)
        call vector4_write_set (p, u, testflag = .true., ultra = .true.)
 
     end subroutine check_phsp
   end subroutine phs_fks_generator_5
 
 @ %def phs_fks_generator_5
 @
 
 <<phs fks: test declarations>>=
   public :: phs_fks_generator_6
 <<phs fks: tests>>=
   subroutine phs_fks_generator_6 (u)
     integer, intent(in) :: u
     type(phs_fks_generator_t) :: generator
     type(vector4_t), dimension(:), allocatable :: p_born
     type(vector4_t), dimension(:), allocatable :: p_real
     real(default) :: x1, x2, x3
     real(default) :: mB, mW, mT
     integer :: i, emitter, i_phs
     type(phs_identifier_t), dimension(2) :: phs_identifiers
 
     write (u, "(A)") "* Test output: phs_fks_generator_6"
     write (u, "(A)") "* Puropse: Create real phase space for particle decays"
     write (u, "(A)")
 
     allocate (p_born(4))
     p_born(1)%p(0) = 173.1_default
     p_born(1)%p(1) = zero
     p_born(1)%p(2) = zero
     p_born(1)%p(3) = zero
     p_born(2)%p(0) = 68.17074462929_default
     p_born(2)%p(1) = -37.32578717617_default
     p_born(2)%p(2) = 30.99675959336_default
     p_born(2)%p(3) = -47.70321718398_default
     p_born(3)%p(0) = 65.26639312326_default
     p_born(3)%p(1) = -1.362927648502_default
     p_born(3)%p(2) = -33.25327150840_default
     p_born(3)%p(3) = 56.14324922494_default
     p_born(4)%p(0) = 39.66286224745_default
     p_born(4)%p(1) = 38.68871482467_default
     p_born(4)%p(2) = 2.256511915049_default
     p_born(4)%p(3) = -8.440032040958_default
 
     generator%n_in = 1
     allocate (generator%isr_kinematics)
     generator%isr_kinematics%isr_mode = SQRTS_FIXED
 
     mB = 4.2_default
     mW = 80.376_default
     mT = 173.1_default
 
     generator%sqrts = mT
 
     write (u, "(A)") "* Use four-particle phase space containing: "
     call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
     write (u, "(A)") "**********************"
     write (u, "(A)")
 
     x1=0.5_default; x2=0.25_default; x3=0.6_default
     write (u, "(A)") "* Use random numbers: "
     write (u, "(A,F3.2,1X,A,F3.2,A,1X,F3.2)") &
        "x1: ", x1, "x2: ", x2, "x3: ", x3
 
     allocate (generator%real_kinematics)
     call generator%real_kinematics%init (3, 2, 2, 1)
     call generator%real_kinematics%p_born_lab%set_momenta (1, p_born)
 
     allocate (generator%emitters(2))
     generator%emitters(1) = 1
     generator%emitters(2) = 2
     allocate (generator%m2 (4), generator%is_massive(4))
     generator%m2(1) = mT**2
     generator%m2(2) = mB**2
     generator%m2(3) = zero
     generator%m2(4) = zero
     generator%is_massive(1:2) = .true.
     generator%is_massive(3:4) = .false.
     phs_identifiers(1)%emitter = 1
     phs_identifiers(2)%emitter = 2
 
     call generator%generate_radiation_variables ([x1,x2,x3], p_born, phs_identifiers)
     call generator%compute_xi_ref_momenta (p_born)
     do i_phs = 1, 2
        emitter = phs_identifiers(i_phs)%emitter
        call generator%compute_xi_max (emitter, i_phs, p_born, &
             generator%real_kinematics%xi_max(i_phs))
     end do
 
     write (u, "(A)") &
        "* With these, the following radiation variables have been produced: "
     associate (rad_var => generator%real_kinematics)
       write (u, "(A,F4.2)") "xi_tilde: ", rad_var%xi_tilde
       do i = 1, 2
          write (u, "(A,I1,A,F5.2)") "i: ", i, "y: " , rad_var%y(i)
       end do
       write (u, "(A,F4.2)") "phi: ", rad_var%phi
     end associate
 
     call write_separator (u)
     write (u, "(A)") "Produce real momenta via initial-state emission: "
     i_phs = 1; emitter = phs_identifiers(i_phs)%emitter
     write (u, "(A,I1)") "emitter: ", emitter
     allocate (p_real(5))
     call generator%generate_isr_fixed_beam_energy (i_phs, p_born, p_real)
     call pacify (p_real, 1E-6_default)
     call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
     call write_separator(u)
     write (u, "(A)") "Produce real momenta via final-state emisson: "
     i_phs = 2; emitter = phs_identifiers(i_phs)%emitter
     write (u, "(A,I1)") "emitter: ", emitter
     call generator%generate_fsr (emitter, i_phs, p_born, p_real)
     call pacify (p_real, 1E-6_default)
     call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
     write (u, "(A)")
     write (u, "(A)") "* Test output end: phs_fks_generator_6"
 
   end subroutine phs_fks_generator_6
 
 @ %def phs_fks_generator_6
 @
 <<phs fks: test declarations>>=
   public :: phs_fks_generator_7
 <<phs fks: tests>>=
   subroutine phs_fks_generator_7 (u)
     integer, intent(in) :: u
     type(phs_fks_generator_t) :: generator
     type(vector4_t), dimension(:), allocatable :: p_born
     type(vector4_t), dimension(:), allocatable :: p_real
     real(default) :: x1, x2, x3
     integer :: i, emitter, i_phs
     type(phs_identifier_t), dimension(2) :: phs_identifiers
     real(default), parameter :: sqrts = 1000.0_default
 
     write (u, "(A)") "* Test output: phs_fks_generator_7"
     write (u, "(A)") "* Puropse: Create real phase space for scattering ISR"
     write (u, "(A)") "*          keeping the beam energy fixed."
     write (u, "(A)")
 
     allocate (p_born(4))
     p_born(1)%p(0) = 500._default
     p_born(1)%p(1) = 0._default
     p_born(1)%p(2) = 0._default
     p_born(1)%p(3) = 500._default
     p_born(2)%p(0) = 500._default
     p_born(2)%p(1) = 0._default
     p_born(2)%p(2) = 0._default
     p_born(2)%p(3) = -500._default
     p_born(3)%p(0) = 500._default
     p_born(3)%p(1) = 11.275563070_default
     p_born(3)%p(2) = -13.588797663_default
     p_born(3)%p(3) = 486.93070588_default
     p_born(4)%p(0) = 500._default
     p_born(4)%p(1:3) = -p_born(3)%p(1:3)
 
     phs_identifiers(1)%emitter = 1
     phs_identifiers(2)%emitter = 2
 
     allocate (generator%emitters(2))
     generator%n_in = 2
     allocate (generator%isr_kinematics)
     generator%isr_kinematics%isr_mode = SQRTS_FIXED
     generator%emitters(1) = 1; generator%emitters(2) = 2
     generator%sqrts = sqrts
 
     write (u, "(A)") "* Use 2 -> 2 phase space containing: "
     call vector4_write_set (p_born, u, testflag = .true., ultra = .true.)
     write (u, "(A)") "**********************"
     write (u, "(A)")
 
     x1 = 0.5_default; x2 = 0.25_default; x3 = 0.6_default
     write (u, "(A)") "* Use random numbers: "
     write (u, "(A,F3.2,1X,A,F3.2,A,1X,F3.2)") &
        "x1: ", x1, "x2: ", x2, "x3: ", x3
 
     allocate (generator%real_kinematics)
     call generator%real_kinematics%init (4, 2, 2, 1)
     call generator%real_kinematics%p_born_lab%set_momenta (1, p_born)
 
     allocate (generator%m2 (4))
     generator%m2 = 0._default
     allocate (generator%is_massive(4))
     generator%is_massive = .false.
     call generator%generate_radiation_variables ([x1,x2,x3], p_born, phs_identifiers)
     call generator%compute_xi_ref_momenta (p_born)
     do i_phs = 1, 2
        emitter = phs_identifiers(i_phs)%emitter
        call generator%compute_xi_max (emitter, i_phs, p_born, &
             generator%real_kinematics%xi_max(i_phs))
     end do
 
     write (u, "(A)") &
        "* With these, the following radiation variables have been produced: "
     associate (rad_var => generator%real_kinematics)
        write (u, "(A,F4.2)") "xi_tilde: ", rad_var%xi_tilde
        do i = 1, 2
           write (u, "(A,I1,A,F5.2)") "i: ", i, "y: " , rad_var%y(i)
        end do
        write (u, "(A,F4.2)") "phi: ", rad_var%phi
     end associate
 
     call write_separator (u)
     write (u, "(A)") "Produce real momenta via initial-state emission: "
     i_phs = 1; emitter = phs_identifiers(i_phs)%emitter
     write (u, "(A,I1)") "emitter: ", emitter
     allocate (p_real(5))
     call generator%generate_isr_fixed_beam_energy (i_phs, p_born, p_real)
     call pacify (p_real, 1E-6_default)
     call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
     call write_separator(u)
     i_phs = 2; emitter = phs_identifiers(i_phs)%emitter
     write (u, "(A,I1)") "emitter: ", emitter
     call generator%generate_isr_fixed_beam_energy (i_phs, p_born, p_real)
     call pacify (p_real, 1E-6_default)
     call vector4_write_set (p_real, u, testflag = .true., ultra = .true.)
     write (u, "(A)")
     write (u, "(A)") "* Test output end: phs_fks_generator_7"
 
   end subroutine phs_fks_generator_7
 
 @ %def phs_fks_generator_3
 @
 \section{Dispatch}
 <<[[dispatch_phase_space.f90]]>>=
 <<File header>>
 
 module dispatch_phase_space
 
 <<Use kinds>>
 <<Use strings>>
   use io_units, only: free_unit
   use variables, only: var_list_t
   use os_interface, only: os_data_t
   use diagnostics
 
   use sf_mappings, only: sf_channel_t
   use beam_structures, only: beam_structure_t
   use dispatch_beams, only: sf_prop_t, strfun_mode
 
   use mappings
   use phs_forests, only: phs_parameters_t
   use phs_base
   use phs_none
   use phs_single
+  use phs_rambo
   use phs_wood
   use phs_fks
 
 <<Standard module head>>
 
 <<Dispatch phs: public>>
 
 contains
 
 <<Dispatch phs: procedures>>
 
 end module dispatch_phase_space
 @ %def dispatch_phase_space
 Allocate a phase-space object according to the variable [[$phs_method]].
 <<Dispatch phs: public>>=
   public :: dispatch_phs
 <<Dispatch phs: procedures>>=
   subroutine dispatch_phs (phs, var_list, os_data, process_id, &
          mapping_defaults, phs_par, phs_method_in)
     class(phs_config_t), allocatable, intent(inout) :: phs
     type(var_list_t), intent(in) :: var_list
     type(os_data_t), intent(in) :: os_data
     type(string_t), intent(in) :: process_id
     type(mapping_defaults_t), intent(in), optional :: mapping_defaults
     type(phs_parameters_t), intent(in), optional :: phs_par
     type(string_t), intent(in), optional :: phs_method_in
     type(string_t) :: phs_method, phs_file, run_id
     logical :: use_equivalences, vis_channels, fatal_beam_decay
     integer :: u_phs
     logical :: exist
     if (present (phs_method_in)) then
        phs_method = phs_method_in
     else
        phs_method = &
             var_list%get_sval (var_str ("$phs_method"))
     end if
     phs_file = &
          var_list%get_sval (var_str ("$phs_file"))
     use_equivalences = &
          var_list%get_lval (var_str ("?use_vamp_equivalences"))
     vis_channels = &
          var_list%get_lval (var_str ("?vis_channels"))
     fatal_beam_decay = &
          var_list%get_lval (var_str ("?fatal_beam_decay"))
     run_id = &
          var_list%get_sval (var_str ("$run_id"))
     select case (char (phs_method))
     case ("none")
        allocate (phs_none_config_t :: phs)
     case ("single")
        allocate (phs_single_config_t :: phs)
        if (vis_channels) then
           call msg_warning ("Visualizing phase space channels not " // &
                "available for method 'single'.")
        end if
+    case ("rambo")
+       allocate (phs_rambo_config_t :: phs)
+       if (vis_channels) &
+          call msg_warning ("Visualizing phase space channels not " // &
+              "available for method 'rambo'.")
     case ("fks")
       allocate (phs_fks_config_t :: phs)
     case ("wood", "default", "fast_wood")
        call dispatch_wood ()
     case default
        call msg_fatal ("Phase space: parameterization method '" &
             // char (phs_method) // "' not implemented")
     end select
   contains
   <<Dispatch phs: dispatch phs: procedures>>
   end subroutine dispatch_phs
 
 @ %def dispatch_phs
 @
 <<Dispatch phs: dispatch phs: procedures>>=
   subroutine dispatch_wood ()
     allocate (phs_wood_config_t :: phs)
     select type (phs)
     type is (phs_wood_config_t)
        if (phs_file /= "") then
           inquire (file = char (phs_file), exist = exist)
           if (exist) then
              call msg_message ("Phase space: reading configuration from '" &
                   // char (phs_file) // "'")
              u_phs = free_unit ()
              open (u_phs, file = char (phs_file), &
                   action = "read", status = "old")
              call phs%set_input (u_phs)
           else
              call msg_fatal ("Phase space: configuration file '" &
                   // char (phs_file) // "' not found")
           end if
        end if
        if (present (phs_par)) &
             call phs%set_parameters (phs_par)
        if (use_equivalences) &
             call phs%enable_equivalences ()
        if (present (mapping_defaults)) &
             call phs%set_mapping_defaults (mapping_defaults)
        if (phs_method == "fast_wood") phs%use_cascades2 = .true.
        phs%vis_channels = vis_channels
        phs%fatal_beam_decay = fatal_beam_decay
        phs%os_data = os_data
        phs%run_id = run_id
     end select
   end subroutine dispatch_wood
 
 @
 @ Configure channel mappings, using some conditions
 from the phase space configuration.  If there are no structure
 functions, we enable a default setup with a single (dummy)
 structure-function channel.  Otherwise, we look at the channel
 collection that we got from the phase-space configuration step.  Each
 entry should be translated into an independent structure-function
 channel, where typically there is one default entry, which could be
 mapped using a standard s-channel mapping if the structure function
 setup recommends this, and other entries with s-channel resonances.
 The latter need to be translated into global mappings from the
 structure-function chain.
 <<Dispatch phs: public>>=
   public :: dispatch_sf_channels
 <<Dispatch phs: procedures>>=
   subroutine dispatch_sf_channels (sf_channel, sf_string, sf_prop, coll, &
          var_list, sqrts, beam_structure)
     type(sf_channel_t), dimension(:), allocatable, intent(out) :: sf_channel
     type(string_t), intent(out) :: sf_string
     type(sf_prop_t), intent(in) :: sf_prop
     type(phs_channel_collection_t), intent(in) :: coll
     type(var_list_t), intent(in) :: var_list
     real(default), intent(in) :: sqrts
     type(beam_structure_t), intent(in) :: beam_structure
     type(beam_structure_t) :: beam_structure_tmp
     class(channel_prop_t), allocatable :: prop
     integer :: n_strfun, n_sf_channel, i
     logical :: sf_allow_s_mapping, circe1_map, circe1_generate
     logical :: s_mapping_enable, endpoint_mapping, power_mapping
     logical :: single_parameter
     integer, dimension(:), allocatable :: s_mapping, single_mapping
     real(default) :: s_mapping_power
     real(default) :: circe1_mapping_slope, endpoint_mapping_slope
     real(default) :: power_mapping_eps
     beam_structure_tmp = beam_structure
     call beam_structure_tmp%write ()
     call beam_structure_tmp%expand (strfun_mode)
     n_strfun = beam_structure_tmp%get_n_record ()
     sf_string = beam_structure_tmp%to_string (sf_only = .true.)
     sf_allow_s_mapping = &
          var_list%get_lval (var_str ("?sf_allow_s_mapping"))
     circe1_generate = &
          var_list%get_lval (var_str ("?circe1_generate"))
     circe1_map = &
          var_list%get_lval (var_str ("?circe1_map"))
     circe1_mapping_slope = &
          var_list%get_rval (var_str ("circe1_mapping_slope"))
     s_mapping_enable = .false.
     s_mapping_power = 1
     endpoint_mapping = .false.
     endpoint_mapping_slope = 1
     power_mapping = .false.
     single_parameter = .false.
     select case (char (sf_string))
     case ("", "[any particles]")
     case ("pdf_builtin, none", &
          "pdf_builtin_photon, none", &
          "none, pdf_builtin", &
          "none, pdf_builtin_photon", &
          "lhapdf, none", &
          "lhapdf_photon, none", &
          "none, lhapdf", &
          "none, lhapdf_photon")
          single_parameter = .true.
     case ("pdf_builtin, none => none, pdf_builtin", &
           "pdf_builtin, none => none, pdf_builtin_photon", &
           "pdf_builtin_photon, none => none, pdf_builtin", &
           "pdf_builtin_photon, none => none, pdf_builtin_photon", &
           "lhapdf, none => none, lhapdf", &
           "lhapdf, none => none, lhapdf_photon", &
           "lhapdf_photon, none => none, lhapdf", &
           "lhapdf_photon, none => none, lhapdf_photon")
        allocate (s_mapping (2), source = [1, 2])
        s_mapping_enable = .true.
        s_mapping_power = 2
     case ("pdf_builtin, none => none, pdf_builtin => epa, none => none, epa", &
           "pdf_builtin, none => none, pdf_builtin => ewa, none => none, ewa", &
           "pdf_builtin, none => none, pdf_builtin => ewa, none => none, epa", &
           "pdf_builtin, none => none, pdf_builtin => epa, none => none, ewa")
        allocate (s_mapping (2), source = [1, 2])
        s_mapping_enable = .true.
        s_mapping_power = 2
     case ("isr, none", &
          "none, isr")
        allocate (single_mapping (1), source = [1])
        single_parameter = .true.
     case ("isr, none => none, isr")
        allocate (s_mapping (2), source = [1, 2])
        power_mapping = .true.
        power_mapping_eps = minval (sf_prop%isr_eps)
     case ("isr, none => none, isr => epa, none => none, epa", &
           "isr, none => none, isr => ewa, none => none, ewa", &
           "isr, none => none, isr => ewa, none => none, epa", &
           "isr, none => none, isr => epa, none => none, ewa")
        allocate (s_mapping (2), source = [1, 2])
        power_mapping = .true.
        power_mapping_eps = minval (sf_prop%isr_eps)
     case ("circe1 => isr, none => none, isr => epa, none => none, epa", &
           "circe1 => isr, none => none, isr => ewa, none => none, ewa", &
           "circe1 => isr, none => none, isr => ewa, none => none, epa", &
           "circe1 => isr, none => none, isr => epa, none => none, ewa")
        if (circe1_generate) then
           allocate (s_mapping (2), source = [2, 3])
        else
           allocate (s_mapping (3), source = [1, 2, 3])
           endpoint_mapping = .true.
           endpoint_mapping_slope = circe1_mapping_slope
        end if
        power_mapping = .true.
        power_mapping_eps = minval (sf_prop%isr_eps)
     case ("pdf_builtin, none => none, isr", &
          "pdf_builtin_photon, none => none, isr", &
          "lhapdf, none => none, isr", &
          "lhapdf_photon, none => none, isr")
        allocate (single_mapping (1), source = [2])
     case ("isr, none => none, pdf_builtin", &
          "isr, none => none, pdf_builtin_photon", &
          "isr, none => none, lhapdf", &
          "isr, none => none, lhapdf_photon")
        allocate (single_mapping (1), source = [1])
     case ("epa, none", &
           "none, epa")
        allocate (single_mapping (1), source = [1])
        single_parameter = .true.
     case ("epa, none => none, epa")
        allocate (single_mapping (2), source = [1, 2])
     case ("epa, none => none, isr", &
          "isr, none => none, epa", &
          "ewa, none => none, isr", &
          "isr, none => none, ewa")
        allocate (single_mapping (2), source = [1, 2])
     case ("pdf_builtin, none => none, epa", &
          "pdf_builtin_photon, none => none, epa", &
          "lhapdf, none => none, epa", &
          "lhapdf_photon, none => none, epa")
        allocate (single_mapping (1), source = [2])
     case ("pdf_builtin, none => none, ewa", &
          "pdf_builtin_photon, none => none, ewa", &
          "lhapdf, none => none, ewa", &
          "lhapdf_photon, none => none, ewa")
        allocate (single_mapping (1), source = [2])
     case ("epa, none => none, pdf_builtin", &
          "epa, none => none, pdf_builtin_photon", &
          "epa, none => none, lhapdf", &
          "epa, none => none, lhapdf_photon")
        allocate (single_mapping (1), source = [1])
     case ("ewa, none => none, pdf_builtin", &
          "ewa, none => none, pdf_builtin_photon", &
          "ewa, none => none, lhapdf", &
          "ewa, none => none, lhapdf_photon")
        allocate (single_mapping (1), source = [1])
     case ("ewa, none", &
           "none, ewa")
        allocate (single_mapping (1), source = [1])
        single_parameter = .true.
     case ("ewa, none => none, ewa")
        allocate (single_mapping (2), source = [1, 2])
     case ("energy_scan, none => none, energy_scan")
        allocate (s_mapping (2), source = [1, 2])
     case ("sf_test_1, none => none, sf_test_1")
        allocate (s_mapping (2), source = [1, 2])
     case ("circe1")
        if (circe1_generate) then
           !!! no mapping
        else if (circe1_map) then
           allocate (s_mapping (1), source = [1])
           endpoint_mapping = .true.
           endpoint_mapping_slope = circe1_mapping_slope
        else
           allocate (s_mapping (1), source = [1])
           s_mapping_enable = .true.
        end if
     case ("circe1 => isr, none => none, isr")
        if (circe1_generate) then
           allocate (s_mapping (2), source = [2, 3])
        else
           allocate (s_mapping (3), source = [1, 2, 3])
           endpoint_mapping = .true.
           endpoint_mapping_slope = circe1_mapping_slope
        end if
        power_mapping = .true.
        power_mapping_eps = minval (sf_prop%isr_eps)
     case ("circe1 => isr, none", &
          "circe1 => none, isr")
        allocate (single_mapping (1), source = [2])
     case ("circe1 => epa, none => none, epa")
        if (circe1_generate) then
           allocate (single_mapping (2), source = [2, 3])
        else
           call msg_fatal ("CIRCE/EPA: supported with ?circe1_generate=true &
                &only")
        end if
     case ("circe1 => ewa, none => none, ewa")
        if (circe1_generate) then
           allocate (single_mapping (2), source = [2, 3])
        else
           call msg_fatal ("CIRCE/EWA: supported with ?circe1_generate=true &
                &only")
        end if
     case ("circe1 => epa, none", &
          "circe1 => none, epa")
        if (circe1_generate) then
           allocate (single_mapping (1), source = [2])
        else
           call msg_fatal ("CIRCE/EPA: supported with ?circe1_generate=true &
                &only")
        end if
     case ("circe1 => epa, none => none, isr", &
          "circe1 => isr, none => none, epa", &
          "circe1 => ewa, none => none, isr", &
          "circe1 => isr, none => none, ewa")
        if (circe1_generate) then
           allocate (single_mapping (2), source = [2, 3])
        else
           call msg_fatal ("CIRCE/EPA: supported with ?circe1_generate=true &
                &only")
        end if
     case ("circe2", &
          "gaussian", &
          "beam_events")
        !!! no mapping
     case ("circe2 => isr, none => none, isr", &
        "gaussian => isr, none => none, isr", &
        "beam_events => isr, none => none, isr")
        allocate (s_mapping (2), source = [2, 3])
        power_mapping = .true.
        power_mapping_eps = minval (sf_prop%isr_eps)
     case ("circe2 => isr, none", &
          "circe2 => none, isr", &
          "gaussian => isr, none", &
          "gaussian => none, isr", &
          "beam_events => isr, none", &
          "beam_events => none, isr")
        allocate (single_mapping (1), source = [2])
     case ("circe2 => epa, none => none, epa", &
          "gaussian => epa, none => none, epa", &
          "beam_events => epa, none => none, epa")
        allocate (single_mapping (2), source = [2, 3])
     case ("circe2 => epa, none", &
          "circe2 => none, epa", &
          "circe2 => ewa, none", &
          "circe2 => none, ewa", &
          "gaussian => epa, none", &
          "gaussian => none, epa", &
          "gaussian => ewa, none", &
          "gaussian => none, ewa", &
          "beam_events => epa, none", &
          "beam_events => none, epa", &
          "beam_events => ewa, none", &
          "beam_events => none, ewa")
        allocate (single_mapping (1), source = [2])
     case ("circe2 => epa, none => none, isr", &
          "circe2 => isr, none => none, epa", &
          "circe2 => ewa, none => none, isr", &
          "circe2 => isr, none => none, ewa", &
          "gaussian => epa, none => none, isr", &
          "gaussian => isr, none => none, epa", &
          "gaussian => ewa, none => none, isr", &
          "gaussian => isr, none => none, ewa", &
          "beam_events => epa, none => none, isr", &
          "beam_events => isr, none => none, epa", &
          "beam_events => ewa, none => none, isr", &
          "beam_events => isr, none => none, ewa")
        allocate (single_mapping (2), source = [2, 3])
     case ("energy_scan")
     case default
        call msg_fatal ("Beam structure: " &
             // char (sf_string) // " not supported")
     end select
     if (sf_allow_s_mapping .and. coll%n > 0) then
        n_sf_channel = coll%n
        allocate (sf_channel (n_sf_channel))
        do i = 1, n_sf_channel
           call sf_channel(i)%init (n_strfun)
           if (allocated (single_mapping)) then
              call sf_channel(i)%activate_mapping (single_mapping)
           end if
           if (allocated (prop))  deallocate (prop)
           call coll%get_entry (i, prop)
           if (allocated (prop)) then
              if (endpoint_mapping .and. power_mapping) then
                 select type (prop)
                 type is (resonance_t)
                    call sf_channel(i)%set_eir_mapping (s_mapping, &
                         a = endpoint_mapping_slope, eps = power_mapping_eps, &
                         m = prop%mass / sqrts, w = prop%width / sqrts)
                 type is (on_shell_t)
                    call sf_channel(i)%set_eio_mapping (s_mapping, &
                         a = endpoint_mapping_slope, eps = power_mapping_eps, &
                         m = prop%mass / sqrts)
                 end select
              else if (endpoint_mapping) then
                 select type (prop)
                 type is (resonance_t)
                    call sf_channel(i)%set_epr_mapping (s_mapping, &
                         a = endpoint_mapping_slope, &
                         m = prop%mass / sqrts, w = prop%width / sqrts)
                 type is (on_shell_t)
                    call sf_channel(i)%set_epo_mapping (s_mapping, &
                         a = endpoint_mapping_slope, &
                         m = prop%mass / sqrts)
                 end select
              else if (power_mapping) then
                 select type (prop)
                 type is (resonance_t)
                    call sf_channel(i)%set_ipr_mapping (s_mapping, &
                         eps = power_mapping_eps, &
                         m = prop%mass / sqrts, w = prop%width / sqrts)
                 type is (on_shell_t)
                    call sf_channel(i)%set_ipo_mapping (s_mapping, &
                         eps = power_mapping_eps, &
                         m = prop%mass / sqrts)
                 end select
              else if (allocated (s_mapping)) then
                 select type (prop)
                 type is (resonance_t)
                    call sf_channel(i)%set_res_mapping (s_mapping, &
                         m = prop%mass / sqrts, w = prop%width / sqrts, &
                         single = single_parameter)
                 type is (on_shell_t)
                    call sf_channel(i)%set_os_mapping (s_mapping, &
                         m = prop%mass / sqrts, &
                         single = single_parameter)
                 end select
              else if (allocated (single_mapping)) then
                 select type (prop)
                 type is (resonance_t)
                    call sf_channel(i)%set_res_mapping (single_mapping, &
                            m = prop%mass / sqrts, w = prop%width / sqrts, &
                            single = single_parameter)
                 type is (on_shell_t)
                    call sf_channel(i)%set_os_mapping (single_mapping, &
                         m = prop%mass / sqrts, &
                         single = single_parameter)
                 end select
              end if
           else if (endpoint_mapping .and. power_mapping) then
              call sf_channel(i)%set_ei_mapping (s_mapping, &
                   a = endpoint_mapping_slope, eps = power_mapping_eps)
           else if (endpoint_mapping .and. .not. allocated (single_mapping)) then
              call sf_channel(i)%set_ep_mapping (s_mapping, &
                   a = endpoint_mapping_slope)
           else if (power_mapping .and. .not. allocated (single_mapping)) then
              call sf_channel(i)%set_ip_mapping (s_mapping, &
                   eps = power_mapping_eps)
           else if (s_mapping_enable .and. .not. allocated (single_mapping)) then
              call sf_channel(i)%set_s_mapping (s_mapping, &
                   power = s_mapping_power)
           end if
        end do
     else if (sf_allow_s_mapping) then
        allocate (sf_channel (1))
        call sf_channel(1)%init (n_strfun)
        if (allocated (single_mapping)) then
           call sf_channel(1)%activate_mapping (single_mapping)
        else if (endpoint_mapping .and. power_mapping) then
           call sf_channel(i)%set_ei_mapping (s_mapping, &
                a = endpoint_mapping_slope, eps = power_mapping_eps)
        else if (endpoint_mapping) then
           call sf_channel(1)%set_ep_mapping (s_mapping, &
                   a = endpoint_mapping_slope)
        else if (power_mapping) then
           call sf_channel(1)%set_ip_mapping (s_mapping, &
                   eps = power_mapping_eps)
        else if (s_mapping_enable) then
           call sf_channel(1)%set_s_mapping (s_mapping, &
                power = s_mapping_power)
        end if
     else
        allocate (sf_channel (1))
        call sf_channel(1)%init (n_strfun)
        if (allocated (single_mapping)) then
           call sf_channel(1)%activate_mapping (single_mapping)
        end if
     end if
   end subroutine dispatch_sf_channels
 
 @ %def dispatch_sf_channels
 @
 @
 \subsection{Unit tests}
 Test module, followed by the corresponding implementation module.
 <<[[dispatch_phs_ut.f90]]>>=
 <<File header>>
 
 module dispatch_phs_ut
   use unit_tests
   use dispatch_phs_uti
 
 <<Standard module head>>
 
 <<Dispatch phs: public test>>
 
 contains
 
 <<Dispatch phs: test driver>>
 
 end module dispatch_phs_ut
 @ %def dispatch_phs_ut
 @
 <<[[dispatch_phs_uti.f90]]>>=
 <<File header>>
 
 module dispatch_phs_uti
 
 <<Use kinds>>
 <<Use strings>>
   use variables
   use io_units, only: free_unit
   use os_interface, only: os_data_t, os_data_init
   use process_constants
   use model_data
   use models
   use phs_base
   use phs_none
   use phs_forests
   use phs_wood
   use mappings
   use dispatch_phase_space
 
 <<Standard module head>>
 
 <<Dispatch phs: test declarations>>
 
 contains
 
 <<Dispatch phs: tests>>
 
 end module dispatch_phs_uti
 @ %def dispatch_phs_ut
 @ API: driver for the unit tests below.
 <<Dispatch phs: public test>>=
   public ::dispatch_phs_test
 <<Dispatch phs: test driver>>=
   subroutine dispatch_phs_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Dispatch phs: execute tests>>
   end subroutine dispatch_phs_test
 
 @  %def dispatch_phs_test
 @
 \subsubsection{Select type: phase-space configuration object}
 <<Dispatch phs: execute tests>>=
   call test (dispatch_phs_1, "dispatch_phs_1", &
        "phase-space configuration", &
        u, results)
 <<Dispatch phs: test declarations>>=
   public :: dispatch_phs_1
 <<Dispatch phs: tests>>=
   subroutine dispatch_phs_1 (u)
     integer, intent(in) :: u
     type(var_list_t) :: var_list
     class(phs_config_t), allocatable :: phs
     type(phs_parameters_t) :: phs_par
     type(os_data_t) :: os_data
     type(mapping_defaults_t) :: mapping_defs
 
     write (u, "(A)")  "* Test output: dispatch_phs_1"
     write (u, "(A)")  "*   Purpose: select phase-space configuration method"
     write (u, "(A)")
 
     call var_list%init_defaults (0)
 
     write (u, "(A)")  "* Allocate PHS as phs_none_t"
     write (u, "(A)")
 
     call var_list%set_string (&
          var_str ("$phs_method"), &
          var_str ("none"), is_known = .true.)
     call dispatch_phs (phs, var_list, os_data, var_str ("dispatch_phs_1"))
     call phs%write (u)
 
     call phs%final ()
     deallocate (phs)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate PHS as phs_single_t"
     write (u, "(A)")
 
     call var_list%set_string (&
          var_str ("$phs_method"), &
          var_str ("single"), is_known = .true.)
     call dispatch_phs (phs, var_list, os_data, var_str ("dispatch_phs_1"))
     call phs%write (u)
 
     call phs%final ()
     deallocate (phs)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate PHS as phs_wood_t"
     write (u, "(A)")
 
     call var_list%set_string (&
          var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call dispatch_phs (phs, var_list, os_data, var_str ("dispatch_phs_1"))
     call phs%write (u)
 
     call phs%final ()
     deallocate (phs)
 
     write (u, "(A)")
     write (u, "(A)")  "* Setting parameters for phs_wood_t"
     write (u, "(A)")
 
     phs_par%m_threshold_s = 123
     phs_par%m_threshold_t = 456
     phs_par%t_channel = 42
     phs_par%off_shell = 17
     phs_par%keep_nonresonant = .false.
     mapping_defs%energy_scale = 987
     mapping_defs%invariant_mass_scale = 654
     mapping_defs%momentum_transfer_scale = 321
     mapping_defs%step_mapping = .false.
     mapping_defs%step_mapping_exp = .false.
     mapping_defs%enable_s_mapping = .true.
     call dispatch_phs (phs, var_list, os_data, var_str ("dispatch_phs_1"), &
          mapping_defs, phs_par)
     call phs%write (u)
 
     call phs%final ()
 
     call var_list%final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_phs_1"
 
   end subroutine dispatch_phs_1
 
 @ %def dispatch_phs_1
 @
 \subsubsection{Phase-space configuration with file}
 <<Dispatch phs: execute tests>>=
   call test (dispatch_phs_2, "dispatch_phs_2", &
        "configure phase space using file", &
        u, results)
 <<Dispatch phs: test declarations>>=
   public :: dispatch_phs_2
 <<Dispatch phs: tests>>=
   subroutine dispatch_phs_2 (u)
     use phs_base_ut, only: init_test_process_data
     use phs_wood_ut, only: write_test_phs_file
     use phs_forests
     integer, intent(in) :: u
     type(var_list_t) :: var_list
     type(os_data_t) :: os_data
     type(process_constants_t) :: process_data
     type(model_list_t) :: model_list
     type(model_t), pointer :: model
     class(phs_config_t), allocatable :: phs
     integer :: u_phs
 
     write (u, "(A)")  "* Test output: dispatch_phs_2"
     write (u, "(A)")  "*   Purpose: select 'wood' phase-space &
          &for a test process"
     write (u, "(A)")  "*            and read phs configuration from file"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initialize a process"
     write (u, "(A)")
 
     call var_list%init_defaults (0)
     call os_data_init (os_data)
     call syntax_model_file_init ()
     call model_list%read_model &
          (var_str ("Test"), var_str ("Test.mdl"), os_data, model)
 
     call syntax_phs_forest_init ()
 
     call init_test_process_data (var_str ("dispatch_phs_2"), process_data)
 
     write (u, "(A)")  "* Write phase-space file"
 
     u_phs = free_unit ()
     open (u_phs, file = "dispatch_phs_2.phs", action = "write", status = "replace")
     call write_test_phs_file (u_phs, var_str ("dispatch_phs_2"))
     close (u_phs)
 
     write (u, "(A)")
     write (u, "(A)")  "* Allocate PHS as phs_wood_t"
     write (u, "(A)")
 
     call var_list%set_string (&
          var_str ("$phs_method"), &
          var_str ("wood"), is_known = .true.)
     call var_list%set_string (&
          var_str ("$phs_file"), &
          var_str ("dispatch_phs_2.phs"), is_known = .true.)
     call dispatch_phs (phs, var_list, os_data, var_str ("dispatch_phs_2"))
 
     call phs%init (process_data, model)
     call phs%configure (sqrts = 1000._default)
 
     call phs%write (u)
     write (u, "(A)")
     select type (phs)
     type is (phs_wood_config_t)
        call phs%write_forest (u)
     end select
 
     call phs%final ()
 
     call var_list%final ()
     call syntax_model_file_final ()
 
     write (u, "(A)")
     write (u, "(A)")  "* Test output end: dispatch_phs_2"
 
   end subroutine dispatch_phs_2
 
 @ %def dispatch_phs_2
 @%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{A lexer for O'Mega's phase-space output}
 This module provides three data types. One of them is the type
 [[dag_string_t]] which should contain the information of all Feynman
 diagrams in the factorized form which is provided by O'Mega in its
 phase-space outout. This output is translated into a string of tokens (in
 the form of an a array of the type [[dag_token_t]]) which have a certain
 meaning. The purpose of this module is only to identify these tokens
 correctly and to provide some procedures and interfaces which allow us to
 use these strings in a similar way as variables of the basic character
 type or the type [[iso_varying_string]]. Both [[character]] and
 [[iso_varying_string]] have some disadvantages at least if one wants to
 keep support for some older compiler versions. These can be circumvented
 by the [[dag_string_t]] type. Finally the [[dag_chain_t]] type is used
 to create a larger string in several steps without always recreating the
 string, which is done in the form of a simple linked list. In the end
 one can create a single [[dag_string]] out of this list, which is more
 useful.
 <<[[cascades2_lexer.f90]]>>=
 <<File header>>
 
 module cascades2_lexer
 
 <<Use kinds>>
   use kinds, only: TC, i8
 
 <<Standard module head>>
 
 <<Cascades2 lexer: public>>
 
 <<Cascades2 lexer: parameters>>
 
 <<Cascades2 lexer: types>>
 
 <<Cascades2 lexer: interfaces>>
 
 contains
 
 <<Cascades2 lexer: procedures>>
 
 end module cascades2_lexer
 
 @ %def cascades2_lexer
 @ This is the token type. By default the variable [[type]] is [[EMPTY_TK]]
 but can obtain other values corresponding to the parameters defined below.
 The type of the token corresponds to a particular sequence of characters.
 When the token corresponds to a node of a tree, i.e. some particle in the
 Feynman diagram, the type is [[NODE_TK]] and the [[particle_name]] variable
 is holding the name of the particle. O'Megas output contains in
 addition to the particle name some numbers which indicate the external
 momenta that are flowing through this line. These numbers are translated
 into a binary code and saved in the variable [[bincode]]. In this case
 the number 1 corresponds to a bit set at position 0, 2 corresponds to a
 bit set at position 1, etc. Instead of numbers which are composed out of
 several digits, letters are used, i.e. A instead of 10 (bit at position 9),
 B instead of 11 (bit at position 10), etc.\\
 When the DAG is reconstructed from a [[dag_string]] which was built from
 O'Mega's output, this string is modified such that a substring (a set of
 tokens) is replaced by a single token where the type variable is one of
 the three parameters [[DAG_NODE_TK]], [[DAG_OPTIONS_TK]] and
 [[DAG_COMBINATION_TK]]. These parameters correspond to the three types
 [[dag_node_t]], [[dag_options_t]] and [[dag_combination_t]] (see [[cascades2]]
 for more information. In this case, since these objects are organized
 in arrays, the [[index]] variable holds the corresponding position in
 the array.\\
 In any case, we want to be able to reproduce the character string from
 which a token (or a string) has been created. The variable [[char_len]]
 is the length of this string. For tokens with the type [[DAG_NODE_TK]],
 [[DAG_OPTIONS_TK]] and [[DAG_COMBINATION_TK]] we use output of the form
 [[<N23>]], [[<O23>]] or [[<C23>]] which is useful for debugging the parser.
 Here 23 is the [[index]] and [[N]], [[O]] or [[C]] obviously corresponds
 to the [[type]].
 <<Cascades2 lexer: parameters>>=
   integer, parameter :: PRT_NAME_LEN = 20
 @ %def PRT_NAME_LEN
 <<Cascades2 lexer: public>>=
   public :: dag_token_t
 <<Cascades2 lexer: types>>=
   type :: dag_token_t
      integer :: type = EMPTY_TK
      integer :: char_len = 0
      integer(TC) :: bincode = 0
      character (PRT_NAME_LEN) :: particle_name=""
      integer :: index = 0
    contains
      <<Cascades2 lexer: dag token: TBP>>
   end type dag_token_t
 
 @ %def dag_token_t
 @ This is the string type. It also holds the number of characters in the
 corresponding character string. It contains an array of tokens. If the
 [[dag_string]] is constructed using the type [[dag_chain_t]], which creates
 a linked list, we also need the pointer [[next]].
 <<Cascades2 lexer: public>>=
   public :: dag_string_t
 <<Cascades2 lexer: types>>=
   type :: dag_string_t
      integer :: char_len = 0
      type (dag_token_t), dimension(:), allocatable :: t
      type (dag_string_t), pointer :: next => null ()
    contains
      <<Cascades2 lexer: dag string: TBP>>
   end type dag_string_t
 
 @ %def dag_string_t
 @ This is the chain of [[dag_strings]]. It allows us to construct a large
 string by appending new strings to the linked list, which can later be
 merged to a single string. This is very useful because the file written
 by O'Mega contains large strings where each string contains all Feynman
 diagrams in a factorized form, but these large strings are cut into
 several pieces and distributed over many lines. As the file can become
 large, rewriting a new [[dag_string]] (or [[iso_varying_string]]) would
 consume more and more time with each additional line. For recreating a
 single [[dag_string]] out of this chain, we need the total character
 length and the sum of all sizes of the [[dag_token]] arrays [[t]].
 <<Cascades2 lexer: public>>=
   public :: dag_chain_t
 <<Cascades2 lexer: types>>=
   type :: dag_chain_t
      integer :: char_len = 0
      integer :: t_size = 0
      type (dag_string_t), pointer :: first => null ()
      type (dag_string_t), pointer :: last => null ()
    contains
      <<Cascades2 lexer: dag chain: TBP>>
   end type dag_chain_t
 
 @ %def dag_chain_t
 @ We define two parameters holding the characters corresponding to a
 backslash and a blanc space.
 <<Cascades2 lexer: parameters>>=
   character(len=1), parameter, public :: BACKSLASH_CHAR = "\\"
   character(len=1), parameter :: BLANC_CHAR = " "
 @ %def BACKSLASH_CHAR BLANC_CHAR
 @ These are the parameters which correspond to meaningful types
 of [[token]].
 <<Cascades2 lexer: parameters>>=
   integer, parameter, public :: NEW_LINE_TK = -2
   integer, parameter :: BLANC_SPACE_TK = -1
   integer, parameter :: EMPTY_TK = 0
   integer, parameter, public :: NODE_TK = 1
   integer, parameter, public :: DAG_NODE_TK = 2
   integer, parameter, public :: DAG_OPTIONS_TK = 3
   integer, parameter, public :: DAG_COMBINATION_TK = 4
   integer, parameter, public :: COLON_TK = 11
   integer, parameter, public :: COMMA_TK = 12
   integer, parameter, public :: VERTICAL_BAR_TK = 13
   integer, parameter, public :: OPEN_PAR_TK = 21
   integer, parameter, public :: CLOSED_PAR_TK = 22
   integer, parameter, public :: OPEN_CURLY_TK = 31
   integer, parameter, public :: CLOSED_CURLY_TK = 32
 
 @ %def NEW_LINE_TK BLANC_SPACE_TK EMPTY_TK NODE_TK
 @ %def COLON_TK COMMA_TK VERTICAL_LINE_TK OPEN_PAR_TK
 @ %def CLOSED_PAR_TK OPEN_CURLY_TK CLOSED_CURLY_TK
 @ Different sorts of assignment. This contains the conversion
 of a [[character]] variable into a [[dag_token]] or [[dag_string]].
 <<Cascades2 lexer: public>>=
   public :: assignment (=)
 <<Cascades2 lexer: interfaces>>=
   interface assignment (=)
      module procedure dag_token_assign_from_char_string
      module procedure dag_token_assign_from_dag_token
      module procedure dag_string_assign_from_dag_token
      module procedure dag_string_assign_from_char_string
      module procedure dag_string_assign_from_dag_string
      module procedure dag_string_assign_from_dag_token_array
   end interface assignment (=)
 
 @ %def interfaces
 <<Cascades2 lexer: dag token: TBP>>=
   procedure :: init_dag_object_token => dag_token_init_dag_object_token
 <<Cascades2 lexer: procedures>>=
   subroutine dag_token_init_dag_object_token (dag_token, type, index)
     class (dag_token_t), intent (out) :: dag_token
     integer, intent (in) :: index
     integer :: type
     dag_token%type = type
     dag_token%char_len = integer_n_dec_digits (index) + 3
     dag_token%index = index
   contains
     function integer_n_dec_digits (number) result (n_digits)
       integer, intent (in) :: number
       integer :: n_digits
       integer :: div_number
       n_digits = 0
       div_number = number
       do
          div_number = div_number / 10
          n_digits = n_digits + 1
          if (div_number == 0) exit
       enddo
     end function integer_n_dec_digits
   end subroutine dag_token_init_dag_object_token
 
 @ %def dag_token_init_dag_object_token
 <<Cascades2 lexer: procedures>>=
   elemental subroutine dag_token_assign_from_char_string (dag_token, char_string)
     type (dag_token_t), intent (out) :: dag_token
     character (len=*), intent (in) :: char_string
     integer :: i, j
     logical :: set_bincode
     integer :: bit_pos
     character (len=10) :: index_char
     dag_token%char_len = len (char_string)
     if (dag_token%char_len == 1) then
        select case (char_string(1:1))
        case (BACKSLASH_CHAR)
           dag_token%type = NEW_LINE_TK
        case (" ")
           dag_token%type = BLANC_SPACE_TK
        case (":")
           dag_token%type = COLON_TK
        case (",")
           dag_token%type = COMMA_TK
        case ("|")
           dag_token%type = VERTICAL_BAR_TK
        case ("(")
           dag_token%type = OPEN_PAR_TK
        case (")")
           dag_token%type = CLOSED_PAR_TK
        case ("{")
           dag_token%type = OPEN_CURLY_TK
        case ("}")
           dag_token%type = CLOSED_CURLY_TK
        end select
     else if (char_string(1:1) == "<") then
        select case (char_string(2:2))
           case ("N")
              dag_token%type = DAG_NODE_TK
           case ("O")
              dag_token%type = DAG_OPTIONS_TK
           case ("C")
              dag_token%type = DAG_COMBINATION_TK
        end select
        read(char_string(3:dag_token%char_len-1), fmt="(I10)") dag_token%index
     else
        dag_token%bincode = 0
        set_bincode = .false.
        do i=1, dag_token%char_len
           select case (char_string(i:i))
           case ("[")
              dag_token%type = NODE_TK
              if (i > 1) then
                 do j = 1, i - 1
                    dag_token%particle_name(j:j) = char_string(j:j)
                 enddo
              end if
              set_bincode = .true.
           case ("]")
              set_bincode = .false.
           case default
              dag_token%type = NODE_TK
              if (set_bincode) then
                 select case (char_string(i:i))
                 case ("1", "2", "3", "4", "5", "6", "7", "8", "9")
                    read (char_string(i:i), fmt="(I1)") bit_pos
                 case ("A")
                    bit_pos = 10
                 case ("B")
                    bit_pos = 11
                 case ("C")
                    bit_pos = 12
                 end select
                 dag_token%bincode = ibset(dag_token%bincode, bit_pos - 1)
              end if
           end select
           if (dag_token%type /= NODE_TK) exit
        enddo
     end if
   end subroutine dag_token_assign_from_char_string
 
 @ %def dag_token_assign_from_char_string
 <<Cascades2 lexer: procedures>>=
   elemental subroutine dag_token_assign_from_dag_token (token_out, token_in)
     type (dag_token_t), intent (out) :: token_out
     type (dag_token_t), intent (in) :: token_in
     token_out%type = token_in%type
     token_out%char_len = token_in%char_len
     token_out%bincode = token_in%bincode
     token_out%particle_name = token_in%particle_name
     token_out%index = token_in%index
   end subroutine dag_token_assign_from_dag_token
 
 @ %def dag_token_assign_from_dag_token
 <<Cascades2 lexer: procedures>>=
   elemental subroutine dag_string_assign_from_dag_token (dag_string, dag_token)
     type (dag_string_t), intent (out) :: dag_string
     type (dag_token_t), intent (in) :: dag_token
     allocate (dag_string%t(1))
     dag_string%t(1) = dag_token
     dag_string%char_len = dag_token%char_len
   end subroutine dag_string_assign_from_dag_token
 
 @ %def dag_string_assign_from_dag_token
 <<Cascades2 lexer: procedures>>=
   subroutine dag_string_assign_from_dag_token_array (dag_string, dag_token)
     type (dag_string_t), intent (out) :: dag_string
     type (dag_token_t), dimension(:), intent (in) :: dag_token
     allocate (dag_string%t(size(dag_token)))
     dag_string%t = dag_token
     dag_string%char_len = sum(dag_token%char_len)
   end subroutine dag_string_assign_from_dag_token_array
 
 @ %def dag_string_assign_from_dag_token_array
 <<Cascades2 lexer: procedures>>=
   elemental subroutine dag_string_assign_from_char_string (dag_string, char_string)
     type (dag_string_t), intent (out) :: dag_string
     character (len=*), intent (in) :: char_string
     type (dag_token_t), dimension(:), allocatable :: token
     integer :: token_pos
     integer :: i
     character (len=len(char_string)) :: node_char
     integer :: node_char_len
     node_char = ""
     dag_string%char_len = len (char_string)
     if (dag_string%char_len > 0) then
        allocate (token(dag_string%char_len))
        token_pos = 0
        node_char_len = 0
        do i=1, dag_string%char_len
           select case (char_string(i:i))
           case (BACKSLASH_CHAR, " ", ":", ",", "|", "(", ")", "{", "}")
              if (node_char_len > 0) then
                 token_pos = token_pos + 1
                 token(token_pos) = node_char(:node_char_len)
                 node_char_len = 0
              end if
              token_pos = token_pos + 1
              token(token_pos) = char_string(i:i)
           case default
              node_char_len = node_char_len + 1
              node_char(node_char_len:node_char_len) = char_string(i:i)
           end select
        enddo
        if (node_char_len > 0) then
           token_pos = token_pos + 1
           token(token_pos) = node_char(:node_char_len)
        end if
        if (token_pos > 0) then
           allocate (dag_string%t(token_pos))
           dag_string%t = token(:token_pos)
           deallocate (token)
        end if
     end if
   end subroutine dag_string_assign_from_char_string
 
 @ %def dag_string_assign_from_char_string
 <<Cascades2 lexer: procedures>>=
   elemental subroutine dag_string_assign_from_dag_string (string_out, string_in)
     type (dag_string_t), intent (out) :: string_out
     type (dag_string_t), intent (in) :: string_in
     if (allocated (string_in%t)) then
        allocate (string_out%t (size(string_in%t)))
        string_out%t = string_in%t
     end if
     string_out%char_len = string_in%char_len
   end subroutine dag_string_assign_from_dag_string
 
 @ %def dag_string_assign_from_dag_string
 @ Concatenate strings/tokens. The result is always a [[dag_string]].
 <<Cascades2 lexer: public>>=
   public :: operator (//)
 <<Cascades2 lexer: interfaces>>=
   interface operator (//)
      module procedure concat_dag_token_dag_token
      module procedure concat_dag_string_dag_token
      module procedure concat_dag_token_dag_string
      module procedure concat_dag_string_dag_string
   end interface operator (//)
 
 @ %def interfaces
 <<Cascades2 lexer: procedures>>=
   function concat_dag_token_dag_token (token1, token2) result (res_string)
     type (dag_token_t), intent (in) :: token1, token2
     type (dag_string_t) :: res_string
     if (token1%type == EMPTY_TK) then
        res_string = token2
     else if (token2%type == EMPTY_TK) then
        res_string = token1
     else
        allocate (res_string%t(2))
        res_string%t(1) = token1
        res_string%t(2) = token2
        res_string%char_len = token1%char_len + token2%char_len
     end if
   end function concat_dag_token_dag_token
 
 @ %def concat_dag_token_dag_token
 <<Cascades2 lexer: procedures>>=
   function concat_dag_string_dag_token (dag_string, dag_token) result (res_string)
     type (dag_string_t), intent (in) :: dag_string
     type (dag_token_t), intent (in) :: dag_token
     type (dag_string_t) :: res_string
     integer :: t_size
     if (dag_string%char_len == 0) then
        res_string = dag_token
     else if (dag_token%type == EMPTY_TK) then
        res_string = dag_string
     else
        t_size = size (dag_string%t)
        allocate (res_string%t(t_size+1))
        res_string%t(:t_size) = dag_string%t
        res_string%t(t_size+1) = dag_token
        res_string%char_len = dag_string%char_len + dag_token%char_len
     end if
   end function concat_dag_string_dag_token
 
 @ %def concat_dag_string_dag_token
 <<Cascades2 lexer: procedures>>=
   function concat_dag_token_dag_string (dag_token, dag_string) result (res_string)
     type (dag_token_t), intent (in) :: dag_token
     type (dag_string_t), intent (in) :: dag_string
     type (dag_string_t) :: res_string
     integer :: t_size
     if (dag_token%type == EMPTY_TK) then
        res_string = dag_string
     else if (dag_string%char_len == 0) then
        res_string = dag_token
     else
        t_size = size (dag_string%t)
        allocate (res_string%t(t_size+1))
        res_string%t(2:t_size+1) = dag_string%t
        res_string%t(1) = dag_token
        res_string%char_len = dag_token%char_len + dag_string%char_len
     end if
   end function concat_dag_token_dag_string
 
 @ %def concat_dag_token_dag_string
 <<Cascades2 lexer: procedures>>=
   function concat_dag_string_dag_string (string1, string2) result (res_string)
     type (dag_string_t), intent (in) :: string1, string2
     type (dag_string_t) :: res_string
     integer :: t1_size, t2_size, t_size
     if (string1%char_len == 0) then
        res_string = string2
     else if (string2%char_len == 0) then
        res_string = string1
     else
        t1_size = size (string1%t)
        t2_size = size (string2%t)
        t_size = t1_size + t2_size
        if (t_size > 0) then
           allocate (res_string%t(t_size))
           res_string%t(:t1_size) = string1%t
           res_string%t(t1_size+1:) = string2%t
           res_string%char_len = string1%char_len + string2%char_len
        end if
     end if
   end function concat_dag_string_dag_string
 
 @ %def concat_dag_string_dag_string
 @ Compare strings/tokens/characters. Each character is relevant, including
 all blanc spaces. An exception is the [[newline]] character which is not
 treated by the types used in this module (not to confused with the type
 parameter [[NEW_LINE_TK]] which corresponds to the backslash character
 and simply tells us that the string continues on the next line in the file).
 <<Cascades2 lexer: public>>=
   public :: operator (==)
 <<Cascades2 lexer: interfaces>>=
   interface operator (==)
      module procedure dag_token_eq_dag_token
      module procedure dag_string_eq_dag_string
      module procedure dag_token_eq_dag_string
      module procedure dag_string_eq_dag_token
      module procedure dag_token_eq_char_string
      module procedure char_string_eq_dag_token
      module procedure dag_string_eq_char_string
      module procedure char_string_eq_dag_string
   end interface operator (==)
 
 @ %def interfaces
 <<Cascades2 lexer: procedures>>=
   elemental function dag_token_eq_dag_token (token1, token2) result (flag)
     type (dag_token_t), intent (in) :: token1, token2
     logical :: flag
     flag = (token1%type == token2%type) .and. &
          (token1%char_len == token2%char_len) .and. &
          (token1%bincode == token2%bincode) .and. &
          (token1%index == token2%index) .and. &
          (token1%particle_name == token2%particle_name)
   end function dag_token_eq_dag_token
 
 @ %def dag_token_eq_dag_token
 <<Cascades2 lexer: procedures>>=
   elemental function dag_string_eq_dag_string (string1, string2) result (flag)
     type (dag_string_t), intent (in) :: string1, string2
     logical :: flag
     flag = (string1%char_len == string2%char_len) .and. &
          (allocated (string1%t) .eqv. allocated (string2%t))
     if (flag) then
        if (allocated (string1%t)) flag = all (string1%t == string2%t)
     end if
   end function dag_string_eq_dag_string
 
 @ %def dag_string_eq_dag_string
 <<Cascades2 lexer: procedures>>=
   elemental function dag_token_eq_dag_string (dag_token, dag_string) result (flag)
     type (dag_token_t), intent (in) :: dag_token
     type (dag_string_t), intent (in) :: dag_string
     logical :: flag
     flag = size (dag_string%t) == 1 .and. &
          dag_string%char_len == dag_token%char_len
     if (flag) flag = (dag_string%t(1) == dag_token)
   end function dag_token_eq_dag_string
 
 @ %def dag_token_eq_dag_string
 <<Cascades2 lexer: procedures>>=
   elemental function dag_string_eq_dag_token (dag_string, dag_token) result (flag)
     type (dag_token_t), intent (in) :: dag_token
     type (dag_string_t), intent (in) :: dag_string
     logical :: flag
     flag = (dag_token == dag_string)
   end function dag_string_eq_dag_token
 
 @ %def dag_string_eq_dag_token
 <<Cascades2 lexer: procedures>>=
   elemental function dag_token_eq_char_string (dag_token, char_string) result (flag)
     type (dag_token_t), intent (in) :: dag_token
     character (len=*), intent (in) :: char_string
     logical :: flag
     flag = (char (dag_token) == char_string)
   end function dag_token_eq_char_string
 
 @ %def dag_token_eq_char_string
 <<Cascades2 lexer: procedures>>=
   elemental function char_string_eq_dag_token (char_string, dag_token) result (flag)
     type (dag_token_t), intent (in) :: dag_token
     character (len=*), intent (in) :: char_string
     logical :: flag
     flag = (char (dag_token) == char_string)
   end function char_string_eq_dag_token
 
 @ %def char_string_eq_dag_token
 <<Cascades2 lexer: procedures>>=
   elemental function dag_string_eq_char_string (dag_string, char_string) result (flag)
     type (dag_string_t), intent (in) :: dag_string
     character (len=*), intent (in) :: char_string
     logical :: flag
     flag = (char (dag_string) == char_string)
   end function dag_string_eq_char_string
 
 @ %def dag_string_eq_char_string
 <<Cascades2 lexer: procedures>>=
   elemental function char_string_eq_dag_string (char_string, dag_string) result (flag)
     type (dag_string_t), intent (in) :: dag_string
     character (len=*), intent (in) :: char_string
     logical :: flag
     flag = (char (dag_string) == char_string)
   end function char_string_eq_dag_string
 
 @ %def char_string_eq_dag_string
 <<Cascades2 lexer: public>>=
   public :: operator (/=)
 <<Cascades2 lexer: interfaces>>=
   interface operator (/=)
      module procedure dag_token_ne_dag_token
      module procedure dag_string_ne_dag_string
      module procedure dag_token_ne_dag_string
      module procedure dag_string_ne_dag_token
      module procedure dag_token_ne_char_string
      module procedure char_string_ne_dag_token
      module procedure dag_string_ne_char_string
      module procedure char_string_ne_dag_string
   end interface operator (/=)
 
 @ %def interfaces
 <<Cascades2 lexer: procedures>>=
   elemental function dag_token_ne_dag_token (token1, token2) result (flag)
     type (dag_token_t), intent (in) :: token1, token2
     logical :: flag
     flag = .not. (token1 == token2)
   end function dag_token_ne_dag_token
 
 @ %def dag_token_ne_dag_token
 <<Cascades2 lexer: procedures>>=
   elemental function dag_string_ne_dag_string (string1, string2) result (flag)
     type (dag_string_t), intent (in) :: string1, string2
     logical :: flag
     flag = .not. (string1 == string2)
   end function dag_string_ne_dag_string
 
 @ %def dag_string_ne_dag_string
 <<Cascades2 lexer: procedures>>=
   elemental function dag_token_ne_dag_string (dag_token, dag_string) result (flag)
     type (dag_token_t), intent (in) :: dag_token
     type (dag_string_t), intent (in) :: dag_string
     logical :: flag
     flag = .not. (dag_token == dag_string)
   end function dag_token_ne_dag_string
 
 @ %def dag_token_ne_dag_string
 <<Cascades2 lexer: procedures>>=
   elemental function dag_string_ne_dag_token (dag_string, dag_token) result (flag)
     type (dag_token_t), intent (in) :: dag_token
     type (dag_string_t), intent (in) :: dag_string
     logical :: flag
     flag = .not. (dag_string == dag_token)
   end function dag_string_ne_dag_token
 
 @ %def dag_string_ne_dag_token
 <<Cascades2 lexer: procedures>>=
   elemental function dag_token_ne_char_string (dag_token, char_string) result (flag)
     type (dag_token_t), intent (in) :: dag_token
     character (len=*), intent (in) :: char_string
     logical :: flag
     flag = .not. (dag_token == char_string)
   end function dag_token_ne_char_string
 
 @ %def dag_token_ne_char_string
 <<Cascades2 lexer: procedures>>=
   elemental function char_string_ne_dag_token (char_string, dag_token) result (flag)
     type (dag_token_t), intent (in) :: dag_token
     character (len=*), intent (in) :: char_string
     logical :: flag
     flag = .not. (char_string == dag_token)
   end function char_string_ne_dag_token
 
 @ %def char_string_ne_dag_token
 <<Cascades2 lexer: procedures>>=
   elemental function dag_string_ne_char_string (dag_string, char_string) result (flag)
     type (dag_string_t), intent (in) :: dag_string
     character (len=*), intent (in) :: char_string
     logical :: flag
     flag = .not. (dag_string == char_string)
   end function dag_string_ne_char_string
 
 @ %def dag_string_ne_char_string
 <<Cascades2 lexer: procedures>>=
   elemental function char_string_ne_dag_string (char_string, dag_string) result (flag)
     type (dag_string_t), intent (in) :: dag_string
     character (len=*), intent (in) :: char_string
     logical :: flag
     flag = .not. (char_string == dag_string)
   end function char_string_ne_dag_string
 
 @ %def char_string_ne_dag_string
 @ Convert a [[dag_token]] or [[dag_string]] to character.
 <<Cascades2 lexer: public>>=
   public :: char
 <<Cascades2 lexer: interfaces>>=
   interface char
      module procedure char_dag_token
      module procedure char_dag_string
   end interface char
 
 @ %def interfaces
 <<Cascades2 lexer: procedures>>=
   pure function char_dag_token (dag_token) result (char_string)
     type (dag_token_t), intent (in) :: dag_token
     character (dag_token%char_len) :: char_string
     integer :: i
     integer :: name_len
     integer :: bc_pos
     integer :: n_digits
     character (len=9) :: fmt_spec
     select case (dag_token%type)
     case (EMPTY_TK)
        char_string = ""
     case (NEW_LINE_TK)
        char_string = BACKSLASH_CHAR
     case (BLANC_SPACE_TK)
        char_string = " "
     case (COLON_TK)
        char_string = ":"
     case (COMMA_TK)
        char_string = ","
     case (VERTICAL_BAR_TK)
        char_string = "|"
     case (OPEN_PAR_TK)
        char_string = "("
     case (CLOSED_PAR_TK)
        char_string = ")"
     case (OPEN_CURLY_TK)
        char_string = "{"
     case (CLOSED_CURLY_TK)
        char_string = "}"
     case (DAG_NODE_TK, DAG_OPTIONS_TK, DAG_COMBINATION_TK)
        n_digits = dag_token%char_len - 3
        fmt_spec = ""
        if (n_digits > 9) then
           write (fmt_spec, fmt="(A,I2,A)") "(A,I", n_digits, ",A)"
        else
           write (fmt_spec, fmt="(A,I1,A)") "(A,I", n_digits, ",A)"
        end if
        select case (dag_token%type)
           case (DAG_NODE_TK)
              write (char_string, fmt=fmt_spec) "<N", dag_token%index, ">"
           case (DAG_OPTIONS_TK)
              write (char_string, fmt=fmt_spec) "<O", dag_token%index, ">"
           case (DAG_COMBINATION_TK)
              write (char_string, fmt=fmt_spec) "<C", dag_token%index, ">"
           end select
     case (NODE_TK)
        name_len = len_trim (dag_token%particle_name)
        char_string = dag_token%particle_name
        bc_pos = name_len + 1
        char_string(bc_pos:bc_pos) = "["
        do i=0, bit_size (dag_token%bincode) - 1
           if (btest (dag_token%bincode, i)) then
              bc_pos = bc_pos + 1
              select case (i)
              case (0, 1, 2, 3, 4, 5, 6, 7, 8)
                 write (char_string(bc_pos:bc_pos), fmt="(I1)") i + 1
              case (9)
                 write (char_string(bc_pos:bc_pos), fmt="(A1)") "A"
              case (10)
                 write (char_string(bc_pos:bc_pos), fmt="(A1)") "B"
              case (11)
                 write (char_string(bc_pos:bc_pos), fmt="(A1)") "C"
              end select
              bc_pos = bc_pos + 1
              if (bc_pos == dag_token%char_len) then
                 write (char_string(bc_pos:bc_pos), fmt="(A1)") "]"
                 return
              else
                 write (char_string(bc_pos:bc_pos), fmt="(A1)") "/"
              end if
           end if
        enddo
     end select
   end function char_dag_token
 
 @ %def char_dag_token
 <<Cascades2 lexer: procedures>>=
   pure function char_dag_string (dag_string) result (char_string)
     type (dag_string_t), intent (in) :: dag_string
     character (dag_string%char_len) :: char_string
     integer :: pos
     integer :: i
     char_string = ""
     pos = 0
     do i=1, size(dag_string%t)
        char_string(pos+1:pos+dag_string%t(i)%char_len) = char (dag_string%t(i))
        pos = pos + dag_string%t(i)%char_len
     enddo
   end function char_dag_string
 
 @ %def char_dag_string
 @ Remove all tokens which are irrelevant for parsing. These are of type
 [[NEW_LINE_TK]], [[BLANC_SPACE_TK]] and [[EMTPY_TK]].
 <<Cascades2 lexer: dag string: TBP>>=
   procedure :: clean => dag_string_clean
 <<Cascades2 lexer: procedures>>=
   subroutine dag_string_clean (dag_string)
     class (dag_string_t), intent (inout) :: dag_string
     type (dag_token_t), dimension(:), allocatable :: tmp_token
     integer :: n_keep
     integer :: i
     n_keep = 0
     dag_string%char_len = 0
     allocate (tmp_token (size(dag_string%t)))
     do i=1, size (dag_string%t)
        select case (dag_string%t(i)%type)
        case(NEW_LINE_TK, BLANC_SPACE_TK, EMPTY_TK)
        case default
           n_keep = n_keep + 1
           tmp_token(n_keep) = dag_string%t(i)
           dag_string%char_len = dag_string%char_len + dag_string%t(i)%char_len
        end select
     enddo
     deallocate (dag_string%t)
     allocate (dag_string%t(n_keep))
     dag_string%t = tmp_token(:n_keep)
   end subroutine dag_string_clean
 
 @ %def dag_string_clean
 @ If we operate explicitly on the [[token]] array [[t]] of a [[dag_string]],
 the variable [[char_len]] is not automatically modified. It can however be
 determined afterwards using the following subroutine.
 <<Cascades2 lexer: dag string: TBP>>=
   procedure :: update_char_len => dag_string_update_char_len
 <<Cascades2 lexer: procedures>>=
   subroutine dag_string_update_char_len (dag_string)
     class (dag_string_t), intent (inout) :: dag_string
     integer :: char_len
     integer :: i
     char_len = 0
     if (allocated (dag_string%t)) then
        do i=1, size (dag_string%t)
           char_len = char_len + dag_string%t(i)%char_len
        enddo
     end if
     dag_string%char_len = char_len
   end subroutine dag_string_update_char_len
 
 @ %def dag_string_update_char_len
 @ Append a [[dag_string]] to a [[dag_chain]]. The argument [[char_string]]
 is of type [[character]] because the subroutine is used for reading from
 the file produced by O'Mega which is first read line by line to a character
 variable.
 <<Cascades2 lexer: dag chain: TBP>>=
   procedure :: append => dag_chain_append_string
 <<Cascades2 lexer: procedures>>=
   subroutine dag_chain_append_string (dag_chain, char_string)
     class (dag_chain_t), intent (inout) :: dag_chain
     character (len=*), intent (in) :: char_string
     if (.not. associated (dag_chain%first)) then
        allocate (dag_chain%first)
        dag_chain%last => dag_chain%first
     else
        allocate (dag_chain%last%next)
        dag_chain%last => dag_chain%last%next
     end if
     dag_chain%last = char_string
     dag_chain%char_len = dag_chain%char_len + dag_chain%last%char_len
     dag_chain%t_size = dag_chain%t_size + size (dag_chain%last%t)
   end subroutine dag_chain_append_string
 
 @ %def dag_chain_append_string
 @ Reduce the linked list of [[dag_string]] objects which are attached
 to a given [[dag_chain]] object to a single [[dag_string]].
 <<Cascades2 lexer: dag chain: TBP>>=
   procedure :: compress => dag_chain_compress
 <<Cascades2 lexer: procedures>>=
   subroutine dag_chain_compress (dag_chain)
     class (dag_chain_t), intent (inout) :: dag_chain
     type (dag_string_t), pointer :: current
     type (dag_string_t), pointer :: remove
     integer :: filled_t
     current => dag_chain%first
     dag_chain%first => null ()
     allocate (dag_chain%first)
     dag_chain%last => dag_chain%first
     dag_chain%first%char_len = dag_chain%char_len
     allocate (dag_chain%first%t (dag_chain%t_size))
     filled_t = 0
     do while (associated (current))
        dag_chain%first%t(filled_t+1:filled_t+size(current%t)) = current%t
        filled_t = filled_t + size (current%t)
        remove => current
        current => current%next
        deallocate (remove)
     enddo
   end subroutine dag_chain_compress
 
 @ %def dag_chain_compress
 @ Finalizer for [[dag_string_t]].
 <<Cascades2 lexer: dag string: TBP>>=
   procedure :: final => dag_string_final
 <<Cascades2 lexer: procedures>>=
   subroutine dag_string_final (dag_string)
     class (dag_string_t), intent (inout) :: dag_string
     if (allocated (dag_string%t)) deallocate (dag_string%t)
     dag_string%next => null ()
   end subroutine dag_string_final
 
 @ %def dag_string_final
 @ Finalizer for [[dag_chain_t]].
 <<Cascades2 lexer: dag chain: TBP>>=
   procedure :: final => dag_chain_final
 <<Cascades2 lexer: procedures>>=
   subroutine dag_chain_final (dag_chain)
     class (dag_chain_t), intent (inout) :: dag_chain
     type (dag_string_t), pointer :: current
     current => dag_chain%first
     do while (associated (current))
        dag_chain%first => dag_chain%first%next
        call current%final ()
        deallocate (current)
        current => dag_chain%first
     enddo
     dag_chain%last => null ()
   end subroutine dag_chain_final
 
 @ %def dag_chain_final
 <<[[cascades2_lexer_ut.f90]]>>=
 <<File header>>
 
 module cascades2_lexer_ut
   use unit_tests
   use cascades2_lexer_uti
 
 <<Standard module head>>
 
 <<Cascades2 lexer: public test>>
 
 contains
 
 <<Cascades2 lexer: test driver>>
 
 end module cascades2_lexer_ut
 @ %def cascades2_lexer_ut
 @
 <<[[cascades2_lexer_uti.f90]]>>=
 <<File header>>
 
 module cascades2_lexer_uti
 
 <<Use kinds>>
 <<Use strings>>
   use numeric_utils
 
   use cascades2_lexer
 
 <<Standard module head>>
 
 <<Cascades2 lexer: test declarations>>
 
 contains
 
 <<Cascades2 lexer: tests>>
 
 end module cascades2_lexer_uti
 @ %def cascades2_lexer_uti
 @ API: driver for the unit tests below.
 <<Cascades2 lexer: public test>>=
   public :: cascades2_lexer_test
 <<Cascades2 lexer: test driver>>=
   subroutine cascades2_lexer_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Cascades2 lexer: execute tests>>
   end subroutine cascades2_lexer_test
 
 @ %def cascades2_lexer_test
 @
 <<Cascades2 lexer: execute tests>>=
   call test (cascades2_lexer_1, "cascades2_lexer_1", &
        "make phase-space", u, results)
 <<Cascades2 lexer: test declarations>>=
   public :: cascades2_lexer_1
 <<Cascades2 lexer: tests>>=
   subroutine cascades2_lexer_1 (u)
     integer, intent(in) :: u
     integer :: u_in = 8
     character (len=300) :: line
     integer :: stat
     logical :: fail
     type (dag_string_t) :: dag_string
 
     write (u, "(A)")  "* Test output: cascades2_lexer_1"
     write (u, "(A)")  "*   Purpose: read lines of O'Mega's phase space output, translate"
     write (u, "(A)")  "*            to dag_string, retranslate to character string and"
     write (u, "(A)")  "*            compare"
     write (u, "(A)")
 
     open (unit=u_in, file="cascades2_lexer_1.fds", status='old', action='read')
 
     stat = 0
     fail = .false.
     read (unit=u_in, fmt="(A)", iostat=stat) line
     do while (stat == 0 .and. .not. fail)
        read (unit=u_in, fmt="(A)", iostat=stat) line
        if (stat /= 0) exit
        dag_string = line
        fail = (char(dag_string) /= line)
     enddo
     if (fail) then
        write (u, "(A)")  "* Test result: Test failed!"
     else
        write (u, "(A)")  "* Test result: Test passed"
     end if
 
     close (u_in)
     write (u, *)
     write (u, "(A)")  "* Test output end: cascades2_lexer_1"
   end subroutine cascades2_lexer_1
 
 @ %def cascades2_lexer_1
 @%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{An alternative cascades module}
 This module might replace the module [[cascades]], which generates
 suitable phase space parametrizations and generates the phase space file.
 The mappings, as well as the criteria to determine these, do not change.
 
 The advantage of this module is that it makes use of the [[O'Mega]] matrix
 element generator which provides the relevant Feynman diagrams (the ones
 which can be constructed only from 3-vertices). In principle, the
 construction of these diagrams is also one of the tasks of the existing
 [[cascades]] module, in which the diagrams would correspond to a set of
 cascades. It starts by creating cascades which correspond to the
 outgoing particles. These are combined to a new cascade using the
 vertices of the model. In this way, since each cascade knows the
 daughter cascades from which it is built, complete Feynman diagrams are
 represented by sets of cascades, as soon as the existing cascades can be
 recombined with the incoming particle(s).
 
 In this module, the Feynman diagrams are represented by the type
 [[feyngraph_t]], which represents the Feynman diagrams as a tree of
 nodes. The object which contains the necessary kinematical information
 to determine mappings, and hence sensible phase space parametrizations
 is of another type, called [[kingraph_t]], which is built from a
 corresponding [[feyngraph]] object.
 
 There are two types of output which can be produced by [[O'Mega]] and
 are potentially relevant here. The first type contains all tree
 diagrams for the process under consideration, where each line of the
 output corresponds to one Feynman diagram. This output is easy to read,
 but can be very large, depending on the number of particles involved in
 the process. Moreover, it repeats substructures of the diagrams which
 are part of more than one diagram. One could in principle work with
 this output and construct a [[feyngraph]] from each line, if allowed,
 i.e. if there are only 3-vertices.
 
 The other output contains also all of these Feynman diagrams, but in
 a factorized form. This means that the substructures which appear in
 several Feynman diagrams, are written only once, if possible. This
 leads to a much shorter input file, which speeds up the parsing
 process. Furthermore it makes it possible to reconstruct the
 [[feyngraphs]] in such a way that the calculations concerning
 subdiagrams which reappear in other [[feyngraphs]] have to be
 performed only once. This is already the case in the existing
 [[cascades]] module but can be exploited more efficiently here
 because the possible graphs are well known from the input file, whereas
 the [[cascades]] module would create a large number of [[cascades]]
 which do not lead to a complete Feynman diagram of the given process.
 <<[[cascades2.f90]]>>=
 <<File header>>
 
 module cascades2
 
 <<Use kinds>>
   use kinds, only: TC, i8
   use cascades2_lexer
   use sorting
   use flavors
   use model_data
   use iso_varying_string, string_t => varying_string
   use io_units
   use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
   use phs_forests, only: phs_parameters_t
   use diagnostics
   use hashes
   use cascades, only: phase_space_vanishes, MAX_WARN_RESONANCE
   use, intrinsic :: iso_fortran_env, only : input_unit, output_unit, error_unit
   use resonances, only: resonance_info_t
   use resonances, only: resonance_history_t
   use resonances, only: resonance_history_set_t
 
 <<Standard module head>>
 
 <<Cascades2: public>>
 
 <<Cascades2: parameters>>
 
 <<Cascades2: types>>
 
 <<Cascades2: interfaces>>
 
 contains
 
 <<Cascades2: procedures>>
 
 end module cascades2
 
 @ %def cascades2
 @
 \subsection{Particle properties}
 We define a type holding the properties of the particles which are needed
 for parsing and finding the phase space parametrizations and mappings.
 The properties of all particles which appear in the parsed
 Feynman diagrams for the given process will be stored in a central place,
 and only pointers to these objects are used.
 <<Cascades2: types>>=
   type :: part_prop_t
      character (len=LABEL_LEN) :: particle_label
      integer :: pdg = 0
      real(default) :: mass = 0.
      real :: width = 0.
      integer :: spin_type = 0
      logical :: is_vector = .false.
      logical :: empty = .true.
      type (part_prop_t), pointer :: anti => null ()
      type (string_t) :: tex_name
    contains
    <<Cascades2: part prop: TBP>>
   end type part_prop_t
 
 @ %def part_prop_t
 @ The [[particle_label]] in [[part_prop_t]] is simply the particle name
 (e.g. 'W+'). The corresponding variable in the type [[f_node_t]] contains
 some additional information related to the external momenta, see below.
 The length of the [[character]] variable is fixed as:
 <<Cascades2: parameters>>=
   integer, parameter :: LABEL_LEN=30
 @ %def LABEL_LEN
 <<Cascades2: part prop: TBP>>=
 procedure :: final => part_prop_final
 <<Cascades2: procedures>>=
   subroutine part_prop_final (part)
     class(part_prop_t), intent(inout) :: part
     part%anti => null ()
   end subroutine part_prop_final
 
 @ %def part_prop_final
 @
 \subsection{The mapping modes}
 The possible mappings are essentially the same as in [[cascades]], but we
 introduce in addition the mapping constant [[NON_RESONANT]], which does
 not refer to a new mapping; it corresponds to the nonresonant version of
 a potentially resonant particle (or [[k_node]]). This becomes relevant
 when we compare [[k_nodes]] to eliminate equivalences.
 <<Cascades2: parameters>>=
   integer, parameter :: &
        & NONRESONANT = -2, EXTERNAL_PRT = -1, &
        & NO_MAPPING = 0, S_CHANNEL = 1, T_CHANNEL =  2, U_CHANNEL = 3, &
        & RADIATION = 4, COLLINEAR = 5, INFRARED = 6, &
        & STEP_MAPPING_E = 11, STEP_MAPPING_H = 12, &
        & ON_SHELL = 99
 @ %def NONRESONANT EXTERNAL_PRT
 @ %def NO_MAPPING S_CHANNEL T_CHANNEL U_CHANNEL
 @ %def RADIATION COLLINEAR INFRARED
 @ %def STEP_MAPPING_E STEP_MAPPING_H
 @ %def ON_SHELL
 @
 \subsection{Grove properties}
 The channels or [[kingraphs]] will be grouped in groves, i.e. sets of
 channels, which share some characteristic numbers. These numbers are
 stored in the following type:
 <<Cascades2: types>>=
   type :: grove_prop_t
      integer :: multiplicity = 0
      integer :: n_resonances = 0
      integer :: n_log_enhanced = 0
      integer :: n_off_shell = 0
      integer :: n_t_channel = 0
      integer :: res_hash = 0
   end type grove_prop_t
 
 @ %def grove_prop_t
 @
 \subsection{The tree type}
 This type contains all the information which is needed to
 reconstruct a [[feyngraph]] or [[kingraph]]. We store bincodes, pdg codes
 and mappings for all nodes of a valid [[kingraph]]. If we label the
 external particles as given in the process definition with integer
 numbers representing their position in the process definition, the bincode
 would be the number that one obtains by setting the bit at the position
 that is given by this number. If we combine two particles/nodes to a third
 one (using a three-vertex of the given model), the bincode is the number which
 one obtains by setting all the bits which are set for the two particles.
 The [[pdg]] and [[mapping]] are simply the pdg-code and mapping at the
 position (i.e. propagator or external particle) which is specified by the
 corresponding bincode. We use [[tree_t]] not only for completed [[kingraphs]],
 but also for all [[k_nodes]], which are a subtree of a [[kingraph]].
 <<Cascades2: types>>=
   type :: tree_t
      integer(TC), dimension(:), allocatable :: bc
      integer, dimension(:), allocatable :: pdg
      integer, dimension(:), allocatable :: mapping
      integer :: n_entries = 0
      logical :: keep = .true.
      logical :: empty = .true.
    contains
    <<Cascades2: tree: TBP>>
   end type tree_t
 
 @ %def tree_t
 <<Cascades2: tree: TBP>>=
   procedure :: final => tree_final
 <<Cascades2: procedures>>=
   subroutine tree_final (tree)
     class (tree_t), intent (inout) :: tree
     if (allocated (tree%bc)) deallocate (tree%bc)
     if (allocated (tree%pdg)) deallocate (tree%pdg)
     if (allocated (tree%mapping)) deallocate (tree%mapping)
   end subroutine tree_final
 
 @ %def tree_final
 <<Cascades2: interfaces>>=
   interface assignment (=)
      module procedure tree_assign
   end interface assignment (=)
 
 <<Cascades2: procedures>>=
   subroutine tree_assign (tree1, tree2)
     type (tree_t), intent (inout) :: tree1
     type (tree_t), intent (in) :: tree2
     if (allocated (tree2%bc)) then
        allocate (tree1%bc(size(tree2%bc)))
        tree1%bc = tree2%bc
     end if
     if (allocated (tree2%pdg)) then
        allocate (tree1%pdg(size(tree2%pdg)))
        tree1%pdg = tree2%pdg
     end if
     if (allocated (tree2%mapping)) then
        allocate (tree1%mapping(size(tree2%mapping)))
        tree1%mapping = tree2%mapping
     end if
     tree1%n_entries = tree2%n_entries
     tree1%keep = tree2%keep
     tree1%empty = tree2%empty
   end subroutine tree_assign
 
 @ %def tree_assign
 @
 \subsection{Add entries to the tree}
 The following procedures fill the arrays in [[tree_t]] with entries
 resulting from the bincode and mapping assignment.
 <<Cascades2: tree: TBP>>=
   procedure :: add_entry_from_numbers => tree_add_entry_from_numbers
   procedure :: add_entry_from_node => tree_add_entry_from_node
   generic :: add_entry =>  add_entry_from_numbers, add_entry_from_node
 @ Here we add a single entry to each of the arrays. This will exclusively
 be used for external particles.
 <<Cascades2: procedures>>=
   subroutine tree_add_entry_from_numbers (tree, bincode, pdg, mapping)
     class (tree_t), intent (inout) :: tree
     integer(TC), intent (in) :: bincode
     integer, intent (in) :: pdg
     integer, intent (in) :: mapping
     integer :: pos
     if (tree%empty) then
        allocate (tree%bc(1))
        allocate (tree%pdg(1))
        allocate (tree%mapping(1))
        pos = tree%n_entries + 1
        tree%bc(pos) = bincode
        tree%pdg(pos) = pdg
        tree%mapping(pos) = mapping
        tree%n_entries = pos
        tree%empty = .false.
     end if
   end subroutine tree_add_entry_from_numbers
 
 @ %def tree_add_entry_from_numbers
 @ Here we merge two existing subtrees and a single entry (bc, pdg and
 mapping).
 <<Cascades2: procedures>>=
   subroutine tree_merge (tree, tree1, tree2, bc, pdg, mapping)
     class (tree_t), intent (inout) :: tree
     type (tree_t), intent (in) :: tree1, tree2
     integer(TC), intent (in) :: bc
     integer, intent (in) :: pdg, mapping
     integer :: tree_size
     integer :: i1, i2
     if (tree%empty) then
        i1 = tree1%n_entries
        i2 = tree1%n_entries + tree2%n_entries
        tree_size = tree1%n_entries + tree2%n_entries + 1
        allocate (tree%bc (tree_size))
        allocate (tree%pdg (tree_size))
        allocate (tree%mapping (tree_size))
        tree%bc(:i1) = tree1%bc
        tree%pdg(:i1) = tree1%pdg
        tree%mapping(:i1) = tree1%mapping
        tree%bc(i1+1:i2) = tree2%bc
        tree%pdg(i1+1:i2) = tree2%pdg
        tree%mapping(i1+1:i2) = tree2%mapping
        tree%bc(tree_size) = bc
        tree%pdg(tree_size) = pdg
        tree%mapping(tree_size) = mapping
        tree%n_entries = tree_size
        tree%empty = .false.
     end if
   end subroutine tree_merge
 
 @ %def tree_merge
 @ Here we add entries to a tree for a given [[k_node]], which means that
 we first have to determine whether the node is external or internal.
 The arrays are sorted after the entries have been added (see below for
 details).
 <<Cascades2: procedures>>=
   subroutine tree_add_entry_from_node (tree, node)
     class (tree_t), intent (inout) :: tree
     type (k_node_t), intent (in) :: node
     integer :: pdg
     if (node%t_line) then
        pdg = abs (node%particle%pdg)
     else
        pdg = node%particle%pdg
     end if
     if (associated (node%daughter1) .and. &
          associated (node%daughter2)) then
        call tree_merge (tree, node%daughter1%subtree, &
             node%daughter2%subtree, node%bincode, &
             node%particle%pdg, node%mapping)
     else
        call tree_add_entry_from_numbers (tree, node%bincode, &
             node%particle%pdg, node%mapping)
     end if
     call tree%sort ()
   end subroutine tree_add_entry_from_node
 
 @ %def tree_add_entry_from_node
 @ For a well-defined order of the elements of the arrays in [[tree_t]],
 the elements can be sorted. The bincodes (entries of [[bc]]) are
 simply ordered by size, the [[pdg]] and [[mapping]] entries go to the
 positions of the corresponding [[bc]] values.
 <<Cascades2: tree: TBP>>=
   procedure :: sort => tree_sort
 <<Cascades2: procedures>>=
   subroutine tree_sort (tree)
     class (tree_t), intent (inout) :: tree
     integer(TC), dimension(size(tree%bc)) :: bc_tmp
     integer, dimension(size(tree%pdg)) :: pdg_tmp, mapping_tmp
     integer, dimension(1) :: pos
     integer :: i
     bc_tmp = tree%bc
     pdg_tmp = tree%pdg
     mapping_tmp = tree%mapping
     do i = size(tree%bc),1,-1
        pos = maxloc (bc_tmp)
        tree%bc(i) = bc_tmp (pos(1))
        tree%pdg(i) = pdg_tmp (pos(1))
        tree%mapping(i) = mapping_tmp (pos(1))
        bc_tmp(pos(1)) = 0
     end do
   end subroutine tree_sort
 
 @ %def tree_sort
 @
 \subsection{Graph types}
 We define an abstract type which will give rise to two different types:
 The type [[feyngraph_t]] contains the pure information of the
 corresponding Feynman diagram, but also a list of objects of the
 [[kingraph]] type which contain the kinematically relevant data for the
 mapping calculation as well as the mappings themselves. Every graph
 should have an index which is unique. Graphs which are not needed any
 more can be disabled by setting the [[keep]] variable to [[false]].
 <<Cascades2: types>>=
   type, abstract :: graph_t
      integer :: index = 0
      integer :: n_nodes = 0
      logical :: keep = .true.
   end type graph_t
 
 @ %def graph_t
 @ This is the type representing the Feynman diagrams which are read from
 an input file created by O'Mega. It is a tree of nodes, which we call
 [[f_nodes]], so that [[feyngraph_t]] contains a pointer to the root of
 this tree, and each node can have two daughter nodes. The case of only
 one associated daughter should never appear, because in the method of
 phase space parametrization which is used here, we combine always two
 particle momenta to a third one. The [[feyngraphs]] will be arranged in
 a linked list. This is why we have a pointer to the next graph. The
 [[kingraphs]] on the other hand are arranged in linked lists which are
 attached to the corresponding [[feyngraph]]. In general, a [[feyngraph]]
 can give rise to more than one [[kingraph]] because we make a copy
 every time a particle can be resonant, so that in the copy we keep
 the particle nonresonant.
 <<Cascades2: types>>=
   type, extends (graph_t) :: feyngraph_t
      type (string_t) :: omega_feyngraph_output
      type (f_node_t), pointer :: root => null ()
      type (feyngraph_t), pointer :: next => null()
      type (kingraph_t), pointer :: kin_first => null ()
      type (kingraph_t), pointer :: kin_last => null ()
    contains
    <<Cascades2: feyngraph: TBP>>
   end type feyngraph_t
 
 @ %def feyngraph_t
 @ A container for a pointer of type [[feyngraph_t]]. This is used to
 realize arrays of these pointers.
 <<Cascades2: types>>=
   type :: feyngraph_ptr_t
      type (feyngraph_t), pointer :: graph => null ()
   end type feyngraph_ptr_t
 
 @ %def feyngraph_ptr_t
 @
 The length of a string describing a Feynman diagram which is produced by
 O'Mega is fixed by the parameter
 <<Cascades2: parameters>>=
   integer, parameter :: FEYNGRAPH_LEN=300
 @ %def feyngraph_len
 <<Cascades2: feyngraph: TBP>>=
   procedure :: final => feyngraph_final
 <<Cascades2: procedures>>=
   subroutine feyngraph_final (graph)
     class(feyngraph_t), intent(inout) :: graph
     type (kingraph_t), pointer :: current
     graph%root => null ()
     graph%kin_last => null ()
     do while (associated (graph%kin_first))
        current => graph%kin_first
        graph%kin_first => graph%kin_first%next
        call current%final ()
        deallocate (current)
     enddo
   end subroutine feyngraph_final
 
 @ %def feyngraph_final
 This is the type of graph which is used to find the phase space channels,
 or in other words, each kingraph could correspond to a channel, if it is
 not eliminated for kinematical reasons or due to an equivalence. For the
 linked list which is attached to the corresponding [[feyngraph]], we
 need the [[next]] pointer, whereas [[grove_next]] points to the next
 [[kingraph]] within a grove. The information which is relevant for the
 specification of a channel is stored in [[tree]]. We use [[grove_prop]]
 to sort the [[kingraph]] in a grove in which all [[kingraphs]] are
 characterized by the numbers contained in [[grove_prop]]. Later these
 groves are further subdevided using the resonance hash. A [[kingraph]]
 which is constructed directly from the output of O'Mega, is not
 [[inverse]]. In this case the first incoming particle is the root ofthe
 tree. In a scattering process, we can also construct a [[kingraph]]
 where the root of the tree is the second incoming particle. In this
 case the value of [[inverse]] is [[.true.]].
 <<Cascades2: types>>=
   type, extends (graph_t) :: kingraph_t
      type (k_node_t), pointer :: root => null ()
      type (kingraph_t), pointer :: next => null()
      type (kingraph_t), pointer :: grove_next => null ()
      type (tree_t) :: tree
      type (grove_prop_t) :: grove_prop
      logical :: inverse = .false.
      integer :: prc_component = 0
      contains
    <<Cascades2: kingraph: TBP>>
   end type kingraph_t
 
 @ %def kingraph_t
 @ Another container for a pointer to emulate arrays of pointers:
 <<Cascades2: types>>=
   type :: kingraph_ptr_t
      type (kingraph_t), pointer :: graph => null ()
   end type kingraph_ptr_t
 
 @ %def kingraph_ptr_t
 @
 <<Cascades2: kingraph: TBP>>=
   procedure :: final => kingraph_final
 <<Cascades2: procedures>>=
   subroutine kingraph_final (graph)
     class(kingraph_t), intent(inout) :: graph
     graph%root => null ()
     graph%next => null ()
     graph%grove_next => null ()
     call graph%tree%final ()
   end subroutine kingraph_final
 
 @ %def kingraph_final
 @
 \subsection{The node types}
 We define an abstract type containing variables which are needed for
 [[f_node_t]] as well as [[k_node_t]]. We say that a node is on the
 t-line if it lies between the two nodes which correspond to the two
 incoming particles. [[incoming]] and [[tline]] are used only for
 scattering processes and remain [[.false.]] in decay processes. The
 variable [[n_subtree_nodes]] holds the number of nodes (including the
 node itself) of the subtree of which the node is the root.
 <<Cascades2: types>>=
   type, abstract :: node_t
      type (part_prop_t), pointer :: particle => null ()
      logical :: incoming = .false.
      logical :: t_line = .false.
      integer :: index = 0
      logical :: keep = .true.
      integer :: n_subtree_nodes = 1
   end type node_t
 
 @  %def node_t
 @ We use two different list types for the different kinds of nodes. We
 therefore start with an abstract type:
 <<Cascades2: types>>=
   type, abstract :: list_t
      integer :: n_entries = 0
   end type list_t
 
 @ %def list_t
 @ Since the contents of the lists are different, we introduce two
 different entry types. Since the trees of nodes use pointers, the nodes
 should only be allocated by a type-bound procedure of the corresponding
 list type, such that we can keep track of all nodes, eventually reuse
 and in the end deallocate nodes correctly, without forgetting any nodes.
 Here is the type for the [[k_nodes]]. The list is a linked list. We want
 to reuse (recycle) the [[k_nodes]] which are neither [[incoming]] nore
 [[t_line]].
 <<Cascades2: types>>=
   type :: k_node_entry_t
      type (k_node_t), pointer :: node => null ()
      type (k_node_entry_t), pointer :: next => null ()
      logical :: recycle = .false.
    contains
    <<Cascades2: k node entry: TBP>>
   end type k_node_entry_t
 
 @ %def k_node_entry_t
 <<Cascades2: k node entry: TBP>>=
   procedure :: final => k_node_entry_final
 <<Cascades2: procedures>>=
   subroutine k_node_entry_final (entry)
     class(k_node_entry_t), intent(inout) :: entry
     if (associated (entry%node)) then
        call entry%node%final
        deallocate (entry%node)
     end if
     entry%next => null ()
   end subroutine k_node_entry_final
 
 @ %def k_node_entry_final
 <<Cascades2: k node entry: TBP>>=
   procedure :: write => k_node_entry_write
 <<Cascades2: procedures>>=
   subroutine k_node_entry_write (k_node_entry, u)
     class (k_node_entry_t), intent (in) :: k_node_entry
     integer, intent (in) :: u
   end subroutine k_node_entry_write
 
 @ %def k_node_entry_write
 @ Here is the list type for [[k_nodes]]. A [[k_node_list]] can be
 declared to be an observer. In this case it does not create any nodes by
 itself, but the entries set their pointers to existing nodes. In this
 way we can use the list structure and the type bound procedures for
 existing nodes.
 <<Cascades2: types>>=
   type, extends (list_t) :: k_node_list_t
      type (k_node_entry_t), pointer :: first => null ()
      type (k_node_entry_t), pointer :: last => null ()
      integer :: n_recycle
      logical :: observer = .false.
    contains
    <<Cascades2: k node list: TBP>>
   end type k_node_list_t
 
 @ %def k_node_list_t
 <<Cascades2: k node list: TBP>>=
   procedure :: final => k_node_list_final
 <<Cascades2: procedures>>=
   subroutine k_node_list_final (list)
     class(k_node_list_t), intent(inout) :: list
     type (k_node_entry_t), pointer :: current
     do while (associated (list%first))
        current => list%first
        list%first => list%first%next
        if (list%observer) current%node => null ()
        call current%final ()
        deallocate (current)
     enddo
   end subroutine k_node_list_final
 
 @ %def k_node_list_final
 @ The [[f_node_t]] type contains the [[particle_label]] variable which is
 extracted from the input file. It consists not only of the particle
 name, but also of some numbers in brackets. These numbers indicate which
 external particles are part of the subtree of this node. The [[f_node]]
 contains also a list of [[k_nodes]]. Therefore, if the nodes are not
 [[incoming]] or [[t_line]], the mapping calculations for these
 [[k_nodes]] which can appear in several [[kingraphs]] have to be
 performed only once.
 <<Cascades2: types>>=
   type, extends (node_t) :: f_node_t
      type (f_node_t), pointer :: daughter1 => null ()
      type (f_node_t), pointer :: daughter2 => null ()
      character (len=LABEL_LEN) :: particle_label
      type (k_node_list_t) :: k_node_list
    contains
    <<Cascades2: f node: TBP>>
   end type f_node_t
 
 @ %def f_node_t
 @ The finalizer nullifies the daughter pointers, since they are
 deallocated, like the [[f_node]] itself, with the finalizer of the
 [[f_node_list]].
 <<Cascades2: f node: TBP>>=
   procedure :: final => f_node_final
 <<Cascades2: procedures>>=
   recursive subroutine f_node_final (node)
     class(f_node_t), intent(inout) :: node
     call node%k_node_list%final ()
     node%daughter1 => null ()
     node%daughter2 => null ()
   end subroutine f_node_final
 
 @ %def f_node_final
 @ Finaliser for [[f_node_entry]].
 <<Cascades2: f node entry: TBP>>=
   procedure :: final => f_node_entry_final
 <<Cascades2: procedures>>=
   subroutine f_node_entry_final (entry)
     class(f_node_entry_t), intent(inout) :: entry
     if (associated (entry%node)) then
        call entry%node%final ()
        deallocate (entry%node)
     end if
     entry%next => null ()
   end subroutine f_node_entry_final
 
 @ %def f_node_entry_final
 @ Set index if not yet done, i.e. if it is zero.
 <<Cascades2: f node: TBP>>=
   procedure :: set_index => f_node_set_index
 <<Cascades2: procedures>>=
   subroutine f_node_set_index (f_node)
     class (f_node_t), intent (inout) :: f_node
     integer, save :: counter = 0
     if (f_node%index == 0) then
        counter = counter + 1
        f_node%index = counter
     end if
   end subroutine f_node_set_index
 
 @ %def f_node_set_index
 @
 Type for the nodes of the tree (lines of the Feynman diagrams). We also need a type containing a
 pointer to a node, which is needed for creating arrays of pointers. This will be used for scattering
 processes where we can take either the first or the second particle to be the root of the tree. Since
 we need both cases for the calculations and O'Mega only gives us one of these, we have to perform a
 transformation of the graph in which some nodes (on the line which we hereafter call t-line) need
 to know their mother and sister nodes, which become their daughters within this transformation.
 <<Cascades2: types>>=
   type :: f_node_ptr_t
      type (f_node_t), pointer :: node => null ()
      contains
        <<Cascades2: f node ptr: TBP>>
   end type f_node_ptr_t
 
 @ %def f_node_ptr_t
 <<Cascades2: f node ptr: TBP>>=
   procedure :: final => f_node_ptr_final
 <<Cascades2: procedures>>=
   subroutine f_node_ptr_final (f_node_ptr)
     class (f_node_ptr_t), intent (inout) :: f_node_ptr
     f_node_ptr%node => null ()
   end subroutine f_node_ptr_final
 
 @ %def f_node_ptr_final
 <<Cascades2: interfaces>>=
   interface assignment (=)
      module procedure f_node_ptr_assign
   end interface assignment (=)
 <<Cascades2: procedures>>=
   subroutine f_node_ptr_assign (ptr1, ptr2)
     type (f_node_ptr_t), intent (out) :: ptr1
     type (f_node_ptr_t), intent (in) :: ptr2
     ptr1%node => ptr2%node
   end subroutine f_node_ptr_assign
 
 @  %def f_node_ptr_assign
 @
 <<Cascades2: types>>=
   type :: k_node_ptr_t
      type (k_node_t), pointer :: node => null ()
   end type k_node_ptr_t
 
 @ %def k_node_ptr_t
 @
 <<Cascades2: types>>=
   type, extends (node_t) :: k_node_t
      type (k_node_t), pointer :: daughter1 => null ()
      type (k_node_t), pointer :: daughter2 => null ()
      type (k_node_t), pointer :: inverse_daughter1 => null ()
      type (k_node_t), pointer :: inverse_daughter2 => null ()
      type (f_node_t), pointer :: f_node => null ()
      type (tree_t) :: subtree
      real (default) :: ext_mass_sum = 0.
      real (default) :: effective_mass = 0.
      logical :: resonant = .false.
      logical :: on_shell = .false.
      logical :: log_enhanced = .false.
      integer :: mapping = NO_MAPPING
      integer(TC) :: bincode = 0
      logical :: mapping_assigned = .false.
      logical :: is_nonresonant_copy = .false.
      logical :: subtree_checked = .false.
      integer :: n_off_shell = 0
      integer :: n_log_enhanced = 0
      integer :: n_resonances = 0
      integer :: multiplicity = 0
      integer :: n_t_channel = 0
      integer :: f_node_index = 0
    contains
    <<Cascades2: k node: TBP>>
   end type k_node_t
 
 @ %def k_node_t
 @
 Subroutine for [[k_node]] assignment.
 <<Cascades2: interfaces>>=
   interface assignment (=)
      module procedure k_node_assign
   end interface assignment (=)
 <<Cascades2: procedures>>=
   subroutine k_node_assign (k_node1, k_node2)
     type (k_node_t), intent (inout) :: k_node1
     type (k_node_t), intent (in) :: k_node2
     k_node1%f_node => k_node2%f_node
     k_node1%particle => k_node2%particle
     k_node1%incoming = k_node2%incoming
     k_node1%t_line = k_node2%t_line
     k_node1%keep = k_node2%keep
     k_node1%n_subtree_nodes = k_node2%n_subtree_nodes
     k_node1%ext_mass_sum = k_node2%ext_mass_sum
     k_node1%effective_mass = k_node2%effective_mass
     k_node1%resonant = k_node2%resonant
     k_node1%on_shell = k_node2%on_shell
     k_node1%log_enhanced = k_node2%log_enhanced
     k_node1%mapping = k_node2%mapping
     k_node1%bincode = k_node2%bincode
     k_node1%mapping_assigned = k_node2%mapping_assigned
     k_node1%is_nonresonant_copy = k_node2%is_nonresonant_copy
     k_node1%n_off_shell = k_node2%n_off_shell
     k_node1%n_log_enhanced = k_node2%n_log_enhanced
     k_node1%n_resonances = k_node2%n_resonances
     k_node1%multiplicity = k_node2%multiplicity
     k_node1%n_t_channel = k_node2%n_t_channel
     k_node1%f_node_index = k_node2%f_node_index
   end subroutine k_node_assign
 
 @  %def k_node_assign
 @ The finalizer of [[k_node_t]] nullifies all pointers to nodes, since the
 deallocation of these nodes takes place in the finalizer of the list by which
 they were created.
 <<Cascades2: k node: TBP>>=
   procedure :: final => k_node_final
 <<Cascades2: procedures>>=
   recursive subroutine k_node_final (k_node)
     class(k_node_t), intent(inout) :: k_node
     k_node%daughter1 => null ()
     k_node%daughter2 => null ()
     k_node%inverse_daughter1 => null ()
     k_node%inverse_daughter2 => null ()
     k_node%f_node => null ()
   end subroutine k_node_final
 
 @ %def k_node_final
 @ Set an index to a [[k_node]], if not yet done, i.e. if it is zero. The
 indices are simply positive integer numbers starting from 1.
 <<Cascades2: k node: TBP>>=
   procedure :: set_index => k_node_set_index
 <<Cascades2: procedures>>=
   subroutine k_node_set_index (k_node)
     class (k_node_t), intent (inout) :: k_node
     integer, save :: counter = 0
     if (k_node%index == 0) then
        counter = counter + 1
        k_node%index = counter
     end if
   end subroutine k_node_set_index
 
 @ %def k_node_set_index
 @ The process type (decay or scattering) is given by an integer which is
 equal to the number of incoming particles.
 <<Cascades2: public>>=
   public :: DECAY, SCATTERING
 <<Cascades2: parameters>>=
   integer, parameter :: DECAY=1, SCATTERING=2
 
 @ %def decay scattering
 @ The entries of the [[f_node_list]] contain the substring of the input
 file from which the node's subtree will be constructed (or a modified
 string containing placeholders for substrings). We use the
 length of this string for fast comparison to find the nodes in the
 [[f_node_list]] which we want to reuse.
 <<Cascades2: types>>=
   type :: f_node_entry_t
      character (len=FEYNGRAPH_LEN) :: subtree_string
      integer :: string_len = 0
      type (f_node_t), pointer :: node => null ()
      type (f_node_entry_t), pointer :: next => null ()
      integer :: subtree_size = 0
    contains
    <<Cascades2: f node entry: TBP>>
   end type f_node_entry_t
 
 @ %def f_node_entry_t
 @ A write method for [[f_node_entry]].
 <<Cascades2: f node entry: TBP>>=
   procedure :: write => f_node_entry_write
 <<Cascades2: procedures>>=
   subroutine f_node_entry_write (f_node_entry, u)
     class (f_node_entry_t), intent (in) :: f_node_entry
     integer, intent (in) :: u
     write (unit=u, fmt='(A)') trim(f_node_entry%subtree_string)
   end subroutine f_node_entry_write
 
 @ %def f_node_entry_write
 <<Cascades2: interfaces>>=
   interface assignment (=)
      module procedure f_node_entry_assign
   end interface assignment (=)
 <<Cascades2: procedures>>=
   subroutine f_node_entry_assign (entry1, entry2)
     type (f_node_entry_t), intent (out) :: entry1
     type (f_node_entry_t), intent (in) :: entry2
     entry1%node => entry2%node
     entry1%subtree_string = entry2%subtree_string
     entry1%string_len = entry2%string_len
     entry1%subtree_size = entry2%subtree_size
   end subroutine f_node_entry_assign
 
 @ %def f_node_entry_assign
 @ This is the list type for [[f_nodes]]. The variable [[max_tree_size]]
 is the number of nodes which appear in a complete graph.
 <<Cascades2: types>>=
   type, extends (list_t) :: f_node_list_t
      type (f_node_entry_t), pointer :: first => null ()
      type (f_node_entry_t), pointer :: last => null ()
      type (k_node_list_t), pointer :: k_node_list => null ()
      integer :: max_tree_size = 0
    contains
    <<Cascades2: f node list: TBP>>
   end type f_node_list_t
 
 @ %def f_node_list_t
 @ Add an entry to the [[f_node_list]]. If the node might be reused, we check first
 using the [[subtree_string]] if there is already a node in the list which
 is the root of exactly the same subtree. Otherwise we add an entry to the
 list and allocate the node. In both cases we return a pointer to the node
 which allows to access the node.
 <<Cascades2: f node list: TBP>>=
   procedure :: add_entry => f_node_list_add_entry
 <<Cascades2: procedures>>=
   subroutine f_node_list_add_entry (list, subtree_string, ptr_to_node, &
        recycle, subtree_size)
     class (f_node_list_t), intent (inout) :: list
     character (len=*), intent (in) :: subtree_string
     type (f_node_t), pointer, intent (out) :: ptr_to_node
     logical, intent (in) :: recycle
     integer, intent (in), optional :: subtree_size
     type (f_node_entry_t), pointer :: current
     type (f_node_entry_t), pointer :: second
     integer :: subtree_len
     ptr_to_node => null ()
     if (recycle) then
        subtree_len = len_trim (subtree_string)
        current => list%first
        do while (associated (current))
           if (present (subtree_size)) then
              if (current%subtree_size /= subtree_size) exit
           end if
           if (current%string_len == subtree_len) then
              if (trim (current%subtree_string) == trim (subtree_string)) then
                 ptr_to_node => current%node
                 exit
              end if
           end if
           current => current%next
        enddo
     end if
     if (.not. associated (ptr_to_node)) then
        if (list%n_entries == 0) then
           allocate (list%first)
           list%last => list%first
        else
           second => list%first
           list%first => null ()
           allocate (list%first)
           list%first%next => second
        end if
        list%n_entries = list%n_entries + 1
        list%first%subtree_string = trim(subtree_string)
        list%first%string_len = subtree_len
        if (present (subtree_size)) list%first%subtree_size = subtree_size
        allocate (list%first%node)
        call list%first%node%set_index ()
        ptr_to_node => list%first%node
     end if
   end subroutine f_node_list_add_entry
 
 @ %def f_node_list_add_entry
 @ A write method for debugging.
 <<Cascades2: f node list: TBP>>=
   procedure :: write => f_node_list_write
 <<Cascades2: procedures>>=
   subroutine f_node_list_write (f_node_list, u)
     class (f_node_list_t), intent (in) :: f_node_list
     integer, intent (in) :: u
     type (f_node_entry_t), pointer :: current
     integer :: pos = 0
     current => f_node_list%first
     do while (associated (current))
        pos = pos + 1
        write (unit=u, fmt='(A,I10)') 'entry #: ', pos
        call current%write (u)
        write (unit=u, fmt=*)
        current => current%next
     enddo
   end subroutine f_node_list_write
 
 @ %def f_node_list_write
 <<Cascades2: interfaces>>=
   interface assignment (=)
      module procedure k_node_entry_assign
   end interface assignment (=)
 <<Cascades2: procedures>>=
   subroutine k_node_entry_assign (entry1, entry2)
     type (k_node_entry_t), intent (out) :: entry1
     type (k_node_entry_t), intent (in) :: entry2
     entry1%node => entry2%node
     entry1%recycle = entry2%recycle
   end subroutine k_node_entry_assign
 
 @ %def k_node_entry_assign
 @ Add an entry to the [[k_node_list]]. We have to specify if the
 node can be reused. The check for existing reusable nodes happens with
 [[k_node_list_get_nodes]] (see below).
 <<Cascades2: k node list: TBP>>=
   procedure :: add_entry => k_node_list_add_entry
 <<Cascades2: procedures>>=
   recursive subroutine k_node_list_add_entry (list, ptr_to_node, recycle)
     class (k_node_list_t), intent (inout) :: list
     type (k_node_t), pointer, intent (out) :: ptr_to_node
     logical, intent (in) :: recycle
     if (list%n_entries == 0) then
        allocate (list%first)
        list%last => list%first
     else
        allocate (list%last%next)
        list%last => list%last%next
     end if
     list%n_entries = list%n_entries + 1
     list%last%recycle = recycle
     allocate (list%last%node)
     call list%last%node%set_index ()
     ptr_to_node => list%last%node
   end subroutine k_node_list_add_entry
 
 @ %def k_node_list_add_entry
 @ We need a similar subroutine for adding only a pointer to a list. This
 is needed for a [[k_node_list]] which is only an observer, i.e. it does
 not create any nodes by itself.
 <<Cascades2: k node list: TBP>>=
   procedure :: add_pointer => k_node_list_add_pointer
 <<Cascades2: procedures>>=
   subroutine k_node_list_add_pointer (list, ptr_to_node, recycle)
     class (k_node_list_t), intent (inout) :: list
     type (k_node_t), pointer, intent (in) :: ptr_to_node
     logical, optional, intent (in) :: recycle
     logical :: rec
     if (present (recycle)) then
        rec = recycle
     else
        rec = .false.
     end if
     if (list%n_entries == 0) then
        allocate (list%first)
        list%last => list%first
     else
        allocate (list%last%next)
        list%last => list%last%next
     end if
     list%n_entries = list%n_entries + 1
     list%last%recycle = rec
     list%last%node => ptr_to_node
   end subroutine k_node_list_add_pointer
 
 @ %def k_node_list_add_pointer
 @ The [[k_node_list]] can also be used to collect [[k_nodes]] which belong to
 different [[f_nodes]] in order to compare these. This is done only for nodes
 which have the same number of subtree nodes. We compare all nodes of the
 list with each other (as long as the node is not deactivated, i.e. if
 the [[keep]] variable is set to [[.true.]]) using the subroutine
 [[subtree_select]]. If it turns out that two nodes are equivalent, we
 keep only one of them. The term equivalent in this module refers to trees
 or subtrees which differ in the pdg codes at positions where
 the trivial mapping is used ([[NO_MAPPING]] or [[NON_RESONANT]]) so that
 the mass of the particle does not matter. Depending on the available
 couplings, two equivalent subtrees could eventually lead to the same phase
 space channels, which is why only one of them is kept.
 <<Cascades2: k node list: TBP>>=
   procedure :: check_subtree_equivalences => k_node_list_check_subtree_equivalences
 <<Cascades2: procedures>>=
   subroutine k_node_list_check_subtree_equivalences (list, model)
     class (k_node_list_t), intent (inout) :: list
     type (model_data_t), intent (in) :: model
     type (k_node_ptr_t), dimension (:), allocatable :: set
     type (k_node_entry_t), pointer :: current
     integer :: pos
     integer :: i,j
     if (list%n_entries == 0) return
     allocate (set (list%n_entries))
     current => list%first
     pos = 0
     do while (associated (current))
        pos = pos + 1
        set(pos)%node => current%node
        current => current%next
     enddo
     do i=1, list%n_entries
        if (set(i)%node%keep) then
           do j=i+1, list%n_entries
              if (set(j)%node%keep) then
                 if (set(i)%node%bincode == set(j)%node%bincode) then
                    call subtree_select (set(i)%node%subtree,set(j)%node%subtree, model)
                    if (.not. set(i)%node%subtree%keep) then
                       set(i)%node%keep = .false.
                       exit
                    else if (.not. set(j)%node%subtree%keep) then
                       set(j)%node%keep = .false.
                    end if
                 end if
              end if
           enddo
        end if
     enddo
     deallocate (set)
   end subroutine k_node_list_check_subtree_equivalences
 
 @ %def k_node_list_check_subtree_equivalences
 @ This subroutine is used to obtain all [[k_nodes]] of a [[k_node_list]]
 which can be recycled and are not disabled for some reason. We pass an
 allocatable array of the type [[k_node_ptr_t]] which will be allocated
 if there are any such nodes in the list and the pointers will be
 associated with these nodes.
 <<Cascades2: k node list: TBP>>=
   procedure :: get_nodes => k_node_list_get_nodes
 <<Cascades2: procedures>>=
   subroutine k_node_list_get_nodes (list, nodes)
     class (k_node_list_t), intent (inout) :: list
     type (k_node_ptr_t), dimension(:), allocatable, intent (out) :: nodes
     integer :: n_nodes
     integer :: pos
     type (k_node_entry_t), pointer :: current, garbage
     n_nodes = 0
     current => list%first
     do while (associated (current))
        if (current%recycle .and. current%node%keep) n_nodes = n_nodes + 1
        current => current%next
     enddo
     if (n_nodes /= 0) then
        pos = 1
        allocate (nodes (n_nodes))
        do while (associated (list%first) .and. .not. list%first%node%keep)
           garbage => list%first
           list%first => list%first%next
           call garbage%final ()
           deallocate (garbage)
        enddo
        current => list%first
        do while (associated (current))
           do while (associated (current%next))
              if (.not. current%next%node%keep) then
                 garbage => current%next
                 current%next => current%next%next
                 call garbage%final
                 deallocate (garbage)
              else
                 exit
              end if
           enddo
           if (current%recycle .and. current%node%keep) then
              nodes(pos)%node => current%node
              pos = pos + 1
           end if
           current => current%next
        enddo
     end if
   end subroutine k_node_list_get_nodes
 
 @ %def k_node_list_get_nodes
 <<Cascades2: f node list: TBP>>=
   procedure :: final => f_node_list_final
 <<Cascades2: procedures>>=
   subroutine f_node_list_final (list)
     class (f_node_list_t) :: list
     type (f_node_entry_t), pointer :: current
     list%k_node_list => null ()
     do while (associated (list%first))
        current => list%first
        list%first => list%first%next
        call current%final ()
        deallocate (current)
     enddo
   end subroutine f_node_list_final
 
 @ %def f_node_list_final
 @
 \subsection{The grove list}
 First a type is introduced in order to speed up the comparison of kingraphs
 with the purpose to quickly find the graphs that might be equivalent.
 This is done solely on the basis of a number (which is given
 by the value of [[depth]] in [[compare_tree_t]]) of bincodes, which are
 the highest ones that do not belong to external particles.
 The highest such value determines the index of the element in the [[entry]]
 array of the [[compare_tree]]. The next lower such value determines
 the index of the element in the [[entry]] array of this [[entry]], and so
 on and so forth. This results in a tree structure where the number of
 levels is given by [[depth]] and should not be too large for reasons of
 memory.
 This is the entry type.
 <<Cascades2: types>>=
   type :: compare_tree_entry_t
      type (compare_tree_entry_t), dimension(:), pointer :: entry => null ()
      type (kingraph_ptr_t), dimension(:), allocatable :: graph_entry
    contains
      <<Cascades2: compare tree entry: TBP>>
   end type compare_tree_entry_t
 
 @ %def compare_tree_entry_t
 @ This is the tree type.
 <<Cascades2: types>>=
   type :: compare_tree_t
     integer :: depth = 3
     type (compare_tree_entry_t), dimension(:), pointer :: entry => null ()
   contains
     <<Cascades2: compare tree: TBP>>
   end type compare_tree_t
 
 @ %def compare_tree_t
 @ Finalizers for both types. The one for the entry type has to be recursive.
 <<Cascades2: compare tree: TBP>>=
   procedure :: final => compare_tree_final
 <<Cascades2: procedures>>=
   subroutine compare_tree_final (ctree)
     class (compare_tree_t), intent (inout) :: ctree
     integer :: i
     if (associated (ctree%entry)) then
        do i=1, size (ctree%entry)
           call ctree%entry(i)%final ()
           deallocate (ctree%entry)
        end do
     end if
   end subroutine compare_tree_final
 
 @ %def compare_tree_final
 <<Cascades2: compare tree entry: TBP>>=
   procedure :: final => compare_tree_entry_final
 <<Cascades2: procedures>>=
   recursive subroutine compare_tree_entry_final (ct_entry)
     class (compare_tree_entry_t), intent (inout) :: ct_entry
     integer :: i
     if (associated (ct_entry%entry)) then
        do i=1, size (ct_entry%entry)
           call ct_entry%entry(i)%final ()
        enddo
        deallocate (ct_entry%entry)
     else
        deallocate (ct_entry%graph_entry)
     end if
   end subroutine compare_tree_entry_final
 
 @ %def compare_tree_entry_final
 @ Check the presence of a graph which is considered as equivalent and
 select between the two. If there is no such graph, the current one
 is added to the list. First the entry has to be found:
 <<Cascades2: compare tree: TBP>>=
   procedure :: check_kingraph => compare_tree_check_kingraph
 <<Cascades2: procedures>>=
   subroutine compare_tree_check_kingraph (ctree, kingraph, model, preliminary)
     class (compare_tree_t), intent (inout) :: ctree
     type (kingraph_t), intent (inout), pointer :: kingraph
     type (model_data_t), intent (in) :: model
     logical, intent (in) :: preliminary
     integer :: i
     integer :: pos
     integer(TC) :: sz
     integer(TC), dimension(:), allocatable :: identifier
     if (.not. associated (ctree%entry)) then
        sz = 0_TC
        do i = size(kingraph%tree%bc), 1, -1
           sz = ior (sz, kingraph%tree%bc(i))
        enddo
        if (sz > 0) then
           allocate (ctree%entry (sz))
        else
           call msg_bug ("Compare tree could not be created")
        end if
     end if
     allocate (identifier (ctree%depth))
     pos = 0
     do i = size(kingraph%tree%bc), 1, -1
        if (popcnt (kingraph%tree%bc(i)) /= 1) then
           pos = pos + 1
           identifier(pos) = kingraph%tree%bc(i)
           if (pos == ctree%depth) exit
        end if
     enddo
     if (size (identifier) > 1) then
        call ctree%entry(identifier(1))%check_kingraph (kingraph, model, &
             preliminary, identifier(1), identifier(2:))
     else if (size (identifier) == 1) then
        call ctree%entry(identifier(1))%check_kingraph (kingraph, model, preliminary)
     end if
     deallocate (identifier)
   end subroutine compare_tree_check_kingraph
 
 @ %def compare_tree_check_kingraph
 @ Then the graphs of the entry are checked.
 <<Cascades2: compare tree entry: TBP>>=
   procedure :: check_kingraph => compare_tree_entry_check_kingraph
 <<Cascades2: procedures>>=
   recursive subroutine compare_tree_entry_check_kingraph (ct_entry, kingraph, &
        model, preliminary, subtree_size, identifier)
     class (compare_tree_entry_t), intent (inout) :: ct_entry
     type (kingraph_t), pointer, intent (inout) :: kingraph
     type (model_data_t), intent (in) :: model
     logical, intent (in) :: preliminary
     integer, intent (in), optional :: subtree_size
     integer, dimension (:), intent (in), optional :: identifier
     if (present (identifier)) then
        if (.not. associated (ct_entry%entry)) &
             allocate (ct_entry%entry(subtree_size))
        if (size (identifier) > 1) then
           call ct_entry%entry(identifier(1))%check_kingraph (kingraph, &
                model, preliminary, identifier(1), identifier(2:))
        else if (size (identifier) == 1) then
           call ct_entry%entry(identifier(1))%check_kingraph (kingraph, &
                model, preliminary)
        end if
     else
        if (allocated (ct_entry%graph_entry)) then
           call perform_check
        else
           allocate (ct_entry%graph_entry(1))
           ct_entry%graph_entry(1)%graph => kingraph
        end if
     end if
 
     contains
 
       subroutine perform_check
         integer :: i
         logical :: rebuild
         rebuild = .true.
         do i=1, size(ct_entry%graph_entry)
            if (ct_entry%graph_entry(i)%graph%keep) then
               if (preliminary .or. &
                    ct_entry%graph_entry(i)%graph%prc_component /= kingraph%prc_component) then
                  call kingraph_select (ct_entry%graph_entry(i)%graph, kingraph, model, preliminary)
                  if (.not. kingraph%keep) then
                     return
                  else if (rebuild .and. .not. ct_entry%graph_entry(i)%graph%keep) then
                     ct_entry%graph_entry(i)%graph => kingraph
                     rebuild = .false.
                  end if
               end if
            end if
         enddo
         if (rebuild) call rebuild_graph_entry
       end subroutine perform_check
 
       subroutine rebuild_graph_entry
         type (kingraph_ptr_t), dimension(:), allocatable :: tmp_ptr
         integer :: i
         integer :: pos
         allocate (tmp_ptr(size(ct_entry%graph_entry)+1))
         pos = 0
         do i=1, size(ct_entry%graph_entry)
            pos = pos + 1
            tmp_ptr(pos)%graph => ct_entry%graph_entry(i)%graph
         enddo
         pos = pos + 1
         tmp_ptr(pos)%graph => kingraph
         deallocate (ct_entry%graph_entry)
         allocate (ct_entry%graph_entry (pos))
         do i=1, pos
            ct_entry%graph_entry(i)%graph => tmp_ptr(i)%graph
         enddo
         deallocate (tmp_ptr)
       end subroutine rebuild_graph_entry
   end subroutine compare_tree_entry_check_kingraph
 
 @ %def compare_tree_entry_check_kingraph
 @ The grove to which a completed [[kingraph]] will be added is determined by the
 entries of [[grove_prop]]. We use another list type (linked list) to
 arrange the groves. Each [[grove]] contains again a linked list of
 [[kingraphs]].
 <<Cascades2: types>>=
   type :: grove_t
      type (grove_prop_t) :: grove_prop
      type (grove_t), pointer :: next => null ()
      type (kingraph_t), pointer :: first => null ()
      type (kingraph_t), pointer :: last => null ()
      type (compare_tree_t) :: compare_tree
    contains
    <<Cascades2: grove: TBP>>
   end type grove_t
 
 @ %def grove_t
 @ Container for a pointer of type [[grove_t]]:
 <<Cascades2: types>>=
   type :: grove_ptr_t
      type (grove_t), pointer :: grove => null ()
   end type grove_ptr_t
 
 @ %def grove_ptr_t
 <<Cascades2: grove: TBP>>=
   procedure :: final => grove_final
 <<Cascades2: procedures>>=
   subroutine grove_final (grove)
     class(grove_t), intent(inout) :: grove
     grove%first => null ()
     grove%last  => null ()
     grove%next => null ()
   end subroutine grove_final
 
 @ %def grove_final
 @ This is the list type:
 <<Cascades2: types>>=
   type :: grove_list_t
      type (grove_t), pointer :: first => null ()
    contains
    <<Cascades2: grove list: TBP>>
   end type grove_list_t
 
 @ %def grove_list_t
 <<Cascades2: grove list: TBP>>=
   procedure :: final => grove_list_final
 <<Cascades2: procedures>>=
   subroutine grove_list_final (list)
     class(grove_list_t), intent(inout) :: list
     class(grove_t), pointer :: current
     do while (associated (list%first))
        current => list%first
        list%first => list%first%next
        call current%final ()
        deallocate (current)
     end do
   end subroutine grove_list_final
 
 @ %def grove_list_final
 @
 \subsection{The feyngraph set}
 The fundament of the module is the public type [[feyngraph_set_t]]. It
 is not only a linked list of all [[feyngraphs]] but contains an array
 of all particle properties ([[particle]]), an [[f_node_list]] and a
 pointer of the type [[grove_list_t]], since several [[feyngraph_sets]]
 can share a common [[grove_list]]. In addition it keeps the data which
 unambiguously specifies the process, as well as the model which
 provides information which allows us to choose between equivalent
 subtrees or complete [[kingraphs]].
 <<Cascades2: public>>=
   public :: feyngraph_set_t
 <<Cascades2: types>>=
   type :: feyngraph_set_t
      type (model_data_t), pointer :: model => null ()
      type(flavor_t), dimension(:,:), allocatable :: flv
      integer :: n_in = 0
      integer :: n_out = 0
      integer :: process_type = DECAY
      type (phs_parameters_t) :: phs_par
      logical :: fatal_beam_decay = .true.
      type (part_prop_t), dimension (:), pointer :: particle => null ()
      type (f_node_list_t) :: f_node_list
      type (feyngraph_t), pointer :: first => null ()
      type (feyngraph_t), pointer :: last => null ()
      integer :: n_graphs = 0
      type (grove_list_t), pointer :: grove_list => null ()
      logical :: use_dag = .true.
      type (dag_t), pointer :: dag => null ()
      type (feyngraph_set_t), dimension (:), pointer :: fset => null ()
    contains
    <<Cascades2: feyngraph set: TBP>>
   end type feyngraph_set_t
 
 @ %def feyngraph_set_t
 @ This final procedure contains calls to all other necessary final
 procedures.
 <<Cascades2: feyngraph set: TBP>>=
   procedure :: final => feyngraph_set_final
 <<Cascades2: procedures>>=
   recursive subroutine feyngraph_set_final (set)
     class(feyngraph_set_t), intent(inout) :: set
     class(feyngraph_t), pointer :: current
     integer :: i
     if (associated (set%fset)) then
        do i=1, size (set%fset)
           call set%fset(i)%final ()
        enddo
        deallocate (set%fset)
     else
        set%particle => null ()
        set%grove_list => null ()
     end if
     set%model => null ()
     if (allocated (set%flv)) deallocate (set%flv)
     set%last => null ()
     do while (associated (set%first))
        current => set%first
        set%first => set%first%next
        call current%final ()
        deallocate (current)
     end do
     if (associated (set%particle)) then
        do i = 1, size (set%particle)
           call set%particle(i)%final ()
        end do
        deallocate (set%particle)
     end if
     if (associated (set%grove_list)) then
        call msg_debug (D_PHASESPACE, "grove_list: final")
        call set%grove_list%final ()
        deallocate (set%grove_list)
     end if
     call msg_debug (D_PHASESPACE, "f_node_list: final")
     call set%f_node_list%final ()
     if (associated (set%dag)) then
        call msg_debug (D_PHASESPACE, "dag: final")
        if (associated (set%dag)) then
           call set%dag%final ()
           deallocate (set%dag)
        end if
     end if
   end subroutine feyngraph_set_final
 
 @ %def feyngraph_set_final
 @
 \subsection{Construct the feyngraph set}
 We construct the [[feyngraph_set]] from an input file. Therefore we pass
 a unit to [[feyngraph_set_build]]. The parsing subroutines are chosen
 depending on the value of [[use_dag]]. In the DAG output, which is the one
 that is produced by default, we have to work on a string of one line,
 where the lenght of this string becomes larger the more particles are
 involved in the process. The other output (which is now only used in a
 unit test) contains one Feynman diagram per line and each line starts with an open
 parenthesis so that we read the file line per line and create a
 [[feyngraph]] for every line. Only after this, nodes are created. In both
 decay and scattering processes the diagrams are represented like in a decay
 process, i.e. in a scattering process one of the incoming particles appears
 as an outgoing particle.
 <<Cascades2: feyngraph set: TBP>>=
   procedure :: build => feyngraph_set_build
 <<Cascades2: procedures>>=
   subroutine feyngraph_set_build (feyngraph_set, u_in)
     class (feyngraph_set_t), intent (inout) :: feyngraph_set
     integer, intent (in) :: u_in
     integer :: stat = 0
     character (len=FEYNGRAPH_LEN) :: omega_feyngraph_output
     type (feyngraph_t), pointer :: current_graph
     type (feyngraph_t), pointer :: compare_graph
     logical :: present
     if (feyngraph_set%use_dag) then
        allocate (feyngraph_set%dag)
        if (.not. associated (feyngraph_set%first)) then
           call feyngraph_set%dag%read_string (u_in, feyngraph_set%flv(:,1))
           call feyngraph_set%dag%construct (feyngraph_set)
           call feyngraph_set%dag%make_feyngraphs (feyngraph_set)
        end if
     else
        if (.not. associated (feyngraph_set%first)) then
           read (unit=u_in, fmt='(A)', iostat=stat, advance='yes') omega_feyngraph_output
           if (omega_feyngraph_output(1:1) == '(') then
              allocate (feyngraph_set%first)
              feyngraph_set%first%omega_feyngraph_output = trim(omega_feyngraph_output)
              feyngraph_set%last => feyngraph_set%first
              feyngraph_set%n_graphs = feyngraph_set%n_graphs + 1
           else
              call msg_fatal ("Invalid input file")
           end if
           read (unit=u_in, fmt='(A)', iostat=stat, advance='yes') omega_feyngraph_output
           do while (stat == 0)
              if (omega_feyngraph_output(1:1) == '(') then
                 compare_graph => feyngraph_set%first
                 present = .false.
                 do while (associated (compare_graph))
                    if (len_trim(compare_graph%omega_feyngraph_output) &
                         == len_trim(omega_feyngraph_output)) then
                       if (compare_graph%omega_feyngraph_output == omega_feyngraph_output) then
                          present = .true.
                          exit
                       end if
                    end if
                    compare_graph => compare_graph%next
                 enddo
                 if (.not. present) then
                    allocate (feyngraph_set%last%next)
                    feyngraph_set%last => feyngraph_set%last%next
                    feyngraph_set%last%omega_feyngraph_output = trim(omega_feyngraph_output)
                    feyngraph_set%n_graphs = feyngraph_set%n_graphs + 1
                 end if
                 read (unit=u_in, fmt='(A)', iostat=stat, advance='yes') omega_feyngraph_output
              else
                 exit
              end if
           enddo
           current_graph => feyngraph_set%first
           do while (associated (current_graph))
              call feyngraph_construct (feyngraph_set, current_graph)
              current_graph => current_graph%next
           enddo
           feyngraph_set%f_node_list%max_tree_size = feyngraph_set%first%n_nodes
        end if
     end if
   end subroutine feyngraph_set_build
 
 @ %def feyngraph_set_build
 @ Read the string from the file. The output which is produced by O'Mega
 contains the DAG in a factorised form as a long string, distributed over
 several lines (in addition, in the case of a scattering process, it
 contains a similar string for the same process, but with the other
 incoming particle as the root of the tree structure). In general, such a
 file can contain many of these strings, belonging to different process
 components. Therefore we first have to find the correct position of the
 string for the process in question. Therefore we look for a line
 containing a pair of colons, in which case the line contains a process
 string. Then we check if the process string describes the correct
 process, which is done by checking for all the incoming and outgoing
 particle names. If the process is correct, the dag output should start
 in the following line. As long as we do not find the correct process
 string, we continue searching. If we reach the end of the file, we
 rewind the unit once, and repeat searching. If the process is still not
 found, there must be some sort of error.
 <<Cascades2: dag: TBP>>=
   procedure :: read_string => dag_read_string
 <<Cascades2: procedures>>=
   subroutine dag_read_string (dag, u_in, flv)
     class (dag_t), intent (inout) :: dag
     integer, intent (in) :: u_in
     type(flavor_t), dimension(:), intent(in) :: flv
     character (len=BUFFER_LEN) :: process_string
     logical :: process_found
     logical :: rewound
 !!! find process string in file
     process_found = .false.
     rewound = .false.
     do while (.not. process_found)
        process_string = ""
        read (unit=u_in, fmt='(A)') process_string
        if (len_trim(process_string) /= 0) then
           if (index (process_string, "::") > 0) then
              process_found = process_string_match (trim (process_string), flv)
           end if
        else if (.not. rewound) then
           rewind (u_in)
           rewound = .true.
        else
           call msg_bug ("Process string not found in O'Mega input file.")
        end if
     enddo
     call fds_file_get_line (u_in, dag%string)
     call dag%string%clean ()
     if (.not. allocated (dag%string%t) .or. dag%string%char_len == 0) &
          call msg_bug ("Process string not found in O'Mega input file.")
   end subroutine dag_read_string
 
 @ %def dag_read_string
 @ The output of factorized Feynman diagrams which is created by O'Mega
 for a given process could in principle be written to a single line in
 the file. This can however lead to different problems with different
 compilers as soon as such lines become too long. This is the reason why
 the line is cut into smaller pieces. This means that a new line starts
 after each vertical bar. For this long string the type [[dag_string_t]]
 has been introduced. In order to read the file quickly into such a
 [[dag_string]] we use another type, [[dag_chain_t]] which is a linked
 list of such [[dag_strings]]. This has the advantage that we do not
 have to recreate a new [[dag_string]] for every line which has been
 read from file. Only in the end of this operation we compress the
 list of strings to a single string, removing useless [[dag_tokens]],
 such as blanc space tokens. This subroutine reads all lines starting
 from the position in the file the unit is connected to, until no
 backslash character is found at the end of a line (the backslash
 means that the next line also belongs to the current string).
 <<Cascades2: parameters>>=
   integer, parameter :: BUFFER_LEN = 1000
   integer, parameter :: STACK_SIZE = 100
 @ %def BUFFER_LEN STACK_SIZE
 <<Cascades2: procedures>>=
   subroutine fds_file_get_line (u, string)
     integer, intent (in) :: u
     type (dag_string_t), intent (out) :: string
     type (dag_chain_t) :: chain
     integer :: string_size, current_len
     character (len=BUFFER_LEN) :: buffer
     integer :: fragment_len
     integer :: stat
     current_len = 0
     stat = 0
     string_size = 0
     do while (stat == 0)
        read (unit=u, fmt='(A)', iostat=stat) buffer
        if (stat /= 0) exit
        fragment_len = len_trim (buffer)
        if (fragment_len == 0) then
           exit
        else if (buffer (fragment_len:fragment_len) == BACKSLASH_CHAR) then
           fragment_len = fragment_len - 1
        end if
        call chain%append (buffer(:fragment_len))
        if (buffer(fragment_len+1:fragment_len+1) /= BACKSLASH_CHAR) exit
     enddo
     if (associated (chain%first)) then
        call chain%compress ()
        string = chain%first
        call chain%final ()
     end if
   end subroutine fds_file_get_line
 
 @ %def fds_file_get_line
 @ We check, if the process string which has been read from file
 corresponds to the process for which we want to extract the Feynman
 diagrams.
 <<Cascades2: procedures>>=
   function process_string_match (string, flv) result (match)
     character (len=*), intent(in) :: string
     type(flavor_t), dimension(:), intent(in) :: flv
     logical :: match
     integer :: pos
     integer :: occurence
     integer :: i
     pos = 1
     match = .false.
     do i=1, size (flv)
        occurence = index (string(pos:), char(flv(i)%get_name()))
        if (occurence > 0) then
           pos = pos + occurence
           match = .true.
        else
           match = .false.
           exit
        end if
     enddo
   end function process_string_match
 
 @ %def process_string_match
 @
 \subsection{Particle properties}
 This subroutine initializes a model instance with the Standard Model
 data. It is only relevant for a unit test.
 We do not have to care about the model initialization in this module
 because the [[model]] is passed to [[feyngraph_set_generate]] when
 it is called.
 <<Cascades2: public>>=
   public :: init_sm_full_test
 <<Cascades2: procedures>>=
   subroutine init_sm_full_test (model)
     class(model_data_t), intent(out) :: model
     type(field_data_t), pointer :: field
     integer, parameter :: n_real = 17
     integer, parameter :: n_field = 21
     integer, parameter :: n_vtx = 56
     integer :: i
     call model%init (var_str ("SM_vertex_test"), &
          n_real, 0, n_field, n_vtx)
     call model%init_par (1, var_str ("mZ"), 91.1882_default)
     call model%init_par (2, var_str ("mW"), 80.419_default)
     call model%init_par (3, var_str ("mH"), 125._default)
     call model%init_par (4, var_str ("me"), 0.000510997_default)
     call model%init_par (5, var_str ("mmu"), 0.105658389_default)
     call model%init_par (6, var_str ("mtau"), 1.77705_default)
     call model%init_par (7, var_str ("ms"), 0.095_default)
     call model%init_par (8, var_str ("mc"), 1.2_default)
     call model%init_par (9, var_str ("mb"), 4.2_default)
     call model%init_par (10, var_str ("mtop"), 173.1_default)
     call model%init_par (11, var_str ("wtop"), 1.523_default)
     call model%init_par (12, var_str ("wZ"), 2.443_default)
     call model%init_par (13, var_str ("wW"), 2.049_default)
     call model%init_par (14, var_str ("wH"), 0.004143_default)
     call model%init_par (15, var_str ("ee"), 0.3079561542961_default)
     call model%init_par (16, var_str ("cw"), 8.819013863636E-01_default)
     call model%init_par (17, var_str ("sw"), 4.714339240339E-01_default)
     i = 0
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("D_QUARK"), 1)
     call field%set (spin_type=2, color_type=3, charge_type=-2, isospin_type=-2)
     call field%set (name = [var_str ("d")], anti = [var_str ("dbar")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("U_QUARK"), 2)
     call field%set (spin_type=2, color_type=3, charge_type=3, isospin_type=2)
     call field%set (name = [var_str ("u")], anti = [var_str ("ubar")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("S_QUARK"), 3)
     call field%set (spin_type=2, color_type=3, charge_type=-2, isospin_type=-2)
     call field%set (mass_data=model%get_par_real_ptr (7))
     call field%set (name = [var_str ("s")], anti = [var_str ("sbar")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("C_QUARK"), 4)
     call field%set (spin_type=2, color_type=3, charge_type=3, isospin_type=2)
     call field%set (mass_data=model%get_par_real_ptr (8))
     call field%set (name = [var_str ("c")], anti = [var_str ("cbar")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("B_QUARK"), 5)
     call field%set (spin_type=2, color_type=3, charge_type=-2, isospin_type=-2)
     call field%set (mass_data=model%get_par_real_ptr (9))
     call field%set (name = [var_str ("b")], anti = [var_str ("bbar")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("T_QUARK"), 6)
     call field%set (spin_type=2, color_type=3, charge_type=3, isospin_type=2)
     call field%set (mass_data=model%get_par_real_ptr (10))
     call field%set (width_data=model%get_par_real_ptr (11))
     call field%set (name = [var_str ("t")], anti = [var_str ("tbar")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("E_LEPTON"), 11)
     call field%set (spin_type=2)
     call field%set (mass_data=model%get_par_real_ptr (4))
     call field%set (name = [var_str ("e-")], anti = [var_str ("e+")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("E_NEUTRINO"), 12)
     call field%set (spin_type=2, is_left_handed=.true.)
     call field%set (name = [var_str ("nue")], anti = [var_str ("nuebar")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("MU_LEPTON"), 13)
     call field%set (spin_type=2)
     call field%set (mass_data=model%get_par_real_ptr (5))
     call field%set (name = [var_str ("mu-")], anti = [var_str ("mu+")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("MU_NEUTRINO"), 14)
     call field%set (spin_type=2, is_left_handed=.true.)
     call field%set (name = [var_str ("numu")], anti = [var_str ("numubar")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("TAU_LEPTON"), 15)
     call field%set (spin_type=2)
     call field%set (mass_data=model%get_par_real_ptr (6))
     call field%set (name = [var_str ("tau-")], anti = [var_str ("tau+")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("TAU_NEUTRINO"), 16)
     call field%set (spin_type=2, is_left_handed=.true.)
     call field%set (name = [var_str ("nutau")], anti = [var_str ("nutaubar")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("GLUON"), 21)
     call field%set (spin_type=3, color_type=8)
     call field%set (name = [var_str ("gl")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("PHOTON"), 22)
     call field%set (spin_type=3)
     call field%set (name = [var_str ("A")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("Z_BOSON"), 23)
     call field%set (spin_type=3)
     call field%set (mass_data=model%get_par_real_ptr (1))
     call field%set (width_data=model%get_par_real_ptr (12))
     call field%set (name = [var_str ("Z")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("W_BOSON"), 24)
     call field%set (spin_type=3)
     call field%set (mass_data=model%get_par_real_ptr (2))
     call field%set (width_data=model%get_par_real_ptr (13))
     call field%set (name = [var_str ("W+")], anti = [var_str ("W-")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("HIGGS"), 25)
     call field%set (spin_type=1)
     call field%set (mass_data=model%get_par_real_ptr (3))
     call field%set (width_data=model%get_par_real_ptr (14))
     call field%set (name = [var_str ("H")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("PROTON"), 2212)
     call field%set (spin_type=2)
     call field%set (name = [var_str ("p")], anti = [var_str ("pbar")])
 !    call field%set (mass_data=model%get_par_real_ptr (12))
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("HADRON_REMNANT_SINGLET"), 91)
     call field%set (color_type=1)
     call field%set (name = [var_str ("hr1")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("HADRON_REMNANT_TRIPLET"), 92)
     call field%set (color_type=3)
     call field%set (name = [var_str ("hr3")], anti = [var_str ("hr3bar")])
     i = i + 1
     field => model%get_field_ptr_by_index (i)
     call field%init (var_str ("HADRON_REMNANT_OCTET"), 93)
     call field%set (color_type=8)
     call field%set (name = [var_str ("hr8")])
     call model%freeze_fields ()
     i = 0
     i = i + 1
 !!! QED
     call model%set_vertex (i, [var_str ("dbar"), var_str ("d"), var_str ("A")])
     i = i + 1
     call model%set_vertex (i, [var_str ("ubar"), var_str ("u"), var_str ("A")])
     i = i + 1
     call model%set_vertex (i, [var_str ("sbar"), var_str ("s"), var_str ("A")])
     i = i + 1
     call model%set_vertex (i, [var_str ("cbar"), var_str ("c"), var_str ("A")])
     i = i + 1
     call model%set_vertex (i, [var_str ("bbar"), var_str ("b"), var_str ("A")])
     i = i + 1
     call model%set_vertex (i, [var_str ("tbar"), var_str ("t"), var_str ("A")])
     i = i + 1
 !!!
     call model%set_vertex (i, [var_str ("e+"), var_str ("e-"), var_str ("A")])
     i = i + 1
     call model%set_vertex (i, [var_str ("mu+"), var_str ("mu-"), var_str ("A")])
     i = i + 1
     call model%set_vertex (i, [var_str ("tau+"), var_str ("tau-"), var_str ("A")])
     i = i + 1
 !!! QCD
     call model%set_vertex (i, [var_str ("gl"), var_str ("gl"), var_str ("gl")])
     i = i + 1
     call model%set_vertex (i, [var_str ("gl"), var_str ("gl"), &
          var_str ("gl"), var_str ("gl")])
     i = i + 1
 !!!
     call model%set_vertex (i, [var_str ("dbar"), var_str ("d"), var_str ("gl")])
     i = i + 1
     call model%set_vertex (i, [var_str ("ubar"), var_str ("u"), var_str ("gl")])
     i = i + 1
     call model%set_vertex (i, [var_str ("sbar"), var_str ("s"), var_str ("gl")])
     i = i + 1
     call model%set_vertex (i, [var_str ("cbar"), var_str ("c"), var_str ("gl")])
     i = i + 1
     call model%set_vertex (i, [var_str ("bbar"), var_str ("b"), var_str ("gl")])
     i = i + 1
     call model%set_vertex (i, [var_str ("tbar"), var_str ("t"), var_str ("gl")])
     i = i + 1
 !!! Neutral currents
     call model%set_vertex (i, [var_str ("dbar"), var_str ("d"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("ubar"), var_str ("u"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("sbar"), var_str ("s"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("cbar"), var_str ("c"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("bbar"), var_str ("b"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("tbar"), var_str ("t"), var_str ("Z")])
     i = i + 1
 !!!
     call model%set_vertex (i, [var_str ("e+"), var_str ("e-"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("mu+"), var_str ("muu-"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("tau+"), var_str ("tau-"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("nuebar"), var_str ("nue"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("numubar"), var_str ("numu"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("nutaubar"), var_str ("nutau"), &
          var_str ("Z")])
     i = i + 1
 !!! Charged currents
     call model%set_vertex (i, [var_str ("ubar"), var_str ("d"), var_str ("W+")])
     i = i + 1
     call model%set_vertex (i, [var_str ("cbar"), var_str ("s"), var_str ("W+")])
     i = i + 1
     call model%set_vertex (i, [var_str ("tbar"), var_str ("b"), var_str ("W+")])
     i = i + 1
     call model%set_vertex (i, [var_str ("dbar"), var_str ("u"), var_str ("W-")])
     i = i + 1
     call model%set_vertex (i, [var_str ("sbar"), var_str ("c"), var_str ("W-")])
     i = i + 1
     call model%set_vertex (i, [var_str ("bbar"), var_str ("t"), var_str ("W-")])
     i = i + 1
 !!!
     call model%set_vertex (i, [var_str ("nuebar"), var_str ("e-"), var_str ("W+")])
     i = i + 1
     call model%set_vertex (i, [var_str ("numubar"), var_str ("mu-"), var_str ("W+")])
     i = i + 1
     call model%set_vertex (i, [var_str ("nutaubar"), var_str ("tau-"), var_str ("W+")])
     i = i + 1
     call model%set_vertex (i, [var_str ("e+"), var_str ("nue"), var_str ("W-")])
     i = i + 1
     call model%set_vertex (i, [var_str ("mu+"), var_str ("numu"), var_str ("W-")])
     i = i + 1
     call model%set_vertex (i, [var_str ("tau+"), var_str ("nutau"), var_str ("W-")])
     i = i + 1
 !!! Yukawa
 !!! keeping only 3rd generation for the moment
     ! call model%set_vertex (i, [var_str ("sbar"), var_str ("s"), var_str ("H")])
     ! i = i + 1
     ! call model%set_vertex (i, [var_str ("cbar"), var_str ("c"), var_str ("H")])
     ! i = i + 1
     call model%set_vertex (i, [var_str ("bbar"), var_str ("b"), var_str ("H")])
     i = i + 1
     call model%set_vertex (i, [var_str ("tbar"), var_str ("t"), var_str ("H")])
     i = i + 1
     ! call model%set_vertex (i, [var_str ("mubar"), var_str ("mu"), var_str ("H")])
     ! i = i + 1
     call model%set_vertex (i, [var_str ("taubar"), var_str ("tau"), var_str ("H")])
     i = i + 1
 !!! Vector-boson self-interactions
     call model%set_vertex (i, [var_str ("W+"), var_str ("W-"), var_str ("A")])
     i = i + 1
     call model%set_vertex (i, [var_str ("W+"), var_str ("W-"), var_str ("Z")])
     i = i + 1
 !!!
     call model%set_vertex (i, [var_str ("W+"), var_str ("W-"), var_str ("Z"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("W+"), var_str ("W+"), var_str ("W-"), var_str ("W-")])
     i = i + 1
     call model%set_vertex (i, [var_str ("W+"), var_str ("W-"), var_str ("Z"), var_str ("A")])
     i = i + 1
     call model%set_vertex (i, [var_str ("W+"), var_str ("W-"), var_str ("A"), var_str ("A")])
     i = i + 1
 !!! Higgs - vector boson
     ! call model%set_vertex (i, [var_str ("H"), var_str ("Z"), var_str ("A")])
     ! i = i + 1
     ! call model%set_vertex (i, [var_str ("H"), var_str ("A"), var_str ("A")])
     ! i = i + 1
     ! call model%set_vertex (i, [var_str ("H"), var_str ("gl"), var_str ("gl")])
     ! i = i + 1
 !!!
     call model%set_vertex (i, [var_str ("H"), var_str ("W+"), var_str ("W-")])
     i = i + 1
     call model%set_vertex (i, [var_str ("H"), var_str ("Z"), var_str ("Z")])
     i = i + 1
     call model%set_vertex (i, [var_str ("H"), var_str ("H"), var_str ("W+"), var_str ("W-")])
     i = i + 1
     call model%set_vertex (i, [var_str ("H"), var_str ("H"), var_str ("Z"), var_str ("Z")])
     i = i + 1
 !!! Higgs self-interactions
     call model%set_vertex (i, [var_str ("H"), var_str ("H"), var_str ("H")])
     i = i + 1
     call model%set_vertex (i, [var_str ("H"), var_str ("H"), var_str ("H"), var_str ("H")])
     i = i + 1
     call model%freeze_vertices ()
   end subroutine init_sm_full_test
 
 @ %def init_sm_full_test
 @ Initialize a [[part_prop]] object by passing a [[particle_label]],
 which is simply the particle name. [[part_prop]] should be part of the
 [[particle]] array of [[feyngraph_set]]. We use the [[model]] of
 [[feyngraph_set]] to obtain the relevant data of the particle which is
 needed to find [[phase_space]] parametrizations. When a [[part_prop]]
 is initialized, we add and initialize also the corresponding anti-
 particle [[part_prop]] if it is not yet in the array.
 <<Cascades2: part prop: TBP>>=
   procedure :: init => part_prop_init
 <<Cascades2: procedures>>=
   recursive subroutine part_prop_init (part_prop, feyngraph_set, particle_label)
     class (part_prop_t), intent (out), target :: part_prop
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     character (len=*), intent (in) :: particle_label
     type (flavor_t) :: flv, anti
     type (string_t) :: name
     integer :: i
     name = particle_label
     call flv%init (name, feyngraph_set%model)
     part_prop%particle_label = particle_label
     part_prop%pdg = flv%get_pdg ()
     part_prop%mass = flv%get_mass ()
     part_prop%width = flv%get_width()
     part_prop%spin_type = flv%get_spin_type ()
     part_prop%is_vector = flv%get_spin_type () == VECTOR
     part_prop%empty = .false.
     part_prop%tex_name = flv%get_tex_name ()
     anti = flv%anti ()
     if (flv%get_pdg() == anti%get_pdg()) then
        select type (part_prop)
        type is (part_prop_t)
           part_prop%anti => part_prop
        end select
     else
        do i=1, size (feyngraph_set%particle)
           if (feyngraph_set%particle(i)%pdg == (- part_prop%pdg)) then
              part_prop%anti => feyngraph_set%particle(i)
              exit
           else if (feyngraph_set%particle(i)%empty) then
              part_prop%anti => feyngraph_set%particle(i)
              call feyngraph_set%particle(i)%init (feyngraph_set, char(anti%get_name()))
              exit
           end if
        enddo
     end if
   end subroutine part_prop_init
 
 @ %def part_prop_init
 @ This subroutine assigns to a node the particle properties. Since these
 properties do not change and are simply read from the model file, we
 use pointers to the elements of the [[particle]] array of the
 [[feyngraph_set]]. If there is no corresponding array element, we
 have to initialize the first empty element of the array.
 <<Cascades2: parameters>>=
   integer, parameter :: PRT_ARRAY_SIZE = 200
 <<Cascades2: f node: TBP>>=
   procedure :: assign_particle_properties => f_node_assign_particle_properties
 <<Cascades2: procedures>>=
   subroutine f_node_assign_particle_properties (node, feyngraph_set)
     class (f_node_t), intent (inout ) :: node
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     character (len=LABEL_LEN) :: particle_label
     integer :: i
     particle_label = node%particle_label(1:index (node%particle_label, '[')-1)
     if (.not. associated (feyngraph_set%particle)) then
        allocate (feyngraph_set%particle (PRT_ARRAY_SIZE))
     end if
     do i = 1, size (feyngraph_set%particle)
        if (particle_label == feyngraph_set%particle(i)%particle_label) then
           node%particle => feyngraph_set%particle(i)
           exit
        else if (feyngraph_set%particle(i)%empty) then
           call feyngraph_set%particle(i)%init (feyngraph_set, particle_label)
           node%particle => feyngraph_set%particle(i)
           exit
        end if
     enddo
 !!! Since the O'Mega output uses the anti-particles instead of the particles specified
 !!! in the process definition, we revert this here. An exception is the first particle
 !!! in the parsable DAG output
     node%particle => node%particle%anti
   end subroutine f_node_assign_particle_properties
 
 @ %def f_node_assign_particle_properties
 @ From the output of a Feynman diagram (in the non-factorized output)
 we need to find out how many daughter nodes would be required to
 reconstruct it correctly, to make sure that we keep
 only those [[feyngraphs]] which are constructed solely on the basis of
 the 3-vertices which are provided by the model. The number of daughter
 particles can easily be determined from the syntax of O'Mega's output:
 The particle which appears before the colon ':' is the mother particle.
 The particles or subtrees (i.e. whole parentheses) follow after the
 colon and are separated by commas.
 <<Cascades2: procedures>>=
   function get_n_daughters (subtree_string, pos_first_colon) &
        result (n_daughters)
     character (len=*), intent (in) :: subtree_string
     integer, intent (in) :: pos_first_colon
     integer :: n_daughters
     integer :: n_open_par
     integer :: i
     n_open_par = 1
     n_daughters = 0
     if (len_trim(subtree_string) > 0) then
        if (pos_first_colon > 0) then
           do i=pos_first_colon, len_trim(subtree_string)
              if (subtree_string(i:i) == ',') then
                 if (n_open_par == 1) n_daughters = n_daughters + 1
              else if (subtree_string(i:i) == '(') then
                 n_open_par = n_open_par + 1
              else if (subtree_string(i:i) == ')') then
                 n_open_par = n_open_par - 1
              end if
           end do
           if (n_open_par == 0) then
              n_daughters = n_daughters + 1
           end if
        end if
     end if
   end function get_n_daughters
 
 @ %def get_n_daughters
 @
 \subsection{Reconstruction of trees}
 The reconstruction of a tree or subtree with the non-factorized input can
 be done recursively, i.e. we first find the root of the tree in the
 string and create an [[f_node]]. Then we look for daughters, which in the
 string appear either as single particles or subtrees (which are of the
 same form as the tree which we want to reconstruct. Therefore the
 subroutine can simply be called again and again until there are no more
 daughter nodes to create. When we meet a vertex which requires more than
 two daughter particles, we stop the recursion and disable the node using
 its [[keep]] variable. Whenever a daughter node is not kept, we do not
 keep the mother node as well.
 <<Cascades2: procedures>>=
   recursive subroutine node_construct_subtree_rec (feyngraph_set, &
        feyngraph, subtree_string, mother_node)
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     type (feyngraph_t), intent (inout) :: feyngraph
     character (len=*), intent (in) :: subtree_string
     type (f_node_t), pointer, intent (inout) :: mother_node
     integer :: n_daughters
     integer :: pos_first_colon
     integer :: current_daughter
     integer :: pos_subtree_begin, pos_subtree_end
     integer :: i
     integer :: n_open_par
     if (.not. associated (mother_node)) then
        call feyngraph_set%f_node_list%add_entry (subtree_string, mother_node, .true.)
        current_daughter = 1
        n_open_par = 1
        pos_first_colon = index (subtree_string, ':')
        n_daughters = get_n_daughters (subtree_string, pos_first_colon)
        if (pos_first_colon == 0) then
           mother_node%particle_label = subtree_string
        else
           mother_node%particle_label = subtree_string(2:pos_first_colon-1)
        end if
        if (.not. associated (mother_node%particle)) then
           call mother_node%assign_particle_properties (feyngraph_set)
        end if
        if (n_daughters /= 2 .and. n_daughters /= 0) then
           mother_node%keep = .false.
           feyngraph%keep = .false.
           return
        end if
        pos_subtree_begin = pos_first_colon + 1
        do i = pos_first_colon + 1, len(trim(subtree_string))
           if (current_daughter == 2) then
              pos_subtree_end = len(trim(subtree_string)) - 1
              call node_construct_subtree_rec (feyngraph_set, feyngraph, &
                   subtree_string(pos_subtree_begin:pos_subtree_end), &
                   mother_node%daughter2)
              exit
           else if (subtree_string(i:i) == ',') then
              if (n_open_par == 1) then
                 pos_subtree_end = i - 1
                 call node_construct_subtree_rec (feyngraph_set, feyngraph, &
                      subtree_string(pos_subtree_begin:pos_subtree_end), &
                      mother_node%daughter1)
                 current_daughter = 2
                 pos_subtree_begin = i + 1
              end if
           else if (subtree_string(i:i) == '(') then
              n_open_par = n_open_par + 1
           else if (subtree_string(i:i) == ')') then
              n_open_par = n_open_par - 1
           end if
        end do
     end if
     if (associated (mother_node%daughter1)) then
        if (.not. mother_node%daughter1%keep) then
           mother_node%keep = .false.
        end if
     end if
     if (associated (mother_node%daughter2)) then
        if (.not. mother_node%daughter2%keep) then
           mother_node%keep = .false.
        end if
     end if
     if (associated (mother_node%daughter1) .and. &
          associated (mother_node%daughter2)) then
        mother_node%n_subtree_nodes = &
             mother_node%daughter1%n_subtree_nodes &
             + mother_node%daughter2%n_subtree_nodes + 1
     end if
     if (.not. mother_node%keep) then
        feyngraph%keep = .false.
     end if
   end subroutine node_construct_subtree_rec
 
 @ %def node_construct_subtree_rec
 @ When the non-factorized version of the O'Mega output is used, the
 [[feyngraph]] is reconstructed from the contents of its [[string_t]]
 variable [[omega_feyngraph_output]]. This can be used for the recursive
 reconstruction of the tree of [[k_nodes]] with
 [[node_construct_subtree_rec]].
 <<Cascades2: procedures>>=
   subroutine feyngraph_construct (feyngraph_set, feyngraph)
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     type (feyngraph_t), pointer, intent (inout) :: feyngraph
     call node_construct_subtree_rec (feyngraph_set, feyngraph, &
          char(feyngraph%omega_feyngraph_output), feyngraph%root)
     feyngraph%n_nodes = feyngraph%root%n_subtree_nodes
   end subroutine feyngraph_construct
 
 @ %def feyngraph_construct
 @ We introduce another node type, which is called [[dag_node_t]] and
 is used to reproduce the dag structure which is represented by the input.
 The [[dag_nodes]] can have several combinations of daughters 1 and 2.
 The [[dag]] type contains an array of [[dag_nodes]] and is only used
 for the reconstruction of [[feyngraphs]] which are factorized as well, but
 in the other direction as the original output. This means in particular
 that the outgoing particles in the output file (which there can appear
 many times) exist only once as [[f_nodes]]. To represent combinations of
 daughters and alternatives (options), we further use the types
 [[dag_options_t]] and [[dag_combination_t]]. The [[dag_nodes]],
 [[dag_options]] and [[dag_combinations]] correspond to a substring of
 the string which has been read from file (and transformed into an object
 of type [[dag_string_t]], which is simply another compact representation
 of this string), or a modified version of this substring. The aim is to
 create only one object for a given substring, even if it appears several
 times in the original string and then create trees of [[f_nodes]], which
 build up the [[feyngraph]], such that as many [[f_nodes]] as possible can be reused.
 An outgoing particle (always interpreting the input as a decay) is
 called a [[leaf]] in the context of a [[dag]].
 <<Cascades2: types>>=
   type :: dag_node_t
      integer :: string_len
      type (dag_string_t) :: string
      logical :: leaf = .false.
      type (f_node_ptr_t), dimension (:), allocatable :: f_node
      integer :: subtree_size = 0
    contains
      <<Cascades2: dag node: TBP>>
   end type dag_node_t
 
 @ %def dag_node_t
 <<Cascades2: dag node: TBP>>=
   procedure :: final => dag_node_final
 <<Cascades2: procedures>>=
   subroutine dag_node_final (dag_node)
     class (dag_node_t), intent (inout) :: dag_node
     integer :: i
     call dag_node%string%final ()
     if (allocated (dag_node%f_node)) then
        do i=1, size (dag_node%f_node)
           if (associated (dag_node%f_node(i)%node)) then
              call dag_node%f_node(i)%node%final ()
              deallocate (dag_node%f_node(i)%node)
           end if
        enddo
        deallocate (dag_node%f_node)
     end if
   end subroutine dag_node_final
 
 @ %def dag_node_final
 @ Whenever there are more than one possible subtrees (represented by
 a [[dag_node]]) or combinations of subtrees to daughters (represented
 by [[dag_combination_t]]), we use the type [[dag_options_t]]. In the
 syntax of the factorized output, options are listed within curly
 braces, separated by horizontal bars.
 <<Cascades2: types>>=
   type :: dag_options_t
      integer :: string_len
      type (dag_string_t) :: string
      type (f_node_ptr_t), dimension (:), allocatable :: f_node_ptr1
      type (f_node_ptr_t), dimension (:), allocatable :: f_node_ptr2
    contains
      <<Cascades2: dag options: TBP>>
   end type dag_options_t
 
 @ %def dag_node_options_t
 <<Cascades2: dag options: TBP>>=
   procedure :: final => dag_options_final
 <<Cascades2: procedures>>=
   subroutine dag_options_final (dag_options)
     class (dag_options_t), intent (inout) :: dag_options
     integer :: i
     call dag_options%string%final ()
     if (allocated (dag_options%f_node_ptr1)) then
        do i=1, size (dag_options%f_node_ptr1)
           dag_options%f_node_ptr1(i)%node => null ()
        enddo
        deallocate (dag_options%f_node_ptr1)
     end if
         if (allocated (dag_options%f_node_ptr2)) then
        do i=1, size (dag_options%f_node_ptr2)
           dag_options%f_node_ptr2(i)%node => null ()
        enddo
        deallocate (dag_options%f_node_ptr2)
     end if
   end subroutine dag_options_final
 
 @ %def dag_options_final
 @ A pair of two daughters (which can be [[dag_nodes]] or [[dag_options]])
 is represented by the type [[dag_combination_t]]. In the original string,
 a [[dag_combination]] appears between parentheses, which contain a comma,
 but not a colon. If we find a colon between these parentheses, it is a
 a [[dag_node]] instead.
 <<Cascades2: types>>=
   type :: dag_combination_t
      integer :: string_len
      type (dag_string_t) :: string
      integer, dimension (2) :: combination
      type (f_node_ptr_t), dimension (:), allocatable :: f_node_ptr1
      type (f_node_ptr_t), dimension (:), allocatable :: f_node_ptr2
    contains
      <<Cascades2: dag combination: TBP>>
   end type dag_combination_t
 
 @ %def dag_combination_t
 <<Cascades2: dag combination: TBP>>=
   procedure :: final => dag_combination_final
 <<Cascades2: procedures>>=
   subroutine dag_combination_final (dag_combination)
     class (dag_combination_t), intent (inout) :: dag_combination
     integer :: i
     call dag_combination%string%final ()
     if (allocated (dag_combination%f_node_ptr1)) then
        do i=1, size (dag_combination%f_node_ptr1)
           dag_combination%f_node_ptr1(i)%node => null ()
        enddo
        deallocate (dag_combination%f_node_ptr1)
     end if
     if (allocated (dag_combination%f_node_ptr2)) then
        do i=1, size (dag_combination%f_node_ptr2)
           dag_combination%f_node_ptr2(i)%node => null ()
        enddo
        deallocate (dag_combination%f_node_ptr2)
     end if
   end subroutine dag_combination_final
 
 @ %def dag_combination_final
 @ Here is the type representing the DAG, i.e. it holds arrays of the
 [[dag_nodes]], [[dag_options]] and [[dag_combinations]]. The root node
 of the [[dag]] is the last filled element of the [[node]] array.
 <<Cascades2: types>>=
   type :: dag_t
      type (dag_string_t) :: string
      type (dag_node_t), dimension (:), allocatable :: node
      type (dag_options_t), dimension (:), allocatable :: options
      type (dag_combination_t), dimension (:), allocatable :: combination
      integer :: n_nodes = 0
      integer :: n_options = 0
      integer :: n_combinations = 0
    contains
      <<Cascades2: dag: TBP>>
   end type dag_t
 
 @ %def dag_t
 <<Cascades2: dag: TBP>>=
   procedure :: final => dag_final
 <<Cascades2: procedures>>=
   subroutine dag_final (dag)
     class (dag_t), intent (inout) :: dag
     integer :: i
     call dag%string%final ()
     if (allocated (dag%node)) then
        do i=1, size (dag%node)
           call dag%node(i)%final ()
        enddo
        deallocate (dag%node)
     end if
     if (allocated (dag%options)) then
        do i=1, size (dag%options)
           call dag%options(i)%final ()
        enddo
        deallocate (dag%options)
     end if
     if (allocated (dag%combination)) then
        do i=1, size (dag%combination)
           call dag%combination(i)%final ()
        enddo
        deallocate (dag%combination)
     end if
   end subroutine dag_final
 
 @ %def dag_final
 @ We construct the DAG from the given [[dag_string]] which is modified
 several times so that in the end the remaining string corresponds to a
 simple [[dag_node]], the root of the factorized tree. This means that
 we first identify the leaves, i.e. outgoing particles. Then we identify
 [[dag_nodes]], [[dag_combinations]] and [[options]] until the number of
 these objects does not change any more. Identifying means that we add
 a corresponding object to the array (if not yet present), which can be identified
 with the corresponding substring, and replace the substring in the
 original [[dag_string]] by a [[dag_token]] of the corresponding type
 (in the char output of this token, this corresponds to a place holder
 like e.g. '<O23>' which in this particular case corresponds to an option
 and can be found at the position 23 in the array). The character output
 of the substrings turns out to be very useful for debugging.
 <<Cascades2: dag: TBP>>=
   procedure :: construct => dag_construct
 <<Cascades2: procedures>>=
   subroutine dag_construct (dag, feyngraph_set)
     class (dag_t), intent (inout) :: dag
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     integer :: n_nodes
     integer :: n_options
     integer :: n_combinations
     logical :: continue_loop
     integer :: subtree_size
     integer :: i,j
     subtree_size = 1
     call dag%get_nodes_and_combinations (leaves = .true.)
     do i=1, dag%n_nodes
        call dag%node(i)%make_f_nodes (feyngraph_set, dag)
     enddo
     continue_loop = .true.
     subtree_size = subtree_size + 2
     do while (continue_loop)
        n_nodes = dag%n_nodes
        n_options = dag%n_options
        n_combinations = dag%n_combinations
        call dag%get_nodes_and_combinations (leaves = .false.)
        if (n_nodes /= dag%n_nodes) then
           dag%node(n_nodes+1:dag%n_nodes)%subtree_size = subtree_size
           do i = n_nodes+1, dag%n_nodes
              call dag%node(i)%make_f_nodes (feyngraph_set, dag)
           enddo
           subtree_size = subtree_size + 2
        end if
        if (n_combinations /= dag%n_combinations) then
           !$OMP PARALLEL DO
           do i = n_combinations+1, dag%n_combinations
              call dag%combination(i)%make_f_nodes (feyngraph_set, dag)
           enddo
           !$OMP END PARALLEL DO
        end if
        call dag%get_options ()
        if (n_options /= dag%n_options) then
           !$OMP PARALLEL DO
           do i = n_options+1, dag%n_options
              call dag%options(i)%make_f_nodes (feyngraph_set, dag)
           enddo
           !$OMP END PARALLEL DO
        end if
        if (n_nodes == dag%n_nodes .and. n_options == dag%n_options &
             .and. n_combinations == dag%n_combinations) then
           continue_loop = .false.
        end if
     enddo
 !!! add root node to dag
     call dag%add_node (dag%string%t, leaf = .false.)
     dag%node(dag%n_nodes)%subtree_size = subtree_size
     call dag%node(dag%n_nodes)%make_f_nodes (feyngraph_set, dag)
     if (debug2_active (D_PHASESPACE)) then
        call dag%write (output_unit)
     end if
 !!! set indices for all f_nodes
     do i=1, dag%n_nodes
        if (allocated (dag%node(i)%f_node)) then
           do j=1, size (dag%node(i)%f_node)
              if (associated (dag%node(i)%f_node(j)%node)) &
                   call dag%node(i)%f_node(j)%node%set_index ()
           enddo
        end if
     enddo
   end subroutine dag_construct
 
 @ %def dag_construct
 @ Identify [[dag_nodes]] and [[dag_combinations]]. Leaves are simply
 nodes (i.e. of type [[NODE_TK]]) where only one bit in the bincode is
 set. The [[dag_nodes]] and [[dag_combinations]] have in common that they
 are surrounded by parentheses. There is however a way to distinguish
 between them because the corresponding substring contains a colon (or
 [[dag_token]] with type [[COLON_TK]]) if it is a [[dag_node]]. Otherwise
 it is a [[dag_combination]]. The string of the [[dag_node]] or
 [[dag_combination]] should not contain curly braces, because these
 correspond to [[dag_options]] and should be identified before.
 <<Cascades2: dag: TBP>>=
   procedure :: get_nodes_and_combinations => dag_get_nodes_and_combinations
 <<Cascades2: procedures>>=
   subroutine dag_get_nodes_and_combinations (dag, leaves)
     class (dag_t), intent (inout) :: dag
     logical, intent (in) :: leaves
     type (dag_string_t) :: new_string
     integer :: i, j, k
     integer :: i_node
     integer :: new_size
     integer :: first_colon
     logical :: combination
 !!! Create nodes also for external particles, except for the incoming one which
 !!! appears as the root of the tree. These can easily be identified by their
 !!! bincodes, since they should contain only one bit which is set.
     if (leaves) then
        first_colon = minloc (dag%string%t%type, 1, dag%string%t%type == COLON_TK)
        do i = first_colon + 1, size (dag%string%t)
           if (dag%string%t(i)%type == NODE_TK) then
              if (popcnt(dag%string%t(i)%bincode) == 1) then
                 call dag%add_node (dag%string%t(i:i), .true., i_node)
                 call dag%string%t(i)%init_dag_object_token (DAG_NODE_TK, i_node)
              end if
           end if
        enddo
        call dag%string%update_char_len ()
     else
 !!! Create a node or combination for every closed pair of parentheses
 !!! which do not contain any other parentheses or curly braces.
 !!! A node (not outgoing) contains a colon. This is not the case
 !!! for combinations, which we use as the criteria to distinguish
 !!! between both.
        allocate (new_string%t (size (dag%string%t)))
        i = 1
        new_size = 0
        do while (i <= size(dag%string%t))
           if (dag%string%t(i)%type == OPEN_PAR_TK) then
              combination = .true.
              do j = i+1, size (dag%string%t)
                 select case (dag%string%t(j)%type)
                 case (CLOSED_PAR_TK)
                    new_size = new_size + 1
                    if (combination) then
                       call dag%add_combination (dag%string%t(i:j), i_node)
                       call new_string%t(new_size)%init_dag_object_token (DAG_COMBINATION_TK, i_node)
                    else
                       call dag%add_node (dag%string%t(i:j), leaves, i_node)
                       call new_string%t(new_size)%init_dag_object_token (DAG_NODE_TK, i_node)
                    end if
                    i = j + 1
                    exit
                 case (OPEN_PAR_TK, OPEN_CURLY_TK, CLOSED_CURLY_TK)
                    new_size = new_size + 1
                    new_string%t(new_size) = dag%string%t(i)
                    i = i + 1
                    exit
                 case (COLON_TK)
                    combination = .false.
                 end select
              enddo
           else
              new_size = new_size + 1
              new_string%t(new_size) = dag%string%t(i)
              i = i + 1
           end if
        enddo
        dag%string = new_string%t(:new_size)
        call dag%string%update_char_len ()
     end if
   end subroutine dag_get_nodes_and_combinations
 
 @ %def dag_get_nodes_and_combinations
 @ Identify [[dag_options]], i.e. lists of rival nodes or combinations
 of nodes. These are identified by the surrounding curly braces. They
 should not contain any parentheses any more, because these correspond
 either to nodes or to combinations and should be identified before.
 <<Cascades2: dag: TBP>>=
   procedure :: get_options => dag_get_options
 <<Cascades2: procedures>>=
   subroutine dag_get_options (dag)
     class (dag_t), intent (inout) :: dag
     type (dag_string_t) :: new_string
     integer :: i, j, k
     integer :: new_size
     integer :: i_options
     character (len=10) :: index_char
     integer :: index_start, index_end
 !!! Create a node or combination for every closed pair of parentheses
 !!! which do not contain any other parentheses or curly braces.
 !!! A node (not outgoing) contains a colon. This is not the case
 !!! for combinations, which we use as the criteria to distinguish
 !!! between both.
     allocate (new_string%t (size (dag%string%t)))
     i = 1
     new_size = 0
     do while (i <= size(dag%string%t))
        if (dag%string%t(i)%type == OPEN_CURLY_TK) then
           do j = i+1, size (dag%string%t)
              select case (dag%string%t(j)%type)
              case (CLOSED_CURLY_TK)
                 new_size = new_size + 1
                 call dag%add_options (dag%string%t(i:j), i_options)
                 call new_string%t(new_size)%init_dag_object_token (DAG_OPTIONS_TK, i_options)
                 i = j + 1
                 exit
              case (OPEN_PAR_TK, CLOSED_PAR_TK, OPEN_CURLY_TK)
                 new_size = new_size + 1
                 new_string%t(new_size) = dag%string%t(i)
                 i = i + 1
                 exit
              end select
           enddo
        else
           new_size = new_size + 1
           new_string%t(new_size) = dag%string%t(i)
           i = i + 1
        end if
     enddo
     dag%string = new_string%t(:new_size)
     call dag%string%update_char_len ()
   end subroutine dag_get_options
 
 @ %def dag_get_options
 @ Add a [[dag_node]] to the list. The optional argument returns the index
 of the node. The node might already exist. In this case we only return
 the index.
 <<Cascades2: dag: TBP>>=
   procedure :: add_node => dag_add_node
 <<Cascades2: parameters>>=
   integer, parameter :: DAG_STACK_SIZE = 1000
 <<Cascades2: procedures>>=
   subroutine dag_add_node (dag, string, leaf, i_node)
     class (dag_t), intent (inout) :: dag
     type (dag_token_t), dimension (:), intent (in) :: string
     logical, intent (in) :: leaf
     integer, intent (out), optional :: i_node
     type (dag_node_t), dimension (:), allocatable :: tmp_node
     integer :: string_len
     integer :: i
     string_len = sum (string%char_len)
     if (.not. allocated (dag%node)) then
         allocate (dag%node (DAG_STACK_SIZE))
      else if (dag%n_nodes == size (dag%node)) then
         allocate (tmp_node (dag%n_nodes))
         tmp_node = dag%node
         deallocate (dag%node)
         allocate (dag%node (dag%n_nodes+DAG_STACK_SIZE))
         dag%node(:dag%n_nodes) = tmp_node
         deallocate (tmp_node)
      end if
      do i = 1, dag%n_nodes
         if (dag%node(i)%string_len == string_len) then
            if (size (dag%node(i)%string%t) == size (string)) then
               if (all(dag%node(i)%string%t == string)) then
                  if (present (i_node)) i_node = i
                  return
               end if
            end if
         end if
      enddo
      dag%n_nodes = dag%n_nodes + 1
      dag%node(dag%n_nodes)%string = string
      dag%node(dag%n_nodes)%string_len = string_len
      if (present (i_node)) i_node = dag%n_nodes
      dag%node(dag%n_nodes)%leaf = leaf
   end subroutine dag_add_node
 
 @ %def dag_add_node
 @ A similar subroutine for options.
 <<Cascades2: dag: TBP>>=
   procedure :: add_options => dag_add_options
 <<Cascades2: procedures>>=
   subroutine dag_add_options (dag, string, i_options)
     class (dag_t), intent (inout) :: dag
     type (dag_token_t), dimension (:), intent (in) :: string
     integer, intent (out), optional :: i_options
     type (dag_options_t), dimension (:), allocatable :: tmp_options
     integer :: string_len
     integer :: i
     string_len = sum (string%char_len)
     if (.not. allocated (dag%options)) then
         allocate (dag%options (DAG_STACK_SIZE))
      else if (dag%n_options == size (dag%options)) then
         allocate (tmp_options (dag%n_options))
         tmp_options = dag%options
         deallocate (dag%options)
         allocate (dag%options (dag%n_options+DAG_STACK_SIZE))
         dag%options(:dag%n_options) = tmp_options
         deallocate (tmp_options)
      end if
      do i = 1, dag%n_options
         if (dag%options(i)%string_len == string_len) then
            if (size (dag%options(i)%string%t) == size (string)) then
               if (all(dag%options(i)%string%t == string)) then
                  if (present (i_options)) i_options = i
                  return
               end if
            end if
         end if
      enddo
      dag%n_options = dag%n_options + 1
      dag%options(dag%n_options)%string = string
      dag%options(dag%n_options)%string_len = string_len
      if (present (i_options)) i_options = dag%n_options
   end subroutine dag_add_options
 
 @ %def dag_add_options
 @ A similar subroutine for combinations.
 <<Cascades2: dag: TBP>>=
   procedure :: add_combination => dag_add_combination
 <<Cascades2: procedures>>=
   subroutine dag_add_combination (dag, string, i_combination)
     class (dag_t), intent (inout) :: dag
     type (dag_token_t), dimension (:), intent (in) :: string
     integer, intent (out), optional :: i_combination
     type (dag_combination_t), dimension (:), allocatable :: tmp_combination
     integer :: string_len
     integer :: i
     string_len = sum (string%char_len)
     if (.not. allocated (dag%combination)) then
         allocate (dag%combination (DAG_STACK_SIZE))
      else if (dag%n_combinations == size (dag%combination)) then
         allocate (tmp_combination (dag%n_combinations))
         tmp_combination = dag%combination
         deallocate (dag%combination)
         allocate (dag%combination (dag%n_combinations+DAG_STACK_SIZE))
         dag%combination(:dag%n_combinations) = tmp_combination
         deallocate (tmp_combination)
      end if
      do i = 1, dag%n_combinations
         if (dag%combination(i)%string_len == string_len) then
            if (size (dag%combination(i)%string%t) == size (string)) then
               if (all(dag%combination(i)%string%t == string)) then
                  i_combination = i
                  return
               end if
            end if
         end if
      enddo
      dag%n_combinations = dag%n_combinations + 1
      dag%combination(dag%n_combinations)%string = string
      dag%combination(dag%n_combinations)%string_len = string_len
      if (present (i_combination)) i_combination = dag%n_combinations
   end subroutine dag_add_combination
 
 @ %def dag_add_combination
 @ For a given [[dag_node]] we want to create all [[f_nodes]]. If the node
 is not a leaf, it contains in its string placeholders for options or
 combinations. For these objects there are similar subroutines which are
 needed here to obtain the sets of daughter nodes. If the [[dag_node]] is
 a leaf, it corresponds to an external particle and the token contains the
 particle name.
 <<Cascades2: dag node: TBP>>=
   procedure :: make_f_nodes => dag_node_make_f_nodes
 <<Cascades2: procedures>>=
   subroutine dag_node_make_f_nodes (dag_node, feyngraph_set, dag)
     class (dag_node_t), intent (inout) :: dag_node
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     type (dag_t), intent (inout) :: dag
     character (len=LABEL_LEN) :: particle_label
     integer :: i, j
     integer, dimension (2) :: obj
     integer, dimension (2) :: i_obj
     integer :: n_obj
     integer :: pos
     integer :: new_size, size1, size2
     integer, dimension(:), allocatable :: match
     if (allocated (dag_node%f_node)) return
     pos = minloc (dag_node%string%t%type, 1,dag_node%string%t%type == NODE_TK)
     particle_label = char (dag_node%string%t(pos))
     if (dag_node%leaf) then
 !!! construct subtree with procedure similar to the one for the old output
        allocate (dag_node%f_node(1))
        allocate (dag_node%f_node(1)%node)
        dag_node%f_node(1)%node%particle_label = particle_label
        call dag_node%f_node(1)%node%assign_particle_properties (feyngraph_set)
        if (.not. dag_node%f_node(1)%node%keep) then
           deallocate (dag_node%f_node)
           return
        end if
     else
        n_obj = 0
        do i = 1, size (dag_node%string%t)
           select case (dag_node%string%t(i)%type)
           case (DAG_NODE_TK, DAG_OPTIONS_TK, DAG_COMBINATION_TK)
              n_obj = n_obj + 1
              if (n_obj > 2) return
              obj(n_obj) = dag_node%string%t(i)%type
              i_obj(n_obj) = dag_node%string%t(i)%index
           end select
        enddo
        if (n_obj == 1) then
           if (obj(1) == DAG_OPTIONS_TK) then
              if (allocated (dag%options(i_obj(1))%f_node_ptr1)) then
                 size1 = size(dag%options(i_obj(1))%f_node_ptr1)
                 allocate (dag_node%f_node(size1))
                 do i=1, size1
                    allocate (dag_node%f_node(i)%node)
                    dag_node%f_node(i)%node%particle_label = particle_label
                    call dag_node%f_node(i)%node%assign_particle_properties (feyngraph_set)
                    dag_node%f_node(i)%node%daughter1 => dag%options(i_obj(1))%f_node_ptr1(i)%node
                    dag_node%f_node(i)%node%daughter2 => dag%options(i_obj(1))%f_node_ptr2(i)%node
                    dag_node%f_node(i)%node%n_subtree_nodes = &
                         dag%options(i_obj(1))%f_node_ptr1(i)%node%n_subtree_nodes &
                         + dag%options(i_obj(1))%f_node_ptr2(i)%node%n_subtree_nodes + 1
                 enddo
              end if
           else if (obj(1) == DAG_COMBINATION_TK) then
              if (allocated (dag%combination(i_obj(1))%f_node_ptr1)) then
                 size1 = size(dag%combination(i_obj(1))%f_node_ptr1)
                 allocate (dag_node%f_node(size1))
                 do i=1, size1
                    allocate (dag_node%f_node(i)%node)
                    dag_node%f_node(i)%node%particle_label = particle_label
                    call dag_node%f_node(i)%node%assign_particle_properties (feyngraph_set)
                    dag_node%f_node(i)%node%daughter1 => dag%combination(i_obj(1))%f_node_ptr1(i)%node
                    dag_node%f_node(i)%node%daughter2 => dag%combination(i_obj(1))%f_node_ptr2(i)%node
                    dag_node%f_node(i)%node%n_subtree_nodes = &
                         dag%combination(i_obj(1))%f_node_ptr1(i)%node%n_subtree_nodes &
                      + dag%combination(i_obj(1))%f_node_ptr2(i)%node%n_subtree_nodes + 1
                 enddo
              end if
           end if
 !!! simply set daughter pointers, daughters are already combined correctly
        else if (n_obj == 2) then
           size1 = 0
           size2 = 0
           if (obj(1) == DAG_NODE_TK) then
              if (allocated (dag%node(i_obj(1))%f_node)) then
                 do i=1, size (dag%node(i_obj(1))%f_node)
                    if (dag%node(i_obj(1))%f_node(i)%node%keep) size1 = size1 + 1
                 enddo
              end if
           else if (obj(1) == DAG_OPTIONS_TK) then
              if (allocated (dag%options(i_obj(1))%f_node_ptr1)) then
                 do i=1, size (dag%options(i_obj(1))%f_node_ptr1)
                    if (dag%options(i_obj(1))%f_node_ptr1(i)%node%keep) size1 = size1 + 1
                 enddo
              end if
           end if
           if (obj(2) == DAG_NODE_TK) then
              if (allocated (dag%node(i_obj(2))%f_node)) then
                 do i=1, size (dag%node(i_obj(2))%f_node)
                    if (dag%node(i_obj(2))%f_node(i)%node%keep) size2 = size2 + 1
                 enddo
              end if
           else if (obj(2) == DAG_OPTIONS_TK) then
              if (allocated (dag%options(i_obj(2))%f_node_ptr1)) then
                 do i=1, size (dag%options(i_obj(2))%f_node_ptr1)
                    if (dag%options(i_obj(2))%f_node_ptr1(i)%node%keep) size2 = size2 + 1
                 enddo
              end if
           end if
 !!! make all combinations of daughters
           select case (obj(1))
           case (DAG_NODE_TK)
              select case (obj(2))
              case (DAG_NODE_TK)
                 call combine_all_daughters(dag%node(i_obj(1))%f_node, &
                      dag%node(i_obj(2))%f_node)
              case (DAG_OPTIONS_TK)
                 call combine_all_daughters(dag%node(i_obj(1))%f_node, &
                      dag%options(i_obj(2))%f_node_ptr1)
              end select
           case (DAG_OPTIONS_TK)
              select case (obj(2))
              case (DAG_NODE_TK)
                 call combine_all_daughters(dag%options(i_obj(1))%f_node_ptr1, &
                      dag%node(i_obj(2))%f_node)
              case (DAG_OPTIONS_TK)
                 call combine_all_daughters(dag%options(i_obj(1))%f_node_ptr1, &
                      dag%options(i_obj(2))%f_node_ptr1)
              end select
           end select
        end if
     end if
 
   contains
 
     subroutine combine_all_daughters (daughter1_ptr, daughter2_ptr)
       type (f_node_ptr_t), dimension (:), intent (in) :: daughter1_ptr
       type (f_node_ptr_t), dimension (:), intent (in) :: daughter2_ptr
       integer :: i, j
       integer :: pos
       new_size = size1*size2
       allocate (dag_node%f_node(new_size))
       pos = 0
       do i = 1, size (daughter1_ptr)
          if (daughter1_ptr(i)%node%keep) then
             do j = 1, size (daughter2_ptr)
                if (daughter2_ptr(j)%node%keep) then
                   pos = pos + 1
                   allocate (dag_node%f_node(pos)%node)
                   dag_node%f_node(pos)%node%particle_label = particle_label
                   call dag_node%f_node(pos)%node%assign_particle_properties (feyngraph_set)
                   dag_node%f_node(pos)%node%daughter1 => daughter1_ptr(i)%node
                   dag_node%f_node(pos)%node%daughter2 => daughter2_ptr(j)%node
                   dag_node%f_node(pos)%node%n_subtree_nodes = daughter1_ptr(i)%node%n_subtree_nodes &
                        + daughter2_ptr(j)%node%n_subtree_nodes + 1
                   call feyngraph_set%model%match_vertex (daughter1_ptr(i)%node%particle%pdg, &
                        daughter2_ptr(j)%node%particle%pdg, match)
                   if (allocated (match)) then
                      if (any (abs(match) == abs(dag_node%f_node(pos)%node%particle%pdg))) then
                         dag_node%f_node(pos)%node%keep = .true.
                      else
                         dag_node%f_node(pos)%node%keep = .false.
                      end if
                      deallocate (match)
                   else
                      dag_node%f_node(pos)%node%keep = .false.
                   end if
                end if
             enddo
          end if
       enddo
     end subroutine combine_all_daughters
   end subroutine dag_node_make_f_nodes
 
 @ %def dag_node_make_f_nodes
 @ In [[dag_options_make_f_nodes_single]]
 we obtain all [[f_nodes]] for [[dag_nodes]] which correspond to a
 set of rival subtrees or nodes, which is the first possibility for
 which [[dag_options]] can appear.
 In [[dag_options_make_f_nodes_pair]]
 the options are rival pairs ([[daughter1]], [[daughter2]]).
 Therefore we have to pass two allocatable arrays of type [[f_node_ptr_t]]
 to the subroutine.
 <<Cascades2: dag options: TBP>>=
   procedure :: make_f_nodes => dag_options_make_f_nodes
 <<Cascades2: procedures>>=
   subroutine dag_options_make_f_nodes (dag_options, &
        feyngraph_set, dag)
     class (dag_options_t), intent (inout) :: dag_options
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     type (dag_t), intent (inout) :: dag
     integer, dimension (:), allocatable :: obj, i_obj
     integer :: n_obj
     integer :: i
     integer :: pos
 !!! read options
     if (allocated (dag_options%f_node_ptr1)) return
     n_obj = count ((dag_options%string%t%type == DAG_NODE_TK) .or. &
          (dag_options%string%t%type == DAG_OPTIONS_TK) .or. &
          (dag_options%string%t%type == DAG_COMBINATION_TK), 1)
     allocate (obj(n_obj)); allocate (i_obj(n_obj))
     pos = 0
     do i = 1, size (dag_options%string%t)
        select case (dag_options%string%t(i)%type)
        case (DAG_NODE_TK, DAG_OPTIONS_TK, DAG_COMBINATION_TK)
           pos = pos + 1
           obj(pos) = dag_options%string%t(i)%type
           i_obj(pos) = dag_options%string%t(i)%index
        end select
     enddo
     if (any (dag_options%string%t%type == DAG_NODE_TK)) then
        call dag_options_make_f_nodes_single
     else if (any (dag_options%string%t%type == DAG_COMBINATION_TK)) then
        call dag_options_make_f_nodes_pair
     end if
     deallocate (obj, i_obj)
 
   contains
 
     subroutine dag_options_make_f_nodes_single
       integer :: i_start, i_end
       integer :: n_nodes
       n_nodes = 0
       do i=1, n_obj
          if (allocated (dag%node(i_obj(i))%f_node)) then
             n_nodes = n_nodes + size (dag%node(i_obj(i))%f_node)
          end if
       enddo
       if (n_nodes /= 0) then
          allocate (dag_options%f_node_ptr1 (n_nodes))
          i_end = 0
          do i = 1, n_obj
             if (allocated (dag%node(i_obj(i))%f_node)) then
                i_start = i_end + 1
                i_end = i_end + size (dag%node(i_obj(i))%f_node)
                dag_options%f_node_ptr1(i_start:i_end) = dag%node(i_obj(i))%f_node
             end if
          enddo
       end if
     end subroutine dag_options_make_f_nodes_single
 
     subroutine dag_options_make_f_nodes_pair
       integer :: i_start, i_end
       integer :: n_nodes
 !!! get f_nodes from each combination
       n_nodes = 0
       do i=1, n_obj
          if (allocated (dag%combination(i_obj(i))%f_node_ptr1)) then
             n_nodes = n_nodes + size (dag%combination(i_obj(i))%f_node_ptr1)
          end if
       enddo
       if (n_nodes /= 0) then
          allocate (dag_options%f_node_ptr1 (n_nodes))
          allocate (dag_options%f_node_ptr2 (n_nodes))
          i_end = 0
          do i=1, n_obj
             if (allocated (dag%combination(i_obj(i))%f_node_ptr1)) then
                i_start = i_end + 1
                i_end = i_end + size (dag%combination(i_obj(i))%f_node_ptr1)
                dag_options%f_node_ptr1(i_start:i_end) = dag%combination(i_obj(i))%f_node_ptr1
                dag_options%f_node_ptr2(i_start:i_end) = dag%combination(i_obj(i))%f_node_ptr2
             end if
          enddo
       end if
     end subroutine dag_options_make_f_nodes_pair
   end subroutine dag_options_make_f_nodes
 
 @ %def dag_options_make_f_nodes
 @ We create all combinations of daughter [[f_nodes]] for a combination.
 In the combination each daughter can be either a single [[dag_node]] or
 [[dag_options]] which are a set of single [[dag_nodes]]. Therefore, we
 first create all possible [[f_nodes]] for daughter1, then all possible
 [[f_nodes]] for daughter2. In the end we combine all [[daughter1]] nodes
 with all [[daughter2]] nodes.
 <<Cascades2: dag combination: TBP>>=
   procedure :: make_f_nodes => dag_combination_make_f_nodes
 <<Cascades2: procedures>>=
   subroutine dag_combination_make_f_nodes (dag_combination, &
        feyngraph_set, dag)
     class (dag_combination_t), intent (inout) :: dag_combination
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     type (dag_t), intent (inout) :: dag
     integer, dimension (2) :: obj, i_obj
     integer :: n_obj
     integer :: new_size, size1, size2
     integer :: i, j, pos
     if (allocated (dag_combination%f_node_ptr1)) return
     n_obj = 0
     do i = 1, size (dag_combination%string%t)
        select case (dag_combination%string%t(i)%type)
        case (DAG_NODE_TK, DAG_OPTIONS_TK, DAG_COMBINATION_TK)
           n_obj = n_obj + 1
           if (n_obj > 2) return
           obj(n_obj) = dag_combination%string%t(i)%type
           i_obj(n_obj) = dag_combination%string%t(i)%index
        end select
     enddo
     size1 = 0
     size2 = 0
     if (obj(1) == DAG_NODE_TK) then
        if (allocated (dag%node(i_obj(1))%f_node)) &
             size1 = size (dag%node(i_obj(1))%f_node)
     else if (obj(1) == DAG_OPTIONS_TK) then
        if (allocated (dag%options(i_obj(1))%f_node_ptr1)) &
             size1 = size (dag%options(i_obj(1))%f_node_ptr1)
     end if
     if (obj(2) == DAG_NODE_TK) then
        if (allocated (dag%node(i_obj(2))%f_node)) &
             size2 = size (dag%node(i_obj(2))%f_node)
     else if (obj(2) == DAG_OPTIONS_TK) then
        if (allocated (dag%options(i_obj(2))%f_node_ptr1)) &
             size2 = size (dag%options(i_obj(2))%f_node_ptr1)
     end if
 !!! combine the 2 arrays of f_nodes
     new_size = size1*size2
     if (new_size /= 0) then
        allocate (dag_combination%f_node_ptr1 (new_size))
        allocate (dag_combination%f_node_ptr2 (new_size))
        pos = 0
        select case (obj(1))
        case (DAG_NODE_TK)
           select case (obj(2))
           case (DAG_NODE_TK)
              do i = 1, size1
                 do j = 1, size2
                    pos = pos + 1
                    dag_combination%f_node_ptr1(pos) = dag%node(i_obj(1))%f_node(i)
                    dag_combination%f_node_ptr2(pos) = dag%node(i_obj(2))%f_node(j)
                 enddo
              enddo
           case (DAG_OPTIONS_TK)
              do i = 1, size1
                 do j = 1, size2
                    pos = pos + 1
                    dag_combination%f_node_ptr1(pos) = dag%node(i_obj(1))%f_node(i)
                    dag_combination%f_node_ptr2(pos) = dag%options(i_obj(2))%f_node_ptr1(j)
                 enddo
              enddo
           end select
        case (DAG_OPTIONS_TK)
           select case (obj(2))
           case (DAG_NODE_TK)
              do i = 1, size1
                 do j = 1, size2
                    pos = pos + 1
                    dag_combination%f_node_ptr1(pos) = dag%options(i_obj(1))%f_node_ptr1(i)
                    dag_combination%f_node_ptr2(pos) = dag%node(i_obj(2))%f_node(j)
                 enddo
              enddo
           case (DAG_OPTIONS_TK)
              do i = 1, size1
                 do j = 1, size2
                    pos = pos + 1
                    dag_combination%f_node_ptr1(pos) = dag%options(i_obj(1))%f_node_ptr1(i)
                    dag_combination%f_node_ptr2(pos) = dag%options(i_obj(2))%f_node_ptr1(j)
                 enddo
              enddo
           end select
        end select
     end if
   end subroutine dag_combination_make_f_nodes
 
 @ %def dag_combination_make_f_nodes
 @ Here we create the [[feyngraphs]]. After the construction of the
 [[dag]] the remaining [[dag_string]] should contain a token for a
 single [[dag_node]] which corresponds to the roots of the
 [[feyngraphs]]. Therefore we make all [[f_nodes]] for this [[dag_node]]
 and create a [[feyngraph]] for each [[f_node]]. Note that only
 3-vertices are accepted. All other vertices are rejected. The
 starting point is the last dag node which has been added to the list,
 since this corresponds to the root of the tree.
 Is is important to understand that the structure of feyngraphs is not
 the same as the structure of the dag which is read from file, because
 for the calculations which are performed in this module we want to
 reuse the nodes for the outgoing particles, which means that they
 appear only once. In O'Mega's output, it is the first incoming particle
 which appears only once and the outgoing particles appear many times. This
 transition is incorporated in the subroutines which create [[f_nodes]]
 from the different dag objects.
 <<Cascades2: dag: TBP>>=
   procedure :: make_feyngraphs => dag_make_feyngraphs
 <<Cascades2: procedures>>=
   subroutine dag_make_feyngraphs (dag, feyngraph_set)
     class (dag_t), intent (inout) :: dag
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     integer :: i
     integer :: max_subtree_size
     max_subtree_size = dag%node(dag%n_nodes)%subtree_size
     if (allocated (dag%node(dag%n_nodes)%f_node)) then
        do i = 1, size (dag%node(dag%n_nodes)%f_node)
           if (.not. associated (feyngraph_set%first)) then
              allocate (feyngraph_set%last)
              feyngraph_set%first => feyngraph_set%last
           else
              allocate (feyngraph_set%last%next)
              feyngraph_set%last => feyngraph_set%last%next
           end if
           feyngraph_set%last%root => dag%node(dag%n_nodes)%f_node(i)%node
 !!! The first particle was correct in the O'Mega parsable DAG output. It was however
 !!! changed to its anti-particle in f_node_assign_particle_properties, which we revert here.
           feyngraph_set%last%root%particle => feyngraph_set%last%root%particle%anti
           feyngraph_set%last%n_nodes = feyngraph_set%last%root%n_subtree_nodes
           feyngraph_set%n_graphs = feyngraph_set%n_graphs + 1
        enddo
        feyngraph_set%f_node_list%max_tree_size = feyngraph_set%first%n_nodes
     end if
   end subroutine dag_make_feyngraphs
 
 @ %def dag_make_feyngraphs
 @ A write procedure of the [[dag]] for debugging.
 <<Cascades2: dag: TBP>>=
   procedure :: write => dag_write
 <<Cascades2: procedures>>=
   subroutine dag_write (dag, u)
     class (dag_t), intent (in) :: dag
     integer, intent(in) :: u
     integer :: i
     write (u,fmt='(A)') 'nodes'
     do i=1, dag%n_nodes
        write (u,fmt='(I5,3X,A)') i, char (dag%node(i)%string)
     enddo
     write (u,fmt='(A)') 'options'
     do i=1, dag%n_options
        write (u,fmt='(I5,3X,A)') i, char (dag%options(i)%string)
     enddo
     write (u,fmt='(A)') 'combination'
     do i=1, dag%n_combinations
        write (u,fmt='(I5,3X,A)') i, char (dag%combination(i)%string)
     enddo
   end subroutine dag_write
 
 @ %def dag_write
 @ Make a copy of a resonant [[k_node]], where the copy is kept
 nonresonant.
 <<Cascades2: procedures>>=
   subroutine k_node_make_nonresonant_copy (k_node)
     type (k_node_t), intent (in) :: k_node
     type (k_node_t), pointer :: copy
     call k_node%f_node%k_node_list%add_entry (copy, recycle=.true.)
     copy%daughter1 => k_node%daughter1
     copy%daughter2 => k_node%daughter2
     copy = k_node
     copy%mapping = NONRESONANT
     copy%resonant = .false.
     copy%on_shell = .false.
     copy%mapping_assigned = .true.
     copy%is_nonresonant_copy = .true.
   end subroutine k_node_make_nonresonant_copy
 
 @ %def k_node_make_nonresonant_copy
 @ For a given [[feyngraph]] we create all possible [[kingraphs]]. Here
 we use existing [[k_nodes]] which have already been created when the
 mapping calculations of the pure s-channel subgraphs are performed. The
 nodes for the incoming particles or the nodes on the t-line will have
 to be created in all cases because they are not used in several graphs.
 To obtain the existing [[k_nodes]], we use the subroutine
 [[k_node_init_from_f_node]] which itself uses [[f_node_list_get_nodes]]
 to obtain all active [[k_nodes]] in the [[k_node_list]] of the [[f_node]].
 The created [[kingraphs]] are attached to the linked list
 of the [[feyngraph]]. For scattering processes we have to split up the
 t-line, because since all graphs are represented as a decay, different
 nodes can share daughter nodes. This happens also for the t-line or
 the incoming particle which appears as an outgoing particle. For the
 [[t_line]] or [[incoming]] nodes we do not want to recycle nodes but
 rather create a copy of this line for each [[kingraph]].
 <<Cascades2: feyngraph: TBP>>=
   procedure :: make_kingraphs => feyngraph_make_kingraphs
 <<Cascades2: procedures>>=
   subroutine feyngraph_make_kingraphs (feyngraph, feyngraph_set)
     class (feyngraph_t), intent (inout) :: feyngraph
     type (feyngraph_set_t), intent (in) :: feyngraph_set
     type (k_node_ptr_t), dimension (:), allocatable :: kingraph_root
     integer :: i
     if (.not. associated (feyngraph%kin_first)) then
        call k_node_init_from_f_node (feyngraph%root, &
             kingraph_root, feyngraph_set)
        if (.not. feyngraph%root%keep) return
        if (feyngraph_set%process_type == SCATTERING) then
           call split_up_t_lines (kingraph_root)
        end if
        do i=1, size (kingraph_root)
           if (associated (feyngraph%kin_last)) then
              allocate (feyngraph%kin_last%next)
              feyngraph%kin_last => feyngraph%kin_last%next
           else
              allocate (feyngraph%kin_last)
              feyngraph%kin_first => feyngraph%kin_last
           end if
           feyngraph%kin_last%root => kingraph_root(i)%node
           feyngraph%kin_last%n_nodes = feyngraph%n_nodes
           feyngraph%kin_last%keep = feyngraph%keep
           if (feyngraph_set%process_type == SCATTERING) then
              feyngraph%kin_last%root%bincode = &
                   f_node_get_external_bincode (feyngraph_set, feyngraph%root)
           end if
        enddo
        deallocate (kingraph_root)
     end if
   end subroutine feyngraph_make_kingraphs
 
 @ %def feyngraph_make_kingraphs
 @ Create all [[k_nodes]] for a given [[f_node]]. We return these nodes
 using [[k_node_ptr]]. If the node is external, we assign also the bincode
 to the [[k_nodes]] because this is determined from substrings of the
 input file which belong to the [[feyngraphs]] and [[f_nodes]].
 <<Cascades2: procedures>>=
   recursive subroutine k_node_init_from_f_node (f_node, k_node_ptr, feyngraph_set)
     type (f_node_t), target, intent (inout) :: f_node
     type (k_node_ptr_t), allocatable, dimension (:), intent (out) :: k_node_ptr
     type (feyngraph_set_t), intent (in) :: feyngraph_set
     type (k_node_ptr_t), allocatable, dimension(:) :: daughter_ptr1, daughter_ptr2
     integer :: n_nodes
     integer :: i, j
     integer :: pos
     integer, save :: counter = 0
     if (.not. (f_node%incoming .or. f_node%t_line)) then
        call f_node%k_node_list%get_nodes (k_node_ptr)
        if (.not. allocated (k_node_ptr) .and. f_node%k_node_list%n_entries > 0) then
           f_node%keep = .false.
           return
        end if
     end if
     if (.not. allocated (k_node_ptr)) then
        if (associated (f_node%daughter1) .and. associated (f_node%daughter2)) then
           call k_node_init_from_f_node (f_node%daughter1, daughter_ptr1, &
                feyngraph_set)
           call k_node_init_from_f_node (f_node%daughter2, daughter_ptr2, &
                feyngraph_set)
           if (.not. (f_node%daughter1%keep .and. f_node%daughter2%keep)) then
              f_node%keep = .false.
              return
           end if
           n_nodes = size (daughter_ptr1) * size (daughter_ptr2)
           allocate (k_node_ptr (n_nodes))
           pos = 1
           do i=1, size (daughter_ptr1)
              do j=1, size (daughter_ptr2)
                 if (f_node%incoming .or. f_node%t_line) then
                    call f_node%k_node_list%add_entry (k_node_ptr(pos)%node, recycle = .false.)
                 else
                    call f_node%k_node_list%add_entry (k_node_ptr(pos)%node, recycle = .true.)
                 end if
                 k_node_ptr(pos)%node%f_node => f_node
                 k_node_ptr(pos)%node%daughter1 => daughter_ptr1(i)%node
                 k_node_ptr(pos)%node%daughter2 => daughter_ptr2(j)%node
                 k_node_ptr(pos)%node%f_node_index = f_node%index
                 k_node_ptr(pos)%node%incoming = f_node%incoming
                 k_node_ptr(pos)%node%t_line = f_node%t_line
                 k_node_ptr(pos)%node%particle => f_node%particle
                 pos = pos + 1
              enddo
           enddo
           deallocate (daughter_ptr1, daughter_ptr2)
        else
           allocate (k_node_ptr(1))
           if (f_node%incoming .or. f_node%t_line) then
              call f_node%k_node_list%add_entry (k_node_ptr(1)%node, recycle=.false.)
           else
              call f_node%k_node_list%add_entry (k_node_ptr(1)%node, recycle=.true.)
           end if
           k_node_ptr(1)%node%f_node => f_node
           k_node_ptr(1)%node%f_node_index = f_node%index
           k_node_ptr(1)%node%incoming = f_node%incoming
           k_node_ptr(1)%node%t_line = f_node%t_line
           k_node_ptr(1)%node%particle => f_node%particle
           k_node_ptr(1)%node%bincode = f_node_get_external_bincode (feyngraph_set, &
                f_node)
        end if
     end if
   end subroutine k_node_init_from_f_node
 
 @ %def k_node_init_from_f_node
 @ The graphs resulting from [[k_node_init_from_f_node]] are fine if they
 are used only in one direction. This is however not the case when one
 wants to invert the graphs, i.e. take the other incoming particle of a
 scattering process as the decaying particle, because the outgoing
 [[f_nodes]] (and hence also the [[k_nodes]]) exist only once. This
 problem is solved here by creating a distinct t-line for each of the
 graphs. The following subroutine disentangles the data structure by
 creating new nodes such that the different t-lines are not connected
 any more.
 <<Cascades2: procedures>>=
   recursive subroutine split_up_t_lines (t_node)
     type (k_node_ptr_t), dimension(:), intent (inout) :: t_node
     type (k_node_t), pointer :: ref_node => null ()
     type (k_node_t), pointer :: ref_daughter => null ()
     type (k_node_t), pointer :: new_daughter => null ()
     type (k_node_ptr_t), dimension(:), allocatable :: t_daughter
     integer :: ref_daughter_index
     integer :: i, j
     allocate (t_daughter (size (t_node)))
     do i=1, size (t_node)
        ref_node => t_node(i)%node
        if (associated (ref_node%daughter1) .and. associated (ref_node%daughter2)) then
           ref_daughter => null ()
           if (ref_node%daughter1%incoming .or. ref_node%daughter1%t_line) then
              ref_daughter => ref_node%daughter1
              ref_daughter_index = 1
           else if (ref_node%daughter2%incoming .or. ref_node%daughter2%t_line) then
              ref_daughter => ref_node%daughter2
              ref_daughter_index = 2
           end if
           do j=1, size (t_daughter)
              if (.not. associated (t_daughter(j)%node)) then
                 t_daughter(j)%node => ref_daughter
                 exit
              else if (t_daughter(j)%node%index == ref_daughter%index) then
                 new_daughter => null ()
                 call ref_daughter%f_node%k_node_list%add_entry (new_daughter, recycle=.false.)
                 new_daughter = ref_daughter
                 new_daughter%daughter1 => ref_daughter%daughter1
                 new_daughter%daughter2 => ref_daughter%daughter2
                 if (ref_daughter_index == 1) then
                    ref_node%daughter1 => new_daughter
                 else if (ref_daughter_index == 2) then
                    ref_node%daughter2 => new_daughter
                 end if
                 ref_daughter => new_daughter
              end if
           enddo
        else
           return
        end if
     enddo
     call split_up_t_lines (t_daughter)
     deallocate (t_daughter)
   end subroutine split_up_t_lines
 
 @ %def split_up_t_lines
 @ This subroutine sets the [[inverse_daughters]] of a [[k_node]]. If we
 invert a [[kingraph]] such that not the first but the second incoming
 particle appears as the root of the tree, the [[incoming]] and [[t_line]]
 particles obtain other daughters. These are the former mother node and
 the sister node [[s_daughter]]. Here we set only the pointers for
 the [[inverse_daughters]]. The inversion happens in [[kingraph_make_inverse_copy]]
 and [[node_inverse_deep_copy]].
 <<Cascades2: procedures>>=
   subroutine kingraph_set_inverse_daughters (kingraph)
     type (kingraph_t), intent (inout) :: kingraph
     type (k_node_t), pointer :: mother
     type (k_node_t), pointer :: t_daughter
     type (k_node_t), pointer :: s_daughter
     mother => kingraph%root
     do while (associated (mother))
        if (associated (mother%daughter1) .and. &
             associated (mother%daughter2)) then
           if (mother%daughter1%t_line .or. mother%daughter1%incoming) then
              t_daughter => mother%daughter1; s_daughter => mother%daughter2
           else if (mother%daughter2%t_line .or. mother%daughter2%incoming) then
              t_daughter => mother%daughter2; s_daughter => mother%daughter1
           else
              exit
           end if
           t_daughter%inverse_daughter1 => mother
           t_daughter%inverse_daughter2 => s_daughter
           mother => t_daughter
        else
           exit
        end if
     enddo
   end subroutine kingraph_set_inverse_daughters
 
 @ %def kingraph_set_inverse_daughters
 @ Set the bincode of an [[f_node]] which corresponds to an external
 particle. This is done on the basis of the [[particle_label]] which is a
 substring of the input file. Here it is not the particle name which is
 important, but the number(s) in brackets which in general indicate the
 external particles which are connected to the current node. This function
 is however only used for external particles, so there can either be
 one or [[n_out + 1]] particles in the brackets (in the DAG input file
 always one, because also for the root there is only a single number).
 In all cases we check the number of particles (in the DAG input the
 numbers are separated by a slash).
 <<Cascades2: procedures>>=
   function f_node_get_external_bincode (feyngraph_set, f_node) result (bincode)
     type (feyngraph_set_t), intent (in) :: feyngraph_set
     type (f_node_t), intent (in) :: f_node
     integer (TC) :: bincode
     character (len=LABEL_LEN) :: particle_label
     integer :: start_pos, end_pos, n_out_decay
     integer :: n_prt ! for DAG
     integer :: i
     bincode = 0
     if (feyngraph_set%process_type == DECAY) then
        n_out_decay = feyngraph_set%n_out
     else
        n_out_decay = feyngraph_set%n_out + 1
     end if
     particle_label = f_node%particle_label
     start_pos = index (particle_label, '[') + 1
     end_pos = index (particle_label, ']') - 1
     particle_label = particle_label(start_pos:end_pos)
 !!! n_out_decay is the number of outgoing particles in the
 !!! O'Mega output, which is always represented as a decay
     if (feyngraph_set%use_dag) then
        n_prt = 1
        do i=1, len(particle_label)
           if (particle_label(i:i) == '/') n_prt = n_prt + 1
        enddo
     else
        n_prt = end_pos - start_pos + 1
     end if
     if (n_prt == 1) then
        bincode = calculate_external_bincode (particle_label, &
             feyngraph_set%process_type, n_out_decay)
     else if (n_prt == n_out_decay) then
        bincode = ibset (0, n_out_decay)
     end if
   end function f_node_get_external_bincode
 
 @ %def f_node_get_external_bincode
 @ Assign a bincode to an internal node, which is calculated from
 the bincodes of [[daughter1]] and [[daughter2]].
 <<Cascades2: procedures>>=
   subroutine node_assign_bincode (node)
     type (k_node_t), intent (inout) :: node
     if (associated (node%daughter1) .and. associated (node%daughter2) &
          .and. .not. node%incoming) then
        node%bincode = ior(node%daughter1%bincode, node%daughter2%bincode)
     end if
   end subroutine node_assign_bincode
 
 @ %def node_assign_bincode
 @ Calculate the [[bincode]] from the number in the brackets of the
 [[particle_label]], if the node is external. For the root in the
 non-factorized output, this is calculated directly in
 [[f_node_get_external_bincode]] because in this case all the other
 external particle numbers appear between the brackets.
 <<Cascades2: procedures>>=
   function calculate_external_bincode (label_number_string, process_type, n_out_decay) result (bincode)
     character (len=*), intent (in) :: label_number_string
     integer, intent (in) :: process_type
     integer, intent (in) :: n_out_decay
     character :: number_char
     integer :: number_int
     integer (kind=TC) :: bincode
     bincode = 0
     read (label_number_string, fmt='(A)') number_char
 !!! check if the character is a letter (A,B,C,...) or a number (1...9)
 !!! numbers 1 and 2 are special cases
     select case (number_char)
     case ('1')
        if (process_type == SCATTERING) then
           number_int = n_out_decay + 3
        else
           number_int = n_out_decay + 2
        end if
     case ('2')
        if (process_type == SCATTERING) then
           number_int = n_out_decay + 2
        else
           number_int = 2
        end if
     case ('A')
        number_int = 10
     case ('B')
        number_int = 11
     case ('C')
        number_int = 12
     case ('D')
        number_int = 13
     case default
        read (number_char, fmt='(I1)') number_int
     end select
     bincode = ibset (bincode, number_int - process_type - 1)
   end function calculate_external_bincode
 
 @ %def calculate_external_bincode
 @
 \subsection{Mapping calculations}
 Once a [[k_node]] and its subtree nodes have been created, we can
 perform the kinematical calculations and assign mappings, depending on
 the particle properties and the results for the subtree nodes. This
 could in principle be done recursively, calling the procedure first
 for the daughter nodes and then perform the calculations for the actual
 node. But for parallization and comparing the nodes, this will be done
 simultaneously for all nodes with the same number of subtree nodes, and the number of
 subtree nodes increases, starting from one, in steps of two. The
 actual mapping calculations are done in complete analogy to cascades.
 <<Cascades2: procedures>>=
   subroutine node_assign_mapping_s (feyngraph, node, feyngraph_set)
     type (feyngraph_t), intent (inout) :: feyngraph
     type (k_node_t), intent (inout) :: node
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     real(default) :: eff_mass_sum
     logical :: keep
     if (.not. node%mapping_assigned) then
        if (node%particle%mass > feyngraph_set%phs_par%m_threshold_s) then
           node%effective_mass = node%particle%mass
        end if
        if (associated (node%daughter1) .and. associated (node%daughter2)) then
           if (.not. (node%daughter1%keep .and. node%daughter2%keep)) then
              node%keep = .false.; return
           end if
           node%ext_mass_sum = node%daughter1%ext_mass_sum &
                + node%daughter2%ext_mass_sum
           keep = .false.
 !!! Potentially resonant cases [sqrts = m_rea for on-shell decay]
           if (node%particle%mass > node%ext_mass_sum &
                .and. node%particle%mass <= feyngraph_set%phs_par%sqrts) then
              if (node%particle%width /= 0) then
                 if (node%daughter1%on_shell .or. node%daughter2%on_shell) then
                    keep = .true.
                    node%mapping = S_CHANNEL
                    node%resonant = .true.
                 end if
              else
                 call warn_decay (node%particle)
              end if
 !!! Collinear and IR singular cases
           else if (node%particle%mass < feyngraph_set%phs_par%sqrts) then
 !!! Massless splitting
              if (node%daughter1%effective_mass == 0 &
                   .and. node%daughter2%effective_mass == 0 &
                   .and. .not. associated (node%daughter1%daughter1) &
                   .and. .not. associated (node%daughter1%daughter2) &
                   .and. .not. associated (node%daughter2%daughter1) &
                   .and. .not. associated (node%daughter2%daughter2)) then
                 keep = .true.
                 node%log_enhanced = .true.
                 if (node%particle%is_vector) then
                    if (node%daughter1%particle%is_vector &
                         .and. node%daughter2%particle%is_vector) then
                       node%mapping = COLLINEAR   !!! three-vector-splitting
                    else
                       node%mapping = INFRARED    !!! vector spliiting into matter
                    end if
                 else
                    if (node%daughter1%particle%is_vector &
                         .or. node%daughter2%particle%is_vector) then
                       node%mapping = COLLINEAR   !!! vector radiation off matter
                    else
                       node%mapping = INFRARED    !!! scalar radiation/splitting
                    end if
                 end if
 !!! IR radiation off massive particle [cascades]
              else if (node%effective_mass > 0 .and. &
                   node%daughter1%effective_mass > 0 .and. &
                   node%daughter2%effective_mass == 0 .and. &
                   (node%daughter1%on_shell .or. &
                   node%daughter1%mapping == RADIATION) .and. &
                   abs (node%effective_mass - &
                   node%daughter1%effective_mass) < feyngraph_set%phs_par%m_threshold_s) &
                   then
                 keep = .true.
                 node%log_enhanced = .true.
                 node%mapping = RADIATION
              else if (node%effective_mass > 0 .and. &
                   node%daughter2%effective_mass > 0 .and. &
                   node%daughter1%effective_mass == 0 .and. &
                   (node%daughter2%on_shell .or. &
                   node%daughter2%mapping == RADIATION) .and. &
                   abs (node%effective_mass - &
                   node%daughter2%effective_mass) < feyngraph_set%phs_par%m_threshold_s) &
                   then
                 keep = .true.
                 node%log_enhanced = .true.
                 node%mapping = RADIATION
              end if
           end if
 !!! Non-singular cases, including failed resonances [from cascades]
           if (.not. keep) then
 !!! Two on-shell particles from a virtual mother [from cascades, here eventually more than 2]
              if (node%daughter1%on_shell .or. node%daughter2%on_shell) then
                 keep = .true.
                 eff_mass_sum = node%daughter1%effective_mass &
                      + node%daughter2%effective_mass
                 node%effective_mass = max (node%ext_mass_sum, eff_mass_sum)
                 if (node%effective_mass < feyngraph_set%phs_par%m_threshold_s) then
                    node%effective_mass = 0
                 end if
              end if
           end if
 !!! Complete and register feyngraph (make copy in case of resonance)
           if (keep) then
              node%on_shell = node%resonant .or. node%log_enhanced
              if (node%resonant) then
                 if (feyngraph_set%phs_par%keep_nonresonant) then
                    call k_node_make_nonresonant_copy (node)
                 end if
                 node%ext_mass_sum = node%particle%mass
              end if
           end if
           node%mapping_assigned = .true.
           call node_assign_bincode (node)
           call node%subtree%add_entry (node)
        else !!! external (outgoing) particle
           node%ext_mass_sum = node%particle%mass
           node%mapping = EXTERNAL_PRT
           node%multiplicity = 1
           node%mapping_assigned = .true.
           call node%subtree%add_entry (node)
           node%on_shell = .true.
           if (node%particle%mass >= feyngraph_set%phs_par%m_threshold_s) then
              node%effective_mass = node%particle%mass
           end if
        end if
     else if (node%is_nonresonant_copy) then
        call node_assign_bincode (node)
        call node%subtree%add_entry (node)
        node%is_nonresonant_copy = .false.
     end if
     call node_count_specific_properties (node)
     if (node%n_off_shell > feyngraph_set%phs_par%off_shell) then
        node%keep = .false.
     end if
   contains
     subroutine warn_decay (particle)
       type(part_prop_t), intent(in) :: particle
       integer :: i
       integer, dimension(MAX_WARN_RESONANCE), save :: warned_code = 0
       LOOP_WARNED: do i = 1, MAX_WARN_RESONANCE
          if (warned_code(i) == 0) then
             warned_code(i) = particle%pdg
             write (msg_buffer, "(A)") &
                  & " Intermediate decay of zero-width particle " &
                  & // trim(particle%particle_label) &
                  & // " may be possible."
             call msg_warning
             exit LOOP_WARNED
          else if (warned_code(i) == particle%pdg) then
             exit LOOP_WARNED
          end if
       end do LOOP_WARNED
     end subroutine warn_decay
   end subroutine node_assign_mapping_s
 
 @ %def node_assign_mapping_s
 @ We determine the numbers [[n_resonances]], [[multiplicity]],
 [[n_off_shell]] and [[n_log_enhanced]] for a given node.
 <<Cascades2: procedures>>=
   subroutine node_count_specific_properties (node)
     type (k_node_t), intent (inout) :: node
     if (associated (node%daughter1) .and. associated(node%daughter2)) then
        if (node%resonant) then
           node%multiplicity = 1
           node%n_resonances &
                = node%daughter1%n_resonances &
                + node%daughter2%n_resonances + 1
        else
           node%multiplicity &
                = node%daughter1%multiplicity &
                + node%daughter2%multiplicity
           node%n_resonances &
                = node%daughter1%n_resonances &
                + node%daughter2%n_resonances
        end if
        if (node%log_enhanced) then
           node%n_log_enhanced &
                = node%daughter1%n_log_enhanced &
                + node%daughter2%n_log_enhanced + 1
        else
           node%n_log_enhanced &
                = node%daughter1%n_log_enhanced &
                + node%daughter2%n_log_enhanced
        end if
        if (node%resonant) then
           node%n_off_shell = 0
        else if (node%log_enhanced) then
           node%n_off_shell &
                = node%daughter1%n_off_shell &
                + node%daughter2%n_off_shell
        else
           node%n_off_shell &
                = node%daughter1%n_off_shell &
                + node%daughter2%n_off_shell + 1
        end if
        if (node%t_line) then
           if (node%daughter1%t_line .or. node%daughter1%incoming) then
              node%n_t_channel = node%daughter1%n_t_channel + 1
           else if (node%daughter2%t_line .or. node%daughter2%incoming) then
              node%n_t_channel = node%daughter2%n_t_channel + 1
           end if
        end if
     end if
   end subroutine node_count_specific_properties
 
 @ %def node_count_specific_properties
 @ The subroutine [[kingraph_assign_mappings_s]] completes kinematical
 calculations for a decay process, considering the [[root]] node.
 <<Cascades2: procedures>>=
   subroutine kingraph_assign_mappings_s (feyngraph, kingraph, feyngraph_set)
     type (feyngraph_t), intent (inout) :: feyngraph
     type (kingraph_t), pointer, intent (inout) :: kingraph
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     if (.not. (kingraph%root%daughter1%keep .and. kingraph%root%daughter2%keep)) then
        kingraph%keep = .false.
        call kingraph%tree%final ()
     end if
     if (kingraph%keep) then
        kingraph%root%on_shell = .true.
        kingraph%root%mapping = EXTERNAL_PRT
        kingraph%root%mapping_assigned = .true.
        call node_assign_bincode (kingraph%root)
        kingraph%root%ext_mass_sum = &
             kingraph%root%daughter1%ext_mass_sum + &
             kingraph%root%daughter2%ext_mass_sum
        if (kingraph%root%ext_mass_sum >= feyngraph_set%phs_par%sqrts) then
           kingraph%root%keep = .false.
           kingraph%keep = .false.; call kingraph%tree%final (); return
        end if
        call kingraph%root%subtree%add_entry (kingraph%root)
        kingraph%root%multiplicity &
             = kingraph%root%daughter1%multiplicity &
             + kingraph%root%daughter2%multiplicity
        kingraph%root%n_resonances &
             = kingraph%root%daughter1%n_resonances &
             + kingraph%root%daughter2%n_resonances
        kingraph%root%n_off_shell &
             = kingraph%root%daughter1%n_off_shell &
             + kingraph%root%daughter2%n_off_shell
        kingraph%root%n_log_enhanced &
             = kingraph%root%daughter1%n_log_enhanced &
             + kingraph%root%daughter2%n_log_enhanced
        if (kingraph%root%n_off_shell > feyngraph_set%phs_par%off_shell) then
           kingraph%root%keep = .false.
           kingraph%keep = .false.; call kingraph%tree%final (); return
        else
           kingraph%grove_prop%multiplicity = &
                kingraph%root%multiplicity
           kingraph%grove_prop%n_resonances = &
                kingraph%root%n_resonances
           kingraph%grove_prop%n_off_shell = &
                kingraph%root%n_off_shell
           kingraph%grove_prop%n_log_enhanced = &
                kingraph%root%n_log_enhanced
        end if
        kingraph%tree = kingraph%root%subtree
     end if
   end subroutine kingraph_assign_mappings_s
 
 @ %def kingraph_assign_mappings_s
 @ Compute mappings for the [[t_line]] and [[incoming]] nodes. This is
 done recursively using [[node_compute_t_line]].
 <<Cascades2: procedures>>=
   subroutine kingraph_compute_mappings_t_line (feyngraph, kingraph, feyngraph_set)
     type (feyngraph_t), intent (inout) :: feyngraph
     type (kingraph_t), pointer, intent (inout) :: kingraph
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     call node_compute_t_line (feyngraph, kingraph, kingraph%root, feyngraph_set)
     if (.not. kingraph%root%keep) then
        kingraph%keep = .false.
        call kingraph%tree%final ()
     end if
     if (kingraph%keep) kingraph%tree = kingraph%root%subtree
   end subroutine kingraph_compute_mappings_t_line
 
 @ %def kingraph_compute_mappings_t_line
 @ Perform the kinematical calculations and mapping assignment for a node
 which is either [[incoming]] or [[t_line]]. This is done recursively,
 going first to the daughter node which has this property. Therefore we
 first set the pointer [[t_node]] to this daughter node and [[s_node]] to
 the other one. The mapping determination happens again in the same way as
 in [[cascades]].
 <<Cascades2: procedures>>=
   recursive subroutine node_compute_t_line (feyngraph, kingraph, node, feyngraph_set)
     type (feyngraph_t), intent (inout) :: feyngraph
     type (kingraph_t), intent (inout) :: kingraph
     type (k_node_t), intent (inout) :: node
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     type (k_node_t), pointer :: s_node
     type (k_node_t), pointer :: t_node
     type (k_node_t), pointer :: new_s_node
     if (.not. (node%daughter1%keep .and. node%daughter2%keep)) then
        node%keep = .false.
        return
     end if
     s_node => null ()
     t_node => null ()
     new_s_node => null ()
     if (associated (node%daughter1) .and. associated (node%daughter2)) then
        if (node%daughter1%t_line .or. node%daughter1%incoming) then
           t_node => node%daughter1; s_node => node%daughter2
        else if (node%daughter2%t_line .or. node%daughter2%incoming) then
           t_node => node%daughter2; s_node => node%daughter1
        end if
        if (t_node%t_line) then
           call node_compute_t_line (feyngraph, kingraph, t_node, feyngraph_set)
           if (.not. t_node%keep) then
              node%keep = .false.
              return
           end if
        else if (t_node%incoming) then
           t_node%mapping = EXTERNAL_PRT
           t_node%on_shell = .true.
           t_node%ext_mass_sum = t_node%particle%mass
           if (t_node%particle%mass >= feyngraph_set%phs_par%m_threshold_t) then
              t_node%effective_mass = t_node%particle%mass
           end if
           call t_node%subtree%add_entry (t_node)
        end if
 !!! root:
        if (.not. node%incoming) then
           if (t_node%incoming) then
              node%ext_mass_sum = s_node%ext_mass_sum
           else
              node%ext_mass_sum &
                   = node%daughter1%ext_mass_sum &
                   + node%daughter2%ext_mass_sum
           end if
           if (node%particle%mass > feyngraph_set%phs_par%m_threshold_t) then
              node%effective_mass = max (node%particle%mass, &
                   s_node%effective_mass)
           else if (s_node%effective_mass > feyngraph_set%phs_par%m_threshold_t) then
              node%effective_mass = s_node%effective_mass
           else
              node%effective_mass = 0
           end if
 !!! Allowed decay of beam particle
           if (t_node%incoming &
                .and. t_node%particle%mass > s_node%particle%mass &
                + node%particle%mass) then
              call beam_decay (feyngraph_set%fatal_beam_decay)
 !!! Massless splitting
           else if (t_node%effective_mass == 0 &
                .and. s_node%effective_mass < feyngraph_set%phs_par%m_threshold_t &
                .and. node%effective_mass == 0) then
              node%mapping = U_CHANNEL
              node%log_enhanced = .true.
 !!! IR radiation off massive particle
           else if (t_node%effective_mass /= 0 &
                .and. s_node%effective_mass == 0 &
                .and. node%effective_mass /= 0 &
                .and. (t_node%on_shell &
                .or. t_node%mapping == RADIATION) &
                .and. abs (t_node%effective_mass - node%effective_mass) &
                < feyngraph_set%phs_par%m_threshold_t) then
              node%log_enhanced = .true.
              node%mapping = RADIATION
           end if
           node%mapping_assigned = .true.
           call node_assign_bincode (node)
           call node%subtree%add_entry (node)
           call node_count_specific_properties (node)
           if (node%n_off_shell > feyngraph_set%phs_par%off_shell) then
              node%keep = .false.
              kingraph%keep = .false.; call kingraph%tree%final (); return
           else if (node%n_t_channel > feyngraph_set%phs_par%t_channel) then
              node%keep = .false.;
              kingraph%keep = .false.; call kingraph%tree%final (); return
           end if
        else
           node%mapping = EXTERNAL_PRT
           node%on_shell = .true.
           node%ext_mass_sum &
                = t_node%ext_mass_sum &
                + s_node%ext_mass_sum
           node%effective_mass = node%particle%mass
           if (.not. (node%ext_mass_sum < feyngraph_set%phs_par%sqrts)) then
              node%keep = .false.
              kingraph%keep = .false.; call kingraph%tree%final (); return
           end if
           if (kingraph%keep) then
              if (t_node%incoming .and. s_node%log_enhanced) then
                 call s_node%f_node%k_node_list%add_entry (new_s_node, recycle=.false.)
                 new_s_node = s_node
                 new_s_node%daughter1 => s_node%daughter1
                 new_s_node%daughter2 => s_node%daughter2
                 if (s_node%index == node%daughter1%index) then
                    node%daughter1 => new_s_node
                 else if (s_node%index ==  node%daughter2%index) then
                    node%daughter2 => new_s_node
                 end if
                 new_s_node%subtree = s_node%subtree
                 new_s_node%mapping = NO_MAPPING
                 new_s_node%log_enhanced = .false.
                 new_s_node%n_log_enhanced &
                      = new_s_node%n_log_enhanced - 1
                 new_s_node%log_enhanced = .false.
                 where (new_s_node%subtree%bc == new_s_node%bincode)
                    new_s_node%subtree%mapping = NO_MAPPING
                 endwhere
              else if ((t_node%t_line .or. t_node%incoming) .and. &
                   t_node%mapping == U_CHANNEL) then
                 t_node%mapping = T_CHANNEL
                 where (t_node%subtree%bc == t_node%bincode)
                    t_node%subtree%mapping = T_CHANNEL
                 endwhere
              else if (t_node%incoming .and. &
                   .not. associated (s_node%daughter1) .and. &
                   .not. associated (s_node%daughter2)) then
                 call s_node%f_node%k_node_list%add_entry (new_s_node, recycle=.false.)
                 new_s_node = s_node
                 new_s_node%mapping = ON_SHELL
                 new_s_node%daughter1 => s_node%daughter1
                 new_s_node%daughter2 => s_node%daughter2
                 new_s_node%subtree = s_node%subtree
                 if (s_node%index == node%daughter1%index) then
                    node%daughter1 => new_s_node
                 else if (s_node%index == node%daughter2%index) then
                    node%daughter2 => new_s_node
                 end if
                 where (new_s_node%subtree%bc == new_s_node%bincode)
                    new_s_node%subtree%mapping = ON_SHELL
                 endwhere
              end if
           end if
           call node%subtree%add_entry (node)
           node%multiplicity &
                = node%daughter1%multiplicity &
                + node%daughter2%multiplicity
           node%n_resonances &
                = node%daughter1%n_resonances &
                + node%daughter2%n_resonances
           node%n_off_shell &
                = node%daughter1%n_off_shell &
                + node%daughter2%n_off_shell
           node%n_log_enhanced &
                = node%daughter1%n_log_enhanced &
                + node%daughter2%n_log_enhanced
           node%n_t_channel &
                = node%daughter1%n_t_channel &
                + node%daughter2%n_t_channel
           if (node%n_off_shell > feyngraph_set%phs_par%off_shell) then
              node%keep = .false.
              kingraph%keep = .false.; call kingraph%tree%final (); return
           else if (node%n_t_channel > feyngraph_set%phs_par%t_channel) then
              node%keep = .false.
              kingraph%keep = .false.; call kingraph%tree%final (); return
           else
              kingraph%grove_prop%multiplicity = node%multiplicity
              kingraph%grove_prop%n_resonances = node%n_resonances
              kingraph%grove_prop%n_off_shell = node%n_off_shell
              kingraph%grove_prop%n_log_enhanced = node%n_log_enhanced
              kingraph%grove_prop%n_t_channel = node%n_t_channel
           end if
        end if
     end if
   contains
     subroutine beam_decay (fatal_beam_decay)
       logical, intent(in) :: fatal_beam_decay
       write (msg_buffer, "(1x,A,1x,'->',1x,A,1x,A)") &
            t_node%particle%particle_label, &
            node%particle%particle_label, &
            s_node%particle%particle_label
       call msg_message
       write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
            t_node%particle%particle_label, t_node%particle%mass
       call msg_message
       write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
            node%particle%particle_label, node%particle%mass
       call msg_message
       write (msg_buffer, "(1x,'mass(',A,') =',1x,E17.10)") &
            s_node%particle%particle_label, s_node%particle%mass
       call msg_message
       if (fatal_beam_decay) then
          call msg_fatal (" Phase space: Initial beam particle can decay")
       else
          call msg_warning (" Phase space: Initial beam particle can decay")
       end if
     end subroutine beam_decay
   end subroutine node_compute_t_line
 
 @ %def node_compute_t_line
 @ After all pure s-channel subdiagrams have already been created from the
 corresponding [[f_nodes]] and mappings have been determined for their
 nodes, we complete the calculations here. In a first step, the
 [[kingraphs]] have to be created on the basis of the existing
 [[k_nodes]], which means in particular that a [[feyngraph]] can give
 rise to several [[kingraphs]] which will all be attached to the linked
 list of the [[feyngraph]]. The calculations which remain are of different
 kinds for decay and scattering processes. In a decay process the
 kinematical calculations have to be done for the [[root]] node. In a
 scattering process, after the creation of [[kingraphs]] in the first
 step, there will be only [[kingraphs]] with the first incoming particle
 as the [[root]] of the tree. For these graphs the [[inverse]] variable
 has the value [[.false.]]. Before performing any calculations on these
 graphs we make a so-called inverse copy of the graph (see below), which
 will also be attached to the linked list. Since the s-channel subgraph
 calculations have already been completed, only the t-line computations
 remain.
 <<Cascades2: feyngraph: TBP>>=
   procedure :: make_inverse_kingraphs => feyngraph_make_inverse_kingraphs
 <<Cascades2: procedures>>=
   subroutine feyngraph_make_inverse_kingraphs (feyngraph)
     class (feyngraph_t), intent (inout) :: feyngraph
     type (kingraph_t), pointer :: current
     current => feyngraph%kin_first
     do while (associated (current))
        if (current%inverse) exit
        call current%make_inverse_copy (feyngraph)
        current => current%next
     enddo
   end subroutine feyngraph_make_inverse_kingraphs
 
 @ %def feyngraph_make_inverse_kingraphs
 <<Cascades2: feyngraph: TBP>>=
   procedure :: compute_mappings => feyngraph_compute_mappings
 <<Cascades2: procedures>>=
   subroutine feyngraph_compute_mappings (feyngraph, feyngraph_set)
     class (feyngraph_t), intent (inout) :: feyngraph
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     type (kingraph_t), pointer :: current
     current => feyngraph%kin_first
     do while (associated (current))
        if (feyngraph_set%process_type == DECAY) then
           call kingraph_assign_mappings_s (feyngraph, current, feyngraph_set)
        else if (feyngraph_set%process_type == SCATTERING) then
           call kingraph_compute_mappings_t_line (feyngraph, current, feyngraph_set)
        end if
        current => current%next
     enddo
   end subroutine feyngraph_compute_mappings
 
 @ %def feyngraph_compute_mappings
 @ Here we control the mapping calculations for the nodes of s-channel
 subgraphs. We start with the nodes with the smallest number of subtree
 nodes and always increase this number by two because nodes have exactly
 zero or two daughter nodes. We create the [[k_nodes]] using the
 [[k_node_list]] of each [[f_node]]. The number of nodes which have to
 be created depends of the number of existing daughter nodes, which means
 that we have to create a node for each combination of existing and
 valid (the ones which we [[keep]]) daughter nodes. If the node
 corresponds to an external particle, we create only one node, since
 there are no daughter nodes. If the particle is not external and
 the daughter [[f_nodes]] do not contain any valid [[k_nodes]], we do
 not create a new [[k_nodes]] either. When the calculations for all nodes
 with the same number of subtree nodes have been completed, we compare
 the valid nodes to eliminate equivalences (see below).
 <<Cascades2: procedures>>=
   subroutine f_node_list_compute_mappings_s (feyngraph_set)
     type (feyngraph_set_t), intent (inout) :: feyngraph_set
     type (f_node_ptr_t), dimension(:), allocatable :: set
     type (k_node_ptr_t), dimension(:), allocatable :: k_set
     type (k_node_entry_t), pointer :: k_entry
     type (f_node_entry_t), pointer :: current
     type (k_node_list_t), allocatable :: compare_list
     integer :: n_entries
     integer :: pos
     integer :: i, j, k
     do i = 1, feyngraph_set%f_node_list%max_tree_size - 2, 2
 !!! Counter number of f_nodes with subtree size i for s channel calculations
        n_entries = 0
        if (feyngraph_set%use_dag) then
           do j=1, feyngraph_set%dag%n_nodes
              if (allocated (feyngraph_set%dag%node(j)%f_node)) then
                 do k=1, size(feyngraph_set%dag%node(j)%f_node)
                    if (associated (feyngraph_set%dag%node(j)%f_node(k)%node)) then
                       if (.not. (feyngraph_set%dag%node(j)%f_node(k)%node%incoming &
                            .or. feyngraph_set%dag%node(j)%f_node(k)%node%t_line) &
                            .and. feyngraph_set%dag%node(j)%f_node(k)%node%n_subtree_nodes == i) then
                          n_entries = n_entries + 1
                       end if
                    end if
                 enddo
              end if
           enddo
        else
           current => feyngraph_set%f_node_list%first
           do while (associated (current))
              if (.not. (current%node%incoming .or. current%node%t_line) &
                   .and. current%node%n_subtree_nodes == i) then
                 n_entries = n_entries + 1
              end if
              current => current%next
           enddo
        end if
        if (n_entries == 0) exit
 !!! Create a temporary k node list for comparison
        allocate (set(n_entries))
        pos = 0
        if (feyngraph_set%use_dag) then
           do j=1, feyngraph_set%dag%n_nodes
              if (allocated (feyngraph_set%dag%node(j)%f_node)) then
                 do k=1, size(feyngraph_set%dag%node(j)%f_node)
                    if (associated (feyngraph_set%dag%node(j)%f_node(k)%node)) then
                       if (.not. (feyngraph_set%dag%node(j)%f_node(k)%node%incoming &
                            .or. feyngraph_set%dag%node(j)%f_node(k)%node%t_line) &
                            .and. feyngraph_set%dag%node(j)%f_node(k)%node%n_subtree_nodes == i) then
                          pos = pos + 1
                          set(pos)%node => feyngraph_set%dag%node(j)%f_node(k)%node
                       end if
                    end if
                 enddo
              end if
           enddo
        else
           current => feyngraph_set%f_node_list%first
           do while (associated (current))
              if (.not. (current%node%incoming .or. current%node%t_line) &
                   .and. current%node%n_subtree_nodes == i) then
                 pos = pos + 1
                 set(pos)%node => current%node
              end if
              current => current%next
           enddo
        end if
        allocate (compare_list)
        compare_list%observer = .true.
        do j = 1, n_entries
           call k_node_init_from_f_node (set(j)%node, k_set, &
                feyngraph_set)
           if (allocated (k_set)) deallocate (k_set)
        enddo
        !$OMP PARALLEL DO PRIVATE (k_entry)
        do j = 1, n_entries
           k_entry => set(j)%node%k_node_list%first
           do while (associated (k_entry))
              call node_assign_mapping_s(feyngraph_set%first, k_entry%node, feyngraph_set)
              k_entry => k_entry%next
           enddo
        enddo
        !$OMP END PARALLEL DO
        do j = 1, size (set)
           k_entry => set(j)%node%k_node_list%first
           do while (associated (k_entry))
              if (k_entry%node%keep) then
                 if (k_entry%node%mapping == NO_MAPPING .or. k_entry%node%mapping == NONRESONANT) then
                    call compare_list%add_pointer (k_entry%node)
                 end if
              end if
              k_entry => k_entry%next
           enddo
        enddo
        deallocate (set)
        call compare_list%check_subtree_equivalences(feyngraph_set%model)
        call compare_list%final
        deallocate (compare_list)
     enddo
   end subroutine f_node_list_compute_mappings_s
 
 @ %def f_node_list_compute_mappings_s
 @
 \subsection{Fill the grove list}
 Find the [[grove]] within the [[grove_list]] for a [[kingraph]] for
 which the kinematical calculations and mapping assignments have been completed. The [[groves]]
 are defined by the [[grove_prop]] entries and the value of the resonance
 hash ([[res_hash]]). Whenever a matching grove does not exist, we
 create one. In a first step we consider only part of the grove properties
 (see [[grove_prop_match]]) and the resonance hash is ignored, which leads
 to a preliminary grove list. In the end all numbers in [[grove_prop]] as
 well as the resonance hash are compared, i.e. we create a new
 [[grove_list]].
 <<Cascades2: grove list: TBP>>=
   procedure :: get_grove => grove_list_get_grove
 <<Cascades2: procedures>>=
   subroutine grove_list_get_grove (grove_list, kingraph, return_grove, preliminary)
     class (grove_list_t), intent (inout) :: grove_list
     type (kingraph_t), intent (in), pointer :: kingraph
     type (grove_t), intent (inout), pointer :: return_grove
     logical, intent (in) :: preliminary
     type (grove_t), pointer :: current_grove
     return_grove => null ()
     if (.not. associated(grove_list%first)) then
        allocate (grove_list%first)
        grove_list%first%grove_prop = kingraph%grove_prop
        return_grove => grove_list%first
        return
     end if
     current_grove => grove_list%first
     do while (associated (current_grove))
        if ((preliminary .and. (current_grove%grove_prop .match. kingraph%grove_prop)) .or. &
             (.not. preliminary .and. current_grove%grove_prop == kingraph%grove_prop)) then
           return_grove => current_grove
           exit
        else if (.not. associated (current_grove%next)) then
           allocate (current_grove%next)
           current_grove%next%grove_prop = kingraph%grove_prop
           if (size (kingraph%tree%bc) < 9) &
                current_grove%compare_tree%depth = 1
           return_grove => current_grove%next
           exit
        end if
        if (associated (current_grove%next)) then
           current_grove => current_grove%next
        end if
     enddo
   end subroutine grove_list_get_grove
 
 @ %def grove_list_get_grove
 @ Add a valid [[kingraph]] to a [[grove_list]]. We first look for the
 [[grove]] which has the grove properties of the [[kingraph]]. If no such
 [[grove]] exists so far, it is created.
 <<Cascades2: grove list: TBP>>=
   procedure :: add_kingraph => grove_list_add_kingraph
 <<Cascades2: procedures>>=
   subroutine grove_list_add_kingraph (grove_list, kingraph, preliminary, check, model)
     class (grove_list_t), intent (inout) :: grove_list
     type (kingraph_t), pointer, intent (inout) :: kingraph
     logical, intent (in) :: preliminary
     logical, intent (in) :: check
     type (model_data_t), optional, intent (in) :: model
     type (grove_t), pointer :: grove
     type (kingraph_t), pointer :: current
     integer, save :: index = 0
     grove => null ()
     current => null ()
     if (preliminary) then
        if (kingraph%index == 0) then
           index = index + 1
           kingraph%index = index
        end if
     end if
     call grove_list%get_grove (kingraph, grove, preliminary)
     if (check) then
        call grove%compare_tree%check_kingraph (kingraph, model, preliminary)
     end if
     if (kingraph%keep) then
        if (associated (grove%first)) then
           grove%last%grove_next => kingraph
           grove%last => kingraph
        else
           grove%first => kingraph
           grove%last => kingraph
        end if
     end if
   end subroutine grove_list_add_kingraph
 
 @ %ref grove_list_add_kingraph
 @ For a given [[feyngraph]] we store all valid [[kingraphs]] in the
 [[grove_list]].
 <<Cascades2: grove list: TBP>>=
   procedure :: add_feyngraph => grove_list_add_feyngraph
 <<Cascades2: procedures>>=
   subroutine grove_list_add_feyngraph (grove_list, feyngraph, model)
     class (grove_list_t), intent (inout) :: grove_list
     type (feyngraph_t), intent (inout) :: feyngraph
     type (model_data_t), intent (in) :: model
     type (kingraph_t), pointer :: current_kingraph, add_kingraph
     do while (associated (feyngraph%kin_first))
        if (feyngraph%kin_first%keep) then
           add_kingraph => feyngraph%kin_first
           feyngraph%kin_first => feyngraph%kin_first%next
           add_kingraph%next => null ()
           call grove_list%add_kingraph (kingraph=add_kingraph, &
                preliminary=.true., check=.true., model=model)
        else
           exit
        end if
     enddo
     if (associated (feyngraph%kin_first)) then
        current_kingraph => feyngraph%kin_first
        do while (associated (current_kingraph%next))
           if (current_kingraph%next%keep) then
              add_kingraph => current_kingraph%next
              current_kingraph%next => current_kingraph%next%next
              add_kingraph%next => null ()
              call grove_list%add_kingraph (kingraph=add_kingraph, &
                   preliminary=.true., check=.true., model=model)
           else
              current_kingraph => current_kingraph%next
           end if
        enddo
     end if
   end subroutine grove_list_add_feyngraph
 
 @ %def grove_list_add_feyngraph
 @ Compare two [[grove_prop]] objects. The [[.match.]] operator is used
 for preliminary groves in which the [[kingraphs]] share only the 3
 numbers [[n_resonances]], [[n_log_enhanced]] and [[n_t_channel]]. These
 groves are only used for comparing the kingraphs, because only graphs
 within these preliminary groves can be equivalent (the numbers which are
 compared here are unambigously fixed by the combination of mappings in
 these channels).
 <<Cascades2: interfaces>>=
   interface operator (.match.)
      module procedure grove_prop_match
   end interface operator (.match.)
 <<Cascades2: procedures>>=
   function grove_prop_match (grove_prop1, grove_prop2) result (gp_match)
     type (grove_prop_t), intent (in) :: grove_prop1
     type (grove_prop_t), intent (in) :: grove_prop2
     logical :: gp_match
     gp_match = (grove_prop1%n_resonances == grove_prop2%n_resonances) &
          .and. (grove_prop1%n_log_enhanced == grove_prop2%n_log_enhanced) &
          .and. (grove_prop1%n_t_channel == grove_prop2%n_t_channel)
   end function grove_prop_match
 
 @ %def grove_prop_match
 @ The equal operator on the other hand will be used when all valid
 [[kingraphs]] have been created and mappings have been determined, to
 split up the existing (preliminary) grove list, i.e. to create new
 groves which are determined by all entries in [[grove_prop_t]].
 <<Cascades2: interfaces>>=
   interface operator (==)
      module procedure grove_prop_equal
   end interface operator (==)
 <<Cascades2: procedures>>=
   function grove_prop_equal (grove_prop1, grove_prop2) result (gp_equal)
     type (grove_prop_t), intent (in) :: grove_prop1
     type (grove_prop_t), intent (in) :: grove_prop2
     logical :: gp_equal
     gp_equal = (grove_prop1%res_hash == grove_prop2%res_hash) &
          .and. (grove_prop1%n_resonances == grove_prop2%n_resonances) &
          .and. (grove_prop1%n_log_enhanced == grove_prop2%n_log_enhanced) &
          .and. (grove_prop1%n_off_shell == grove_prop2%n_off_shell) &
          .and. (grove_prop1%multiplicity == grove_prop2%multiplicity) &
          .and. (grove_prop1%n_t_channel == grove_prop2%n_t_channel)
   end function grove_prop_equal
 
 @ %def grove_prop_equal
 @
 \subsection{Remove equivalent channels}
 Here we define the equivalence condition for completed [[kingraphs]].
 The aim is to keep those [[kingraphs]] which describe the strongest
 peaks of the amplitude. The [[bincodes]] and [[mappings]] have to be
 the same for an equivalence, but the [[pdgs]] can be different. At
 the same time we check if the trees are exacly the same (up to the
 sign of pdg codes) in which case we do not keep both of them. This
 can be the case when the incoming particles are the same or their
 mutual anti-particles and there are no t-channel lines in the
 Feynman diagram to which the kingraph belongs.
 <<Cascades2: parameters>>=
   integer, parameter :: EMPTY = -999
 <<Cascades2: procedures>>=
   function kingraph_eqv (kingraph1, kingraph2) result (eqv)
     type (kingraph_t), intent (in) :: kingraph1
     type (kingraph_t), intent (inout) :: kingraph2
     logical :: eqv
     integer :: i
     logical :: equal
     eqv = .false.
     do i = kingraph1%tree%n_entries, 1, -1
        if (kingraph1%tree%bc(i) /= kingraph2%tree%bc(i)) return
     enddo
     do i = kingraph1%tree%n_entries, 1, -1
        if ( .not. (kingraph1%tree%mapping(i) == kingraph2%tree%mapping(i) &
             .or. ((kingraph1%tree%mapping(i) == NO_MAPPING .or. &
             kingraph1%tree%mapping(i) == NONRESONANT) .and. &
             (kingraph2%tree%mapping(i) == NO_MAPPING .or. &
             kingraph2%tree%mapping(i) == NONRESONANT)))) return
     enddo
     equal = .true.
     do i = kingraph1%tree%n_entries, 1, -1
        if (abs(kingraph1%tree%pdg(i)) /= abs(kingraph2%tree%pdg(i))) then
           equal = .false.;
           select case (kingraph1%tree%mapping(i))
           case (S_CHANNEL, RADIATION)
              select case (kingraph2%tree%mapping(i))
              case (S_CHANNEL, RADIATION)
                 return
              end select
           end select
        end if
     enddo
     if (equal) then
        kingraph2%keep = .false.
        call kingraph2%tree%final ()
     else
        eqv = .true.
     end if
   end function kingraph_eqv
 
 @ %def kingraph_eqv
 @ Select between two [[kingraphs]] which fulfill the equivalence
 condition above. This is done by comparing the [[pdg]] values of the
 [[tree]] for increasing bincode. If the particles are different at
 some place, we usually choose the one which would be returned first by the
 subroutine [[match_vertex]] of the model for the daughter [[pdg]] codes.
 Since we work here only on the basis of the the [[trees]] of the
 completed [[kingraphs]], we have to use the [[bc]] array to determine
 the positions of the daughter nodes' entries in the array. The graph
 which has to be kept should correspond to the stronger peak at the place
 which is compared.
 <<Cascades2: procedures>>=
   subroutine kingraph_select (kingraph1, kingraph2, model, preliminary)
     type (kingraph_t), intent (inout) :: kingraph1
     type (kingraph_t), intent (inout) :: kingraph2
     type (model_data_t), intent (in) :: model
     logical, intent (in) :: preliminary
     integer(TC), dimension(:), allocatable :: tmp_bc, daughter_bc
     integer, dimension(:), allocatable :: tmp_pdg, daughter_pdg
     integer, dimension (:), allocatable :: pdg_match
     integer :: i, j
     integer :: n_ext1, n_ext2
     if (kingraph_eqv (kingraph1, kingraph2)) then
        if (.not. preliminary) then
           kingraph2%keep = .false.; call kingraph2%tree%final ()
           return
        end if
        do i=1, size (kingraph1%tree%bc)
           if (abs(kingraph1%tree%pdg(i)) /= abs(kingraph2%tree%pdg(i))) then
              if (kingraph1%tree%mapping(i) /= EXTERNAL_PRT) then
                 n_ext1 = popcnt (kingraph1%tree%bc(i))
                 n_ext2 = n_ext1
                 do j=i+1, size (kingraph1%tree%bc)
                    if (abs(kingraph1%tree%pdg(j)) /= abs(kingraph2%tree%pdg(j))) then
                       n_ext2 = popcnt (kingraph1%tree%bc(j))
                       if (n_ext2 < n_ext1) exit
                    end if
                 enddo
                 if (n_ext2 < n_ext1) cycle
                 allocate (tmp_bc(i-1))
                 tmp_bc = kingraph1%tree%bc(:i-1)
                 allocate (tmp_pdg(i-1))
                 tmp_pdg = kingraph1%tree%pdg(:i-1)
                 do j=i-1, 1, - 1
                    where (iand (tmp_bc(:j-1),tmp_bc(j)) /= 0 &
                         .or. iand(tmp_bc(:j-1),kingraph1%tree%bc(i)) == 0)
                       tmp_bc(:j-1) = 0
                       tmp_pdg(:j-1) = 0
                    endwhere
                 enddo
                 allocate (daughter_bc(size(pack(tmp_bc, tmp_bc /= 0))))
                 daughter_bc = pack (tmp_bc, tmp_bc /= 0)
                 allocate (daughter_pdg(size(pack(tmp_pdg, tmp_pdg /= 0))))
                 daughter_pdg = pack (tmp_pdg, tmp_pdg /= 0)
                 if (size (daughter_pdg) == 2) then
                    call model%match_vertex(daughter_pdg(1), daughter_pdg(2), pdg_match)
                 end if
                 do j=1, size (pdg_match)
                    if (abs(pdg_match(j)) == abs(kingraph1%tree%pdg(i))) then
                       kingraph2%keep = .false.; call kingraph2%tree%final ()
                       exit
                    else if (abs(pdg_match(j)) == abs(kingraph2%tree%pdg(i))) then
                       kingraph1%keep = .false.; call kingraph1%tree%final ()
                       exit
                    end if
                 enddo
                 deallocate (tmp_bc, tmp_pdg, daughter_bc, daughter_pdg, pdg_match)
                 if (.not. (kingraph1%keep .and. kingraph2%keep)) exit
              end if
           end if
        enddo
     end if
   end subroutine kingraph_select
 
 @ %def kingraph_select
 @ At the beginning we do not care about the resonance hash, but only
 about part of the grove properties, which is defined in
 [[grove_prop_match]]. In these resulting preliminary groves the kingraphs
 can be equivalent, i.e. we do not have to compare all graphs with each
 other but only all graphs within each of these preliminary groves. In the
 end we create a new grove list where the grove properties of the
 [[kingraphs]] within a [[grove]] have to be exactly the same and in
 addition the groves are distinguished by the resonance hash values. Here
 the kingraphs are not compared any more, which means that the number of
 channels is not reduced any more.
 <<Cascades2: grove list: TBP>>=
   procedure :: merge => grove_list_merge
 <<Cascades2: procedures>>=
   subroutine grove_list_merge (target_list, grove_list, model, prc_component)
     class (grove_list_t), intent (inout) :: target_list
     type (grove_list_t), intent (inout) :: grove_list
     type (model_data_t), intent (in) :: model
     integer, intent (in) :: prc_component
     type (grove_t), pointer :: current_grove
     type (kingraph_t), pointer :: current_graph
     current_grove => grove_list%first
     do while (associated (current_grove))
        do while (associated (current_grove%first))
           current_graph => current_grove%first
           current_grove%first => current_grove%first%grove_next
           current_graph%grove_next => null ()
           if (current_graph%keep) then
              current_graph%prc_component = prc_component
              call target_list%add_kingraph(kingraph=current_graph, &
                   preliminary=.false., check=.true., model=model)
           else
              call current_graph%final ()
              deallocate (current_graph)
           end if
        enddo
        current_grove => current_grove%next
     enddo
   end subroutine grove_list_merge
 
 @ %def grove_list_merge
 @ Recreate a grove list where we have different groves for different
 resonance hashes.
 <<Cascades2: grove list: TBP>>=
   procedure :: rebuild => grove_list_rebuild
 <<Cascades2: procedures>>=
   subroutine grove_list_rebuild (grove_list)
     class (grove_list_t), intent (inout) :: grove_list
     type (grove_list_t) :: tmp_list
     type (grove_t), pointer :: current_grove
     type (grove_t), pointer :: remove_grove
     type (kingraph_t), pointer :: current_graph
     type (kingraph_t), pointer :: next_graph
     tmp_list%first => grove_list%first
     grove_list%first => null ()
     current_grove => tmp_list%first
     do while (associated (current_grove))
        current_graph => current_grove%first
        do while (associated (current_graph))
           call current_graph%assign_resonance_hash ()
           next_graph => current_graph%grove_next
           current_graph%grove_next => null ()
           if (current_graph%keep) then
              call grove_list%add_kingraph (kingraph=current_graph, &
                   preliminary=.false., check=.false.)
           end if
           current_graph => next_graph
        enddo
        current_grove => current_grove%next
     enddo
     call tmp_list%final
   end subroutine grove_list_rebuild
 
 @ %def grove_list_rebuild
 @
 \subsection{Write the phase-space file}
 The phase-space file is written from the graphs which survive the
 calculations and equivalence checks and are in the grove list. It is
 written grove by grove. The output should be the same as in the
 corresponding procedure [[cascade_set_write_file_format]] of
 [[cascades]], up to the order of groves and channels.
 <<Cascades2: public>>=
   public :: feyngraph_set_write_file_format
 <<Cascades2: procedures>>=
   subroutine feyngraph_set_write_file_format (feyngraph_set, u)
     type (feyngraph_set_t), intent (in) :: feyngraph_set
     integer, intent (in) :: u
     type (grove_t), pointer :: grove
     integer :: channel_number
     integer :: grove_number
     channel_number = 0
     grove_number = 0
     grove => feyngraph_set%grove_list%first
     do while (associated (grove))
        grove_number = grove_number + 1
        call grove%write_file_format (feyngraph_set, grove_number, channel_number, u)
        grove => grove%next
     enddo
   end subroutine feyngraph_set_write_file_format
 
 @ %def feyngraph_set_write_file_format
 @ Write the relevant information of the [[kingraphs]] of a [[grove]] and
 the grove properties in the file format.
 <<Cascades2: grove: TBP>>=
   procedure :: write_file_format => grove_write_file_format
 <<Cascades2: procedures>>=
     recursive subroutine grove_write_file_format (grove, feyngraph_set, gr_number, ch_number, u)
       class (grove_t), intent (in) :: grove
       type (feyngraph_set_t), intent (in) :: feyngraph_set
       integer, intent (in) :: u
       integer, intent (inout) :: gr_number
       integer, intent (inout) :: ch_number
       type (kingraph_t), pointer :: current
 1     format(3x,A,1x,40(1x,I4))
       write (u, "(A)")
       write (u, "(1x,'!',1x,A,1x,I0,A)", advance='no') &
            'Multiplicity =', grove%grove_prop%multiplicity, ","
       select case (grove%grove_prop%n_resonances)
       case (0)
          write (u, '(1x,A)', advance='no') 'no resonances, '
       case (1)
          write (u, '(1x,A)', advance='no') '1 resonance,  '
       case default
          write (u, '(1x,I0,1x,A)', advance='no') &
               grove%grove_prop%n_resonances, 'resonances, '
       end select
       write (u, '(1x,I0,1x,A)', advance='no') &
            grove%grove_prop%n_log_enhanced, 'logs, '
       write (u, '(1x,I0,1x,A)', advance='no') &
            grove%grove_prop%n_off_shell, 'off-shell, '
       select case (grove%grove_prop%n_t_channel)
       case (0);  write (u, '(1x,A)') 's-channel graph'
       case (1);  write (u, '(1x,A)') '1 t-channel line'
       case default
          write(u,'(1x,I0,1x,A)') &
               grove%grove_prop%n_t_channel, 't-channel lines'
       end select
       write (u, '(1x,A,I0)') 'grove #', gr_number
       current => grove%first
       do while (associated (current))
          if (current%keep) then
             ch_number = ch_number + 1
             call current%write_file_format (feyngraph_set, ch_number, u)
          end if
          current => current%grove_next
       enddo
     end subroutine grove_write_file_format
 
 @ %def grove_write_file_format
 @ Write the relevant information of a valid [[kingraph]] in the file
 format. The information is extracted from the [[tree]].
 <<Cascades2: kingraph: TBP>>=
   procedure :: write_file_format => kingraph_write_file_format
 <<Cascades2: procedures>>=
   subroutine kingraph_write_file_format (kingraph, feyngraph_set, ch_number, u)
     class (kingraph_t), intent (in) :: kingraph
     type (feyngraph_set_t), intent (in) :: feyngraph_set
     integer, intent (in) :: ch_number
     integer, intent (in) :: u
     integer :: i
     integer(TC) :: bincode_incoming
 2   format(3X,'map',1X,I3,1X,A,1X,I9,1X,'!',1X,A)
 !!! determine bincode of incoming particle from tree
     bincode_incoming = maxval (kingraph%tree%bc)
     write (unit=u, fmt='(1X,A,I0)') '! Channel #', ch_number
     write (unit=u, fmt='(3X,A,1X)', advance='no') 'tree'
     do i=1, size (kingraph%tree%bc)
        if (kingraph%tree%mapping(i) >=0 .or. kingraph%tree%mapping(i) == NONRESONANT &
             .or. (kingraph%tree%bc(i) == bincode_incoming &
             .and. feyngraph_set%process_type == DECAY)) then
           write (unit=u, fmt='(1X,I0)', advance='no') kingraph%tree%bc(i)
        end if
     enddo
     write (unit=u, fmt='(A)', advance='yes')
     do i=1, size(kingraph%tree%bc)
        select case (kingraph%tree%mapping(i))
        case (NO_MAPPING, NONRESONANT, EXTERNAL_PRT)
        case (S_CHANNEL)
           write (unit=u, fmt=2) kingraph%tree%bc(i), 's_channel', &
                kingraph%tree%pdg(i), &
                trim(get_particle_name (feyngraph_set, kingraph%tree%pdg(i)))
        case (T_CHANNEL)
           write (unit=u, fmt=2) kingraph%tree%bc(i), 't_channel', &
                abs (kingraph%tree%pdg(i)), &
                trim(get_particle_name (feyngraph_set, abs(kingraph%tree%pdg(i))))
        case (U_CHANNEL)
           write (unit=u, fmt=2) kingraph%tree%bc(i), 'u_channel', &
                abs (kingraph%tree%pdg(i)), &
                trim(get_particle_name (feyngraph_set, abs(kingraph%tree%pdg(i))))
        case (RADIATION)
           write (unit=u, fmt=2) kingraph%tree%bc(i), 'radiation', &
                kingraph%tree%pdg(i), &
                trim(get_particle_name (feyngraph_set, kingraph%tree%pdg(i)))
        case (COLLINEAR)
           write (unit=u, fmt=2) kingraph%tree%bc(i), 'collinear', &
                kingraph%tree%pdg(i), &
                trim(get_particle_name (feyngraph_set, kingraph%tree%pdg(i)))
        case (INFRARED)
           write (unit=u, fmt=2) kingraph%tree%bc(i), 'infrared ', &
                kingraph%tree%pdg(i), &
                trim(get_particle_name (feyngraph_set, kingraph%tree%pdg(i)))
        case (ON_SHELL)
           write (unit=u, fmt=2) kingraph%tree%bc(i), 'on_shell ', &
                kingraph%tree%pdg(i), &
                trim(get_particle_name (feyngraph_set, kingraph%tree%pdg(i)))
        case default
           call msg_bug (" Impossible mapping mode encountered")
        end select
     enddo
   end subroutine kingraph_write_file_format
 
 @ %def kingraph_write_file_format
 @ Get the particle name from the [[particle]] array of the
 [[feyngraph_set]]. This is needed for the phs file creation.
 <<Cascades2: procedures>>=
    function get_particle_name (feyngraph_set, pdg) result (particle_name)
      type (feyngraph_set_t), intent (in) :: feyngraph_set
      integer, intent (in) :: pdg
      character (len=LABEL_LEN) :: particle_name
      integer :: i
      do i=1, size (feyngraph_set%particle)
         if (feyngraph_set%particle(i)%pdg == pdg) then
            particle_name = feyngraph_set%particle(i)%particle_label
            exit
         end if
      enddo
    end function get_particle_name
 
 @ %def get_particle_name
 @
 \subsection{Invert a graph}
 All Feynman diagrams given by O'Mega look like a decay. The [[feyngraph]]
 which is constructed from this output also looks like a decay, where one
 of the incoming particles is the decaying particle (or the root of the
 tree). The calculations can in principle be done on this data structure.
 However, it is also performed with the other incoming particle as
 the root. The first part of the calculation is the same for both cases.
 For the second part we need to transform/turn the graphs such that the
 other incoming particle becomes the root. This is done by identifying
 the incoming particles from the O'Mega output (the first one is simply
 the root of the existing tree, the second contains [2] in the
 [[particle_label]]) and the nodes/particles which connect both incoming
 particles (here we set [[t_line = .true.]]). At the same time we set the
 pointers  [[inverse_daughter1]] and [[inverse_daughter2]] for the
 corresponding node, which point to the mother node and the other daughter
 of the mother node; these will be the daughters of the node in the
 inverted [[feyngraph]].
 <<Cascades2: feyngraph: TBP>>=
   procedure :: make_invertible => feyngraph_make_invertible
 <<Cascades2: procedures>>=
   subroutine feyngraph_make_invertible (feyngraph)
     class (feyngraph_t), intent (inout) :: feyngraph
     logical :: t_line_found
     feyngraph%root%incoming = .true.
     t_line_found = .false.
     if (associated (feyngraph%root%daughter1)) then
        call f_node_t_line_check (feyngraph%root%daughter1, t_line_found)
        if (.not. t_line_found) then
           if (associated (feyngraph%root%daughter2)) then
              call f_node_t_line_check (feyngraph%root%daughter2, t_line_found)
           end if
        end if
     end if
 
   contains
 
 <<k node t line check>>
   end subroutine feyngraph_make_invertible
 
 @ %def feyngraph_make_invertible
 @ Check if a node has to be [[t_line]] or [[incoming]] and assign
 inverse daughter pointers.
 <<k node t line check>>=
   recursive subroutine f_node_t_line_check (node, t_line_found)
     type (f_node_t), target, intent (inout) :: node
     integer :: pos
     logical, intent (inout) :: t_line_found
     if (associated (node%daughter1)) then
        call f_node_t_line_check (node%daughter1, t_line_found)
        if (node%daughter1%incoming .or. node%daughter1%t_line) then
           node%t_line = .true.
        else if (associated (node%daughter2)) then
           call f_node_t_line_check (node%daughter2, t_line_found)
           if (node%daughter2%incoming .or. node%daughter2%t_line) then
              node%t_line = .true.
           end if
        end if
     else
        pos = index (node%particle_label, '[') + 1
        if (node%particle_label(pos:pos) == '2') then
           node%incoming = .true.
           t_line_found = .true.
        end if
     end if
   end subroutine f_node_t_line_check
 
 @ %def k_node_t_line_check
 @ Make an inverted copy of a [[kingraph]] using the inverse daughter
 pointers.
 <<Cascades2: kingraph: TBP>>=
   procedure :: make_inverse_copy => kingraph_make_inverse_copy
 <<Cascades2: procedures>>=
   subroutine kingraph_make_inverse_copy (original_kingraph, feyngraph)
     class (kingraph_t), intent (inout) :: original_kingraph
     type (feyngraph_t), intent (inout) :: feyngraph
     type (kingraph_t), pointer :: kingraph_copy
     type (k_node_t), pointer :: potential_root
     allocate (kingraph_copy)
     if (associated (feyngraph%kin_last)) then
        allocate (feyngraph%kin_last%next)
        feyngraph%kin_last => feyngraph%kin_last%next
     else
        allocate(feyngraph%kin_first)
        feyngraph%kin_last => feyngraph%kin_first
     end if
     kingraph_copy => feyngraph%kin_last
     call kingraph_set_inverse_daughters (original_kingraph)
     kingraph_copy%inverse = .true.
     kingraph_copy%n_nodes = original_kingraph%n_nodes
     kingraph_copy%keep = original_kingraph%keep
     potential_root => original_kingraph%root
     do while (.not. potential_root%incoming .or. &
          (associated (potential_root%daughter1) .and. associated (potential_root%daughter2)))
        if (potential_root%daughter1%incoming .or. potential_root%daughter1%t_line) then
           potential_root => potential_root%daughter1
        else if (potential_root%daughter2%incoming .or. potential_root%daughter2%t_line) then
           potential_root => potential_root%daughter2
        end if
     enddo
     call node_inverse_deep_copy (potential_root, kingraph_copy%root)
   end subroutine kingraph_make_inverse_copy
 
 @ %def kingraph_make_inverse_copy
 @ Recursively deep-copy nodes, but along the t-line the inverse daughters
 become the new daughters. We need a deep copy only for the [[incoming]]
 or [[t_line]] nodes. For the other nodes (of s-channel subgraphs) we set
 only pointers to the existing nodes of the non-inverted graph.
 <<Cascades2: procedures>>=
   recursive subroutine node_inverse_deep_copy (original_node, node_copy)
     type (k_node_t), intent (in) :: original_node
     type (k_node_t), pointer, intent (out) :: node_copy
     call original_node%f_node%k_node_list%add_entry(node_copy, recycle=.false.)
     node_copy = original_node
     if (node_copy%t_line .or. node_copy%incoming) then
        node_copy%particle => original_node%particle%anti
     else
        node_copy%particle => original_node%particle
     end if
     if (associated (original_node%inverse_daughter1) .and. associated (original_node%inverse_daughter2)) then
        if (original_node%inverse_daughter1%incoming .or. original_node%inverse_daughter1%t_line) then
           node_copy%daughter2 => original_node%inverse_daughter2
           call node_inverse_deep_copy (original_node%inverse_daughter1, &
                node_copy%daughter1)
        else if (original_node%inverse_daughter2%incoming .or. original_node%inverse_daughter2%t_line) then
           node_copy%daughter1 => original_node%inverse_daughter1
           call node_inverse_deep_copy (original_node%inverse_daughter2, &
                node_copy%daughter2)
        end if
     end if
   end subroutine node_inverse_deep_copy
 
 @ %def node_inverse_deep_copy
 @
 \subsection{Find phase-space parametrizations}
 Perform all mapping calculations for a single process and store valid
 [[kingraphs]] (channels) into the grove list, without caring for instance
 about the resonance hash values.
 <<Cascades2: public>>=
   public :: feyngraph_set_generate_single
 <<Cascades2: procedures>>=
   subroutine feyngraph_set_generate_single (feyngraph_set, model, n_in, n_out, &
        phs_par, fatal_beam_decay, u_in)
     type(feyngraph_set_t), intent(inout) :: feyngraph_set
     type(model_data_t), target, intent(in) :: model
     integer, intent(in) :: n_in, n_out
     type(phs_parameters_t), intent(in) :: phs_par
     logical, intent(in) :: fatal_beam_decay
     integer, intent(in) :: u_in
     feyngraph_set%n_in = n_in
     feyngraph_set%n_out = n_out
     feyngraph_set%process_type = n_in
     feyngraph_set%phs_par = phs_par
     feyngraph_set%model => model
     call msg_debug (D_PHASESPACE, "Construct relevant Feynman diagrams from Omega output")
     call feyngraph_set%build (u_in)
     call msg_debug (D_PHASESPACE, "Find phase-space parametrizations")
     call feyngraph_set_find_phs_parametrizations(feyngraph_set)
   end subroutine feyngraph_set_generate_single
 
 @ %def feyngraph_set_generate_single
 @ Find the phase space parametrizations. We start with the computation
 of pure s-channel subtrees, i.e. we determine mappings and compare
 subtrees in order to reduce the number of channels. This can be
 parallelized easily. When all s-channel [[k_nodes]] exist, the possible
 [[kingraphs]] are created using these nodes and we determine mappings for
 t-channel nodes.
 <<Cascades2: procedures>>=
   subroutine feyngraph_set_find_phs_parametrizations (feyngraph_set)
     class (feyngraph_set_t), intent (inout) :: feyngraph_set
     type (feyngraph_t), pointer :: current => null ()
     type (feyngraph_ptr_t), dimension (:), allocatable :: set
     integer :: pos
     integer :: i
     allocate (set (feyngraph_set%n_graphs))
     pos = 0
     current => feyngraph_set%first
     do while (associated (current))
        pos = pos + 1
        set(pos)%graph => current
        current => current%next
     enddo
     if (feyngraph_set%process_type == SCATTERING) then
        !$OMP PARALLEL DO
        do i=1, feyngraph_set%n_graphs
           if (set(i)%graph%keep) then
              call set(i)%graph%make_invertible ()
           end if
        enddo
        !$OMP END PARALLEL DO
     end if
     call f_node_list_compute_mappings_s (feyngraph_set)
     do i=1, feyngraph_set%n_graphs
        if (set(i)%graph%keep) then
           call set(i)%graph%make_kingraphs (feyngraph_set)
        end if
     enddo
     if (feyngraph_set%process_type == SCATTERING) then
        do i=1, feyngraph_set%n_graphs
           if (set(i)%graph%keep) then
              call set(i)%graph%make_inverse_kingraphs ()
           end if
        enddo
     end if
     do i=1, feyngraph_set%n_graphs
        if (set(i)%graph%keep) then
           call set(i)%graph%compute_mappings (feyngraph_set)
        end if
     enddo
     do i=1, feyngraph_set%n_graphs
        if (set(i)%graph%keep) then
           call feyngraph_set%grove_list%add_feyngraph (set(i)%graph, &
                feyngraph_set%model)
        end if
     enddo
   end subroutine feyngraph_set_find_phs_parametrizations
 
 @ %def feyngraph_set_find_phs_parametrizations
 @ Compare objects of type [[tree_t]].
 <<Cascades2: interfaces>>=
   interface operator (==)
      module procedure tree_equal
   end interface operator (==)
 <<Cascades2: procedures>>=
   elemental function tree_equal (tree1, tree2) result (flag)
     type (tree_t), intent (in) :: tree1, tree2
     logical :: flag
     if (tree1%n_entries == tree2%n_entries) then
        if (tree1%bc(size(tree1%bc)) == tree2%bc(size(tree2%bc))) then
           flag = all (tree1%mapping == tree2%mapping) .and. &
                all (tree1%bc == tree2%bc) .and. &
                all (abs(tree1%pdg) == abs(tree2%pdg))
        else
           flag = .false.
        end if
     else
        flag = .false.
     end if
   end function tree_equal
 
 @ %def tree_equal
 @ Select between equivalent subtrees (type [[tree_t]]). This is similar
 to [[kingraph_select]], but we compare only positions with mappings
 [[NONRESONANT]] and [[NO_MAPPING]].
 <<Cascades2: interfaces>>=
   interface operator (.eqv.)
      module procedure subtree_eqv
   end interface operator (.eqv.)
 <<Cascades2: procedures>>=
   pure function subtree_eqv (subtree1, subtree2) result (eqv)
     type (tree_t), intent (in) :: subtree1, subtree2
     logical :: eqv
     integer :: root_pos
     integer :: i
     logical :: equal
     eqv = .false.
     if (subtree1%n_entries /= subtree2%n_entries) return
     root_pos = subtree1%n_entries
     if (subtree1%mapping(root_pos) == NONRESONANT .or. &
          subtree2%mapping(root_pos) == NONRESONANT .or. &
          (subtree1%mapping(root_pos) == NO_MAPPING .and. &
          subtree2%mapping(root_pos) == NO_MAPPING .and. &
          abs(subtree1%pdg(root_pos)) == abs(subtree2%pdg(root_pos)))) then
        do i = subtree1%n_entries, 1, -1
           if (subtree1%bc(i) /= subtree2%bc(i)) return
        enddo
        equal = .true.
        do i = subtree1%n_entries, 1, -1
           if (abs(subtree1%pdg(i)) /= abs (subtree2%pdg(i))) then
              select case (subtree1%mapping(i))
              case (NO_MAPPING, NONRESONANT)
                 select case (subtree2%mapping(i))
                 case (NO_MAPPING, NONRESONANT)
                    equal = .false.
                 case default
                    return
                 end select
              case default
                 return
              end select
           end if
        enddo
        do i = subtree1%n_entries, 1, -1
           if (subtree1%mapping(i) /= subtree2%mapping(i)) then
              select case (subtree1%mapping(i))
              case (NO_MAPPING, NONRESONANT)
                 select case (subtree2%mapping(i))
                 case (NO_MAPPING, NONRESONANT)
                 case default
                    return
                 end select
              case default
                 return
              end select
           end if
        enddo
        if (.not. equal) eqv = .true.
     end if
   end function subtree_eqv
 
 @ %def subtree_eqv
 <<Cascades2: procedures>>=
   subroutine subtree_select (subtree1, subtree2, model)
     type (tree_t), intent (inout) :: subtree1, subtree2
     type (model_data_t), intent (in) :: model
     integer :: j, k
     integer(TC), dimension(:), allocatable :: tmp_bc, daughter_bc
     integer, dimension(:), allocatable :: tmp_pdg, daughter_pdg
     integer, dimension (:), allocatable :: pdg_match
     if (subtree1 .eqv. subtree2) then
        do j=1, subtree1%n_entries
           if (abs(subtree1%pdg(j)) /= abs(subtree2%pdg(j))) then
              tmp_bc = subtree1%bc(:j-1); tmp_pdg = subtree1%pdg(:j-1)
              do k=j-1, 1, - 1
                 where (iand (tmp_bc(:k-1),tmp_bc(k)) /= 0 &
                      .or. iand(tmp_bc(:k-1),subtree1%bc(j)) == 0)
                    tmp_bc(:k-1) = 0
                    tmp_pdg(:k-1) = 0
                 endwhere
              enddo
              daughter_bc = pack (tmp_bc, tmp_bc /= 0)
              daughter_pdg = pack (tmp_pdg, tmp_pdg /= 0)
              if (size (daughter_pdg) == 2) then
                 call model%match_vertex(daughter_pdg(1), daughter_pdg(2), pdg_match)
                 if (.not. allocated (pdg_match)) then
 !!! Relevant if tree contains only abs (pdg). In this case, changing the
 !!! sign of one of the pdg codes should give a result.
                    call model%match_vertex(-daughter_pdg(1), daughter_pdg(2), pdg_match)
                 end if
              end if
              do k=1, size (pdg_match)
                 if (abs(pdg_match(k)) == abs(subtree1%pdg(j))) then
                    if (subtree1%keep) subtree2%keep = .false.
                    exit
                 else if (abs(pdg_match(k)) == abs(subtree2%pdg(j))) then
                    if (subtree2%keep) subtree1%keep = .false.
                    exit
                 end if
              enddo
              deallocate (tmp_bc, tmp_pdg, daughter_bc, daughter_pdg, pdg_match)
              if (.not. (subtree1%keep .and. subtree2%keep)) exit
           end if
        enddo
     end if
   end subroutine subtree_select
 
 @ %def subtree_select
 @ Assign a resonance hash value to a [[kingraph]], like in [[cascades]],
 but here without the array [[tree_resonant]].
 <<Cascades2: kingraph: TBP>>=
   procedure :: assign_resonance_hash => kingraph_assign_resonance_hash
 <<Cascades2: procedures>>=
   subroutine kingraph_assign_resonance_hash (kingraph)
     class (kingraph_t), intent (inout) :: kingraph
     logical, dimension (:), allocatable :: tree_resonant
     integer(i8), dimension(1) :: mold
     allocate (tree_resonant (kingraph%tree%n_entries))
     tree_resonant = (kingraph%tree%mapping == S_CHANNEL)
     kingraph%grove_prop%res_hash = hash (transfer &
          ([sort (pack (kingraph%tree%pdg, tree_resonant)), &
            sort (pack (abs (kingraph%tree%pdg), &
            kingraph%tree%mapping == T_CHANNEL .or. &
            kingraph%tree%mapping == U_CHANNEL))], mold))
     deallocate (tree_resonant)
   end subroutine kingraph_assign_resonance_hash
 
 @ %def kingraph_assign_resonance_hash
 @ Write the process in the bincode format. This is again a copy of the
 corresponding procedure in [[cascades]], using [[feyngraph_set]] instead
 of [[cascade_set]] as an argument.
 <<Cascades2: public>>=
   public :: feyngraph_set_write_process_bincode_format
 <<Cascades2: procedures>>=
   subroutine feyngraph_set_write_process_bincode_format (feyngraph_set, unit)
     type(feyngraph_set_t), intent(in), target :: feyngraph_set
     integer, intent(in), optional :: unit
     integer, dimension(:), allocatable :: bincode, field_width
     integer :: n_in, n_out, n_tot, n_flv
     integer :: u, f, i, bc
     character(20) :: str
     type(string_t) :: fmt_head
     type(string_t), dimension(:), allocatable :: fmt_proc
     u = given_output_unit (unit);  if (u < 0)  return
     if (.not. allocated (feyngraph_set%flv)) return
     write (u, "('!',1x,A)")  "List of subprocesses with particle bincodes:"
     n_in  = feyngraph_set%n_in
     n_out = feyngraph_set%n_out
     n_tot = n_in + n_out
     n_flv = size (feyngraph_set%flv, 2)
     allocate (bincode (n_tot), field_width (n_tot), fmt_proc (n_tot))
     bc = 1
     do i = 1, n_out
        bincode(n_in + i) = bc
        bc = 2 * bc
     end do
     do i = n_in, 1, -1
        bincode(i) = bc
        bc = 2 * bc
     end do
     do i = 1, n_tot
        write (str, "(I0)")  bincode(i)
        field_width(i) = len_trim (str)
        do f = 1, n_flv
           field_width(i) = max (field_width(i), &
                len (feyngraph_set%flv(i,f)%get_name ()))
        end do
     end do
     fmt_head = "('!'"
     do i = 1, n_tot
        fmt_head = fmt_head // ",1x,"
        fmt_proc(i) = "(1x,"
        write (str, "(I0)")  field_width(i)
        fmt_head = fmt_head // "I" // trim(str)
        fmt_proc(i) = fmt_proc(i) // "A" // trim(str)
        if (i == n_in) then
           fmt_head = fmt_head // ",1x,'  '"
        end if
     end do
     do i = 1, n_tot
        fmt_proc(i) = fmt_proc(i) // ")"
     end do
     fmt_head = fmt_head // ")"
     write (u, char (fmt_head))  bincode
     do f = 1, n_flv
        write (u, "('!')", advance="no")
        do i = 1, n_tot
           write (u, char (fmt_proc(i)), advance="no") &
                char (feyngraph_set%flv(i,f)%get_name ())
           if (i == n_in)  write (u, "(1x,'=>')", advance="no")
        end do
        write (u, *)
     end do
     write (u, char (fmt_head))  bincode
   end subroutine feyngraph_set_write_process_bincode_format
 
 @ %def feyngraph_set_write_process_bincode_format
 @ Write tex file for graphical display of channels.
 <<Cascades2: public>>=
   public :: feyngraph_set_write_graph_format
 <<Cascades2: procedures>>=
   subroutine feyngraph_set_write_graph_format (feyngraph_set, filename, process_id, unit)
     type(feyngraph_set_t), intent(in), target :: feyngraph_set
     type(string_t), intent(in) :: filename, process_id
     integer, intent(in), optional :: unit
     type(kingraph_t), pointer :: kingraph
     type(grove_t), pointer :: grove
     integer :: u, n_grove, count, pgcount
     logical :: first_in_grove
     u = given_output_unit (unit);  if (u < 0)  return
     write (u, '(A)') "\documentclass[10pt]{article}"
     write (u, '(A)') "\usepackage{amsmath}"
     write (u, '(A)') "\usepackage{feynmp}"
     write (u, '(A)') "\usepackage{url}"
     write (u, '(A)') "\usepackage{color}"
     write (u, *)
     write (u, '(A)') "\textwidth 18.5cm"
     write (u, '(A)') "\evensidemargin -1.5cm"
     write (u, '(A)') "\oddsidemargin -1.5cm"
     write (u, *)
     write (u, '(A)') "\newcommand{\blue}{\color{blue}}"
     write (u, '(A)') "\newcommand{\green}{\color{green}}"
     write (u, '(A)') "\newcommand{\red}{\color{red}}"
     write (u, '(A)') "\newcommand{\magenta}{\color{magenta}}"
     write (u, '(A)') "\newcommand{\cyan}{\color{cyan}}"
     write (u, '(A)') "\newcommand{\sm}{\footnotesize}"
     write (u, '(A)') "\setlength{\parindent}{0pt}"
     write (u, '(A)') "\setlength{\parsep}{20pt}"
     write (u, *)
     write (u, '(A)') "\begin{document}"
     write (u, '(A)') "\begin{fmffile}{" // char (filename) // "}"
     write (u, '(A)') "\fmfcmd{color magenta; magenta = red + blue;}"
     write (u, '(A)') "\fmfcmd{color cyan; cyan = green + blue;}"
     write (u, '(A)') "\begin{fmfshrink}{0.5}"
     write (u, '(A)') "\begin{flushleft}"
     write (u, *)
     write (u, '(A)') "\noindent" // &
          & "\textbf{\large\texttt{WHIZARD} phase space channels}" // &
          & "\hfill\today"
     write (u, *)
     write (u, '(A)') "\vspace{10pt}"
     write (u, '(A)') "\noindent" // &
          & "\textbf{Process:} \url{" // char (process_id) // "}"
     call feyngraph_set_write_process_tex_format (feyngraph_set, u)
     write (u, *)
     write (u, '(A)') "\noindent" // &
          & "\textbf{Note:} These are pseudo Feynman graphs that "
     write (u, '(A)') "visualize phase-space parameterizations " // &
          & "(``integration channels'').  "
     write (u, '(A)') "They do \emph{not} indicate Feynman graphs used for the " // &
          & "matrix element."
     write (u, *)
     write (u, '(A)') "\textbf{Color code:} " // &
          & "{\blue resonance,} " // &
          & "{\cyan t-channel,} " // &
          & "{\green radiation,} "
     write (u, '(A)') "{\red infrared,} " // &
          & "{\magenta collinear,} " // &
          & "external/off-shell"
     write (u, *)
     write (u, '(A)') "\noindent" // &
          & "\textbf{Black square:} Keystone, indicates ordering of " // &
          & "phase space parameters."
     write (u, *)
     write (u, '(A)') "\vspace{-20pt}"
     count = 0
     pgcount = 0
     n_grove = 0
     grove => feyngraph_set%grove_list%first
     do while (associated (grove))
        n_grove = n_grove + 1
        write (u, *)
        write (u, '(A)') "\vspace{20pt}"
        write (u, '(A)') "\begin{tabular}{l}"
        write (u, '(A,I5,A)') &
             & "\fbox{\bf Grove \boldmath$", n_grove, "$} \\[10pt]"
        write (u, '(A,I1,A)') "Multiplicity: ", &
             grove%grove_prop%multiplicity, "\\"
        write (u, '(A,I1,A)') "Resonances:   ", &
             grove%grove_prop%n_resonances, "\\"
        write (u, '(A,I1,A)') "Log-enhanced: ", &
             grove%grove_prop%n_log_enhanced, "\\"
        write (u, '(A,I1,A)') "Off-shell:    ", &
             grove%grove_prop%n_off_shell, "\\"
        write (u, '(A,I1,A)') "t-channel:    ", &
             grove%grove_prop%n_t_channel, ""
        write (u, '(A)') "\end{tabular}"
        kingraph => grove%first
        do while (associated (kingraph))
           count = count + 1
           call kingraph_write_graph_format (kingraph, count, unit)
           kingraph => kingraph%grove_next
        enddo
        grove => grove%next
     enddo
     write (u, '(A)') "\end{flushleft}"
     write (u, '(A)') "\end{fmfshrink}"
     write (u, '(A)') "\end{fmffile}"
     write (u, '(A)') "\end{document}"
   end subroutine feyngraph_set_write_graph_format
 
 @ %def feyngraph_set_write_graph_format
 @ Write the process as a \LaTeX\ expression. This is a slightly modified
 copy of [[cascade_set_write_process_tex_format]] which has only been
 adapted to the types which are used here.
 <<Cascades2: procedures>>=
   subroutine feyngraph_set_write_process_tex_format (feyngraph_set, unit)
     type(feyngraph_set_t), intent(in), target :: feyngraph_set
     integer, intent(in), optional :: unit
     integer :: n_tot
     integer :: u, f, i
     n_tot = feyngraph_set%n_in + feyngraph_set%n_out
     u = given_output_unit (unit);  if (u < 0)  return
     if (.not. allocated (feyngraph_set%flv)) return
     write (u, "(A)")  "\begin{align*}"
     do f = 1, size (feyngraph_set%flv, 2)
        do i = 1, feyngraph_set%n_in
           if (i > 1)  write (u, "(A)", advance="no") "\quad "
           write (u, "(A)", advance="no") &
                char (feyngraph_set%flv(i,f)%get_tex_name ())
        end do
        write (u, "(A)", advance="no")  "\quad &\to\quad "
        do i = feyngraph_set%n_in + 1, n_tot
           if (i > feyngraph_set%n_in + 1)  write (u, "(A)", advance="no") "\quad "
           write (u, "(A)", advance="no") &
                char (feyngraph_set%flv(i,f)%get_tex_name ())
        end do
        if (f < size (feyngraph_set%flv, 2)) then
           write (u, "(A)")  "\\"
        else
           write (u, "(A)")  ""
        end if
     end do
     write (u, "(A)")  "\end{align*}"
   end subroutine feyngraph_set_write_process_tex_format
 
 @ %def feyngraph_set_write_process_tex_format
 @ This creates metapost source for graphical display for a given [[kingraph]].
 It is the analogon to [[cascade_write_graph_format]] (a modified copy).
 <<Cascades2: procedures>>=
   subroutine kingraph_write_graph_format (kingraph, count, unit)
     type(kingraph_t), intent(in) :: kingraph
     integer, intent(in) :: count
     integer, intent(in), optional :: unit
     integer :: u
     type(string_t) :: left_str, right_str
     u = given_output_unit (unit);  if (u < 0)  return
     left_str = ""
     right_str = ""
     write (u, '(A)') "\begin{minipage}{105pt}"
     write (u, '(A)') "\vspace{30pt}"
     write (u, '(A)') "\begin{center}"
     write (u, '(A)') "\begin{fmfgraph*}(55,55)"
     call graph_write_node (kingraph%root)
     write (u, '(A)') "\fmfleft{" // char (extract (left_str, 2)) // "}"
     write (u, '(A)') "\fmfright{" // char (extract (right_str, 2)) // "}"
     write (u, '(A)') "\end{fmfgraph*}\\"
     write (u, '(A,I5,A)') "\fbox{$", count, "$}"
     write (u, '(A)') "\end{center}"
     write (u, '(A)') "\end{minipage}"
     write (u, '(A)') "%"
   contains
     recursive subroutine graph_write_node (node)
       type(k_node_t), intent(in) :: node
       if (associated (node%daughter1) .or. associated (node%daughter2)) then
          if (node%daughter2%t_line .or. node%daughter2%incoming) then
             call vertex_write (node, node%daughter2)
             call vertex_write (node, node%daughter1)
          else
             call vertex_write (node, node%daughter1)
             call vertex_write (node, node%daughter2)
          end if
          if (node%mapping == EXTERNAL_PRT) then
             call line_write (node%bincode, 0, node%particle)
             call external_write (node%bincode, node%particle%tex_name, &
                  left_str)
             write (u, '(A,I0,A)') "\fmfv{d.shape=square}{v0}"
          end if
       else
          if (node%incoming) then
             call external_write (node%bincode, node%particle%anti%tex_name, &
                  left_str)
          else
             call external_write (node%bincode, node%particle%tex_name, &
                  right_str)
          end if
       end if
     end subroutine graph_write_node
     recursive subroutine vertex_write (node, daughter)
       type(k_node_t), intent(in) :: node, daughter
       integer :: bincode
       if (associated (node%daughter1) .and. associated (node%daughter2) &
            .and. node%mapping == EXTERNAL_PRT) then
          bincode = 0
       else
          bincode = node%bincode
       end if
       call graph_write_node (daughter)
       if (associated (node%daughter1) .or. associated (node%daughter2)) then
          call line_write (bincode, daughter%bincode, daughter%particle, &
               mapping=daughter%mapping)
       else
          call line_write (bincode, daughter%bincode, daughter%particle)
       end if
     end subroutine vertex_write
     subroutine line_write (i1, i2, particle, mapping)
       integer(TC), intent(in) :: i1, i2
       type(part_prop_t), intent(in) :: particle
       integer, intent(in), optional :: mapping
       integer :: k1, k2
       type(string_t) :: prt_type
       select case (particle%spin_type)
       case (SCALAR);       prt_type = "plain"
       case (SPINOR);       prt_type = "fermion"
       case (VECTOR);       prt_type = "boson"
       case (VECTORSPINOR); prt_type = "fermion"
       case (TENSOR);       prt_type = "dbl_wiggly"
       case default;        prt_type = "dashes"
       end select
       if (particle%pdg < 0) then
 !!! anti-particle
          k1 = i2;  k2 = i1
       else
          k1 = i1;  k2 = i2
       end if
       if (present (mapping)) then
          select case (mapping)
          case (S_CHANNEL)
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=blue,lab=\sm\blue$" // &
                  & char (particle%tex_name) // "$}" // &
                  & "{v", k1, ",v", k2, "}"
          case (T_CHANNEL, U_CHANNEL)
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=cyan,lab=\sm\cyan$" // &
                  & char (particle%tex_name) // "$}" // &
                  & "{v", k1, ",v", k2, "}"
          case (RADIATION)
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=green,lab=\sm\green$" // &
                  & char (particle%tex_name) // "$}" // &
                  & "{v", k1, ",v", k2, "}"
          case (COLLINEAR)
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=magenta,lab=\sm\magenta$" // &
                  & char (particle%tex_name) // "$}" // &
                  & "{v", k1, ",v", k2, "}"
          case (INFRARED)
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=red,lab=\sm\red$" // &
                  & char (particle%tex_name) // "$}" // &
                  & "{v", k1, ",v", k2, "}"
          case default
             write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & ",f=black}" // &
                  & "{v", k1, ",v", k2, "}"
          end select
       else
          write (u, '(A,I0,A,I0,A)') "\fmf{" // char (prt_type) // &
                  & "}" // &
                  & "{v", k1, ",v", k2, "}"
       end if
     end subroutine line_write
     subroutine external_write (bincode, name, ext_str)
       integer(TC), intent(in) :: bincode
       type(string_t), intent(in) :: name
       type(string_t), intent(inout) :: ext_str
       character(len=20) :: str
       write (str, '(A2,I0)') ",v", bincode
       ext_str = ext_str // trim (str)
       write (u, '(A,I0,A,I0,A)') "\fmflabel{\sm$" &
         // char (name) &
         // "\,(", bincode, ")" &
         // "$}{v", bincode, "}"
     end subroutine external_write
   end subroutine kingraph_write_graph_format
 
 @ %def kingraph_write_graph_format
 @ Generate a [[feyngraph_set]] for several subprocesses. Mapping
 calculations are performed separately, but the final grove list is shared
 between the subsets [[fset]] of the [[feyngraph_set]].
 <<Cascades2: public>>=
   public :: feyngraph_set_generate
 <<Cascades2: procedures>>=
   subroutine feyngraph_set_generate &
     (feyngraph_set, model, n_in, n_out, flv, phs_par, fatal_beam_decay, &
     u_in, vis_channels, use_dag)
     type(feyngraph_set_t), intent(out) :: feyngraph_set
     class(model_data_t), intent(in), target :: model
     integer, intent(in) :: n_in, n_out
     type(flavor_t), dimension(:,:), intent(in) :: flv
     type(phs_parameters_t), intent(in) :: phs_par
     logical, intent(in) :: fatal_beam_decay
     integer, intent(in) :: u_in
     logical, intent(in) :: vis_channels
     logical, optional, intent(in) :: use_dag
     type(grove_t), pointer :: grove
     integer :: i, j
     type(kingraph_t), pointer :: kingraph
     if (phase_space_vanishes (phs_par%sqrts, n_in, flv))  return
     if (present (use_dag)) feyngraph_set%use_dag = use_dag
     feyngraph_set%process_type = n_in
     feyngraph_set%n_in = n_in
     feyngraph_set%n_out = n_out
     allocate (feyngraph_set%flv (size (flv, 1), size (flv, 2)))
     do i = 1, size (flv, 2)
        do j = 1, size (flv, 1)
           call feyngraph_set%flv(j,i)%init (flv(j,i)%get_pdg (), model)
        end do
     end do
     allocate (feyngraph_set%particle (PRT_ARRAY_SIZE))
     allocate (feyngraph_set%grove_list)
     allocate (feyngraph_set%fset (size (flv, 2)))
     do i = 1, size (feyngraph_set%fset)
        feyngraph_set%fset(i)%use_dag = feyngraph_set%use_dag
        allocate (feyngraph_set%fset(i)%flv(size (flv,1),1))
        feyngraph_set%fset(i)%flv(:,1) = flv(:,i)
        feyngraph_set%fset(i)%particle => feyngraph_set%particle
        allocate (feyngraph_set%fset(i)%grove_list)
        call feyngraph_set_generate_single (feyngraph_set%fset(i), &
             model, n_in, n_out, phs_par, fatal_beam_decay, u_in)
        call feyngraph_set%grove_list%merge (feyngraph_set%fset(i)%grove_list, model, i)
        if (.not. vis_channels) call feyngraph_set%fset(i)%final()
     enddo
     call feyngraph_set%grove_list%rebuild ()
   end subroutine feyngraph_set_generate
 
 @ %def feyngraph_set_generate
 @ Check whether the [[grove_list]] of the [[feyngraph_set]] contains any
 [[kingraphs]] which are valid, i.e. where the [[keep]] variable has the
 value [[.true.]]. This is necessary to write a non-empty phase-space
 file. The function is the pendant to [[cascade_set_is_valid]].
 <<Cascades2: public>>=
   public :: feyngraph_set_is_valid
 <<Cascades2: procedures>>=
   function feyngraph_set_is_valid (feyngraph_set) result (flag)
     class (feyngraph_set_t), intent(in) :: feyngraph_set
     type (kingraph_t), pointer :: kingraph
     type (grove_t), pointer :: grove
     logical :: flag
     flag = .false.
     if (associated (feyngraph_set%grove_list)) then
        grove => feyngraph_set%grove_list%first
        do while (associated (grove))
           kingraph => grove%first
           do while (associated (kingraph))
              if (kingraph%keep) then
                 flag = .true.
                 return
              end if
              kingraph => kingraph%next
           enddo
           grove => grove%next
        enddo
     end if
   end function feyngraph_set_is_valid
 
 @ %def feyngraph_set_is_valid
 @
 \subsection{Return the resonance histories for subtraction}
 The following procedures are copies of corresponding procedures in
 [[cascades]], which only have been adapted to the new types used in
 this module.\\
 Extract the resonance set from a valid [[kingraph]] which is kept in the
 final grove list.
 <<Cascades2: kingraph: TBP>>=
   procedure :: extract_resonance_history => kingraph_extract_resonance_history
 <<Cascades2: procedures>>=
   subroutine kingraph_extract_resonance_history &
        (kingraph, res_hist, model, n_out)
     class(kingraph_t), intent(in), target :: kingraph
     type(resonance_history_t), intent(out) :: res_hist
     class(model_data_t), intent(in), target :: model
     integer, intent(in) :: n_out
     type(resonance_info_t) :: resonance
     integer :: i, mom_id, pdg
     call msg_debug2 (D_PHASESPACE, "kingraph_extract_resonance_history")
     if (kingraph%grove_prop%n_resonances > 0) then
        if (associated (kingraph%root%daughter1) .or. &
             associated (kingraph%root%daughter2)) then
           call msg_debug2 (D_PHASESPACE, "kingraph has resonances, root has children")
           do i = 1, kingraph%tree%n_entries
              if (kingraph%tree%mapping(i) == S_CHANNEL) then
                 mom_id = kingraph%tree%bc (i)
                 pdg = kingraph%tree%pdg (i)
                 call resonance%init (mom_id, pdg, model, n_out)
                 if (debug2_active (D_PHASESPACE)) then
                    print *, 'D: Adding resonance'
                    call resonance%write ()
                 end if
                 call res_hist%add_resonance (resonance)
              end if
           end do
        end if
     end if
   end subroutine kingraph_extract_resonance_history
 
 @ %def kingraph_extract_resonance_history
 @ Determine the number of valid [[kingraphs]] in [[grove_list]].
 <<Cascades2: public>>=
   public :: grove_list_get_n_trees
 <<Cascades2: procedures>>=
   function grove_list_get_n_trees (grove_list) result (n)
     class (grove_list_t), intent (in) :: grove_list
     integer :: n
     type(kingraph_t), pointer :: kingraph
     type(grove_t), pointer :: grove
     call msg_debug (D_PHASESPACE, "grove_list_get_n_trees")
     n = 0
     grove => grove_list%first
     do while (associated (grove))
        kingraph => grove%first
        do while (associated (kingraph))
           if (kingraph%keep) n = n + 1
           kingraph => kingraph%grove_next
        enddo
        grove => grove%next
     enddo
     call msg_debug (D_PHASESPACE, "n", n)
   end function grove_list_get_n_trees
 
 @ %def grove_list_get_n_trees
 @ Extract the resonance histories from the [[feyngraph_set]], in complete
 analogy to [[cascade_set_get_resonance_histories]]
 <<Cascades2: public>>=
   public :: feyngraph_set_get_resonance_histories
 <<Cascades2: procedures>>=
   subroutine feyngraph_set_get_resonance_histories (feyngraph_set, n_filter, res_hists)
     type(feyngraph_set_t), intent(in), target :: feyngraph_set
     integer, intent(in), optional :: n_filter
     type(resonance_history_t), dimension(:), allocatable, intent(out) :: res_hists
     type(kingraph_t), pointer :: kingraph
     type(grove_t), pointer :: grove
     type(resonance_history_t) :: res_hist
     type(resonance_history_set_t) :: res_hist_set
     integer :: i_grove
     call msg_debug (D_PHASESPACE, "grove_list_get_resonance_histories")
     call res_hist_set%init (n_filter = n_filter)
     grove => feyngraph_set%grove_list%first
     i_grove = 0
     do while (associated (grove))
        i_grove = i_grove + 1
        kingraph => grove%first
        do while (associated (kingraph))
           if (kingraph%keep) then
              call msg_debug2 (D_PHASESPACE, "grove", i_grove)
              call kingraph%extract_resonance_history &
                   (res_hist, feyngraph_set%model, feyngraph_set%n_out)
              call res_hist_set%enter (res_hist)
           end if
           kingraph => kingraph%grove_next
        end do
     end do
     call res_hist_set%freeze ()
     call res_hist_set%to_array (res_hists)
   end subroutine feyngraph_set_get_resonance_histories
 
 @ %def feyngraph_set_get_resonance_histories
 <<[[cascades2_ut.f90]]>>=
 <<File header>>
 
 module cascades2_ut
   use unit_tests
   use cascades2_uti
 
 <<Standard module head>>
 
 <<Cascades2: public test>>
 
 contains
 
 <<Cascades2: test driver>>
 
 end module cascades2_ut
 @ %def cascades2_ut
 @
 <<[[cascades2_uti.f90]]>>=
 <<File header>>
 
 module cascades2_uti
 
 <<Use kinds>>
 <<Use strings>>
   use numeric_utils
 
   use cascades2
   use flavors
   use phs_forests, only: phs_parameters_t
   use model_data
 
 <<Standard module head>>
 
 <<Cascades2: test declarations>>
 
 contains
 
 <<Cascades2: tests>>
 
 end module cascades2_uti
 @ %def cascades2_uti
 @ API: driver for the unit tests below.
 <<Cascades2: public test>>=
   public :: cascades2_test
 <<Cascades2: test driver>>=
   subroutine cascades2_test (u, results)
     integer, intent(in) :: u
     type(test_results_t), intent(inout) :: results
   <<Cascades2: execute tests>>
   end subroutine cascades2_test
 
 @ %def cascades2_test
 
 @
 <<Cascades2: execute tests>>=
   call test (cascades2_1, "cascades2_1", &
        "make phase-space", u, results)
   call test (cascades2_2, "cascades2_2", &
        "make phase-space (scattering)", u, results)
 <<Cascades2: test declarations>>=
   public :: cascades2_1
 <<Cascades2: tests>>=
   subroutine cascades2_1 (u)
     integer, intent(in) :: u
     type (feyngraph_set_t) :: feyngraph_set
     type (model_data_t) :: model
     integer :: n_in = 1
     integer :: n_out = 6
     type(flavor_t), dimension(7,1) :: flv
     type (phs_parameters_t) :: phs_par
     logical :: fatal_beam_decay = .true.
     integer :: u_in = 8
 
     write (u, "(A)")  "* Test output: cascades2_1"
     write (u, "(A)")  "*   Purpose: create a test phs file (decay) with the forest"
     write (u, "(A)")  "*            output of O'Mega"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initializing"
     write (u, "(A)")
 
     call init_sm_full_test (model)
 
     call flv(1,1)%init (6, model)
     call flv(2,1)%init (5, model)
     call flv(3,1)%init (-11, model)
     call flv(4,1)%init (12, model)
     call flv(5,1)%init (21, model)
     call flv(6,1)%init (22, model)
     call flv(7,1)%init (21, model)
 
     phs_par%sqrts = 173.1_default
     phs_par%m_threshold_s = 50._default
     phs_par%m_threshold_t = 100._default
     phs_par%keep_nonresonant = .true.
     phs_par%off_shell = 2
 
     open (unit=u_in, file="cascades2_1.fds", status='old', action='read')
 
     write (u, "(A)")
     write (u, "(A)")  "* Generating phase-space parametrizations"
     write (u, "(A)")
 
     call feyngraph_set_generate (feyngraph_set, model, n_in, n_out, &
          flv, phs_par, fatal_beam_decay, u_in, use_dag = .false., &
 	 vis_channels = .false.)
     call feyngraph_set_write_process_bincode_format (feyngraph_set, u)
     call feyngraph_set_write_file_format (feyngraph_set, u)
 
     write (u, "(A)")  "* Cleanup"
     write (u, "(A)")
 
     close (u_in)
     call feyngraph_set%final ()
     call model%final ()
 
     write (u, *)
     write (u, "(A)")  "* Test output end: cascades2_1"
   end subroutine cascades2_1
 
 @ %def cascades2_1
 @
 <<Cascades2: test declarations>>=
   public :: cascades2_2
 <<Cascades2: tests>>=
   subroutine cascades2_2 (u)
     integer, intent(in) :: u
     type (feyngraph_set_t) :: feyngraph_set
     type (model_data_t) :: model
     integer :: n_in = 2
     integer :: n_out = 5
     type(flavor_t), dimension(7,1) :: flv
     type (phs_parameters_t) :: phs_par
     logical :: fatal_beam_decay = .true.
     integer :: u_in = 8
 
     write (u, "(A)")  "* Test output: cascades2_2"
     write (u, "(A)")  "*   Purpose: create a test phs file (scattering) with the"
     write (u, "(A)")  "*            parsable DAG output of O'Mega"
     write (u, "(A)")
 
     write (u, "(A)")  "* Initializing"
     write (u, "(A)")
 
     call init_sm_full_test (model)
 
     call flv(1,1)%init (-11, model)
     call flv(2,1)%init (11, model)
     call flv(3,1)%init (-11, model)
     call flv(4,1)%init (12, model)
     call flv(5,1)%init (1, model)
     call flv(6,1)%init (-2, model)
     call flv(7,1)%init (22, model)
 
     phs_par%sqrts = 500._default
     phs_par%m_threshold_s = 50._default
     phs_par%m_threshold_t = 100._default
     phs_par%keep_nonresonant = .true.
     phs_par%off_shell = 2
     phs_par%t_channel = 6
 
     open (unit=u_in, file="cascades2_2.fds", &
          status='old', action='read')
 
     write (u, "(A)")
     write (u, "(A)")  "* Generating phase-space parametrizations"
     write (u, "(A)")
 
     call feyngraph_set_generate (feyngraph_set, model, n_in, n_out, &
          flv, phs_par, fatal_beam_decay, u_in, use_dag = .true., &
 	 vis_channels = .false.)
     call feyngraph_set_write_process_bincode_format (feyngraph_set, u)
     call feyngraph_set_write_file_format (feyngraph_set, u)
 
     write (u, "(A)")  "* Cleanup"
     write (u, "(A)")
 
     close (u_in)
     call feyngraph_set%final ()
     call model%final ()
 
     write (u, *)
     write (u, "(A)")  "* Test output end: cascades2_2"
   end subroutine cascades2_2
 
 @ %def cascades2_2
Index: trunk/src/phase_space/Makefile.am
===================================================================
--- trunk/src/phase_space/Makefile.am	(revision 8186)
+++ trunk/src/phase_space/Makefile.am	(revision 8187)
@@ -1,226 +1,228 @@
 ## Makefile.am -- Makefile for WHIZARD
 ##
 ## Process this file with automake to produce Makefile.in
 #
 # Copyright (C) 1999-2018 by
 #     Wolfgang Kilian <kilian@physik.uni-siegen.de>
 #     Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
 #     Juergen Reuter <juergen.reuter@desy.de>
 #     with contributions from
 #     cf. main AUTHORS file
 #
 # WHIZARD is free software; you can redistribute it and/or modify it
 # under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 2, or (at your option)
 # any later version.
 #
 # WHIZARD is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
 #
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 #
 ########################################################################
 
 ## The files in this directory implement quantum field theory concepts
 ## such as model representation and quantum numbers.
 
 ## We create a library which is still to be combined with auxiliary libs.
 noinst_LTLIBRARIES = libphase_space.la
 check_LTLIBRARIES = libphase_space_ut.la
 
 libphase_space_la_SOURCES = \
   phs_base.f90 \
   phs_none.f90 \
   phs_single.f90 \
+  phs_rambo.f90 \
   resonances.f90 \
   mappings.f90 phs_trees.f90 phs_forests.f90 \
   cascades.f90 \
   phs_wood.f90 \
   phs_fks.f90 \
   dispatch_phase_space.f90 \
   cascades2_lexer.f90 \
   cascades2.f90
 
 libphase_space_ut_la_SOURCES = \
   phs_base_uti.f90 phs_base_ut.f90 \
   phs_none_uti.f90 phs_none_ut.f90 \
   phs_single_uti.f90 phs_single_ut.f90 \
+  phs_rambo_uti.f90 phs_rambo_ut.f90 \
   resonances_uti.f90 resonances_ut.f90 \
   phs_trees_uti.f90 phs_trees_ut.f90 \
   phs_forests_uti.f90 phs_forests_ut.f90 \
   cascades_uti.f90 cascades_ut.f90 \
   phs_wood_uti.f90 phs_wood_ut.f90 \
   phs_fks_uti.f90 phs_fks_ut.f90 \
   dispatch_phs_uti.f90 dispatch_phs_ut.f90 \
   cascades2_lexer_uti.f90 cascades2_lexer_ut.f90 \
   cascades2_uti.f90 cascades2_ut.f90
 
 ## Omitting this would exclude it from the distribution
 dist_noinst_DATA = phase_space.nw
 
 # Dump module names into file Modules
 libphase_space_Modules = \
   ${libphase_space_la_SOURCES:.f90=} \
   ${libphase_space_ut_la_SOURCES:.f90=}
 Modules: Makefile
 	@for module in $(libphase_space_Modules); do \
           echo $$module >> $@.new; \
         done
 	@if diff $@ $@.new -q >/dev/null; then \
           rm $@.new; \
 	else \
           mv $@.new $@; echo "Modules updated"; \
         fi
 BUILT_SOURCES = Modules
 
 ## Fortran module dependencies
 # Get module lists from other directories
 module_lists = \
   ../basics/Modules \
   ../utilities/Modules \
   ../testing/Modules \
   ../system/Modules \
   ../combinatorics/Modules \
   ../parsing/Modules \
   ../physics/Modules \
   ../qft/Modules \
   ../types/Modules \
   ../matrix_elements/Modules \
   ../beams/Modules \
   ../model_features/Modules \
   ../variables/Modules \
   ../expr_base/Modules \
   ../user/Modules \
   ../threshold/Modules
 
 $(module_lists):
 	$(MAKE) -C `dirname $@` Modules
 
 Module_dependencies.sed: $(libphase_space_la_SOURCES) $(libphase_space_ut_la_SOURCES)
 Module_dependencies.sed: $(module_lists)
 	@rm -f $@
 	echo 's/, *only:.*//' >> $@
 	echo 's/, *&//' >> $@
 	echo 's/, *.*=>.*//' >> $@
 	echo 's/$$/.lo/' >> $@
 	for list in $(module_lists); do \
 		dir="`dirname $$list`"; \
 		for mod in `cat $$list`; do \
 			echo 's!: '$$mod'.lo$$!': $$dir/$$mod'.lo!' >> $@; \
 		done \
 	done
 
 DISTCLEANFILES = Module_dependencies.sed
 
 # The following line just says
 #    include Makefile.depend
 # but in a portable fashion (depending on automake's AM_MAKE_INCLUDE
 @am__include@ @am__quote@Makefile.depend@am__quote@
 
 Makefile.depend: Module_dependencies.sed
 Makefile.depend: $(libphase_space_la_SOURCES) $(libphase_space_ut_la_SOURCES)
 	@rm -f $@
 	for src in $^; do \
 	  module="`basename $$src | sed 's/\.f[90][0358]//'`"; \
 	  grep '^ *use ' $$src \
 	    | grep -v '!NODEP!' \
 	    | sed -e 's/^ *use */'$$module'.lo: /' \
 	          -f Module_dependencies.sed; \
 	done > $@
 
 DISTCLEANFILES += Makefile.depend
 
 # Fortran90 module files are generated at the same time as object files
 .lo.$(FC_MODULE_EXT):
 	@:
 #	touch $@
 
 AM_FCFLAGS = -I../basics -I../utilities -I../testing -I../system -I../combinatorics -I../parsing -I../physics -I../fastjet -I../qed_pdf -I../qft -I../matrix_elements -I../types -I../particles -I../beams -I../rng -I../../circe1/src -I../../circe2/src  -I../pdf_builtin -I../lhapdf -I../model_features -I../variables -I../expr_base -I../user -I../threshold
 
 
 ########################################################################
 ## Default Fortran compiler options
 
 ## Profiling
 if FC_USE_PROFILING
 AM_FCFLAGS += $(FCFLAGS_PROFILING)
 endif
 
 ## OpenMP
 if FC_USE_OPENMP
 AM_FCFLAGS += $(FCFLAGS_OPENMP)
 endif
 
 # MPI
 if FC_USE_MPI
 AM_FCFLAGS += $(FCFLAGS_MPI)
 endif
 
 ########################################################################
 ## Non-standard targets and dependencies
 
 ## Install the modules used by generated matrix element code
 #execmoddir = $(pkglibdir)/mod/phase_space
 #nodist_execmod_HEADERS = \#
 
 ## (Re)create F90 sources from NOWEB source.
 if NOWEB_AVAILABLE
 
 PRELUDE = $(top_srcdir)/src/noweb-frame/whizard-prelude.nw
 POSTLUDE = $(top_srcdir)/src/noweb-frame/whizard-postlude.nw
 
 phase_space.stamp: $(PRELUDE) $(srcdir)/phase_space.nw $(POSTLUDE)
 	@rm -f phase_space.tmp
 	@touch phase_space.tmp
 	for src in \
 	  $(libphase_space_la_SOURCES) \
 	  $(libphase_space_ut_la_SOURCES); do \
 	  $(NOTANGLE) -R[[$$src]] $^ | $(CPIF) $$src; \
         done
 	@mv -f phase_space.tmp phase_space.stamp
 
 $(libphase_space_la_SOURCES) $(libphase_space_ut_la_SOURCES): phase_space.stamp
 ## Recover from the removal of $@
 	@if test -f $@; then :; else \
 	  rm -f phase_space.stamp; \
 	  $(MAKE) $(AM_MAKEFLAGS) phase_space.stamp; \
 	fi
 
 endif
 
 
 ########################################################################
 ## Non-standard cleanup tasks
 ## Remove sources that can be recreated using NOWEB
 if NOWEB_AVAILABLE
 maintainer-clean-noweb:
 	-rm -f *.f90 *.c
 endif
 .PHONY: maintainer-clean-noweb
 
 ## Remove those sources also if builddir and srcdir are different
 if NOWEB_AVAILABLE
 clean-noweb:
 	test "$(srcdir)" != "." && rm -f *.f90 *.c || true
 endif
 .PHONY: clean-noweb
 
 ## Remove F90 module files
 clean-local: clean-noweb
 	-rm -f phase_space.stamp phase_space.tmp
 	-rm -f *.$(FC_MODULE_EXT)
 if FC_SUBMODULES
 	-rm -f *.smod
 endif
 
 ## Remove backup files
 maintainer-clean-backup:
 	-rm -f *~
 .PHONY: maintainer-clean-backup
 
 ## Register additional clean targets
 maintainer-clean-local: maintainer-clean-noweb maintainer-clean-backup
Index: trunk/share/tests/Makefile.am
===================================================================
--- trunk/share/tests/Makefile.am	(revision 8186)
+++ trunk/share/tests/Makefile.am	(revision 8187)
@@ -1,1368 +1,1374 @@
 ## Makefile.am -- Makefile for WHIZARD tests
 ##
 ## Process this file with automake to produce Makefile.in
 ##
 ########################################################################
 #
 # Copyright (C) 1999-2018 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 \
     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/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_hepmc_1.ref \
     unit_tests/ref-output/eio_hepmc_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_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/hepmc_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 \
     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/model_change_1.ref \
     functional_tests/ref-output/model_change_2.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/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/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/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/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/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/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/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/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/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/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
 
 # 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/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
 
 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
 
 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)
 
 MISC_TESTS_M4 =
 
 MISC_TESTS_SIN = \
     functional_tests/empty.sin \
     functional_tests/fatal.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_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/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/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/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/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/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/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/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/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/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/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/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
 
 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_decay_tbw.sin \
     ext_tests_nlo/nlo_tt.sin \
     ext_tests_nlo/nlo_tt_powheg.sin \
     ext_tests_nlo/nlo_tt_powheg_sudakov.sin \
     ext_tests_nlo/nlo_uu.sin \
     ext_tests_nlo/nlo_uu_powheg.sin \
     ext_tests_nlo/nlo_qq_powheg.sin \
     ext_tests_nlo/nlo_threshold.sin \
     ext_tests_nlo/nlo_threshold_factorized.sin \
     ext_tests_nlo/nlo_methods_gosam.sin \
     ext_tests_nlo/nlo_jets.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
 
 all-local: $(TESTSUITES_SIN)
 
 if M4_AVAILABLE
 SUFFIXES = .m4 .sin
 .m4.sin:
 	case "$@" in \
 	*/*) \
 		mkdir -p `sed 's,/.[^/]*$$,,g' <<< "$@"` ;; \
 	esac
 	$(M4) $(srcdir)/$(TESTSUITE_MACROS) $< > $@
 endif M4_AVAILABLE
Index: trunk/share/tests/functional_tests/testproc_12.sin
===================================================================
--- trunk/share/tests/functional_tests/testproc_12.sin	(revision 0)
+++ trunk/share/tests/functional_tests/testproc_12.sin	(revision 8187)
@@ -0,0 +1,37 @@
+# SINDARIN input for WHIZARD self-test
+# Check rebuilding/keeping of grid file
+
+model = "Test"
+
+?logging = true
+?openmp_logging = false
+?vis_history = false
+?integration_timer = false
+error_threshold = 1E-5
+
+$method = "unit_test"
+process testproc_12_p1 = s, s => s, s
+
+seed = 0
+
+compile ()
+
+$phs_method = "rambo"
+$integration_method = "vamp2"
+
+sqrts = 1000
+iterations = 1:1000
+integrate (testproc_12_p1)
+
+# Keep everything
+?rebuild_grids = false
+integrate (testproc_12_p1)
+
+# Rebuild grid because parameter has changed
+sqrts = 500
+integrate (testproc_12_p1)
+
+# Rebuild grid because QCD setup has changed
+?alphas_is_fixed = false
+?alphas_from_mz = true
+integrate (testproc_12_p1)
\ No newline at end of file
Index: trunk/share/tests/functional_tests/ref-output/testproc_12.ref
===================================================================
--- trunk/share/tests/functional_tests/ref-output/testproc_12.ref	(revision 0)
+++ trunk/share/tests/functional_tests/ref-output/testproc_12.ref	(revision 8187)
@@ -0,0 +1,147 @@
+?openmp_logging = false
+?vis_history = false
+?integration_timer = false
+error_threshold =  1.000000000000E-05
+$method = "unit_test"
+| Process library 'testproc_12_lib': recorded process 'testproc_12_p1'
+seed = 0
+| Process library 'testproc_12_lib': compiling ...
+| Process library 'testproc_12_lib': ... success.
+$phs_method = "rambo"
+$integration_method = "vamp2"
+sqrts =  1.000000000000E+03
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 0
+| Initializing integration for process testproc_12_p1:
+| Beam structure: [any particles]
+| Beam data (collision):
+|   s  (mass = 1.2500000E+02 GeV)
+|   s  (mass = 1.2500000E+02 GeV)
+|   sqrts = 1.000000000000E+03 GeV
+| ------------------------------------------------------------------------
+| Process [scattering]: 'testproc_12_p1'
+|   Library name  = 'testproc_12_lib'
+|   Process index = 1
+|   Process components:
+|     1: 'testproc_12_p1_i1':   s, s => s, s [unit_test]
+| ------------------------------------------------------------------------
+| Phase space: 1 channels, 2 dimensions
+| Phase space: flat (RAMBO)
+Warning: No cuts have been defined.
+| Starting integration for process 'testproc_12_p1'
+| Integrate: iterations = 1:1000
+| Integrator: 1 channels, 2 dimensions
+| Integrator: Using VAMP2 channel equivalences
+| Integrator: 1000 initial calls, 20 max. bins, stratified = T
+| Integrator: VAMP2
+|=============================================================================|
+| It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
+|=============================================================================|
+   1        800  7.7464622E+03  0.00E+00    0.00    0.00* 100.00
+|-----------------------------------------------------------------------------|
+   1        800  7.7464622E+03  0.00E+00    0.00    0.00  100.00
+|=============================================================================|
+?rebuild_grids = false
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 1
+| Initializing integration for process testproc_12_p1:
+| Beam structure: [any particles]
+| Beam data (collision):
+|   s  (mass = 1.2500000E+02 GeV)
+|   s  (mass = 1.2500000E+02 GeV)
+|   sqrts = 1.000000000000E+03 GeV
+| ------------------------------------------------------------------------
+| Process [scattering]: 'testproc_12_p1'
+|   Library name  = 'testproc_12_lib'
+|   Process index = 1
+|   Process components:
+|     1: 'testproc_12_p1_i1':   s, s => s, s [unit_test]
+| ------------------------------------------------------------------------
+| Phase space: 1 channels, 2 dimensions
+| Phase space: flat (RAMBO)
+Warning: No cuts have been defined.
+| Starting integration for process 'testproc_12_p1'
+| Integrate: iterations = 1:1000
+| Integrator: 1 channels, 2 dimensions
+| Integrator: Using VAMP2 channel equivalences
+| Integrator: 1000 initial calls, 20 max. bins, stratified = T
+| Integrator: VAMP2
+|=============================================================================|
+| It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
+|=============================================================================|
+| VAMP2: using grids and results from file ’testproc_12_p1.m1.vg2’
+   1        800  7.7464622E+03  0.00E+00    0.00    0.00* 100.00
+|-----------------------------------------------------------------------------|
+   1        800  7.7464622E+03  0.00E+00    0.00    0.00  100.00
+|=============================================================================|
+sqrts =  5.000000000000E+02
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 2
+| Initializing integration for process testproc_12_p1:
+| Beam structure: [any particles]
+| Beam data (collision):
+|   s  (mass = 1.2500000E+02 GeV)
+|   s  (mass = 1.2500000E+02 GeV)
+|   sqrts = 5.000000000000E+02 GeV
+| ------------------------------------------------------------------------
+| Process [scattering]: 'testproc_12_p1'
+|   Library name  = 'testproc_12_lib'
+|   Process index = 1
+|   Process components:
+|     1: 'testproc_12_p1_i1':   s, s => s, s [unit_test]
+| ------------------------------------------------------------------------
+| Phase space: 1 channels, 2 dimensions
+| Phase space: flat (RAMBO)
+Warning: No cuts have been defined.
+| Starting integration for process 'testproc_12_p1'
+| Integrate: iterations = 1:1000
+| Integrator: 1 channels, 2 dimensions
+| Integrator: Using VAMP2 channel equivalences
+| Integrator: 1000 initial calls, 20 max. bins, stratified = T
+| Integrator: VAMP2
+|=============================================================================|
+| It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
+|=============================================================================|
+| VAMP2: header: parameter mismatch, discarding grid file 'testproc_12_p1.m1.vg2'
+   1        800  3.0985849E+04  0.00E+00    0.00    0.00* 100.00
+|-----------------------------------------------------------------------------|
+   1        800  3.0985849E+04  0.00E+00    0.00    0.00  100.00
+|=============================================================================|
+?alphas_is_fixed = false
+?alphas_from_mz = true
+| QCD alpha: using a running strong coupling
+| RNG: Initializing TAO random-number generator
+| RNG: Setting seed for random-number generator to 3
+| Initializing integration for process testproc_12_p1:
+| Beam structure: [any particles]
+| Beam data (collision):
+|   s  (mass = 1.2500000E+02 GeV)
+|   s  (mass = 1.2500000E+02 GeV)
+|   sqrts = 5.000000000000E+02 GeV
+| ------------------------------------------------------------------------
+| Process [scattering]: 'testproc_12_p1'
+|   Library name  = 'testproc_12_lib'
+|   Process index = 1
+|   Process components:
+|     1: 'testproc_12_p1_i1':   s, s => s, s [unit_test]
+| ------------------------------------------------------------------------
+| Phase space: 1 channels, 2 dimensions
+| Phase space: flat (RAMBO)
+Warning: No cuts have been defined.
+| Starting integration for process 'testproc_12_p1'
+| Integrate: iterations = 1:1000
+| Integrator: 1 channels, 2 dimensions
+| Integrator: Using VAMP2 channel equivalences
+| Integrator: 1000 initial calls, 20 max. bins, stratified = T
+| Integrator: VAMP2
+|=============================================================================|
+| It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
+|=============================================================================|
+| VAMP2: header: parameter mismatch, discarding grid file 'testproc_12_p1.m1.vg2'
+   1        800  3.0985849E+04  0.00E+00    0.00    0.00* 100.00
+|-----------------------------------------------------------------------------|
+   1        800  3.0985849E+04  0.00E+00    0.00    0.00  100.00
+|=============================================================================|
+| There were no errors and    4 warning(s).
+| WHIZARD run finished.
+|=============================================================================|
Index: trunk/share/tests/unit_tests/ref-output/phs_rambo_1.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/phs_rambo_1.ref	(revision 0)
+++ trunk/share/tests/unit_tests/ref-output/phs_rambo_1.ref	(revision 8187)
@@ -0,0 +1,25 @@
+* Test output: phs_rambo_1
+*   Purpose: initialize and display phase-space configuration data
+
+* Initialize a process and a matching phase-space configuration
+
+ Partonic, flat phase-space configuration (RAMBO):
+   ID        = 'phs_rambo_1'
+   n_in      = 2
+   n_out     = 2
+   n_tot     = 4
+   n_state   = 1
+   n_par     = 2
+   n_channel = 1
+   sqrts     =  1.000000000000E+03
+   s_fixed   = T
+   cm_frame  = T
+   azim.dep. = F
+ Flavor combinations:
+   1: s s s s
+ Phase-space / structure-function channels:
+   1: 1
+   MD5 sum (model par)  = '34AE44487D84198697E1368F11F2C8D8'
+   MD5 sum (phs config) = 'C2C66CEDE8B1FCCC3606F234D907F7D7'
+
+* Test output end: phs_rambo_1
Index: trunk/share/tests/unit_tests/ref-output/phs_rambo_2.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/phs_rambo_2.ref	(revision 0)
+++ trunk/share/tests/unit_tests/ref-output/phs_rambo_2.ref	(revision 8187)
@@ -0,0 +1,132 @@
+* Test output: phs_rambo_2
+*   Purpose: test simple two-channel phase space
+
+* Initialize a process and a matching phase-space configuration
+
+ Partonic, flat phase-space configuration (RAMBO):
+   ID        = 'phs_rambo_2'
+   n_in      = 2
+   n_out     = 2
+   n_tot     = 4
+   n_state   = 1
+   n_par     = 2
+   n_channel = 1
+   sqrts     =  1.000000000000E+03
+   s_fixed   = T
+   cm_frame  = T
+   azim.dep. = F
+ Flavor combinations:
+   1: s s s s
+ Phase-space / structure-function channels:
+   1: 1
+   MD5 sum (model par)  = '34AE44487D84198697E1368F11F2C8D8'
+   MD5 sum (phs config) = '923E8E2955C1B349236549FE0165AB1F'
+
+* Initialize the phase-space instance
+
+ Partonic phase space: parameters [undefined]
+   m_in    =  1.250000000000E+02  1.250000000000E+02
+   m_out   =  1.250000000000E+02  1.250000000000E+02
+   Flux   =  3.133842031921E+08
+   Volume =  2.552940346135E-05
+ Channel #1:
+   r = 0.0000000 0.0000000
+   f = 0.0000000E+00
+ Partonic phase space: momenta
+ Incoming: [undefined]
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ Outgoing: [undefined]
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ Intermediate masses (massless):
+    0.000000000000E+00 0.000000000000E+00
+ Intermediate masses (massive):
+    0.000000000000E+00 0.000000000000E+00
+
+* Set incoming momenta
+
+ Partonic phase space: parameters [undefined]
+   m_in    =  1.250000000000E+02  1.250000000000E+02
+   m_out   =  1.250000000000E+02  1.250000000000E+02
+   Flux   =  3.133842031921E+08
+   Volume =  2.552940346135E-05
+ Channel #1:
+   r = 0.0000000 0.0000000
+   f = 0.0000000E+00
+ Partonic phase space: momenta
+   sqrts  =  1.000000000000E+03
+ Incoming:
+ E =   5.000000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00  4.841229182759E+02
+ E =   5.000000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00 -4.841229182759E+02
+ Outgoing: [undefined]
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ Intermediate masses (massless):
+    0.000000000000E+00 0.000000000000E+00
+ Intermediate masses (massive):
+    0.000000000000E+00 0.000000000000E+00
+
+* Compute phase-space point for x = 0.5, 0.125
+
+ Partonic phase space: parameters
+   m_in    =  1.250000000000E+02  1.250000000000E+02
+   m_out   =  1.250000000000E+02  1.250000000000E+02
+   Flux   =  3.133842031921E+08
+   Volume =  2.552940346135E-05
+ Channel #1: [selected]
+   r = 0.5000000 0.1250000
+   f = 9.6824584E-01
+ Partonic phase space: momenta
+   sqrts  =  1.000000000000E+03
+ Incoming:
+ E =   5.000000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00  4.841229182759E+02
+ E =   5.000000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00 -4.841229182759E+02
+ Outgoing:
+ E =   5.000000000000E+02
+ P =   3.423265984407E+02  3.423265984407E+02  0.000000000000E+00
+ E =   5.000000000000E+02
+ P =  -3.423265984407E+02 -3.423265984407E+02  0.000000000000E+00
+ Intermediate masses (massless):
+    7.500000000000E+02 0.000000000000E+00
+ Intermediate masses (massive):
+    1.000000000000E+03 1.250000000000E+02
+
+* Inverse kinematics
+
+ Partonic phase space: parameters
+   m_in    =  1.250000000000E+02  1.250000000000E+02
+   m_out   =  1.250000000000E+02  1.250000000000E+02
+   Flux   =  3.133842031921E+08
+   Volume =  2.552940346135E-05
+ Channel #1:
+   r = 0.5000000 0.1250000
+   f = 0.0000000E+00
+ Partonic phase space: momenta
+   sqrts  =  1.000000000000E+03
+ Incoming:
+ E =   5.000000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00  4.841229182759E+02
+ E =   5.000000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00 -4.841229182759E+02
+ Outgoing:
+ E =   5.000000000000E+02
+ P =   3.423265984407E+02  3.423265984407E+02  0.000000000000E+00
+ E =   5.000000000000E+02
+ P =  -3.423265984407E+02 -3.423265984407E+02  0.000000000000E+00
+ Intermediate masses (massless):
+    7.500000000000E+02 0.000000000000E+00
+ Intermediate masses (massive):
+    1.000000000000E+03 0.000000000000E+00
+
+* Test output end: phs_rambo_2
Index: trunk/share/tests/unit_tests/ref-output/vegas_3.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/vegas_3.ref	(revision 8186)
+++ trunk/share/tests/unit_tests/ref-output/vegas_3.ref	(revision 8187)
@@ -1,430 +1,430 @@
 * Test output: vegas_3
 *   Purpose: Integrate gaussian distribution.
 
  RNG Stream generator
  Current position = [
                1234.0,               1234.0,               1234.0,
                1234.0,               1234.0,               1234.0,
  ]
  Beginning substream = [
                1234.0,               1234.0,               1234.0,
                1234.0,               1234.0,               1234.0,
  ]
  Initial stream = [
                1234.0,               1234.0,               1234.0,
                1234.0,               1234.0,               1234.0,
  ]
 
 * Initialise MC integrator with n_dim = 3
 
 
 * Initialise grid with n_calls = 10000
 
 
 * Get VEGAS config object and write out
 
    Number of dimensions            = 3
    Adaption power (alpha)          =  1.5000000000E+00
    Max. number of bins (per dim.)  = 50
    Number of iterations            = 5
    Mode (stratified or importance) = 0
    Calls per box                   = 2
    Number of calls                 = 9826
    Min. number of calls            = 20
    Number of bins                  = 50
    Number of boxes                 = 17
 
 * Get VEGAS grid object and write out
 
  begin vegas_grid_t
            n_dim =                3
           n_bins =               50
  begin x_lower
-                  1 -1.0000000000E+01
-                  2 -1.0000000000E+01
-                  3 -1.0000000000E+01
+                  1 -.10000000E+0002
+                  2 -.10000000E+0002
+                  3 -.10000000E+0002
  end x_lower
  begin x_upper
-                  1  1.0000000000E+01
-                  2  1.0000000000E+01
-                  3  1.0000000000E+01
+                  1 0.10000000E+0002
+                  2 0.10000000E+0002
+                  3 0.10000000E+0002
  end x_upper
  begin delta_x
-                  1  2.0000000000E+01
-                  2  2.0000000000E+01
-                  3  2.0000000000E+01
+                  1 0.20000000E+0002
+                  2 0.20000000E+0002
+                  3 0.20000000E+0002
  end delta_x
  begin xi
-         1        1  0.0000000000E+00
-         2        1  2.0000000000E-02
-         3        1  4.0000000000E-02
-         4        1  6.0000000000E-02
-         5        1  8.0000000000E-02
-         6        1  1.0000000000E-01
-         7        1  1.2000000000E-01
-         8        1  1.4000000000E-01
-         9        1  1.6000000000E-01
-        10        1  1.8000000000E-01
-        11        1  2.0000000000E-01
-        12        1  2.2000000000E-01
-        13        1  2.4000000000E-01
-        14        1  2.6000000000E-01
-        15        1  2.8000000000E-01
-        16        1  3.0000000000E-01
-        17        1  3.2000000000E-01
-        18        1  3.4000000000E-01
-        19        1  3.6000000000E-01
-        20        1  3.8000000000E-01
-        21        1  4.0000000000E-01
-        22        1  4.2000000000E-01
-        23        1  4.4000000000E-01
-        24        1  4.6000000000E-01
-        25        1  4.8000000000E-01
-        26        1  5.0000000000E-01
-        27        1  5.2000000000E-01
-        28        1  5.4000000000E-01
-        29        1  5.6000000000E-01
-        30        1  5.8000000000E-01
-        31        1  6.0000000000E-01
-        32        1  6.2000000000E-01
-        33        1  6.4000000000E-01
-        34        1  6.6000000000E-01
-        35        1  6.8000000000E-01
-        36        1  7.0000000000E-01
-        37        1  7.2000000000E-01
-        38        1  7.4000000000E-01
-        39        1  7.6000000000E-01
-        40        1  7.8000000000E-01
-        41        1  8.0000000000E-01
-        42        1  8.2000000000E-01
-        43        1  8.4000000000E-01
-        44        1  8.6000000000E-01
-        45        1  8.8000000000E-01
-        46        1  9.0000000000E-01
-        47        1  9.2000000000E-01
-        48        1  9.4000000000E-01
-        49        1  9.6000000000E-01
-        50        1  9.8000000000E-01
-        51        1  1.0000000000E+00
-         1        2  0.0000000000E+00
-         2        2  2.0000000000E-02
-         3        2  4.0000000000E-02
-         4        2  6.0000000000E-02
-         5        2  8.0000000000E-02
-         6        2  1.0000000000E-01
-         7        2  1.2000000000E-01
-         8        2  1.4000000000E-01
-         9        2  1.6000000000E-01
-        10        2  1.8000000000E-01
-        11        2  2.0000000000E-01
-        12        2  2.2000000000E-01
-        13        2  2.4000000000E-01
-        14        2  2.6000000000E-01
-        15        2  2.8000000000E-01
-        16        2  3.0000000000E-01
-        17        2  3.2000000000E-01
-        18        2  3.4000000000E-01
-        19        2  3.6000000000E-01
-        20        2  3.8000000000E-01
-        21        2  4.0000000000E-01
-        22        2  4.2000000000E-01
-        23        2  4.4000000000E-01
-        24        2  4.6000000000E-01
-        25        2  4.8000000000E-01
-        26        2  5.0000000000E-01
-        27        2  5.2000000000E-01
-        28        2  5.4000000000E-01
-        29        2  5.6000000000E-01
-        30        2  5.8000000000E-01
-        31        2  6.0000000000E-01
-        32        2  6.2000000000E-01
-        33        2  6.4000000000E-01
-        34        2  6.6000000000E-01
-        35        2  6.8000000000E-01
-        36        2  7.0000000000E-01
-        37        2  7.2000000000E-01
-        38        2  7.4000000000E-01
-        39        2  7.6000000000E-01
-        40        2  7.8000000000E-01
-        41        2  8.0000000000E-01
-        42        2  8.2000000000E-01
-        43        2  8.4000000000E-01
-        44        2  8.6000000000E-01
-        45        2  8.8000000000E-01
-        46        2  9.0000000000E-01
-        47        2  9.2000000000E-01
-        48        2  9.4000000000E-01
-        49        2  9.6000000000E-01
-        50        2  9.8000000000E-01
-        51        2  1.0000000000E+00
-         1        3  0.0000000000E+00
-         2        3  2.0000000000E-02
-         3        3  4.0000000000E-02
-         4        3  6.0000000000E-02
-         5        3  8.0000000000E-02
-         6        3  1.0000000000E-01
-         7        3  1.2000000000E-01
-         8        3  1.4000000000E-01
-         9        3  1.6000000000E-01
-        10        3  1.8000000000E-01
-        11        3  2.0000000000E-01
-        12        3  2.2000000000E-01
-        13        3  2.4000000000E-01
-        14        3  2.6000000000E-01
-        15        3  2.8000000000E-01
-        16        3  3.0000000000E-01
-        17        3  3.2000000000E-01
-        18        3  3.4000000000E-01
-        19        3  3.6000000000E-01
-        20        3  3.8000000000E-01
-        21        3  4.0000000000E-01
-        22        3  4.2000000000E-01
-        23        3  4.4000000000E-01
-        24        3  4.6000000000E-01
-        25        3  4.8000000000E-01
-        26        3  5.0000000000E-01
-        27        3  5.2000000000E-01
-        28        3  5.4000000000E-01
-        29        3  5.6000000000E-01
-        30        3  5.8000000000E-01
-        31        3  6.0000000000E-01
-        32        3  6.2000000000E-01
-        33        3  6.4000000000E-01
-        34        3  6.6000000000E-01
-        35        3  6.8000000000E-01
-        36        3  7.0000000000E-01
-        37        3  7.2000000000E-01
-        38        3  7.4000000000E-01
-        39        3  7.6000000000E-01
-        40        3  7.8000000000E-01
-        41        3  8.0000000000E-01
-        42        3  8.2000000000E-01
-        43        3  8.4000000000E-01
-        44        3  8.6000000000E-01
-        45        3  8.8000000000E-01
-        46        3  9.0000000000E-01
-        47        3  9.2000000000E-01
-        48        3  9.4000000000E-01
-        49        3  9.6000000000E-01
-        50        3  9.8000000000E-01
-        51        3  1.0000000000E+00
+         1        1 0.00000000E+0000
+         2        1 0.20000000E-0001
+         3        1 0.40000000E-0001
+         4        1 0.60000000E-0001
+         5        1 0.80000000E-0001
+         6        1 0.10000000E+0000
+         7        1 0.12000000E+0000
+         8        1 0.14000000E+0000
+         9        1 0.16000000E+0000
+        10        1 0.18000000E+0000
+        11        1 0.20000000E+0000
+        12        1 0.22000000E+0000
+        13        1 0.24000000E+0000
+        14        1 0.26000000E+0000
+        15        1 0.28000000E+0000
+        16        1 0.30000000E+0000
+        17        1 0.32000000E+0000
+        18        1 0.34000000E+0000
+        19        1 0.36000000E+0000
+        20        1 0.38000000E+0000
+        21        1 0.40000000E+0000
+        22        1 0.42000000E+0000
+        23        1 0.44000000E+0000
+        24        1 0.46000000E+0000
+        25        1 0.48000000E+0000
+        26        1 0.50000000E+0000
+        27        1 0.52000000E+0000
+        28        1 0.54000000E+0000
+        29        1 0.56000000E+0000
+        30        1 0.58000000E+0000
+        31        1 0.60000000E+0000
+        32        1 0.62000000E+0000
+        33        1 0.64000000E+0000
+        34        1 0.66000000E+0000
+        35        1 0.68000000E+0000
+        36        1 0.70000000E+0000
+        37        1 0.72000000E+0000
+        38        1 0.74000000E+0000
+        39        1 0.76000000E+0000
+        40        1 0.78000000E+0000
+        41        1 0.80000000E+0000
+        42        1 0.82000000E+0000
+        43        1 0.84000000E+0000
+        44        1 0.86000000E+0000
+        45        1 0.88000000E+0000
+        46        1 0.90000000E+0000
+        47        1 0.92000000E+0000
+        48        1 0.94000000E+0000
+        49        1 0.96000000E+0000
+        50        1 0.98000000E+0000
+        51        1 0.10000000E+0001
+         1        2 0.00000000E+0000
+         2        2 0.20000000E-0001
+         3        2 0.40000000E-0001
+         4        2 0.60000000E-0001
+         5        2 0.80000000E-0001
+         6        2 0.10000000E+0000
+         7        2 0.12000000E+0000
+         8        2 0.14000000E+0000
+         9        2 0.16000000E+0000
+        10        2 0.18000000E+0000
+        11        2 0.20000000E+0000
+        12        2 0.22000000E+0000
+        13        2 0.24000000E+0000
+        14        2 0.26000000E+0000
+        15        2 0.28000000E+0000
+        16        2 0.30000000E+0000
+        17        2 0.32000000E+0000
+        18        2 0.34000000E+0000
+        19        2 0.36000000E+0000
+        20        2 0.38000000E+0000
+        21        2 0.40000000E+0000
+        22        2 0.42000000E+0000
+        23        2 0.44000000E+0000
+        24        2 0.46000000E+0000
+        25        2 0.48000000E+0000
+        26        2 0.50000000E+0000
+        27        2 0.52000000E+0000
+        28        2 0.54000000E+0000
+        29        2 0.56000000E+0000
+        30        2 0.58000000E+0000
+        31        2 0.60000000E+0000
+        32        2 0.62000000E+0000
+        33        2 0.64000000E+0000
+        34        2 0.66000000E+0000
+        35        2 0.68000000E+0000
+        36        2 0.70000000E+0000
+        37        2 0.72000000E+0000
+        38        2 0.74000000E+0000
+        39        2 0.76000000E+0000
+        40        2 0.78000000E+0000
+        41        2 0.80000000E+0000
+        42        2 0.82000000E+0000
+        43        2 0.84000000E+0000
+        44        2 0.86000000E+0000
+        45        2 0.88000000E+0000
+        46        2 0.90000000E+0000
+        47        2 0.92000000E+0000
+        48        2 0.94000000E+0000
+        49        2 0.96000000E+0000
+        50        2 0.98000000E+0000
+        51        2 0.10000000E+0001
+         1        3 0.00000000E+0000
+         2        3 0.20000000E-0001
+         3        3 0.40000000E-0001
+         4        3 0.60000000E-0001
+         5        3 0.80000000E-0001
+         6        3 0.10000000E+0000
+         7        3 0.12000000E+0000
+         8        3 0.14000000E+0000
+         9        3 0.16000000E+0000
+        10        3 0.18000000E+0000
+        11        3 0.20000000E+0000
+        12        3 0.22000000E+0000
+        13        3 0.24000000E+0000
+        14        3 0.26000000E+0000
+        15        3 0.28000000E+0000
+        16        3 0.30000000E+0000
+        17        3 0.32000000E+0000
+        18        3 0.34000000E+0000
+        19        3 0.36000000E+0000
+        20        3 0.38000000E+0000
+        21        3 0.40000000E+0000
+        22        3 0.42000000E+0000
+        23        3 0.44000000E+0000
+        24        3 0.46000000E+0000
+        25        3 0.48000000E+0000
+        26        3 0.50000000E+0000
+        27        3 0.52000000E+0000
+        28        3 0.54000000E+0000
+        29        3 0.56000000E+0000
+        30        3 0.58000000E+0000
+        31        3 0.60000000E+0000
+        32        3 0.62000000E+0000
+        33        3 0.64000000E+0000
+        34        3 0.66000000E+0000
+        35        3 0.68000000E+0000
+        36        3 0.70000000E+0000
+        37        3 0.72000000E+0000
+        38        3 0.74000000E+0000
+        39        3 0.76000000E+0000
+        40        3 0.78000000E+0000
+        41        3 0.80000000E+0000
+        42        3 0.82000000E+0000
+        43        3 0.84000000E+0000
+        44        3 0.86000000E+0000
+        45        3 0.88000000E+0000
+        46        3 0.90000000E+0000
+        47        3 0.92000000E+0000
+        48        3 0.94000000E+0000
+        49        3 0.96000000E+0000
+        50        3 0.98000000E+0000
+        51        3 0.10000000E+0001
  end xi
  end vegas_grid_t
 
 * Integrate with n_it = 3 and n_calls = 20000 (Adaptation)
 
   Result:  1.00051E+00 +/-  2.09522E-03
 
 * Integrate with n_it = 3 and n_calls = 2000 (Precision)
 
    Number of dimensions            = 3
    Adaption power (alpha)          =  1.5000000000E+00
    Max. number of bins (per dim.)  = 50
    Number of iterations            = 3
    Mode (stratified or importance) = 0
    Calls per box                   = 2
    Number of calls                 = 2000
    Min. number of calls            = 20
    Number of bins                  = 50
    Number of boxes                 = 10
 
   Result:  9.90236E-01 +/-  6.12393E-03
 
 * Get VEGAS result object and write out
 
    Start iteration                 = 0
    Iteration number                = 3
    Sample number                   = 3
    Sum of weighted integrals       =  2.6404496672E+04
    Sum of weights                  =  2.6664839373E+04
    Sum of chi                      =  2.6147919739E+04
    chi2                            =  1.1376075904E-02
    Overall efficiency              =  1.4506373094E-01
    f-positive efficiency           =  2.9012746188E+02
    f-negative efficiency           =  0.0000000000E+00
    Maximum absolute overall value  =  6.8158838837E+00
    Maximum absolute positive value =  6.8158838837E+00
    Maximum absolute negative value =  0.0000000000E+00
    Integral (of latest iteration)  =  9.8873754583E-01
    Standard deviation              =  1.1672779753E-02
   Event weight                    =  0.0000000000E+00
   Event weight excess             =  0.0000000000E+00
 
 * Get VEGAS grid object and write out
 
  begin vegas_grid_t
            n_dim =                3
           n_bins =               50
  begin x_lower
-                  1 -1.0000000000E+01
-                  2 -1.0000000000E+01
-                  3 -1.0000000000E+01
+                  1 -.10000000E+0002
+                  2 -.10000000E+0002
+                  3 -.10000000E+0002
  end x_lower
  begin x_upper
-                  1  1.0000000000E+01
-                  2  1.0000000000E+01
-                  3  1.0000000000E+01
+                  1 0.10000000E+0002
+                  2 0.10000000E+0002
+                  3 0.10000000E+0002
  end x_upper
  begin delta_x
-                  1  2.0000000000E+01
-                  2  2.0000000000E+01
-                  3  2.0000000000E+01
+                  1 0.20000000E+0002
+                  2 0.20000000E+0002
+                  3 0.20000000E+0002
  end delta_x
  begin xi
-         1        1  0.0000000000E+00
-         2        1  4.2028048244E-01
-         3        1  4.3584335558E-01
-         4        1  4.4415217775E-01
-         5        1  4.4929676731E-01
-         6        1  4.5366966717E-01
-         7        1  4.5746350623E-01
-         8        1  4.6104655180E-01
-         9        1  4.6429516404E-01
-        10        1  4.6729371261E-01
-        11        1  4.7014562114E-01
-        12        1  4.7280253332E-01
-        13        1  4.7513545202E-01
-        14        1  4.7737543632E-01
-        15        1  4.7960248762E-01
-        16        1  4.8173702008E-01
-        17        1  4.8377566264E-01
-        18        1  4.8576848163E-01
-        19        1  4.8782242573E-01
-        20        1  4.8989646493E-01
-        21        1  4.9193221409E-01
-        22        1  4.9389364201E-01
-        23        1  4.9583518947E-01
-        24        1  4.9776104661E-01
-        25        1  4.9962030365E-01
-        26        1  5.0143555633E-01
-        27        1  5.0317035955E-01
-        28        1  5.0485923250E-01
-        29        1  5.0664450724E-01
-        30        1  5.0853614913E-01
-        31        1  5.1045045710E-01
-        32        1  5.1226856592E-01
-        33        1  5.1407573119E-01
-        34        1  5.1602770068E-01
-        35        1  5.1815962941E-01
-        36        1  5.2042992216E-01
-        37        1  5.2266635863E-01
-        38        1  5.2505659645E-01
-        39        1  5.2728243529E-01
-        40        1  5.2969449857E-01
-        41        1  5.3229090361E-01
-        42        1  5.3527067105E-01
-        43        1  5.3851136532E-01
-        44        1  5.4206156711E-01
-        45        1  5.4613874234E-01
-        46        1  5.5113847808E-01
-        47        1  5.5727182469E-01
-        48        1  5.6558815451E-01
-        49        1  5.8836160953E-01
-        50        1  6.8125450095E-01
-        51        1  1.0000000000E+00
-         1        2  0.0000000000E+00
-         2        2  2.6370156880E-01
-         3        2  3.9271998546E-01
-         4        2  4.3012870468E-01
-         5        2  4.4075409552E-01
-         6        2  4.4774635221E-01
-         7        2  4.5282594732E-01
-         8        2  4.5714624694E-01
-         9        2  4.6102927867E-01
-        10        2  4.6445342966E-01
-        11        2  4.6760466347E-01
-        12        2  4.7040233732E-01
-        13        2  4.7289822713E-01
-        14        2  4.7517687274E-01
-        15        2  4.7741446004E-01
-        16        2  4.7962043423E-01
-        17        2  4.8181941371E-01
-        18        2  4.8394261288E-01
-        19        2  4.8605449792E-01
-        20        2  4.8810825862E-01
-        21        2  4.9018740643E-01
-        22        2  4.9223897251E-01
-        23        2  4.9423776452E-01
-        24        2  4.9610131664E-01
-        25        2  4.9797522631E-01
-        26        2  4.9973859709E-01
-        27        2  5.0155019738E-01
-        28        2  5.0328343849E-01
-        29        2  5.0518060184E-01
-        30        2  5.0705340228E-01
-        31        2  5.0913132207E-01
-        32        2  5.1112528854E-01
-        33        2  5.1304681860E-01
-        34        2  5.1498389839E-01
-        35        2  5.1705759568E-01
-        36        2  5.1917865243E-01
-        37        2  5.2148053914E-01
-        38        2  5.2369074118E-01
-        39        2  5.2605145706E-01
-        40        2  5.2858754198E-01
-        41        2  5.3147269827E-01
-        42        2  5.3446957303E-01
-        43        2  5.3771889519E-01
-        44        2  5.4102935707E-01
-        45        2  5.4519884124E-01
-        46        2  5.5011510015E-01
-        47        2  5.5636068532E-01
-        48        2  5.6484075010E-01
-        49        2  5.7835661918E-01
-        50        2  6.9500868598E-01
-        51        2  1.0000000000E+00
-         1        3  0.0000000000E+00
-         2        3  4.1332644329E-01
-         3        3  4.3302823590E-01
-         4        3  4.4305031489E-01
-         5        3  4.4901665727E-01
-         6        3  4.5373768963E-01
-         7        3  4.5766886585E-01
-         8        3  4.6115415216E-01
-         9        3  4.6438626719E-01
-        10        3  4.6729928282E-01
-        11        3  4.7001651233E-01
-        12        3  4.7243722167E-01
-        13        3  4.7476068281E-01
-        14        3  4.7698127517E-01
-        15        3  4.7918078674E-01
-        16        3  4.8142654482E-01
-        17        3  4.8346240319E-01
-        18        3  4.8542145852E-01
-        19        3  4.8731069732E-01
-        20        3  4.8918195942E-01
-        21        3  4.9109239832E-01
-        22        3  4.9281153933E-01
-        23        3  4.9469714249E-01
-        24        3  4.9654212171E-01
-        25        3  4.9841092852E-01
-        26        3  5.0017226415E-01
-        27        3  5.0197550711E-01
-        28        3  5.0379447761E-01
-        29        3  5.0578799319E-01
-        30        3  5.0777614425E-01
-        31        3  5.0976527056E-01
-        32        3  5.1178947634E-01
-        33        3  5.1388169193E-01
-        34        3  5.1592383090E-01
-        35        3  5.1791866043E-01
-        36        3  5.1989002549E-01
-        37        3  5.2196407492E-01
-        38        3  5.2417775090E-01
-        39        3  5.2655561689E-01
-        40        3  5.2912770841E-01
-        41        3  5.3191096337E-01
-        42        3  5.3499153961E-01
-        43        3  5.3811336876E-01
-        44        3  5.4165493789E-01
-        45        3  5.4539088251E-01
-        46        3  5.4998002803E-01
-        47        3  5.5552071421E-01
-        48        3  5.6294280751E-01
-        49        3  5.7442692175E-01
-        50        3  6.4372790213E-01
-        51        3  1.0000000000E+00
+         1        1 0.00000000E+0000
+         2        1 0.42028048E+0000
+         3        1 0.43584336E+0000
+         4        1 0.44415218E+0000
+         5        1 0.44929677E+0000
+         6        1 0.45366967E+0000
+         7        1 0.45746351E+0000
+         8        1 0.46104655E+0000
+         9        1 0.46429516E+0000
+        10        1 0.46729371E+0000
+        11        1 0.47014562E+0000
+        12        1 0.47280253E+0000
+        13        1 0.47513545E+0000
+        14        1 0.47737544E+0000
+        15        1 0.47960249E+0000
+        16        1 0.48173702E+0000
+        17        1 0.48377566E+0000
+        18        1 0.48576848E+0000
+        19        1 0.48782243E+0000
+        20        1 0.48989646E+0000
+        21        1 0.49193221E+0000
+        22        1 0.49389364E+0000
+        23        1 0.49583519E+0000
+        24        1 0.49776105E+0000
+        25        1 0.49962030E+0000
+        26        1 0.50143556E+0000
+        27        1 0.50317036E+0000
+        28        1 0.50485923E+0000
+        29        1 0.50664451E+0000
+        30        1 0.50853615E+0000
+        31        1 0.51045046E+0000
+        32        1 0.51226857E+0000
+        33        1 0.51407573E+0000
+        34        1 0.51602770E+0000
+        35        1 0.51815963E+0000
+        36        1 0.52042992E+0000
+        37        1 0.52266636E+0000
+        38        1 0.52505660E+0000
+        39        1 0.52728244E+0000
+        40        1 0.52969450E+0000
+        41        1 0.53229090E+0000
+        42        1 0.53527067E+0000
+        43        1 0.53851137E+0000
+        44        1 0.54206157E+0000
+        45        1 0.54613874E+0000
+        46        1 0.55113848E+0000
+        47        1 0.55727182E+0000
+        48        1 0.56558815E+0000
+        49        1 0.58836161E+0000
+        50        1 0.68125450E+0000
+        51        1 0.10000000E+0001
+         1        2 0.00000000E+0000
+         2        2 0.26370157E+0000
+         3        2 0.39271999E+0000
+         4        2 0.43012870E+0000
+         5        2 0.44075410E+0000
+         6        2 0.44774635E+0000
+         7        2 0.45282595E+0000
+         8        2 0.45714625E+0000
+         9        2 0.46102928E+0000
+        10        2 0.46445343E+0000
+        11        2 0.46760466E+0000
+        12        2 0.47040234E+0000
+        13        2 0.47289823E+0000
+        14        2 0.47517687E+0000
+        15        2 0.47741446E+0000
+        16        2 0.47962043E+0000
+        17        2 0.48181941E+0000
+        18        2 0.48394261E+0000
+        19        2 0.48605450E+0000
+        20        2 0.48810826E+0000
+        21        2 0.49018741E+0000
+        22        2 0.49223897E+0000
+        23        2 0.49423776E+0000
+        24        2 0.49610132E+0000
+        25        2 0.49797523E+0000
+        26        2 0.49973860E+0000
+        27        2 0.50155020E+0000
+        28        2 0.50328344E+0000
+        29        2 0.50518060E+0000
+        30        2 0.50705340E+0000
+        31        2 0.50913132E+0000
+        32        2 0.51112529E+0000
+        33        2 0.51304682E+0000
+        34        2 0.51498390E+0000
+        35        2 0.51705760E+0000
+        36        2 0.51917865E+0000
+        37        2 0.52148054E+0000
+        38        2 0.52369074E+0000
+        39        2 0.52605146E+0000
+        40        2 0.52858754E+0000
+        41        2 0.53147270E+0000
+        42        2 0.53446957E+0000
+        43        2 0.53771890E+0000
+        44        2 0.54102936E+0000
+        45        2 0.54519884E+0000
+        46        2 0.55011510E+0000
+        47        2 0.55636069E+0000
+        48        2 0.56484075E+0000
+        49        2 0.57835662E+0000
+        50        2 0.69500869E+0000
+        51        2 0.10000000E+0001
+         1        3 0.00000000E+0000
+         2        3 0.41332644E+0000
+         3        3 0.43302824E+0000
+         4        3 0.44305031E+0000
+         5        3 0.44901666E+0000
+         6        3 0.45373769E+0000
+         7        3 0.45766887E+0000
+         8        3 0.46115415E+0000
+         9        3 0.46438627E+0000
+        10        3 0.46729928E+0000
+        11        3 0.47001651E+0000
+        12        3 0.47243722E+0000
+        13        3 0.47476068E+0000
+        14        3 0.47698128E+0000
+        15        3 0.47918079E+0000
+        16        3 0.48142654E+0000
+        17        3 0.48346240E+0000
+        18        3 0.48542146E+0000
+        19        3 0.48731070E+0000
+        20        3 0.48918196E+0000
+        21        3 0.49109240E+0000
+        22        3 0.49281154E+0000
+        23        3 0.49469714E+0000
+        24        3 0.49654212E+0000
+        25        3 0.49841093E+0000
+        26        3 0.50017226E+0000
+        27        3 0.50197551E+0000
+        28        3 0.50379448E+0000
+        29        3 0.50578799E+0000
+        30        3 0.50777614E+0000
+        31        3 0.50976527E+0000
+        32        3 0.51178948E+0000
+        33        3 0.51388169E+0000
+        34        3 0.51592383E+0000
+        35        3 0.51791866E+0000
+        36        3 0.51989003E+0000
+        37        3 0.52196407E+0000
+        38        3 0.52417775E+0000
+        39        3 0.52655562E+0000
+        40        3 0.52912771E+0000
+        41        3 0.53191096E+0000
+        42        3 0.53499154E+0000
+        43        3 0.53811337E+0000
+        44        3 0.54165494E+0000
+        45        3 0.54539088E+0000
+        46        3 0.54998003E+0000
+        47        3 0.55552071E+0000
+        48        3 0.56294281E+0000
+        49        3 0.57442692E+0000
+        50        3 0.64372790E+0000
+        51        3 0.10000000E+0001
  end xi
  end vegas_grid_t
 
 * Cleanup
Index: trunk/share/tests/unit_tests/ref-output/phs_rambo_3.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/phs_rambo_3.ref	(revision 0)
+++ trunk/share/tests/unit_tests/ref-output/phs_rambo_3.ref	(revision 8187)
@@ -0,0 +1,137 @@
+* Test output: phs_rambo_3
+*   Purpose: phase-space evaluation in lab frame
+
+* Initialize a process and a matching phase-space configuration
+
+ Partonic, flat phase-space configuration (RAMBO):
+   ID        = 'phs_rambo_3'
+   n_in      = 2
+   n_out     = 2
+   n_tot     = 4
+   n_state   = 1
+   n_par     = 2
+   n_channel = 1
+   sqrts     =  1.000000000000E+03
+   s_fixed   = F
+   cm_frame  = F
+   azim.dep. = F
+ Flavor combinations:
+   1: s s s s
+ Phase-space / structure-function channels:
+   1: 1
+   MD5 sum (model par)  = '34AE44487D84198697E1368F11F2C8D8'
+   MD5 sum (phs config) = 'B10FDB52F4E22D25FFB480874EA384A7'
+
+* Initialize the phase-space instance
+
+ Partonic phase space: parameters [undefined]
+   m_in    =  1.250000000000E+02  1.250000000000E+02
+   m_out   =  1.250000000000E+02  1.250000000000E+02
+   Flux   =  0.000000000000E+00
+   Volume =  2.552940346135E-05
+ Channel #1:
+   r = 0.0000000 0.0000000
+   f = 0.0000000E+00
+ Partonic phase space: momenta
+ Incoming: [undefined]
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ Outgoing: [undefined]
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ Intermediate masses (massless):
+    0.000000000000E+00 0.000000000000E+00
+ Intermediate masses (massive):
+    0.000000000000E+00 0.000000000000E+00
+
+* Set incoming momenta in lab system
+
+ E =   6.705801627249E+02
+ P =   6.672522009283E+01  0.000000000000E+00  6.554391654789E+02
+ E =   3.786576558844E+02
+ P =   3.767784499627E+01  0.000000000000E+00 -3.554391654789E+02
+
+* Compute phase-space point for x = 0.5, 0.125
+
+ Partonic phase space: parameters
+   m_in    =  1.250000000000E+02  1.250000000000E+02
+   m_out   =  1.250000000000E+02  1.250000000000E+02
+   Flux   =  3.133842031921E+08
+   Volume =  2.552940346135E-05
+ Channel #1: [selected]
+   r = 0.5000000 0.1250000
+   f = 9.6824584E-01
+ Partonic phase space: momenta
+   sqrts  =  1.000000000000E+03
+ Incoming:
+ E =   5.000000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00  4.841229182759E+02
+ E =   5.000000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00 -4.841229182759E+02
+ Outgoing:
+ E =   5.000000000000E+02
+ P =   3.423265984407E+02  3.423265984407E+02  0.000000000000E+00
+ E =   5.000000000000E+02
+ P =  -3.423265984407E+02 -3.423265984407E+02  0.000000000000E+00
+ Transformation c.m -> lab frame
+ L00 =   1.049237818609E+00
+ L0j =   1.000000000000E-01  0.000000000000E+00  3.014962686336E-01
+ L10 =   1.044030650891E-01
+ L1j =   1.004987562112E+00  0.000000000000E+00  3.000000000000E-02
+ L20 =   0.000000000000E+00
+ L2j =   0.000000000000E+00  1.000000000000E+00  0.000000000000E+00
+ L30 =   3.000000000000E-01
+ L3j =   0.000000000000E+00  0.000000000000E+00  1.044030650891E+00
+ Intermediate masses (massless):
+    7.500000000000E+02 0.000000000000E+00
+ Intermediate masses (massive):
+    1.000000000000E+03 1.250000000000E+02
+
+* Extract outgoing momenta in lab system
+
+ E =   5.588515691487E+02
+ P =   3.962355061576E+02  3.423265984407E+02  1.500000000000E+02
+ E =   4.903862494606E+02
+ P =  -2.918324410685E+02 -3.423265984407E+02  1.500000000000E+02
+
+* Inverse kinematics
+
+ Partonic phase space: parameters
+   m_in    =  1.250000000000E+02  1.250000000000E+02
+   m_out   =  1.250000000000E+02  1.250000000000E+02
+   Flux   =  3.133842031921E+08
+   Volume =  2.552940346135E-05
+ Channel #1:
+   r = 0.5000000 0.1250000
+   f = 0.0000000E+00
+ Partonic phase space: momenta
+   sqrts  =  1.000000000000E+03
+ Incoming:
+ E =   5.000000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00  4.841229182759E+02
+ E =   5.000000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00 -4.841229182759E+02
+ Outgoing:
+ E =   5.000000000000E+02
+ P =   3.423265984407E+02  3.423265984407E+02  0.000000000000E+00
+ E =   5.000000000000E+02
+ P =  -3.423265984407E+02 -3.423265984407E+02  0.000000000000E+00
+ Transformation c.m -> lab frame
+ L00 =   1.049237818609E+00
+ L0j =   1.000000000000E-01  0.000000000000E+00  3.014962686336E-01
+ L10 =   1.044030650891E-01
+ L1j =   1.004987562112E+00  0.000000000000E+00  3.000000000000E-02
+ L20 =   0.000000000000E+00
+ L2j =   0.000000000000E+00  1.000000000000E+00  0.000000000000E+00
+ L30 =   3.000000000000E-01
+ L3j =   0.000000000000E+00  0.000000000000E+00  1.044030650891E+00
+ Intermediate masses (massless):
+    7.500000000000E+02 0.000000000000E+00
+ Intermediate masses (massive):
+    1.000000000000E+03 0.000000000000E+00
+
+* Test output end: phs_rambo_3
Index: trunk/share/tests/unit_tests/ref-output/phs_rambo_4.ref
===================================================================
--- trunk/share/tests/unit_tests/ref-output/phs_rambo_4.ref	(revision 0)
+++ trunk/share/tests/unit_tests/ref-output/phs_rambo_4.ref	(revision 8187)
@@ -0,0 +1,124 @@
+* Test output: phs_rambo_4
+*   Purpose: test simple two-channel phase space
+
+* Initialize a decay and a matching phase-space configuration
+
+ Partonic, flat phase-space configuration (RAMBO):
+   ID        = 'phs_rambo_4'
+   n_in      = 1
+   n_out     = 2
+   n_tot     = 3
+   n_state   = 1
+   n_par     = 2
+   n_channel = 1
+   sqrts     =  1.250000000000E+02
+   s_fixed   = T
+   cm_frame  = T
+   azim.dep. = F
+ Flavor combinations:
+   1: s f fbar
+ Phase-space / structure-function channels:
+   1: 1
+   MD5 sum (model par)  = 'D97BD28DED990FF93E2D56F3C62D67B8'
+   MD5 sum (phs config) = '20DB6DE5ADDF67900BDD6CBA93BC4D87'
+
+* Initialize the phase-space instance
+
+ Partonic phase space: parameters [undefined]
+   m_in    =  1.250000000000E+02
+   m_out   =  5.000000000000E+01  5.000000000000E+01
+   Flux   =  6.234181826176E+00
+   Volume =  2.552940346135E-05
+ Channel #1:
+   r = 0.0000000 0.0000000
+   f = 0.0000000E+00
+ Partonic phase space: momenta
+ Incoming: [undefined]
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ Outgoing: [undefined]
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ Intermediate masses (massless):
+    0.000000000000E+00 0.000000000000E+00
+ Intermediate masses (massive):
+    0.000000000000E+00 0.000000000000E+00
+
+* Set incoming momenta
+
+ Partonic phase space: parameters [undefined]
+   m_in    =  1.250000000000E+02
+   m_out   =  5.000000000000E+01  5.000000000000E+01
+   Flux   =  6.234181826176E+00
+   Volume =  2.552940346135E-05
+ Channel #1:
+   r = 0.0000000 0.0000000
+   f = 0.0000000E+00
+ Partonic phase space: momenta
+   sqrts  =  1.250000000000E+02
+ Incoming:
+ E =   1.250000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ Outgoing: [undefined]
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ E =   0.000000000000E+00
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ Intermediate masses (massless):
+    0.000000000000E+00 0.000000000000E+00
+ Intermediate masses (massive):
+    0.000000000000E+00 0.000000000000E+00
+
+* Compute phase-space point for x = 0.5, 0.125
+
+ Partonic phase space: parameters
+   m_in    =  1.250000000000E+02
+   m_out   =  5.000000000000E+01  5.000000000000E+01
+   Flux   =  6.234181826176E+00
+   Volume =  2.552940346135E-05
+ Channel #1: [selected]
+   r = 0.5000000 0.1250000
+   f = 6.0000000E-01
+ Partonic phase space: momenta
+   sqrts  =  1.250000000000E+02
+ Incoming:
+ E =   1.250000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ Outgoing:
+ E =   6.250000000000E+01
+ P =   2.651650429450E+01  2.651650429450E+01  0.000000000000E+00
+ E =   6.250000000000E+01
+ P =  -2.651650429450E+01 -2.651650429450E+01  0.000000000000E+00
+ Intermediate masses (massless):
+    2.500000000000E+01 0.000000000000E+00
+ Intermediate masses (massive):
+    1.250000000000E+02 5.000000000000E+01
+
+* Inverse kinematics
+
+ Partonic phase space: parameters
+   m_in    =  1.250000000000E+02
+   m_out   =  5.000000000000E+01  5.000000000000E+01
+   Flux   =  6.234181826176E+00
+   Volume =  2.552940346135E-05
+ Channel #1:
+   r = 0.5000000 0.1250000
+   f = 0.0000000E+00
+ Partonic phase space: momenta
+   sqrts  =  1.250000000000E+02
+ Incoming:
+ E =   1.250000000000E+02
+ P =   0.000000000000E+00  0.000000000000E+00  0.000000000000E+00
+ Outgoing:
+ E =   6.250000000000E+01
+ P =   2.651650429450E+01  2.651650429450E+01  0.000000000000E+00
+ E =   6.250000000000E+01
+ P =  -2.651650429450E+01 -2.651650429450E+01  0.000000000000E+00
+ Intermediate masses (massless):
+    2.500000000000E+01 0.000000000000E+00
+ Intermediate masses (massive):
+    1.250000000000E+02 0.000000000000E+00
+
+* Test output end: phs_rambo_4
Index: trunk/share/doc/manual.tex
===================================================================
--- trunk/share/doc/manual.tex	(revision 8186)
+++ trunk/share/doc/manual.tex	(revision 8187)
@@ -1,17166 +1,17207 @@
 \documentclass[12pt]{book}
 % \usepackage{feynmp}
 \usepackage{microtype}
 \usepackage{graphics,graphicx}
 \usepackage{color}
 \usepackage{amsmath,amssymb}
 \usepackage[colorlinks,bookmarks,bookmarksnumbered=true]{hyperref}
 \usepackage{thophys}
 \usepackage{fancyvrb}
 \usepackage{makeidx}
 \usepackage{units}
 \usepackage{ifpdf}
 %HEVEA\pdftrue
 \makeindex
 \usepackage{url}
 \usepackage[latin1]{inputenc}
 %HEVEA\@def@charset{UTF-8}
 %BEGIN LATEX
 \usepackage{supertabular,fancyvrb}
 \usepackage{hevea}
 %END LATEX
 \renewcommand{\topfraction}{0.9}
 \renewcommand{\bottomfraction}{0.8}
 \renewcommand{\textfraction}{0.1}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%% Macro section
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \newcommand{\email}[2]{\thanks{\ahref{#1@{}#2}{#1@{}#2}}}
 \newcommand{\hepforgepage}{\url{https://whizard.hepforge.org}}
 \newcommand{\whizardwiki}{\url{https://projects.hepforge.org/whizard/trac/wiki}}
 \tocnumber
 %BEGIN LATEX
 \DeclareMathOperator{\diag}{diag}
 %END LATEX
 %BEGIN LATEX
 \makeatletter
 \newif\if@preliminary
 \@preliminaryfalse
 \def\preliminary{\@preliminarytrue}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%% Changes referring to article.cls
 %
 %%% Title page
 \def\preprintno#1{\def\@preprintno{#1}}
 \def\address#1{\def\@address{#1}}
 \def\email#1#2{\thanks{\tt #1@{}#2}}
 \def\abstract#1{\def\@abstract{#1}}
 \newcommand\abstractname{ABSTRACT}
 \newlength\preprintnoskip
 \setlength\preprintnoskip{\textwidth\@plus -1cm}
 \newlength\abstractwidth
 \setlength\abstractwidth{\textwidth\@plus -3cm}
 %
 \@titlepagetrue
 \renewcommand\maketitle{\begin{titlepage}%
   \let\footnotesize\small
   \hfill\parbox{\preprintnoskip}{%
   \begin{flushright}\@preprintno\end{flushright}}\hspace*{1cm}
   \vskip 60\p@
   \begin{center}%
     {\Large\bf\boldmath \@title \par}\vskip 1cm%
     {\sc\@author \par}\vskip 3mm%
     {\@address \par}%
     \if@preliminary
       \vskip 2cm {\large\sf PRELIMINARY DRAFT \par \@date}%
     \fi
   \end{center}\par
   \@thanks
   \vfill
   \begin{center}%
     \parbox{\abstractwidth}{\centerline{\abstractname}%
     \vskip 3mm%
     \@abstract}
   \end{center}
   \end{titlepage}%
   \setcounter{footnote}{0}%
   \let\thanks\relax\let\maketitle\relax
   \gdef\@thanks{}\gdef\@author{}\gdef\@address{}%
   \gdef\@title{}\gdef\@abstract{}\gdef\@preprintno{}
 }%
 %
 %%% New settings of dimensions
 \topmargin -1.5cm
 \textheight 22cm
 \textwidth 17cm
 \oddsidemargin 0cm
 \evensidemargin 0cm
 %
 %%% Original Latex definition of citex, except for the removal of
 %%% 'space' following a ','. \citerange replaces the ',' by '--'.
 \def\@citex[#1]#2{\if@filesw\immediate\write\@auxout{\string\citation{#2}}\fi
   \def\@citea{}\@cite{\@for\@citeb:=#2\do
     {\@citea\def\@citea{,\penalty\@m}\@ifundefined
        {b@\@citeb}{{\bf ?}\@warning
        {Citation `\@citeb' on page \thepage \space undefined}}%
 \hbox{\csname b@\@citeb\endcsname}}}{#1}}
 \def\citerange{\@ifnextchar [{\@tempswatrue\@citexr}{\@tempswafalse\@citexr[]}}
 \def\@citexr[#1]#2{\if@filesw\immediate\write\@auxout{\string\citation{#2}}\fi
   \def\@citea{}\@cite{\@for\@citeb:=#2\do
     {\@citea\def\@citea{--\penalty\@m}\@ifundefined
        {b@\@citeb}{{\bf ?}\@warning
        {Citation `\@citeb' on page \thepage \space undefined}}%
 \hbox{\csname b@\@citeb\endcsname}}}{#1}}
 %
 %%% Captions set in italics
 \long\def\@makecaption#1#2{%
   \vskip\abovecaptionskip
   \sbox\@tempboxa{#1: \emph{#2}}%
   \ifdim \wd\@tempboxa >\hsize
     #1: \emph{#2}\par
   \else
     \hbox to\hsize{\hfil\box\@tempboxa\hfil}%
   \fi
   \vskip\belowcaptionskip}
 %
 %%% Other useful macros
 \def\fmslash{\@ifnextchar[{\fmsl@sh}{\fmsl@sh[0mu]}}
 \def\fmsl@sh[#1]#2{%
   \mathchoice
     {\@fmsl@sh\displaystyle{#1}{#2}}%
     {\@fmsl@sh\textstyle{#1}{#2}}%
     {\@fmsl@sh\scriptstyle{#1}{#2}}%
     {\@fmsl@sh\scriptscriptstyle{#1}{#2}}}
 \def\@fmsl@sh#1#2#3{\m@th\ooalign{$\hfil#1\mkern#2/\hfil$\crcr$#1#3$}}
 \makeatother
 
 % Labelling command for Feynman graphs generated by package FEYNMF
 %\def\fmfL(#1,#2,#3)#4{\put(#1,#2){\makebox(0,0)[#3]{#4}}}
 
 %END LATEX
 %%%% Environment for showing user input and program response
 \newenvironment{interaction}%
   {\begingroup\small
    \Verbatim}%
   {\endVerbatim
    \endgroup\noindent}
 %BEGIN LATEX
 
 %%%% Environment for typesetting listings verbatim
 \newenvironment{code}%
   {\begingroup\footnotesize
    \quote
    \Verbatim}%
   {\endVerbatim
    \endquote
    \endgroup\noindent}
 
 %%%% Boxed environment for typesetting listings verbatim
 \newenvironment{Code}%
   {\begingroup\footnotesize
    \quote
    \Verbatim[frame=single]}%
   {\endVerbatim
    \endquote
    \endgroup\noindent}
 
 %%% Environment for displaying syntax
 \newenvironment{syntax}%
   {\begin{quote}
    \begin{flushleft}\tt}%
   {\end{flushleft}
    \end{quote}}
 \newcommand{\var}[1]{$\langle$\textit{#1}$\rangle$}
 
 
 %END LATEX
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 % Macros specific for this paper
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \newcommand{\ttt}[1]{\texttt{#1}}
 \newcommand{\whizard}{\ttt{WHIZARD}}
 \newcommand{\oMega}{\ttt{O'Mega}}
 \newcommand{\vamp}{\ttt{VAMP}}
 \newcommand{\vamptwo}{\ttt{VAMP2}}
 \newcommand{\vegas}{\ttt{VEGAS}}
 \newcommand{\madgraph}{\ttt{MadGraph}}
 \newcommand{\CalcHep}{\ttt{CalcHep}}
 \newcommand{\helas}{\ttt{HELAS}}
 \newcommand{\herwig}{\ttt{HERWIG}}
 \newcommand{\isajet}{\ttt{ISAJET}}
 \newcommand{\pythia}{\ttt{PYTHIA}}
 \newcommand{\pythiasix}{\ttt{PYTHIA6}}
 \newcommand{\pythiaeight}{\ttt{PYTHIA8}}
 \newcommand{\jetset}{\ttt{JETSET}}
 \newcommand{\comphep}{\ttt{CompHEP}}
 \newcommand{\circe}{\ttt{CIRCE}}
 \newcommand{\circeone}{\ttt{CIRCE1}}
 \newcommand{\circetwo}{\ttt{CIRCE2}}
 \newcommand{\gamelan}{\textsf{gamelan}}
 \newcommand{\stdhep}{\ttt{STDHEP}}
 \newcommand{\lcio}{\ttt{LCIO}}
 \newcommand{\pdflib}{\ttt{PDFLIB}}
 \newcommand{\lhapdf}{\ttt{LHAPDF}}
 \newcommand{\hepmc}{\ttt{HepMC}}
 \newcommand{\fastjet}{\ttt{FastJet}}
 \newcommand{\hoppet}{\ttt{HOPPET}}
 \newcommand{\metapost}{\ttt{MetaPost}}
 \newcommand{\sarah}{\ttt{SARAH}}
 \newcommand{\spheno}{\ttt{SPheno}}
 \newcommand{\Mathematica}{\ttt{Mathematica}}
 \newcommand{\FeynRules}{\ttt{FeynRules}}
 \newcommand{\UFO}{\ttt{UFO}}
 \newcommand{\gosam}{\ttt{Gosam}}
 \newcommand{\openloops}{\ttt{OpenLoops}}
 \newcommand{\recola}{\ttt{Recola}}
 \newcommand{\collier}{\ttt{Collier}}
 \newcommand{\powheg}{\ttt{POWHEG}}
 %%%%%
 \newcommand{\sindarin}{\ttt{SINDARIN}}
 \newcommand{\cpp}{\ttt{C++}}
 \newcommand{\fortran}{\ttt{Fortran}}
 \newcommand{\fortranSeventySeven}{\ttt{FORTRAN77}}
 \newcommand{\fortranNinetyFive}{\ttt{Fortran95}}
 \newcommand{\fortranOThree}{\ttt{Fortran2003}}
 \newcommand{\ocaml}{\ttt{OCaml}}
 \newcommand{\python}{\ttt{Python}}
 
 \newenvironment{commands}{\begin{quote}\tt}{\end{quote}}
 \newcommand{\eemm}{$e^+e^- \to \mu^+\mu^-$}
 
 %\def\~{$\sim$}
 \newcommand{\sgn}{\mathop{\rm sgn}\nolimits}
 \newcommand{\GeV}{\textrm{GeV}}
 \newcommand{\fb}{\textrm{fb}}
 \newcommand{\ab}{\textrm{ab}}
 
 \newenvironment{parameters}{%
 \begin{center}
 \begin{tabular}{lccp{65mm}}
 \hline
 Parameter & Value & Default & Description \\
 \hline
 }{%
 \hline
 \end{tabular}
 \end{center}
 }
 
 \newenvironment{options}{%
 \begin{center}
 \begin{tabular}{llcp{80mm}}
 \hline
 Option & Long version & Value & Description \\
 \hline
 }{%
 \hline
 \end{tabular}
 \end{center}
 }
 
 %BEGIN LATEX
 \renewenvironment{options}{%
 \begin{center}
 \tablehead{\hline
 Option & Long version & Value & Description \\
 \hline
 }
 \begin{supertabular}{llcp{80mm}}
 }{%
 \hline
 \end{supertabular}
 \end{center}
 }
 %END LATEX
 
 %BEGIN LATEX
 \renewenvironment{parameters}{%
 \begin{center}
 \tablehead{\hline
 Parameter & Value & Default & Description \\
 \hline
 }
 \begin{supertabular}{lccp{65mm}}
 }{%
 \hline
 \end{supertabular}
 \end{center}
 }
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %END LATEX
 \newcommand{\thisversion}{2.6.5}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \begin{document}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %BEGIN LATEX
 \preprintno{}
 %%%\preprintno{arXiv:0708.4233 (also based on LC-TOOL-2001-039 (revised))}
 %END LATEX
 \title{%
 %HEVEA WHIZARD 2.6 \\
 %BEGIN LATEX
  \ttt{\huge WHIZARD 2.6} \\[\baselineskip]
 %END LATEX
  A generic \\ Monte-Carlo integration and event generation package \\
  for multi-particle processes\\[\baselineskip]
  MANUAL
  \footnote{%
  This work is supported by Helmholtz-Alliance ``Physics at the
  Terascale''.
  In former stages this work has also been supported by
  the Helmholtz-Gemeinschaft VH--NG--005 \\
  E-mail: \ttt{whizard@desy.de}
  }
  \\[\baselineskip]
 }
 % \def\authormail{\ttt{kilian@physik.uni-siegen.de},
 %   \ttt{ohl@physik.uni-wuerzburg.de},
 %   \ttt{juergen.reuter@desy.de}, \ttt{cnspeckn@googlemail.com}}
 \author{%
   Wolfgang Kilian,%
   Thorsten Ohl,%
   J\"urgen Reuter,%
   with contributions from
   Fabian Bach, %
   Simon Bra\ss,
   Bijan Chokouf\'{e} Nejad, %
   Christian Fleper, %
   Vincent Rothe, %
   Sebastian Schmidt, %
   Marco Sekulla, %
   Christian Speckner, %
   So Young Shim, %
   Florian Staub, %
   Christian Weiss}
 
 %BEGIN LATEX
 \address{%
  Universit\"at Siegen, Emmy-Noether-Campus, Walter-Flex-Str. 3,
  D--57068 Siegen, Germany \\
  Universit\"at W\"urzburg, Emil-Hilb-Weg 22,
  D--97074 W\"urzburg, Germany \\
  Deutsches Elektronen-Synchrotron DESY, Notkestr. 85,
  D--22603 Hamburg, Germany \\
  %% \authormail
  \vspace{1cm}
  \begin{center}
  \includegraphics[width=4cm]{Whizard-Logo}
  \end{center}
  \mbox{} \\
  \vspace{2cm}
  \mbox{} when using \whizard\ please cite: \\
  W. Kilian, T. Ohl, J. Reuter, \\ {\em WHIZARD: Simulating Multi-Particle
  Processes at LHC and ILC}, \\
  Eur.Phys.J.{\bf C71} (2011) 1742, arXiv:
  0708.4233 [hep-ph]; \\
  M. Moretti, T. Ohl, J. Reuter, \\ {\em O'Mega: An Optimizing Matrix
  Element Generator}, \\
  arXiv: hep-ph/0102195
 }
 %END LATEX
 %BEGIN LATEX
 \abstract{%
 \whizard\ is a program system designed for the efficient calculation
 of multi-particle scattering cross sections and simulated event
 samples.  The generated events can be written to file in various formats
 (including HepMC, LHEF, STDHEP, LCIO, and ASCII) or analyzed directly on the
 parton or hadron level using a built-in \LaTeX-compatible graphics
 package.
 \\[\baselineskip]
 Complete tree-level matrix elements are generated automatically for arbitrary
 partonic multi-particle processes by calling the built-in matrix-element
 generator \oMega.  Beyond hard matrix elements, \whizard\ can generate
 (cascade) decays with complete spin correlations.
 Various models beyond the SM are implemented, in particular,
 the MSSM is supported with an interface to the SUSY Les Houches Accord
 input format.  Matrix elements obtained by alternative methods (e.g.,
 including loop corrections) may be interfaced as well.
 \\[\baselineskip]
 The program uses an adaptive multi-channel method for phase space
 integration, which allows to calculate numerically stable signal and
 background cross sections and generate unweighted event samples with
 reasonable efficiency for processes with up to eight and more
 final-state particles.  Polarization is treated exactly for both the
 initial and final states.  Quark or lepton flavors can be
 summed over automatically where needed.
 \\[\baselineskip]
 For hadron collider physics, we ship the package with the most recent
 PDF sets from the MSTW/MMHT and CTEQ/CT10/CJ12/CJ15/CT14
 collaborations. Furthermore, an interface to the \lhapdf\ library is
 provided.
 \\[\baselineskip]
 For Linear Collider physics,
 beamstrahlung (\circeone, \circetwo), Compton and ISR spectra are
 included for electrons and photons, including the most recent ILC and
 CLIC collider designs. Alternatively, beam-crossing events can be read
 directly from file.
 \\[\baselineskip]
 For parton showering and matching/merging with hard matrix elements ,
 fragmenting and hadronizing the final state, a first version of two
 different parton shower algorithms are included in the \whizard\
 package. This also includes infrastructure for the MLM matching and
 merging algorithm. For hadronization and hadronic decays, \pythia\
 and \herwig\ interfaces are provided which follow the Les Houches
 Accord. In addition, the last and final version of (\fortran) \pythia\
 is included in the package.
 \\[\baselineskip]
 The \whizard\ distribution is available at
 %%% \begin{center}
 %%%   \ttt{http://whizard.event-generator.org}
 %%% \end{center}
 %%% or at
 \begin{center}
   \url{https://projects.hepforge.org/whizard}
 \end{center}
 where also the \ttt{svn} repository is located.
 }
 %END LATEX
 %
 \maketitle
 
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%% Text
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %\begin{fmffile}
 \tableofcontents
 
 \newpage
 \chapter{Introduction}
 
 \section{Disclaimer}
 
 \emph{This is a preliminary version of the WHIZARD manual.  Many parts
   are still missing or incomplete, and some parts will be rewritten and
   improved soon.  To find updated versions of the manual,
   visit the \whizard\ website}
 \begin{center}
   \hepforgepage
 \end{center}
 \emph{or consult the current version in the \ttt{svn} repository
   on \hepforgepage\ directly. Note, that the most recent version of
   the manual might contain information about features of the
   current \ttt{svn} version, which are not contained in the last
   official release version!}
 
 \emph{For information that is not (yet) written in the manual, please
 consult the examples in the \whizard\ distribution.  You will find these in
 the subdirectory \ttt{share/examples} of the main directory where
 \whizard\ is installed. More information about the examples can be
 found on the \whizard\ Wiki page}
 \begin{center}
   \whizardwiki .
 \end{center}
 
 %%%%%
 
 \clearpage
 \section{Overview}
 
 \whizard\ is a multi-purpose event generator that covers all parts of
 event generation (unweighted and weighted), either through intrinsic
 components or interfaces to external packages. Realistic collider
 environments are covered through sophisticated descriptions for beam
 structures at hadron colliders, lepton colliders, lepton-hadron
 colliders, both circular and linear machines. Other options include
 scattering processes e.g. for dark matter annihilation or particle
 decays. \whizard\ contains its in-house generator for (tree-level)
 high-multiplicity matrix elements, \oMega\, that supports the whole
 Standard Model (SM) of particle physics and basically all possibile
 extensions of it. QCD parton shower describe high-multiplicity
 partonic jet events that can be matched with matrix elements. At the
 moment, only hadron collider parton distribution functions (PDFs) and
 hadronization are handled by packages not written by the main
 authors.
 
 This manual is organized mainly along the lines of the way how to run
 \whizard: this is done through a command language, \sindarin\ (Scripting
 INtegration, Data Analysis, Results display and INterfaces.) Though
 this seems a complication at first glance, the user is rewarded with a
 large possibility, flexibility and versatility on how to steer
 \whizard.
 
 After some general remarks in the follow-up sections, in
 Chap.~\ref{chap:installation} we describe how to get the program, the
 package structure, the prerequisites, possible external extensions of
 the program and the basics of the installation (both as superuser and
 locally). Also, a first technical overview how to work with \whizard\
 on single computer, batch clusters and farms are given. Furthermore,
 some rare uncommon possible build problems are discussed, and a tour
 through options for debugging, testing and validation is being made.
 
 A first dive into the running of the program is made in
 Chap.~\ref{chap:start}. This is following by an extensive, but rather
 technical introduction into the steering language \sindarin\ in
 Chap.~\ref{chap:sindarinintro}. Here, the basic elements of the
 language like commands, statements, control structures, expressions
 and variables as well as the form of warnings and error messages are
 explained in detail.
 
 Chap.~\ref{chap:sindarin} contains the application of the \sindarin\
 command language to the main tasks in running \whizard\ in a physics
 framework: the defintion of particles, subevents, cuts, and event
 selections. The specification of a particular physics models is
 \begin{figure}[t]
   \centering
   \includegraphics[width=0.9\textwidth]{whizstruct}
   \caption{General structure of the \whizard\ package.}
 \end{figure}
 discussed, while the next sections are devoted to the setup and
 compilation of code for particular processes, the specification of
 beams, beam structure and polarization. The next step is the
 integration, controlling the integration, phase space, generator cuts,
 scales and weights, proceeding further to event generation and
 decays. At the end of this chapter, \whizard's internal data analysis
 methods and graphical visualization options are documented.
 
 The following chapters are dedicated to the physics implemented in
 \whizard: methods for hard matrix interactions in
 Chap.~\ref{chap:hardint}. Then, in Chap.~\ref{chap:physics},
 implemented methods for adaptive multi-channel integration,
 particularly the integrator \vamp\ are explained, together with the
 algorithms for the generation of the phase-space in \whizard. Finally,
 an overview is given over the physics models implemented in \whizard\
 and its matrix element generator \oMega, together with possibilities
 for their extension. After that, the next chapter discusses parton
 showering, matching and hadronization as well as options for event
 normalizations and supported event formats. Also weighted event
 generation is explained along the lines with options for negative
 weights. Then, in Chap.~\ref{chap:user}, options for user to plug-in
 self-written code into the \whizard\ framework are detailed, e.g. for
 observables, selections and cut functions, or for spectra and
 structure functions. Also, static executables are discussed.
 
 Chap.~\ref{chap:visualization} is a stand-alone documentation of
 GAMELAN, the interal graphics support for the visualization of data
 and analysis. The next chapter, Chap.~\ref{chap:userint} details user
 interfaces: how to use more options of the \whizard\ command on the
 command line, how to use \whizard\ interactively, and how to include
 \whizard\ as a library into the user's own program.
 
 Then, an extensive list of examples in Chap.~\ref{chap:examples}
 documenting physics examples from the LEP, SLC, HERA, Tevatron, and
 LHC colliders to future linear and circular colliders. This chapter is
 a particular good reference for the beginning, as the whole chain from
 choosing a model, setting up processes, the beam structure, the
 integration, and finally simulation and (graphical) analysis are
 explained in detail.
 
 More technical details about efficiency, tuning and advance usage of
 \whizard\ are collected in Chap.~\ref{chap:tuning}. Then,
 Chap.~\ref{chap:extmodels} shows how to set up your own new physics
 model with the help of external programs like \sarah\ or
 \FeynRules\ program or the Universal Feynrules Output, UFO, and
 include it into the \whizard\ event generator.
 
 In the appendices, we e.g. give an exhaustive reference list of
 \sindarin\ commands and built-in variables.
 
 Please report any inconsistencies, bugs, problems or simply pose open
 questions to our contact \url{whizard@desy.de}.
 
 
 %%%%%
 
 \section{Historical remarks}
 
 This section gives a historical overview over the development of
 \whizard\ and can be easily skipped in a (first) reading of the
 manual. \whizard\ has been developed in a first place as a tool for
 the physics at the then planned linear electron-positron collider
 TESLA around 1999. The intention was to have a tool at hand to
 describe electroweak physics of multiple weak bosons and the Higgs
 boson as precise as possible with full matrix elements. Hence, the
 acronym: \ttt{WHiZard}, which stood for $\mathbf{W}$, {\bf H}iggs,
 $\mathbf{Z}$, {\bf a}nd {\bf r}espective {\bf d}ecays.
 
 Several components of the \whizard\ package that are also available as
 independent sub-packages have been published already before the first
 versions of the \whizard\ generator itself: the multi-channel adaptive
 Monte-Carlo integration package \vamp\ has been released mid
 1998~\cite{VAMP}. The dedicated packages for the simulation of linear
 lepton collider beamstrahlung and the option for a photon collider on
 Compton backscattering (\ttt{CIRCE1/2}) date back even to mid
 1996~\cite{CIRCE}. Also parts of the code for \whizard's internal
 graphical analysis (the \gamelan\ module) came into existence already
 around 1998.
 
 After first inofficial versions, the official version 1 of \whizard\
 was release in the year 2000. The development, improvement and
 incorporation of new features continued for roughly a decade. Major
 milestones in the development were the full support of all kinds of
 beyond the Standard Model (BSM) models including spin 3/2 and spin 2
 particles and the inclusion of the MSSM, the NMSSM, Little Higgs
 models and models for anomalous couplings as well as extra-dimensional
 models from version 1.90 on. In the beginning, several methods for
 matrix elements have been used, until the in-house matrix element
 generator \oMega\ became available from version 1.20 on. It was
 included as a part of the \whizard\ package from version 1.90 on. The
 support for full color amplitudes came with version 1.50, but in a
 full-fledged version from 2.0 on. Version 1.40 brought the necessary
 setups for all kinds of collider environments, i.e. asymmetric beams,
 decay processes, and intrinsic $p_T$ in structure functions.
 
 Version 2.0 was released in April 2010 as an almost complete rewriting
 of the original code. It brought the construction of an internal
 density-matrix formalism which allowed the use of factorized
 production and (cascade) decay processes including complete color and
 spin correlations. Another big new feature was the command-line
 language \sindarin\ for steering all parts of the program. Also, many
 performance improvement have taken place in the new release series,
 like OpenMP parallelization, speed gain in matrix element generation
 etc. Version 2.2 came out in May 2014 as a major refactoring of the
 program internals but keeping (almost everywhere) the same user
 interface. New features are inclusive processes, reweighting, and more
 interfaces for QCD environments (BLHA/HOPPET).
 
 The following tables shows some of the major steps (physics
 implementation and/or technical improvements) in the development
 of \whizard:
 
 \begin{center}
 \begin{tabular}{|l|l|l|}\hline
   0.99 & 08/1999 & Beta version \\\hline
   1.00 & 12/2000 & First public version \\\hline
   1.10 & 03/2001 & Libraries; \pythiasix\ interface \\
   1.11 & 04/2001 & PDF support; anomalous couplings \\ \hline
   1.20 & 02/2002 & \oMega\ matrix elements; \ttt{CIRCE} support\\
   1.22 & 03/2002 & QED ISR; beam remnants, phase space improvements \\
   1.25 & 05/2003 & MSSM; weighted events; user-code plug-in \\
   1.28 & 04/2004 & Improved phase space; SLHA interface; signal catching
   \\\hline
   1.30 & 09/2004 & Major technical overhaul \\\hline
   1.40 & 12/2004 & Asymmetric beams; decays; $p_T$ in structure
   functions \\\hline
   1.50 & 02/2006 & QCD support in \oMega\ (color flows); LHA format \\
   1.51 & 06/2006 & $Hgg$, $H\gamma\gamma$; Spin 3/2 + 2; BSM models
   \\\hline
   1.90 & 11/2007 & \oMega\ included; LHAPDF support; $Z'$; $WW$ scattering \\
   1.92 & 03/2008 & LHE format; UED; parton shower beta version \\
   1.93 & 04/2009 & NMSSM; SLHA2 accord; improved color/flavor sums \\
   1.95 & 02/2010 & MLM matching; development stop in version 1
   \\
   1.97 & 05/2011 & Manual for version 1 completed. \\\hline\hline
   2.0.0 & 04/2010 & Major refactoring: automake setup; dynamic
   libraries \\
   & & improved speed; cascades; OpenMP; \sindarin\ steering language \\
   2.0.3 & 07/2010 & QCD ISR+FSR shower; polarized beams \\
   2.0.5 & 05/2011 & Builtin PDFs; static builds; relocation scripts \\
   2.0.6 & 12/2011 & Anomalous top couplings; unit tests \\\hline
   2.1.0 & 06/2012 & Analytic ISR+FSR parton shower; anomalous Higgs
   couplings \\\hline
   2.2.0 & 05/2014 & Major technical refactoring: abstract
   object-orientation; THDM; \\
   & & reweighting; LHE v2/3; BLHA; HOPPET interface; inclusive
   processes \\
   2.2.1 & 05/2014 & CJ12 PDFs; FastJet interface \\
   2.2.2 & 07/2014 & LHAPDF6 support; correlated LC beams; GuineaPig
   interface \\
   2.2.3 & 11/2014 & O'Mega virtual machine; lepton collider top
   pair threshold; Higgs singlet extension \\
   2.2.4 & 02/2015 & LCIO support; progress on NLO; many technical
   bug fixes \\
   2.2.7 & 08/2015 & progress on POWHEG; fixed-order NLO events;
   revalidation of ILC event chain \\
   2.2.8 & 11/2015 & support for quadruple precision; StdHEP included;
   SM dim 6 operators supported
   \\\hline
   2.3.0 & 07/2016 & NLO: resonance mappings for FKS subtraction; more
   advanced cascade syntax; \\
   & & GUI ($\alpha$ version); UFO support
   ($\alpha$ version); ILC v1.9x-v2.x final validation \\
   2.3.1 & 08/2016 & Complex mass scheme
   \\\hline
   2.4.0 & 11/2016 & Refactoring of NLO setup \\
   2.4.1 & 03/2017 & $\alpha$ version of new VEGAS implementation
   \\\hline
   2.5.0 & 05/2017 & Full UFO support (SM-like models)
   \\\hline
   2.6.0 & 09/2017 & MPI parallel integration and event generation;
   resonance histories \\
   & & for showers; RECOLA support \\
   2.6.1 & 11/2017 & EPA/ISR transverse distributions, handling of
   shower resonances; \\
   & & more efficient (alternative) phase space generation \\
   2.6.2 & 12/2017 & $Hee$ coupling, improved resonance matching \\
   2.6.3 & 02/2018 & Partial NLO refactoring for quantum numbers,
   unified RECOLA 1/2 interface. \\
   2.6.4. & 08/2018 & Gridpack functionality; Bug fixes: color flows,
   HSExt model, MPI setup
   \\\hline
 \end{tabular}
 \end{center}
 
 \vspace{.5cm}
 
 For a detailed overview over the historical development of the code
 confer the \ttt{ChangeLog} file and the commit messages in our
 revision control system repository.
 
 %%%%%
 
 \section{About examples in this manual}
 
 Although \whizard\ has been designed as a Monte Carlo event generator
 for LHC physics, several elementary steps and aspects of its usage
 throughout the manual will be demonstrated with the famous textbook
 example of $e^+e^- \to \mu^+ \mu^-$. This is the same process, the
 textbook by Peskin/Schroeder \cite{PeskinSchroeder} uses as a prime
 example to teach the basics of quantum field theory. We use this
 example not because it is very special for \whizard\ or at the time
 being a relevant physics case, but simply because it is the easiest
 fundamental field theoretic process without the complications of
 structured beams (which can nevertheless be switched on like for ISR
 and beamstrahlung!), the need for jet definitions/algorithms and
 flavor sums; furthermore, it easily accomplishes a demonstration of
 polarized beams. After the basics of \whizard\ usage have been
 explained, we move on to actual physics cases from LHC (or Tevatron).
 
 
 \newpage
 \chapter{Installation}
 \label{chap:installation}
 
 \section{Package Structure}
 
 \whizard\ is a software package that consists of a main executable
 program (which is called \ttt{whizard}), libraries, auxiliary
 executable programs, and machine-independent data files.  The whole
 package can be installed by the system administrator, by default, on a
 central location in the file system (\ttt{/usr/local} with its proper
 subdirectories).  Alternatively, it is possible to install it in a
 user's home directory, without administrator privileges, or at any
 other location.
 
 A \whizard\ run requires a workspace, i.e., a writable directory where
 it can put generated code and data.  There are no constraints on the
 location of this directory, but we recommend to use a separate
 directory for each \whizard\ project, or even for each \whizard\ run.
 
 Since \whizard\ generates the matrix elements for scattering and decay
 processes in form of \fortran\ code that is automatically compiled and
 dynamically linked into the running program, it requires a working
 \fortran\ compiler not just for the installation, but also at runtime.
 
 The previous major version \whizard1 did put more constraints on the
 setup.  In a nutshell, not just the matrix element code was compiled
 at runtime, but other parts of the program as well, so the whole
 package was interleaved and had to be installed in user space.  The
 workflow was controlled by \ttt{make} and PERL scripts.  These
 constraints are gone in the present version in favor of a clean
 separation of installation and runtime workspace.
 
 
 \section{\label{sec:prerequisites}Prerequisites}
 
 \subsection{No Binary Distribution}
 
 \whizard\ is currently not distributed as a binary package, nor is it
 available as a debian or RPM package.  This might change in the
 future.  However, compiling from source is very simple (see below).
 Since the package needs a compiler also at runtime, it would not work
 without some development tools installed on the machine, anyway.
 
 Note, however, that we support an install script, that downloads all
 necessary prerequisites, and does the configuration and compilation
 described below automatically. This is called the ``instant WHIZARD''
 and is accessible through the WHIZARD webpage from version 2.1.1 on:
 \url{https://whizard.hepforge.org/versions/install/install-whizard-2.X.X.sh}.
 Download this shell script, make it executable by
 \begin{interaction}
   chmod +x install-whizard-2.X.X.sh
 \end{interaction}
 and execute it. Note that this also involves compilation of the
 required \ttt{Fortran} compiler which takes 1-3 hours depending on
 your system.
 \ttt{Darwin} operating systems (a.k.a. as \ttt{Mac OS X}) have a very
 similar general system for all sorts of software, called
 \ttt{MacPorts} (\url{http://www.macports.org}). This offers to install
 \whizard\ as one of its software ports, and is very similar to
 ``instant WHIZARD'' described above.
 
 
 \subsection{Tarball Distribution}
 
 This is the recommended way of obtaining \whizard.  You may download
 the current stable distribution from the \whizard\ webpage,
 hosted at the HepForge webpage
 \begin{quote}
   \hepforgepage
 \end{quote}
 The distribution is a single file, say \ttt{whizard-\thisversion.tgz} for
 version \thisversion.
 
 You need the additional prerequisites:
 \begin{itemize}
 \item
   GNU \ttt{tar} (or \ttt{gunzip} and \ttt{tar}) for unpacking the
   tarball.
 \item
   The \ttt{make} utility.  Other standard Unix utilities (\ttt{sed},
   \ttt{grep}, etc.) are usually installed by default.
 \item
   A modern \fortran\ compiler (see Sec.~\ref{sec:compilers} for
   details).
 \item
   The \ocaml\ system.  \ocaml\ is a functional and object-oriented
   language.  Version 3.12 or later is required to compile all components
   of \whizard. The package is freely available either as a debian/RPM package
   on your system (it might be necessary to install it from the usual
   repositories), or you can obtain it directly from
   \begin{quote}
     \url{http://caml.inria.fr}
   \end{quote}
   and install it yourself.  If desired, the package can be installed
   in user space without administrator privileges\footnote{
     Unfortunately, the version of the \ocaml\
     compiler from 3.12.0 broke backwards compatibility. Therefore,
     versions of \oMega/\whizard\ up to 2.0.2 only compile with older
     versions (3.11.x works). This has been fixed in versions
     2.0.3 and later. See also Sec.~\ref{sec:buildproblems}.}.
 \end{itemize}
 The following optional external packages are not required, but used
 for certain purposes.  Make sure to check whether you will need any of
 them, before you install \whizard.
 \begin{itemize}
 \item
   \LaTeX\ and \metapost\ for data visualization.  Both are part of the
   \TeX\ program family.  These programs are not absolutely necessary,
   but \whizard\ will lack the tools for visualization without them.
 \item
   The \lhapdf\ structure-function library.  See
   Sec.~\ref{sec:lhapdf_install}.
 \item
   The \hoppet\ structure-function matching tool. See
   Sec.~\ref{sec:hoppet}.
 \item
   The \hepmc\ event-format package.  See Sec.~\ref{sec:hepmc}.
 \item
   The \fastjet\ jet-algorithm package.  See Sec.~\ref{sec:fastjet}.
 \item
   The \lcio\ event-format package.  See Sec.~\ref{sec:lcio}.
 \end{itemize}
 Until version v2.2.7 of \whizard, the event-format package \stdhep\ used
 to be available as an external package. As their distribution is frozen
 with the final version v5.06.01, and it used to be notoriously difficult to
 compile and link \stdhep\ into \whizard, it was decided to include \stdhep\
 into \whizard. This is the case from version v2.2.8 of \whizard\ on. Linking
 against an external version of \stdhep\ is precluded from there
 on. Nevertheless, we list some explanations in Sec.~\ref{sec:stdhep}.
 Once these prerequisites are met, you may unpack the package in a
 directory of your choice
 \begin{quote}\small\tt
   some-directory> tar xzf whizard-\thisversion.tgz
 \end{quote}
 and proceed.\footnote{Without GNU \ttt{tar}, this would read
   \ttt{\small gunzip -c whizard-\thisversion.tgz | tar xz -}}
 
 For using external physics models that are directly supported by
 \whizard\ and \oMega, the user can use tools like \sarah\ or
 \FeynRules. There installation and linking to \whizard\ will be
 explained in Chap.~\ref{chap:extmodels}. Besides this, also new models
 can be conveniently included via \UFO\ files, which will be explained
 as well in that chapter.
 
 The directory will then contain a subdirectory \ttt{whizard-\thisversion}
 where the complete source tree is located.  To update later to a new
 version, repeat these steps.  Each new version will unpack in a
 separate directory with the appropriate name.
 
 
 \subsection{SVN Repository Version}
 
 If you want to install the latest development version, you have to
 check it out from the \whizard\ SVN repository.
 
 In addition to the prerequisites listed in the previous section, you
 need:
 \begin{itemize}
 \item
   The \ttt{subversion} package (\ttt{svn}), the tool for dealing with
   SVN repositories.
 \item
   The \ttt{autoconf} package, part of the \ttt{autotools} development
   system.
 \item
   The \ttt{noweb} package, a light-weight tool for literate programming.  This
   package is nowadays often part of Linux distributions\footnote{In
     Ubuntu from version 10.04 on, and in Debian since
     squeeze. For \ttt{Mac OS X}, \ttt{noweb} is available via the
     \ttt{MacPorts} system.}.  You can obtain the source code
   from\footnote{Please, do not use any of the binary builds from this
     webpage. Probably all of them are quite old and broken.}
   \begin{quote}
     \url{http://www.cs.tufts.edu/~nr/noweb/}
   \end{quote}
 \end{itemize}
 To start, go to a directory of your choice and execute
 \begin{interaction}
   your-src-directory> svn checkout
   svn+ssh://vcs@phab.hepforge.org/source/whizardsvn/trunk \;\; .
 \end{interaction}
 Note that for the time being after the HepForge system modernization
 early September 2018, a HepForge account with a local ssl key is
 necessary to checkout the subversion repository. This is enforced by
 the phabricator framework of HepForge, and will hopefully be relaxed
 in the future. The SVN source tree will appear in the current
 directory.  To update later, you just have to execute
 \begin{interaction}
   your-src-directory> svn update
 \end{interaction}
 within that directory.
 
 After checking out the sources, you first have to create
 \ttt{configure.ac} by executing the shell script
 \ttt{build\_master.sh}. Afterwards, run\footnote{At least, version
   2.65 of the \ttt{autoconf} package is required.}
 \begin{interaction}
   your-src-directory> autoreconf
 \end{interaction}
 This will generate a \ttt{configure} script.
 
 
 \subsection{\label{sec:compilers}Fortran Compilers}
 
 \whizard\ is written in modern \fortran.  To be precise, it uses a
 subset of the \fortranOThree\ standard.  At the time of this writing,
 this subset is supported by, at least, the following compilers:
 \begin{itemize}
 \item
   \ttt{gfortran} (GNU, Open Source).  You will need version 4.8.4
   or higher\footnote{Note that \whizard\ versions 2.0.0 until 2.3.1 compiled
   with \ttt{gfortran} 4.7.4, but the object-oriented
   refactoring of the \whizard\ code from 2.4 on made a switch to
   \ttt{gfortran} 4.8.4 or higher necessary.}. We recommend to use at
   least version 5.4 or higher, as especially the the early version of
   4.8.X and 4.9.X experience some severe bugs.
 \item
   \ttt{nagfor} (NAG).  You will need version 6.0 or higher.
 \item
   \ttt{ifort} (Intel). You will need version 17.0.4 or
   higher.
 \end{itemize}
 
 %%%%%
 
 \subsection{LHAPDF}
 \label{sec:lhapdf_install}
 
 For computing scattering processes at hadron colliders such as the
 LHC, \whizard\ has a small set of standard structure-function
 parameterizations built in, cf.\ Sec.~\ref{sec:built-in-pdf}.  For
 many applications, this will be sufficient, and you can skip this
 section.
 
 However, if you need structure-function parameterizations that are not
 in the default set (e.g. PDF error sets), you can use the \lhapdf\
 structure-function library, which is an external package.  It has to
 be linked during \whizard\ installation.  For use with \whizard,
 version 5.3.0 or higher of the library is required\footnote{ Note that
   PDF sets which contain photons as partons are only supported with
   \whizard\ for \lhapdf\ version 5.7.1 or higher}. The \lhapdf\
 package has undergone a major rewriting from \fortran\ version 5
 to \ttt{C++} version 6. While still maintaining the interface for
 the \lhapdf\ version 5 series, from version 2.2.2 of \whizard\ on, the
 new release series of \lhapdf, version 6.0 and higher, is also
 supported.
 
 If \lhapdf\ is not yet installed on your system, you can download it from
 \begin{quote}
   \url{https://lhapdf.hepforge.org}
 \end{quote}
 for the most recent LHAPDF version 6 and newer, or
 \begin{quote}
   \url{https://lhapdf.hepforge.org/lhapdf5}
 \end{quote}
 for version 5 and older, and install it.  The website contains
 comprehensive documentation on the configuring and installation
 procedure.  Make sure that you have downloaded and installed not just
 the package, but also the data sets. Note that \lhapdf\ version 5
 needs both a \fortran\ and a \ttt{C++} compiler.
 
 During \whizard\ configuration, \whizard\ looks for the script
 \ttt{lhapdf} (which is present in \lhapdf\ series 6) first, and then
 for \ttt{lhapdf-config} (which is present since \lhapdf\ version
 4.1.0): if those are in an executable path (or only
 the latter for \lhapdf\ version 5), the environment variables for
 \lhapdf\ are automatically recognized by \whizard, as well as the
 version number. This should look like this in the \ttt{configure}
 output (for \lhapdf\ version 6 or newer),
 
 \begin{footnotesize}
 \begin{verbatim}
    configure: --------------------------------------------------------------
    configure: --- LHAPDF ---
    configure:
    checking for lhapdf... /usr/local/bin/lhapdf
    checking for lhapdf-config... /usr/local/bin/lhapdf-config
    checking the LHAPDF version... 6.1.6
    checking the major version... 6
    checking the LHAPDF pdfsets path... /usr/local/share/LHAPDF
    checking the standard PDF sets...  all standard PDF sets installed
    checking if LHAPDF is functional (may take a while)... yes
    checking LHAPDF... yes
    configure: --------------------------------------------------------------
 \end{verbatim}
 \end{footnotesize}
 while for \lhapdf\ version 5 and older it looks like this:
 
 \begin{footnotesize}
 \begin{verbatim}
    configure: --------------------------------------------------------------
    configure: --- LHAPDF ---
    configure:
    checking for lhapdf... no
    checking for lhapdf-config... /usr/local/bin/lhapdf-config
    checking the LHAPDF version... 5.9.1
    checking the major version... 5
    checking the LHAPDF pdfsets path... /usr/local/share/lhapdf/PDFsets
    checking the standard PDF sets...  all standard PDF sets installed
    checking for getxminm in -lLHAPDF... yes
    checking for has_photon in -lLHAPDF... yes
    configure: --------------------------------------------------------------
 \end{verbatim}
 \end{footnotesize}
 
 If you want to use a different \lhapdf\ (e.g. because the one installed
 on your system by default is an older one), the preferred way to do so
 is to put the \ttt{lhapdf} (and/or \ttt{lhapdf-config}) scripts in an
 executable path that is checked before the system paths,
 e.g. \ttt{<home>/bin}.
 
 For the old series, \lhapdf\ version 5, a possible error could arise
 if \lhapdf\ had been compiled with a different \fortran\ compiler than
 \whizard, and if the run-time library of that \fortran\ compiler had
 not been included in the \whizard\ configure process. The output then
 looks like this:
 
 \begin{footnotesize}
 \begin{verbatim}
    configure: --------------------------------------------------------------
    configure: --- LHAPDF ---
    configure:
    checking for lhapdf... no
    checking for lhapdf-config... /usr/local/bin/lhapdf-config
    checking the LHAPDF version... 5.9.1
    checking the major version... 5
    checking the LHAPDF pdfsets path... /usr/local/share/lhapdf/PDFsets
    checking for standard PDF sets... all standard PDF sets installed
    checking for getxminm in -lLHAPDF... no
    checking for has_photon in -lLHAPDF... no
    configure: --------------------------------------------------------------
 \end{verbatim}
 \end{footnotesize}
 
 So, the \whizard\ configure found the \lhapdf\ distribution, but could
 not link because it could not resolve the symbols inside the
 library. In case of failure, for more details confer the
 \ttt{config.log}.
 
 If \lhapdf\ is installed in a non-default directory where
 \whizard\ would not find it, set the environment variable
 \ttt{LHAPDF\_DIR} to the correct installation path when configuring
 \whizard.
 
 The check for the standard PDF sets are those sets that are used in
 the default \whizard\ self tests in the case \lhapdf\ is enabled and
 correctly linked. If some of them are missing, then this test will
 result in a failure. They are the \ttt{CT10} set for \lhapdf\ version
 6 (for version 5, \ttt{cteq61.LHpdf}, \ttt{cteq6ll.LHpdf},
 \ttt{cteq5l.LHgrid}, and \ttt{GSG961.LHgrid} are demanded). If you
 want to use \lhapdf\ inside \whizard\ please install them such that
 \whizard\ could perform all its sanity checks with them. The last
 check is for the \ttt{has\_photon} flag, which tests whether photon
 PDFs are available in the found \lhapdf\ installation.
 
 %%%%%
 
 \subsection{HOPPET}
 \label{sec:hoppet}
 
 \hoppet\ (not Hobbit) is a tool for the QCD DGLAP evolution of PDFs
 for hadron colliders. It provides possibilities for matching
 algorithms for 4- and 5-flavor schemes, that are important for
 precision simulations of $b$-parton initiated processes at hadron
 colliders. If you are not interested in those features, you can skip
 this section. Note that this feature is not enabled by default (unlike
 e.g. \lhapdf), but has to be explicitly during the configuration
 (see below):
 \begin{interaction}
   your-build-directory> your-src-directory/configure --enable-hoppet
 \end{interaction}
 If you \ttt{configure} messages like the following:
 \begin{footnotesize}
 \begin{verbatim}
 configure: --------------------------------------------------------------
 configure: --- HOPPET ---
 configure:
 checking for hoppet-config... /usr/local/bin/hoppet-config
 checking for hoppetAssign in -lhoppet_v1... yes
 configure: --------------------------------------------------------------
 \end{verbatim}
 \end{footnotesize}
 then you know that \hoppet\ has been found and was correctly
 linked. If that is not the case, you have to specify the location of
 the \hoppet\ library, e.g. by adding
 \begin{interaction}
   HOPPET=<hoppet\_directory>/lib
 \end{interaction}
 to the \ttt{configure} options above. For more details, please confer
 the \hoppet\ manual.
 
 %%%%%
 
 \subsection{HepMC}
 \label{sec:hepmc}
 
 Now, there is also a first attempt to support the new version 3 of
 \hepmc. The configure step can already successfully recognize the two
 different versions, but version 3 is not yet fully functional. So for
 the moment, users should still use version 2. Also, version 3 of
 \hepmc\ still lacks all features of version 2.
 
 \hepmc\ is a \ttt{C++} class library for handling collider scattering
 events.  In particular, it provides a portable format for event files.
 If you want to use this format, you should link \whizard\ with \hepmc,
 otherwise you can skip this section.
 
 If it is not already installed on your system, you may obtain
 \hepmc\ from one of these two webpages:
 \begin{quote}
   \url{http://lcgapp.cern.ch/project/simu/HepMC/}
 \end{quote}
 or
 \begin{quote}
   \url{http://hepmc.web.cern.ch/hepmc/}
 \end{quote}
 If the \hepmc\ library is linked with the installation, \whizard\ is
 able to read and write files in the \hepmc\ format.
 
 Detailed information on the installation and usage can be found on the
 \hepmc\ homepage. We give here only some brief details relevant for
 the usage with \whizard: For the compilation of HepMC one needs a
 \ttt{C++} compiler. Then the procedure is the same as for the
 \whizard\ package, namely configure HepMC:
 \begin{interaction}
   configure --with-momentum=GEV --with-length=MM --prefix=<install dir>
 \end{interaction}
 Note that the particle momentum and decay length flags are mandatory, and
 we highly recommend to set them to the values \ttt{GEV} and \ttt{MM},
 respectively. After configuration, do \ttt{make}, an optional
 \ttt{make check} (which might sometimes fail for non-standard values
 of momentum and length), and finally \ttt{make install}.
 
 A \whizard\ configuration for HepMC looks like this:
 \begin{footnotesize}
   \begin{verbatim}
    configure: --------------------------------------------------------------
    configure: --- HepMC ---
    configure:
    checking the HepMC version... 2.06.09
    checking for GenEvent class in -lHepMC... yes
    configure: --------------------------------------------------------------
   \end{verbatim}
 \end{footnotesize}
 
 If \hepmc\ is installed in a non-default directory where \whizard\
 would not find it, set the environment variable \ttt{HEPMC\_DIR} to
 the correct installation path when configuring \whizard.  Furthermore,
 the environment variable \ttt{CXXFLAGS} allows you to set specific
 \ttt{C/C++} preprocessor flags, e.g. non-standard include paths for
 header files.
 
 %%%%%
 
 \subsection{PYTHIA8}
 \label{sec:pythia8}
 
 \emph{NOTE: This is at the moment not yet supported, but merely a stub
 with the only purpose to be recognized by the build system.}
 
 \pythiaeight\ is a \ttt{C++} class library for handling hadronization,
 showering and underlying event. If you want to use this feature (once it is
 fully supported in \whizard), you should link \whizard\ with \pythiaeight,
 otherwise you can skip this section.
 
 If it is not already installed on your system, you may obtain
 \pythiaeight\ from
 \begin{quote}
   \url{http://home.thep.lu.se/~torbjorn/Pythia.html}
 \end{quote}
 If the \pythiaeight\ library is linked with the installation, \whizard\ will
 be able to use its hadronization and showering, once this is fully supported
 within \whizard.
 
 To link a \pythiaeight\ installation to \whizard, you should specify the flag
 \begin{quote}
 \ttt{--enable-pythia8}
 \end{quote}
 to \ttt{configure}.  If  \pythiaeight\ is installed in a non-default directory
 where \whizard\ would not find it, specify also
 \begin{quote}
 \ttt{--with-pythia8=\emph{<your-pythia8-installation-path>}}
 \end{quote}
 
 A successful \whizard\ configuration should produce a screen output
 similar to this:
 \begin{footnotesize}
 \begin{verbatim}
 configure: --------------------------------------------------------------
 configure: --- SHOWERS PYTHIA6 PYTHIA8 MPI ---
 configure:
 [....]
 checking for pythia8-config... /usr/local/bin/pythia8-config
 checking if PYTHIA8 is functional... yes
 checking PYTHIA8... yes
 configure: WARNING: PYTHIA8 configure is for testing purposes at the moment.
 configure: --------------------------------------------------------------
 \end{verbatim}
 \end{footnotesize}
 
 %%%%%
 
 \subsection{FastJet}
 \label{sec:fastjet}
 
 \emph{NOTE: This is an experimental feature.}
 
 \fastjet\ is a \ttt{C++} class library for handling jet clustering.
 If you want to use this feature, you should link \whizard\ with \fastjet,
 otherwise you can skip this section.
 
 If it is not already installed on your system, you may obtain
 \fastjet\ from
 \begin{quote}
   \url{http://fastjet.fr}
 \end{quote}
 If the \fastjet\ library is linked with the installation, \whizard\ is
 able to call the jet algorithms provided by this program for the purposes of
 applying cuts and analysis.
 
 To link a \fastjet\ installation to \whizard, you should specify the flag
 \begin{quote}
 \ttt{--enable-fastjet}
 \end{quote}
 to \ttt{configure}.  If  \fastjet\ is installed in a non-default directory
 where \whizard\ would not find it, specify also
 \begin{quote}
 \ttt{--with-fastjet=\emph{<your-fastjet-installation-path>}}
 \end{quote}
 
 A successful \whizard\ configuration should produce a screen output
 similar to this:
 \begin{footnotesize}
 \begin{verbatim}
 configure: --------------------------------------------------------------
 configure: --- FASTJET ---
 configure:
 checking for fastjet-config... /usr/local/bin/fastjet-config
 checking if FastJet is functional... yes
 checking FastJet... yes
 configure: --------------------------------------------------------------
 \end{verbatim}
 \end{footnotesize}
 
 %%%%%
 
 \subsection{STDHEP}
 \label{sec:stdhep}
 
 \stdhep\ is a  library for handling collider scattering
 events~\cite{stdhep}.  In particular, it provides a portable format
 for event files. Until version 2.2.7 of \whizard, \stdhep\ that was
 maintained by Fermilab, could be linked as an externally compiled
 library. As the \stdhep\ package is frozen in its final release
 v5.06.1 and no longer maintained, it has from version 2.2.8 been
 included \whizard. This eases many things, as it was notoriously
 difficult to compile and link \stdhep\ in a way compatible with
 \whizard. Not the full package has been included, but only the
 libraries for file I/O (\ttt{mcfio}, the library for the XDR
 conversion), while the various translation tools for \pythia, \herwig,
 etc.  have been abandoned. Note that \stdhep\ has largely been
 replaced in the hadron collider community by the \hepmc\ format, and
 in the lepton collider community by \lcio. \whizard\ might serve as a
 conversion tools for all these formats, but other tools also exist, of
 course.
 
 If the \stdhep\ library is linked with the installation, \whizard\ is
 able to write files in the \stdhep\ format, the  corresponding
 configure output notifies you that \stdhep\ is always included:
 \begin{footnotesize}
 \begin{verbatim}
 configure: --------------------------------------------------------------
 configure: --- STDHEP ---
 configure:
 configure: StdHEP v5.06.01 is included internally
 configure: --------------------------------------------------------------
 \end{verbatim}
 \end{footnotesize}
 
 %%%%%
 
 \subsection{LCIO}
 \label{sec:lcio}
 
 
 \lcio\ is a \ttt{C++} class library for handling collider scattering
 events.  In particular, it provides a portable format for event files.
 If you want to use this format, you should link \whizard\ with \lcio,
 otherwise you can skip this section.
 
 If it is not already installed on your system, you may obtain
 \lcio\ from:
 \begin{quote}
   \url{http://lcio.desy.de}
 \end{quote}
 If the \lcio\ library is linked with the installation, \whizard\ is
 able to read and write files in the \lcio\ format.
 
 Detailed information on the installation and usage can be found on the
 \lcio\ homepage. We give here only some brief details relevant for
 the usage with \whizard: For the compilation of \lcio\ one needs a
 \ttt{C++} compiler. \lcio\ is based on \ttt{cmake}. For the
 corresponding options please confer the \lcio\ manual.
 
 A \whizard\ configuration for \lcio\ looks like this:
 \begin{footnotesize}
   \begin{verbatim}
    configure: --------------------------------------------------------------
    configure: --- LCIO ---
    configure:
    checking the LCIO version... 2.7.1
    checking for LCEventImpl class in -llcio... yes
    configure: --------------------------------------------------------------
   \end{verbatim}
 \end{footnotesize}
 
 If \lcio\ is installed in a non-default directory where \whizard\
 would not find it, set the environment variable \ttt{LCIO} or
 \ttt{LCIO\_DIR} to the correct installation path when configuring
 \whizard.  The first one is the variable exported by the
 \ttt{setup.sh}  script while the second one is analogous to the
 environment variables of other external packages. \ttt{LCIO} takes
 precedence over \ttt{LCIO\_DIR}. Furthermore, the environment variable
 \ttt{CXXFLAGS} allows you to set specific \ttt{C/C++} preprocessor
 flags, e.g. non-standard include paths for header files.
 
 %%%%%
 
 \section{Installation}
 \label{sec:installation}
 
 Once you have unpacked the source (either the tarball or the SVN
 version), you are ready to compile it.  There are several options.
 
 
 \subsection{Central Installation}
 This is the default and recommended way, but it requires adminstrator
 privileges.  Make sure that all
 prerequisites are met (Sec.~\ref{sec:prerequisites}).
 \begin{enumerate}
 \item
   Create a fresh directory for the \whizard\ build.  It is recommended
   to keep this separate from the source directory.
 \item
   Go to that directory and execute
   \begin{interaction}
     your-build-directory> your-src-directory/configure
   \end{interaction}
   This will analyze your system and prepare the compilation of \whizard\
   in the build directory.  Make sure to set the proper options to
   \ttt{configure}, see Sec.~\ref{sec:configure-options} below.
 \item
   Call \ttt{make} to compile and link \whizard:
   \begin{interaction}
     your-build-directory> make
   \end{interaction}
 \item
   If you want to make sure that everything works, run
   \begin{interaction}
     your-build-directory> make check
   \end{interaction}
   This will take some more time.
 \item
   Become superuser and say
   \begin{interaction}
     your-build-directory> make install
   \end{interaction}
 \end{enumerate}
 \whizard\ should now installed in the default locations, and the
 executable should be available in the standard path.  Try to call
 \ttt{whizard --help} in order to check this.
 
 \subsection{Installation in User Space}
 You may lack administrator privileges on your system.  In that case,
 you can still install and run \whizard.  Make sure that all
 prerequisites are met (Sec.~\ref{sec:prerequisites}).
 \begin{enumerate}
 \item
   Create a fresh directory for the \whizard\ build.  It is recommended
   to keep this separate from the source directory.
 \item
   Reserve a directory in user space for the \whizard\ installation.
   It should be empty, or yet non-existent.
 \item
   Go to that directory and execute
   \begin{interaction}
     your-build-directory> your-src-directory/configure
                                --prefix=your-install-directory
   \end{interaction}
   This will analyze your system and prepare the compilation of \whizard\
   in the build directory.  Make sure to set the proper additional options to
   \ttt{configure}, see Sec.~\ref{sec:configure-options} below.
 \item
   Call \ttt{make} to compile and link \whizard:
   \begin{interaction}
     your-build-directory> make
   \end{interaction}
 \item
   If you want to make sure that everything works, run
   \begin{interaction}
     your-build-directory> make check
   \end{interaction}
   This will take some more time.
 \item
   Install:
   \begin{interaction}
     your-build-directory> make install
   \end{interaction}
 \end{enumerate}
 \whizard\ should now be installed in the installation directory of your
 choice.  If the installation is not in your standard search paths, you
 have to account for this by extending the paths appropriately, see
 Sec.~\ref{sec:workspace}.
 
 
 \subsection{Configure Options}
 \label{sec:configure-options}
 
 The configure script accepts environment variables and flags.  They
 can be given as arguments to the \ttt{configure} program in arbitrary
 order.  You may run \ttt{configure --help} for a listing; only the
 last part of this long listing is specific for the \whizard\ system.
 Here is an example:
 \begin{interaction}
   configure  FC=gfortran-4.8  FCFLAGS="-g -O3"  --enable-fc-openmp
 \end{interaction}
 
 The most important options are
 \begin{itemize}
 \item
   \ttt{FC} (variable): The \fortran\ compiler.  This is necessary if
   you need a compiler different from the standard compiler on the
   system, e.g., if the latter is too old.
 \item
   \ttt{FCFLAGS} (variable): The flags to be given to the Fortran
   compiler.  The main use is to control the level of optimization.
 \item
   \ttt{--prefix=\var{directory-name}}: Specify a non-default directory
   for installation.
 \item
   \ttt{--enable-fc-openmp}: Enable parallel executing via OpenMP on a
   multi-processor/multi-core machine.  This works only if OpenMP is
   supported by the compiler (e.g., \ttt{gfortran}).  When running
   \whizard, the number of processors that are actually requested can
   be controlled by the user.  Without this option, \whizard\ will run
   in serial mode on a single core.  See Sec.~\ref{sec:openmp} for
   further details.
 \item
   \ttt{--enable-fc-mpi}: Enable parallel executing via MPI on a single
   machine using several cores or several machines. This works only if a MPI
   library is installed (e.g. \ttt{OpenMPI}) and \ttt{FC=mpifort CC=mpicc CXX=mpic++} is
   set. Without this option, \whizard\ will run in serial mode on a single core.
   The flag can be combined with \ttt{--enable-fc-openmp}. See Sec.~\ref{sec:mpi}
   for further details.
 \item
   \ttt{LHADPF\_DIR} (variable): The location of the optional \lhapdf\
   package, if non-default.
 \item
   \ttt{LOOPTOOLS\_DIR} (variable): The location of the optional \ttt{LOOPTOOLS}
   package, if non-default.
 \item
   \ttt{OPENLOOPS\_DIR} (variable): The location of the optional \openloops\
   package, if non-default.
 \item
   \ttt{GOSAM\_DIR} (variable): The location of the optional \gosam\
   package, if non-default.
 \item
   \ttt{HOPPET\_DIR} (variable): The location of the optional \hoppet\
   package, if non-default.
 \item
   \ttt{HEPMC\_DIR} (variable): The location of the optional \hepmc\ package, if
   non-default.
 \item
   \ttt{LCIO}/\ttt{LCIO\_DIR} (variable): The location of the optional
   \lcio\ package, if non-default.
 \end{itemize}
 
 Other flags that might help to work around possible problems are the
 flags for the $C$ and $C++$ compilers as well as the \ttt{Fortran77}
 compiler, or the linker flags and additional libraries for the linking
 process.
 \begin{itemize}
 \item
   \ttt{CC} (variable): \ttt{C} compiler command
 \item
   \ttt{F77} (variable): \ttt{Fortran77} compiler command
 \item
   \ttt{CXX} (variable): \ttt{C++} compiler command
 \item
   \ttt{CPP} (variable): \ttt{C} preprocessor
 \item
   \ttt{CXXCPP} (variable): \ttt{C++} preprocessor
 \item
   \ttt{CFLAGS} (variable): \ttt{C} compiler flags
 \item
   \ttt{FFLAGS} (variable): \ttt{Fortran77} compiler flags
 \item
   \ttt{CXXFLAGS} (variable): \ttt{C++} compiler flags
 \item
   \ttt{LIBS} (variable): libraries to be passed to the linker as
   \ttt{-l{\em library}}
 \item
   \ttt{LDFLAGS} (variable): non-standard linker flags
 \end{itemize}
 
 For other options (like e.g. \ttt{--with-precision=...} etc.) please
 see the \ttt{configure --help} option.
 
 %%%%%
 
 \subsection{Details on the Configure Process}
 
 The configure process checks for the build and host system type; only
 if this is not detected automatically, the user would have to specify
 this by himself. After that system-dependent files are searched for,
 LaTeX and Acroread for documentation and plots, the \fortran\ compiler
 is checked, and finally the \ocaml\ compiler. The next step is the
 checks for external programs like \lhapdf\ and \ttt{HepMC}.
 Finally, all the Makefiles are being built.
 
 The compilation is done by invoking \ttt{make} and finally
 \ttt{make install}. You could also do a \ttt{make check} in
 order to test whether the compilation has produced sane files on your
 system. This is highly recommended.
 
 Be aware that there be problems for the installation if the install
 path or a user's home directory is part of an AFS file system. Several
 times problems were encountered connected with conflicts with
 permissions inside the OS permission environment variables and the AFS
 permission flags which triggered errors during the \ttt{make install}
 procedure. Also please avoid using \ttt{make -j} options of parallel
 execution of \ttt{Makefile} directives as AFS filesystems might not be
 fast enough to cope with this.
 
 For specific problems that might have been encountered in rare
 circumstances for some FORTRAN compilers confer the webpage
 \url{https://projects.hepforge.org/whizard/compilers.html}.
 
 Note that the \pythia\  bundle for showering and hadronization (and
 some other external legacy code pieces) do still contain good old
 \ttt{Fortran77} code. These parts should better be
 compiled with the very same \ttt{Fortran2003} compiler as the
 \whizard\ core. There is, however, one subtlety:
 when the \ttt{configure} flag \ttt{FC} gets a full system path as
 argument, \ttt{libtool} is not able to recognize this as a valid (GNU)
 \ttt{Fortran77} compiler. It then searches automatically for binaries
 like \ttt{f77}, \ttt{g77} etc. or a standard system compiler. This
 might result in a compilation failure of the \ttt{Fortran77} code. A
 viable solution is to define an executable link and use this (not the
 full path!) as \ttt{FC} flag.
 
 It is possible to compile \whizard\ without the \ocaml\ parts of
 \oMega, namely by using the \ttt{--disable-omega} option of the
 configure. This will result in a built of \whizard\ with the \oMega\
 Fortran library, but without the binaries for the matrix element
 generation. All selftests (cf. \ref{sec:selftests}) requiring \oMega\
 matrix elements are thereby switched off. Note that you can install
 such a built (e.g. on a batch system without \ocaml\ installation), but
 the try to build a distribution (all \ttt{make distxxx} targets) will fail.
 
 
 %%%%%%%%%%%
 
 
 \subsection{\whizard\ self tests/checks}
 \label{sec:selftests}
 
 \whizard\ has a number of self-consistency checks and tests which assure
 that most of its features are running in the intended way. The
 standard procedure to invoke these self tests is to perform a
 \ttt{make check} from the \ttt{build} directory. If \ttt{src}
 and \ttt{build} directories are the same, all relevant files for
 these self-tests reside in the \ttt{tests} subdirectory of the main
 \whizard\ directory. In that case, one could in principle just call the
 scripts individually from the command line. Note, that if \ttt{src}
 and \ttt{build} directory are different as recommended, then the
 input files will have been installed in
 \ttt{prefix/share/whizard/test}, while the corresponding test shell
 scripts remain in the \ttt{srcdir/test} directory. As the main shell
 script \ttt{run\_whizard.sh} has been built in the \ttt{build}
 directory, one now has to copy the files over by and set the correct
 paths by hand, if one wishes to run the test scripts individually.
 \ttt{make check} still correctly performs all \whizard\
 self-consistency tests. The tests itself fall into two categories,
 unit self test that individually test the modular structure of
 \whizard, and tests that are run by \sindarin\ files. In future releases
 of \whizard, these two categories of tests will be better separated
 than in the 2.2.1 release.
 
 There are additional, quite extensiv numerical tests for validation
 and backwards compatibility checks for SM and MSSM processes. As a
 standard, these extended self tests are not invoked. However, they can
 be enabled by executing the corresponding specific \ttt{make check}
 operations in the subdirectories for these extensive tests.
 
 As the new \whizard\ testsuite does very thorough and scrupulous tests
 of the whole \whizard\ structure, it is always possible that some
 tests are failing due to some weird circumstances or because of
 numerical fluctuations. In such a case do not panic, contact the
 developers (\ttt{whizard@desy.de}) and provide them with the logfiles
 of the failing test as well as the setup of your configuration.
 
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \clearpage
 
 \chapter{Working with \whizard}
 \label{chap:start}
 
 \whizard\ can run as a stand-alone program.  You (the user) can steer
 \whizard\ either interactively or by a script file.  We will first
 describe the latter method, since it will be the most common way to
 interact with the \whizard\ system.
 
 \section{Hello World}
 
 The legacy version series 1 of the program relied on a bunch of input
 files that the user had to provide in some obfuscated format.  This
 approach is sufficient for straightforward applications.  However, once
 you get experienced with a program, you start thinking about uses that
 the program's authors did not foresee.  In case of a Monte Carlo
 package, typical abuses are parameter scans, complex patterns of cuts
 and reweighting factors, or data analysis without recourse to external
 packages.  This requires more flexibility.
 
 Instead of transferring control over data input to some generic
 scripting language like PERL or PYTHON (or even C++), which come with
 their own peculiarities and learning curves, we decided to unify data
 input and scripting in a dedicated steering language that is
 particularly adapted to the needs of Monte-Carlo integration,
 simulation, and simple analysis of the results.  Thus we discovered
 what everybody knew anyway: that W(h)izards communicate in \sindarin,
 Scripting INtegration, Data Analysis, Results display and INterfaces.
 
 \sindarin\ is a DSL -- a domain-specific scripting language -- that is
 designed for the single purpose of steering and talking to \whizard.
 Now since \sindarin\ is a programming language, we honor the old
 tradition of starting with the famous Hello World program.  In
 \sindarin\ this reads simply
 \begin{quote}
 \begin{verbatim}
 printf "Hello World!"
 \end{verbatim}
 \end{quote}
 Open your favorite editor, type this text, and save it into a file
 named \verb|hello.sin|.
 
 \begin{figure}
   \centering
 \begin{scriptsize}
 \begin{Verbatim}[frame=single]
     | Writing log to 'whizard.log'
     |=============================================================================|
     |                                                                             |
     |    WW             WW  WW   WW  WW  WWWWWW      WW      WWWWW    WWWW        |
     |     WW    WW     WW   WW   WW  WW     WW      WWWW     WW  WW   WW  WW      |
     |      WW  WW WW  WW    WWWWWWW  WW    WW      WW  WW    WWWWW    WW   WW     |
     |       WWWW   WWWW     WW   WW  WW   WW      WWWWWWWW   WW  WW   WW  WW      |
     |        WW     WW      WW   WW  WW  WWWWWW  WW      WW  WW   WW  WWWW        |
     |                                                                             |
     |                                                                             |
     |                                        W                                    |
     |                                       sW                                    |
     |                                       WW                                    |
     |                                      sWW                                    |
     |                                      WWW                                    |
     |                                     wWWW                                    |
     |                                    wWWWW                                    |
     |                                    WW WW                                    |
     |                                    WW WW                                    |
     |                                   wWW WW                                    |
     |                                  wWW  WW                                    |
     |                                  WW   WW                                    |
     |                                  WW   WW                                    |
     |                                 WW    WW                                    |
     |                                 WW    WW                                    |
     |                                WW     WW                                    |
     |                                WW     WW                                    |
     |           wwwwww              WW      WW                                    |
     |              WWWWWww          WW      WW                                    |
     |                 WWWWWwwwww   WW       WW                                    |
     |                     wWWWwwwwwWW       WW                                    |
     |                 wWWWWWWWWWWwWWW       WW                                    |
     |                wWWWWW       wW        WWWWWWW                               |
     |                  WWWW       wW        WW  wWWWWWWWwww                       |
     |                   WWWW                      wWWWWWWWwwww                    |
     |                     WWWW                      WWWW     WWw                  |
     |                       WWWWww                   WWWW                         |
     |                           WWWwwww              WWWW                         |
     |                               wWWWWwww       wWWWWW                         |
     |                                     WwwwwwwwwWWW                            |
     |                                                                             |
     |                                                                             |
     |                                                                             |
     |  by:   Wolfgang Kilian, Thorsten Ohl, Juergen Reuter                        |
     |        with contributions from Christian Speckner                           |
     |        Contact: <whizard@desy.de>                                           |
     |                                                                             |
     |  if you use WHIZARD please cite:                                            |
     |        W. Kilian, T. Ohl, J. Reuter,  Eur.Phys.J.C71 (2011) 1742            |
     |                                          [arXiv: 0708.4233 [hep-ph]]        |
     |        M. Moretti, T. Ohl, J. Reuter, arXiv: hep-ph/0102195                 |
     |                                                                             |
     |=============================================================================|
     |                               WHIZARD 2.6.5
     |=============================================================================|
     | Reading model file '/usr/local/share/whizard/models/SM.mdl'
     | Preloaded model: SM
     | Process library 'default_lib': initialized
     | Preloaded library: default_lib
     | Reading commands from file 'hello.sin'
     Hello World!
     | WHIZARD run finished.
     |=============================================================================|
 \end{Verbatim}
 \end{scriptsize}
   \caption{Output of the \ttt{"Hello world!"} \sindarin\ script.\label{fig:helloworld}}
 \end{figure}
 
 Now we assume that you -- or your kind system administrator -- has
 installed \whizard\ in your executable path.  Then you should open a
 command shell and execute (we will come to the meaning of the
 \verb|-r| option later.)
 \begin{verbatim}
 /home/user$ whizard -r hello.sin
 \end{verbatim}
 and if everything works well, you get the output (the complete output
 including the \whizard\ banner is shown in Fig.~\ref{fig:helloworld})
 \begin{footnotesize}
 \begin{verbatim}
 | Writing log to 'whizard.log'
 \end{verbatim}
 \centerline{[... here a banner is displayed]}
 \begin{Verbatim}
 |=============================================================================|
 |                               WHIZARD 2.6.5
 |=============================================================================|
 | Reading model file '/usr/local/share/whizard/models/SM.mdl'
 | Preloaded model: SM
 ! Process library 'default_lib': initialized
 ! Preloaded library: default_lib
 | Reading commands from file 'hello.sin'
 Hello World!
 | WHIZARD run finished.
 |=============================================================================|
 \end{Verbatim}
 \end{footnotesize}
 If this has just worked for you, you can be confident that you have a working
 \whizard\ installation, and you have been able to successfully run the
 program.
 
 \section{A Simple Calculation}
 You may object that \whizard\ is not exactly designed for printing out
 plain text.  So let us demonstrate a more useful example.
 
 Looking at the Hello World output, we first observe that the program
 writes a log file named (by default) \verb|whizard.log|.  This file
 receives all screen output, except for the output of external programs
 that are called by \whizard.  You don't have to cache \whizard's screen
 output yourself.
 
 After the welcome banner, \whizard\ tells you that it reads a physics
 \emph{model}, and that it initializes and preloads a \emph{process library}.  The
 process library is initially empty.  It is ready for receiving
 definitions of elementary high-energy physics processes (scattering or
 decay) that you provide.  The processes are set in the context of a
 definite model of high-energy physics.  By default this is the
 Standard Model, dubbed \verb|SM|.
 
 Here is the \sindarin\ code for defining a SM physics process, computing
 its cross section, and generating a simulated event sample in Les Houches
 event format:
 \begin{quote}
 \begin{Verbatim}
 process ee = e1, E1 => e2, E2
 sqrts = 360 GeV
 n_events = 10
 sample_format = lhef
 simulate (ee)
 \end{Verbatim}
 \end{quote}
 As before, you save this text in a file (named, e.g.,
 \verb|ee.sin|) which is run by
 \begin{verbatim}
 /home/user$ whizard -r ee.sin
 \end{verbatim}
 (We will come to the meaning of the \verb|-r| option later.)
 This produces a lot of output which looks similar to this:
 
  \begin{footnotesize}
  \begin{verbatim}
  | Writing log to 'whizard.log'
 [... banner ...]
  |=============================================================================|
  |                               WHIZARD 2.6.5
  |=============================================================================|
  | Reading model file '/usr/local/share/whizard/models/SM.mdl'
  | Preloaded model: SM
  | Process library 'default_lib': initialized
  | Preloaded library: default_lib
  | Reading commands from file 'ee.sin'
  | Process library 'default_lib': recorded process 'ee'
  sqrts =  3.600000000000E+02
  n_events = 10
  \end{verbatim}
 
  \begin{verbatim}
  | Starting simulation for process 'ee'
  | Simulate: process 'ee' needs integration
  | Integrate: current process library needs compilation
  | Process library 'default_lib': compiling ...
  | Process library 'default_lib': writing makefile
  | Process library 'default_lib': removing old files
  rm -f default_lib.la
  rm -f default_lib.lo default_lib_driver.mod opr_ee_i1.mod ee_i1.lo
  rm -f ee_i1.f90
  | Process library 'default_lib': writing driver
  | Process library 'default_lib': creating source code
  rm -f ee_i1.f90
  rm -f opr_ee_i1.mod
  rm -f ee_i1.lo
  /usr/local/bin/omega_SM.opt -o ee_i1.f90 -target:whizard
   -target:parameter_module parameters_SM -target:module opr_ee_i1
   -target:md5sum '70DB728462039A6DC1564328E2F3C3A5' -fusion:progress
   -scatter 'e- e+ -> mu- mu+'
  [1/1] e- e+ -> mu- mu+ ... allowed. [time: 0.00 secs, total: 0.00 secs, remaining: 0.00 secs]
  all processes done. [total time: 0.00 secs]
  SUMMARY: 6 fusions, 2 propagators, 2 diagrams
  | Process library 'default_lib': compiling sources
 [.....]
  \end{verbatim}
 
 
  \begin{verbatim}
  | Process library 'default_lib': loading
  | Process library 'default_lib': ... success.
  | Integrate: compilation done
  | RNG: Initializing TAO random-number generator
  | RNG: Setting seed for random-number generator to 9616
  | Initializing integration for process ee:
  | ------------------------------------------------------------------------
  | Process [scattering]: 'ee'
  |   Library name  = 'default_lib'
  |   Process index = 1
  |   Process components:
  |     1: 'ee_i1':   e-, e+ => mu-, mu+ [omega]
  | ------------------------------------------------------------------------
  | Beam structure: [any particles]
  | Beam data (collision):
  |   e-  (mass = 5.1099700E-04 GeV)
  |   e+  (mass = 5.1099700E-04 GeV)
  |   sqrts = 3.600000000000E+02 GeV
  | Phase space: generating configuration ...
  | Phase space: ... success.
  | Phase space: writing configuration file 'ee_i1.phs'
  | Phase space: 2 channels, 2 dimensions
  | Phase space: found 2 channels, collected in 2 groves.
  | Phase space: Using 2 equivalences between channels.
  | Phase space: wood
  Warning: No cuts have been defined.
  \end{verbatim}
 
 
  \begin{verbatim}
  | Starting integration for process 'ee'
  | Integrate: iterations not specified, using default
  | Integrate: iterations = 3:1000:"gw", 3:10000:""
  | Integrator: 2 chains, 2 channels, 2 dimensions
  | Integrator: Using VAMP channel equivalences
  | Integrator: 1000 initial calls, 20 bins, stratified = T
  | Integrator: VAMP
  |=============================================================================|
  | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
  |=============================================================================|
     1        784  8.3282892E+02  1.68E+00    0.20    0.06*  39.99
     2        784  8.3118961E+02  1.23E+00    0.15    0.04*  76.34
     3        784  8.3278951E+02  1.36E+00    0.16    0.05   54.45
  |-----------------------------------------------------------------------------|
     3       2352  8.3211789E+02  8.01E-01    0.10    0.05   54.45    0.50   3
  |-----------------------------------------------------------------------------|
     4       9936  8.3331732E+02  1.22E-01    0.01    0.01*  54.51
     5       9936  8.3341072E+02  1.24E-01    0.01    0.01   54.52
     6       9936  8.3331151E+02  1.23E-01    0.01    0.01*  54.51
  |-----------------------------------------------------------------------------|
     6      29808  8.3334611E+02  7.10E-02    0.01    0.01   54.51    0.20   3
  |=============================================================================|
  \end{verbatim}
 
  \begin{verbatim}
 [.....]
 | Simulate: integration done
 | Simulate: using integration grids from file 'ee_m1.vg'
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 9617
 | Simulation: requested number of events = 10
 |             corr. to luminosity [fb-1] =   1.2000E-02
 | Events: writing to LHEF file 'ee.lhe'
 | Events: writing to raw file 'ee.evx'
 | Events: generating 10 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: closing LHEF file 'ee.lhe'
 | Events: closing raw file 'ee.evx'
 | There were no errors and    1 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
  \end{verbatim}
  \end{footnotesize}
 %$
 The final result is the desired event file, \ttt{ee.lhe}.
 
 Let us discuss the output quickly to walk you through the procedures
 of a \whizard\ run: after the logfile message and the banner, the
 reading of the physics model and the initialization of a process
 library, the recorded process with tag \ttt{'ee'} is recorded. Next,
 user-defined parameters like the center-of-mass energy and the number
 of demanded (unweighted) events are displayed. As a next step,
 \whizard\ is starting the simulation of the process with tag
 \ttt{'ee'}. It recognizes that there has not yet been an integration
 over phase space (done by an optional \ttt{integrate} command,
 cf. Sec.~\ref{sec:integrate}), and consequently starts the
 integration. It then acknowledges, that the process code for the
 process \ttt{'ee'} needs to be compiled first (done by an optional
 \ttt{compile} command, cf. Sec.~\ref{sec:compilation}). So, \whizard\
 compiles the process library, writes the makefile for its steering,
 and as a safeguard against garbage removes possibly existing
 files. Then, the source code for the library and its processes are
 generated: for the process code, the default method -- the matrix
 element generator \oMega\ is called (cf. Sec.~\ref{sec:omega_me}); and
 the sources are being compiled.
 
 The next steps are the loading of the process library, and \whizard\
 reports the completion of the integration. For the Monte-Carlo
 integration, a random number generator is initialized. Here, it is the
 default generator, TAO (for more details, cf. Sec.~\ref{sec:tao},
 while the random seed is set to a value initialized by the system
 clock, as no seed has been provided in the \sindarin\ input file.
 
 Now, the integration for the process \ttt{'ee'} is initialized, and
 information about the process (its name, the name of its process
 library, its index inside the library, and the process components out
 of which it consists, cf. Sec.~\ref{sec:processcomp}) are
 displayed. Then, the beam structure is shown, which in that case are
 symmetric partonic electron and positron beams with the center-of-mass
 energy provided by the user (360 GeV). The next step is the generation
 of the phase space, for which the default phase space method
 \ttt{wood} (for more details cf. Sec.~\ref{sec:wood}) is selected. The
 integration is performed, and the result with absolute and relative
 error, unweighting efficiency, accuracy, $\chi^2$ quality is shown.
 
 The final step is the event generation
 (cf. Chap.~\ref{chap:events}). The integration grids are now being
 used, again the random number generator is initialized. Finally, event
 generation of ten unweighted events starts (\whizard\ let us know to
 which integrated luminosity that would correspond), and events are
 written both in an internal (binary) event format as well as in the
 demanded LHE format. This concludes the \whizard\ run.
 
 After a more comprehensive introduction into the \sindarin\ steering
 language in the next chapter, Chap.~\ref{chap:sindarinintro}, we will
 discuss all the details of the different steps of this introductory
 example.
 
 
 \clearpage
 
 \section{WHIZARD in a Computing Environment}
 
 \subsection{Working on a Single Computer}
 \label{sec:workspace}
 
 After installation, \whizard\ is ready for use.  There is a slight
 complication if \whizard\ has been installed in a location that is not
 in your standard search paths.
 
 In that case, to successfully run \whizard, you may either
 \begin{itemize}
 \item
   manually add \ttt{your-install-directory/bin} to your execution PATH\\
   and \ttt{your-install-directory/lib} to your library search path
   (LD\_LIBRARY\_PATH), or
 \item
   whenever you start a project, execute
   \begin{interaction}
     your-workspace> . your-install-directory/bin/whizard-setup.sh
   \end{interaction}
   which will enable the paths in your current environment, or
 \item
   source \ttt{whizard-setup.sh} script in your shell startup file.
 \end{itemize}
 In either case, try to call \ttt{whizard --help} in order to check
 whether this is done correctly.
 
 For a new \whizard\ project, you should set up a new (empty)
 directory.  Depending on the complexity of your task, you may want to
 set up separate directories for each subproblem that you want to
 tackle, or even for each separate run.  The location of the
 directories is arbitrary.
 
 To run, \whizard\ needs only a single input file, a \sindarin\ command
 script with extension \ttt{.sin} (by convention).  Running
 \whizard\ is as simple as
 \begin{interaction}
   your-workspace> whizard your-input.sin
 \end{interaction}
 No other configuration files are needed.  The total number of
 auxiliary and output files generated in a single run may get quite
 large, however, and they may clutter your workspace.  This is the
 reason behind keeping subdirectories on a per-run basis.
 
 Basic usage of \whizard\ is explained in Chapter~\ref{chap:start}, for
 more details, consult the following chapters.  In
 Sec.~\ref{sec:cmdline-options} we give an account of the command-line
 options that \whizard\ accepts.
 
 \subsection{Working Parallel on Several Computers}
 \label{sec:mpi}
 
 For integration (only VAMP2), \whizard\ supports parallel execution via MPI
 by communicating between parallel tasks on a single machine or distributed over
 several machines.
 
 During integration the calculation of channels is distributed along several
 workers where a master worker collects the results and adapts weights and grids.
 In wortwhile cases (e.g. high number of calls in one channel), the calculation
 of a single grid is distributed.
 
 In order to use these advancements, \whizard\ requires an installed MPI-3.1 capable
 library (e.g. OpenMPI) and configuration and compilation with the appropriate flags,
 cf.~Sec.~\ref{sec:installation}.
 
 MPI support is only active when the integration method is set to VAMP2.
 Additionally, to preserve the numerical properties of a single task run, it is
 recommended to use the RNGstream as random number generator.
 \begin{code}
   $integration_method = 'vamp2'
   $rng_method = 'rng_stream'
 \end{code}
 
 \whizard\ has then to be called by mpirun
 \begin{footnotesize}
 \begin{Verbatim}[frame=single]
   your-workspace> mpirun -f hostfile -np 4 --output-filename mpi.log whizard your-input.sin
 \end{Verbatim}
 \end{footnotesize}
 where the number of parallel tasks can be set by \ttt{-np} and a hostfile can be
 given by \ttt{--hostfile}. It is recommended to use \ttt{--output-filename} which
 lets mpirun redirect the standard (error) output to a file, for each worker separatly.
 
 Some caveats exist regarding MPI which are mostly based on output operations.
 Following are known issues,
 \begin{itemize}
 \item runIDs are not supported,
 \item event generation must not be run with MPI.
 \end{itemize}
 The latter can be trivially parallelized by hand.
 
 \subsection{Stopping and Resuming WHIZARD Jobs}
 
 On a Unix-like system, it is possible to prematurely stop running jobs
 by a \ttt{kill(1)} command, or by entering \ttt{Ctrl-C} on the
 terminal.
 
 If the system supports this, \whizard\ traps these signals.  It also
 traps some signals that a batch operating system might issue, e.g.,
 for exceeding a predefined execution time limit.  \whizard\ tries to
 complete the calculation of the current event and gracefully close
 open files.  Then, the program terminates with a message and a nonzero
 return code.  Usually, this should not take more than a fraction of a
 second.
 
 If, for any reason, the program does not respond to an interrupt, it
 is always possible to kill it by \ttt{kill -9}.  A convenient method,
 on a terminal, would be to suspend it first by \ttt{Ctrl-Z} and then
 to kill the suspended process.
 
 The program is usually able to recover after being stopped.  Simply
 run the job again from start, with the same input, all output files
 generated so far left untouched.  The results obtained so far will be
 quickly recovered or gathered from files written in the previous run,
 and the actual time-consuming calculation is resumed near the point
 where it was interrupted.\footnote{This holds for simple workflow.  In
   case of scans and repeated integrations of the same process, there
   may be name clashes on the written files which prevent resuming.  A
   future \whizard\ version will address this problem.}  If the
 interruption happened during an integration step, it is resumed after
 the last complete iteration.  If it was during event generation, the
 previous events are taken from file and event generation is continued.
 
 The same mechanism allows for efficiently redoing a calculation with
 similar, somewhat modified input.  For instance, you might want to add
 a further observable to event analysis, or write the events in a
 different format.  The time for rerunning the program is determined
 just by the time it takes to read the existing integration or event
 files, and the additional calculation is done on the recovered
 information.
 
 By managing various checksums on its input and output files, \whizard\
 detects changes that affect further calculations, so it does a
 real recalculation only where it is actually needed.  This applies to
 all steps that are potentially time-consuming: matrix-element code
 generation, compilation, phase-space setup, integration, and event
 generation.  If desired, you can set command-line options or
 \sindarin\ parameters that explicitly discard previously generated
 information.
 
 
 \subsection{Files and Directories: default and customization}
 
 \whizard\ jobs take a small set of files as input.  In many cases, this is
 just a single \sindarin\ script provided by the user.
 When running, \whizard\ can produce a set of auxiliary and output files:
 \begin{enumerate}
 \item
   \textbf{Job.}
   Files pertaining to the \whizard\ job as a whole.  This is the default log
   file \ttt{whizard.log}.
 \item
   \textbf{Process compilation.}  Files that originate from generating and
   compiling process code.  If the default \oMega\ generator is used, these
   files include Fortran source code as well as compiled libraries that are
   dynamically linked to the running executable.  The file names are derived
   from either the process-library name or the individual process names, as
   defined in the \sindarin\ input.  The default library name is
   \ttt{default\_lib}.
 \item
   \textbf{Integration.}
   Files that are created by integration, i.e., when calculating the total cross
   section for a scattering process using the Monte-Carlo algorithm.  The file
   names are derived from the process name.
 \item
   \textbf{Simulation.}
   Files that are created during simulation, i.e., generating event samples for
   a process or a set of processes.  By default, the file names are derived
   from the name of the first process.  Event-file formats are distinguished
   by appropriate file name extensions.
 \item
   \textbf{Result Analysis.}
   Files that are created by the internal analysis tools and written by the
   command \ttt{write\_analysis} (or \ttt{compile\_analysis}).  The default
   base name is \ttt{whizard\_analysis}.
 \end{enumerate}
 
 A complex workflow with several processes, parameter sets, or runs, can easily
 lead to in file-name clashes or a messy working directory.  Furthermore,
 running a batch job on a dedicated computing environment often requires
 transferring data from a user directory to the server and back.
 
 Custom directory and file names can be used to organize things and facilitate
 dealing with the environment, along with the available batch-system tools for
 coordinating file transfer.
 \begin{enumerate}
 \item
   \textbf{Job.}
   \begin{itemize}
   \item
     The \ttt{-L} option on the command line defines a custom base name for
     the log file.
   \item
     The \ttt{-J} option on the command line defines a job ID.  For instance,
     this may be set to the job ID assigned by the batch system.  Within the
     \sindarin\ script, the job ID is available as the string variable
     \ttt{\$job\_id} and can be used for constructing custom job-specific file
     and directory names, as described below.
   \end{itemize}
 \item
   \textbf{Process compilation.}
   \begin{itemize}
   \item
     The user can require the program to put all files created during the
     compilation step including the library to be linked, in a subdirectory of
     the working directory.  To enable this, set the string variable
     \ttt{\$compile\_workspace} within the \sindarin\ script.
   \end{itemize}
 \item
   \textbf{Integration.}
   \begin{itemize}
   \item
     The value of the string variable \ttt{\$run\_id}, if set, is appended to
     the base name of all files created by integration, separated by dots.  If
     the \sindarin\ script scans over parameters, varying the run ID avoids
     repeatedly overwriting files with identical name during the scan.
   \item
     The user can require the program to put the important files created during
     the integration step -- the phase-space configuration file and the
     \vamp\ grid files -- in a subdirectory of the working directory.  To
     enable this, set the string variable \ttt{\$integrate\_workspace} within
     the \sindarin\ script.  (\ttt{\$compile\_workspace} and
     \ttt{\$integrate\_workspace} may be set to the same value.)
   \end{itemize}
   Log files produced during the integration step are put in the working
   directory.
 \item
   \textbf{Simulation.}
   \begin{itemize}
   \item
     The value of the string variable \ttt{\$run\_id}, if set, identifies
     the specific integration run that is used for the event sample.  It is
     also inserted into default event-sample file names.
   \item
     The variable \ttt{\$sample}, if set, defines an arbitrary base name for the
     files related to the event sample.
   \end{itemize}
   Files resulting from simulation are put in the working directory.
 \item
   \textbf{Result Analysis.}
   \begin{itemize}
   \item
     The variable \ttt{\$out\_file}, if set,
     defines an arbitrary base name for the analysis data and
     auxiliary files.
   \end{itemize}
   Files resulting from result analysis are put in the working directory.
 \end{enumerate}
 
 
 \subsection{Batch jobs on a different machine}
 
 It is possible to separate the tasks of process-code compilation, integration,
 and simulation, and execute them on different machines.  To make use of
 this feature, the local and remote machines including all
 installed libraries that are relevant for \whizard, must be
 binary-compatible.
 \begin{enumerate}
 \item
   Process-code compilation may be done once on a local machine, while the
   time-consuming tasks of integration and event generation for specific
   parameter sets are delegated to a remote machine, e.g., a batch cluster.  To
   enable this, prepare a \sindarin\ script that just produces process code
   (i.e., terminates with a \ttt{compile} command) for the local machine.  You
   may define \ttt{\$compile\_workspace} such that all generated code
   conveniently ends up in a single subdirectory.
 
   To start the batch job, transfer the workspace subdirectory to the remote
   machine
   and start \whizard\ there.  The \sindarin\ script on the remote machine must
   include the local script unchanged in all parts that are relevant for
   process definition.  The program will recognize the contents of the
   workspace, skip compilation and instead link the process library immediately.
   To proceed further, the script should define the run-specific parameters and
   contain the appropriate commands for integration and simulation.
 \item
   Analogously, you may execute both process-code compilation and integration
   locally, but generate event samples on a remote machine.  To this end,
   prepare a \sindarin\ script that produces process code and computes integrals
   (i.e., terminates with an \ttt{integrate} command) for the local machine.
   You may define \ttt{\$compile\_workspace} and \ttt{\$integrate\_workspace}
   (which may coincide) such that all generated code, phase-space and
   integration grid data conveniently end up in subdirectories.
 
   To start the batch job, transfer the workspace(s) to the remote machine and
   start \whizard\ there.  The \sindarin\ script on the remote machine must
   include the local script unchanged in all parts that are relevant for
   process definition and integration.  The program will recognize the contents
   of the workspace, skip compilation and integration and instead load the
   process library and integration results immediately.  To proceed further,
   the script should define the sample-specific parameters and contain the
   appropriate commands for simulation.
 \end{enumerate}
 
 To simplify transferring whole directories, \whizard\ supports the
 \ttt{--pack} and \ttt{--unpack} options.  You may specify any number of these
 options for a \whizard\ run.  (The feature relies on the GNU version of the
 \ttt{tar} utility.)
 
 For instance,
 \begin{code}
 whizard script1.sin --pack my_ws
 \end{code}
 runs \whizard\ with the \sindarin\ script \ttt{script1.sin} as input, where
 within the script you have defined
 \begin{code}
 $compile_workspace = "my_ws"
 \end{code}
 as the target directory for process-compilation files.  After completion, the
 program will tar and gzip the target directory as \ttt{my\_ws.tgz}.  You
 should copy this file to the remote machine as one of the job's input files.
 
 On the remote machine, you can then run the program with
 \begin{code}
 whizard script2.sin --unpack my_ws.tgz
 \end{code}
 where \ttt{script2.sin} should include \ttt{script1.sin}, and add integration
 or simulation commands.  The contents of \ttt{ws.tgz} will thus be unpacked
 and reused on the remote machine, instead of generating new process code.
 
 
 
 \subsection{Static Linkage}
 
 In its default running mode, \whizard\ compiles process-specific matrix
 element code on the fly and dynamically links the resulting library.  On the
 computing server, this requires availability of the appropriate Fortran
 compiler, as well as the \ocaml\ compiler suite, and the dynamical linking
 feature.
 
 Since this may be unavailable or undesired, there is a possibility to
 distribute \whizard\ as a statically linked executable that contains a
 pre-compiled library of processes.  This removes the need for the Fortran
 compiler, the \ocaml\ system, and extra dynamic linking.  Any external
 libraries that are accessed (the \fortran\ runtime environment, and possibly
 some dynamically linked external libraries and/or the C++ runtime library,
 must still be available on the target system, binary-compatible.  Otherwise,
 there is no need for transferring the complete \whizard\ installation or
 process-code compilation data.
 
 Generating, compiling and linking matrix element code is done in advance on a
 machine that can access the required tools and produces compatible libraries.
 This procedure is accomplished by \sindarin\ commands, explained below in
 Sec.~\ref{sec:static}.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \newpage
 
 \section{Troubleshooting}
 \label{sec:troubleshooting}
 
 In this section, we list known issues or problems and give advice on
 what can be done in case something does not work as intended.
 
 \subsection{Possible (uncommon) build problems}
 \label{sec:buildproblems}
 
 \subsubsection{\ocaml\ versions and \oMega\ builds}
 
 For the matrix element generator \oMega\ of \whizard\, the functional
 programming language \ocaml\ is used. Unfortunately, the versions of
 the \ocaml\ compiler from 3.12.0 on broke backwards
 compatibility. Therefore,  versions of \oMega/\whizard\ up to v2.0.2
 only compile with older versions (3.04 to 3.11 works). This has been
 fixed in all \whizard\ versions from 2.0.3 on.
 
 \subsubsection{Identical Build and Source directories}
 
 There is a problem that only occurred with version 2.0.0 and has been
 corected for all follow-up versions. It can only appear if you
 compile the \whizard\ sources in the source directory. Then an error
 like this may occur:
 \begin{footnotesize}
 \begin{Verbatim}[frame=single]
 ...
 libtool: compile:  gfortran -I../misc -I../vamp -g -O2 -c processes.f90 -fPIC -o
           .libs/processes.o
 libtool: compile:  gfortran -I../misc -I../vamp -g -O2 -c processes.f90 -o
           processes.o >/dev/null 2>&1
 make[2]: *** No rule to make target `limits.lo', needed by `decays.lo'.  Stop.
 ...
 make: *** [all-recursive] Error 1
 \end{Verbatim}
 \end{footnotesize}
 In this case, please unpack a fresh copy of \whizard\ and configure it
 in a separate directory (not necessarily a subdirectory). Then the
 compilation will go through:
 \begin{footnotesize}
 \begin{Verbatim}[frame=single]
 $ zcat whizard-2.0.0.tar.gz | tar xf -
 $ cd whizard-2.0.0
 $ mkdir _build
 $ cd _build
 $ ../configure FC=gfortran
 $ make
 \end{Verbatim}
 \end{footnotesize}
 The developers use this setup to be able to test different
 compilers. Therefore building in the same directory is not as
 thoroughly tested. This behavior has been patched from version 2.0.1
 on. But note that in general it is always adviced to keep
 build and source directory apart from each other.
 
 %%%%%
 
 \subsection{What happens if \whizard\ throws an error?}
 \label{ref:errors}
 
 \subsubsection{Particle name special characters in process
   declarations}
 
 Trying to use a process declaration like
 \begin{code}
 process foo = e-, e+ => mu-, mu+
 \end{code}
 will lead to a \sindarin\ syntax error:
 \begin{Code}
 process foo = e-, e+ => mu-, mu+
                ^^
 | Expected syntax: SEQUENCE    <cmd_process> = process <process_id> '=' <process_p
 | Found token: KEYWORD:    '-'
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR:  Syntax error (at or before the location indicated above)
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 \whizard\ tries to interpret the minus and plus signs as operators
 (\ttt{KEYWORD: '-'}), so you have to quote the particle names:
 \ttt{process foo = "e-", "e+" => "mu-", "mu+"}.
 
 
 \subsubsection{Missing collider energy}
 
 This happens if you forgot to set the collider energy in the
 integration of a scattering process:
 \begin{Code}
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR:  Colliding beams: sqrts is zero (please set sqrts)
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 This will solve your problem:
 \begin{code}
 sqrts = <your_energy>
 \end{code}
 
 \subsubsection{Missing process declaration}
 
 If you try to integrate or simulate a process that has not declared
 before (and is also not available in a library that might be loaded),
 \whizard\ will complain:
 \begin{Code}
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR: Process library doesn't contain process 'f00'
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 Note that this could sometimes be a simple typo, e.g. in that case an
 \ttt{integrate (f00)} instead of \ttt{integrate (foo)}
 
 \subsubsection{Ambiguous initial state without beam declaration}
 
 When the user declares a process with a flavor sum in the initial
 state, e.g.
 \begin{code}
 process qqaa = u:d, U:D => A, A
 sqrts = <your_energy>
 integrate (qqaa)
 \end{code}
 then a fatal error will be issued:
 \begin{Code}
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR: Setting up process 'qqaa':
 ***                 --------------------------------------------
 ***              Inconsistent initial state. This happens if either
 ***              several processes with non-matching initial states
 ***              have been added, or for a single process with an
 ***              initial state flavor sum. In that case, please set beams
 ***              explicitly [singling out a flavor / structure function.]
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 What now? Either a structure function providing a tensor structure in
 flavors has to be provided like
 \begin{code}
 beams = p, pbar => pdf_builtin
 \end{code}
 or, if the partonic process was intended, a specific flavor has to be
 singled out,
 \begin{code}
 beams = u, U
 \end{code}
 which would take only the up-quarks. Note that a sum over process
 components with varying initial states is not possible.
 
 \subsubsection{Invalid or unsupported beam structure}
 
 An error message like
 \begin{Code}
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR: Beam structure: [.......] not supported
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 This happens if you try to use a beam structure with is either not
 supported by \whizard\ (meaning that there is no phase-space
 parameterization for Monte-Carlo integration available in order to
 allow an efficient sampling), or you have chosen a combination of beam
 structure functions that do not make sense physically. Here is an
 example for the latter (lepton collider ISR applied to protons, then
 proton PDFs):
 \begin{code}
 beams = p, p => isr => pdf_builtin
 \end{code}
 
 \subsubsection{Mismatch in beams}
 
 Sometimes you get a rather long error output statement followed by a
 fatal error:
 \begin{Code}
  Evaluator product
  First interaction
  Interaction: 6
  Virtual:
  Particle 1
   [momentum undefined]
 [.......]
  State matrix:  norm =  1.000000000000E+00
  [f(2212)]
    [f(11)]
      [f(92) c(1 )]
        [f(-6) c(-1 )] => ME(1) = ( 0.000000000000E+00, 0.000000000000E+00)
 [.......]
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR: Product of density matrices is empty
 ***                 --------------------------------------------
 ***              This happens when two density matrices are convoluted
 ***              but the processes they belong to (e.g., production
 ***              and decay) do not match. This could happen if the
 ***              beam specification does not match the hard
 ***              process. Or it may indicate a WHIZARD bug.
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 As \whizard\ indicates, this could have happened because the hard
 process setup did not match the specification of the beams as in:
 \begin{code}
 process neutral_current_DIS = e1, u => e1, u
 beams_momentum = 27.5 GeV, 920 GeV
 beams = p, e => pdf_builtin, none
 integrate (neutral_current_DIS)
 \end{code}
 In that case, the order of the beam particles simply was wrong,
 exchange proton and electron (together with the structure functions)
 into \ttt{beams = e, p => none, pdf\_builtin}, and \whizard\ will be
 happy.
 
 \subsubsection{Unstable heavy beam particles}
 
 If you try to use unstable particles as beams that can potentially
 decay into the final state particles, you might encounter the
 following error message:
 \begin{Code}
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR:  Phase space: Initial beam particle can decay
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 This happens basically only for  processes in testing/validation (like
 $t \bar t \to b \bar b$). In principle, it could also happen in a real
 physics setup, e.g. when simulating electron pairs at a muon collider:
 \begin{code}
 process mmee = "mu-", "mu+" => "e-", "e+"
 \end{code}
 However, \whizard\ at the moment does not allow a muon width, and so
 \whizard\ is not able to decay a muon in a scattering process.
 A possibile decay of the beam particle into (part of) the final state
 might lead to instabilities in the phase space setup. Hence, \whizard\
 do not let you perform such an integration right away. When you
 nevertheless encounter such a rare occasion in your setup, there is a
 possibility to convert this fatal error into a simple warning by
 setting the flag:
 \begin{code}
 ?fatal_beam_decay = false
 \end{code}
 
 \subsubsection{Impossible beam polarization}
 
 If you specify a beam polarization that cannot correspond to any
 physically allowed spin density matrix, e.g.,
 \begin{code}
 beams = e1, E1
 beams_pol_density = @(-1), @(1:1:.5, -1, 1:-1)
 \end{code}
 \whizard\ will throw a fatal
 error like this:
 \begin{Code}
  Trace of matrix square =    1.4444444444444444
  Polarization: spin density matrix
    spin type     = 2
    multiplicity  = 2
    massive       = F
    chirality     = 0
    pol.degree    = 1.0000000
    pure state    = F
    @(+1: +1: ( 3.333333333333E-01, 0.000000000000E+00))
    @(-1: -1: ( 6.666666666667E-01, 0.000000000000E+00))
    @(-1: +1: ( 6.666666666667E-01, 0.000000000000E+00))
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR: Spin density matrix: not permissible as density matrix
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 
 \subsubsection{Beams with crossing angle}
 
 Specifying a crossing angle (e.g. at a linear lepton collider) without
 explicitly setting the beam momenta,
 \begin{code}
   sqrts = 1 TeV
   beams = e1, E1
   beams\_theta = 0, 10 degree
 \end{code}
 triggers a fatal:
 \begin{Code}
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR: Beam structure: angle theta/phi specified but momentum/a p undefined
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 In that case the single beam momenta have to be explicitly set:
 \begin{code}
   beams = e1, E1
   beams\_momentum = 500 GeV, 500 GeV
   beams\_theta = 0, 10 degree
 \end{code}
 
 \subsubsection{Phase-space generation failed}
 
 Sometimes an error might be issued that \whizard\ could not generate a
 valid phase-space parameterization:
 \begin{Code}
 | Phase space: ... failed.  Increasing phs_off_shell ...
 | Phase space: ... failed.  Increasing phs_off_shell ...
 | Phase space: ... failed.  Increasing phs_off_shell ...
 | Phase space: ... failed.  Increasing phs_off_shell ...
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR: Phase-space: generation failed
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 You see that \whizard\ tried to increase the number of off-shell lines
 that are taken into account for the phase-space setup. The second most
 important parameter for the phase-space setup, \ttt{phs\_t\_channel},
 however, is not increased automatically. Its default value is $6$, so
 e.g. for the process $e^+ e^- \to 8\gamma$ you will run into the
 problem above. Setting
 \begin{code}
 phs_off_shell = <n>-1
 \end{code}
 where \ttt{<n>} is the number of final-state particles will solve the problem.
 
 \subsubsection{Non-converging process integration}
 
 There could be several reasons for this to happen. The most prominent
 one is that no cuts have been specified for the process (\whizard\ttt{2}
 does not apply default cuts), and there are singular regions in the
 phase space over which the integration stumbles. If cuts have been
 specified, it could be that they are not sufficient. E.g. in $pp \to
 jj$ a distance cut between the two jets prevents singular collinear
 splitting in their generation, but if no $p_T$ cut have been set,
 there is still singular collinear splitting from the beams.
 
 \subsubsection{Why is there no event file?}
 
 If no event file has been generated, \whizard\ stumled over some error
 and should have told you, or, you simply forgot to set a \ttt{simulate}
 command for your process. In case there was a \ttt{simulate} command
 but the process under consideration is not possible (e.g. a typo,
 \ttt{e1, E1 => e2, E3} instead of \ttt{e1, E1 => e3, E3}), then you
 get an error like that:
 \begin{Code}
 ******************************************************************************
 *** ERROR: Simulate: no process has a valid matrix element.
 ******************************************************************************
 \end{Code}
 
 \subsubsection{Why is the event file empty?}
 
 In order to get events, you need to set either a desired number of
 events:
 \begin{code}
 n_events = <integer>
 \end{code}
 or you have to specify a certain integrated luminosity (the default
 unit being inverse femtobarn:
 \begin{code}
 luminosity = <real> / 1 fbarn
 \end{code}
 In case you set both, \whizard\ will take the one that leads to the
 higher number of events.
 
 \subsubsection{Parton showering fails}
 
 For BSM models containing massive stable or long-lived particles
 parton showering with \pythiasix\ fails:
 \begin{Code}
      Advisory warning type 3 given after        0 PYEXEC calls:
      (PYRESD:) Failed to decay particle  1000022 with mass   15.000
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR: Simulation: failed to generate valid event after 10000 tries
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 The solution to that problem is discussed in Sec.~\ref{sec:pythia6}.
 
 \vspace{1cm}
 
 
 %%%%%
 
 \subsection{Debugging, testing, and validation}
 
 
 \subsubsection{Catching/tracking arithmetic exceptions}
 
 Catching arithmetic exceptions is not automatically supported by
 \fortran\ compilers. In general, flags that cause the compiler to keep
 track of arithmetic exceptions are diminishing the maximally possible
 performance, and hence they should not be used in production
 runs. Hence, we refrained from making these flags a default.
 They can be added using the \ttt{FCFLAGS = {\em <flags>}} settings during
 configuration. For the \ttt{NAG} \fortran\ compiler we use the flags
 \ttt{-C=all -nan -gline} for debugging purposes. For the \ttt{gfortran}
 compilers, the flags \ttt{-ffpe-trap=invalid,zero,overflow} are the
 corresponding debugging flags. For tests, debugging or first sanity
 checks on your setup, you might want to make use of these flags in
 order to track possible numerical exceptions in the produced code.
 Some compilers started to include \ttt{IEEE} exception handling
 support (\ttt{Fortran 2008} status), but we do not use these
 implementations in the \whizard\ code (yet).
 
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{Steering WHIZARD: \sindarin\ Overview}
 \label{chap:sindarinintro}
 
 
 \section{The command language for WHIZARD}
 A conventional physics application program gets its data from a set of input
 files.  Alternatively, it is called as a library, so the user has to write his
 own code to interface it, or it combines these two approaches.  \whizard~1 was
 built in this way: there were some input files which were written by the user,
 and it could be called both stand-alone or as an external library.
 
 \whizard~2 is also a stand-alone program.  It comes with its own full-fledged
 script language, called \sindarin.  All interaction between the user and the
 program is done in \sindarin\ expressions, commands, and scripts.  Two main
 reasons led us to this choice:
 \begin{itemize}
 \item
   In any nontrivial physics study, cuts and (parton- or hadron-level) analysis
   are of central importance.  The task of specifying appropriate kinematics
   and particle selection for a given process is well defined, but it is
   impossible to cover all possiblities in a simple format like the cut files
   of \whizard~1.
 
   The usual way of dealing with this problem is to write analysis driver code
   (often in \ttt{C++}), using external libraries for Lorentz algebra etc.  However,
   the overhead of writing correct \ttt{C++} or \ttt{Fortran} greatly blows up problems
   that could be formulated in a few lines of text.
 \item
   While many problems lead to a repetitive workflow (process definition,
   integration, simulation), there are more involved tasks that involve
   parameter scans, comparisons of different processes, conditional execution,
   or writing output in widely different formats.  This is easily done by a
   steering script, which should be formulated in a complete language.
 \end{itemize}
 The \sindarin\ language is built specifically around event analysis, suitably
 extended to support steering, including data types, loops, conditionals, and
 I/O.
 
 It would have been possible to use an established general-purpose language for
 these tasks.  For instance, \ocaml\ which is a functional language would be a
 suitable candidate, and the matrix-element generator \oMega\ is written in that
 language.  Another candidate would be a popular scripting language such as
 PYTHON.
 
 We started to support interfaces for commonly used languages: prime
 examples for \ttt{C}, \ttt{C++}, and PYTHON are found in the
 \ttt{share/interfaces} subdirectory. However, introducing a
 special-purpose language has the three distinct
 advantages: First, it is compiled and executed by the very \ttt{Fortran} code that
 handles data and thus accesses it without interfaces.  Second, it can be
 designed with a syntax especially suited to the task of event handling and
 Monte-Carlo steering, and third, the user is not forced to learn all those
 features of a generic language that are of no relevance to the application he/she
 is interested in.
 
 
 \section{\sindarin\ scripts}
 
 A \sindarin\ script tells the \whizard\ program what it has to do.  Typically,
 the script is contained in a file which you (the user) create.  The file name
 is arbitrary; by convention, it has the extension `\verb|.sin|'.
 \whizard\ takes the file name as its argument on the command line and
 executes the contained script:
 \begin{verbatim}
 /home/user$ whizard script.sin
 \end{verbatim}
 Alternatively, you can call \whizard\ interactively and execute
 statements line by line; we describe this below in Sec.\ref{sec:whish}.
 
 A \sindarin\ script is a sequence of \emph{statements}, similar to the
 statements in any imperative language such as \ttt{Fortran} or
 \ttt{C}.  Examples of statements are commands like \ttt{integrate},
 variable declarations like \ttt{logical ?flag} or assigments like
 \ttt{mH = 130 GeV}.
 
 The script is free-form, i.e., indentation, extra whitespace and
 newlines are syntactically insignificant.  In contrast to most
 languages, there is no statement separator.  Statements simply follow each
 other, just separated by whitespace.
 \begin{code}
 statement1 statement2
 statement3
                statement4
 \end{code}
 Nevertheless, for clarity we recommend to
 write one statement per line where possible, and to use proper
 indentation for longer statements, nested and bracketed expressions.
 
 A command may consist of a \emph{keyword}, a list of \emph{arguments} in
 parantheses \ttt{(}\ldots\ttt{)}, and an \emph{option} script which
 itself is a sequence of statements.
 \begin{code}
 command
 command_with_args (arg1, arg2)
 command_with_option { option }
 command_with_options (arg) {
   option_statement1
   option_statement2
 }
 \end{code}
 As a rule, parentheses \ttt{()} enclose arguments and expressions, as
 you would expect.  Arguments enclosed in square brackets \ttt{[]} also
 exist.  They have a special meaning, they denote subevents
 (collections of momenta) in event analysis.  Braces \ttt{\{\}} enclose
 blocks of \sindarin\ code.  In particular, the option script
 associated with a command is a block of code that may contain local
 parameter settings, for instance.  Braces always indicate a scoping
 unit, so parameters will be restored their previous values when the
 execution of that command is completed.
 
 The script can contain comments.   Comments are initiated by either a \verb|#|
 or a \verb|!| character and extend to the end of the current line.
 \begin{code}
 statement
 # This is a comment
 statement  ! This is also a comment
 \end{code}
 
 
 %%%%%%%%%%%%%%%
 
 \section{Errors}
 \label{sec:errors}
 
 Before turning to proper \sindarin\ syntax, let us consider error messages.
 \sindarin\ distinguishes syntax errors and runtime errors.
 
 Syntax errors are recognized when the script is read and compiled,
 before any part is executed.  Look at this example:
 \begin{code}
 process foo = u, ubar => d, dbar
 md = 10
 integrade (foo)
 \end{code}
 \whizard\ will fail with the error message
 \begin{interaction}
 sqrts = 1 TeV
 integrade (foo)
           ^^
 | Expected syntax: SEQUENCE    <cmd_num> = <var_name> '=' <expr>
 | Found token: KEYWORD:    '('
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR:  Syntax error (at or before the location indicated above)
 ******************************************************************************
 ******************************************************************************
 WHIZARD run aborted.
 \end{interaction}
 which tells you that you have misspelled the command
 \verb|integrate|, so the compiler tried to interpret it as a variable.
 
 Runtime errors are categorized by their severity.  A warning is simply
 printed:
 \begin{interaction}
 Warning: No cuts have been defined.
 \end{interaction}
 This indicates a condition that is suspicious, but may actually be
 intended by the user.
 
 When an error is encountered, it is printed with more emphasis
 \begin{interaction}
 ******************************************************************************
 *** ERROR: Variable 'md' set without declaration
 ******************************************************************************
 \end{interaction}
 and the program tries to continue.  However, this usually indicates
 that there is something wrong.  (The $d$ quark is defined
 massless, so \verb|md| is not a model parameter.)  \whizard\ counts
 errors and warnings and tells you at the end
 \begin{interaction}
 | There were  1 error(s) and no warnings.
 \end{interaction}
 just in case you missed the message.
 
 Other errors are considered fatal, and execution stops at this point.
 \begin{interaction}
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR:  Colliding beams: sqrts is zero (please set sqrts)
 ******************************************************************************
 ******************************************************************************
 \end{interaction}
 Here, \whizard\ was unable to do anything sensible. But at least (in
 this case) it told the user what to do to resolve the problem.
 
 %%%%%%%%%%%%%%%
 
 \section{Statements}
 \label{sec:statements}
 
 \sindarin\ statements are executed one by one.  For an overview, we
 list the most common statements in the order in which they typically
 appear in a \sindarin\ script, and quote the basic syntax and simple
 examples.  This should give an impression on the \whizard's
 capabilities and on the user interface.  The list is not complete.
 Note that there are no
 mandatory commands (although an empty \sindarin\ script is not really
 useful).  The details and options are explained in later sections.
 
 \subsection{Process Configuration}
 
 \subsubsection{model}
 \begin{syntax}
 model = \var{model-name}
 \end{syntax}
 This assignment sets or resets the current physics model.  The
 Standard Model is already preloaded, so the \ttt{model} assignment
 applies to non-default models.  Obviously, the model must be known to
 \whizard. Example:
 \begin{code}
 model = MSSM
 \end{code}
 See Sec.~\ref{sec:models}.
 
 \subsubsection{alias}
 \begin{syntax}
 alias \var{alias-name} = \var{alias-definition}
 \end{syntax}
 Particles are specified by their names.   For most particles, there
 are various equivalent names.  Names containing special characters
 such as a \verb|+| sign have to be quoted.  The \ttt{alias} assignment
 defines an alias for a list of particles.  This is useful for setting
 up processes with sums over flavors, cut expressions, and more.  The
 alias name is then used like a simple particle name.  Example:
 \begin{syntax}
 alias jet = u:d:s:U:D:S:g
 \end{syntax}
 See Sec.~\ref{sec:alias}.
 
 
 \subsubsection{process}
 \begin{syntax}
 process \var{tag} = \var{incoming} \verb|=>| \var{outgoing}
 \end{syntax}
 Define a process.  You give the process a name \var{tag} by which it is
 identified later, and specify the incoming and outgoing particles,
 and possibly options.  You can define an arbitrary number of processes
 as long as they are distinguished by their names.  Example:
 \begin{code}
 process w_plus_jets = g, g => "W+", jet, jet
 \end{code}
 See Sec.~\ref{sec:processes}.
 
 
 \subsubsection{sqrts}
 \begin{syntax}
 sqrts = \var{energy-value}
 \end{syntax}
 Define the center-of-mass energy for collision processes.  The default
 setup will assume head-on central collisions of two beams.  Example:
 \begin{code}
 sqrts = 500 GeV
 \end{code}
 See Sec.~\ref{sec:beam-setup}.
 
 
 \subsubsection{beams}
 \begin{syntax}
 beams = \var{beam-particles} \\
 beams = \var{beam-particles} => \var{structure-function-setup}
 \end{syntax}
 Declare beam particles and properties.  The current value of \ttt{sqrts} is
 used, unless specified otherwise.  Example:
 \begin{code}
 beams = u:d:s, U:D:S => lhapdf
 \end{code}
 With options, the assignment allows for
 defining beam structure in some detail.  This includes beamstrahlung and ISR
 for lepton colliders, precise structure function definition for hadron
 colliders, asymmetric beams, beam polarization, and more.  See
 Sec.~\ref{sec:beams}.
 
 
 \subsection{Parameters}
 
 \subsubsection{Parameter settings}
 \begin{syntax}
 \var{parameter} = \var{value} \\
 \var{type} \var{user-parameter} \\
 \var{type} \var{user-parameter} = \var{value}
 \end{syntax}
 Specify a value for a parameter.  There are predefined parameters that affect
 the behavior of a command, model-specific parameters (masses, couplings), and
 user-defined parameters.  The latter have to be declared with a type, which
 may be \ttt{int} (integer), \ttt{real}, \ttt{complex}, \ttt{logical},
 \ttt{string}, or \ttt{alias}.  Logical parameter
 names begin with a question mark, string parameter names with a dollar sign.
 Examples:
 \begin{code}
 mb = 4.2 GeV
 ?rebuild_grids = true
 real mass_sum = mZ + mW
 string $message = "This is a string"
 \end{code}
 % $
 The value need not be a literal, it can be an arbitrary expression of the
 correct type.  See Sec.~\ref{sec:variables}.
 
 
 \subsubsection{read\_slha}
 \begin{syntax}
 read\_slha (\var{filename})
 \end{syntax}
 This is useful only for supersymmetric models: read a parameter file
 in the SUSY Les Houches Accord format.  The file defines parameter
 values and, optionally, decay widths, so this command removes the need
 for writing assignments for each of them.
 \begin{code}
 read_slha ("sps1a.slha")
 \end{code}
 See Sec.~\ref{sec:slha}.
 
 
 \subsubsection{show}
 \begin{syntax}
 show (\var{data-objects})
 \end{syntax}
 Print the current value of some data object.  This includes not just
 variables, but also models, libraries, cuts, etc.  This is rather a
 debugging aid, so don't expect the output to be concise in the latter
 cases.  Example:
 \begin{code}
 show (mH, wH)
 \end{code}
 See Sec.~\ref{sec:I/O}.
 
 
 \subsubsection{printf}
 \begin{syntax}
 printf \var{format-string} (\var{data-objects})
 \end{syntax}
 Pretty-print the data objects according to the given format string.
 If there are no data objects, just print the format string.
 This command is borrowed from the \ttt{C} programming language; it is
 actually an interface to the system's \ttt{printf(3)} function.  The
 conversion specifiers are restricted to \ttt{d,i,e,f,g,s},
 corresponding to the output of integer, real, and string variables.
 Example:
 \begin{code}
 printf "The Higgs mass is %f GeV" (mH)
 \end{code}
 See Sec.~\ref{sec:I/O}.
 
 
 \subsection{Integration}
 
 \subsubsection{cuts}
 \begin{syntax}
 cuts = \var{logical-cut-expression}
 \end{syntax}
 The cut expression is a logical macro expression that is evaluated for each
 phase space point during integration and event generation.  You may construct
 expressions out of various observables that are computed for the (partonic)
 particle content of the current event.  If the expression evaluates to
 \verb|true|, the matrix element is calculated and the event is used.  If it
 evaluates to \verb|false|, the matrix element is set zero and the event is
 discarded. Note that for collisions the expression is evaluated in the
 lab frame, while for decays it is evaluated in the rest frame of the
 decaying particle.  In case you want to impose cuts on a factorized
 process, i.e. a combination of a production process and one or more
 decay processes, you have to use the \ttt{selection} keyword
 instead.
 
 Example for the keyword \ttt{cuts}:
 \begin{code}
 cuts = all Pt > 20 GeV [jet]
   and  all mZ - 10 GeV < M < mZ + 10 GeV [lepton, lepton]
   and  no  abs (Eta) < 2 [jet]
 \end{code}
 See Sec.~\ref{sec:cuts}.
 
 
 \subsubsection{integrate}
 \begin{syntax}
 integrate (\var{process-tags})
 \end{syntax}
 Compute the total cross section for a process.  The command takes into account
 the definition of the process, the beam setup, cuts, and parameters as defined
 in the script.  Parameters may also be specified as options to the command.
 
 Integration is necessary for each process for which you want to know total or
 differential cross sections, or event samples.  Apart from computing a value,
 it sets up and adapts phase space and integration grids that are used in event
 generation.   If you just need an event sample, you can omit an explicit
 \ttt{integrate} command; the \ttt{simulate} command will call it
 automatically.  Example:
 \begin{code}
 integrate (w_plus_jets, z_plus_jets)
 \end{code}
 See Sec.~\ref{sec:integrate}.
 
 \subsubsection{?phs\_only/n\_calls\_test}
 \begin{syntax}
 integrate (\var{process-tag}) \{ ?phs\_only = true  n\_calls\_test = 1000 \}
 \end{syntax}
 These are just optional settings for the \ttt{integrate} command
 discussed just a second ago. The \ttt{?phs\_only = true} (note that
 variables starting with a question mark are logicals) option tells
 \whizard\ to prepare a process for integration, but instead of
 performing the integration, just to generate a phase space
 parameterization. \ttt{n\_calls\_test = <num>} evaluates the sampling
 function for random integration channels and random momenta.  \vamp\
 integration grids are neither generated nor used, so the channel
 selection corresponds to the first integration pass, before any grids
 or channel weights are adapted.  The number of sampling points is
 given by \verb|<num>|. The output contains information about the
 timing, number of sampling points that passed the kinematics
 selection, and the number of matrix-element values that were actually
 evaluated. This command is useful mainly for debugging and
 diagnostics.  Example:
 \begin{code}
 integrate (some_large_process) { ?phs_only = true  n_calls_test = 1000 }
 \end{code}
 (Note that there used to be a separate command
 \ttt{matrix\_element\_test} until version 2.1.1 of \whizard\ which has
 been discarded in order to simplify the \sindarin\ syntax.)
 
 \subsection{Events}
 
 \subsubsection{histogram}
 \begin{syntax}
 histogram \var{tag} (\var{lower-bound}, \var{upper-bound}) \\
 histogram \var{tag} (\var{lower-bound}, \var{upper-bound}, \var{step}) \\
 \end{syntax}
 Declare a histogram for event analysis.  The histogram is filled by an
 analysis expression, which is evaluated once for each event during a
 subsequent simulation step.  Example:
 \begin{code}
 histogram pt_distribution (0, 150 GeV, 10 GeV)
 \end{code}
 See Sec.~\ref{sec:histogram}.
 
 
 \subsubsection{plot}
 \begin{syntax}
 plot \var{tag}
 \end{syntax}
 Declare a plot for displaying data points.  The plot may be filled by an
 analysis expression that is evaluated for each event; this would result in a
 scatter plot.  More likely, you will use this feature for displaying data such
 as the energy dependence of a cross section.  Example:
 \begin{code}
 plot total_cross_section
 \end{code}
 See Sec.~\ref{sec:plot}.
 
 
 \subsubsection{selection}
 \begin{syntax}
 selection = \var{selection-expression}
 \end{syntax}
 The selection expression is a logical macro expression that is evaluated once
 for each event. It is applied to the event record,
 after all decays have been executed (if any). It is therefore intended
 e.g. for modelling detector acceptance cuts etc. For unfactorized
 processes the usage of \ttt{cuts} or \ttt{selection} leads to
 the same results. Events for which the selection expression evaluates
 to false are dropped; they are neither analyzed nor written to any
 user-defined output file. However, the dropped events are written to
 \whizard's native event file. For unfactorized processes it is
 therefore preferable to implement all cuts using the \ttt{cuts}
 keyword for the integration, see \ttt{cuts} above.
 Example:
 \begin{code}
 selection = all Pt > 50 GeV [lepton]
 \end{code}
 The syntax is generically the same as for the \ttt{cuts
 expression}, see Sec.~\ref{sec:cuts}. For more information see also
 Sec.~\ref{sec:analysis}.
 
 
 \subsubsection{analysis}
 \begin{syntax}
 analysis = \var{analysis-expression}
 \end{syntax}
 The analysis expression is a logical macro expression that is evaluated once
 for each event that passes the integration and selection cuts in a
 subsequent simulation step.  The
 expression has type logical in analogy with the cut expression; however, its
 main use will be in side effects caused by embedded \ttt{record} expressions.
 The \ttt{record} expression books a value, calculated from observables
 evaluated for the current event, in one of the predefined histograms or plots.
 Example:
 \begin{code}
 analysis = record pt_distribution (eval Pt [photon])
       and  record mval (eval M [lepton, lepton])
 \end{code}
 See Sec.~\ref{sec:analysis}.
 
 
 \subsubsection{unstable}
 \begin{syntax}
 unstable \var{particle} (\var{decay-channels})
 \end{syntax}
 Specify that a particle can decay, if it occurs in the final state of a
 subsequent simulation step.  (In the integration step, all final-state
 particles are considered stable.)  The decay channels are processes which
 should have been declared before by a \ttt{process} command
 (alternatively, there are options that \whizard\ takes care of this
 automatically; cf. Sec.~\ref{sec:decays}).  They may be
 integrated explicitly, otherwise the \ttt{unstable} command will take care of
 the integration before particle decays are generated.  Example:
 \begin{code}
 unstable Z (z_ee, z_jj)
 \end{code}
 Note that the decay is an on-shell approximation.  Alternatively, \whizard\ is
 capable of generating the final state(s) directly, automatically including the
 particle as an internal resonance together with irreducible background.
 Depending on the physical problem and on the complexity of the matrix-element
 calculation, either option may be more appropriate.
 
 See Sec.~\ref{sec:decays}.
 
 
 \subsubsection{n\_events}
 \begin{syntax}
 n\_events = \var{integer}
 \end{syntax}
 Specify the number of events that a subsequent simulation step should produce.
 By default, simulated events are unweighted.  (Unweighting is done by a
 rejection operation on weighted events, so the usual caveats on event
 unweighting by a numerical Monte-Carlo generator do apply.)  Example:
 \begin{code}
 n_events = 20000
 \end{code}
 See Sec.~\ref{sec:simulation}.
 
 
 \subsubsection{simulate}
 \begin{syntax}
 simulate (\var{process-tags})
 \end{syntax}
 Generate an event sample.  The command allows for analyzing the generated
 events by the \ttt{analysis} expression.  Furthermore, events can be written
 to file in various formats.  Optionally, the partonic events can be showered
 and hadronized, partly using included external (\pythia) or truly
 external programs called by \whizard. Example:
 \begin{code}
 simulate (w_plus_jets) { sample_format = lhef }
 \end{code}
 See Sec.~\ref{sec:simulation} and Chapter~\ref{chap:events}.
 
 
 \subsubsection{graph}
 \begin{syntax}
 graph (\var{tag}) = \var{histograms-and-plots}
 \end{syntax}
 Combine existing histograms and plots into a common graph.  Also
 useful for pretty-printing single histograms or plots.  Example:
 \begin{code}
 graph comparison {
   $title = "$p_T$ distribution for two different values of $m_h$"
 } = hist1 & hist2
 \end{code}
 % $
 See Sec.~\ref{sec:graphs}.
 
 
 \subsubsection{write\_analysis}
 \begin{syntax}
 write\_analysis (\var{analysis-objects})
 \end{syntax}
 Writes out data tables for the specified analysis objects (plots,
 graphs, histograms).  If the argument is empty or absent, write all
 analysis objects currently available.  The tables are
 available for feeding external programs.  Example:
 \begin{code}
 write_analysis
 \end{code}
 See Sec.~\ref{sec:analysis}.
 
 
 \subsubsection{compile\_analysis}
 \begin{syntax}
 compile\_analysis (\var{analysis-objects})
 \end{syntax}
 Analogous to \ttt{write\_analysis}, but the generated data tables are
 processed by \LaTeX\ and \gamelan, which produces Postscript and PDF
 versions of the displayed data.  Example:
 \begin{code}
 compile_analysis
 \end{code}
 See Sec.~\ref{sec:analysis}.
 
 
 
 \section{Control Structures}
 
 Like any complete programming language, \sindarin\ provides means for
 branching and looping the program flow.
 
 \subsection{Conditionals}
 
 \subsubsection{if}
 \begin{syntax}
 if \var{logical\_expression} then \var{statements} \\
 elsif \var{logical\_expression} then \var{statements} \\
 else \var{statements} \\
 endif
 \end{syntax}
 Execute statements conditionally, depending on the value of a logical
 expression. There may be none or multiple \ttt{elsif} branches, and
 the \ttt{else} branch is also optional.  Example:
 \begin{code}
 if (sqrts > 2 * mtop) then
   integrate (top_pair_production)
 else
   printf "Top pair production is not possible"
 endif
 \end{code}
 The current \sindarin\ implementation puts some restriction on the
 statements that can appear in a conditional.  For instance, process
 definitions must be done unconditionally.
 
 \subsection{Loops}
 \subsubsection{scan}
 \begin{syntax}
 scan \var{variable} = (\var{value-list}) \{ \var{statements} \}
 \end{syntax}
 Execute the statements repeatedly, once for each value of the scan
 variable.  The statements are executed in a local context, analogous
 to the option statement list for commands.  The value list is a
 comma-separated list of expressions, where each item evaluates to the
 value that is assigned to \ttt{\var{variable}} for this iteration.
 
 The type of the variable is not restricted to numeric, scans can be
 done for various object types.  For instance, here is a scan over strings:
 \begin{code}
 scan string $str = ("%.3g", "%.4g", "%.5g") { printf $str (mW) }
 \end{code}
 % $
 The output:
 \begin{interaction}
 [user variable] $str = "%.3g"
 80.4
 [user variable] $str = "%.4g"
 80.42
 [user variable] $str = "%.5g"
 80.419
 \end{interaction}
 % $
 For a numeric scan variable in particular, there are iterators that
 implement the usual functionality of \ttt{for} loops.  If the scan
 variable is of type integer, an iterator may take one of the forms
 \begin{syntax}
 \var{start-value} \verb|=>| \var{end-value} \\
 \var{start-value} \verb|=>| \var{end-value} \verb|/+| \var{add-step} \\
 \var{start-value} \verb|=>| \var{end-value} \verb|/-| \var{subtract-step} \\
 \var{start-value} \verb|=>| \var{end-value} \verb|/*| \var{multiplicator} \\
 \var{start-value} \verb|=>| \var{end-value} \verb|//| \var{divisor} \\
 \end{syntax}
 The iterator can be put in place of an expression in the
 \ttt{\var{value-list}}.  Here is an example:
 \begin{code}
 scan int i = (1, (3 => 5), (10 => 20 /+ 4))
 \end{code}
 which results in the output
 \begin{interaction}
 [user variable] i =            1
 [user variable] i =            3
 [user variable] i =            4
 [user variable] i =            5
 [user variable] i =           10
 [user variable] i =           14
 [user variable] i =           18
 \end{interaction}
 [Note that the \ttt{\var{statements}} part of the scan construct may
 be empty or absent.]
 
 For real scan variables, there are even more possibilities for iterators:
 \begin{syntax}
 \var{start-value} \verb|=>| \var{end-value} \\
 \var{start-value} \verb|=>| \var{end-value} \verb|/+| \var{add-step} \\
 \var{start-value} \verb|=>| \var{end-value} \verb|/-| \var{subtract-step} \\
 \var{start-value} \verb|=>| \var{end-value} \verb|/*| \var{multiplicator} \\
 \var{start-value} \verb|=>| \var{end-value} \verb|//| \var{divisor} \\
 \var{start-value} \verb|=>| \var{end-value} \verb|/+/| \var{n-points-linear} \\
 \var{start-value} \verb|=>| \var{end-value} \verb|/*/| \var{n-points-logarithmic} \\
 \end{syntax}
 The first variant is equivalent to \ttt{/+ 1}.  The \ttt{/+} and
 \ttt{/-} operators are intended to add or subtract the given step once
 for each iteration.  Since in floating-point arithmetic this would be
 plagued by rounding ambiguities, the actual implementation first
 determines the (integer) number of iterations from the provided step
 value, then recomputes the step so that the iterations are evenly
 spaced with the first and last value included.
 
 The \ttt{/*} and \ttt{//} operators are analogous.  Here, the initial
 value is intended to be multiplied by the step value once for each
 iteration.  After determining the integer number of iterations, the
 actual scan values will be evenly spaced on a logarithmic scale.
 
 Finally, the \ttt{/+/} and \ttt{/*/} operators allow to specify the
 number of iterations (not counting the initial value) directly.  The
 \ttt{\var{start-value}} and \ttt{\var{end-value}} are always included,
 and the intermediate values will be evenly spaced on a linear
 (\ttt{/+/}) or logarithmic (\ttt{/*/}) scale.
 
 Example:
 \begin{code}
 scan real mh = (130 GeV,
            (140 GeV => 160 GeV /+ 5 GeV),
            180 GeV,
            (200 GeV => 1 TeV /*/ 10))
   {  integrate (higgs_decay) }
 \end{code}
 
 
 \subsection{Including Files}
 \subsubsection{include}
 \begin{syntax}
 include (\var{file-name})
 \end{syntax}
 Include a \sindarin\ script from the specified file.  The contents
 must be complete commands; they are compiled and executed as if they
 were part of the current script.  Example:
 \begin{code}
 include ("default_cuts.sin")
 \end{code}
 
 
 
 
 
 \section{Expressions}
 
 \sindarin\ expressions are classified by their types.  The
 type of an expression is verified when the script is compiled, before
 it is executed.  This provides some safety against simple coding
 errors.
 
 Within expressions, grouping is done using ordinary brackets \ttt{()}.
 For subevent expressions, use square brackets \ttt{[]}.
 
 \subsection{Numeric}
 The language supports the classical numeric types
 \begin{itemize}
 \item
    \ttt{int} for integer: machine-default, usually 32 bit;
 \item
    \ttt{real}, usually \emph{double precision} or 64 bit;
 \item
    \ttt{complex}, consisting of real and imaginary part equivalent to a
    \ttt{real} each.
 \end{itemize}
 \sindarin\ supports arithmetic expressions similar to conventional
 languages.  In arithmetic expressions, the three numeric types can be
 mixed as appropriate.  The computation essentially follows the rules
 for mixed arithmetic in \ttt{Fortran}.  The arithmetic operators are
 \verb|+|, \verb|-|, \verb|*|, \verb|/|, \verb|^|. Standard functions
 such as \ttt{sin}, \ttt{sqrt}, etc. are available.  See
 Sec.~\ref{sec:real} to Sec.~\ref{sec:complex}.
 
 Numeric values can be associated with units.  Units evaluate to
 numerical factors, and their use is optional, but they can be useful
 in the physics context for which \whizard\ is designed.  Note that the
 default energy/mass unit is \verb|GeV|, and the default unit for cross
 sections is \verb|fbarn|.
 
 
 \subsection{Logical and String}
 
 The language also has the following standard types:
 \begin{itemize}
 \item
    \ttt{logical} (a.k.a.\ boolean). Logical variable names have a
    \ttt{?} (question mark) as prefix.
 \item
    \ttt{string} (arbitrary length).  String variable names have a \ttt{\$}
    (dollar) sign as prefix.
 \end{itemize}
 There are comparisons, logical operations, string concatenation, and a
 mechanism for formatting objects as strings for output.
 
 
 \subsection{Special}
 
 Furthermore, \sindarin\ deals with a bunch of data types tailored
 specifically for Monte Carlo applications:
 \begin{itemize}
 \item
   \ttt{alias} objects denote a set of particle species.
 \item
   \ttt{subevt} objects denote a collection of particle momenta within an
   event.  They have their uses in cut and analysis expressions.
 \item
   \ttt{process} object are generated by a \ttt{process} statement.
   There are no expressions involving processes, but they are referred
   to by \ttt{integrate} and \ttt{simulate} commands.
 \item
   \ttt{model}: There is always a current object of type and name
   \ttt{model}.  Several models can be used concurrently by
   appropriately defining processes, but this happens behind the scenes.
 \item
   \ttt{beams}: Similarly, the current implementation allows only for a single
   object of this type at a given time, which is assigned by a \ttt{beams =}
   statement and used by \ttt{integrate}.
 \end{itemize}
 
 In the current implementation, \sindarin\ has no container data types
 derived from basic types, such as lists, arrays, or hashes, and there
 are no user-defined data types.  (The \ttt{subevt} type is a container
 for particles in the context of events, but there is no type for an
 individual particle: this is represented as a one-particle
 \ttt{subevt}). There are also containers for inclusive processes which
 are however simply handled as an expansion into several components of
 a master process tag.
 
 
 
 
 
 \section{Variables}
 \label{sec:variables}
 
 \sindarin\ supports global variables, variables local to a scoping unit (the
 option body of a command, the body of a \ttt{scan} loop), and variables local
 to an expression.
 
 Some variables are predefined by the system (\emph{intrinsic
   variables}).  They are further separated into \emph{independent}
 variables that can be reset by the user, and \emph{derived} or locked
 variables that are automatically computed by the program, but not
 directly user-modifiable.  On top of that, the user is free to
 introduce his own variables (\emph{user variables}).
 
 The names of numerical variables consist of alphanumeric characters and
 underscores.  The first character must not be a digit.  Logical
 variable names are furthermore prefixed by a
 \ttt{?} (question mark) sign, while string variable names begin
 with a \ttt{\$} (dollar) sign.
 
 Character case does matter.  In this manual we follow the
 convention that variable names consist of lower-case letters,
 digits, and underscores only, but you may also use upper-case
 letters if you wish.
 
 Physics models contain their own, specific set of numeric variables
 (masses, couplings).  They are attached to the model where they are
 defined, so they appear and disappear with the model that is currently
 loaded.  In particular, if two different models contain a variable
 with the same name, these two variables are nevertheless distinct:
 setting one doesn't affect the other.  This feature might be called,
 in computer-science jargon, a \emph{mixin}.
 
 User variables -- global or local -- are declared by their type when they are
 introduced, and acquire an initial value upon declaration.  Examples:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   int i = 3
   real my_cut_value = 10 GeV
   complex c = 3 - 4 * I
   logical ?top_decay_allowed = mH > 2 * mtop
   string $hello = "Hello world!"
   alias q = d:u:s:c
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 An existing user variable can be assigned a new value without a declaration:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   i = i + 1
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 and it may also be redeclared if the new declaration specifies the same type,
 this is equivalent to assigning a new value.
 
 Variables local to an expression are introduced by the \ttt{let ... in}
 contruct.  Example:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   real a = let int n = 2 in
            x^n + y^n
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 The explicit \ttt{int} declaration is necessary only if the variable \ttt{n}
 has not been declared before.  An intrinsic variable must not be declared:
 \ttt{let mtop = 175.3 GeV in \ldots}
 
 \ttt{let} constructs can be concatenated if several local variables need to
 be assigned: \ttt{let a = 3 in let b = 4 in \textit{expression}}.
 
 Variables of type \ttt{subevt} can only be defined in \ttt{let} constructs.
 
 Exclusively in the context of particle selections (event analysis), there are
 \emph{observables} as special numeric objects.  They are used like numeric
 variables, but they are never declared or assigned.  They get their value
 assigned dynamically, computed from the particle momentum configuration.
 Hence, they may be understood as (intrinsic and predefined) macros.
 By convention, observable names begin with a capital letter.
 
 Further macros are
 \begin{itemize}
 \item
   \ttt{cuts} and \ttt{analysis}.  They are of type logical, and can be
   assigned an expression by the user.  They are evaluated once for
   each event.
 \item
   \ttt{scale}, \ttt{factorization\_scale} and
   \ttt{renormalization\_scale} are real numeric macros which define the
   energy scale(s) of an event.  The latter two override the former.
   If no scale is defined, the partonic energy is used as the process scale.
 \item
   \ttt{weight} is a real numeric macro.  If it is assigned an
   expression, the expression is evaluated for each valid phase-space
   point, and the result multiplies the matrix element.
 \end{itemize}
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{\sindarin\ in Details}
 \label{chap:sindarin}
 
 \section{Data and expressions}
 
 \subsection{Real-valued objects}
 \label{sec:real}
 
 Real literals have their usual form, mantissa and, optionally, exponent:
 \begin{center}
 \ttt{0.}\quad  \ttt{3.14}\quad \ttt{-.5}\quad
 \ttt{2.345e-3}\quad \ttt{.890E-023}
 \end{center}
 Internally, real values are treated as double precision.  The values are read
 by the Fortran library, so details depend on its implementation.
 
 A special feature of \sindarin\ is that numerics (real and integer) can be
 immediately followed by a physical unit.  The supported units are presently
 hard-coded, they are
 \begin{center}
   \ttt{meV}\quad \ttt{eV}\quad \ttt{keV}\quad
   \ttt{MeV}\quad \ttt{GeV}\quad \ttt{TeV}
 \\
   \ttt{nbarn}\quad \ttt{pbarn}\quad \ttt{fbarn}\quad \ttt{abarn}
 \\
   \ttt{rad}\quad \ttt{mrad}\quad \ttt{degree}
 \\
   \ttt{\%}
 \end{center}
 If a number is followed by a unit, it is automatically normalized to the
 corresponding default unit: \ttt{14.TeV} is transformed into the real number
 \ttt{14000.}  Default units are \ttt{GeV}, \ttt{fbarn}, and \ttt{rad}.  The
 \ttt{\%} sign after a number has the effect that the number is multiplied by
 $0.01$.  Note that no checks for consistency of units are done, so you can add
 \ttt{1 meV + 3 abarn} if you absolutely wish to.  Omitting units is always
 allowed, in that case, the default unit is assumed.
 
 Units are not treated as variables.  In particular, you can't write \ttt{theta
   / degree}, the correct form is \ttt{theta / 1 degree}.
 
 There is a single predefined real constant, namely $\pi$ which is referred to
 by the keyword \ttt{pi}. In addition, there is a single predefined
 complex constant, which is the complex unit $i$, being referred to by
 the keyword \ttt{I}.
 
 The arithmetic operators are
 \begin{center}
   \verb|+| \verb|-| \verb|*| \verb|/| \verb|^|
 \end{center}
 with their obvious meaning and the usual precedence rules.
 
 \sindarin\ supports a bunch of standard numerical functions, mostly equivalent
 to their Fortran counterparts:
 \begin{center}
   \ttt{abs}\quad \ttt{conjg}\quad \ttt{sgn}\quad \ttt{mod}\quad \ttt{modulo}
 \\
   \ttt{sqrt}\quad \ttt{exp}\quad \ttt{log}\quad \ttt{log10}
 \\
   \ttt{sin}\quad \ttt{cos}\quad \ttt{tan}\quad
   \ttt{asin}\quad \ttt{acos}\quad \ttt{atan}
 \\
   \ttt{sinh}\quad \ttt{cosh}\quad \ttt{tanh}
 \end{center}
 (Unlike Fortran, the \ttt{sgn} function takes only one argument and returns
 $1.$, or $-1.$) The function argument is enclosed in brackets: \ttt{sqrt
   (2.)}, \ttt{tan (11.5 degree)}.
 
 There are two functions with two real arguments:
 \begin{center}
   \ttt{max}\quad \ttt{min}
 \end{center}
 Example: \verb|real lighter_mass = min (mZ, mH)|
 
 The following functions of a real convert to integer:
 \begin{center}
   \ttt{int}\quad \ttt{nint}\quad \ttt{floor}\quad \ttt{ceiling} %% \; .
 \end{center}
 and this converts to complex type:
 \begin{center}
   \ttt{complex}
 \end{center}
 
 Real values can be compared by the following operators, the result is a
 logical value:
 \begin{center}
   \verb|==|\quad \verb|<>|
 \\
   \verb|>|\quad \verb|<|\quad \verb|>=|\quad \verb|<=|
 \end{center}
 In \sindarin, it is possible to have more than two operands in a logical
 expressions.  The comparisons are done from left to right.  Hence,
 \begin{center}
   \verb|115 GeV < mH < 180 GeV|
 \end{center}
 is valid \sindarin\ code and evaluates to \ttt{true} if the Higgs mass is in the
 given range.
 
 Tests for equality and inequality with machine-precision real numbers are
 notoriously unreliable and should be avoided altogether.  To deal with this
 problem, \sindarin\ has the possibility to make the comparison operators
 ``fuzzy'' which should be read as ``equal (unequal) up to an absolute
 tolerance'', where the tolerance is given by the real-valued intrinsic
 variable \ttt{tolerance}. This variable is initially zero, but can be
 set to any value (for instance, \ttt{tolerance = 1.e-13} by the user.
 Note that for non-zero tolerance, operators like
 \verb|==| and \verb|<>| or \verb|<| and \verb|>| are not mutually
 exclusive\footnote{In older versions of \whizard, until v2.1.1, there
 used to be separate comparators for the comparisons up to a tolerance,
 namely \ttt{==\~{}} and \ttt{<>\~{}}. These have been discarded from
 v2.2.0 on in order to simplify the syntax.}.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Integer-valued objects}
 \label{sec:integer}
 
 Integer literals are obvious:
 \begin{center}
 \ttt{1}\quad \ttt{-98765}\quad \ttt{0123}
 \end{center}
 Integers are always signed.  Their range is the default-integer range as
 determined by the \fortran\ compiler.
 
 Like real values, integer values can be followed by a physical unit: \ttt{1
   TeV}, \ttt{30 degree}.  This actually transforms the integer into a real.
 
 Standard arithmetics is supported:
 \begin{center}
   \verb|+| \verb|-| \verb|*| \verb|/| \verb|^|
 \end{center}
 It is important to note that there is no fraction datatype, and pure integer
 arithmetics does not convert to real.  Hence \ttt{3/4} evaluates to \ttt{0},
 but \ttt{3 GeV / 4 GeV} evaluates to \ttt{0.75}.
 
 Since all arithmetics is handled by the underlying \fortran\ library, integer
 overflow is not detected.  If in doubt, do real arithmetics.
 
 Integer functions are more restricted than real functions.  We support the
 following:
 \begin{center}
   \ttt{abs}\quad \ttt{sgn}\quad \ttt{mod}\quad \ttt{modulo}
 \\
   \ttt{max}\quad \ttt{min}
 \end{center}
 and the conversion functions
 \begin{center}
   \ttt{real}\quad \ttt{complex}
 \end{center}
 Comparisons of integers among themselves and with reals are possible using the
 same set of comparison operators as for real values.  This includes
 the operators with a finite tolerance.
 
 %%%%%%%%%%%%%%%%
 
 \subsection{Complex-valued objects}
 \label{sec:complex}
 
 Complex variables and values are currently not yet used by the physics
 models implemented in \whizard. There complex input coupling constants
 are always split into their real and imaginary parts (or modulus and
 phase). They are exclusively available for arithmetic calculations.
 
 There is no form for complex literals.  Complex values must be created via an
 arithmetic expression,
 \begin{center}
   \ttt{complex c = 1 + 2 * I}
 \end{center}
 where the imaginary unit \ttt{I} is predefined as a constant.
 
 The standard arithmetic operations are supported (also mixed with real and
 integer).  Support for functions is currently still incomplete, among the
 supported functions there are \ttt{sqrt}, \ttt{log}, \ttt{exp}.
 
 
 
 \subsection{Logical-valued objects}
 
 There are two predefined logical constants, \ttt{true} and \ttt{false}.
 Logicals are \emph{not} equivalent to integers (like in C) or to strings (like
 in PERL), but they make up a type of their own.  Only in \verb|printf| output,
 they are treated as strings, that is, they require the \verb|%s| conversion
 specifier.
 
 The names of logical variables begin with a question mark \ttt{?}.  Here is
 the declaration of a logical user variable:
 \begin{quote}
 \begin{footnotesize}
 \begin{footnotesize}
 \begin{verbatim}
 logical ?higgs_decays_into_tt = mH > 2 * mtop
 \end{verbatim}
 \end{footnotesize}
 \end{footnotesize}
 \end{quote}
 
 Logical expressions use the standard boolean operations
 \begin{center}
   \ttt{or}\quad \ttt{and}\quad \ttt{not}
 \end{center}
 The results of comparisons (see above) are logicals.
 
 There is also a special logical operator with lower priority, concatenation by
 a semicolon:
 \begin{center}
   \ttt{\textit{lexpr1} ; \textit{lexpr2}}
 \end{center}
 This evaluates \textit{lexpr1} and throws its result away, then evaluates
 \textit{lexpr2} and returns that result.  This feature is to used with logical
 expressions that have a side effect, namely the \ttt{record} function within
 analysis expressions.
 
 The primary use for intrinsic logicals are flags that change the behavior of
 commands.  For instance, \ttt{?unweighted = true} and \ttt{?unweighted =
   false} switch the unweighting of simulated event samples on and off.
 
 
 \subsection{String-valued objects and string operations}
 \label{sec:sprintf}
 
 String literals are enclosed in double quotes: \ttt{"This is a string."}
 The empty string is \ttt{""}.  String variables begin with the dollar
 sign: \verb|$|. There is only one string operation, concatenation
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 string $foo = "abc" & "def"
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 
 However, it is possible to transform variables and values to a string using
 the \ttt{sprintf} function.  This function is an interface to the system's \ttt{C}
 function \ttt{sprintf} with some restrictions and modifications.  The allowed
 conversion specifiers are
 \begin{center}
   \verb|%d|\quad \verb|%i| (integer)
 \\
   \verb|%e|\quad \verb|%f|\quad \verb|%g|\quad
   \verb|%E|\quad \verb|%F|\quad \verb|%G| (real)
 \\
   \verb|%s| (string and logical)
 \end{center}
 The conversions can use flag parameter, field width, and precision, but length
 modifiers are not supported since they have no meaning for the application.
 (See also Sec.~\ref{sec:I/O}.)
 
 The \ttt{sprintf} function has the syntax
 \begin{center}
   \ttt{sprintf} \textit{format-string}
   \ttt{(}\textit{arg-list}\ttt{)}
 \end{center}
 This is an expression that evaluates to a string.  The format string contains
 the mentioned conversion specifiers.  The argument list is optional.  The
 arguments are separated by commas.  Allowed arguments are integer, real,
 logical, and string variables, and numeric expressions.  Logical and string
 expressions can also be printed, but they have to be dressed as
 \emph{anonymous variables}.  A logical anonymous variable has the form
 \ttt{?(}\textit{logical\_expr}\ttt{)} (example: \ttt{?(mH > 115 GeV)}).  A
 string anonymous variable has the form \ttt{\$(}\textit{string-expr}\ttt{)}.
 
 Example:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 string $unit = "GeV"
 string $str = sprintf "mW = %f %s" (mW, $unit)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 The related \ttt{printf} command with the same syntax prints the formatted
 string to standard output\footnote{In older versions of \whizard,
   until v2.1.1, there also used to be a \ttt{sprintd} function and a
   \ttt{printd} command for default formats without a format
   string. They have been discarded in order to simplify the syntax
   from version v2.2.0 on.}.
 
 
 \section{Particles and (sub)events}
 
 \subsection{Particle aliases}
 \label{sec:alias}
 
 A particle species is denoted by its name as a string: \verb|"W+"|.
 Alternatively, it can be addressed by an \ttt{alias}.  For instance, the $W^+$
 boson has the alias \ttt{Wp}.  Aliases are used like variables in a context
 where a particle species is expected, and the user can specify his/her own
 aliases.
 
 An alias may either denote a single particle species or a class of particles
 species.  A colon \ttt{:} concatenates particle names and aliases to yield
 multi-species aliases:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 alias quark = u:d:s
 alias wboson = "W+":"W-"
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Such aliases are used for defining processes with summation over flavors, and
 for defining classes of particles for analysis.
 
 Each model files define both names and (single-particle) aliases for all
 particles it contains.  Furthermore, it defines the class aliases
 \verb|colored| and \verb|charged| which are particularly useful for event
 analysis.
 
 
 \subsection{Subevents}
 
 Subevents are sets of particles, extracted from an event.  The sets are
 unordered by default, but may be ordered by appropriate functions.  Obviously,
 subevents are meaningful only in a context where an event is available.  The
 possible context may be the specification of a cut, weight, scale, or analysis
 expression.
 
 To construct a simple subevent, we put a particle alias or an expression of
 type particle alias into square brackets:
 \begin{quote}
 \begin{footnotesize}
   \verb|["W+"]|\quad
   \verb|[u:d:s]|\quad
   \verb|[colored]|
 \end{footnotesize}
 \end{quote}
 These subevents evaluate to the set of all $W^+$ bosons (to be precise, their
 four-momenta), all $u$, $d$, or $s$ quarks, and all colored particles,
 respectively.
 
 A subevent can contain pseudoparticles, i.e., particle combinations.
 That is, the four-momenta of
 distinct particles are combined (added conmponent-wise), and the results
 become subevent elements just like ordinary particles.
 
 The (pseudo)particles in a subevent are non-overlapping.  That is, for
 any of the particles in the original event, there is at most one
 (pseudo)particle in the subevent in which it is contained.
 
 Sometimes, variables (actually, named constants) of type subevent are useful.
 Subevent variables are declared by the \ttt{subevt} keyword, and their
 names carry the prefix \verb|@|.  Subevent variables exist only within the
 scope of a \verb|cuts| (or \verb|scale|, \verb|analysis|, etc.) macro, which
 is evaluated in the presence of an actual event.  In the macro body, they are
 assigned via the \ttt{let} construct:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 cuts =
   let subevt @jets = select if Pt > 10 GeV [colored]
   in
   all Theta > 10 degree [@jets, @jets]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 In this expression, we first define \verb|@jets| to stand for the set of all
 colored partons with $p_T>10\;\mathrm{GeV}$.  This abbreviation is then used
 in a logical expression, which evaluates to true if all relative angles
 between distinct jets are greater than $10$ degree.
 
 We note that the example also introduces pairs of subevents: the square
 bracket with two entries evaluates to the list of all possible pairs which do
 not overlap.  The objects within square brackets can be either subevents or
 alias expressions.  The latter are transformed into subevents before they are
 used.
 
 As a special case, the original event is always available as the predefined
 subevent \verb|@evt|.
 
 \subsection{Subevent functions}
 
 There are several functions that take a subevent (or an alias) as an argument
 and return a new subevent.  Here we describe them:
 
 \subsubsection{collect}
 \begin{quote}
 \begin{footnotesize}
   \ttt{collect [\textit{particles}]} \\
   \ttt{collect if \textit{condition} [\textit{particles}]} \\
   \ttt{collect if \textit{condition} [\textit{particles}, \textit{ref\_particles}]}
 \end{footnotesize}
 \end{quote}
 First version: collect all particle momenta in the argument and combine them
 to a single four-momentum.  The \textit{particles} argument may either be a
 \ttt{subevt} expression or an \ttt{alias} expression.  The result is a
 one-entry \ttt{subevt}.  In the second form, only those particles are collected
 which satisfy the \textit{condition}, a logical expression.  Example:
 \ttt{collect if Pt > 10 GeV [colored]}
 
 The third version is useful if you want to put binary observables (i.e.,
 observables constructed from two different particles) in the condition.  The
 \textit{ref\_particles} provide the second argument for binary observables in
 the \textit{condition}.  A particle is taken into account if the condition is
 true with respect to all reference particles that do not overlap with this
 particle.  Example: \ttt{collect if Theta > 5 degree [photon, charged]}:
 combine all photons that are separated by 5 degrees from all charged
 particles.
 
 
 \subsubsection{cluster}
 \emph{NOTE: This is an experimental feature, available from version
   2.2.1 on.}
 \begin{quote}
 \begin{footnotesize}
   \ttt{cluster [\textit{particles}]} \\
   \ttt{cluster if \textit{condition} [\textit{particles}]} \\
 \end{footnotesize}
 \end{quote}
 First version: collect all particle momenta in the argument and cluster them
 to a set of jets.  The \textit{particles} argument may either be a
 \ttt{subevt} expression or an \ttt{alias} expression.  The result is a
 one-entry \ttt{subevt}.  In the second form, only those particles are clustered
 which satisfy the \textit{condition}, a logical expression.  Example:
 \ttt{cluster if Pt > 10 GeV [colored]}
 
 % The third version is usefule if you want to put binary observables (i.e.,
 % observables constructed from two different particles) in the condition.  The
 % \textit{ref\_particles} provide the second argument for binary observables in
 % the \textit{condition}.  A particle is taken into account if the condition is
 % true with respect to all reference particles that do not overlap with this
 % particle.  Example: \ttt{cluster if Theta > 5 degree [photon, charged]}:
 % combine all photons that are separated by 5 degrees from all charged
 % particles.
 
 This command is available from \whizard\ version 2.2.1 on, and only if
 the \fastjet\ package has been installed and linked with \whizard\
 (cf. Sec.\ref{sec:fastjet}); in a future version of \whizard\ it is
 foreseen to have also an intrinsic clustering package inside \whizard\
 which will be able to support some of the clustering algorithms
 below. To use it in an analysis, you have to set the variable
 \ttt{jet\_algorithm} to one of the predefined jet-algorithm values
 (integer constants):
 \begin{quote}
 \begin{footnotesize}
   \ttt{kt\_algorithm}\\
   \ttt{cambridge\_algorithm}\\
   \ttt{antikt\_algorithm}\\
   \ttt{genkt\_algorithm}\\
   \ttt{cambridge\_for\_passive\_algorithm}\\
   \ttt{genkt\_for\_passive\_algorithm}\\
   \ttt{ee\_kt\_algorithm}\\
   \ttt{ee\_genkt\_algorithm}\\
   \ttt{plugin\_algorithm}
 \end{footnotesize}
 \end{quote}
 and the variable \ttt{jet\_r} to the desired $R$ parameter value, as
 appropriate for the analysis and the jet algorithm.  Example:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   jet_algorithm = antikt_algorithm
   jet_r = 0.7
   cuts = all Pt > 15 GeV [cluster if Pt > 5 GeV [colored]]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 
 
 \subsubsection{combine}
 \begin{quote}
 \begin{footnotesize}
   \ttt{combine [\textit{particles\_1}, \textit{particles\_2}]} \\
   \ttt{combine if \textit{condition}} [\textit{particles\_1}, \textit{particles\_2}]
 \end{footnotesize}
 \end{quote}
 Make a new subevent of composite particles.  The composites are generated by
 combining all particles from subevent \textit{particles\_1} with all particles
 from subevent \textit{particles\_2} in all possible combinations.  Overlapping
 combinations are excluded, however: if a (composite) particle in the first
 argument has a constituent in common with a composite particle in the second
 argument, the combination is dropped.  In particular, this applies if the
 particles are identical.
 
 If a \textit{condition} is provided, the combination is done only when the
 logical expression, applied to the particle pair in question, returns true.
 For instance, here we reconstruct intermediate $W^-$ bosons:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 let @W_candidates = combine if 70 GeV < M < 80 GeV ["mu-", "numubar"]
 in ...
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Note that the combination may fail, so the resulting subevent could be empty.
 
 
 \subsubsection{operator +}
 
 If there is no condition, the $+$ operator provides a convenient
 shorthand for the \verb|combine| command.  In particular, it can be
 used if there are several particles to combine.  Example:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 cuts = any 170 GeV < M < 180 GeV [b + lepton + invisible]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 
 
 \subsubsection{select}
 \begin{quote}
 \begin{footnotesize}
   \ttt{select if \textit{condition} [\textit{particles}]}   \\
   \ttt{select if \textit{condition} [\textit{particles}, \textit{ref\_particles}]}
 \end{footnotesize}
 \end{quote}
 One argument: select all particles in the argument that satisfy the
 \textit{condition} and drop the rest.  Two arguments: the
 \textit{ref\_particles} provide a second argument for binary observables.
 Select particles if the condition is satisfied for all reference particles.
 
 \subsubsection{extract}
 \begin{quote}
 \begin{footnotesize}
   \ttt{extract [\textit{particles}]}   \\
   \ttt{extract index \textit{index-value} [\textit{particles}]}
 \end{footnotesize}
 \end{quote}
 Return a single-particle subevent.  In the first version, it contains the
 first particle in the subevent \textit{particles}.  In the second version, the
 particle with index \textit{index-value} is returned, where
 \textit{index-value} is an integer expression.  If its value is negative, the
 index is counted from the end of the subevent.
 
 The order of particles in an event or subevent is not always well-defined, so
 you may wish to sort the subevent before applying the \textit{extract}
 function to it.
 
 \subsubsection{sort}
 \begin{quote}
 \begin{footnotesize}
    \ttt{sort [\textit{particles}]} \\
    \ttt{sort by \textit{observable} [\textit{particles}]}   \\
    \ttt{sort by \textit{observable} [\textit{particles}, \textit{ref\_particle}]}
 \end{footnotesize}
 \end{quote}
 Sort the subevent according to some criterion.  If no criterion is supplied
 (first version), the subevent is sorted by increasing PDG code (first
 particles, then antiparticles).  In the second version, the
 \textit{observable} is a real expression which is evaluated for each particle
 of the subevent in turn.  The subevent is sorted by increasing value of this
 expression, for instance:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 let @sorted_evt = sort by Pt [@evt]
 in ...
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 In the third version, a reference particle is provided as second argument, so
 the sorting can be done for binary observables.  It doesn't make much sense to
 have several reference particles at once, so the \ttt{sort} function uses
 only the first entry in the subevent \textit{ref-particle}, if it has more
 than one.
 
 
 \subsubsection{join}
 \begin{quote}
 \begin{footnotesize}
   \ttt{join [\textit{particles}, \textit{new\_particles}]} \\
   \ttt{join if \textit{condition} [\textit{particles}, \textit{new\_particles}]}
 \end{footnotesize}
 \end{quote}
 This commands appends the particles in subevent \textit{new\_particles} to the
 subevent \textit{particles}, i.e., it joins the two particle sets.  To be
 precise, a (pseudo)particle from \textit{new\_particles} is only appended if it
 does not overlap with any of the (pseudo)particles
 present in \textit{particles}, so the function will not produce overlapping
 entries.
 
 In the second version, each particle from \textit{new\_particles} is also
 checked with all particles in the first set whether \textit{condition} is
 fulfilled.  If yes, and there is no overlap, it is appended, otherwise
 it is dropped.
 
 
 \subsubsection{operator \&}
 
 Subevents can also be concatenated by the operator \verb|&|.  This effectively
 applies \ttt{join} to all operands in turn.  Example:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 let @visible =
     select if Pt > 10 GeV and E > 5 GeV [photon]
   & select if Pt > 20 GeV and E > 10 GeV [colored]
   & select if Pt > 10 GeV [lepton]
 in ...
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 
 
 \subsection{Calculating observables}
 
 Observables (invariant mass \ttt{M}, energy \ttt{E}, \ldots) are used in
 expressions just like ordinary numeric variables.  By convention, their names
 start with a capital letter.  They are computed using a particle momentum (or
 two particle momenta) which are taken from a subsequent subevent argument.
 
 We can extract the value of an observable for an event and make it available
 for computing the \ttt{scale} value, or for histogramming etc.:
 
 \subsubsection{eval}
 \begin{quote}
 \begin{footnotesize}
   \ttt{eval \textit{expr} [\textit{particles}]} \\
   \ttt{eval \textit{expr} [\textit{particles\_1}, \textit{particles\_2}]}
 \end{footnotesize}
 \end{quote}
 
 The function \ttt{eval} takes an expression involving observables and
 evaluates it for the first momentum (or momentum pair) of the subevent (or
 subevent pair) in square brackets that follows the expression.  For example,
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   eval Pt [colored]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 evaluates to the transverse momentum of the first colored particle,
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   eval M [@jets, @jets]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 evaluates to the invariant mass of the first distinct pair of jets (assuming
 that \verb|@jets| has been defined in a \ttt{let} construct), and
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   eval E - M [combine [e1, N1]]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 evaluates to the difference of energy and mass of the combination of the first
 electron-neutrino pair in the event.
 
 The last example illustrates why observables are treated like variables, even
 though they are functions of particles: the \ttt{eval} construct with the
 particle reference in square brackets after the expression allows to compute
 derived observables -- observables which are functions of new observables --
 without the need for hard-coding them as new functions.
 
 
 \subsection{Cuts and event selection}
 \label{sec:cuts}
 
 Instead of a numeric value, we can use observables to compute a logical value.
 
 \subsubsection{all}
 \begin{quote}
 \begin{footnotesize}
   \ttt{all \textit{logical\_expr} [\textit{particles}]} \\
   \ttt{all \textit{logical\_expr} [\textit{particles\_1}, \textit{particles\_2}]}
 \end{footnotesize}
 \end{quote}
 The \ttt{all} construct expects a logical expression and one or two subevent
 arguments in square brackets.
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   all Pt > 10 GeV [charged]
   all 80 GeV < M < 100 GeV [lepton, antilepton]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 In the second example, \ttt{lepton} and \ttt{antilepton} should be aliases
 defined in a \ttt{let} construct.  (Recall that aliases are promoted to
 subevents if they occur within square brackets.)
 
 This construction defines a cut.  The result value is \ttt{true} if the
 logical expression evaluates to \ttt{true} for all particles in the subevent
 in square brackets.  In the two-argument case it must be \ttt{true} for all
 non-overlapping combinations of particles in the two subevents.  If one of the
 arguments is the empty subevent, the result is also \ttt{true}.
 
 \subsubsection{any}
 \begin{quote}
 \begin{footnotesize}
   \ttt{any \textit{logical\_expr} [\textit{particles}]} \\
   \ttt{any \textit{logical\_expr} [\textit{particles\_1}, \textit{particles\_2}]}
 \end{footnotesize}
 \end{quote}
 The \ttt{any} construct is true if the logical expression is true for at least
 one particle or non-overlapping particle combination:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   any E > 100 GeV [photon]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This defines a trigger or selection condition.  If a subevent argument is
 empty, it evaluates to \ttt{false}
 
 \subsubsection{no}
 \begin{quote}
 \begin{footnotesize}
   \ttt{no \textit{logical\_expr} [\textit{particles}]} \\
   \ttt{no \textit{logical\_expr} [\textit{particles\_1}, \textit{particles\_2}]}
 \end{footnotesize}
 \end{quote}
 The \ttt{no} construct is true if the logical expression is true for no single
 one particle or non-overlapping particle combination:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   no 5 degree < Theta < 175 degree ["e-":"e+"]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This defines a veto condition.  If a subevent argument is empty, it
 evaluates to \ttt{true}.  It is equivalent to \ttt{not any\ldots}, but
 included for notational convenience.
 
 
 \subsection{More particle functions}
 
 \subsubsection{count}
 \begin{quote}
 \begin{footnotesize}
   \ttt{count [\textit{particles}]} \\
   \ttt{count [\textit{particles\_1}, \textit{particles\_2}]} \\
   \ttt{count if \textit{logical-expr} [\textit{particles}]} \\
   \ttt{count if \textit{logical-expr} [\textit{particles}, \textit{ref\_particles}]}
 \end{footnotesize}
 \end{quote}
 This counts the number of events in a subevent, the result is of type
 \ttt{int}.  If there is a conditional expression, it counts the number of
 \ttt{particle} in the subevent that pass the test.   If there are two
 arguments, it counts the number of non-overlapping particle pairs (that pass
 the test, if any).
 
 
 \subsubsection{Predefined observables}
 
 The following real-valued observables are available in \sindarin\ for use in
 \ttt{eval}, \ttt{all}, \ttt{any}, \ttt{no}, and \ttt{count} constructs.  The
 argument is always the subevent or alias enclosed in square brackets.
 \begin{itemize}
 \item \ttt{M2}
   \begin{itemize}
   \item One argument: Invariant mass squared of the (composite) particle in the
     argument.
   \item Two arguments: Invariant mass squared of the sum of the two momenta.
   \end{itemize}
 \item \ttt{M}
   \begin{itemize}
   \item Signed square root of \ttt{M2}: positive if $\ttt{M2}>0$, negative if
     $\ttt{M2}<0$.
   \end{itemize}
 \item \ttt{E}
   \begin{itemize}
   \item One argument: Energy of the (composite) particle in the argument.
   \item Two arguments: Sum of the energies of the two momenta.
   \end{itemize}
 \item \ttt{Px}, \ttt{Py}, \ttt{Pz}
   \begin{itemize}
   \item Like \ttt{E}, but returning the spatial momentum components.
   \end{itemize}
 \item \ttt{P}
   \begin{itemize}
   \item Like \ttt{E}, returning the absolute value of the spatial momentum.
   \end{itemize}
 \item \ttt{Pt}, \ttt{Pl}
   \begin{itemize}
   \item Like \ttt{E}, returning the transversal and longitudinal momentum,
     respectively.
   \end{itemize}
 \item \ttt{Theta}
   \begin{itemize}
   \item One argument: Absolute polar angle in the lab frame
   \item Two arguments: Angular distance of two particles in the lab frame.
   \end{itemize}
 \item \ttt{Theta\_star}
   Only with two arguments, gives the relative polar angle of the two momenta
   in the rest system of the momentum sum (i.e. mother particle).
 \item \ttt{Phi}
   \begin{itemize}
   \item One argument: Absolute azimuthal angle in the lab frame
   \item Two arguments: Azimuthal distance of two particles in the lab frame
   \end{itemize}
 \item \ttt{Rap}, \ttt{Eta}
   \begin{itemize}
   \item One argument: rapidity / pseudorapidity
   \item Two arguments: rapidity / pseudorapidity difference
   \end{itemize}
 \item \ttt{Dist}
   \begin{itemize}
   \item Two arguments: Distance on the $\eta$-$\phi$ cylinder, i.e.,
     $\sqrt{\Delta\eta^2 + \Delta\phi^2}$
   \end{itemize}
 \item \ttt{kT}
   \begin{itemize}
   \item Two arguments: $k_T$ jet clustering variable:
     $2 \min (E_{j1}^2, E_{j2}^2) / Q^2 \times (1 -
     \cos\theta_{j1,j2})$. At the moment, $Q^2 = 1$ GeV$^2$.
   \end{itemize}
 \end{itemize}
 There are also integer-valued observables:
 \begin{itemize}
 \item \ttt{PDG}
   \begin{itemize}
   \item One argument: PDG code of the particle.  For a composite particle, the
     code is undefined (value 0).
   \end{itemize}
 \item \ttt{Ncol}
   \begin{itemize}
   \item One argument: Number of open color lines.  Only count color
     lines, not anticolor lines.  This is defined only if the global flag
     \ttt{?colorize\_subevt} is true.
   \end{itemize}
 \item \ttt{Nacl}
   \begin{itemize}
   \item One argument: Number of open anticolor lines.  Only count anticolor
     lines, not color lines.  This is defined only if the global flag
     \ttt{?colorize\_subevt} is true.
   \end{itemize}
 \end{itemize}
 
 
 %%%%%%%%%%%%%%%
 
 \section{Physics Models}
 \label{sec:models}
 
 A physics model is a combination of particles, numerical parameters (masses,
 couplings, widths), and Feynman rules.  Many physics analyses are done in the
 context of the Standard Model (SM).  The SM is also the default model for
 \whizard.  Alternatively, you can choose a subset of the SM (QED or QCD),
 variants of the SM (e.g., with or without nontrivial CKM matrix), or various
 extensions of the SM.  The complete list is displayed in
 Table~\ref{tab:models}.
 
 The model definitions are contained in text files with filename extension
 \ttt{.mdl}, e.g., \ttt{SM.mdl}, which are located in the \ttt{share/models}
 subdirectory of the \whizard\ installation.  These files are easily readable,
 so if you need details of a model implementation, inspect their contents.  The
 model file contains the complete particle and parameter definitions as well as
 their default values.  It also contains a list of vertices.  This is used only
 for phase-space setup; the vertices used for generating amplitudes and the
 corresponding Feynman rules are stored in different files within the
 \oMega\ source tree.
 
 In a \sindarin\ script, a model is a special object of type \ttt{model}.  There
 is always a \emph{current} model.  Initially, this is the SM, so on startup
 \whizard\ reads the \ttt{SM.mdl} model file and assigns its content to the
 current model object.  (You can change the default model by the \ttt{--model}
 option on the command line. Also the preloading of a model can be
 switched off with the \ttt{--no-model} option)  Once the model has
 been loaded, you can define processes for the model, and you have all
 independent model parameters at your disposal.  As noted before, these
 are intrinsic parameters which need not be declared when you assign
 them a value, for instance:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   mW = 80.33 GeV
   wH = 243.1 MeV
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Other parameters are \emph{derived}.  They can be used in expressions like any
 other parameter, they are also intrinsic, but they cannot be modified directly
 at all.  For instance, the electromagnetic coupling \ttt{ee} is a derived
 parameter.  If you change either \ttt{GF} (the Fermi constant), \ttt{mW} (the
 $W$ mass), or \ttt{mZ} (the $Z$ mass), this parameter will reflect the change,
 but setting it directly is an error.  In other words, the SM is defined within
 \whizard\ in the $G_F$-$m_W$-$m_Z$ scheme.  (While this scheme is unusual for
 loop calculations, it is natural for a tree-level event generator where the
 $Z$ and $W$ poles have to be at their experimentally determined
 location\footnote{In future versions of \whizard\ it is foreseen to
   implement other electroweak schemes.}.)
 
 The model also defines the particle names and aliases that you can use for
 defining processes, cuts, or analyses.
 
 If you would like to generate a SUSY process instead, for instance, you can
 assign a different model (cf.\ Table~\ref{tab:models}) to the current model
 object:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   model = MSSM
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This assignment has the consequence that the list of SM parameters and
 particles is replaced by the corresponding MSSM list (which is much longer).
 The MSSM contains essentially all SM parameters by the same name, but in fact
 they are different parameters.  This is revealed when you say
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   model = SM
   mb = 5.0 GeV
   model = MSSM
   show (mb)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 After the model is reassigned, you will see the MSSM value of $m_b$ which
 still has its default value, not the one you have given.  However, if you
 revert to the SM later,
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   model = SM
   show (mb)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 you will see that your modification of the SM's $m_b$ value has been
 remembered.  If you want both mass values to agree, you have to set them
 separately in the context of their respective model.  Although this might seem
 cumbersome at first, it is nevertheless a sensible procedure since the
 parameters defined by the user might anyhow not be defined or available for
 all chosen models.
 
 When using two different models which need an SLHA input file,
 these {\em have} to be provided for both models.
 
 Within a given scope, there is only one current model.  The current model can
 be reset permanently as above.  It can also be temporarily be reset in a local
 scope, i.e., the option body of a command or the body of a \ttt{scan} loop.
 It is thus possible to use several models within the same script.  For
 instance, you may define a SUSY signal process and a pure-SM background
 process. Each process depends only on the respective model's parameter set,
 and a change to a parameter in one of the models affects only the
 corresponding process.
 
 
 \section{Processes}
 \label{sec:processes}
 
 The purpose of \whizard\ is the integration and simulation of high-energy
 physics processes: scatterings and decays.  Hence, \ttt{process} objects play
 the central role in \sindarin\ scripts.
 
 A \sindarin\ script may contain an arbitrary number of process definitions.  The
 initial states need not agree, and the processes may belong to different
 physics models.
 
 
 \subsection{Process definition}
 \label{sec:procdef}
 
 A process object is defined in a straightforward notation.  The definition
 syntax is straightforward:
 \begin{quote}
 \begin{footnotesize}
   \ttt{process \textit{process-id} = \textit{incoming-particles}} \verb|=>|
   \ttt{\textit{outgoing-particles}}
 \end{footnotesize}
 \end{quote}
 Here are typical examples:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   process w_pair_production = e1, E1 => "W+", "W-"
   process zdecay = Z => u, ubar
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Throughout the program, the process will be identified by its
 \textit{process-id}, so this is the name of the process object.  This
 identifier is arbitrary, chosen by the user.  It follows the rules for
 variable names, so it consists of alphanumeric characters and underscores,
 where the first character is not numeric.  As a special rule, it must not
 contain upper-case characters.  The reason is that this name is used for
 identifying the process not just within the script, but also within the
 \fortran\ code that the matrix-element generator produces for this process.
 
 After the equals sign, there follow the lists of incoming and outgoing
 particles.  The number of incoming particles is either one or two: scattering
 processes and decay processes.  The number of outgoing particles should be two
 or larger (as $2\to 1$ processes are proportional to a $\delta$
 function they can only be sensibly integrated when using a structure
 function like a hadron collider PDF or a beamstrahlung spectrum.).
 There is no hard upper limit; the complexity of processes that
 \whizard\ can handle depends only on the practical computing
 limitations (CPU time and memory).  Roughly speaking, one can assume
 that processes up to $2\to 6$ particles are safe, $2\to 8$ processes
 are feasible given sufficient time for reaching a stable integration,
 while more complicated processes are largely unexplored.
 
 We emphasize that in the default setup, the matrix element of a physics
 process is computed exactly in leading-order perturbation theory, i.e., at
 tree level.  There is no restriction of intermediate states, the result always
 contains the complete set of Feynman graphs that connect the initial with the
 final state.  If the result would actually be expanded in Feynman graphs
 (which is not done by the \oMega\ matrix element generator that
 \whizard\ uses), the number of graphs can easily reach several thousands,
 depending on the complexity of the process and on the physics model.
 
 More details about the different methods for quantum field-theoretical
 matrix elements can be found in Chap.~\ref{chap:hardint}. In the
 following, we will discuss particle names, options for processes like
 restrictions on intermediate states, parallelization, flavor sums and
 process components for inclusive event samples (process containers).
 
 
 \subsection{Particle names}
 
 The particle names are taken from the particle definition in the current model
 file.  Looking at the SM, for instance, the electron entry in
 \ttt{share/models/SM.mdl} reads
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 particle E_LEPTON 11
   spin 1/2  charge  -1   isospin -1/2
   name "e-" e1 electron e
   anti "e+" E1 positron
   tex_name "e^-"
   tex_anti "e^+"
   mass me
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This tells that you can identify an electron either as \verb|"e-"|, \verb|e1|,
 \verb|electron|, or simply \verb|e|.  The first version is used for output,
 but needs to be quoted, because otherwise \sindarin\ would interpret the minus
 sign as an operator.  (Technically, unquoted particle identifiers are aliases,
 while the quoted versions -- you can say either \verb|e1| or \verb|"e1"| --
 are names.  On input, this makes no difference.)  The alternative version
 \verb|e1| follows a convention, inherited from
 \comphep~\cite{Boos:2004kh}, that particles are indicated by lower
 case, antiparticles by upper case, and for leptons, the generation
 index is appended: \verb|e2| is the muon, \verb|e3| the tau.  These
 alternative names need not be quoted because they contain no special
 characters.
 
 In Table~\ref{tab:SM-particles}, we list the recommended names as well as
 mass and width parameters for all SM particles.  For other models, you may
 look up the names in the corresponding model file.
 
 \begin{table}[p]
   \begin{center}
     \begin{tabular}{|l|l|l|l|cc|}
       \hline
       & Particle & Output name & Alternative names & Mass & Width\\
       \hline\hline
       Leptons
       &$e^-$ & \verb|e-| & \ttt{e1}\quad\ttt{electron} & \ttt{me} & \\
       &$e^+$ & \verb|e+| & \ttt{E1}\quad\ttt{positron} & \ttt{me} & \\
       \hline
       &$\mu^-$ & \verb|mu-| & \ttt{e2}\quad\ttt{muon} & \ttt{mmu} & \\
       &$\mu^+$ & \verb|mu+| & \ttt{E2} & \ttt{mmu} & \\
       \hline
       &$\tau^-$ & \verb|tau-| & \ttt{e3}\quad\ttt{tauon} & \ttt{mtau} & \\
       &$\tau^+$ & \verb|tau+| & \ttt{E3} & \ttt{mtau} & \\
       \hline\hline
       Neutrinos
       &$\nu_e$ & \verb|nue| & \ttt{n1} & & \\
       &$\bar\nu_e$ & \verb|nuebar| & \ttt{N1} & & \\
       \hline
       &$\nu_\mu$ & \verb|numu| & \ttt{n2} & & \\
       &$\bar\nu_\mu$ & \verb|numubar| & \ttt{N2} & & \\
       \hline
       &$\nu_\tau$ & \verb|nutau| & \ttt{n3} & & \\
       &$\bar\nu_\tau$ & \verb|nutaubar| & \ttt{N3} & & \\
       \hline\hline
       Quarks
       &$d$ & \verb|d| & \ttt{down} & & \\
       &$\bar d$ & \verb|dbar| & \ttt{D} & & \\
       \hline
       &$u$ & \verb|u| & \ttt{up} & & \\
       &$\bar u$ & \verb|ubar| & \ttt{U} & & \\
       \hline
       &$s$ & \verb|s| & \ttt{strange} & \ttt{ms} & \\
       &$\bar s$ & \verb|sbar| & \ttt{S} & \ttt{ms}  & \\
       \hline
       &$c$ & \verb|c| & \ttt{charm} & \ttt{mc}  & \\
       &$\bar c$ & \verb|cbar| & \ttt{C} & \ttt{mc} & \\
       \hline
       &$b$ & \verb|b| & \ttt{bottom} & \ttt{mb} & \\
       &$\bar b$ & \verb|bbar| & \ttt{B} &  \ttt{mb} & \\
       \hline
       &$t$ & \verb|t| & \ttt{top} &  \ttt{mtop} & \ttt{wtop} \\
       &$\bar t$ & \verb|tbar| & \ttt{T} &  \ttt{mtop} & \ttt{wtop} \\
       \hline\hline
       Vector bosons
       &$g$ & \verb|gl| & \ttt{g}\quad\ttt{G}\quad\ttt{gluon} & & \\
       \hline
       &$\gamma$ & \verb|A| & \ttt{gamma}\quad\ttt{photon} & & \\
       \hline
       &$Z$ & \verb|Z| & & \ttt{mZ} & \ttt{wZ} \\
       \hline
       &$W^+$ & \verb|W+| & \ttt{Wp} & \ttt{mW} & \ttt{wW} \\
       &$W^-$ & \verb|W-| & \ttt{Wm} & \ttt{mW} & \ttt{wW} \\
       \hline\hline
       Scalar bosons
       &$H$ & \verb|H| & \ttt{h}\quad \ttt{Higgs} & \ttt{mH} & \ttt{wH} \\
       \hline
     \end{tabular}
   \end{center}
   \caption{\label{tab:SM-particles} Names that can be used for SM particles.
     Also shown are the intrinsic variables that can be used to set mass and
     width, if applicable.}
 \end{table}
 
 Where no mass or width parameters are listed in the table, the particle is
 assumed to be massless or stable, respectively.  This is obvious for particles
 such as the photon.  For neutrinos, the mass is meaningless to particle
 physics collider experiments, so it is zero.  For quarks, the $u$ or
 $d$ quark mass is unobservable directly, so we also set it zero.  For
 the heavier quarks, the mass may play a role, so it is kept.  (The $s$
 quark is borderline; one may argue that its mass is also unobservable
 directly.)  On the other hand, the electron mass is relevant, e.g., in
 photon radiation without cuts, so it is not zero by default.
 
 It pays off to set particle masses to zero, if the approximation is justified,
 since fewer helicity states will contribute to the matrix element.  Switching
 off one of the helicity states of an external fermion speeds up the
 calculation by a factor of two.  Therefore, script files will usually contain
 the assignments
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   me = 0  mmu = 0  ms = 0  mc = 0
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 unless they deal with processes where this simplification is
 phenomenologically unacceptable.  Often $m_\tau$ and $m_b$ can also be
 neglected, but this excludes processes where the Higgs couplings of $\tau$ or
 $b$ are relevant.
 
 Setting fermion masses to zero enables, furthermore, the possibility to define
 multi-flavor aliases
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   alias q = d:u:s:c
   alias Q = D:U:S:C
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 and handle processes such as
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   process two_jets_at_ilc = e1, E1 => q, Q
   process w_pairs_at_lhc = q, Q => Wp, Wm
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 where a sum over all allowed flavor combination is automatically included.
 For technical reasons, such flavor sums are possible only for massless
 particles (or more general for mass-degenerate particles). If you want
 to generate inclusive processes with sums over particles of different
 masses (e.g. summing over $W/Z$ in the final state etc.), confer below
 the section about process components, Sec.~\ref{sec:processcomp}.
 
 Assignments of masses, widths and other parameters are actually in effect when
 a process is integrated, not when it is defined.  So, these assignments may
 come before or after the process definition, with no significant difference.
 However, since flavor summation requires masses to be zero, the assignments
 may be put before the alias definition which is used in the process.
 
 The muon, tau, and the heavier quarks are actually unstable.  However, the
 width is set to zero because their decay is a macroscopic effect and, except for
 the muon, affected by hadron physics, so it is not described by \whizard.  (In
 the current \whizard\ setup, all decays occur at the production vertex.  A
 future version may describe hadronic physics and/or macroscopic particle
 propagation, and this restriction may be eventually removed.)
 
 
 
 
 \subsection{Options for processes}
 \label{sec:process options}
 
 The \ttt{process} definition may contain an optional argument:
 \begin{quote}
 \begin{footnotesize}
   \ttt{process \textit{process-id} = \textit{incoming-particles}} \verb|=>|
   \ttt{\textit{outgoing-particles}} \ttt{\{\textit{options\ldots}\}}
 \end{footnotesize}
 \end{quote}
 The \textit{options} are a \sindarin\ script that is executed in a context local
 to the \ttt{process} command.  The assignments it contains apply only to the
 process that is defined. In the following, we describe the set of potentially
 useful options (which all can be also set globally):
 
 \subsubsection{Model reassignment}
 
 It is possible to locally reassign the model via a  \ttt{model =} statment,
 permitting the definition of process using a model other than the globally
 selected model. The process will retain this association during
 integration and event generation.
 
 \subsubsection{Restrictions on matrix elements}
 \label{subsec:restrictions}
 
 Another useful option is the setting
 \begin{quote}
 \begin{footnotesize}
   \verb|$restrictions =| \ttt{\textit{string}}
 \end{footnotesize}
 \end{quote}
 This option allows to select particular classes of Feynman graphs for the
 process when using the \oMega\ matrix element generator.  The
 \verb|$restrictions| string specifies e.g. propagators that the graph
 must contain.  Here is an example:
 \begin{code}
   process zh_invis = e1, E1 => n1:n2:n3, N1:N2:N3, H { $restrictions = "1+2 ~ Z" }
 \end{code}
 The complete process $e^-e^+ \to \nu\bar\nu H$, summed over all neutrino
 generations,  contains both $ZH$ pair production (Higgs-strahlung) and
 $W^+W^-\to H$ fusion.  The restrictions string selects the Higgs-strahlung
 graph where the initial electrons combine to a $Z$ boson.  Here, the particles
 in the process are consecutively numbered, starting with the initial
 particles.  An alternative for the same selection would be
 \verb|$restrictions = "3+4 ~ Z"|.  Restrictions can be combined using
 \verb|&&|, for instance
 \begin{code}
   $restrictions = "1+2 ~ Z && 3 + 4 ~ Z"
 \end{code}
 which is redundant here, however.
 
 The restriction keeps the full energy dependence in the intermediate
 propagator, so the Breit-Wigner shape can be observed in distributions.  This
 breaks gauge invariance, in particular if the intermediate state is off shell,
 so you should use the feature only if you know the implications. For
 more details, cf. the Chap.~\ref{chap:hardint} and the \oMega\ manual.
 
 Other restrictions that can be combined with the restrictions above on
 intermediate propagators allow to exclude certain particles from
 intermediate propagators, or to exclude certain vertices from the
 matrix elements. For example,
 \begin{code}
   process eemm = e1, E1 => e2, E2  { $restrictions = "!A" }
 \end{code}
 would exclude all photon propagators from the matrix element and
 leaves only the $Z$ exchange here. In the same way,
 \verb|$restrictions = "!gl"| would exclude all gluon exchange. This
 exclusion of internal propagators works also for lists of particles,
 like
 \begin{code}
   $restrictions = "!Z:H"
 \end{code}
 excludes all $Z$ and $H$ propagators from the matrix elements.
 
 Besides excluding certain particles as internal lines, it is also
 possible to exclude certain vertices using the restriction command
 \begin{code}
   process eeww = e1, E1 => Wp, Wm  { $restrictions = "^[W+,W-,Z]" }
 \end{code}
 This would generate the matrix element for the production of two $W$
 bosons at LEP without the non-Abelian vertex $W^+W^-Z$. Again, these
 restrictions are able to work on lists, so
 \begin{code}
   $restrictions = "^[W+,W-,A:Z]"
 \end{code}
 would exclude all triple gauge boson vertices from the above process
 and leave only the $t$-channel neutrino exchange.
 
 It is also possible to exlude vertices by their coupling constants,
 e.g. the photon exchange in the process $e^+ e^- \to \mu^+ \mu^-$ can
 also be removed by the following restriction:
 \begin{code}
   $restrictions = "^qlep"
 \end{code}
 Here, \ttt{qlep} is the \fortran\ variable for the coupling constant
 of the electron-positron-photon vertex.
 
 \begin{table}
   \begin{center}
     \begin{tabular}{|l|l|}
       \hline
       \verb|3+4~Z| & external particles 3 and 4 must come from
       intermediate $Z$ \\\hline
       \verb| && |   & logical ``and'', e.g. in
       \verb| 3+5~t && 4+6~tbar| \\\hline
       \verb| !A | & exclude all $\gamma$ propagators \\\hline
       \verb| !e+:nue | & exclude a list of propagators, here $\gamma$,
       $\nu_e$ \\\hline
       \verb|^qlep:gnclep| & exclude all vertices with
       \ttt{qlep},\ttt{gnclep} coupling constants \\\hline
       \verb|^[A:Z,W+,W-]| & exclude all vertices $W^+W^-Z$,
       $W^+W^-\gamma$ \\\hline
       \verb|^c1:c2:c3[H,H,H]| & exclude all triple Higgs couplings
       with $c_i$ constants
       \\\hline
     \end{tabular}
   \end{center}
   \caption{List of possible restrictions that can be applied to
     \oMega\ matrix elements.}
   \label{tab:restrictions}
 \end{table}
 The Tab.~\ref{tab:restrictions} gives a list of options that can be
 applied to the \oMega\ matrix elements.
 
 
 \subsubsection{Other options}
 
 There are some further options that the \oMega\ matrix-element generator can
 take.  If desired, any string of options that is contained in this variable
 \begin{quote}
 \begin{footnotesize}
   \verb|$omega_flags =| \ttt{\textit{string}}
 \end{footnotesize}
 \end{quote}
 will be copied verbatim to the \oMega\ call, after all other options.
 
 One important application is the scheme of treating the width of unstable
 particles in the $t$-channel.  This is modified by the \verb|model:| class of
 \oMega\ options.
 
 It is well known that for some processes, e.g., single $W$ production from
 photon-$W$ fusion, gauge invariance puts constraints on the treatment of the
 unstable-particle width.  By default, \oMega\ puts a nonzero width in the $s$
 channel only.  This correctly represents the resummed Dyson series for the
 propagator, but it violates QED gauge invariance, although the effect is only
 visible if the cuts permit the photon to be almost on-shell.
 
 An alternative is
 \begin{quote}
 \begin{footnotesize}
   \verb|$omega_flags = "-model:fudged_width"|
 \end{footnotesize}
 \end{quote}
 which puts zero width in the matrix element, so that gauge cancellations
 hold, and reinstates the $s$-channel width in the appropriate places by an
 overall factor that multiplies the whole matrix element.
 
 Another possibility is
 \begin{quote}
 \begin{footnotesize}
   \verb|$omega_flags = "-model:constant_width"|
 \end{footnotesize}
 \end{quote}
 which puts the width both in the $s$ and in the $t$ channel everywhere.
 
 Note that both options apply only to charged unstable particles, such as the
 $W$ boson.
 
 
 \subsubsection{Multithreaded calculation of helicity sums via OpenMP}
 \label{sec:openmp}
 
 On multicore and / or multiprocessor systems, it is possible to speed
 up the calculation by using multiple threads to perform the helicity
 sum in the matrix element calculation. As the processing time used by
 \whizard\ is not used up solely in the matrix element, the speedup thus
 achieved varies greatly depending on the process under consideration;
 while simple processes without flavor sums do not profit significantly
 from this parallelization, the computation time for processes
 involving flavor sums with four or more particles in the final state
 is typically reduced by a factor between two and three when utilizing
 four parallel threads.
 
 The parallization is implemented using \ttt{OpenMP} and requires
 \whizard\ to be compiled with an \ttt{OpenMP} aware compiler and the
 appropiate compiler flags This is done in the configuration step, cf.\
 Sec.~\ref{sec:installation}.
 
 As with all \ttt{OpenMP} programs, the default number of threads used at
 runtime is up to the compiler runtime support and typically set to the
 number of independent hardware threads (cores / processors /
 hyperthreads) available in the system.  This default can be adjusted
 by setting the \ttt{OMP\_NUM\_THREADS} environment variable prior to
 calling WHIZARD.  Alternatively, the available number of threads can
 be reset anytime by the \sindarin\ parameter
 \ttt{openmp\_num\_threads}.  Note however that the total number of
 threads that can be sensibly used is limited by the number of
 nonvanishing helicity combinations.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Process components}
 \label{sec:processcomp}
 
 It was mentioned above that processes with flavor sums (in the initial
 or final state or both) have to be mass-degenerate (in most cases
 massless) in all particles that are summed over at a certain
 position. This condition is necessary in order to use the same
 phase-space parameterization and integration for the flavor-summed
 process. However, in many applications the user wants to handle
 inclusive process definitions, e.g. by defining inclusive decays,
 inclusive SUSY samples at hadron colliders (gluino pairs, squark
 pairs, gluino-squark associated production), or maybe lepton-inclusive
 samples where the tau and muon mass should be kept at different
 values. In \whizard\, from version v2.2.0 on, there is the possibility
 to define such inclusive process containers. The infrastructure for
 this feature is realized via so-called process components: processes
 are allowed to contain several process components. Those components
 need not be provided by the same matrix element generator,
 e.g. internal matrix elements, \oMega\ matrix elements, external
 matrix element (e.g. from a one-loop program, OLP) can be mixed. The
 very same infrastructure can also be used for next-to-leading order
 (NLO) calculations, containing the born with real emission, possible
 subtraction terms to make the several components infrared- and
 collinear finite, as well as the virtual corrections.
 
 Here, we want to discuss the use for inclusive particle samples. There
 are several options, the simplest of which to add up different final
 states by just using the \ttt{+} operator in \sindarin, e.g.:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
    process multi_comp = e1, E1 => (e2, E2) + (e3, E3) + (A, A)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 The brackets are not only used for a better grouping of the expressions,
 they are not mandatory for \whizard\ to interpret the sum
 correctly. When integrating, \whizard\ tells you that this a process
 with three different components:
 \begin{footnotesize}
 \begin{Verbatim}
 | Initializing integration for process multi_comp_1_p1:
 | ------------------------------------------------------------------------
 | Process [scattering]: 'multi_comp'
 |   Library name  = 'default_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'multi_comp_i1':   e-, e+ => m-, m+ [omega]
 |     2: 'multi_comp_i2':   e-, e+ => t-, t+ [omega]
 |     3: 'multi_comp_i3':   e-, e+ => A, A [omega]
 | ------------------------------------------------------------------------
 \end{Verbatim}
 \end{footnotesize}
 A different phase-space setup is used for each different
 component. The integration for each different component is performed
 separately, and displayed on screen. At the end, a sum of all
 components is shown. All files that depend on the components are being
 attached an \ttt{\_i{\em <n>}} where \ttt{{\em <n>}} is the number of
 the process component that appears in the list above: the \fortran\
 code for the matrix element, the \ttt{.phs} file for the phase space
 parameterization, and the grid files for the \vamp\ Monte-Carlo
 integration (or any other integration method). However, there will be
 only one event file for the inclusive process, into which a mixture of
 events according to the size of the individual process component cross
 section enter.
 
 More options are to specify additive lists of particles. \whizard\
 then expands the final states according to tensor product algebra:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
    process multi_tensor = e1, E1 => e2 + e3 + A, E2 + E3 + A
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This gives the same three process components as above, but \whizard\
 recognized that e.g. $e^- e^+ \to \mu^- \gamma$ is a vanishing
 process, hence the numbering is different:
 \begin{footnotesize}
 \begin{Verbatim}
 | Process component 'multi_tensor_i2': matrix element vanishes
 | Process component 'multi_tensor_i3': matrix element vanishes
 | Process component 'multi_tensor_i4': matrix element vanishes
 | Process component 'multi_tensor_i6': matrix element vanishes
 | Process component 'multi_tensor_i7': matrix element vanishes
 | Process component 'multi_tensor_i8': matrix element vanishes
 | ------------------------------------------------------------------------
 | Process [scattering]: 'multi_tensor'
 |   Library name  = 'default_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'multi_tensor_i1':   e-, e+ => m-, m+ [omega]
 |     5: 'multi_tensor_i5':   e-, e+ => t-, t+ [omega]
 |     9: 'multi_tensor_i9':   e-, e+ => A, A [omega]
 | ------------------------------------------------------------------------
 \end{Verbatim}
 \end{footnotesize}
 Identical copies of the same process that would be created by
 expanding the tensor product of final states are eliminated and appear
 only once in the final sum of process components.
 
 Naturally, inclusive process definitions are also available for
 decays:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 process multi_dec = Wp => E2 + E3, n2 + n3
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 This yields:
 \begin{footnotesize}
 \begin{Verbatim}
 | Process component 'multi_dec_i2': matrix element vanishes
 | Process component 'multi_dec_i3': matrix element vanishes
 | ------------------------------------------------------------------------
 | Process [decay]: 'multi_dec'
 |   Library name  = 'default_lib'
 |   Process index = 2
 |   Process components:
 |     1: 'multi_dec_i1':   W+ => mu+, numu [omega]
 |     4: 'multi_dec_i4':   W+ => tau+, nutau [omega]
 | ------------------------------------------------------------------------
 \end{Verbatim}
 \end{footnotesize}
 
 
 %%%%%%%%%%%%%%%
 
 \subsection{Compilation}
 \label{sec:compilation}
 
 Once processes have been set up, to make them available for integration they
 have to be compiled.  More precisely, the matrix-element generator
 \oMega\ (and it works similarly if a different matrix element method
 is chosen) is called to generate matrix element code, the compiler is
 called to transform this \fortran\ code into object files, and the
 linker is called to collect this in a dynamically loadable library.
 Finally, this library is linked to the program. From version v2.2.0 of
 \whizard\ this is no longer done by system calls of the OS but steered
 via process library Makefiles. Hence, the user can execute and
 manipulate those Makefiles in order to manually intervene in the
 particular steps, if he/she wants to do so.
 
 All this is done automatically when an \ttt{integrate}, \ttt{unstable}, or
 \ttt{simulate} command is encountered for the first time.  You may also force
 compilation explicitly by the command
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   compile
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 which performs all steps as listed above, including loading the generated
 library.
 
 The \fortran\ part of the compilation will be done using the \fortran\ compiler
 specified by the string variable
 \verb|$fc| and the compiler flags specified as \verb|$fcflags|.  The default
 settings are those that have been used for compiling \whizard\ itself during
 installation.  For library compatibility, you should stick to the compiler.
 The flags may be set differently.  They are applied in the compilation and
 loading steps, and they are processed by \ttt{libtool}, so
 \ttt{libtool}-specific flags can also be given.
 
 \whizard\ has some precautions against unnecessary repetitions.  Hence, when a
 \ttt{compile} command is executed (explicitly, or implicitly by the first
 integration), the program checks first whether the library is already loaded,
 and whether source code already exists for the requested processes.  If yes,
 this code is used and no calls to \oMega\ (or another matrix element
 method) or to the compiler are issued.
 Otherwise, it will detect any modification to the process configuration and
 regenerate the matrix element or recompile accordingly.  Thus, a \sindarin\
 script can be executed repeatedly without rebuilding everything from scratch,
 and you can safely add more processes to a script in a subsequent run without
 having to worry about the processes that have already been treated.
 
 This default behavior can be changed.  By setting
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   ?rebuild_library = true
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 code will be re-generated and re-compiled even if \whizard\ would think that
 this is unncessary.  The same effect is achieved by calling \whizard\ with a
 command-line switch,
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   /home/user$ whizard --rebuild_library
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 There are further \ttt{rebuild} switches which are described below.  If
 everything is to be rebuilt, you can set a master switch \ttt{?rebuild} or the
 command line option \verb|--rebuild|.  The latter can be abbreviated as a short
 command-line option:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   /home/user$ whizard -r
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Setting this switch is always a good idea when starting a new project, just in
 case some old files clutter the working directory.  When re-running the same
 script, possibly modified, the \verb|-r| switch should be omitted, so the
 existing files can be reused.
 
 
 
 \subsection{Process libraries}
 
 Processes are collected in \emph{libraries}.  A script may use more than one
 library, although for most applications a single library will probably be
 sufficient.
 
 The default library is \ttt{default\_lib}.  If you do not specify anything else,
 the processes you compile will be collected by a driver file
 \ttt{default\_lib.f90} which is compiled together with the process code and
 combined as a libtool archive \ttt{default\_lib.la}, which is dynamically linked
 to the running \whizard\ process.
 
 Once in a while, you work on several projects at once, and you didn't care
 about opening a new working directory for each.  If the \verb|-r| option is
 given, a new run will erase the existing library, which may contain processes
 needed for the other project.  You could omit \verb|-r|, so all processes will
 be collected in the same library (this does not hurt), but you may wish to
 cleanly separate the projects.  In that case, you should open a separate
 library for each project.
 
 Again, there are two possibilities.  You may start the script with the
 specification
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   library = "my_lhc_proc"
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 to open a library \verb|my_lhc_proc| in place of the default library.
 Repeating the command with different arguments, you may introduce several
 libraries in the script.  The active library is always the one specified
 last.  It is possible to issue this command locally, so a particular process
 goes into its own library.
 
 Alternatively, you may call \whizard\ with the option
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   /home/user$ whizard --library=my_lhc_proc
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 
 If several libraries are open simultaneously, the \ttt{compile} command will
 compile all libraries that the script has referenced so far.  If this is not
 intended, you may give the command an argument,
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   compile ("my_lhc_proc", "my_other_proc")
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 to compile only a specific subset.
 
 The command
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   show (library)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 will display the contents of the actually loaded library together with
 a status code which indicates the status of the library and the processes within.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Stand-alone \whizard\ with precompiled processes}
 \label{sec:static}
 
 Once you have set up a process library, it is straightforward to make a
 special stand-alone \whizard\ executable which will have this library
 preloaded on startup.  This is a matter of convenience, and it is also useful
 if you need a statically linked executable for reasons of profiling,
 batch processing, etc.
 
 For this task, there is a variant of the \ttt{compile} command:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   compile as "my_whizard" ()
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 which produces an executable \verb|my_whizard|.  You can omit the library
 argument if you simply want to include everything.  (Note that this command
 will \emph{not} load a library into the current process, it is intended for
 creating a separate program that will be started independently.)
 
 As an example, the script
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   process proc1 = e1, E1 => e1, E1
   process proc2 = e1, E1 => e2, E2
   process proc3 = e1, E1 => e3, E3
   compile as "whizard-leptons" ()
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 will make a new executable program \verb|whizard-leptons|.  This
 program behaves completely identical to vanilla \whizard, except for the fact
 that the processes \ttt{proc1}, \ttt{proc2}, and \ttt{proc3} are available
 without configuring them or loading any library.
 
 % This feature is particularly useful when compiling with the \ttt{-static}
 % flag.  As long as the architecture is compatible, the resulting binary may be
 % run on a different computer where no \whizard\ libraries are present.  (The
 % program will still need to find its model files, however.)
 
 
 
 \section{Beams}
 \label{sec:beams}
 
 Before processes can be integrated and simulated, the program has to know
 about the collider properties.  They can be specified by the \ttt{beams}
 statement.
 
 In the command script, it is irrelevant whether a \ttt{beams} statement comes
 before or after process specification.  The \ttt{integrate} or \ttt{simulate}
 commands will use the \ttt{beams} statement that was issued last.
 
 
 \subsection{Beam setup}
 \label{sec:beam-setup}
 
 If the beams have no special properties, and the colliding particles are the
 incoming particles in the process themselves, there is no need for a
 \ttt{beams} statement at all.  You only \emph{must} specify the
 center-of-momentum energy of the collider by setting the value of $\sqrt{s}$,
 for instance
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   sqrts = 14 TeV
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 The \ttt{beams} statement comes into play if
 \begin{itemize}
 \item
   the beams have nontrivial structure, e.g., parton structure in hadron
   collision or photon radiation in lepton collision, or
 \item
   the beams have non-standard properties: polarization, asymmetry, crossing
   angle.
 \end{itemize}
 Note that some of the abovementioned beam properties had not yet been
 reimplemented in the \whizard\ttt{2} release series. From version
 v2.2.0 on all options of the legacy series \whizard\ttt{1} are
 available again. From version v2.1 to version v2.2 of \whizard\ there
 has also been a change in possible options to the \ttt{beams}
 statement: in the early versions of \whizard\ttt{2} (v2.0/v2.1), local
 options could be specified within the beam settings, e.g. \ttt{beams =
 p, p { sqrts = 14 TeV } => pdf\_builtin}. These possibility has been
 abandoned from version v2.2 on, and the \ttt{beams} command does not
 allow for {\em any} optional arguments any more.
 
 Hence, beam parameters can -- with the exception of the specification
 of structure functions -- be specified only globally:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   sqrts = 14 TeV
   beams = p, p => lhapdf
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 It does not make any difference whether the value of \ttt{sqrts} is
 set before or after the \ttt{beams} statement, the last value found
 before an \ttt{integrate} or \ttt{simulate} is the relevant one. This
 in particularly allows to specify the beam structure, and then after
 that perform a loop or scan over beam energies, beam parameters, or
 structure function settings.
 
 The \ttt{beams} statement also applies to particle decay processes, where there
 is only a single beam.  Here, it is usually redundant because no structure
 functions are possible, and the energy is fixed to the decaying particle's
 mass.  However, it is needed for computing polarized decay, e.g.
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   beams = Z
   beams_pol_density = @(0)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 where for a boson at rest, the polarization axis is defined to be the $z$
 axis.
 
 Beam polarization is described in detail below in Sec.~\ref{sec:polarization}.
 
 Note also that future versions of \whizard\ might give support for
 single-beam events, where structure functions for single particles
 indeed do make sense.
 
 In the following sections we list the available options for structure
 functions or spectra inside \whizard\ and explain their usage. More
 about the physics of the implemented structure functions can be found
 in Chap.~\ref{chap:hardint}.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Asymmetric beams and Crossing angles}
 \label{sec:asymmetricbeams}
 
 \whizard\ not only allows symmetric beam collisions, but basically
 arbitrary collider setups. In the case there are two different beam
 energies, the command
 \begin{quote}
 \begin{footnotesize}
   \ttt{beams\_momentum = {\em <beam\_mom1>}, {\em <beam\_mom2>}}
 \end{footnotesize}
 \end{quote}
 allows to specify the momentum (or as well energies for massless
 particles) for the beams. Note that for scattering processes both
 values for the beams must be present. So the following to setups for
 14 TeV LHC proton-proton collisions are equivalent:
 \begin{quote}
 \begin{footnotesize}
   \ttt{beams = p, p => pdf\_builtin} \newline
   \ttt{sqrts = 14 TeV}
 \end{footnotesize}
 \end{quote}
 and
 \begin{quote}
 \begin{footnotesize}
   \ttt{beams = p, p => pdf\_builtin} \newline
   \ttt{beams\_momentum = 7 TeV, 7 TeV}
 \end{footnotesize}
 \end{quote}
 Asymmetric setups can be set by using different values for the two
 beam momenta, e.g. in a HERA setup:
 \begin{quote}
 \begin{footnotesize}
   \ttt{beams = e, p => none, pdf\_builtin}
   \ttt{beams\_momentum = 27.5 GeV, 920 GeV}
 \end{footnotesize}
 \end{quote}
 or for the BELLE experiment at the KEKB accelerator:
 \begin{quote}
 \begin{footnotesize}
   \ttt{beams = e1, E1}
   \ttt{beams\_momentum = 8 GeV, 3.5 GeV}
 \end{footnotesize}
 \end{quote}
 \whizard\ lets you know about the beam structure and calculates for
 you that the center of mass energy corresponds to 10.58 GeV:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 | Beam structure: e-, e+
 |   momentum = 8.000000000000E+00, 3.500000000000E+00
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 1.058300530253E+01 GeV
 | Beam structure: lab and c.m. frame differ
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 
 It is also possible to specify beams for decaying particles, where
 \ttt{beams\_momentum} then only has a single argument, e.g.:
 \begin{quote}
 \begin{footnotesize}
   \ttt{process zee = Z => "e-", "e+"} \\
   \ttt{beams = Z} \\
   \ttt{beams\_momentum = 500 GeV} \\
   \ttt{simulate (zee) \{ n\_events = 100 \} }
 \end{footnotesize}
 \end{quote}
 This would corresponds to a beam of $Z$ bosons with a momentum of 500
 GeV. Note, however, that \whizard\ will always do the integration of
 the particle width in the particle's rest frame, while the moving beam
 is then only taken into account for the frame of reference for the
 simulation.
 
 Further options then simply having different beam energies describe a
 non-vanishing between the two incoming beams. Such concepts are quite
 common e.g. for linear colliders to improve the beam properties in the
 collimation region at the beam interaction points. Such crossing
 angles can be specified in the beam setup, too, using the
 \ttt{beams\_theta} command:
 \begin{quote}
 \begin{footnotesize}
   \ttt{beams = e1, E1} \\
   \ttt{beams\_momentum = 500 GeV, 500 GeV} \\
   \ttt{beams\_theta = 0, 10 degree}
 \end{footnotesize}
 \end{quote}
 It is important that when a crossing angle is being specified, and the
 collision system consequently never is the center-of-momentum system,
 the beam momenta have to explicitly set. Besides a planar crossing
 angle, one is even able to rotate an azimuthal distance:
 \begin{quote}
 \begin{footnotesize}
   \ttt{beams = e1, E1} \\
   \ttt{beams\_momentum = 500 GeV, 500 GeV} \\
   \ttt{beams\_theta = 0, 10 degree} \\
   \ttt{beams\_phi = 0, 45 degree}
 \end{footnotesize}
 \end{quote}
 
 %%%%%%%%%%%%%%%
 
 \subsection{LHAPDF}
 \label{sec:lhapdf}
 
 For incoming hadron beams, the \ttt{beams} statement specifies which structure
 functions are used.  The simplest example is the study of parton-parton
 scattering processes at a hadron-hadron collider such as LHC or Tevatron.  The
 \lhapdf\ structure function set is selected by a syntax similar to the
 process setup, namely the example already shown above:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   beams = p, p => lhapdf
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Note that there are slight differences in using the \lhapdf\ release
 series 6 and the older \fortran\ \lhapdf\ release series 5, at least
 concerning the naming conventions for the PDF sets~\footnote{Until
   \whizard\ version 2.2.1 including, only the \lhapdf\ series 5 was
   supported, while from version 2.2.2 on also the \lhapdf\ release
   series 6 has been supported.}. The above \ttt{beams}
 statement selects a default \lhapdf\ structure-function set for both
 proton beams (which is the \ttt{CT10} central set for \lhapdf\ 6, and
 \ttt{cteq6ll.LHpdf} central set for \lhapdf 5).  The structure
 function will apply for all quarks, antiquarks, and the gluon as far
 as supported by the particular \lhapdf\ set.  Choosing a different set
 is done by adding the  filename as a local option to the \ttt{lhapdf}
 keyword:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   beams = p, p => lhapdf
   $lhapdf_file = "MSTW2008lo68cl"
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 for the actual \lhapdf\ 6 series, and
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   beams = p, p => lhapdf
   $lhapdf_file = "MSTW2008lo68cl.LHgrid"
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 for \lhapdf 5.Similarly, a member within the set is selected by the
 numeric variable \verb|lhapdf_member| (for both release series of \lhapdf).
 
 In some cases, different structure functions have to be chosen for the two
 beams.  For instance, we may look at $ep$ collisions:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   beams = "e-", p => none, lhapdf
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Here, there is a list of two independent structure functions (each with its
 own option set, if applicable) which applies to the two beams.
 
 Another mixed case is $p\gamma$ collisions, where the photon is to be
 resolved as a hadron.  The simple assignment
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   beams = p, gamma => lhapdf, lhapdf_photon
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 will be understood as follows: \whizard\ selects the appropriate default
 structure functions (here we are using \lhapdf\ 5 as an example as the
 support of photon and pion PDFs in \lhapdf\ 6 has been dropped),
 \ttt{cteq6ll.LHpdf} for the proton and
 \ttt{GSG960.LHgrid} for the photon.  The photon case has an additional
 integer-valued parameter \verb|lhapdf_photon_scheme|.  (There are also pion
 structure functions available.)  For modifying the default, you have to
 specify separate structure functions
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   beams = p, gamma => lhapdf, lhapdf_photon
   $lhapdf_file = ...
   $lhapdf_photon_file = ...
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Finally, the scattering of elementary photons on partons is described by
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   beams = p, gamma => lhapdf, none
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 
 Note that for \lhapdf\ version 5.7.1 or higher and for PDF sets which
 support it, photons can be used as partons.
 
 There is one more option for the \lhapdf\ PDFs, namely to specify the
 path where the \lhapdf\ PDF sets reside: this is done with the string
 variable \ttt{\$lhapdf\_dir = "{\em <path-to-lhapdf>}"}. Usually, it
 is not necessary to set this because \whizard\ detects this path via
 the \ttt{lhapdf-config} script during configuration, but in the case
 paths have been moved, or special files/special locations are to be
 used, the user can specify this location explicitly.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Built-in PDFs}
 \label{sec:built-in-pdf}
 
 In addition to the possibility of linking against \lhapdf, \whizard\
 comes with a couple of built-in PDFs which are selected via the
 \verb?pdf_builtin? keyword
 %
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   beams = p, p => pdf_builtin
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 %
 
 The default PDF set is CTEQ6L, but other choices are also available by
 setting the string variable \verb?$pdf_builtin_set? to an
 appropiate value. E.g, modifying the above
 setup to
 %
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   beams = p, p => pdf_builtin
   $pdf_builtin_set = "mrst2004qedp"
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 %
 would select the proton PDF from the MRST2004QED set. A list of all currently
 available PDFs can be found in Table~\ref{tab:pdfs}.
 %
 \begin{table}
 \centerline{\begin{tabular}{|l||l|p{0.2\textwidth}|l|}
 \hline
 Tag & Name & Notes & References \\\hline\hline
 %
 \ttt{cteq6l} & CTEQ6L & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Pumplin:2002vw} \\\hline
 \ttt{cteq6l1} & CTEQ6L1 & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Pumplin:2002vw} \\\hline
 \ttt{cteq6d} & CTEQ6D & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Pumplin:2002vw} \\\hline
 \ttt{cteq6m} & CTEQ6M & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Pumplin:2002vw} \\\hline
 \hline
 \ttt{mrst2004qedp} & MRST2004QED (proton) & includes photon &
    \cite{Martin:2004dh} \\\hline
 \hline
 \ttt{mrst2004qedn} & MRST2004QED (neutron) & includes photon &
    \cite{Martin:2004dh} \\\hline
 \hline
 \ttt{mstw2008lo} & MSTW2008LO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Martin:2009iq} \\\hline
 \ttt{mstw2008nlo} & MSTW2008NLO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Martin:2009iq} \\\hline
 \ttt{mstw2008nnlo} & MSTW2008NNLO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Martin:2009iq} \\\hline
 \hline
 \ttt{ct10} & CT10 & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Lai:2010vv} \\\hline
 \hline
 \ttt{CJ12\_max} & CJ12\_max & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Owens:2012bv} \\\hline
 \ttt{CJ12\_mid} & CJ12\_mid & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Owens:2012bv} \\\hline
 \ttt{CJ12\_min} & CJ12\_min & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Owens:2012bv} \\\hline
 \hline
 \ttt{CJ15LO} & CJ15LO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Accardi:2016qay} \\\hline
 \ttt{CJ15NLO} & CJ15NLO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Accardi:2016qay} \\\hline
 \hline
 \ttt{mmht2014lo} & MMHT2014LO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Harland-Lang:2014zoa} \\\hline
 \ttt{mmht2014nlo} & MMHT2014NLO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Harland-Lang:2014zoa} \\\hline
 \ttt{mmht2014nnlo} & MMHT2014NNLO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Harland-Lang:2014zoa} \\\hline
 \hline
 \ttt{CT14LL} & CT14LLO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Dulat:2015mca} \\\hline
 \ttt{CT14L} & CT14LO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Dulat:2015mca} \\\hline
 \ttt{CT14N} & CT1414NLO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Dulat:2015mca} \\\hline
 \ttt{CT14NN} & CT14NNLO & \mbox{}\hfill---\hfill\mbox{} &
    \cite{Dulat:2015mca} \\\hline
 \hline
 %
 \end{tabular}}
 \caption{All PDF sets available as builtin sets. The two MRST2004QED
   sets also contain a photon.}
 \label{tab:pdfs}
 \end{table}
 
 The two MRST2004QED sets also contain the photon as a parton, which
 can be used in the same way as for \lhapdf\ from v5.7.1 on. Note,
 however, that there is no builtin PDF that contains a photon structure
 function. There is a \ttt{beams} structure function specifier
 \ttt{pdf\_builtin\_photon}, but at the moment this throws an error. It
 just has been implemented for the case that in future versions of
 \whizard\ a photon structure function might be included.
 
 Note that in general only the data sets for the central values of the
 different PDFs ship with \whizard. Using the error sets is possible,
 i.e. it is supported in the syntax of the code, but you have to
 download the corresponding data sets from the web pages of the PDF
 fitting collaborations.
 
 %%%%%%%%%%%%%%%
 
 \subsection{HOPPET $b$ parton matching}
 
 When the \hoppet\ tool~\cite{Salam:2008qg} for hadron-collider PDF
 structure functions and their manipulations are
 correctly linked to \whizard, it can be used for advanced
 calculations and simulations of hadron collider physics. Its main
 usage inside \whizard\ is for matching schemes between 4-flavor and
 5-flavor schemes in $b$-parton initiated processes at hadron
 colliders. Note that in versions 2.2.0 and 2.2.1 it only worked
 together with \lhapdf\ version 5, while with the \lhapdf\ version 6
 interface from version 2.2.2 on it can be used also with the modern
 version of PDFs from \lhapdf. Furthermore, from version 2.2.2, the
 \hoppet\ $b$ parton matching also works for the builtin PDFs.
 
 It depends on the corresponding process and the energy scales involved
 whether it is a better description to use the
 $g\to b\bar b$ splitting from the DGLAP evolution inside the PDF and
 just take the $b$ parton content of a PDF, e.g. in BSM Higgs
 production for large $\tan\beta$: $pp \to H$ with a partonic
 subprocess $b\bar b \to H$, or directly take the gluon PDFs and use
 $pp \to b\bar b H$ with a partonic subprocess $gg \to b \bar b
 H$. Elaborate schemes for a proper matching between the two
 prescriptions have been developed and have been incorporated into the
 \hoppet\ interface.
 
 Another prime example for using these matching schemes is single top
 production at hadron colliders. Let us consider the following setup:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 process proc1 = b, u => t, d
 process proc2 = u, b => t, d
 process proc3 = g, u => t, d, B	{ $restrictions = "2+4 ~ W+" }
 process proc4 = u, g => t, d, B	{ $restrictions = "1+4 ~ W+" }
 
 beams = p,p => pdf_builtin
 sqrts = 14 TeV
 ?hoppet_b_matching = true
 
 $sample = "single_top_matched"
 luminosity = 1 / 1 fbarn
 simulate (proc1, proc2, proc3, proc4)
 \end{Verbatim}
 \end{footnotesize}%$
 \end{quote}
 The first two processes are single top production from $b$ PDFs, the
 last two processes contain an explicit $g\to b\bar b$ splitting (the
 restriction, cf. Sec.~\ref{sec:process options} has been placed in
 order to single out the single top production signal process). PDFs
 are then chosen from the default builtin PDF (which is \ttt{CTEQ6L}),
 and the \hoppet\ matching routines are switched on by the flag
 \ttt{?hoppet\_b\_matching}.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Lepton Collider ISR structure functions}
 \label{sec:lepton_isr}
 
 Initial state QED radiation off leptons is an important feature at all
 kinds of lepton colliders: the radiative return to the $Z$ resonance
 by ISR radiation was in fact the largest higher-order effect for the
 SLC and LEP I colliders. The soft-collinear and soft photon radiation
 can indeed be resummed/exponentiated to all orders in perturbation
 theory~\cite{Gribov:1972rt}, while higher orders in hard-collinear
 photons have to be explicitly calculated order by
 order~\cite{Kuraev:1985hb,Skrzypek:1990qs}. \whizard\ has an intrinsic
 implementation of the lepton ISR structure function that includes all
 orders of soft and soft-collinear photons as well as up to the third
 order in hard-collinear photons. It can be switched on by the
 following statement:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 beams = e1, E1 => isr
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 As the ISR structure function is a single-beam structure function,
 this expression is synonymous for
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 beams = e1, E1 => isr, isr
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 The ISR structure function can again be applied to only one of the two
 beams, e.g. in a HERA-like setup:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 beams = e1, p => isr, pdf_builtin
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 
 Their are several options for the lepton-collider ISR structure
 function that are summarized in the following:
 
 \vspace{2mm}
 
 \centerline{\begin{tabular}{|l|l|l|}\hline
 Parameter & Default & Meaning \\\hline\hline
 \ttt{isr\_alpha} & \ttt{0}/intrinsic & value of $\alpha_{QED}$ for ISR
 \\\hline
 \ttt{isr\_order} & \ttt{3} & max. order of hard-collinear photon
 emission \\\hline
 \ttt{isr\_mass} & \ttt{0}/intrinsic & mass of the radiating lepton  \\\hline
 \ttt{isr\_q\_max} & \ttt{0}/$\sqrt{s}$ & upper cutoff for ISR \\\hline
 \hline
 \ttt{?isr\_recoil} & \ttt{false} & flag to switch on recoil/$p_T$
 (\emph{deprecated})\\\hline
 \ttt{?isr\_keep\_energy} & \ttt{false} & recoil flag: conserve
 energy in splitting (\emph{deprecated})
 \\\hline
 \end{tabular}}\mbox{}
 
 The maximal order of the hard-collinear photon emission taken into
 account by \whizard\ is set by the integer variable \ttt{isr\_order};
 the default is the maximally available order of three. With the
 variable \ttt{isr\_alpha}, the value of the QED coupling constant
 $\alpha_{QED}$ used in the ISR structure function can be set. The
 default is taken from the active physics model. The mass of the
 radiating lepton (in most cases the electron) is set by
 \ttt{isr\_mass}; again the default is taken from the active physics
 model. Furthermore, the upper integration border for the ISR structure
 function which acts roughly as an upper hardness cutoff for the emitted
 photons, can be set through \ttt{isr\_q\_max}; if not set, the
 collider energy (possibly after beamstrahlung,
 cf. Sec.~\ref{sec:beamstrahlung}) $\sqrt{s}$ (or $\sqrt{\widehat{s}}$)
 is taken.  Note that \whizard\ accounts for the
 exclusive effects of ISR radiation at the moment by a single (hard,
 resolved) photon in the event; a more realistic treatment of exclusive
 ISR photons in simulation is foreseen for a future version.
 
 While the ISR structure function is evaluated in the collinear limit,
 it is possible to generate transverse momentum for both the radiated
 photons and the recoiling partonic system.  We recommend to stick to
 the collinear approximation for the integration step.  Integration
 cuts should be set up such that they do not significantly depend on
 photon transverse momentum.  In a subsequent simulation step, it is
 possible to transform the events with collinear ISR radiation into
 more realistic events with non-collinear radiation.  To this end,
 \whizard\ provides a separate ISR photon handler which can be
 activated in the simulation step.  The algorithm operates on the
 partonic event: it takes the radiated photons and the partons entering
 the hard process, and applies a $p_T$ distribution to those particles
 and their interaction products, i.e., all outgoing particles.  Cuts
 that depend on photon $p_T$ may be applied to the modified events.
 For details on the ISR photon handler,
 cf.\ Sec.~\ref{sec:isr-photon-handler}.
 
 {\footnotesize The flag \ttt{?isr\_recoil} switches on $p_T$ recoil of
   the emitting lepton against photon radiation during integration; per
   default it is off.  The flag \ttt{?isr\_keep\_energy} controls the
   mode of on-shell projection for the splitting process with $p_T$.
   Note that this feature is kept for backwards compatibility, but
   should not be used for new simulations.  The reason is as follows:
   For a fraction of events, $p_T$ will become significant, and (i)
   energy/momentum non-conservation, applied to both beams separately,
   can lead to unexpected and unphysical effects, and (ii) the modified
   momenta enter the hard process, so the collinear approximation used
   in the ISR structure function computation does not hold.  }
 
 %%%%%%%%%%%%%%%
 
 \subsection{Lepton Collider Beamstrahlung}
 \label{sec:beamstrahlung}
 
 At linear lepton colliders, the macroscopic electromagnetic
 interaction of the bunches leads to a distortion of the spectrum of
 the bunches that is important for an exact simulation of the beam
 spectrum. There are several methods to account for these effects. The
 most important tool to simulate classical beam-beam interactions in
 lepton-collider physics is
 \ttt{GuineaPig++}~\cite{Schulte:1998au,Schulte:1999tx,Schulte:2007zz}. A
 direct interface between this tool \ttt{GuineaPig++} and \whizard\ had
 existed as an inofficial add-on to the legacy branch \whizard\ttt{1},
 but is no longer applicable in \whizard\ttt{2}. A \whizard-internal
 interface is foreseen for the very near future, most probably within
 this v2.2 release. Other options are to use parameterizations of the
 beam spectrum that have been included in the package \circeone~\cite{CIRCE}
 which has been interfaced to \whizard\ since version v1.20 and been
 included in the \whizard\ttt{2} release series. Another option is to
 generate a beam spectrum externally and then read it in as an ASCII
 data file, cf. Sec.~\ref{sec:beamevents}. More about this can be found
 in a dedicated section on lepton collider spectra,
 Sec.~\ref{sec:beamspectra}.
 
 In this section, we discuss the usage of beamstrahlung spectra by
 means of the \circeone\ package. The beamstrahlung spectra are
 true spectra, so they have to be applied to pairs of beams, and an
 application to only one beam is meaningless. They are switched on by
 this \ttt{beams} statement including structure functions:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 beams = e1, E1 => circe1
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 It is important to note that the parameterization of the beamstrahlung
 spectra within \circeone\ contain also processes where $e\to\gamma$
 conversions have been taking place, i.e. also hard processes with one
 (or two) initial photons can be simulated with beamstrahlung switched
 on. In that case, the explicit photon flags, \ttt{?circe1\_photon1}
 and \ttt{?circe1\_photon2}, for the two beams have to be properly set,
 e.g. (ordering in the final state does not play a role):
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 process proc1 = A, e1 => A, e1
 sqrts = 500 GeV
 beams = e1, E1 => circe1
 ?circe1_photon1 = true
 integrate (proc1)
 
 process proc2 = e1, A => A, e1
 sqrts = 1000 GeV
 beams = e1, A => circe1
 ?circe1_photon2 = true
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 or
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 process proc1 = A, A => Wp, Wm
 sqrts = 200 GeV
 beams = e1, E1 => circe1
 ?circe1_photon1 = true
 ?circe1_photon2 = true
 ?circe1_generate = false
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 In all cases (one or both beams with photon conversion) the beam
 spectrum applies to both beams simultaneously.
 
 In the last example ($\gamma\gamma\to W^+W^-$) the default
 \circeone\ generator mode was turned off by unsetting
 \verb|?circe1_generate|.  In the other examples this flag is
 set, by default.  For standard use cases,
 \circeone\ implements a beam-event generator inside the
 \whizard\ generator, which provides beam-event samples with correctly
 distributed probability.  For electrons, the beamstrahlung spectrum
 sharply peaks near maximum energy.  This distribution is most
 efficiently handled by the generator mode.  By contrast, in the $\gamma\gamma$
 mode, the beam-event c.m.\ energy is concentrated at low values.  For
 final states with low invariant mass, which are typically produced by
 beamstrahlung photons, the generator mode is appropriate.
 However, the $W^+W^-$ system requires substantial energy, and such
 events will be very rare in the beam-event sample.  Switching off the
 \circeone\ generator mode solves this
 problem.
 
 This is an overview over all options and flags for the \circeone\
 setup for lepton collider beamstrahlung:
 
 \vspace{2mm}
 
 \centerline{\begin{tabular}{|l|l|l|}\hline
 Parameter & Default & Meaning \\\hline\hline
 \ttt{?circe1\_photon1} & \ttt{false} & $e\to\gamma$ conversion for beam 1
 \\\hline
 \ttt{?circe1\_photon2} & \ttt{false} & $e\to\gamma$ conversion for beam 2
 \\\hline
 \ttt{circe1\_sqrts} & $\sqrt{s}$ & collider energy for the beam spectrum  \\\hline
 \ttt{?circe1\_generate} & \ttt{true} & flag for the \circeone\ generator mode \\\hline
 \ttt{?circe1\_map} & \ttt{true} & flag to apply special phase-space mapping
 \\\hline
 \ttt{circe1\_mapping\_slope} & \ttt{2.} & value of PS mapping exponent
 \\\hline
 \ttt{circe1\_eps} & \ttt{1E-5} & parameter for mapping of spectrum peak
 position \\\hline
 \ttt{circe1\_ver} & \ttt{0} & internal version of \circeone\ package
 \\\hline
 \ttt{circe1\_rev} & \ttt{0}/most recent & internal revision of
 \circeone\ \\\hline
 \ttt{\$circe1\_acc} & \ttt{SBAND} & accelerator type \\\hline
 \ttt{circe1\_chat} & \ttt{0} & chattiness/verbosity of \circeone \\\hline
 \end{tabular}}\mbox{}
 
 The collider energy relevant for the beamstrahlung spectrum is set by
 \ttt{circe1\_sqrts}. As a default, this is always the value of
 \ttt{sqrts} set in the \sindarin\ script. However, sometimes these
 values do not match, e.g. the user wants to simulate $t\bar t h$ at
 \ttt{sqrts = 550 GeV}, but the only available beam spectrum is for 500
 GeV. In that case, \ttt{circe1\_sqrts = 500 GeV} has to be set to use
 the closest possible available beam spectrum.
 
 As mentioned in the discussion of the examples above, in
 \circeone\ there are two options to use the beam spectra for
 beamstrahlung: intrinsic semi-analytic approximation formulae for the
 spectra, or a Monte-Carlo sampling of the sampling. The second
 possibility always give a better description of the spectra, and is
 the default for \whizard. It can, however, be switched off by setting
 the flag \ttt{?circe1\_generate} to \ttt{false}.
 
 As the beamstrahlung spectra are sharply peaked at the collider
 energy, but still having long tails, a mapping of the spectra for an
 efficient phase-space sampling is almost mandatory. This is the
 default in \whizard, which can be changed by the flag
 \ttt{?circe1\_map}. Also, the default exponent for the mapping can be
 changed from its default value \ttt{2.} with the variable
 \ttt{circe1\_mapping\_slope}. It is important to efficiently sample
 the peak position of the spectrum; the effective ratio of the peak to
 the whole sampling interval can be set by the parameter
 \ttt{circe1\_eps}. The integer parameter \ttt{circe1\_chat} sets the
 chattiness or verbosity of the \circeone\ package, i.e. how many
 messages and warnings from the beamstrahlung generation/sampling will
 be issued.
 
 The actual internal version and revision of the \circeone\ package are
 set by the two integer parameters \ttt{circe1\_ver} and
 \ttt{circe1\_rev}. The default is in any case always the newest
 version and revision, while older versions are still kept for
 backwards compatibility and regression testing.
 
 Finally, the geometry and design of the accelerator type is set with
 the string variable \ttt{\$circe1\_acc}: it contains the possible
 options for the old \ttt{"SBAND"} and \ttt{"XBAND"} setups, as well as
 the \ttt{"TESLA"} and JLC/NLC SLAC design \ttt{"JLCNLC"}. The setups
 for the most important energies of the ILC as they are summarized in
 the ILC
 TDR~\cite{Behnke:2013xla,Baer:2013cma,Adolphsen:2013jya,Adolphsen:2013kya}
 are available as \ttt{ILC}. Beam spectra for the
 CLIC~\cite{Aicheler:2012bya,Lebrun:2012hj,Linssen:2012hp} linear
 collider are much more demanding to correctly simulate (due to the
 drive beam concept; only the low-energy modes where the drive beam is
 off can be simulated with the same setup as the abovementioned
 machines). Their setup will be supported soon in one of the upcoming
 \whizard\ versions within the \circetwo\ package.
 
 An example of how to generate beamstrahlung spectra with the help of
 the package \circetwo\ (that is also a part of \whizard) is this:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 process eemm = e1, E1 => e2, E2
 sqrts = 500 GeV
 beams = e1, E1 => circe2
 $circe2_file = "ilc500.circe"
 $circe2_design = "ILC"
 ?circe_polarized = false
 \end{Verbatim}
 \end{footnotesize}%$
 \end{quote}
 Here, the ILC design is used for a beamstrahlung spectrum at 500 GeV
 nominal energy, with polarization averaged (hence, the setting of
 polarization to \ttt{false}). A list of all available options can be
 found in Sec.~\ref{sec:photoncoll}.
 
 More technical details about the simulation of beamstrahlung spectra
 see the documented source code of the \circeone\ package, as well as
 Chap.~\ref{chap:hardint}. In the next section, we discuss how to read
 in beam spectra from external files.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Beam events}
 \label{sec:beamevents}
 
 As mentioned in the previous section, beamstrahlung is one of the
 crucial ingredients for a realistic simulation of linear lepton
 colliders. One option is to take a pre-generated beam spectrum for
 such a machine, and make it available for simulation within \whizard\
 as an external ASCII data file. Such files basically contain only
 pairs of energy fractions of the nominal collider energy $\sqrt{s}$
 ($x$ values). In \whizard\ they can be used in simulation with the
 following \ttt{beams} statement:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 beams = e1, E1 => beam_events
 $beam_events_file = "<beam_spectrum_file>"
 \end{Verbatim}
 \end{footnotesize}%$
 \end{quote}
 Note that beam spectra must always be pair spectra, i.e. they are
 automatically applied to both beam simultaneously.
 Beam spectra via external files are expected to reside in the current
 working directory. Alternatively, \whizard\ searches for them in the
 install directory of \whizard\ in \ttt{share/beam-sim}. There you can
 find an example file, \ttt{uniform\_spread\_2.5\%.dat} for such a beam
 spectrum. The only possible parameter that can be set is the flag
 \ttt{?beam\_events\_warn\_eof} whose default is \ttt{true}. This
 triggers the issuing of a warning when the end of file of an external
 beam spectrum file is reached. In such a case, \whizard\ starts to
 reuse the same file again from the beginning. If the available data
 points in the beam events file are not big enough, this could result
 in an insufficient sampling of the beam spectrum.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Gaussian beam-energy spread}
 \label{sec:gaussian}
 
 Real beams have a small energy spread.  If beamstrahlung is small, the spread
 may be approximately described as Gaussian.  As a replacement for the full
 simulation that underlies \ttt{CIRCE2} spectra, it is possible to
 impose a Gaussian distributed beam energy, separately for each beam.
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 beams = e1, E1 => gaussian
 gaussian_spread_1 = 0.1\%
 gaussian_spread_2 = 0.2\%
 \end{Verbatim}
 \end{footnotesize}%$
 \end{quote}
 (Note that the \% sign means multiplication by 0.01, as it should.)  The
 spread values are defined as the $\sigma$ value of the Gaussian distribution,
 i.e., $2/3$ of the events are within $\pm 1\sigma$ for each beam,
 respectively.
 
 %%%%%%%%%%%%%%%%
 
 \subsection{Equivalent photon approximation}
 \label{sec:epa}
 
 The equivalent photon approximation (EPA) uses an on-shell approximation for
 the $e \to e\gamma$ collinear splitting to allow the simulation of
 photon-induced backgrounds in lepton collider physics. The original
 concept is that of the Weizs\"acker-Williams
 approximation~\cite{vonWeizsacker:1934sx,Williams:1934ad,Budnev:1974de}. This
 is a single-beam structure
 function that can be applied to both beams, or also to one beam
 only. Examples are:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 beams = e1, E1 => epa
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 or for a single beam:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 beams = e1, p => epa, pdf_builtin
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 The last process allows the reaction of (quasi-) on-shell photons with
 protons.
 
 In the following, we collect the parameters and flags that can be
 adjusted when using the EPA inside \whizard:
 
 \vspace{2mm}
 
 \centerline{\begin{tabular}{|l|l|l|}\hline
 Parameter & Default & Meaning \\\hline\hline
 \ttt{epa\_alpha} & \ttt{0}/intrinsic & value of $\alpha_{QED}$ for EPA
 \\\hline
 \ttt{epa\_x\_min} & \ttt{0.} & soft photon cutoff in $x$ (mandatory)
 \\\hline
 \ttt{epa\_q\_min} & \ttt{0.} & minimal $\gamma$ momentum transfer \\\hline
 \ttt{epa\_mass} & \ttt{0}/intrinsic & mass of the radiating fermion (mandatory)  \\\hline
 \ttt{epa\_q\_max} & \ttt{0}/$\sqrt{s}$ & upper cutoff for EPA \\\hline
 \ttt{?epa\_recoil} & \ttt{false} & flag to switch on recoil/$p_T$
 \\\hline
 \ttt{?epa\_keep\_energy} & \ttt{false} & recoil flag to conserve
 energy in splitting
 \\\hline
 \end{tabular}}\mbox{}
 
 The adjustable parameters are partially similar to the parameters in
 the QED initial-state radiation (ISR), cf. Sec.~\ref{sec:lepton_isr}:
 the parameter \ttt{epa\_alpha} sets the value of the electromagnetic
 coupling constant, $\alpha_{QED}$ used in the EPA structure
 function. If not set, this is taken from the value inside the active
 physics model. The same is true for the mass of the particle that
 radiates the photon of the hard interaction, which can be reset by the
 user with the variable \ttt{epa\_mass}. There are two dimensionful
 scale parameters, the minimal momentum transfer to the photon,
 \ttt{epa\_q\_min}, which must not be zero, and the upper momentum-transfer
 cutoff
 for the EPA structure function, \ttt{epa\_q\_max}. The default for the
 latter value is the collider energy, $\sqrt{s}$, or the energy reduced
 by another structure function like e.g. beamstrahlung,
 $\sqrt{\hat{s}}$. Furthermore, there is a soft-photon regulator for
 the splitting function in $x$ space, \ttt{epa\_x\_min}, which also has
 to be explicitly set different from zero. Hence, a minimal viable
 scenario that will be accepted by \whizard\ looks like this:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 beams = e1, E1 => epa
 epa_q_min = 5 GeV
 epa_x_min = 0.01
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 
 Finally, like the ISR case in Sec.~\ref{sec:lepton_isr}, there is a
 flag to consider the recoil of the photon against the radiating
 electron by setting \ttt{?epa\_recoil} to \ttt{true} (default:
 \ttt{false}).
 
 Though in principle processes like $e^+ e^- \to e^+ e^- \gamma \gamma$
 where the two photons have been created almost collinearly and then
 initiate a hard process could be described by exact matrix elements
 and exact kinematics. However, the numerical stability in the very far
 collinear kinematics is rather challenging, such that the use of the
 EPA is very often an acceptable trade-off between quality of the
 description on the one hand and numerical stability and speed on the
 other hand.
 
 In the case, the EPA is set after a second structure function like a
 hadron collider PDF, there is a flavor summation over the quark
 constituents inside the proton, which are then the radiating fermions
 for the EPA. Here, the masses of all fermions have to be identical.
 
 More about the physics of the equivalent photon approximation can be
 found in Chap.~\ref{chap:hardint}.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Effective $W$ approximation}
 \label{sec:ewa}
 
 An approach similar to the equivalent photon approximation (EPA)
 discussed in the previous section Sec.~\ref{sec:epa}, is the usage
 of a collinear splitting function for the radiation of massive
 electroweak vector bosons $W$/$Z$, the effective $W$ approximation
 (EWA). It has been developed for the
 description of high-energy weak vector-boson fusion and scattering
 processes at hadron colliders, particularly the Superconducting
 Super-Collider (SSC). This was at a time when the simulation of $2\to
 4$ processes war still very challenging and $2\to 6$ processes almost
 impossible, such that this approximation was the only viable solution
 for the simulation of processes like $pp \to jjVV$ and subsequent
 decays of the bosons $V \equiv W, Z$.
 
 Unlike the EPA, the EWA is much more involved as the structure
 functions do depend on the isospin of the radiating fermions, and are
 also different for transversal and longitudinal polarizations. Also, a
 truely collinear kinematics is never possible due to the finite $W$
 and $Z$ boson masses, which start becoming more and more negligible
 for energies larger than the nominal LHC energy of 14 TeV.
 
 Though in principle all processes for which the EWA might be
 applicable are technically feasible in \whizard\ to be generated also
 via full matrix elements, the EWA has been implemented in \whizard\
 for testing purposes, backwards compatibility and comparison with
 older simulations. Like the EPA, it is a single-beam structure
 function that can be applied to one or both beams. We only give an
 example for both beams here, this is for a 3 TeV CLIC collider:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 sqrts = 3 TeV
 beams = e1, E1 => ewa
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 And this is for LHC or a higher-energy follow-up collider (which also
 shows the concatenation of the single-beam structure functions,
 applied to both beams consecutively,
 cf. Sec.~\ref{sec:concatenation}:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 sqrts = 14 TeV
 beams = p, p => pdf_builtin => ewa
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 
 Again, we list all the options, parameters and flags that can be
 adapted for the EWA:
 
 \vspace{2mm}
 
 \centerline{\begin{tabular}{|l|l|l|}\hline
 Parameter & Default & Meaning \\\hline\hline
 \ttt{ewa\_x\_min} & \ttt{0.} & soft $W$/$Z$ cutoff in $x$ (mandatory)
 \\\hline
 \ttt{ewa\_mass} & \ttt{0}/intrinsic & mass of the radiating fermion  \\\hline
 \ttt{ewa\_pt\_max} & \ttt{0}/$\sqrt{\hat{s}}$ & upper cutoff for EWA \\\hline
 \ttt{?ewa\_recoil} & \ttt{false} & recoil switch
 \\\hline
 \ttt{?ewa\_keep\_energy} & \ttt{false} & energy conservation for
 recoil in splitting
 \\\hline
 \end{tabular}}\mbox{}
 
 First of all, all coupling constants are taken from the active physics
 model as they have to be consistent with electroweak gauge
 invariance. Like for EPA, there is a soft $x$ cutoff for the $f \to f
 V$ splitting, \ttt{ewa\_x\_min}, that has to be set different from
 zero by the user. Again, the mass of the radiating fermion can be set
 explicitly by the user; and, also again, the masses for the flavor sum
 of quarks after a PDF as radiators of the electroweak bosons have to
 be identical. Also for the EWA, there is an upper cutoff for the $p_T$
 of the electroweak boson, that can be set via
 \ttt{eta\_pt\_max}. Indeed, the transversal $W$/$Z$ structure function
 is logarithmically divergent in that variable. If it is not set by the
 user, it is estimated from $\sqrt{s}$ and the splitting kinematics.
 
 For the EWA, there is a flag to switch on a recoil for the
 electroweak boson against the radiating fermion,
 \ttt{?ewa\_recoil}. Note that this is an experimental feature that is
 not completely tested. In any case, the non-collinear kinematics
 violates 4-four momentum conservation, so there are two choices:
 either to conserve the energy (\ttt{?ewa\_keep\_energy = true}) or to
 conserve 3-momentum (\ttt{?ewa\_keep\_energy = false}). Momentum
 conservation for the kinematics is the default. This is due to the
 fact that for energy conservation, there will be a net total momentum
 in the event including the beam remnants (ISR/EPA/EWA radiated
 particles) that leeds to unexpected or unphysical features in the
 energy distributions of the beam remnants recoiling against the rest
 of the event.
 
 More details about the physics can be found in
 Chap.~\ref{chap:hardint}.
 
 
 %%%%%%%%%%%%%%%
 
 \subsection{Energy scans using structure functions}
 
 In \whizard, there is an implementation of a pair spectrum,
 \ttt{energy\_scan}, that allows to scan the energy dependence of a
 cross section without actually scanning over the collider
 energies. Instead, only a single integration at the upper end of the
 scan interval over the process with an additional pair spectrum
 structure function performed. The structure function is chosen
 in such a way, that the distribution of $x$ values of the energy scan
 pair spectrum translates in a plot over the energy of the final state
 in an energy scan from \ttt{0} to \ttt{sqrts} for the process under
 consideration.
 
 The simplest example is the $1/s$ fall-off with the $Z$ resonance in
 $e^+e^- \to \mu^+ \mu^-$, where the syntax is very easy:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 process eemm = e1, E1 => e2, E2
 sqrts = 500 GeV
 cuts = sqrts_hat > 50
 beams = e1, E1 => energy_scan
 integrate (eemm)
 \end{Verbatim}
 \end{footnotesize}
 \end{quote}
 The value of \ttt{sqrts = 500 GeV} gives the upper limit for the scan,
 while the cut effectively let the scan start at 50 GeV. There are no
 adjustable parameters for this structure function. How to plot the
 invariant mass distribution of the final-state muon pair to show the
 energy scan over the cross section, will be explained in
 Sec.~\ref{sec:analysis}.
 
 More details can be found in Chap.~\ref{chap:hardint}.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Photon collider spectra}
 \label{sec:photoncoll}
 
 One option that has been discussed as an alternative possibility for a
 high-energy linear lepton collider is to convert the electron and
 positron beam via Compton backscattering off intense laser beams into
 photon
 beams~\cite{Ginzburg:1981vm,Telnov:1989sd,Telnov:1995hc}. Naturally,
 due to the production
 of the photon beams and the inherent electron spectrum, the photon
 beams have a characteristic spectrum. The simulation of such spectra
 is possible within \whizard\ by means of the subpackage \circetwo,
 which have been mentioned already in Sec.~\ref{sec:beamstrahlung}. It
 allows to give a much more elaborate description of a linear lepton
 collider environment than
 \circeone\ (which, however, is not in all cases necessary, as the ILC
 beamspectra for electron/positrons can be perfectly well described
 with \circeone).
 
 Here is a typical photon collider setup where we take a
 photon-initiated process:
 \begin{quote}
 \begin{footnotesize}
 \begin{Verbatim}
 process aaww = A, A => Wp, Wm
 
 beams = A, A => circe2
 $circe2_file = "teslagg_500_polavg.circe"
 $circe2_design = "TESLA/GG"
 ?circe2_polarized = false
 \end{Verbatim}
 \end{footnotesize}%$
 \end{quote}
 
 Here, the photons are the initial states initiating the hard
 scattering. The structure function is \ttt{circe2} which always is a
 pair spectrum. The list of available options are:
 
 \vspace{2mm}
 
 \centerline{\begin{tabular}{|l|l|l|}\hline
 Parameter & Default & Meaning \\\hline\hline
 \ttt{?circe2\_polarized} & \ttt{true} & spectrum respects polarization info
 \\\hline
 \ttt{\$circe2\_file} & -- & name of beam spectrum data file
 \\\hline
 \ttt{\$circe2\_design} & \ttt{"*"} & collider design
 \\\hline
 \end{tabular}}\mbox{}
 
 The only logical flag \ttt{?circe2\_polarized} let \whizard\ know
 whether it should keep polarization information in the beam spectra or
 average over polarizations. Naturally, because of the Compton
 backscattering generation of the photons, photon spectra are always
 polarized. The collider design can be specified by the string variable
 \ttt{\$circe2\_design}, where the default setting \ttt{"*"}
 corresponds to the default of \circetwo\ (which is the TESLA 500 GeV
 machine as discussed in the TESLA Technical Design
 Report~\cite{AguilarSaavedra:2001rg,Richard:2001qm}). Note that up to
 now there have not been any setups for a photon collider option for
 the modern linear collider concepts like ILC and CLIC. The string
 variable \ttt{\$circe2\_file} then allows to give the name of the file
 containing the actual beam spectrum; all files that ship with
 \whizard\ are stored in the directory \ttt{circe2/share/data}.
 
 More details about the subpackage \circetwo\ and the physics it
 covers, can be found in its own manual and the chapter
 Chap.~\ref{chap:hardint}.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Concatenation of several structure functions}
 \label{sec:concatenation}
 
 As has been shown already in Sec.~\ref{sec:epa} and
 Sec.~\ref{sec:ewa}, it is possible within \whizard\ to concatenate
 more than one structure function, irrespective of the fact, whether
 the structure functions are single-beam structure functions or pair
 spectra. One important thing is whether there is a phase-space mapping
 for these structure functions. Also, there are some combinations which
 do not make sense from the physics point of view, for example using
 lepton-collider ISR for protons, and then afterwards switching on
 PDFs. Such combinations will be vetoed by \whizard, and you will find
 an error message like (cf. also Sec.~\ref{sec:errors}):
 \begin{interaction}
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR: Beam structure: [....] not supported
 ******************************************************************************
 ******************************************************************************
 \end{interaction}
 
 Common examples for the concatenation of structure functions are
 linear collider applications, where beamstrahlung (macroscopic
 electromagnetic beam-beam interactions) and electron QED initial-state
 radiation are both switched on:
 \begin{code}
 beams = e1, E1 => circe1 => isr
 \end{code}
 Another possibility is the simulation of photon-induced backgrounds at
 ILC or CLIC, using beamstrahlung and equivalent photon approximation
 (EPA):
 \begin{code}
 beams = e1, E1 => circe1 => epa
 \end{code}
 or with beam events from a data file:
 \begin{code}
 beams = e1, E1 => beam_events => isr
 \end{code}
 
 In hadron collider physics, parton distribution functions (PDFs) are
 basically always switched on, while afterwards the user could specify
 to use the effective $W$ approximation (EWA) to simulate high-energy
 vector boson scattering:
 \begin{code}
 sqrts = 100 TeV
 beams = p, p => pdf_builtin => ewa
 \end{code}
 Note that this last case involves a flavor sum over the five active
 quark (and anti-quark) species $u$, $d$, $c$, $s$, $b$ in the proton,
 all of which act as radiators for the electroweak vector bosons in the
 EWA.
 
 This would be an example with three structure functions:
 \begin{code}
 beams = e1, E1 => circe1 => isr => epa
 \end{code}
 
 %%%%%%%%%%%%%%%
 
 \section{Polarization}
 \label{sec:polarization}
 
 %%%%%
 
 \subsection{Initial state polarization}
 \label{sec:initialpolarization}
 
 \whizard\ supports polarizing the inital state fully or partially by
 assigning a nontrivial density matrix in helicity space.
 Initial state polarization requires a beam setup and is initialized by
 means of the \ttt{beams\_pol\_density} statement\footnote{Note that
   the syntax for the specification of beam polarization has changed
   from version v2.1 to v2.2 and is incompatible between the two
   release series. The old syntax \ttt{beam\_polarization} with its
   different polarization constructors has been discarded in favor of a
   unified syntax.}:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 beams_pol_density = @([<spin entries>]), @([<spin entries>])
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 The command \ttt{beams\_pol\_fraction} gives the degree of
 polarization of the two beams:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 beams_pol_fraction = <degree beam 1>, <degree beam 2>
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Both commands in the form written above apply to scattering processes,
 where the polarization of both beams must be specified. The
 \ttt{beams\_pol\_density} and \ttt{beams\_pol\_fraction} are possible
 with a single beam declaration if a decay process is considered, but
 only then.
 
 While the syntax for the command \ttt{beams\_pol\_fraction} is pretty
 obvious, the syntax for the actual specification of the beam
 polarization is more intricate. We start with the polarization
 fraction: for each beam there is a real number between zero
 (unpolarized) and one (complete polarization) that can be specified
 either as a floating point number like \ttt{0.4} or with a percentage:
 \ttt{40 \%}. Note that the actual arithmetics is sometimes
 counterintuitive: 80 \% left-handed electron polarization means that
 80 \% of the electron beam are polarized, 20 \% are unpolarized,
 i.e. 20 \% have half left- and half right-handed polarization
 each. Hence, 90 \% of the electron beam is left-handed, 10 \% is
 right-handed.
 
 How does the specification of the polarization work? If there are no
 entries at all in the polarization constructor, \ttt{@()}, the beam is
 unpolarized, and the spin density matrix is proportional to the
 unit/identity matrix. Placing entries into the \ttt{@()} constructor
 follows the concept of sparse matrices, i.e. the entries that have
 been specified will be present, while the rest remains zero. Single
 numbers do specify entries for that particular helicity on the main
 diagonal of the spin density matrix, e.g. for an electron \ttt{@(-1)}
 means (100\%) left-handed polarization. Different entries are
 separated by commas: \ttt{@(1,-1)} sets the two diagonal entries at
 positions $(1,1)$ and $(-1,-1)$ in the density matrix both equal to
 one. Two remarks are in order
 already here. First, note that you do not have to worry about the
 correct normalization of the spin density matrix, \whizard\ is taking
 care of this automatically. Second, in the screen output for the beam
 data, only those entries of the spin density matrix that have been
 specified by the user, will be displayed. If a
 \ttt{beams\_pol\_fraction} statement appears, other components will be
 non-zero, but might not be shown. E.g. ILC-like, 80 \% polarization of
 the electrons, 30 \% positron polarization will be specified like this
 for left-handed electrons and right-handed positrons:
 \begin{code}
 beams = e1, E1
 beams_pol_density = @(-1), @(+1)
 beams_pol_fraction = 80%, 30%
 \end{code}
 The screen output will be like this:
 \begin{code}
 | ------------------------------------------------------------------------
 | 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 = 0.0000000E+00 GeV)  polarized
 |   e+   (mass = 0.0000000E+00 GeV)  polarized
 \end{code}
 But because of the fraction of unpolarized electrons and positrons,
 the spin density matrices for electrons and positrons are:
 \[
 \rho(e^-) = \diag \left ( 0.10, 0.90 \right) \qquad
 \rho(e^+) = \diag \left ( 0.65, 0.35 \right) \quad ,
 \]
 respectively. So, in general, only the entries due to the polarized
 fraction will be displayed on screen. We will come back to more
 examples below.
 
 Again, the setting of a single entry, e.g. \ttt{@($\pm m$)}, which
 always sets the diagonal component $(\pm m, \pm m)$ of the spin
 density matrix equal to one. Here $m$ can have the following values
 for the different spins (in parentheses are entries that exist only
 for massive particles):
 
 \vspace{1mm}
 
 \begin{center}
 \begin{tabular}{|l|l|l|}\hline
   Spin $j$ & Particle type & possible $m$ values \\\hline
   0   & Scalar boson           & 0 \\
   1/2 & Spinor                 & +1, -1 \\
   1   & (Massive) Vector boson & +1, (0), -1 \\
   3/2 & (Massive) Vectorspinor & +2, (+1), (-1), -2 \\
   2   & (Massive) Tensor       & +2, (+1), (0), (-1), -2
   \\\hline
 \end{tabular}
 \end{center}
 
 \vspace{1mm}
 
 Off-diagonal entries that are equal to one (up to the normalization)
 of the spin-density matrix can be specified simply by the position,
 namely: \ttt{@($m$:$m'$, $m''$)}. This would result in a spin density
 matrix with diagonal entry $1$ for the position $(m'', m'')$, and an entry
 of $1$ for the off-diagonal position $(m,m')$.
 
 Furthermore, entries in the density matrix different from $1$ with a
 numerical value \ttt{{\em <val>}} can be
 specified, separated by another colon: \ttt{@($m$:$m'$:{\em
 <val>})}. Here, it does not matter whether $m$ and $m'$ are different
 or not. For $m = m'$ also diagonal spin density matrix entries
 different from one can be specified. Note that because spin density
 matrices have to be Hermitian, only the entry $(m,m')$ has to be set,
 while the complex conjugate entry at the transposed position $(m',m)$
 is set automatically by \whizard.
 
 We will give some general density
 matrices now, and after that a few more definite examples. In the
 general setups below, we always give the expression for the spin
 density matrix only for one single beam.
 %
 {
 
 \newcommand{\cssparse}[4]{%
 \begin{pmatrix}
   #1     & 0      & \cdots & \cdots & #3     \\
   0      & 0      & \ddots &        & 0      \\
   \vdots & \ddots & \ddots & \ddots & \vdots \\
   0      &        & \ddots & 0      & 0      \\
   #4     & \cdots & \cdots & 0      & #2
 \end{pmatrix}%
 }
 %
 
 \begin{itemize}
 \item {\bf Unpolarized:}
   \begin{center}
     \begin{footnotesize}
     \ttt{beams\_pol\_density = @()}
     \end{footnotesize}
   \end{center}
 % \newline
 This has the same effect as not specifying any
 polarization at all and is the only constructor available for scalars and
 fermions declared as left- or right-handed (like the neutrino). Density matrix:
 \[ \rho = \frac{1}{|m|}\mathbb{I} \]
 ($|m|$: particle multiplicity which is 2 for massless, $2j + 1$ for massive particles).
 %
 \item {\bf Circular polarization:}
   \begin{center}
     \begin{footnotesize}
     \ttt{beams\_pol\_density = @($\pm j$) \qquad beams\_pol\_fraction
       = $f$}
     \end{footnotesize}
   \end{center}
 A fraction $f$ (parameter range $f \in \left[0\;;\;1\right]$) of
 the particles are in the maximum / minimum helicity eigenstate $\pm
 j$, the remainder is unpolarized. For spin $\frac{1}{2}$ and massless
 particles of spin $>0$, only the maximal / minimal entries of the
 density matrix are populated, and the density matrix looks like this:
 \[ \rho = \diag\left(\frac{1\pm f}{2}\;,\;0\;,\;\dots\;,\;0\;,
 \frac{1\mp f}{2}\right) \]
 %
 \item {\bf Longitudinal polarization (massive):}
   \begin{center}
     \begin{footnotesize}
     \ttt{beams\_pol\_density = @(0) \qquad beams\_pol\_fraction = $f$}
     \end{footnotesize}
   \end{center}
 We consider massive particles with maximal spin component $j$, a
 fraction $f$ of which having longitudinal polarization, the remainder
 is unpolarized. Longitudinal polarization is (obviously) only
 available for massive bosons of spin $>0$. Again, the parameter range
 for the fraction is: $f \in \left[0\;;\;1\right]$. The density matrix
 has the form:
 \[ \rho = \diag\left(\frac{1-f}{|m|}\;,\;\dots\;,\;\frac{1-f}{|m|}\;,\;
 \frac{1+f \left(|m| - 1\right)}{|m|}\;,\;\frac{1-f}{|m|}\;,
 \;\dots\;,\;\frac{1-f}{|m|}\right)
 \]
 ($|m| = 2j+1 $: particle multiplicity)
 %
 \item {\bf Transverse polarization (along an axis):}
   \begin{center}
     \begin{footnotesize}
     \ttt{beams\_pol\_density = @(j, -j, j:-j:exp(-I*phi)) \qquad
       beams\_pol\_fraction = $f$}
     \end{footnotesize}
   \end{center}
 This so called transverse polarization is a polarization along an
 arbitrary direction in the $x-y$ plane, with $\phi=0$ being the positive
 $x$ direction and $\phi=90^\circ$ the positive $y$ direction. Note that
 the value of \ttt{phi} has either to be set inside the beam
 polarization expression explicitly or by a statement \ttt{real phi =
   {\em val} degree} before. A fraction $f$ of the particles are
 polarized, the remainder is unpolarized. Note that, although
 this yields a valid density matrix for all particles with multiplicity
 $>1$ (in which the only the highest and lowest helicity states are
 populated), it is meaningful only for spin $\frac{1}{2}$ particles and
 massless bosons of spin $>0$. The range of the parameters are:
 $f \in \left[0\;;\;1\right]$ and $\phi \in \mathbb{R}$. This yields a
 density matrix:
 \[ \rho =
 \cssparse{1}{1}
    {\frac{f}{2}\,e^{-i\phi}} {\frac{f}{2}\,e^{i\phi}} \]
 (for antiparticles, the matrix is conjugated).
 %
 \item {\bf Polarization along arbitrary axis $\left(\theta, \phi\right)$:}
   \begin{center}
     \begin{footnotesize}
     \ttt{beams\_pol\_density = @(j:j:1-cos(theta),
       j:-j:sin(theta)*exp(-I*phi), -j:-j:1+cos(theta))} \qquad\quad\qquad
     \ttt{beams\_pol\_fraction = $f$}
     \end{footnotesize}
   \end{center}
 This example describes polarization along an arbitrary axis in polar
 coordinates (polar axis in positive $z$ direction, polar angle
 $\theta$, azimuthal angle $\phi$). A fraction $f$ of the particles are
 polarized, the remainder is unpolarized. Note that, although axis
 polarization defines a valid density matrix for all particles with
 multiplicity $>1$, it is meaningful only for particles with spin
 $\frac{1}{2}$. Valid ranges for the parameters are $f \in
 \left[0\;;\;1\right]$, $\theta \in \mathbb{R}$, $\phi \in
 \mathbb{R}$. The density matrix then has the form:
 \[ \rho = \frac{1}{2}\cdot
 \cssparse{1 - f\cos\theta}{1 + f\cos\theta}
    {f\sin\theta\, e^{-i\phi}}{f\sin\theta\, e^{i\phi}}
 \]
 %
 \item {\bf Diagonal density matrix:}
   \begin{center}
     \begin{footnotesize}
     \ttt{beams\_pol\_density = @(j:j:$h_j$, j-1:j-1:$h_{j-1}$,
       $\ldots$, -j:-j:$h_{-j}$)}
     \end{footnotesize}
   \end{center}
 This defines an arbitrary diagonal density matrix with entries
 $\rho_{j,j}\,,\,\dots\,,\,\rho_{-j,-j}$.
 %
 \item {\bf Arbitrary density matrix:}
   \begin{center}
     \begin{footnotesize}
     \ttt{beams\_pol\_density = @($\{m:m':x_{m,m'}\}$)}:
     \end{footnotesize}
   \end{center}
 Here, \ttt{$\{m:m':x_{m,m'}\}$} denotes a selection of entries at
 various positions somewhere in the spin density matrix. \whizard\
 will check whether this is a valid spin density matrix, but it does
 e.g. not have to correspond to a pure state.
 %
 \end{itemize}
 }
 %
 
 The beam polarization statements can be used both globally directly
 with the \ttt{beams} specification, or locally inside the
 \ttt{integrate} or \ttt{simulate} command. Some more specific examples
 are in order to show how initial state polarization works:
 %
 \begin{itemize}
 \item
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 beams = A, A
 beams_pol_density = @(+1),  @(1, -1, 1:-1:-I)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This declares the initial state to be composed of two incoming
 photons, where the first photon is right-handed, and the second photon
 has transverse polarization in $y$ direction.
 %
 \item
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 beams = A, A
 beams_pol_density = @(+1),  @(1, -1, 1:-1:-1)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Same as before, but this time the second photon has transverse
 polarization in $x$ direction.
 
 %
 \item
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 beams = "W+"
 beams_pol\_density = @(0)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This example sets up the decay of a longitudinal vector boson.
 %
 \item
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 beams = E1, e1
 scan int hel_ep = (-1, 1) {
    scan int hel_em = (-1, 1) {
       beams_pol_density = @(hel_ep), @(hel_em)
       integrate (eeww)
    }
 }
 integrate (eeww)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This example loops over the different positron and electron helicity
 combinations and calculates the respective integrals. The
 \ttt{beams\_pol\_density} statement is local to the scan loop(s) and,
 therefore, the last \ttt{integrate} calculates the unpolarized
 integral.
 \end{itemize}
 %
 
 Although beam polarization should be straightforward to use, some pitfalls exist
 for the unwary:
 \begin{itemize}
 \item Once \ttt{beams\_pol\_density} is set globally, it persists and
 is applied every time \ttt{beams} is executed (unless it is reset). In
 particular, this means that code like
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 process wwaa = Wp, Wm => A, A
 process zee = Z => e1, E1
 
 sqrts = 200 GeV
 beams_pol_density = @(1, -1, 1:-1:-1), @()
 beams = Wp, Wm
 integrate (wwaa)
 beams = Z
 integrate (zee)
 beams_pol_density = @(0)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 will throw an error, because \whizard\ complains that the spin density
 matrix has the wrong dimensionality for the second (the decay) process.
 This kind of trap can be avoided be using \ttt{beams\_pol\_density}
 only locally in \ttt{integrate} or \ttt{simulate} statements.
 %
 \item On-the-fly integrations executed by \ttt{simulate}
 use the beam
 setup found at the point of execution. This implies that any polarization
 settings you have previously done affect the result of the integration.
 %
 \item The \ttt{unstable} command also requires integrals of the selected decay
   processes, and will compute them on-the-fly if they are unavailable.  Here,
   a polarized integral is not meaningful at all.  Therefore, this command
   ignores the current \ttt{beam} setting and issues a warning if a previous
   polarized integral is available; this will be discarded.
 \end{itemize}
 
 
 \subsection{Final state polarization}
 
 Final state polarization is available in \whizard\ in the sense that the
 polarization of real final state particles can be retained when generating
 simulated
 events. In order for the polarization of a particle to be retained, it must be
 declared as polarized via the \ttt{polarized} statement
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 polarized particle [, particle, ...]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 The effect of \ttt{polarized} can be reversed with the \ttt{unpolarized}
 statement which has the same syntax. For example,
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 polarized "W+", "W-", Z
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 will cause the polarization of all final state $W$ and $Z$ bosons to be
 retained, while
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 unpolarized "W+", "W-", Z
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 will reverse the effect and cause the polarization to be summed over again. Note
 that \ttt{polarized} and \ttt{unpolarized} are global statements which cannot be
 used locally as command arguments and if you use them e.g. in a loop, the
 effects will persist beyond the loop body. Also, a particle cannot be
 \ttt{polarized} and \ttt{unstable} at the same time (this restriction
 might be loosened in future versions of \whizard).
 
 After toggling the polarization flag, the generation of polarized events can be
 requested by using the \ttt{?polarized\_events} option of the \ttt{simulate}
 command, e.g.
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 simulate (eeww) { ?polarized_events = true }
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 When \ttt{simulate} is run in this mode, helicity information for final state
 particles that have been toggled as \ttt{polarized} is written to the event
 file(s) (provided that polarization is supported by the selected event file
 format(s) ) and can also be accessed in the analysis by means of the \ttt{Hel}
 observable. For example, an analysis definition like
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 analysis =
   if (all Hel == -1 ["W+"] and all Hel == -1 ["W-"] ) then
     record cta_nn (eval cos (Theta) ["W+"]) endif;
   if (all Hel == -1 ["W+"] and all Hel ==  0 ["W-"] )
     then record cta_nl (eval cos (Theta) ["W+"]) endif
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 can be used to histogram the angular distribution for the production of
 polarized $W$ pairs (obviously, the example would have to be extended
 to cover all possible helicity combinations). Note, however, that
 helicity information is not available in the integration step;
 therefore, it is not possible to use \ttt{Hel} as a cut observable.
 
 While final state polarization is straightforward to use, there is a caveat when
 used in combination with flavor products. If a particle in a flavor product is
 defined as \ttt{polarized}, then all particles ``originating'' from the product will
 act as if they had been declared as \ttt{polarized} --- their polarization will
 be recorded in the generated events. E.g., the example
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 process test = u:d, ubar:dbar => d:u, dbar:ubar, u, ubar
 
 ! insert compilation, cuts and integration here
 
 polarized d, dbar
 simulate (test) {?polarized_events = true}
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 will generate events including helicity information for all final state $d$ and
 $\overline{d}$ quarks, but only for part of the final state $u$ and $\overline{u}$
 quarks. In this case, if you had wanted to keep the helicity information also
 for all $u$ and $\overline{u}$, you would have had to explicitely include them
 into the \ttt{polarized} statement.
 
 
 \section{Cross sections}
 
 Integrating matrix elements over phase space is the core of \whizard's
 activities.  For any process where we want the cross section, distributions,
 or event samples, the cross section has to be determined first.  This is done
 by a doubly adaptive multi-channel Monte-Carlo integration.  The integration,
 in turn, requires a \emph{phase-space setup}, i.e., a collection of
 phase-space \emph{channels}, which are mappings of the unit hypercube onto the
 complete space of multi-particle kinematics.  This phase-space information is
 encoded in the file \emph{xxx}\ttt{.phs}, where \emph{xxx} is the process tag.
 \whizard\ generates the phase-space file on the fly and can reuse it in later
 integrations.
 
 For each phase-space channel, the unit hypercube is binned in each dimension.
 The bin boundaries are allowed to move during a sequence of iterations, each
 with a fixed number of sampled phase-space points, so they adapt to the actual
 phase-space density as far as possible.  In addition to this \emph{intrinsic}
 adaptation, the relative channel weights are also allowed to vary.
 
 All these steps are done automatically when the \ttt{integrate} command is
 executed.  At the end of the iterative adaptation procedure, the program has
 obtained an estimate for the integral of the matrix element over phase space,
 together with an error estimate, and a set of integration \emph{grids} which
 contains all information on channel weights and bin boundaries.  This
 information is stored in a file \emph{xxx}\ttt{.vg}, where \emph{xxx} is the
 process tag, and is used for event generation by the \ttt{simulate}
 command.
 
 
 \subsection{Integration}
 \label{sec:integrate}
 
 Since everything can be handled automatically using default parameters, it
 often suffices to write the command
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   integrate (proc1)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 for integrating the process with name tag \ttt{proc1}, and similarly
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   integrate (proc1, proc2, proc3)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 for integrating several processes consecutively.  Options to the integrate
 command are specified, if not globally, by a local option string
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   integrate (proc1, proc2, proc3) { mH = 200 GeV }
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 (It is possible to place a \ttt{beams} statement inside the option string, if
 desired.)
 
 If the process is configured but not compiled, compilation will be done
 automatically.   If it is not available at all, integration will fail.
 
 The integration method can be specified by the string variable
 \begin{quote}
 \begin{footnotesize}
   \ttt{\$integration\_method = "{\em <method>}"}
 \end{footnotesize}
 \end{quote} %$
 The default method is called \ttt{"vamp"} and uses the \vamp\
 algorithm and code. (At the moment, there is only a single simplistic
 alternative, using the midpoint rule or rectangle method for
 integration, \ttt{"midpoint"}. This is mainly for testing purposes. In
 future versions of \whizard, more methods like e.g. Gauss integration
 will be made available). \vamp, however, is clearly the main
 integration method. It is done in several \emph{passes} (usually two),
 and each pass consists of several \emph{iterations}.  An iteration
 consists of a definite number of \emph{calls} to the matrix-element
 function.
 
 For each iteration, \whizard\ computes an estimate of the integral and an
 estimate of the error, based on the binned sums of matrix element values and
 squares.  It also computes an estimate of the rejection efficiency for
 generating unweighted events, i.e., the ratio of the average sampling function
 value over the maximum value of this function.
 
 After each iteration, both the integration grids (the binnings) and the
 relative weights of the integration channels can be adapted to
 minimize the variance estimate of the integral.  After each pass of several
 iterations, \whizard\ computes an average of the iterations within the pass,
 the corresponding error estimate, and a $\chi^2$ value.  The integral, error,
 efficiency and $\chi^2$ value computed for the most recent integration pass,
 together with the most recent integration grid, are used for any subsequent
 calculation that involves this process, in particular for event generation.
 
 In the default setup, during the first pass(es) both grid binnings and channel
 weights are adapted.  In the final (usually second) pass, only binnings are
 further adapted.  Roughly speaking, the final pass is the actual calculation,
 while the previous pass(es) are used for ``warming up'' the integration grids,
 without using the numerical results. Below, in the section about the
 specification of the iterations, Sec.~\ref{sec:iterations}, we will
 explain how it is possible to change the behavior of adapting grids
 and weights.
 
 Here is an example of the integration output, which illustrates these
 properties.  The \sindarin\ script describes the process $e^+e^-\to q\bar q
 q\bar q$ with $q$ being any light quark, i.e., $W^+W^-$ and $ZZ$ production
 and hadronic decay together will any irreducible background.  We cut on $p_T$
 and energy of jets, and on the invariant mass of jet pairs.  Here is the
 script:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 alias q = d:u:s:c
 alias Q = D:U:S:C
 process proc_4f = e1, E1 => q, Q, q, Q
 
 ms = 0  mc = 0
 sqrts = 500 GeV
 cuts = all (Pt > 10 GeV and E > 10 GeV) [q:Q]
    and all M > 10 GeV [q:Q, q:Q]
 
 integrate (proc_4f)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 After the run is finished, the integration output looks like
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 | Process library 'default_lib': loading
 | Process library 'default_lib': ... success.
 | Integrate: compilation done
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 12511
 | Initializing integration for process proc_4f:
 | ------------------------------------------------------------------------
 | Process [scattering]: 'proc_4f'
 |   Library name  = 'default_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'proc_4f_i1':   e-, e+ => d:u:s:c, dbar:ubar:sbar:cbar,
 |                                  d:u:s:c, dbar:ubar:sbar:cbar [omega]
 | ------------------------------------------------------------------------
 | Beam structure: [any particles]
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'proc_4f_i1.phs'
 | Phase space: 123 channels, 8 dimensions
 | Phase space: found 123 channels, collected in 15 groves.
 | Phase space: Using 195 equivalences between channels.
 | Phase space: wood
 | Applying user-defined cuts.
 | OpenMP: Using 8 threads
 | Starting integration for process 'proc_4f'
 | Integrate: iterations not specified, using default
 | Integrate: iterations = 10:10000:"gw", 5:20000:""
 | Integrator: 15 chains, 123 channels, 8 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 10000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1       9963  2.3797857E+03  3.37E+02   14.15   14.13*   4.02
    2       9887  2.8307603E+03  9.58E+01    3.39    3.37*   4.31
    3       9815  3.0132091E+03  5.10E+01    1.69    1.68*   8.37
    4       9754  2.9314937E+03  3.64E+01    1.24    1.23*  10.65
    5       9704  2.9088284E+03  3.40E+01    1.17    1.15*  12.99
    6       9639  2.9725788E+03  3.53E+01    1.19    1.17   15.34
    7       9583  2.9812484E+03  3.10E+01    1.04    1.02*  17.97
    8       9521  2.9295139E+03  2.88E+01    0.98    0.96*  22.27
    9       9435  2.9749262E+03  2.94E+01    0.99    0.96   20.25
   10       9376  2.9563369E+03  3.01E+01    1.02    0.99   21.10
 |-----------------------------------------------------------------------------|
   10      96677  2.9525019E+03  1.16E+01    0.39    1.22   21.10    1.15  10
 |-----------------------------------------------------------------------------|
   11      19945  2.9599072E+03  2.13E+01    0.72    1.02   15.03
   12      19945  2.9367733E+03  1.99E+01    0.68    0.96*  12.68
   13      19945  2.9487747E+03  2.03E+01    0.69    0.97   11.63
   14      19945  2.9777794E+03  2.03E+01    0.68    0.96*  11.19
   15      19945  2.9246612E+03  1.95E+01    0.67    0.94*  10.34
 |-----------------------------------------------------------------------------|
   15      99725  2.9488622E+03  9.04E+00    0.31    0.97   10.34    1.05   5
 |=============================================================================|
 | Time estimate for generating 10000 events: 0d:00h:00m:51s
 | Creating integration history display proc_4f-history.ps and proc_4f-history.pdf
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Each row shows the index of a single iteration, the number of matrix element
 calls for that iteration, and the integral and error estimate.  Note
 that the number of calls displayed are the real calls to the matrix
 elements after all cuts and possible rejections. The error
 should be viewed as the $1\sigma$ uncertainty, computed on a statistical
 \begin{figure}
   \centering
   \includegraphics[width=.56\textwidth]{proc_4f-history}
   \caption{\label{fig:inthistory} Graphical output of the convergence
     of the adaptation during the integration of a \whizard\ process.}
 \end{figure}
 basis.  The next two columns display the error in percent, and the
 \emph{accuracy} which is the same error normalized by $\sqrt{n_{\rm calls}}$.
 The accuracy value has the property that it is independent of $n_{\rm calls}$,
 it describes the quality of adaptation of the current grids.  Good-quality
 grids have a number of order one, the smaller the better.  The next column is
 the estimate for the rejection efficiency in percent.  Here, the value should
 be as high as possible, with $100\,\%$ being the possible maximum.
 
 In the example, the grids are adapted over ten iterations, after which the
 accuracy and efficiency have saturated at about $1.0$ and $10\,\%$,
 respectively.  The asterisk in the accuracy column marks those iterations
 where an improvement over the previous iteration is seen.  The average over
 these iterations exhibits an accuracy of $1.22$, corresponding to $0.39\,\%$
 error, and a $\chi^2$ value of $1.15$, which is just right:
 apparently, the phase-space for this process and set of cuts is
 well-behaved.  The subsequent five iterations are used for obtaining
 the final integral, which has an accuracy below one (error $0.3\,\%$),
 while the efficiency settles at about
 $10\,\%$.  In this example, the final $\chi^2$ value happens to be quite
 small, i.e., the individual results are closer together than the error
 estimates would suggest.  One should nevertheless not scale down the error,
 but rather scale it up if the $\chi^2$ result happens to be much larger than
 unity: this often indicates sub-optimally adapted grids, which insufficiently
 map some corner of phase space.
 
 One should note that all values are subject to statistical fluctuations, since
 the number of calls within each iterations is finite.  Typically, fluctuations
 in the efficiency estimate are considerably larger than fluctuations in the
 error/accuracy estimate.  Two subsequent runs of the same script should yield
 statistically independent results which may differ in all quantities, within
 the error estimates, since the seed of the random-number generator will differ
 by default.
 
 It is possible to get exactly reproducible results by setting the
 random-number seed explicitly, e.g.,
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   seed = 12345
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 at any point in the \sindarin\ script.  \ttt{seed} is a predefined intrinsic
 variable.  The value can be any 32bit integer.  Two runs with different seeds
 can be safely taken as statistically independent. In the example
 above, no seed has been set, and the seed has therefore been
 determined internally by \whizard\ from the system clock.
 
 The concluding line with the time estimate applies to a subsequent simulation
 step with unweighted events, which is not actually requested in the current
 example.  It is based on the timing and efficiency estimate of the most recent
 iteration.
 
 As a default, a graphical output of the integration history will be
 produced (if both \LaTeX\ and \metapost\ have been available during
 configuration). Fig.~\ref{fig:inthistory} shows how this looks like,
 and demonstrates how a proper convergence of the integral during the
 adaptation looks like. The generation of these graphical history files
 can be switched off using the command \ttt{?vis\_history = false}.
 
 %%%%%
 
 \subsection{Integration run IDs}
 
 A single \sindarin\ script may contain multiple calls to the
 \ttt{integrate} command with different parameters.  By default,
 files generated for the same process in a subsequent integration will
 overwrite the previous ones.  This is undesirable when the script is
 re-run: all results that have been overwritten have to be recreated.
 
 To avoid this, the user may identify a specific run by a string-valued
 ID, e.g.
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   integrate (foo) { $run_id = "first" }
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This ID will become part of the file name for all files that are
 created specifically for this run.  Often it is useful to create a run
 ID from a numerical value using \ttt{sprintf}, e.g., in this scan:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   scan real mh = (100 => 200 /+ 10) {
     $run_id = sprintf "%e" (mh)
     integrate (h_production)
   }
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 
 With unique run IDs, a subsequent run of the same \sindarin\ script
 will be able to reuse all previous results, even if there is more than
 a single integration per process.
 
 
 
 
 \subsection{Controlling iterations}
 \label{sec:iterations}
 
 \whizard\ has some predefined numbers of iterations and calls for the first
 and second integration pass, respectively, which depend on the number of
 initial and final-state particles.  They are guesses for values that yield
 good-quality grids and error values in standard situations, where no
 exceptionally strong peaks or loose cuts are present in the integrand.
 Actually, the large number of warmup iterations in the previous example
 indicates some safety margin in that respect.
 
 It is possible, and often advisable, to adjust the iteration and call numbers
 to the particular situation.  One may reduce the default numbers to short-cut
 the integration, if either less accuracy is needed, or CPU time is to be
 saved.  Otherwise, if convergence is bad, the number of iterations or calls
 might be increased.
 
 To set iterations manually, there is the \ttt{iterations} command:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   iterations = 5:50000, 3:100000
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This is a comma-separated list.  Each pair of values corresponds to an
 integration pass.  The value before the colon is the number of iterations for
 this pass, the other number is the number of calls per iteration.
 
 While the default number of passes is two (one for warmup, one for the final
 result), you may specify a single pass
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   iterations = 5:100000
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 where the relative channel weights will \emph{not} be adjusted (because this
 is the final pass).  This is appropriate for well-behaved integrands where
 weight adaptation is not necessary.
 
 You can also define more than two passes.  That might be useful when reusing a
 previous grid file with insufficient quality: specify the previous passes
 as-is, so the previous results will be read in, and then a new pass for
 further adaptation.
 
 In the final pass, the default behavior is to not adapt grids and
 weights anymore. Otherwise, different iterations would be correlated,
 and a final reliable error estimate would not be possible. For all but
 the final passes, the user can decide whether to adapt grids and
 weights by attaching a string specifier to the number of iterations:
 \ttt{"g"} does adapt grids, but not weights, \ttt{"w"} the other way
 round. \ttt{"gw"} or \ttt{"wg"} does adapt both. By the setting
 \ttt{""}, all adaptations are switched off. An example looks like
 this:
 \begin{code}
   iterations = 2:10000:"gw", 3:5000
 \end{code}
 
 Since it is often not known beforehand how many iterations the grid
 adaptation will need, it is generally a good idea to give the first
 pass a large number of iterations.  However, in many cases these turn
 out to be not necessary.  To shortcut iterations, you can set any of
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 accuracy_goal
 error_goal
 relative_error_goal
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 to a positive value.  If this is done, \whizard\ will skip warmup
 iterations once all of the specified goals are reached by the current
 iteration.  The final iterations (without weight adaptation) are
 always performed.
 
 
 \subsection{Phase space}
 
 Before \ttt{integrate} can start its work, it must have a phase-space
 configuration for the process at hand.  The method for the phase-space
 parameterization is determined by the string variable
 \ttt{\$phs\_method}. At the moment there are only two options,
 \ttt{"single"}, for testing purposes, that is mainly used internally,
 and \whizard's traditional method, \ttt{"wood"}. This parameterization
 is particularly adapted and fine-tuned for electroweak processes and
 might not be the ideal for for pure jet cross sections. In future
 versions of \whizard, more options for phase-space parameterizations
 will be made available, e.g. the \ttt{RAMBO} algorithm and its massive
 cousin, and phase-space parameterizations that take care of the
 dipole-like emission structure in collinear QCD (or QED) splittings.
 For the standard method, the phase-space parameterization is laid out
 in an ASCII file \ttt{\textit{<process-name>\_}i\textit{<comp>}.phs}.
 Here, \ttt{{\em <process-name>}} is the process name chosen by the
 user while \ttt{{\em <comp>}} is the number of the process component
 of the corresponding process. This immediately shows that different
 components of processes are getting different phase space setups. This
 is necessary for inclusive processes, e.g. the sum of $pp \to Z + nj$
 and $pp \to W + nj$, or in future versions of \whizard\ for NLO
 processes, where one component is the interference between the virtual
 and the Born matrix element, and another one is the subtraction terms.
 Normally, you do not have to deal with this file, since \whizard\ will
 generate one automatically if it does not find one. (\whizard\ is
 careful to check for consistency of process definition and parameters
 before using an existing file.)
 
 Experts might find it useful to generate a phase-space file and inspect and/or
 modify it before proceeding further.  To this end, there is the parameter
 \verb|?phs_only|.  If you set this \ttt{true}, \whizard\ skips the actual
 integration after the phase-space file has been generated.  There is also a
 parameter \verb|?vis_channels| which can be set independently; if this is
 \ttt{true}, \whizard\ will generate a graphical visualization of the
 phase-space parameterizations encoded in the phase-space file. This
 file has to be taken with a grain of salt because phase space channels
 are represented by sample Feynman diagrams for the corresponding
 channel. This does however {\em not} mean that in the matrix element
 other Feynman diagrams are missing (the default matrix element method,
 \oMega, is not using Feynman-diagrammatic amplitudes at all).
 
 Things might go wrong with the default phase-space generation, or manual
 intervention might be necessary to improve later performance.  There are a few
 parameters that control the algorithm of phase-space generation.  To
 understand their meaning, you should realize that phase-space
 parameterizations are modeled after (dominant) Feynman graphs for the current
 process.
 
 \subsubsection{The main phase space setup {\em wood}}
 
 For the main phase-space parameterization of \whizard, which is called
 \ttt{"wood"}, there are many different parameters and flags that allow
 to tune and customize the phase-space setup for every certain process:
 
 The parameter \verb|phs_off_shell| controls the number of off-shell lines in
 those graphs, not counting $s$-channel resonances and logarithmically enhanced
 $s$- and $t$-channel lines.  The default value is $2$.  Setting it to zero
 will drop everything that is not resonant or logarithmically enhanced.
 Increasing it will include more subdominant graphs.  (\whizard\ increases the
 value automatically if the default value does not work.)
 
 There is a similar parameter \verb|phs_t_channel| which controls
 multiperipheral graphs in the parameterizations.  The default value is $6$, so
 graphs with up to $6$ $t/u$-channel lines are considered.  In particular
 cases, such as $e^+e^-\to n\gamma$, all graphs are multiperipheral, and for
 $n>7$ \whizard\ would find no parameterizations in the default setup.
 Increasing the value of \verb|phs_t_channel| solves this problem.  (This is
 presently not done automatically.)
 
 There are two numerical parameters that describe whether particles are treated
 like massless particles in particular situations.  The value of
 \verb|phs_threshold_s| has the default value $50\;\GeV$.  Hence, $W$ and $Z$
 are considered massive, while $b$ quarks are considered massless.  This
 categorization is used for deciding whether radiation of $b$ quarks can lead
 to (nearly) singular behavior, i.e., logarithmic enhancement, in the infrared
 and collinear regions.  If yes, logarithmic mappings are applied to phase
 space.  Analogously, \verb|phs_threshold_t| decides about potential
 $t$-channel singularities.  Here, the default value is $100\;\GeV$, so
 amplitudes with $W$ and $Z$ in the $t$-channel are considered as
 logarithmically enhanced. For a high-energy hadron collider of 40 or
 100 TeV energy, also $W$ and $Z$ in $s$-channel like situations might
 be necessary to be considered massless.
 
 Such logarithmic mappings need a dimensionful scale as parameter.  There are
 three such scales, all with default value $10\;\GeV$: \verb|phs_e_scale|
 (energy), \verb|phs_m_scale| (invariant mass), and \verb|phs_q_scale|
 (momentum transfer).  If cuts and/or masses are such that energies, invariant
 masses of particle pairs, and momentum transfer values below $10\;\GeV$ are
 excluded or suppressed, the values can be kept.  In special cases they should
 be changed: for instance, if you want to describe $\gamma^*\to\mu^+\mu^-$
 splitting well down to the muon mass, no cuts, you may set
 \verb|phs_m_scale = mmu|.  The convergence of the Monte-Carlo integration
 result will be considerably faster.
 
 There are more flags. These and more details about the phase space
 parameterization will be described in Sec.~\ref{sec:wood}.
 
 
 \subsection{Cuts}
 
 \whizard~2 does not apply default cuts to the integrand.  Therefore, processes
 with massless particles in the initial, intermediate, or final states may not
 have a finite cross section.  This fact will manifest itself in an integration
 that does not converge, or is unstable, or does not yield a reasonable error
 or reweighting efficiency even for very large numbers of iterations or calls
 per iterations.  When doing any calculation, you should verify first that the
 result that you are going to compute is finite on physical grounds.  If not,
 you have to apply cuts that make it finite.
 
 A set of cuts is defined by the \ttt{cuts} statement.  Here is an example
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 cuts = all Pt > 20 GeV [colored]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This implies that events are kept only (for integration and simulation) if the
 transverse momenta of all colored particles are above $20\;\GeV$.
 
 Technically, \ttt{cuts} is a special object, which is unique within a given
 scope, and is defined by the logical expression on the right-hand side of the
 assignment.  It may be defined in global scope, so it is applied to all
 subsequent processes.  It may be redefined by another \ttt{cuts} statement.
 This overrides the first cuts setting: the \ttt{cuts} statement is not
 cumulative.  Multiple cuts should be specified by the logical operators of
 \sindarin, for instance
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 cuts = all Pt > 20 GeV [colored]
   and all E > 5 GeV [photon]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Cuts may also be defined local to an \ttt{integrate} command, i.e., in the
 options in braces.   They will apply only to the processes being integrated,
 overriding any global cuts.
 
 The right-hand side expression in the \ttt{cuts} statement is evaluated at the
 point where it is used by an \ttt{integrate} command (which could be an
 implicit one called by \ttt{simulate}).  Hence, if the logical expression
 contains parameters, such as
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 mH = 120 GeV
 cuts = all M > mH [b, bbar]
 mH = 150 GeV
 integrate (myproc)
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 the Higgs mass value that is inserted is the value in place when
 \ttt{integrate} is evaluated, $150\;\GeV$ in this example.  This same value
 will also be used when the process is called by a subsequent \ttt{simulate};
 it is \ttt{integrate} which compiles the cut expression and stores it among
 the process data.  This behavior allows for scanning over parameters without
 redefining the cuts every time.
 
 The cut expression can make use of all variables and constructs that are
 defined at the point where it is evaluated.  In particular, it can make use of
 the particle content and kinematics of the hard process, as in the example
 above.  In addition to the predefined variables and those defined by the user,
 there are the following variables which depend on the hard process:
 \begin{quote}
 \begin{tabular}{ll}
 integer: & \ttt{n\_in}, \ttt{n\_out}, \ttt{n\_tot} \\
 real: & \ttt{sqrts}, \ttt{sqrts\_hat}
 \end{tabular}
 \end{quote}
 Example:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 cuts = sqrts_hat > 150 GeV
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 The constants \ttt{n\_in} etc.\ are sometimes useful if a generic set of cuts
 is defined, which applies to various processes simultaneously.
 
 The user is encouraged to define his/her own set of cuts, if possible in a
 process-independent manner, even if it is not required.  The \ttt{include}
 command allows for storing a set of cuts in a separate \sindarin\ script which
 may be read in anywhere.  As an example, the system directories contain a file
 \verb|default_cuts.sin| which may be invoked by
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 include ("default_cuts.sin")
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 
 
 \subsection{QCD scale and coupling}
 
 \whizard\ treats all physical parameters of a model, the coefficients in the
 Lagrangian, as constants.  As a leading-order program, \whizard\ does not make
 use of running parameters as they are described by renormalization theory.
 For electroweak interactions where the perturbative expansion is sufficiently
 well behaved, this is a consistent approach.
 
 As far as QCD is concerned, this approach does not yield numerically
 reliable results, even on the validity scale of the tree approximation.
 In \whizard\ttt{2}, it is therefore possible to replace the fixed value of
 $\alpha_s$ (which is accessible as the intrinsic model variable
 \verb|alphas|), by a function of an energy scale $\mu$.
 
 This is controlled by the parameter \verb|?alphas_is_fixed|, which is
 \ttt{true} by default.  Setting it to \ttt{false} enables running~$\alpha_s$.
 The user has then to decide how $\alpha_s$ is calculated.
 
 One option is to set \verb|?alphas_from_lhapdf| (default \ttt{false}).  This
 is recommended if the \lhapdf\ library is used for including structure
 functions, but it may also be set if \lhapdf\ is not invoked.  \whizard\ will
 then use the $\alpha_s$ formula and value that matches the active
 \lhapdf\ structure function set and member.
 
 In the very same way, the $\alpha_s$ running from the PDFs implemented
 intrinsically in \whizard\ can be taken by setting
 \verb|?alphas_from_pdf_builtin| to \ttt{true}. This is the same
 running then the one from \lhapdf, if the intrinsic PDF coincides with
 a PDF chosen from \lhapdf.
 
 If this is not appropriate, there are again two possibilities.  If
 \verb|?alphas_from_mz| is \ttt{true}, the user input value \verb|alphas| is
 interpreted as the running value $\alpha_s(m_Z)$, and for the particular
 event, the coupling is evolved to the appropriate scale $\mu$.  The formula is
 controlled by the further parameters \verb|alphas_order| (default $0$,
 meaning leading-log; maximum $2$) and \verb|alphas_nf| (default $5$).
 
 Otherwise there is the option to set \verb|?alphas_from_lambda_qcd = true|
 in order to evaluate $\alpha_s$ from the scale $\Lambda_{\rm QCD}$,
 represented by the intrinsic variable \verb|lambda_qcd|. The reference
 value for the QCD scale is $\Lambda\_{\rm QCD} = 200$
 MeV. \verb|alphas_order| and \verb|alphas_nf| apply analogously.
 
 Note that for using one of the running options for $\alpha_s$, always
 \ttt{?alphas\_is\_fixed = false} has to be invoked.
 
 In any case, if $\alpha_s$ is not fixed, each event has to be assigned an
 energy scale.  By default, this is $\sqrt{\hat s}$, the partonic invariant
 mass of the event.  This can be replaced by a user-defined scale, the special
 object \ttt{scale}.  This is assigned and used just like the \ttt{cuts}
 object.  The right-hand side is a real-valued expression.  Here is an example:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 scale = eval Pt [sort by -Pt [colored]]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 This selects the $p_T$ value of the first entry in the list of colored
 particles sorted by decreasing $p_T$, i.e., the $p_T$ of the hardest jet.
 
 The \ttt{scale} definition is used not just for running $\alpha_s$ (if
 enabled), but it is also the factorization scale for the \lhapdf\ structure
 functions.
 
 These two values can be set differently by specifying
 \ttt{factorization\_scale} for the scale at which the PDFs are
 evaluated. Analogously, there is a variable
 \ttt{renormalization\_scale} that sets the scale value for the running
 $\alpha_s$. Whenever any of these two values is set, it supersedes the
 \ttt{scale} value.
 
 Just like the \ttt{cuts} expression, the expressions for \ttt{scale},
 \ttt{factorization\_scale} and also \ttt{renormalization\_scale}
 are evaluated at the point where it is read by an explicit or implicit
 \ttt{integrate} command.
 
 
 \subsection{Reweighting factor}
 
 It is possible to reweight the integrand by a user-defined function of the
 event kinematics.  This is done by specifying a \ttt{weight} expression.
 Syntax and usage is exactly analogous to the \ttt{scale} expression.  Example:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 weight = eval (1 + cos (Theta) ^ 2) [lepton]
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 We should note that the phase-space setup is not aware of this reweighting, so
 in complicated cases you should not expect adaptation to achieve as accurate
 results as for plain cross sections.
 
 Needless to say, the default \ttt{weight} is unity.
 
 
 \section{Events}
 
 After the cross section integral of a scattering process is known (or the
 partial-width integral of a decay process), \whizard\ can generate event
 samples.  There are two limiting cases or modes of event generation:
 \begin{enumerate}
 \item
   For a physics simulation, one needs \emph{unweighted} events, so the
   probability of a process and a kinematical configuration in the event sample
   is given by its squared matrix element.
 \item
   Monte-Carlo integration yields \emph{weighted} events, where the probability
   (without any grid adaptation) is uniformly distributed over phase space,
   while the weight of the event is given by its squared matrix element.
 \end{enumerate}
 The choice of parameterizations and the iterative adaptation of the
 integration grids gradually shift the generation mode from option 2 to option
 1, which obviously is preferred since it simulates the actual outcome of an
 experiment.  Unfortunately, this adaptation is perfect only in trivial cases,
 such that the Monte-Carlo integration yields non-uniform probability still
 with weighted events.  Unweighted events are obtained by rejection, i.e.,
 accepting an event with a probability equal to its own weight divided by the
 maximal possible weight.  Furthermore, the maximal weight is never precisely
 known, so this probability can only be estimated.
 
 The default generation mode of \whizard\ is unweighted.  This is controlled by
 the parameter \verb|?unweighted| with default value \ttt{true}.  Unweighted
 events are easy to interpret and can be directly compared with experiment, if
 properly interfaced with detector simulation and analysis.
 
 However, when applying rejection to generate unweighted events, the generator
 discards information, and for a single event it needs, on the average,
 $1/\epsilon$ calls, where the efficiency $\epsilon$ is the ratio of the
 average weight over the maximal weight.  If \verb|?unweighted| is \ttt{false},
 all events are kept and assigned their respective weights in histograms or
 event files.
 
 
 \subsection{Simulation}
 \label{sec:simulation}
 
 The \ttt{simulate} command generates an event sample.  The number of events
 can be set either by specifying the integer variable \verb|n_events|, or by
 the real variable \verb|luminosity|.  (This holds for unweighted events.  If
 weighted events are requested, the luminosity value is ignored.)  The
 luminosity is measured in
 femtobarns, but other units can be used, too.  Since the cross sections for the
 processes are known at that point, the number of events is determined as the
 luminosity multiplied by the cross section.
 
 As usual, both parameters can be set either as global or as local parameters:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   n_events = 10000
   simulate (proc1)
   simulate (proc2, proc3) { luminosity = 100 / 1 pbarn }
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 In the second example, both \verb|n_events| and \verb|luminosity| are set.
 In that case, \whizard\ chooses whatever produces the larger number of events.
 
 If more than one process is specified in the argument of \ttt{simulate},
 events are distributed among the processes with fractions proportional to
 their cross section values.  The processes are mixed randomly, as it would be
 the case for real data.
 
 The raw event sample is written to a file which is named after the first process
 in the argument of \ttt{simulate}.  If the process name is \ttt{proc1}, the
 file will be named \ttt{proc1.evx}.  You can choose another basename by the
 string variable \verb|$sample|.  For instance,
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   simulate (proc1) { n_events = 4000  $sample = "my_events" }
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 will produce an event file \verb|my_events.evx| which contains $4000$ events.
 
 This event file is in a machine-dependent binary format, so it is not of
 immediate use.  Its principal purpose is to serve as a cache: if you re-run
 the same script, before starting simulation, it will look for an existing
 event file that matches the input.  If nothing has changed, it will find the
 file previously generated and read in the events, instead of generating them.
 Thus you can modify the analysis or any further steps without repeating the
 time-consuming task of generating a large event sample.  If you change the
 number of events to generate, the program will make use of the existing event
 sample and generate further events only when it is used up.  If necessary, you
 can suppress the writing/reading of the raw event file by the parameters
 \verb|?write_raw| and \verb|?read_raw|.
 
 If you try to reuse an event file that has been written by a previous version
 of \whizard, you may run into an incompatibility, which will be detected as an
 error.  If this happens, you may enforce a compatibility mode (also for
 writing) by setting \ttt{\$event\_file\_version} to the appropriate version
 string, e.g., \verb|"2.0"|.  Be aware that this may break some more recent
 features in the event analysis.
 
 Generating an event sample can serve several purposes.  First of all,
 it can be analyzed directly, by \whizard's built-in capabilities, to
 produce tables, histograms, or calculate inclusive observables.  The
 basic analysis features of \whizard\ are described below in
 Sec.~\ref{sec:analysis}.  It can be written to an external file in a
 standard format that a human or an external program can understand.
 In Chap.~\ref{chap:events}, you will find a more thorough discussion
 of event generation with \whizard, which also covers in detail the
 available event-file formats.  Finally, \whizard\ can rescan an
 existing event sample.  The event sample may either be the result of a
 previous \ttt{simulate} run or, under certain conditions, an external
 event sample produced by another generator or reconstructed from
 data.
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 rescan "my_events" (proc1) { $pdf_builtin_set = "MSTW2008LO" }
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 The rescanning may apply different parameters and recalculate the
 matrix element, it may apply a different event selection, it may
 reweight the events by a different PDF set (as above).  The modified
 event sample can again be analyzed or written to file.  For more
 details, cf.\ Sec.~\ref{sec:rescan}.
 
 %%%%%%%%%%%%%%%
 
 \subsection{Decays}
 \label{sec:decays}
 
 Normally, the events generated by the \ttt{simulate} command will be identical
 in structure to the events that the \ttt{integrate} command generates.  This
 implies that for a process such as $pp\to W^+W^-$, the final-state particles
 are on-shell and stable, so they appear explicitly in the generated event
 files.  If events are desired where the decay products of the $W$ bosons
 appear, one has to generate another process, e.g., $pp\to u\bar d\bar ud$.  In
 this case, the intermediate vector bosons, if reconstructed, are off-shell as
 dictated by physics, and the process contains all intermediate states that are
 possible.  In this example, the matrix element contains also $ZZ$, photon, and
 non-resonant intermediate states.  (This can be restricted via the
 \verb|$restrictions| option, cf.\ \ref{sec:process options}.
 
 Another approach is to factorize the process in production (of $W$ bosons) and
 decays ($W\to q\bar q$).  This is actually the traditional approach, since it
 is much less computing-intensive.  The factorization neglects all off-shell
 effects and irreducible background diagrams that do not have the decaying
 particles as an intermediate resonance.  While \whizard\ is able to deal with
 multi-particle processes without factorization, the needed computing resources
 rapidly increase with the number of external particles. Particularly,
 it is the phase space integration that becomes the true bottleneck for
 a high multiplicity of final state particles.
 
 In order to use the factorized approach, one has to specify particles
 as \ttt{unstable}.  (Also, the \ttt{?allow\_decays} switch must be \ttt{true};
 this is however its default value.)  We give an example for a $pp \to Wj$ final
 state:
 \begin{code}
 process wj  = u, gl => d, Wp
 process wen = Wp => E1, n1
 
 integrate (wen)
 
 sqrts = 7 TeV
 beams = p, p => pdf_builtin
 unstable Wp (wen)
 simulate (wj) { n_events = 1 }
 \end{code}
 This defines a $2 \to 2$ hard scattering process of $W + j$ production
 at the 7 TeV LHC 2011 run. The $W^+$ is marked as unstable, with its
 decay process being $W^+ \to e^+ \nu_e$. In the \ttt{simulate} command
 both processes, the production process \ttt{wj} and the decay process
 \ttt{wen} will be integrated, while the $W$ decays become effective
 only in the final event sample. This event sample will contain final
 states with multiplicity $3$, namely $e^+ \nu_e d$. Note that here
 only one decay process is given, hence the branching ratio for the
 decay will be taken to be $100 \%$ by \whizard.
 
 A natural restriction of the factorized approach is the implied narrow-width
 approximation.  Theoretically, this restriction is necessary since whenever
 the width plays an important role, the usage of the factorized approach will
 not be fully justified.  In particular, all involved matrix elements must be
 evaluated on-shell, or otherwise gauge-invariance issues could spoil the
 calculation.  (There are plans for a future \whizard\ version
 to also include Breit-Wigner or Gaussian distributions when using the
 factorized approach.)
 
 Decays can be concatenated, e.g. for top pair production and
 decay, $e^+ e^- \to t \bar t$ with decay $t \to W^+ b$, and subsequent
 leptonic decay of the $W$ as in $W^+ \to \mu^+ \nu_\mu$:
 \begin{code}
 process eett = e1, E1 => t, tbar
 process t_dec = t => Wp, b
 process W_dec = Wp => E2, n2
 
 unstable t (t_dec)
 unstable Wp (W_dec)
 
 sqrts = 500
 simulate (eett) { n_events = 1 }
 \end{code}
 Note that in this case the final state in the event file will consist
 of $\bar t b \mu^+ \nu_\mu$ because the anti-top is not decayed.
 
 If more than one decay process is being specified like in
 \begin{code}
   process eeww = e1, E1 => Wp, Wm
   process w_dec1 = Wp => E2, n2
   process w_dec2 = Wp => E3, n3
 
   unstable Wp (w_dec1, w_dec2)
 
   sqrts = 500
   simulate (eeww) { n_events = 100 }
 \end{code}
 then \whizard\ takes the integrals of the specified decay processes
 and distributes the decays statistically according to the calculated
 branching ratio. Note that this might not be the true branching ratios
 if decay processes are missing, or loop corrections to partial widths
 give large(r) deviations. In the calculation of the code above,
 \whizard\ will issue an output like
 \begin{code}
 | Unstable particle W+: computed branching ratios:
 |   w_dec1: 5.0018253E-01   mu+, numu
 |   w_dec2: 4.9981747E-01   tau+, nutau
 |   Total width = 4.5496085E-01 GeV (computed)
 |               = 2.0490000E+00 GeV (preset)
 |   Decay options: helicity treated exactly
 \end{code}
 So in this case, \whizard\ uses 50 \% muonic and 50 \% tauonic decays
 of the positively charged $W$, while the $W^-$ appears directly in the
 event file. \whizard\ shows the difference between the preset $W$
 width from the physics model file and the value computed from the two
 decay channels.
 
 Note that a particle in a \sindarin\ input script can be also explictly
 marked as being stable, using the
 \begin{code}
 stable <particle-tag>
 \end{code}
 constructor for the particle \ttt{<particle-tag>}.
 
 
 \subsubsection{Resetting branching fractions}
 \label{sec:br-reset}
 
 As described above, decay processes that appear in a simulation must
 first be integrated by the program, either explicitly via the
 \verb|integrate| command, or implicitly by \verb|unstable|.  In either
 case, \whizard\ will use the computed partial widths in order to
 determine branching fractions.  In the spirit of a purely leading-order
 calculation, this is consistent.
 
 However, it may be desired to rather use different branching-fraction
 values for the decays of a particle, for instance, NLO-corrected
 values.  In fact, after \whizard\ has integrated any process, the
 integration result becomes available as an ordinary
 \sindarin\ variable.  For instance, if a decay process has the ID
 \verb|h_bb|, the integral of this process -- the partial width, in
 this case -- becomes the variable \verb|integral(h_bb)|.  This
 variable may be reset just like any other variable:
 \begin{code}
   integral(h_bb) = 2.40e-3 GeV
 \end{code}
 The new value will be used for all subsequent Higgs branching-ratio
 calculations and decays, if an unstable Higgs appears in a process for
 simulation.
 
 
 \subsubsection{Spin correlations in decays}
 \label{sec:spin-correlations}
 
 By default, \whizard\ applies full spin and color correlations to the
 factorized processes, so it keeps both color and spin coherence between
 productions and decays.  Correlations between decay products of distinct
 unstable particles in the same event are also fully retained.  The program
 sums over all intermediate quantum numbers.
 
 Although this approach obviously yields the optimal description with the
 limits of production-decay factorization, there is support for a simplified
 handling of particle decays.  Essentially, there are four options, taking a
 decay \ttt{W\_ud}: $W^-\to \bar u d$ as an example:
 \begin{enumerate}
 \item
   Full spin correlations: \verb|unstable Wp (W_ud)|
 \item
   Isotropic decay: \verb|unstable Wp (W_ud) { ?isotropic_decay = true }|
 \item
   Diagonal decay matrix:
   \verb|unstable Wp (W_ud) { ?diagonal_decay = true }|
 \item
   Project onto specific helicity:
   \verb|unstable Wp (W_ud) { decay_helicity = -1 }|
 \end{enumerate}
 Here, the isotropic option completely eliminates spin correlations.  The
 diagonal-decays option eliminates just the off-diagonal entries of the $W$
 spin-density matrix.  This is equivalent to a measurement of spin before the
 decay.  As a result, spin correlations are still present in the classical
 sense, while quantum coherence is lost.  The definite-helicity option is
 similar and additional selects only the specified helicity component for the
 decaying particle, so its decay distribution assumes the shape for an
 accordingly polarized particle.  All options apply in the rest frame of the
 decaying particle, with the particle's momentum as the quantization axis.
 
 \subsubsection{Automatic decays}
 
 A convenient option is if the user did not have to specify the decay
 mode by hand, but if they were generated automatically. \whizard\ does
 have this option: the flag \ttt{?auto\_decays} can be set to
 \ttt{true}, and is taking care of that. In that case the list for the
 decay processes of the particle marked as unstable is left empty (we
 take a $W^-$ again as example):
 \begin{code}
 unstable Wm () { ?auto_decays = true }
 \end{code}
 \whizard\ then inspects at the local position within the \sindarin\
 input file where that \ttt{unstable} statement appears the masses of
 all the particles of the active physics model in order to determine
 which decays are possible. It then calculates their partial widths.
 There are a few options to customize the decays. The integer variable
 \ttt{auto\_decays\_multiplicity} allows to set the maximal
 multiplicity of the final states considered in the auto decay
 option. The defaul value of that variable is \ttt{2}; please be quite
 careful when setting this to values larger than that. If you do so,
 the flag \ttt{?auto\_decays\_radiative} allows to specify whether
 final states simply containing additional resolved gluons or photons
 are taken into account or not. For the example above, you almost hit
 the PDG value for the $W$ total width:
 \begin{code}
 | Unstable particle W-: computed branching ratios:
 |   decay_a24_1: 3.3337068E-01   d, ubar
 |   decay_a24_2: 3.3325864E-01   s, cbar
 |   decay_a24_3: 1.1112356E-01   e-, nuebar
 |   decay_a24_4: 1.1112356E-01   mu-, numubar
 |   decay_a24_5: 1.1112356E-01   tau-, nutaubar
 |   Total width = 2.0478471E+00 GeV (computed)
 |               = 2.0490000E+00 GeV (preset)
 |   Decay options: helicity treated exactly
 \end{code}
 
 \subsubsection{Future shorter notation for decays}
 
 {\color{red} In an upcoming \whizard\ version there will be a shorter and more
   concise notation already in the process definition for such decays,
   which, however, is current not yet implemented. The two first examples
   above will then be shorter and have this form:}
   \begin{code}
     process wj = u, gl => (Wp => E1, n1), d
   \end{code}
   {\color{red} as well as }
   \begin{code}
     process eett = e1, E1 => (t => (Wp => E2, n2), b), tbar
   \end{code}
 
 %%%%%
 
 \subsection{Event formats}
 
 As mentioned above, the internal \whizard\ event format is a
 machine-dependent event format. There are a series of human-readable
 ASCII event formats that are supported: very verbose formats intended
 for debugging, formats that have been agreed upon during the Les
 Houches workshops like LHA and LHEF, or formats that are steered
 through external packages like HepMC. More details about event formats
 can be found in Sec.~\ref{sec:eventformats}.
 
 %%%%%%%%%%%%%%%
 
 \section{Analysis and Visualization}
 \label{sec:analysis}
 
 \sindarin\ natively supports basic methods of data analysis and visualization
 which are frequently used in high-energy physics studies.  Data generated
 during script execution, in particular simulated event samples, can be
 analyzed to evaluate further observables, fill histograms, and draw
 two-dimensional plots.
 
 So the user does not have to rely on his/her own external graphical
 analysis method (like e.g. \ttt{gnuplot} or \ttt{ROOT} etc.), but can
 use methods that automatically ship with \whizard. In many cases, the
 user, however, clearly will use his/her own analysis machinery,
 especially experimental collaborations.
 
 In the following sections, we first summarize the available data structures,
 before we consider their graphical display.
 
 
 
 \subsection{Observables}
 
 Analyses in high-energy physics often involve averages of quantities other
 than a total cross section.  \sindarin\ supports this by its \ttt{observable}
 objects.  An \ttt{observable} is a container that collects a single
 real-valued variable with a statistical distribution.  It is declared by a
 command of the form
 \begin{quote}
   \begin{footnotesize}
 \ttt{observable \emph{analysis-tag}}
   \end{footnotesize}
 \end{quote}
 where \ttt{\emph{analysis-tag}} is an identifier that follows the same rules
 as a variable name.
 
 Once the observable has been declared, it can be filled with values.  This is
 done via the \ttt{record} command:
 \begin{quote}
   \begin{footnotesize}
 \ttt{record \emph{analysis-tag} (\emph{value})}
   \end{footnotesize}
 \end{quote}
 To make use of this, after values have been filled, we want to perform the
 actual analysis and display the results.  For an observable, these are the
 mean value and the standard deviation.  There is the command
 \ttt{write\_analysis}:
 \begin{quote}
   \begin{footnotesize}
 \ttt{write\_analysis (\emph{analysis-tag})}
   \end{footnotesize}
 \end{quote}
 
 Here is an example:
 \begin{quote}
   \begin{footnotesize}
 \begin{verbatim}
 observable obs
 record obs (1.2)  record obs (1.3)  record obs (2.1)  record obs (1.4)
 write_analysis (obs)
 \end{verbatim}
   \end{footnotesize}
 \end{quote}
 The result is displayed on screen:
 \begin{quote}
   \begin{footnotesize}
 \begin{verbatim}
 ###############################################################################
 # Observable: obs
 average     =  1.500000000000E+00
 error[abs]  =  2.041241452319E-01
 error[rel]  =  1.360827634880E-01
 n_entries   = 4
 \end{verbatim}
   \end{footnotesize}
 \end{quote}
 
 
 \subsection{The analysis expression}
 \label{subsec:analysis}
 
 The most common application is the computation of event observables -- for
 instance, a forward-backward asymmetry -- during simulation.  To this end,
 there is an \ttt{analysis} expression, which behaves very similar to the
 \ttt{cuts} expression.  It is defined either globally
 \begin{quote}
   \begin{footnotesize}
     \ttt{analysis = \emph{logical-expr}}
   \end{footnotesize}
 \end{quote}
 or as a local option to the \ttt{simulate} or \ttt{rescan} commands which
 generate and handle event samples.  If this expression is defined, it is not
 evaluated immediately, but it is evaluated once for each event in the sample.
 
 In contrast to the \ttt{cuts} expression, the logical value of the
 \ttt{analysis} expression is discarded; the expression form has been chosen
 just by analogy.  To make this useful, there is a variant of the \ttt{record}
 command, namely a \ttt{record} function with exactly the same syntax.  As an
 example, here is a calculation of the forward-backward symmetry in a process
 \ttt{ee\_mumu} with final state $\mu^+\mu^-$:
 \begin{quote}
   \begin{footnotesize}
 \begin{verbatim}
   observable a_fb
   analysis = record a_fb (eval sgn (Pz) ["mu-"])
   simulate (ee_mumu) { luminosity = 1 / 1 fbarn }
 \end{verbatim}
   \end{footnotesize}
 \end{quote}
 The logical return value of \ttt{record} -- which is discarded here -- is
 \ttt{true} if the recording was successful.  In case of histograms (see below)
 it is true if the value falls within bounds, false otherwise.
 
 Note that the function version of \ttt{record} can be used anywhere in
 expressions, not just in the \ttt{analysis} expression.
 
 When \ttt{record} is called for an observable or histogram in simulation mode,
 the recorded value is weighted appropriately.  If \ttt{?unweighted} is true,
 the weight is unity, otherwise it is the event weight.
 
 The \ttt{analysis} expression can involve any other construct
 that can be expressed as an expression in \sindarin.  For instance, this
 records the energy of the 4th hardest jet in a histogram \ttt{pt\_dist}, if it
 is in the central region:
 \begin{quote}
   \begin{footnotesize}
 \begin{verbatim}
   analysis =
     record pt_dist (eval E [extract index 4
                              [sort by - Pt
                                [select if -2.5 < Eta < 2.5 [colored]]]])
 \end{verbatim}
   \end{footnotesize}
 \end{quote}
 Here, if there is no 4th jet in the event which satisfies the criterion, the
 result will be an undefined value which is not recorded.  In that case,
 \ttt{record} evaluates to \ttt{false}.
 
 Selection cuts can be part of the analysis expression:
 \begin{code}
   analysis =
     if any Pt > 50 GeV [lepton] then
       record jet_energy (eval E [collect [jet]])
     endif
 \end{code}
 Alternatively, we can specify a separate selection expression:
 \begin{code}
   selection = any Pt > 50 GeV [lepton]
   analysis = record jet_energy (eval E [collect [jet]])
 \end{code}
 The former version writes all events to file (if requested), but
 applies the analysis expression only to the selected events.  This
 allows for the simultaneous application of different selections to a
 single event sample.  The latter version applies the selection to all
 events before they are analyzed or written to file.
 
 The analysis expression can make use of all variables and constructs that are
 defined at the point where it is evaluated.  In particular, it can make use of
 the particle content and kinematics of the hard process, as in the example
 above.  In addition to the predefined variables and those defined by the user,
 there are the following variables which depend on the hard process.  Some of
 them are constants, some vary event by event:
 \begin{quote}
 \begin{tabular}{ll}
 integer: &\ttt{event\_index} \\
 integer: &\ttt{process\_num\_id} \\
 string: &\ttt{\$process\_id} \\
 integer: &\ttt{n\_in}, \ttt{n\_out}, \ttt{n\_tot} \\
 real: &\ttt{sqrts}, \ttt{sqrts\_hat} \\
 real: &\ttt{sqme}, \ttt{sqme\_ref} \\
 real: &\ttt{event\_weight}, \ttt{event\_excess}
 \end{tabular}
 \end{quote}
 The \ttt{process\_num\_id} is the numeric ID as used by external
 programs, while the process index refers to the current library. By
 default, the two are identical.  The process index itself is not
 available as a predefined observable. The \ttt{sqme} and
 \ttt{sqme\_ref} values indicate the squared matrix element and the
 reference squared matrix element, respectively.  The latter applies
 when comparing with a reference sample (the \ttt{rescan} command).
 
 \ttt{record} evaluates to a logical, so several \ttt{record} functions may
 be concatenated by the logical operators \ttt{and} or \ttt{or}.  However,
 since usually the further evaluation should not depend on the return value of
 \ttt{record}, it is more advisable to concatenate them by the semicolon
 (\ttt{;}) operator.  This is an operator (\emph{not} a statement separator or
 terminator) that connects two logical expressions and evaluates both of them
 in order.  The lhs result is discarded, the result is the value of the rhs:
 \begin{quote}
   \begin{footnotesize}
 \begin{verbatim}
   analysis =
     record hist_pt (eval Pt [lepton]) ; record hist_ct (eval cos (Theta) [lepton])
 \end{verbatim}
   \end{footnotesize}
 \end{quote}
 
 
 \subsection{Histograms}
 \label{sec:histogram}
 
 In \sindarin, a histogram is declared by the command
 \begin{quote}
   \begin{footnotesize}
 \ttt{histogram \emph{analysis-tag} (\emph{lower-bound}, \emph{upper-bound})}
   \end{footnotesize}
 \end{quote}
 This creates a histogram data structure for an (unspecified) observable.  The
 entries are organized in bins between the real values \ttt{\emph{lower-bound}}
 and \ttt{\emph{upper-bound}}.  The number of bins is given by the value of the
 intrinsic integer variable \ttt{n\_bins}, the default value is 20.
 
 The \ttt{histogram} declaration supports an optional argument, so the number
 of bins can be set locally, for instance
 \begin{quote}
   \begin{footnotesize}
 \ttt{histogram pt\_distribution (0 GeV, 500 GeV) \{ n\_bins = 50 \}}
   \end{footnotesize}
 \end{quote}
 Sometimes it is more convenient to set the bin width directly.  This can be
 done in a third argument to the \ttt{histogram} command.
 \begin{quote}
   \begin{footnotesize}
 \ttt{histogram pt\_distribution (0 GeV, 500 GeV, 10 GeV)}
   \end{footnotesize}
 \end{quote}
 If the bin width is specified this way, it overrides the setting of
 \ttt{n\_bins}.
 
 The \ttt{record} command or function fills histograms.  A single call
 \begin{quote}
   \begin{footnotesize}
 \ttt{record (\emph{real-expr})}
   \end{footnotesize}
 \end{quote}
 puts the value of \ttt{\emph{real-expr}} into the appropriate bin.  If
 the call is issued during a simulation where \ttt{unweighted} is false, the
 entry is weighted appropriately.
 
 If the value is outside the range specified in the histogram declaration, it
 is put into one of the special underflow and overflow bins.
 
 The \ttt{write\_analysis} command prints the histogram contents as a table in
 blank-separated fixed columns.  The columns are: $x$ (bin midpoint), $y$ (bin
 contents), $\Delta y$ (error), excess weight, and $n$ (number of entries).
 The output also contains comments initiated by a \verb|#| sign, and following
 the histogram proper, information about underflow and overflow as well as
 overall contents is added.
 
 
 \subsection{Plots}
 \label{sec:plot}
 
 While a histogram stores only summary information about a data set, a
 \ttt{plot} stores all data as $(x,y)$ pairs, optionally with errors.  A plot
 declaration is as simple as
 \begin{quote}
   \begin{footnotesize}
 \ttt{plot \emph{analysis-tag}}
   \end{footnotesize}
 \end{quote}
 Like observables and histograms, plots are filled by the \ttt{record} command
 or expression.  To this end, it can take two arguments,
 \begin{quote}
   \begin{footnotesize}
 \ttt{record (\emph{x-expr}, \emph{y-expr})}
   \end{footnotesize}
 \end{quote}
 or up to four:
 \begin{quote}
   \begin{footnotesize}
 \ttt{record (\emph{x-expr}, \emph{y-expr}, \emph{y-error})}
 \\
 \ttt{record (\emph{x-expr}, \emph{y-expr},
   \emph{y-error-expr}, \emph{x-error-expr})}
   \end{footnotesize}
 \end{quote}
 Note that the $y$ error comes first.  This is because applications will
 demand errors for the $y$ value much more often than $x$ errors.
 
 The plot output, again written by \ttt{write\_analysis} contains the four
 values for each point, again in the ordering $x,y,\Delta y, \Delta x$.
 
 
 \subsection{Analysis Output}
 
 There is a default format for piping information into observables,
 histograms, and plots. In older versions of \whizard\ there was a
 first version of a custom format, which was however rather limited.
 A more versatile custom output format will be coming soon.
 
 \begin{enumerate}
 \item
 By default, the \ttt{write\_analysis} command prints all data to the
 standard output. The data are also written to a default file with the
 name \ttt{whizard\_analysis.dat}.
 Output is redirected to a file with a different name if the
 variable \ttt{\$out\_file} has a nonempty value.  If the file is
 already open, the output will be appended to
 the file, and it will be kept open.  If the file is not open,
 \ttt{write\_analysis} will open the output file by itself, overwriting any
 previous file with the same name, and close it again after data have been
 written.
 
 The command is able to print more than one dataset, following the syntax
 \begin{quote}
   \begin{footnotesize}
   \ttt{write\_analysis (\emph{analysis-tag1}, \emph{analysis-tag2}, \ldots)
   \{ \emph{options} \}}
   \end{footnotesize}
 \end{quote}
 The argument in brackets may also be empty or absent; in this case, all
 currently existing datasets are printed.
 
 The default data format is suitable for compiling analysis data by \whizard's
 built-in \gamelan\ graphics driver (see below and particularly
 Chap.~\ref{chap:visualization}).  Data are written in
 blank-separated fixed columns, headlines and comments are initiated by the
 \verb|#| sign, and each data set is terminated by a blank line.  However,
 external programs often require special formatting.
 
 The internal graphics driver \gamelan\ of \whizard\ is initiated by
 the \ttt{compile\_analysis} command. Its syntax is the same, and it
 contains the \ttt{write\_analysis} if that has not been separately
 called (which is unnecessary). For more details about the \gamelan\
 graphics driver and data visualization within \whizard, confer
 Chap.~\ref{chap:visualization}.
 
 \item
 Custom format. Not yet (re-)implemented in a general form.
 \end{enumerate}
 
 
 \section{Custom Input/Output}
 \label{sec:I/O}
 
 \whizard\ is rather chatty.  When you run examples or your own scripts, you
 will observe that the program echoes most operations (assignments, commands,
 etc.) on the standard output channel, i.e., on screen.  Furthermore, all
 screen output is copied to a log file which by default is named
 \ttt{whizard.log}.
 
 For each integration run, \whizard\ writes additional process-specific
 information to a file \ttt{\var{tag}.log}, where \ttt{\var{tag}} is the
 process name.  Furthermore, the \ttt{write\_analysis} command dumps analysis
 data -- tables for histograms and plots -- to its own set of files, cf.\
 Sec.~\ref{sec:analysis}.
 
 However, there is the occasional need to write data to extra files in a custom
 format.  \sindarin\ deals with that in terms of the following commands:
 
 \subsection{Output Files}
 
 \subsubsection{open\_out}
 \begin{syntax}
 open\_out (\var{filename}) \\
 open\_out (\var{filename}) \{ \var{options} \}
 \end{syntax}
 Open an external file for writing.  If the file exists, it is overwritten
 without warning, otherwise it is created.  Example:
 \begin{code}
 open_out ("my_output.dat")
 \end{code}
 
 
 \subsubsection{close\_out}
 \begin{syntax}
 close\_out (\var{filename}) \\
 close\_out (\var{filename}) \{ \var{options} \}
 \end{syntax}
 Close an external file that is open for writing.  Example:
 \begin{code}
 close_out ("my_output.dat")
 \end{code}
 
 
 \subsection{Printing Data}
 
 \subsubsection{printf}
 \begin{syntax}
 printf \var{format-string-expr} \\
 printf \var{format-string-expr} (\var{data-objects})
 \end{syntax}
 Format \ttt{\var{data-objects}} according to \ttt{\var{format-string-expr}}
 and print the resulting string to standard output if the string variable
 \ttt{\$out\_file} is undefined.  If \ttt{\$out\_file} is defined and the file
 with this name is open for writing, print to this file instead.
 
 Print a newline at the end if \ttt{?out\_advance} is true, otherwise don't
 finish the line.
 
 The \ttt{\var{format-string-expr}} must evaluate to a string.  Formatting
 follows a subset of the rules for the \ttt{printf(3)} command in the \ttt{C}
 language.  The supported rules are:
 \begin{itemize}
 \item All characters are printed as-is, with the exception of embedded
   conversion specifications.
 \item Conversion specifications are initiated by a percent (\verb|%|) sign and
   followed by an optional prefix flag, an optional integer value, an optional
   dot followed by another integer, and a mandatory letter as the conversion
   specifier.
 \item A percent sign immediately followed by another percent sign is
   interpreted as a single percent sign, not as a conversion specification.
 \item The number of conversion specifiers must be equal to the number of data
   objects.  The data types must also match.
 \item The first integer indicates the minimum field width, the second one the
   precision.  The field is expanded as needed.
 \item The conversion specifiers \ttt{d} and \ttt{i} are equivalent, they
   indicate an integer value.
 \item The conversion specifier \ttt{e} indicates a real value that should be
   printed in exponential notation.
 \item The conversion specifier \ttt{f} indicates a real value that should be
   printed in decimal notation without exponent.
 \item The conversion specifier \ttt{g} indicates a real value that should be
   printed either in exponential or in decimal notation, depending on its
   value.
 \item The conversion specifier \ttt{s} indicates a logical or string value
   that should be printed as a string.
 \item Possible prefixes are \verb|#| (alternate form, mandatory decimal point
   for reals), \verb|0| (zero padding), \verb|-| (left adjusted), \verb|+|
   (always print sign), `\verb| |' (print space before a positive number).
 \end{itemize}
 For more details, consult the \verb|printf(3)| manpage.  Note that other
 conversions are not supported and will be rejected by \whizard.
 
 The data arguments are numeric, logical or string variables or expressions.
 Numeric expressions must be enclosed in parantheses.  Logical expressions must
 be enclosed in parantheses prefixed by a question mark \verb|?|.  String
 expressions must be enclosed in parantheses prefixed by a dollar sign
 \verb|$|.  These forms behave as anonymous variables.
 
 Note that for simply printing a text string, you may call \ttt{printf} with
 just a format string and no data arguments.
 
 Examples:
 \begin{code}
 printf "The W mass is %8f GeV" (mW)
 
 int i = 2
 int j = 3
 printf "%i + %i = %i" (i, j, (i+j))
 
 string $directory = "/usr/local/share"
 string $file = "foo.dat"
 printf "File path: %s/%s" ($directory, $file)
 \end{code}
 There is a related \ttt{sprintf} function, cf.~Sec.~\ref{sec:sprintf}.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \section{WHIZARD at next-to-leading order}
 \subsection{Prerequisites}
 A full NLO computation requires virtual matrix elements obtained from
 loop diagrams. Since \oMega\ cannot calculate such diagrams, external
 programs are used.  \whizard\ has a generic interface to matrix-element
 generators that are BLHA-compatible.
 Explicit implementations exist for \gosam, \openloops\ and \recola.
 
 %%%%%
 
 \subsubsection{Setting up \gosam}
 
 The installation of \gosam\ is detailed on the HepForge page
 \url{https://gosam/hepforge.org}.  We mention here some of the steps
 necessary to get it to be linked with \whizard.
 
 {\bf Bug in \gosam\ installation scripts:} In many versions of
 \gosam\ there is a bug in the installation scripts that is only
 relevant if \gosam\ is installed with superuser privileges. Then all
 files in \ttt{\$installdir/share/golem} do not have read privileges
 for normal users. These privileges must be given manually to all files
 in that directory.
 
 Prerequisites for \gosam\ to produce code for one-loop matrix elements
 are the scientific algebra program \ttt{form} and the generator of
 loop topologies and diagrams, \ttt{qgraf}.
 These can be accessed via their respective webpages
 \url{http://www.nikhef.nl/~form/} and
 \url{http://cfif.ist.utl.pt/~paulo/qgraf.html}. Note also that both
 \ttt{Java} and the Java runtime environment have to be installed in
 order for \gosam\ to properly work.  Furthermore, \ttt{libtool}
 needs to be installed.  A more convenient way to install \gosam, is the
 automatic installation script
 \url{https://gosam.hepforge.org/gosam_installer.py}.
 
 %%%%%
 
 \subsubsection{Setting up \openloops}
 \label{sec:openloops-setup}
 
 The installation of \openloops\ is explained in detail on the HepForge
 page \url{https://openloops.hepforge.org}.  In the following, the main
 steps for usage with \whizard\ are summarized.
 
 Please note that at the moment, \openloops\ cannot be installed such
 that in almost all cases the explicit \openloops\ package directory
 has to be set via \ttt{--with-openloops=<openloops\_dir>}.
 
 \openloops\ can be checked out with
 \begin{code}
   git clone https://gitlab.com/openloops/OpenLoops.git
 \end{code}
 The program can be build by running \ttt{scons} or \ttt{./scons}, a
 local version that is included in the \openloops\ directory.  This
 produces the script \ttt{./openloops}, which is the main hook for the
 further usage of the program.
 
 \openloops\ works by downloading prebuild process libraries, which have
 to be installed for each individual process. This requires the file
 \ttt{openloops.cfg}, which should contain
 the following content:
 \begin{code}
    [OpenLoops]
    process\_repositories=public, whizard\\
    compile\_extra=1
 \end{code}
 The first line instructs \openloops\ to also look for process libraries
 in an additional lepton collider repository.  The second line triggers
 the inclusion of $N+1$-particle tree-level matrix elements in the
 process directory, so that a complete NLO calculation including real
 amplitudes can be performed only with \openloops.
 
 The libraries can then be installed via
 \begin{code}
    ./openloops libinstall proc_name
 \end{code}
 A list of supported library names can be found on the \openloops\ web
 page.  Note that a process library also includes all possible permutated
 processes.  The process library \ttt{ppll}, for example, can also be
 used to compute the matrix elements for $e^+ e^- \rightarrow q \bar{q}$
 (massless quarks only).  The massive case of the top quark is handled in
 \ttt{eett}.  Additionally, there are process libraries for top and gauge
 boson decays, \ttt{tbw}, \ttt{vjj}, \ttt{tbln} and \ttt{tbqq}.
 
 Finally, \openloops\ can be linked to \whizard\ during configuration by
 including
 \begin{code}
   --enable-openloops --with-openloops=$OPENLOOPS_PATH,
 \end{code}
 where \ttt{\$OPENLOOPS\_PATH} is the directory the \openloops\
 executable is located in.  \openloops\ one-loop diagrams can then be
 used with the \sindarin\ option
 \begin{code}
   $loop_me_method = "openloops".
 \end{code}
 The functional tests which check the \openloops\ functionality require
 the libraries \ttt{ppll}, \ttt{eett} and \ttt{tbw} to be installed (note
 that \ttt{eett} is not contained in \ttt{ppll}).  During the
 configuration of \whizard, it is automatically checked that these two
 libraries, as well as the option \ttt{compile\_extra=1}, are present.
 
 \subsubsection{\openloops\ \sindarin\ flags}
 Several \sindarin\ options exist to control the behavior of \openloops.
 \begin{itemize}
   \item \ttt{openloops\_verbosity}:\\
     Decide how much \openloops\ output is printed. Can have values 0, 1
     and 2.
   \item \ttt{?openloops\_use\_cms}:\\
     Activates the complex mass scheme. For computations with decaying
     resonances like the top quark or W or Z bosons, this is the
     preferred option to avoid gauge-dependencies.
   \item \ttt{openloops\_phs\_tolerance}:\\
     Controls the exponent of \ttt{extra psp\_tolerance} in the BLHA
     interface, which is the numerical tolerance for the on-shell
     condition of external particles
   \item \ttt{openloops\_switch\_off\_muon\_yukawa}:\\
     Sets the Yukawa coupling of muons to zero in order to assure
     agreement with \oMega, which is possibly used for other
     components and per default does not take $H\mu\mu$ couplings
     into account.
   \item \ttt{openloops\_stability\_log}:\\
     Creates the directory \ttt{stability\_log}, which contains information
     about the performance of the matrix elements. Possible values are
     \begin{itemize}
     \item 0: No output (default),
     \item 1: On finish() call,
     \item 2: Adaptive,
     \item 3: Always
    \end{itemize}
   \item \ttt{?openloops\_use\_collier}: Use Collier as the reduction
     method (default true).
 \end{itemize}
 
 %%%%%
 
 \subsubsection{Setting up \recola}
 \label{sec:recola-setup}
 
 The installation of \recola\ is explained in detail on the HepForge page
 \url{https://recola.hepforge.org}. In the following the main steps for
 usage with \whizard\ are summarized. The minimal required version number
 of \recola\ is 1.3.0.
 
 \recola\ can be linked to \whizard\ during configuration by including
 \begin{code}
   --enable-recola
 \end{code}
 In case the \recola\ library is not in a standard path or a path
 accessible in the \ttt{LD\_LIBRARY\_PATH} (or
 \ttt{DYLD\_LIBRARY\_PATH}) of the operating system, then the option
 \begin{code}
    --with-recola=$RECOLA_PATH
 \end{code}
 can be set, where \ttt{\$RECOLA\_PATH} is the directory the
 \recola\ library is located in. \recola\ can then be used with the
 \sindarin\ option
 \begin{code}
   $method = "recola"
 \end{code}
 or any other of the matrix element methods.
 
 Note that there might be a clash of the \collier\ libraries when you
 have \collier\ installed both via \recola\ and via \openloops, but
 have compiled them with different \fortran\ compilers.
 
 %%%%%
 
 \subsection{NLO cross sections}
 An NLO computation can be switched on in \sindarin\ with
 \begin{code}
   process proc_nlo = in1, in2 => out1, ..., outN { nlo_calculation = <components> },
 \end{code}
 where the \ttt{nlo\_calculation} can be followed by a list of strings
 specifying the desired NLO-components to be integrated, i.e.
 \ttt{born}, \ttt{real}, \ttt{virtual}, \ttt{dglap}, (for hadron
 collisions) or \ttt{mismatch} (for the soft mismatch in
 resonance-aware computations) and \ttt{full}. The \ttt{full} option
 switches on all components and is required if the total NLO result is
 desired. For example, specifying
 \begin{code}
   nlo_calculation = born, virtual
 \end{code}
 will result in the computation of the Born and virtual component.
 
 The integration can be carried out in two different modes: Combined
 and separate integration.  In the separate integration mode, each
 component is integrated individually, allowing for a good overview of
 their contributions to the total cross section and a fine tuned
 control over the iterations in each component.  In the combined
 integration mode, all components are added up during integration so that
 the sum of them is evaluated.  Here, only one integration will be
 displayed.  The default method is the separate integration.
 
 The convergence of the integration can crucially be influenced by the
 presence of resonances.  A better convergence is in this case achieved
 activating the resonance-aware FKS subtraction,
 \begin{code}
   $fks_mapping_type = "resonances".
 \end{code}
 This mode comes with an additional integration component, the
 so-called soft mismatch.
 
 Note that you can modify the number of iterations in each component with
 the multipliers:
 \begin{itemize}
   \item \ttt{mult\_call\_real} multiplies the number of calls to be used
     in the integration of the real component. A reasonable choice is
     \ttt{10.0} as the real phase-space is more complicated than the Born
     but the matrix elements evaluate faster than the virtuals.
   \item \ttt{mult\_call\_virt} multiplies the number of calls to be used
     in the integration of the virtual component. A reasonable choice is
     \ttt{0.5} to make sure that the fast Born component only contributes
     a negligible MC error compared to the real and virtual components.
   \item \ttt{mult\_call\_dglap} multiplies the number of calls to be used
     in the integration of the DGLAP component.
 \end{itemize}
 
 \subsection{Fixed-order NLO events}
 \label{ss:fixedorderNLOevents}
 Fixed-order NLO events can also be produced in three different modes:
 Combined weighted, combined unweighted and separated weighted.
 \begin{itemize}
   \item \textbf{Combined weighted}\\
     In the combined mode, one single integration grid is produced, from
     which events are generated with the total NLO weight. The
     corresponding event file contains $N$ events with born-like
     kinematics and weight equal to $\mathcal{B} + \mathcal{V} +
     \sum_{\alpha_r} \mathcal{C}_{\alpha_r}$, where $\mathcal{B}$ is the
     Born matrix element, $\mathcal{V}$ is the virtual matrix element and
     $\mathcal{C}_{\alpha_r}$ are the subtraction terms in each singular
     region. For resonance-aware processes, also the mismatch value is
     added. Each born-like event is followed by $N_{\text{phs}}$
     associated events with real kinematics, i.e. events where one
     additional QCD particle is present. The corresponding real
     matrix-elements $\mathcal{R}_\alpha$ form the weight of these events.
     $N_{\text{phs}}$ the number of distinct phase spaces. Two phase spaces
     are distinct if they share the same resonance history but have
     different emitters. So, two $\alpha_r$ can share the same phase
     space index.
 
     The combined event mode is activated by
     \begin{code}
       ?combined_nlo_integration = true
       ?unweighted = false
       ?fixed_order_nlo_events = true
     \end{code}
     Moreover, the process must be specified at next-to-leading-order in its
     definition using \ttt{nlo\_calculation = full}.  \whizard\ then
     proceeds as in the usual simulation mode. I.e. it first checks
     whether integration grids are already present and uses them if they
     fit. Otherwise, it starts an integration.
   \item \textbf{Combined unweighted}\\
     The unweighted combined events can be generated by using the
     \powheg\ mode, cf. also the next subsection, but disabling the
     additional radiation and Sudakov factors with the
     \ttt{?powheg\_disable\_sudakov} switch:
     \begin{code}
       ?combined_nlo_integration = true
       ?powheg_matching = true
       ?powheg_disable_sudakov = true
     \end{code}
     This will produce events with Born kinematics and unit weights (as
     \ttt{?unweighted} is \ttt{true} by default).  The events are
     unweighted by using $\mathcal{B} + \mathcal{V} + \sum_{\alpha_r}
     (\mathcal{C}_{\alpha_r} + \mathcal{R}_{\alpha_r})$.  Of course, this
     only works when these weights are positive over the full
     phase-space, which is not guaranteed for all scales and regions at
     NLO.  However, for many processes perturbation theory works nicely
     and this is not an issue.
 
   \item \textbf{Separate weighted}\\
     In the separate mode, grids and events are generated for each
     individual component of the NLO process. This method is preferable
     for complicated processes, since it allows to individually tune each
     grid generation. Moreover, the grid generation is then trivially
     parallelized.  The event files either contain only Born
     kinematics with weight $\mathcal{B}$ or $\mathcal{V}$ (and mismatch
     in case of a resonance-aware process) or mixed Born and real
     kinematics for the real component like in the combined mode.
     However, the Born events have only the weight $\sum_{\alpha_r}
     \mathcal{C}_{\alpha_r}$ in this case.
 
     The separate event mode is activated by
     \begin{code}
       ?unweighted = false
       ?negative_weights = true
       ?fixed_order_nlo_events = true
     \end{code}
     Note that negative weights have to be switched on because, in contrast
     to the combined mode, the total cross sections of the individual
     components can be negative.
 
     Also, the desired component has to appear in the process NLO
     specification, e.g. using \ttt{nlo\_calculation = real}.
 \end{itemize}
 Weighted fixed-order NLO events are supported by any output format that
 supports weights like the \ttt{HepMC} format and unweighted NLO events
 work with any format. The output can either be written to disk or put
 into a FIFO to interface it to an analysis program without writing
 events to file.
 
 The weights in the real event output, both in the combined and separate
 weighted mode, are divided by a factor $N_{\text{phs}} + 1$. This
 is to account for the fact that we artificially increase the number of
 events in the output file.  Thus, the sum of all event weights correctly
 reproduces the total cross section.
 
 \subsection{\powheg\ matching}
 To match the NLO computation with a parton shower, \whizard\ supports
 the  \powheg\ matching.  It generates a distribution according to
 \begin{align}
   \label{eq:powheg}
   \text{d}\sigma &= \text{d}\Phi_n \,{\bar{B}_{\text{s}}}\,\biggl(
   {\Delta_{\text{s}}}(p_T^{\text{min}}\bigr) +
   \text{d}\Phi_{\text{rad}}\,{\Delta_{\text{s}}}(k_{\text{T}}(\Phi_{\text{rad}})\bigr)
   {\frac{R_{\text{s}}}B}\biggr) \quad \text{where} \\
   {\bar{B}_{\text{s}}} &= {B} + {\mathcal{V}} + \text{d}\Phi_{\text{rad}}\,
     {\mathcal{R}_{\text{s}}} \quad \text{and} \\
   {\Delta_{\text{s}}}(p_T) &= \exp\left[- \int{\text{d}\Phi_{\text{rad}}}
    {\frac{R_{\text{s}}}{B}}\; \theta\left(k_T^2(\Phi_{\text{rad}}) -
    p_T^2\right)\right]\;.
 \end{align}
 The subscript s refers to the singular part of the real component, cf.
 to the next subsection.  Eq.~\eqref{eq:powheg} produces either no or one
 additional emission.  These events can then either be analyzed directly
 or passed on to the parton shower\footnote{E.g. \pythiaeight\ has
 explicit examples for \powheg\ input, see also
 \url{http://home.thep.lu.se/Pythia/pythia82html/POWHEGMerging.html}.}
 for the full simulation.  You activate this with
 \begin{code}
   ?fixed_order_nlo_events = false
   ?combined_nlo_integration = true
   ?powheg_matching = true
 \end{code}
 The $p_T^{\text{min}}$ of Eq.~\eqref{eq:powheg} can be set with
 \ttt{powheg\_pt\_min}.  It sets the minimal scale for the \powheg\
 evolution and should be of order 1 GeV and set accordingly in the
 interfaced shower.  The maximal scale is currently given by \ttt{sqrts}
 but should in the future be changeable with \ttt{powheg\_pt\_min}.
 
 Note that the \powheg\ event generation needs an additional grid for
 efficient event generation that is automatically generated during
 integration.  Further options that steer the efficiency of this grid are
 \ttt{powheg\_grid\_size\_xi} and \ttt{powheg\_grid\_size\_y}.
 
 \subsection{Separation of finite and singular contributions}
 
 For both the pure NLO computations as well as the \powheg\ event
 generation, \whizard\ supports the partitioning of the real into finite
 and singular contributions with the flag
 \begin{code}
   ?nlo_use_real_partition = true
 \end{code}
 The finite contributions, which by definition should not contain soft or
 collinear emissions, will then integrate like a ordinary LO integration
 with one additional particle.  Similarly, the event generation will
 produce only real events without subtraction terms with Born kinematics
 for this additional finite component.  The \powheg\ event generation
 will also only use the singular parts.
 
 The current implementation uses the following parametrization
 \begin{align}
   R                 &= R_{\text{fin}} + R_{\text{sing}} \;,\\
   R_{\text{sing}}     &= R F(\Phi_{n+1}) \;,\\
   R_{\text{fin}}      &= R (1-F(\Phi_{n+1})) \;,\\
   F(\Phi_{n+1})     &=
   \begin{cases}
     1 & \text{if} \quad\exists\,(i,j)\in\mathcal{P}_{\text{FKS}}\quad \text{with} \quad
       \sqrt{(p_i+p_j)^2} < h + m_i + m_j  \\
     0 & \text{else}
   \end{cases} \;.
 \end{align}
 Thus, a point is {singular ($F=1$)}, if {any} of the {FKS tuples}
 forms an {invariant mass} that is {smaller than the hardness scale
 $h$}. This parameter is controlled in \sindarin\ with
 \ttt{real\_partition\_scale}.
 This simplifies in {massless case} to
 \begin{align}
   F(\Phi_{n+1}) =
   \begin{cases}
     1 & \text{if} \;\exists\,(i,j)\in\mathcal{P}_{\text{FKS}}\quad \text{with} \quad
       2 E_i E_j (1-\cos\theta_{ij}) < h^2  \\
     0 & \text{else}
   \end{cases} \;.
 \end{align}
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{Random number generators}
 \label{chap:rng}
 
 \section{General remarks}
 \label{sec:rng}
 
 The random number generators (RNG) are one of the crucialer points of Monte
 Carlo calculations, hence, giving those their ``randomness''. A decent
 multipurpose random generator covers
 \begin{itemize}
 \item reproducibility
 \item large period
 \item fast generation
 \item independence
 \end{itemize}
 of the random numbers. Therefore, special care is taken for the choice of the
 RNGs in \whizard{}. It is stated that \whizard{} utilizes \textit{pseudo}-RNGs,
 which are based on one (or more) recursive algorithm(s) and start-seed(s) to have
 reproducible sequences of numbers. In contrast, a genuine random generator relies
 on physical processes.
 
 \whizard\ ships with two completely different random number generators which can be
 selected by setting the \sindarin\ option
 \begin{code}
   $rng_method = "rng_tao"
 \end{code}
-Altough, \whizard{} sets a default seed, it is adviced to use a different one
+Although, \whizard{} sets a default seed, it is adviced to use a different one
 \begin{code}
   seed = 175368842
 \end{code}
 note that some RNGs do not allow certain seed values (e.g. zero seed).
 
 \section{The TAO Random Number Generator}
 \label{sec:tao}
 
 The TAO (``The Art Of'') random number generator is a lagged Fibonacci
 generator based upon (signed) 32-bit integer arithmetic and was proposed by
 Donald E. Knuth and is implemented in the \vamp\ package.
 The TAO random number generator is the default RNG of \whizard{}, but can additionally
 be set as \sindarin\ option
 \begin{code}
   $rng_method = rng_tao
 \end{code}
 
 The TAO random number generators is a subtractive lagged Fibonacci generator
 \begin{equation*}
   x_{j} = \left( x_{j-k} - x_{j-L} \right) \mod 2^{30}
 \end{equation*}
 with lags $k = 100$ and $l = 37$ and period length $\rho = 2^{30} - 2$.
 
 \section{The RNGStream Generator}
 \label{sec:rngstream}
 
 The RNGStream \cite{L_Ecuyer:2002} was originally implemented in \cpp\ with
 floating point arithmetic and has been ported to \fortranOThree{}. The RNGstream
 can be selected by the \sindarin\ option
 \begin{code}
   $rng_method = "rng_stream"
 \end{code}
 
 The RNGstream supports multiple independent streams and substreams of random
 numbers which can be directly accessed.
 
 The main advantage of the RNGStream lies in the domain of parallelization where
 different worker have to access different parts of the random number stream to
 ensure numerical reproducibility. The RNGstream provides exactly this property with its
 (sub)stream-driven model.
 
 Unfortunately, the RNGStream can only be used in combination with \vamptwo{}.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{Integration Methods}
 
 \section{The Monte-Carlo integration routine: \ttt{VAMP}}
 \label{sec:vamp}
 
 \vamp\ \cite{Ohl:1998jn}
 is a multichannel extension of the \vegas\ \cite{Lepage:1980dq}
 algorithm. For all possible singularities in the integrand, suitable
 maps and integration channels are chosen which are then weighted and
 superimposed to build the phase space parameterization. Both grids and
 weights are modified in the adaption phase of the integration.
 
 The multichannel integration algorithm is implemented as a
 \fortranNinetyFive\ library with the task of mapping out the integrand
 and finding suitable parameterizations being completely delegated to
 the calling program (\whizard\ core in this case). This makes the
 actual \vamp\ library completely agnostic of the model under
 consideration.
 
 \section{The next generation integrator: \ttt{VAMP2}}
 \label{sec:vamp2}
 
 \vamptwo\ is a modern implementation of the integrator package \vamp\ written
 in \fortranOThree\, providing the same features. The backbone integrator is
 still \vegas\ \cite{Lepage:1980dq}, although implemented differently as in
 \vamp{}.
 
 The main advantage over \vamp\ is the overall faster integration due to the usage
 of \fortranOThree{}, the possible usage of different random number generators
 and the complete parallelization of \vegas\ and the multichannel integration.
 
 \vamptwo{} can be set by the \sindarin{} option
 \begin{code}
   $integration_method = "vamp2"
 \end{code}
 
 It is said that the generated grids between \vamp{} and \vamptwo{} are
 incompatible.
 
 \subsection{Multichannel integration}
 \label{sec:multi-channel}
 
 The usual matrix elements do not factorise with respect to their integration
 variables, thus making an direct integration ansatz with VEGAS
 unfavorable.\footnote{One prerequisite for the VEGAS algorithm is that the
   integral factorises, and such produces only the best results for those.} Instead, we
 apply the multichannel ansatz and let VEGAS integrate each channel in a
 factorising mapping.
 
 The different structures of the matrix element are separated by a partition of
 unity and the respective mappings, such that each structure factorise at least
 once. We define the mappings $\phi_i : U \mapsto \Omega$, where $U$ is the unit
 hypercube and $\Omega$ the physical phase space. We refer to each mapping as a
 \textit{channel}. Each channel then gives rise to a probability density $g_i : U
 \mapsto [0, \infty)$, normalised to unity
 \begin{equation*}
   \int_0^1 g_i(\phi_i^{-1}(p)) \left| \frac{\partial \phi_i^{-1}}{\partial p} \right| \mathrm{d}\mu(p) = 1, \quad g_i(\phi_i^{-1}(p)) \geq 0,
 \end{equation*}
 written for a phase space point $p$ using the mapping $\phi_i$.
 The \textit{a-priori} channel weights $\alpha_i$ are defined as partition of
 unity by $\sum_{i\in I} \alpha_i = 1$ and $0 \leq \alpha_i \leq 1$. The overall
 probability density $g$ of a random sample is then obtained by
 \begin{equation*}
   g(p) = \sum_{i \in I} \alpha_i g_i(\phi_i^{-1}(p)) \left| \frac{\partial \phi_i^{-1}}{\partial p} \right|,
 \end{equation*}
 which is also a non-negative and normalized probability density.
 
 We reformulate the integral
 \begin{equation*}
   I(f) = \sum_{i \in I} \alpha_i \int_\Omega g_i(\phi_i^{-1}(p)) \left| \frac{\partial \phi_i^{-1}}{\partial p} \right| \frac{f(p)}{g(p)} \mathrm{d}\mu(p).
 \end{equation*}
 The actual integration of each channel is then done by VEGAS, which shapes the $g_i$.
 
 \subsection{VEGAS}
 \label{sec:vegas}
 
 VEGAS is an adaptive and iterative Monte Carlo algorithm for integration using
 importance sampling. After each iteration, VEGAS adapts the probability density
 $g_i$ using information collected while sampling. For independent
 integration variables, the probability density factorises $g_i = \prod_{j =
   1}^{d} g_{i,j}$ for each integration axis and each (independent) $g_{i,j}$ is
 defined by a normalised step function
 \begin{equation*}
   g_{i,j} (x_j) = \frac{1}{N\Delta x_{j,k}}, \quad x_{j,k} - \Delta x_{j,k} \leq x_{j} < x_{j,k},
 \end{equation*}
 where the steps are $0 = x_{j, 0} < \cdots < x_{j,k} < \cdots < x_{j,N} = 1$ for
 each dimension $j$.
 The algorithm randomly selects for each dimension a bin and a position inside
 the bin and calculates the respective $g_{i,j}$.
 
 \subsection{Channel equivalences}
 \label{sec:equivalences}
 
 The automated mulitchannel phasespace configuration can lead to a surplus of
 degrees of freedom, e.g. for a highly complex process with a large number of
 channels (VBS). In order to marginalize the redundant degrees of freedom of
 phasespace configuration, the adaptation distribution of the grids are aligned in accordance to their
 phasespace relation, hence the binning of the grids is equialized. These equivalences are activated by
 default for \vamp{} and \vamptwo{}, but can be steered by:
 
 \begin{code}
   ?use_vamp_equivalences = true
 \end{code}
 
 Be aware, that the usage of equivalences are currently only possible for LO
 processes.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{Phase space parameterizations}
 
 \section{General remarks}
 
 \whizard\ as a default performs an adaptive multi-channel Monte-Carlo
 integration. Besides its default phase space algorithm, \ttt{wood}, to
 be detailed in Sec.~\ref{sec:wood}, \whizard\ contains a phase space
 method \ttt{phs\_none} which is a dummy method that is intended for
 setups of processes where no phase space integration is needed, but
 the program flow needs a (dummy) integrator for internal
 consistency. Then, for testing purposes, there is a single-channel
 phase space integrator, \ttt{phs\_single}. From version 2.6.0 of
 \whizard\ on, there is also a second implementation of the \ttt{wood}
 phase space algorithm, called \ttt{fast\_wood},
 cf. Sec.~\ref{sec:fast_wood}, whose implementation differs technically
 and which therefore solves certain technical flaws of the \ttt{wood}
 implementation.
+Additionally, \whizard\ supports single-channel, flat phase-space using RAMBO
+(on diet).
+
+\section{The flat method: \ttt{rambo}}
+\label{sec:rambo}
+
+The \ttt{RAMBO} algorithm produces a flat phase-space with constant volume for
+massless particles. \ttt{RAMBO} was originally published in
+\cite{Kleiss:1985gy}. We use the slim version, called \ttt{RAMBO} on diet,
+published in \cite{Platzer:2013esa}.
+The overall weighting efficiency of the algorithm is unity for massless
+final-state particles. For the massive case, the weighting efficiency of unity will
+decrease rendering the algorithm less efficient. But in most cases, the
+invariants are in regions of phase space where they are much larger than the
+masses of the final-state particles.
+
+We provide the \ttt{RAMBO} mainly for cross checking our implementation and do
+not recommend it for real world application, even though it can be used as one.
 
 \section{The default method: \ttt{wood}}
 \label{sec:wood}
 
 The \ttt{wood} algorithm classifies different phase space channels
 according to their importance for a full scattering or decay process
 following heuristic rules. For that purpose, \whizard\ investigates
 the kinematics of the different channels depending on the total
 center-of-mass energy (or the mass of the decaying particle) and the
 masses of the final-state particles.
 
 The \ttt{wood} phase space inherits its name from the naming schemes
 of structures of increasing complexities, namely trees, forests and
 groves. Simply stated, a phase-space forest is a collection of
 phase-space trees. A phase-space tree is a parameterization for a
 valid channel in the multi-channel adaptive integration, and each
 variable in the a tree corresponds to an integration dimension,
 defined by an appropriate mapping of the $(0,1)$ interval of the unit
 hypercube to the allowed range of the corresponding integration
 variable. The whole set of these phase-space trees, collected in a
 phase-space forest object hence contains all parameterizations of the
 phase space that \whizard\ will use for a single hard process. Note
 that processes might contain flavor sums of particles in the final
 state. As \whizard\ will use the same phase space parameterization for
 all channels for this set of subprocesses, all particles in those
 flavor sums have to have the same mass. E.g. in the definition of a
 "light" jet consisting of the first five quarks and antiquarks,
 \begin{code}
   alias jet = u:d:s:c:b:U:D:S:C:B
 \end{code}
 all quarks including strange, charm and bottom have to be massless for
 the phase-space integration. \whizard\ can treat processes with
 subprocesses having final-state particles with different masses in an
 "additive" way, where each subprocess will become a distinct component
 of the whole process. Each process component will get its own
 phase-space parameterization, such that they can allow for different
 masses. E.g. in a 4-flavor scheme for massless $u,d,s,c$ quarks one
 can write
 \begin{code}
   alias jet = u:d:s:c:U:D:S:C
   process eeqq = e1, E1 => (jet, jet) + (b, B)
 \end{code}
 In that case, the parameterizations will be for massless final state
 quarks for the first subprocess, and for massive $b$ quarks for the
 second subprocess. In general, for high-energy lepton colliders, the
 difference would not matter much, but performing the integration
 e.g. for $\sqrt{s} = 11$ GeV, the difference will be
 tremendous. \whizard\ avoids inconsistent phase-space
 parameterizations in that way.
 
 As a multi-particle process will contain hundred or thousands of
 different channels, the different integration channels (trees) are
 grouped into so called {\em groves}. All channels/trees in the same
 grove share a common weight for the phase-space integration, following
 the assumption that they are related by some approximate symmetry. The
 \vamp\ adaptive multi-channel integrator (cf. Sec.~\ref{sec:vamp})
 allows for equivalences between different integration channels. This
 means that trees/channels that are related by an exact symmetry are
 connected by an array of these equivalences.
 
 The phase-space setup, i.e. the detailed structure of trees and
 forests, are written by \whizard\ into a phase-space file that has the
 same name as the corresponding process (or process component) with the
 suffix \ttt{.phs}. For the \ttt{wood} phase-space method this file is
 written by a \fortran\ module which constructs a similar tree-like
 structure as the directed acyclical graphs (DAGs) in the
 \oMega\ matrix element generator but in a less efficient way.
 
 In some very rare cases with externally generated models
 (cf. Chapter~\ref{chap:extmodels}) the phase-space generation has been
 reported to fail as \whizard\ could not find a valid phase-space
 channel. Such pathological cases cannot occur for the hard-coded model
 implementations inside \whizard. They can only happen if there are in
 principle two different Feynman diagrams contributing to the same
 phase-space channel and \whizard\ considers the second one as
 extremely subleading (and would hence drop it). If for some reason
 however the first Feynman diagram is then absent, no phase-space
 channel could be found. This problem cannot occur with the
 \ttt{fast\_wood} implementation discussed in the next section,
 cf.~\ref{sec:fast_wood}.
 
 The \ttt{wood} algorithms orders the different groves of phase-space
 channels according to a heuristic importance depending on the
 kinematic properties of the different phase-space channels in the
 groves. A phase-space (\ttt{.phs}) file looks typically like this:
 \begin{code}
  process sm_i1
 
 ! List of subprocesses with particle bincodes:
 !  8  4      1   2
 ! e+ e- => mu+ mu-
 !  8  4      1   2
 
    md5sum_process    = "1B3B7A30C24664A73D3D027382CFB4EF"
    md5sum_model_par  = "7656C90A0B2C4325AD911301DACF50EB"
    md5sum_phs_config = "6F72D447E8960F50FDE4AE590AD7044B"
    sqrts         =  1.000000000000E+02
    m_threshold_s =  5.000000000000E+01
    m_threshold_t =  1.000000000000E+02
    off_shell = 2
    t_channel = 6
    keep_nonresonant = T
 
  ! Multiplicity = 2, no resonances,  0 logs,  0 off-shell,  s-channel graph
  grove #1
  ! Channel #1
    tree  3
 
  ! Multiplicity = 1, 1 resonance,   0 logs,  0 off-shell,  s-channel graph
  grove #2
  ! Channel #2
    tree  3
    map   3 s_channel      23 ! Z
 \end{code}
 The first line contains the process name, followed by a list of
 subprocesses with the external particles and their binary codes. Then
 there are three lines of MD5 check sums, used for consistency
 checks. \whizard\ (unless told otherwise) will check for the existence
 of a phase-space file, and if the check sum matches, it will reuse the
 existing file and not generate it again. Next, there are several
 kinematic parameters, namely the center-of-mass energy of the process,
 \ttt{sqrts}, and two mass thresholds, \ttt{m\_threshold\_s} and
 \ttt{m\_threshold\_t}. The latter two are kinematical thresholds,
 below which \whizard\ will consider $s$-channel and $t$-channel-like
 kinematic configurations as effectively massless, respectively. The
 default values shown in the example have turned out to be optimal
 values for Standard Model particles. The two integers \ttt{off\_shell}
 and \ttt{t\_channel} give the number of off-shell lines and of
 $t$-channel lines that \whizard\ will allow for finding valid
 phase-space channels, respectively. This neglects extremley multi-peripheral
 background-like diagram constellations which are very subdominamnt
 compared to resonant signal processes. The final flags specifies
 whether \whizard\ will keep non-resonant phase-space channels
 (default), or whether it will focus only on resonant situations.
 
 After this header, there is a list of all groves, i.e. collections of
 phase-space channels which are connected by quasi-symmetries, together
 with the corresponding multiplicity of subchannels in that
 grove. In the phase-space file, Behind the multiplicity
 \whizard\ denotes the number of (massive) resonances, logarithmcally
 enhanced kinematics (e.g. collinear regions), and number of off-shell
 lines, respectively. The final entry in the grove header notifies
 whether the diagrams in that grove have $s$-channel topologies, or
 count the number of corresponding $t$-channel lines.
 
 Another example is shown here,
 \begin{code}
  ! Multiplicity = 3, no resonances,  2 logs,  0 off-shell,  1 t-channel line
  grove #1
  ! Channel #1
    tree  3 12
    map   3 infrared       22 ! A
    map  12 t_channel       2 ! u
  ! Channel #2
    tree  3 11
    map   3 infrared       22 ! A
    map  11 t_channel       2 ! u
  ! Channel #3
    tree  3 20
    map   3 infrared       22 ! A
    map  20 t_channel       2 ! u
  ! Channel #4
    tree  3 19
    map   3 infrared       22 ! A
    map  19 t_channel       2 ! u
 \end{code}
 where \whizard\ notifies in different situations a photon exchange as
 \ttt{infrared}. So it detects a possible infrared singularity where a
 particle can become arbitrarily soft. Such a situation can tell the
 user that there might be a cut necessary in order to get a meaningful
 integration result.
 
 The phase-space setup that is generated and used by the \ttt{wood}
 phase-space method can be visualized using the \sindarin\ option
 \begin{code}
   ?vis_channels = true
 \end{code}
 
 The \ttt{wood} phase-space method can be invoked with the
 \sindarin\ command
 \begin{code}
   $phs_method = "wood"
 \end{code}
 Note that this line is unnecessary, as \ttt{wood} is the default
 phase-space method of \whizard.
 
 %%%%%
 
 \section{A new method: \ttt{fast\_wood}}
 \label{sec:fast_wood}
 
 This method (which is available from version 2.6.0 on) is an
 alternative implementation of the \ttt{wood} phase-space algorithm. It
 uses the recursive structures inside the \oMega\ matrix element
 generator to generate all the structures needed for the different
 phase-space channels. In that way, it can avoid some of the
 bottlenecks of the \ttt{wood} \fortran\ implementation of the
 algorithm. On the other hand, it is only available if the
 \oMega\ matrix element generator has been enabled (which is the
 default for \whizard). The \ttt{fast\_wood} method is then invoked via
 \begin{code}
   ?omega_write_phs_output = true
   $phs_method = "fast_wood"
 \end{code}
 The first option is necessary in order to tell \oMega\ to write out
 the output needed for the \ttt{fast\_wood} parser in order to generate
 the phase-space file. This is not enabled by default in order not to
 generate unnecessary files in case the default method \ttt{wood} is
 used.
 
 So the \ttt{fast\_wood} implementation of the \ttt{wood} phase-space
 algorithm parses the tree-like represenation of the recursive set of
 one-particle off-shell wave functions that make up the whole amplitude
 inside \oMega\ in the form of a directed acyclical graph (DAG) in
 order to generate the phase-space (\ttt{.phs}) file
 (cf. Sec.~\ref{sec:wood}). In that way, the algorithm makes sure that
 only phase-space channels are generated for which there are indeed
 (sub)amplitudes in the matrix elements, and this also allows to
 exclude vetoed channels due to restrictions imposed on the matrix
 elements from the phase-space setup (cf. next
 Sec.~\ref{sec:ps_restrictions}).
 
 %%%%%
 
 \section{Phase space respecting restrictions on subdiagrams}
 \label{sec:ps_restrictions}
 
 The \fortran\ implementation of the \ttt{wood} phase-space does not
 know anything about possible restrictions that maybe imposed on the
 \oMega\ matrix elements, cf. Sec.~\ref{sec:process options}.
 Consequently, the \ttt{wood} phase space also generates phase-space
 channels that might be absent when restrictions are imposed. This is
 not a principal problem, as in the adaptation of the phase-space
 channels \whizard's integrator \vamp\ will recognize that there is
 zero weight in that channel and will drop the channel (stop sampling
 in that channel) after some iterations. However, this is a waste of
 ressources as it is in principle known that this channel is
 absent. Using the \ttt{fast\_wood} phase-space algorithm
 (cf. Sec.~\ref{sec:fast_wood} will take restrictions into account, as
 \oMega\ will not generate trees for channels that are removed with the
 restrictions command. So it advisable for the user in the case of very
 complicated processes with restrictions to use the \ttt{fast\_wood}
 phase-space method to make \whizard\ generation and integration of the
 phase space less cumbersome.
 
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{Methods for Hard Interactions}
 \label{chap:hardint}
 
 The hard interaction process is the core of any physics simulation
 within an MC event generator. One tries to describe the dominant
 particle interaction in the physics process of interest at a given
 order in perturbation theory, thereby making use of field-theoretic
 factorization theorems, especially for QCD, in order to separate
 non-perturbative physics like parton distribution functions (PDFs) or
 fragmentation functions from the perturbative part. Still, it is in
 many cases not possible to describe the perturbative part completely
 by means of fixed-order hard matrix elements: in soft and/or collinear
 regions of phase space, multiple emission of gluons and quarks (in
 general QCD jets) and photons necessitates a resummation, as large
 logarithms accompany the perturbative coupling constants and render
 fixed-order perturbation theory unreliable. The resummation of these
 large logarithms can be done analytically or (semi-)numerically,
 however, usually only for very inclusive quantities. At the level of
 exclusive events, these phase space regions are the realm of (QCD and
 also QED) parton showers that approximate multi-leg matrix elements
 from the hard perturbative into to the soft-/collinear regime.
 
 The hard matrix elements are then the core building blocks of the
 physics description inside the MC event generator. \whizard\ generates
 these hard matrix elements at tree-level (or sometimes for
 loop-induced processes using effective operators as insertions) as
 leading-order processes. This is done by the \oMega\ subpackage that
 is automatically called by \whizard. Besides these physical matrix
 elements, there exist a couple of methods to generate dummy matrix
 elements for testing purposes, or for generating beam profiles and
 using them with externally linked special matrix elements.
 
 Especially for one-loop processes (next-to-leading order for
 tree-allowed processes or leading-order for loop-induced processes),
 \whizard\ allows to use matrix elements from external providers, so
 called OLP programs (one-loop providers). Of course, all of these
 external packages can also generate tree-level matrix elements, which
 can then be used as well in \whizard.
 
 We start the discussion with the two different options for test matrix
 elements, internal test matrix elements with no generated compiled code
 in Sec.~\ref{sec:test_me} and so called template matrix elements with
 actual \fortran\ code that is compiled and linked, and can also be
 modified by the user in Sec.~\ref{sec:template_me}. Then, we move to
 the main matrix element method by the matrix element generator
 \oMega\ in Sec.~\ref{sec:omega_me}. Matrix elements from the external
 matrix element generators are discussed in the order of which
 interfaces for the external tools have been implemented: \gosam\ in
 Sec.~\ref{sec:gosam_me}, \openloops\ in Sec.~\ref{sec:openloops_me},
 and \recola\ in Sec.~\ref{sec:recola_me}.
 
 %%%%%
 
 \section{Internal test matrix elements}
 \label{sec:test_me}
 
 This method is merely for internal consistency checks inside \whizard,
 and is not really intended to be utilized by the user. The method is
 invoked by
 \begin{code}
   $method = "unit_test"
 \end{code}
 This particular method is only applicable for the internal test model
 \ttt{Test.mdl}, which just contains a Higgs boson and a top
 quark. Technically, it will also works within model specifications
 for the Standard Model, or the Minimal Supersymmetric Standard Model
 (MSSM), or all models which contain particles named as \ttt{H} and
 \ttt{t} with PDG codes 25 and 6, respectively. So, the models
 \ttt{QED} and {QCD} will not work. Irrespective of what is given in
 the \sindarin\ file as a scattering input process, \whizard\ will
 always take the process
 \begin{code}
   model = SM
   process <proc_name>= H, H => H, H
 \end{code}
 or for the test model:
 \begin{code}
   model = Test
   process <proc_name>= s, s => s, s
 \end{code}
 as corresponding process. (This is the same process, just with
 differing nomenclature in the different models). No matrix element
 code is generated and compiled, the matrix element is completely
 internal, included in the \whizard\ executable (or library), with a
 unit value for the squared amplitude. The integration will always be
 performed for this particularly process, even if the user provides a
 different process for that method. Hence, the result will always be
 the volume of the relativistic two-particle phase space. The only two
 parameters that influence the result are the collider energy,
 \ttt{sqrts}, and the mass of the Higgs particle with PDG code 25 (this
 mass parameter can be changed in the model \ttt{Test} as \ttt{ms},
 while it would be \ttt{mH} in the Standard Model \ttt{SM}.
 
 It is also possible to use a test matrix element, again internal, for
 decay processes, where again \whizard\ will take a predefined process:
 \begin{code}
   model = SM
   process <proc_name> = H => t, tbar
 \end{code}
 in the \ttt{SM} model or
 \begin{code}
   model = Test
   process <proc_name> = s => f, fbar
 \end{code}
 Again, this is the same process with PDG codes $25 \to 6 \; -6$ in the
 corresponding models. Note that in the model \ttt{SM} the mass of the
 quark is set via the variable \ttt{mtop}, while it is \ttt{mf} in the
 model \ttt{Test}.
 
 Besides the fact that the user always gets a fixed process and cannot
 modify any matrix element code by hand, one can do all things as for a
 normal process like generating events, different weights, testing
 rebuild flags, using different setups and reweight events
 accordingly. Also factorized processes with production and decay can
 be tested that way.
 
 In order to avoid confusion, it is highly recommended to use this
 method \ttt{unit\_test} only with the test model setup, model
 \ttt{Test}.
 
 On the technical side, the method \ttt{unit\_test} does not produce a
 process library (at least not an externally linked one), and also not
 a makefile in order to modify any process files (which anyways do not
 exist for that method). Except for the logfiles and the phase space
 file, all files are internal.
 
 %%%%%
 
 \section{Template matrix elements}
 \label{sec:template_me}
 
 Much more versatile for the user than the previous matrix element
 method in~\ref{sec:test_me}, are two different methods with constant
 template matrix elements. These are written out as \fortran\ code by
 the \whizard\ main executable (or library), providing an interface
 that is (almost) identical to the matrix element code produced by the
 \oMega\ generator (cf. the next section,
 Sec.~\ref{sec:omega_me}. There are actually two different methods for
 that purpose, providing matrix elements with different normalizations:
 \begin{code}
   $method = "template"
 \end{code}
 generates matrix elements which give after integration over phase
 space exactly one. Of course, for multi-particle final states the
 integration can fluctuate numerically and could then give numbers that
 are only close to one but not exactly one. Furthermore, the
 normalization is not exact if any of the external particles have
 non-zero masses, or there are any cuts involved. But otherwise, the
 integral from \whizard\ should give unity irrespective of the number
 of final state particles.
 
 In contrast to this, the second method,
 \begin{code}
   $method = "template_unity"
 \end{code}
 gives a unit matrix elements, or rather a matrix element that contains
 helicity and color averaging factors for the initial state and the
 square root of the factorials of identical final state particles in
 the denominator. Hence, integration over the final state momentum
 configuration gives a cross section that corresponds to the volume of
 the $n$-particle final state phase space, divided by the corresponding
 flux factor, resulting in
 \begin{equation}
   \sigma(s, 2 \to 2,0) = \frac{3.8937966\cdot 10^{11}}{16\pi} \cdot
   \frac{1}{s \text{[GeV]}^2} \; \text{fb}
 \end{equation}
 for the massless case and
 \begin{equation}
   \sigma(s, 2 \to 2,m_i) = \frac{3.8937966\cdot 10^{11}}{16\pi} \cdot
   \sqrt{\frac{\lambda (s,m_3^2,m_4^2)}{\lambda (s,m_1^2,m_2^2)}}
   \cdot \frac{1}{s \text{[GeV]}^2} \; \text{fb}
 \end{equation}
 for the massive case. Here, $m_1$ and $m_2$ are the masses of the
 incoming, $m_3$ and $m_4$ the masses of the outgoing particles, and
 $\lambda(x,y,z) = x^2 + y^2 + z^2 - 2xy - 2xz - 2yz$.
 
 For the general massless case with no cuts, the integral should be
 exactly
 \begin{equation}
   \sigma(s, 2\to n, 0) = \frac{(2\pi)^4}{2 s}\Phi_n(s)
   = \frac{1}{16\pi s}\,\frac{\Phi_n(s)}{\Phi_2(s)},
 \end{equation}
 where the volume of the massless $n$-particle phase space is
 given by
 \begin{equation}\label{phi-n}
   \Phi_n(s) = \frac{1}{4(2\pi)^5} \left(\frac{s}{16\pi^2}\right)^{n-2}
   \frac{1}{(n-1)!(n-2)!}.
 \end{equation}
 For $n\neq2$ the phase space volume is dimensionful, so the
 units of the integral are $\fb\times\GeV^{2(n-2)}$. (Note that for
 physical matrix elements this is compensated by momentum factors from
 wave functions, propagators, vertices and possibly dimensionful
 coupling constants, but here the matrix element is just equal to
 unity.)
 
 Note that the phase-space integration for the \ttt{template} and
 \ttt{template\_unity} matrix element methods is organized in the same
 way as it would be for the real $2\to n$ process.  Since such a phase
 space parameterization is not optimized for the constant matrix
 element that is supplied instead, good convergence is not guaranteed.
 (Setting \ttt{?stratified = true} may be helpful here.)
 
 The possibility to call a dummy matrix element with this method allows
 to histogram spectra or structure functions: Choose a trivial process
 such as $uu\to dd$, select the \ttt{template\_unity} method, switch
 on structure functions for one (or both) beams, and generate events.
 The distribution of the final-state mass squared reflects the $x$
 dependence of the selected structure function.
 
 Furthermore, the constant in the source code of the unit matrix
 elements can be easily modified by the user with their \fortran\ code
 in order to study customized matrix elements. Just rerun
 \whizard\ with the \ttt{--recompile} option after the modification of
 the matrix element code.
 
 Both methods, \ttt{template} and \ttt{template\_unity} will also work
 even if no \ocaml\ compiler is found or used and consequently the
 \oMega\ matrix elemente generator (cf. Sec.~\ref{sec:omega_me} is
 disable. The methods produce a process library for their corresponding
 processes, and a makefile, by  which \whizard\ steers compilation and
 linking of the process source code.
 
 %%%%%
 
 \section{The O'Mega matrix elements}
 \label{sec:omega_me}
 
 \oMega\ is a subpackage of \whizard, written in \ocaml, which can
 produce matrix elements for a wide class of implemented physics models
 (cf. Sec.~\ref{sec:smandfriends} and \ref{sec:bsmmodels} for a list of
 all implemented physics models), and even almost arbitrary models when
 using external Lagrange level tools, cf. Chap.~\ref{chap:extmodels}.
 There are two different variants for matrix elements from \oMega:
 the first one is invoked as
 \begin{code}
   $method = "omega"
 \end{code}
 and is the default method for \whizard. It produces matrix element as
 \fortran\ code which is then compiled and linked. An alternative
 method, which for the moment is only available for the Standard Model
 and its variants as well models which are quite similar to the SM,
 e.g. the Two-Higgs doublet model or the Higgs-singlet extension. This
 method is taken when setting
 \begin{code}
   $method = "ovm"
 \end{code}
 The acronym \ttt{ovm} stands for \oMega\ Virtual Machine (OVM). The
 first (default) method (\ttt{omega}) of \oMega\ matrix elements
 produces \fortran\ code for the matrix elements,that is compiled by
 the same compiler with which \whizard\ has been compiled. The OVM
 method (\ttt{ovm}) generates an \ttt{ASCII} file with so called op
 code for operations. These are just numbers which tell what numerical
 operations are to be performed on momenta, wave functions and vertex
 expression in order to yield a complex number for the amplitude. The
 op codes are interpreted by the OVM in the same as a Java Virtual
 Machine. In both cases, a compiled \fortran\ is generated which for
 the \ttt{omega} method contains the full expression for the matrix
 element as \fortran\ code, while for the \ttt{ovm} method this is the
 driver file of the OVM. Hence, for the \ttt{ovm} method this file
 always has roughly the same size irrespective of the complexity of the
 process. For the \ttt{ovm} method, there will also be the \ttt{ASCII}
 file that contains the op codes, which has a name with an \ttt{.hbc}
 suffix: \ttt{<process\_name>.hbc}.
 
 For both \oMega\ methods, there will be a process library created as
 for the template matrix elements (cf. Sec.~\ref{sec:template_me})
 named \ttt{default\_lib.f90} which can be given a user-defined name
 using the \ttt{library = "<library>"} command. Again, for both methods
 \ttt{omega} and \ttt{ovm}, a makefile named
 \ttt{<library>\_lib.makefile} is generated by which \whizard\ steers
 compilation, linking and clean-up of the process sources. This
 makefile can handily be adapted by the user in case she or he wants to
 modify the source code for the process (in the case of the source code
 method).
 
 Note that \whizard's default ME method via \oMega\ allows the user to
 specify many different options either globally for all processes in
 the \sindarin, or locally for each process separately in curly
 brackets behind the corresponding process definition. Examples are
 \begin{itemize}
 \item
   Restrictions for the matrix elements like the exclusion of
   intermediate resonances, the appearance of specific vertices or
   coupling constants in the matrix elments. For more details on this
   cf. Sec.~\ref{subsec:restrictions}.
 \item
   Choice of a specific scheme for the width of massive intermediate
   resonances, whether to use constant width, widths only in
   $s$-channel like kinematics (this is the default), a fudged-width
   scheme or the complex-mass scheme. The latter is actually steered as
   a specific scheme of the underlying model and not with a specific
   \oMega\ command.
 \item
   Choice of the electroweak gauge for the amplitude. The default is
   the unitary gauge.
 \end{itemize}
 With the exception of the restrictions steered by the
 \ttt{\$restrictions = "<restriction>"} string expression, these options
 have to be set in their specific \oMega\ syntax verbatim via the
 string command \ttt{\$omega\_flags = "<expr>"}.
 
 
 
 %%%%%
 
 \section{Interface to GoSam}
 \label{sec:gosam_me}
 
 One of the supported methods for automated matrix elements from
 external providers is for the \gosam\ package. This program package
 which is a combination of \python\ scripts and \fortran\ libraries,
 allows both for tree and one-loop matrix elements (which is leading or
 next-to-leading order, depending on whether the corresponding process
 is allowed at the tree level or not). In principle, the advanced
 version of \gosam\ also allows for the evaluation of two-loop virtual
 matrix elements, however, this is currently not supported in
 \whizard. This method is invoked via the command
 \begin{code}
   $method = "gosam"
 \end{code}
 Of course, this will only work correctly of \gosam\ with all its
 subcomponents has been correctly found during configuration of
 \whizard\ and then subsequently correctly linked.
 
 In order to generate the tables for spin, flavor and color states for
 the  corresponding process, first \oMega\ is called to provide
 \fortran\ code for the interfaces to all the metadata for the
 process(es) to be evaluated. Next, the \gosam\ \python\ script is
 automatically invoked that first checks for the necessary ingredients
 to produce, compile and link the \gosam\ matrix elements. These are
 the the \ttt{Qgraf} topology generator for the diagrams, \ttt{Form} to
 perform algebra, the \ttt{Samurai}, \ttt{AVHLoop}, \ttt{QCDLoop} and
 \ttt{Ninja} libraries for Passarino-Veltman reduction, one-loop tensor
 integrals etc. As a next step, \gosam\ automatically writes and
 executes a \ttt{configure} script, and then it exchanges the Binoth
 Les Houches accord (BLHA) contract files between \whizard\ and
 itself~\cite{Binoth:2010xt,Alioli:2013nda} to check whether it
 actually generate code for the demanded process at the given
 order. Note that the contract and answer files do not have to be
 written by the user by hand, but are generated automatically within
 the program work flow initiated by the original
 \sindarin\ script. \gosam\ then generates \fortran\ code for the
 different components of the processes, compiles it and links it into a
 library, which is then automatically accessible (as an external
 process library) from inside \whizard. The phase space setup and the
 integration as well as the LO (and NLO) event generation work then in
 exactly the same way as for \oMega\ matrix elements.
 
 As an NLO calculation consists of different components for the Born,
 the real correction, the virtual correction, the subtraction part and
 possible further components depending on the details of the
 calculation, there is the possible to separately choose the matrix
 element method for those components via the keywords
 \ttt{\$loop\_me\_method}, \ttt{\$real\_tree\_me\_method},
 \ttt{\$correlation\_me\_method}  etc. These
 keywords overwrite the master switch of the \ttt{\$method} keyword.
 
 For more information on the switches and details of the functionality
 of \gosam, cf. \url{http://gosam.hepforge.org}.
 
 %%%%%
 
 \section{Interface to Openloops}
 \label{sec:openloops_me}
 
 Very similar to the case of \gosam, cf. Sec.~\ref{sec:gosam_me}, is
 the case for \openloops\ matrix elements. Also here, first \oMega\ is
 called in order to provide an interface for the spin, flavor and color
 degrees of freedom for the corresponding process. Information exchange
 between \whizard\ and \openloops\ then works in the same automatic way
 as for \gosam\ via the BLHA interface. This matrix element method is
 invoked via
 \begin{code}
   $method = "openloops"
 \end{code}
 This again is the master switch that will tell \whizard\ to use
 \openloops\ for all components, while there are special keywords to
 tailor-make the setup for the different components of an NLO
 calculation (cf. Sec.~\ref{sec:gosam_me}.
 
 The main difference between \openloops\ and \gosam\ is that for
 \openloops\ there is no process code to be generated, compiled and
 linked for a process, but a precompiled library is called and linked,
 e.g. \ttt{ppll} for the Drell-Yan process. Of course, this library has
 to be installed on the system, but if that is not the case, the user
 can execute the \openloops\ script in the source directory of
 \openloops\ to download, compile and link the corresponding dynamic
 library. This limits (for the moment) the usage of \openloops\ to
 processes where pre-existint libraries for that specific processes
 have been generated by the \openloops\ authors. A new improved
 generator for general process libraries for \openloops\ will get rid
 of that restriction.
 
 For more information on the installation, switches and details of the
 functionality of \openloops, cf. \url{http://openloops.hepforge.org}.
 
 %%%%%
 
 \section{Interface to Recola}
 \label{sec:recola_me}
 
 The third one-loop provider (OLP) for external matrix elements that
 is supported by \whizard, is \recola. In contrast to \gosam,
 cf. Sec.~\ref{sec:gosam_me}, and \openloops,
 cf. Sec.~\ref{sec:openloops_me}, \recola\ does not use a BLHA
 interface to exchange information with \whizard, but its own
 tailor-made C interoperable library interface to communicate to the
 Monte Carlo side. \recola\ matrix elements are called for via
 \begin{code}
   $method = "recola"
 \end{code}
 \recola\ uses a highly efficient algorithm to generate process code
 for LO and NLO SM amplitudes in a fully recursive manner. At the
 moment, the setup of the interface within \whizard\ does not allow to
 invoke more than one different process in \recola: this would lead to
 a repeated initialization of the main setup of \recola\ and would
 consequently crash it. It is foreseen in the future to have a
 safeguard mechanism inside \whizard\ in order to guarantee
 initialization of \recola\ only once, but this is not yet
 implemented.
 
 Further information on the installation, details and parameters of
 \recola\ can be found at \url{http://recola.hepforge.org}.
 
 %%%%%
 
 \section{Special applications}
 \label{sec:special_me}
 
 There are also special applications with combinations of matrix
 elements from different sources for dedicated purposes like e.g. for
 the matched top--anti-top threshold in $e^+e^-$. For this special
 application which depending on the order of the matching takes only
 \oMega\ matrix elements or at NLO combines amplitudes from \oMega\ and
 \openloops, is invoked by the method:
 \begin{code}
   $method = "threshold"
 \end{code}
 
 
 \newpage
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{Implemented physics}
 \label{chap:physics}
 
 %%%%%
 
 \section{The hard interaction models}
 
 In this section, we give a brief overview over the different
 incarnations of models for the description of the realm of subatomic
 particles and their interactions inside \whizard. In
 Sec.~\ref{sec:smandfriends}, the Standard Model (SM) itself and
 straightforward extensions and modifications thereof in the gauge,
 fermionic and Higgs sector are described. Then,
 Sec.~\ref{sec:bsmmodels} gives a list and short description of all
 genuine beyond the SM models (BSM) that are currently implemented in
 \whizard\ and its matrix element generator \oMega. Additional models
 beyond that can be integrated and handled via the interfaces to
 external tools like \sarah\ and \FeynRules, or the universal model
 format \UFO, cf. Chap.~\ref{chap:extmodels}.
 
 %%%%%%%%%%%%%%%
 
 \subsection{The Standard Model and friends}
 \label{sec:smandfriends}
 
 
 %%%%
 
 \subsection{Beyond the Standard Model}
 \label{sec:bsmmodels}
 
 \begin{table}
         \begin{center}
            \begin{tabular}{|l|l|l|}
              \hline
              MODEL TYPE & with CKM matrix & trivial CKM \\
              \hline\hline
              Yukawa test model & \tt{---} & \tt{Test} \\
              \hline
              QED with $e,\mu,\tau,\gamma$ & \tt{---} &  \tt{QED} \\
              QCD with $d,u,s,c,b,t,g$ & \tt{---} &  \tt{QCD} \\
              Standard Model        & \tt{SM\_CKM} & \tt{SM} \\
              SM with anomalous gauge couplings &  \tt{SM\_ac\_CKM} &
              \tt{SM\_ac} \\
              SM with $Hgg$, $H\gamma\gamma$, $H\mu\mu$, $He^+e^-$ &
              \tt{SM\_Higgs\_CKM} & \tt{SM\_Higgs} \\
              SM with bosonic dim-6 operators &  \tt{---} &
              \tt{SM\_dim6} \\
              SM with charge 4/3 top &  \tt{---} &
              \tt{SM\_top} \\
              SM with anomalous top couplings &  \tt{---} &
              \tt{SM\_top\_anom} \\
              SM with anomalous Higgs couplings &  \tt{---} &
              \tt{SM\_rx}/\tt{NoH\_rx}/\tt{SM\_ul} \\\hline
              SM extensions for $VV$ scattering & \tt{---} &
              \tt{SSC}/\tt{AltH}/\tt{SSC\_2}/\tt{SSC\_AltT} \\\hline
              SM with $Z'$ & \tt{---} & \tt{Zprime} \\
              \hline
              Two-Higgs Doublet Model & \tt{THDM\_CKM} & \tt{THDM} \\ \hline\hline
              MSSM &   \tt{MSSM\_CKM} & \tt{MSSM} \\
              \hline
              MSSM with gravitinos &   \tt{---} & \tt{MSSM\_Grav} \\
              \hline
              NMSSM &   \tt{NMSSM\_CKM} & \tt{NMSSM} \\
              \hline
              extended SUSY models &   \tt{---} & \tt{PSSSM} \\
              \hline\hline
              Littlest Higgs &  \tt{---} & \tt{Littlest} \\
              \hline
              Littlest Higgs with ungauged $U(1)$ &  \tt{---} &
              \tt{Littlest\_Eta} \\
              \hline
              Littlest Higgs with $T$ parity &  \tt{---} &
              \tt{Littlest\_Tpar} \\
              \hline
              Simplest Little Higgs (anomaly-free) &  \tt{---} &
              \tt{Simplest} \\
              \hline
              Simplest Little Higgs (universal) &  \tt{---} &
              \tt{Simplest\_univ} \\
              \hline\hline
              SM with graviton & \tt{---} & \tt{Xdim} \\
              \hline
              UED & \tt{---} & \tt{UED} \\
              \hline
              ``SQED'' with gravitino & \tt{---} & \tt{GravTest} \\
              \hline
              Augmentable SM template & \tt{---} & \tt{Template} \\
              \hline
            \end{tabular}
          \end{center}
   \caption{\label{tab:models} List of models available in
           \whizard. There are pure test models or models implemented
           for theoretical investigations, a long list of SM variants
           as well as a large number of BSM models.}
 \end{table}
 
 \subsubsection{Strongly Interacting Models and Composite Models}
 
 Higgsless models have been studied extensively before the Higgs boson
 discovery at the LHC Run I in 2012 in order to detect possible
 loopholes in the electroweak Higgs sector discovery potential of this
 collider. The Threesite Higgsless Model is one of the simplest
 incarnations of these models, and was one of the first BSM models
 beyond SUSY and Little Higgs models that have been implemented in
 \whizard~\cite{Speckner:2010zi}. It is also called the Minimal
 Higgsless Model (MHM)~\cite{Chivukula:2006cg} is a  minimal
 deconstructed Higgsless model which contains only the first resonance
 in  the tower of Kaluza-Klein modes of a Higgsless extra-dimensional
 model. It is a non-renormalizable, effective theory whose
 gauge group is an extension of the SM with an extra $SU(2)$ gauge
 group.  The breaking of the extended electroweak gauge symmetry is
 accomplished by a set of nonlinear sigma fields which represent the
 effects of physics at a higher scale and make the theory
 nonrenormalizable. The physical vector boson spectrum contains the
 usual photon, $W^\pm$ and $Z$ bosons as well as a $W'^\pm$ and $Z'$
 boson.  Additionally, a new set of heavy fermions are introduced to
 accompany the new gauge group ``site'' which mix to form the physical
 eigenstates.  This mixing is controlled by the small mixing parameter
 $\epsilon_L$ which is adjusted to satisfy constraints from precision
 observables, such as the S parameter~\cite{Chivukula:2005xm}.
 Here, additional weak gauge boson production at the LHC was
 one of the focus of the studies with \whizard~\cite{Ohl:2008ri}.
 
 
 \subsubsection{Supersymmetric Models}
 
 \whizard/\oMega\ was the first multi-leg matrix-element/event
 generator to include the full Minimal Supersymmetric Standard Model
 (MSSM), and also the NMSSM. The SUSY implementations in \whizard\ have
 been extensively tested~\cite{Ohl:2002jp,Reuter:2009ex}, and have been
 used for many theoretical and experimental studies (some prime
 examples
 being~\cite{Kalinowski:2008fk,Robens:2008sa,Hagiwara:2005wg}.
 
 \subsubsection{Little Higgs Models}
 
 \subsubsection{Inofficial models}
 
 There have been several models that have been included within the
 \whizard/\oMega\ framework but never found their way into the official
 release series. One famous example is the non-commutative extension of
 the SM, the NCSM. There have been several studies, e.g. simulations on
 the $s$-channel production of a $Z$ boson at the photon collider
 option of the ILC~\cite{Ohl:2004tn}. Also, the production of
 electroweak gauge bosons at the LHC in the framework of the NCSM have
 been studied~\cite{Ohl:2010zf}.
 
 
 %%%%%%%%%%%%%%%
 
 \section{The SUSY Les Houches Accord (SLHA) interface}
 \label{sec:slha}
 
 
 To be filled in
 ...~\cite{Skands:2003cj,AguilarSaavedra:2005pw,Allanach:2008qq}.
 
 The neutralino sector deserves special attention. After
 diagonalization of the mass matrix expresssed in terms
 of the gaugino and higgsino eigenstates, the resulting mass
 eigenvalues may be either negative or positive. In this case, two
 procedures can be followed.  Either the masses are rendered
 positive and the associated mixing matrix gets purely imaginary
 entries or the masses are kept signed, the mixing matrix in this case
 being real.  According to the SLHA agreement, the second option is
 adopted. For a specific eigenvalue, the phase is absorbed into the
 definition of the relevant eigenvector, rendering the mass
 negative. However, \whizard\ has not yet officially tested for
 negative masses. For external SUSY models
 (cf.~Chap.~\ref{chap:extmodels}) this means, that one must be careful
 using a SLHA file with explicit factors of
 the complex unity in the mixing matrix, and on the other hand,
 real and positive masses for the neutralinos. For the hard-coded SUSY
 models, this is completely handled internally. Especially
 Ref.~\cite{Hagiwara:2005wg} discusses the details of the neutralino
 (and chargino) mixing matrix.
 
 %%%%%%%%%%%%%%%%
 
 \section{Lepton Collider Beam Spectra}
 \label{sec:beamspectra}
 
 For the simulation of lepton collider beam spectra there are two
 dedicated tools, \circeone\ and \circetwo\ that have been written as
 in principle independent tools. Both attempt to describe the
 details of electron (and positron) beams in a realistic lepton
 collider environment. Due to the quest for achieving high peak
 luminosities at $e^+e^-$ machines, the goal is to make the spatial
 extension of the beam as small as possible but keeping the area of the
 beam roughly constant. This is achieved by forcing the beams in the
 final focus into the shape of a quasi-2D bunch. Due to the high charge
 density in that bunch, the bunch electron distribution is modified by
 classical electromagnetic radiation, so called {\em beamstrahlung}.
 The two \circe\ packages are intended to perform a simulation of this
 beamstrahlung and its consequences on the electron beam spectrum as
 realistic as possible. More details about the two packages can be
 found in their stand-alone documentations. We will discuss the basic
 features of lepton-collider beam simulations in the next two sections,
 including the technicalities of passing simulations of the machine
 beam setup to \whizard. This will be followed by a section on the
 simulation of photon collider spectra, included for historical
 reasons.
 
 %%%%%
 
 \subsection{\circeone}
 
 While the bunches in a linear collider cross only once, due to their
 small size they experience a strong beam-beam effect. There is a
 code to simulate the impact of this effect on luminosity and
 background, called
 \ttt{GuineaPig++}~\cite{Schulte:1998au,Schulte:1999tx,Schulte:2007zz}.
 This takes into account the details of the accelerator, the final
 focus etc. on the structure of the beam and the main features of the
 resulting energy spectrum of the electrons and positrons. It offers
 the state-of-the-art simulation of lepton-collider beam spectra as
 close as possible to reality. However, for many high-luminosity
 simulations, event files produced with \ttt{GuineaPig++} are usually
 too small, in the sense that not enough independent events are
 available for physics simulations. Lepton collider beam spectra do
 peak at the nominal beam energy ($\sqrt{s}/2$) of the collider, and
 feature very steeply falling tails. Such steeply falling distributions
 are very poorly mapped by histogrammed distributions with fixed bin
 widths.
 
 The main working assumption to handle such spectra are being followed
 within \circeone:
 \begin{enumerate}
 \label{circe1_assumptions}
 \item The beam spectra for the two beams $P_1$ and $P_2$ factorize
   (here $x_1$ and $x_2$ are the energy fractions of the two beams,
   respectively):
   \begin{equation*}
     D_{P_1P_2} (x_1, x_2) = D_{P_1} (x_1) \cdot D_{P_2} (x_2)
   \end{equation*}
 
 \item
   The peak is described with a delta distribution, and the tail with a
   power law:
   \begin{equation*}
     D(x) = d \cdot \delta(1-x) \; + \; c \cdot x^\alpha \, (1-x)^\beta
   \end{equation*}
 \end{enumerate}
 The two powers $\alpha$ and $\beta$ are the main coefficients that can
 be tuned in order to describe the spectrum with \circeone\ as close as
 possible as the original \ttt{GuineaPig++} spectrum. More details
 about how \circeone\ works and what it does can be found in its own
 write-up in \ttt{circe1/share/doc}.
 
 \subsection{\circetwo}
 
 The two conditions listed in \ref{circe1_assumptions} are too
 restrictive and hence insufficient to describe more complicated
 lepton-collider beam spectra, as they e.g. occur in the CLIC
 drive-beam design. Here, the two beams are highly correlated and also
 a power-law description does not give good enough precision for the
 tails. To deal with these problems, \circetwo\ starts with a
 two-dimensional histogram featuring factorized, but variable bin
 widths in order to simulate the steep parts of the
 distributions. The limited statistics from too small
 \ttt{GuineaPig++} event output files leads to correlated
 fluctuations that would leave strange artifacts in the
 distributions. To abandon them, Gaussian filters are applied to smooth
 out the correlated fluctuations. Here care has to be taken when going
 from the continuum in $x$ momentum fraction space to the corresponding
 \begin{figure}
   \centering
   \includegraphics{circe2-smoothing}
   \caption{\label{fig:circe2-smoothing}
     Smoothing the bin at the $x_{e^+} = 1$ boundary with Gaussian
     filters of 3 and 10 bins width compared to no smoothing.}
 \end{figure}
 boundaries: separate smoothing procedures are being applied to the
 bins in the continuum region and those in the boundary in order to
 avoid artificial unphysical beam energy
 spreads. Fig.~\ref{fig:circe2-smoothing} shows the smoothing of the
 distribution for the bin at the $x_{e^+} = 1$ boundary. The blue dots
 show the direct \ttt{GuineaPig++} output comprising the
 fluctuations due to the low statistics. Gaussian filters with widths
 of 3 and 10 bins, respectively, have been applied (orange and green
 dots, resp.). While there is still considerable fluctuation for 3 bin
 width Gaussian filtering, the distribution is perfectly smooth for 10
 bin width. Hence, five bin widths seem a reasonable compromise for
 histograms with a total of 100 bins. Note that the bins are not
 equidistant, but shrink with a power law towards the $x_{e^-} = 1$
 boundary on the right hand side of Fig.~\ref{fig:circe2-smoothing}.
 
 \whizard\ ships (inside its subpackage \circetwo) with prepared beam
 spectra ready to be used within \circetwo\ for the ILC beam spectra
 used in the ILC
 TDR~\cite{Behnke:2013xla,Baer:2013cma,Adolphsen:2013jya,Adolphsen:2013kya,Behnke:2013lya}. These
 comprise the designed staging energies of 200 GeV, 230 GeV, 250 GeV,
 350 GeV, and 500 GeV. Note that all of these spectra up to now do not
 take polarization of the original beams on the beamstrahlung into
 account, but are polarization-averaged. For backwards compatibility,
 also the 500 GeV spectra for the TESLA
 design~\cite{AguilarSaavedra:2001rg,Richard:2001qm}, here both for
 polarized and polarization-averaged cases, are included. Correlated
 spectra for CLIC staging energies like 350 GeV, 1400 GeV and 3000 GeV
 are not yet (as of version 2.2.4) included in the \whizard\
 distribution.
 
 In the following we describe how to obtain such files with the tools
 included in \whizard (resp. \circetwo). The procedure is equivalent to
 the so-called \ttt{lumi-linker} construction used by Timothy
 Barklow (SLAC) together with the legacy version \whizard\ttt{ 1.95}.
 The workflow to produce such files is to run \ttt{GuineaPig++} with
 the following input parameters:
 \begin{Code}
   do_lumi = 7;
   num_lumi = 100000000;
   num_lumi_eg = 100000000;
   num_lumi_gg = 100000000;
 \end{Code}
 This demands from \ttt{GuineaPig++} the generation of distributions
 for the $e^-e^+$, $e^\mp \gamma$, and $\gamma\gamma$ components of the
 beamstrahlung's spectrum, respectively. These are the files
 \ttt{lumi.ee.out}, \ttt{lumi.eg.out}, \ttt{lumi.ge.out}, and
 \ttt{lumi.gg.out}, respectively. These contain pairs $(E_1, E_2)$
 of beam energies, {\em not} fractions of the original beam
 energy. Huge event numbers are out in here, as \ttt{GuineaPig++}
 will produce only a small fraction due to a very low generation
 efficiency.
 
 The next step is to transfer these output files from
 \ttt{GuineaPig++} into input files used with \circetwo. This is
 done by means of the tool \ttt{circe\_tool.opt} that is installed
 together with the \whizard\ main binary and libraries. The user should
 run this executable with the following input file:
 \begin{Code}
 { file="ilc500/ilc500.circe"                   # to be loaded by WHIZARD
   { design="ILC" roots=500 bins=100 scale=250 # E in [0,1]
     { pid/1=electron pid/2=positron pol=0     # unpolarized e-/e+
       events="ilc500/lumi.ee.out" columns=2   # <= Guinea-Pig
       lumi = 1564.763360                      # <= Guinea-Pig
       iterations = 10                         # adapting bins
       smooth = 5 [0,1) [0,1)                  # Gaussian filter 5 bins
       smooth = 5 [1] [0,1) smooth = 5 [0,1) [1] } } }
 \end{Code}
 The first line defines the output file, that later can be read in into
 the beamstrahlung's description of \whizard\ (cf. below). Then, in the
 second line the design of the collider (here: ILC for 500 GeV
 center-of-mass energy, with the number of bins) is specified. The next
 line tells the tool to take the unpolarized case, then the
 \ttt{GuineaPig++} parameters (event file and luminosity) are
 set. In the last three lines, details concerning the adaptation of the
 simulation as well as the smoothing procedure are being specified: the
 number of iterations in the adaptation procedure, and for the
 smoothing with the Gaussian filter first in the continuum and then at
 the two edges of the spectrum. For more details confer the
 documentation in the \circetwo\ subpackage.
 
 This produces the corresponding input files that can be used within
 \whizard\ to describe beamstrahlung for lepton colliders, using a
 \sindarin\ input file like:
 \begin{Code}
         beams = e1, E1 => circe2
         $circe2_file = "ilc500.circe"
         $circe2_design = "ILC"
         ?circe2_polarized = false
 \end{Code}
 
 
 %%%%%
 
 \subsection{Photon Collider Spectra}
 
 For details confer the complete write-up of the \circetwo\
 subpackage.
 
 %%%%%
 
 \section{Transverse momentum for ISR photons}
 \label{sec:isr-photon-handler}
 
 The structure functions that describe the splitting of a beam particle
 into a particle pair, of which one enters the hard interaction and the
 other one is radiated, are defined and evaluated in the strict
 collinear approximation.  In particular, this holds for the ISR
 structure function which describes the radiation of photons off a
 charged particle in the initial state.
 
 The ISR structure function that is used by \whizard\ is understood to
 be inclusive, i.e., it implicitly contains an integration over
 transverse momentum.  This approach is to be used for computing a
 total cross section via \ttt{integrate}.  In \whizard, it is possible
 to unfold this integration, as a transformation that is applied by
 \ttt{simulate} step, event by event.  The resulting modified events
 will show a proper logarithmic momentum-transfer ($Q^2$) distribution
 for the radiated photons.  The recoil is applied to the
 hard-interaction system, such that four-momentum and $\sqrt{\hat s}$
 are conserved.  The distribution is cut off by $Q_{\text{max}}^2$
 (cf. \ttt{isr\_q\_max}) for large momentum transfer, and smoothly by
 the parton mass (cf.\ \ttt{isr\_mass}) for small momentum transfer.
 
 To activate this modification, set
 \begin{Code}
   ?isr_handler = true
   $isr_handler_mode = "recoil"
 \end{Code}
 before, or as an option to, the \ttt{simulate} command.
 
 Limitations: the current implementation of the $p_T$ modification
 works only for the symmetric double-ISR case, i.e., both beams have to
 be charged particles with identical mass (e.g., $e^+e^-$).  The mode
 \ttt{recoil} generates exactly one photon per beam, i.e., it modifies
 the momentum of the single collinear photon that the ISR structure
 function implementation produces, for each beam.  (It is foreseen that
 further modes or options will allow to generate multiple photons.
 Alternatively, the \pythia\ shower can be used to simulate multiple
 photons radiated from the initial state.)
 
 %%%%%
 
 \section{Transverse momentum for the EPA approximation}
 \label{sec:epa-beam-handler}
 
 For the equivalent-photon approximation (EPA), which is also defined
 in the collinear limit, recoil momentum can be inserted into generated
 events in an entirely analogous way.  The appropriate settings are
 \begin{Code}
   ?epa_handler = true
   $epa_handler_mode = "recoil"
 \end{Code}
 
 Limitations: as for ISR, the current implementation of the $p_T$
 modification works only for the symmetric double-EPA case.  Both
 incoming particles of the hard process must be photons, while both
 beams must be charged particles with identical mass (e.g., $e^+e^-$).
 Furthermore, the current implementation does not respect the
 kinematical limit parameter \verb|epa_q_min|, it has to be set to
 zero. In effect, the lower $Q^2$ cutoff is determined by the
 beam-particle mass \verb|epa_mass|, and the upper cutoff is either
 given by $Q_{\text{max}}$ (the parameter
 \verb|epa_q_max|), or by the limit $\sqrt{s}$ if this is not set.
 
 It is possible to combine the ISR and EPA handlers, for processes
 where ISR is active for one of the beams, EPA for the other beam.  For
 this scenario to work, both handler switches must be on, and both mode
 strings must coincide.  The parameters are set separately for ISR and
 EPA, as described above.
 
 %%%%%
 
 \section{Resonances and continuum}
 
 \subsection{Complete matrix elements}
 
 Many elementary physical processes are composed of contributions that can be
 qualified as (multiply) \emph{resonant} or \emph{continuum}.  For instance,
 the amplitude for the process $e^+e^-\to q\bar q q\bar q$, evaluated at tree
 level in perturbation theory, contains Feynman diagrams with zero, one, or two
 $W$ and $Z$ bosons as virtual lines.  If the kinematical constraints allow
 this, two vector bosons can become simultaneously on-shell in part of phase
 space.  To a first approximation, this situation is understood as $W^+W^-$ or
 $ZZ$ production with subsequent decay.  The kinematical distributions show
 distinct resonances in the quark-pair spectra.  Other graphs contain only one
 s-channel $W/Z$ boson, or none at all, such as graphs with $q\bar q$
 production and subsequent gluon radiation, splitting into another $q\bar q$
 pair.
 
 A \whizard\ declaration of the form
 \begin{Code}
         process q4 = e1, E1 => u, U, d, D
 \end{Code}
 produces the full set of graphs for the selected final state, which after
 squaring and integrating yields the exact tree-level result for the process.
 The result contains all doubly and singly resonant parts, with correct
 resonance shapes, as well as the continuum contribution and all interference.
 This is, to given order in perturbation theory, the best possible
 approximation to the true result.
 
 \subsection{Processes restricted to resonances}
 
 For an intuitive separation of a two-boson ``signal'' contribution, it is
 possible to restrict the set of graphs to a certain intermediate state.  For
 instance, the declaration
 \begin{Code}
   process q4_zz = e1, E1 => u, U, d, D { $restrictions = "3+4~Z && 5+6~Z" }
 \end{Code}
 generates an amplitude that contains only those Feynman graphs where the
 specified quarks are connected to a $Z$ virtual line.  The result may be
 understood as $ZZ$ production with subsequent decay, where the $Z$ resonances
 exhibit a Breit-Wigner shape.  Combining this with the
 analogous $W^+W^-$ restricted process, the user can generate ``signal''
 processes.
 
 Adding both ``signal'' cross sections $WW$ and $ZZ$ will result in a
 reasonable approximation to the exact tree-level cross section.  The amplitude
 misses the single-resonant and continuum contributions, and the squared
 amplitude misses the interference terms, however.  More importantly, the
 restricted processes as such are not gauge-invariant (with respect to the
 electroweak gauge group), and they are no longer dominant away from resonant
 kinematics.  We therefore strongly recommend that such restricted processes
 are always accompanied by a cut setup that restricts the kinematics to an
 approximately on-shell pattern for both resonances.  For instance:
 \begin{Code}
   cuts = all 85 GeV < M < 95 GeV [u:U]
      and all 85 GeV < M < 95 GeV [d:D]
 \end{Code}
 In this region, the gauge-dependent and continuum contributions are strictly
 subdominant.  Away from the resonance(s), the results for a restricted process
 are meaningless, and the full process has to be computed instead.
 
 \subsection{Factorized processes}
 
 Another method for obtaining the signal contribution is a proper factorization
 into resonance production and decay.  We would have to generate a production
 process and two decay processes:
 \begin{Code}
         process z_uu = Z => u, U
         process z_dd = Z => d, D
         process zz = e1, E1 => Z, Z
 \end{Code}
 All three processes must be integrated.  The integration results are partial
 decay widths and the $ZZ$ production cross section, respectively.  (Note that
 cut expressions in \sindarin\ apply to all integrations, so make sure that
 no production-process cuts are active when integrating the decay
 processes.)
 
 During a later event-generation step, the $Z$ decays can then be activated by declaring the $Z$ as
 unstable,
 \begin{Code}
         unstable Z (z_uu, z_dd)
 \end{Code}
 and then simulating the production process
 \begin{Code}
         simulate (zz)
 \end{Code}
 The generated events will consist of four-fermion final states, including all
 combinations of both decay modes.  It is important to note that in this setup,
 the invariant $u\bar u$ and $d\bar d$ masses will be always \emph{exactly}
 equal to the $Z$ mass.  There is no Breit-Wigner shape involved.  However, in
 this approximation the results are gauge-invariant, as there is no off-shell
 contribution involved.
 
 For further details on factorized processes and spin correlations,
 cf.\ Sec.~\ref{sec:spin-correlations}.
 
 
 \subsection{Resonance insertion in the event record}
 
 From the above discussion, we may conclude that it is always preferable to
 compute the complete process for a given final state, as long as this is
 computationally feasible.  However, in the simulation step this approach also
 has a drawback.  Namely, if a parton-shower module (see below) is switched on,
 the parton-shower algorithm relies on event details in order to determine the
 radiation pattern of gluons and further splitting.  In the generated event
 records, the full-process events carry the signature of non-resonant continuum
 production with no intermediate resonances.  The parton shower will thus start
 the evolution at the process energy scale, the total available energy.  By
 contrast, for an electroweak production and decay process, the evolution
 should start only at the vector boson mass, $m_Z$.  In effect, even though the
 resonant contribution of $WW$ and $ZZ$ constitutes the bulk of the cross
 section, the radiation pattern follows the dynamics of four-quark continuum
 production.  In general, the number of radiated hadrons will be too high.
 
 
 \begin{figure}
   \begin{center}
     \includegraphics[width=.41\textwidth]{resonance_e_gam}
     \includegraphics[width=.41\textwidth]{resonance_n_charged} \\
     \includegraphics[width=.41\textwidth]{resonance_n_hadron}
     \includegraphics[width=.41\textwidth]{resonance_n_particles} \\
     \includegraphics[width=.41\textwidth]{resonance_n_photons}
     \includegraphics[width=.41\textwidth]{resonance_n_visible}
   \end{center}
   \caption{The process $e^+e^- \to jjjj$ at 250 GeV center-of-mass
     energy is compared transferring the partonic events naively to the
     parton shower, i.e. without respecting any intermediate resonances
     (red lines). The blue lines show the process factorized into $WW$
     production and decay, where the shower knows the origin of the two
     jet pairs. The orange and dark green lines show the resonance
     treatment as mentioned in the text, with
     \ttt{resonance\_on\_shell\_limit = 1} and \ttt{= 4},
     respectively. \pythiasix\ parton shower and hadronization with the
     OPAL tune have been used. The observables are: photon energy
     distribution and number of charged tracks (upper line left/right,
     number of hadrons and total number of particles (middle
     left/right), and number of photons and neutral particles (lower
     line left/right).}
 \end{figure}
 
 To overcome this problem, there is a refinement of the process description
 available in \whizard.  By modifying the process declaration to
 \begin{Code}
   ?resonance_history = true
   resonance_on_shell_limit = 4
   process q4 = e1, E1 => u, U, d, D
 \end{Code}
 we advise the program to produce not just the complete matrix element, but
 also all possible restricted matrix elements containing resonant intermediate
 states.  This has no effect at all on the integration step, and thus on the
 total cross section.
 
 However, when subsequently events are generated with this setting, the program
 checks, for each event, the kinematics and determines the set of potentially
 resonant contributions.  The criterion is whether the off-shellness of a
 particular would-be resonance is less than the resonance width multiplied by
 the value of \verb|resonance_on_shell_limit| (default value $=4$).  For the
 set of resonance histories which pass this criterion (which can be empty),
 their respective squared matrix element is related to the full-process matrix
 element.  The ratio is interpreted as a probability.  The random-number
 generator then selects one or none of the resonance histories, and modifies
 the event record accordingly.  In effect, for an appropriate fraction of the
 events, depending on the kinematics, the parton-shower module is provided with
 resonance information, so it can adjust the radiation pattern accordingly.
 
 It has to be mentioned that generating the matrix-element code for all
 possible resonance histories takes additional computing resources.  In the
 current default setup, this feature is switched off.  It has to be explicitly
 activated via the \verb|?resonance_history| flag.
 
 Also, the feature can be activated or deactivated individually for
 each process, such as in
 \begin{Code}
   ?resonance_history = true
   process q4_with_res = e1, E1 => u, U, d, D  { ?resonance_history = true }
   process q4_wo_res   = e1, E1 => u, U, d, D  { ?resonance_history = false }
 \end{Code}
 If the flag is \verb|false| for a process, no resonance code will be
 generated.  Similarly, the flag has to be globally or locally active
 when \verb|simulate| is called, such that the feature takes effect for
 event generation.
 
 There are two additional parameters that can fine-tune the conditions for
 resonance insertion in the event record.  Firstly, the parameter
 \verb|resonance_on_shell_turnoff|, if nonzero, enables a Gaussian suppression
 of the probability for resonance insertion.  For instance, setting
 \begin{Code}
   ?resonance_history = true
   resonance_on_shell_turnoff = 4
   resonance_on_shell_limit = 8
 \end{Code}
 will reduce the probability for the event to be qualified as resonant by
 $e^{-1}= 37\,\%$ if the kinematics is off-shell by four units of the width,
 and by $e^{-4}=2\,\%$ at eight units of the width.  Beyond this point, the
 setting of the \verb|resonance_on_shell_limit| parameter eliminates resonance
 insertion altogether.  In effect, the resonance-background transition is
 realized in a smooth way.  Secondly, within the resonant-kinematics range the
 probability for qualifying the event as background can be reduced by the
 parameter \verb|resonance_background_factor| (default value $=1$) to a number
 between zero and one.  Setting this to zero means that the event will be
 necessarily qualified as resonant, if it falls within the resonant-kinematics
 range.
 
 Note that if an event, by the above mechanism, is identified as following a
 certain resonance history, the assigned color flow will be chosen to match the
 resonance history, not the complete matrix element.  This may result in a
 reassignment of color flow with respect to the original partonic event.
 
 Finally, we mention the order of execution: any additional
 matrix element code is compiled and linked when \verb|compile| is
 executed for the processes in question.  If this command is omitted,
 the \verb|simulate| command will trigger compilation.
 
 
 \section{Parton showers and Hadronization}
 
 In order to produce sensible events, final state QCD (and also QED)
 radiation has to be considered as well as the binding of strongly
 interacting partons into mesons and baryons. Furthermore, final state
 hadronic resonances undergo subsequent decays into those particles
 showing up in (or traversing) the detector. The latter are mostly
 pions, kaons, photons, electrons and muons.
 
 The physics associated with these topics can be divided into the
 perturbative part which is the regime of the parton shower, and the
 non-perturbative part which is the regime for the
 hadronization. \whizard\ comes with its own two different parton
 shower implementations, an analytic and a so-called $k_T$-ordered
 parton shower that will be detailed in the next section.
 
 Note that in general it is not advisable to use different shower and
 hadronization methods, or in other words, when using shower and
 hadronization methods from different programs these would have to be
 tuned together again with the corresponding data.
 
 Parton showers are approximations to full matrix elements taking only
 the leading color flow into account, and neglecting all interferences
 between different amplitudes leading to the same exclusive final
 state. They rely on the QCD (and QED) splitting functions to describe
 the emissions of partons off other partons. This is encoded in the
 so-called Sudakov form factor~\cite{Sudakov:1954sw}:
 \begin{equation*}
   \Delta( t_1, t_2) = \exp \left[ \int\limits_{t_1}^{t_2} \mbox{d} t
     \int\limits_{z_-}^{z_+} \mbox{d} z \frac{\alpha_s}{2 \pi t} P(z)
     \right]
 \end{equation*}
 This gives the probability for a parton to evolve from scale $t_2$ to
 $t_1$ without any further emissions of partons. $t$ is the evolution
 parameter of the shower, which can be a parton energy, an emission
 angle, a virtuality, a transverse momentum etc. The variable $z$
 relates the two partons after the branching, with the most common
 choice being the ratio of energies of the parton after and before the
 branching. For final-state radiation brachings occur after the hard
 interaction, the evolution of the shower starts at the scale of the
 hard interaction, $t \sim \hat{s}$, down to a cut-off scale $t =
 t_{\text{cut}}$ that marks the transition to the non-perturbative
 regime of hadronization. In the space-like evolution for the
 initial-state shower, the evolution is from a cut-off representing the
 factorization scale for the parton distribution functions (PDFs) to the
 inverse of the hard process scale, $-\hat{s}$. Technically, this
 evolution is then backwards in (shower) time~\cite{Sjostrand:1985xi},
 leading to the necessity to include the PDFs in the Sudakov factors.
 
 The main switches for the shower and hadronization which are realized
 as transformations on the partonic events within \whizard\ are
 \ttt{?allow\_shower} and \ttt{?allow\_hadronization}, which are
 true by default and only there for technical reasons. Next, different
 shower and hadronization methods can be chosen within \whizard:
 \begin{code}
   $shower_method = "WHIZARD"
   $hadronization_method = "PYTHIA6"
 \end{code}
 The snippet above shows the default choices in \whizard\, namely
 \whizard's intrinsic parton shower, but \pythiasix\ as hadronization
 tool. (Note that \whizard\ does not have its own hadronization module
 yet.)  The usage of \pythiasix\ for showering and hadronization will
 be explained in Sec.~\ref{sec:pythia6}, while the two different
 implementations of the \whizard\ homebrew parton showers are discussed
 in Sec.~\ref{sec:ktordered} and~\ref{sec:analytic}, respectively.
 
 %%%%%
 
 \subsection{The $k_T$-ordered parton shower}
 \label{sec:ktordered}
 
 %%%%%
 
 \subsection{The analytic parton shower}
 \label{sec:analytic}
 
 %%%%%
 
 \subsection{Parton shower and hadronization from \pythiasix}
 \label{sec:pythia6}
 
 Development of the \pythiasix\ generator for parton shower and
 hadronization (the \fortran\ version) has been discontinued by the
 authors several years ago. Hence, the final release of that program is
 frozen. This allowed to ship this final version, v6.427, with the
 \whizard\ distribution without the need of updating it all the
 time. One of the main reasons for that inclusion -- besides having the
 standard tool for showering and hadronization for decays at hand -- is
 to allow for backwards validation within \whizard\ particularly for
 the event samples generated for the development of linear collider
 physics: first for TESLA, JLC and NLC, and later on for the Conceptual
 and Technical Design Report for ILC, for the Conceptual Design Report
 for CLIC as well as for the Letters of Intent for the LC detectors,
 ILD and SiD.
 
 Usually, an external parton shower and hadronization program (PS) is
 steered via the transfer of event files that are given to the PS via
 LHE events, while the PS program then produces hadron level events,
 usually in HepMC format. These can then be directed towards a full or
 fast detector simulation program. As \pythiasix\ has been completely
 integrated inside the \whizard\ framework, the showered or more
 general hadron level events can be returned to and kept inside
 \whizard's internal event record, and hence be used in \whizard's
 internal event analysis. In that way, the events can be also written
 out in event formats that are not supported by \pythiasix,
 e.g. \ttt{LCIO} via the output capabilities of \whizard.
 
 There are several switches to directly steer \pythiasix\ (the values
 in brackets correspond to the \pythiasix\ variables):
 \begin{code}
   ps_mass_cutoff = 1 GeV                  [PARJ(82)]
   ps_fsr_lambda = 0.29 GeV                [PARP(72)]
   ps_isr_lambda = 0.29 GeV                [PARP(61)]
   ps_max_n_flavors = 5                    [MSTJ(45)]
   ?ps_isr_alphas_running = true           [MSTP(64)]
   ?ps_fsr_alphas_running = true           [MSTJ(44)]
   ps_fixed_alphas = 0.2                   [PARU(111)]
   ?ps_isr_angular_ordered = true          [MSTP(62)]
   ps_isr_primordial_kt_width = 1.5 GeV    [PARP(91)]
   ps_isr_primordial_kt_cutoff = 5.0 GeV   [PARP(93)]
   ps_isr_z_cutoff = 0.999                 [1-PARP(66)]
   ps_isr_minenergy = 2 GeV                [PARP(65)]
   ?ps_isr_only_onshell_emitted_partons =
         true                              [MSTP(63)]
 \end{code}
 The values given above are the default values. The first value
 corresponds to the \pythiasix\ parameter \ttt{PARJ(82)}, its
 squared being the minimal virtuality that is allowed for the parton
 shower, i.e. the cross-over to the hadronization. The same parameter
 is used also for the \whizard\ showers. \ttt{ps\_fsr\_lambda} is
 the equivalent of \ttt{PARP(72)} and is the $\Lambda_{\text{QCD}}$
 for the final state shower. The corresponding variable for the initial
 state shower is called \ttt{PARP(61)} in \pythiasix. By the next
 variable (\ttt{MSTJ(45)}), the maximal number of flavors produced
 in splittings in the shower is given, together with the number of
 active flavors in the running of
 $\alpha_s$. \ttt{?ps\_isr\_alphas\_running} which corresponds to
 \ttt{MSTP(64)} in \pythiasix\ determines whether or net a running
 $\alpha_s$ is taken in the space-like initial state showers. The same
 variable for the final state shower is \ttt{MSTJ(44)}. For fixed
 $\alpha_s$, the default value is given by \ttt{ps\_fixed\_alpha},
 corresponding to \ttt{PARU(111)}. \ttt{MSTP(62)} determines
 whether the ISR shower is angular order, i.e. whether angles are
 increasing towards the hard interaction. This is per default true, and
 set in the variable \ttt{?ps\_isr\_angular\_ordered}. The width of
 the distribution for the primordial (intrinsic) $k_T$ distribution
 (which is a non-perturbative quantity) is the \pythiasix\ variable
 \ttt{PARP(91)}, while in \whizard\ it is given by
 \ttt{pythia\_isr\_primordial\_kt\_width}. The next variable
 (\ttt{PARP(93}) gives the upper cutoff for that distribution, which
 is 5 GeV per default. For splitting in space-like showers, there is a
 cutoff on the $z$ variable named \ttt{ps\_isr\_z\_cutoff} in
 \whizard. This corresponds to one minus the value of the
 \pythiasix\ parameter \ttt{PARP(66)}. \ttt{PARP(65)}, on the
 other hand, gives the minimal (effective) energy for a time-like or
 on-shell emitted parton on a space-like QCD shower, given by the
 \sindarin\ parameter \ttt{ps\_isr\_minenergy}. Whether or not
 partons emitted from space-like showers are allowed to be only
 on-shell is given by
 \ttt{?ps\_isr\_only\_onshell\_emitted\_partons}, \ttt{MSTP(63)}
 in \pythiasix\ language.
 For more details confer the
 \pythiasix\ manual~\cite{Sjostrand:2006za}.
 
 Any other non-standard \pythiasix\ parameter can be fed into the
 parton shower via the string variable
 \begin{code}
   $ps_PYTHIA_PYGIVE = "...."
 \end{code}
 Variables set here get preference over the ones set explicitly by
 dedicated \sindarin\ commands. For example, the OPAL tune for hadronic
 final states can be set via:
 \begin{code}
   $ps_PYTHIA_PYGIVE = "MSTJ(28)=0; PMAS(25,1)=120.; PMAS(25,2)=0.3605E-02; MSTJ(41)=2;
    MSTU(22)=2000; PARJ(21)=0.40000; PARJ(41)=0.11000; PARJ(42)=0.52000; PARJ(81)=0.25000;
    PARJ(82)=1.90000; MSTJ(11)=3; PARJ(54)=-0.03100; PARJ(55)=-0.00200; PARJ(1)=0.08500;
    PARJ(3)=0.45000; PARJ(4)=0.02500; PARJ(2)=0.31000; PARJ(11)=0.60000; PARJ(12)=0.40000;
    PARJ(13)=0.72000; PARJ(14)=0.43000; PARJ(15)=0.08000; PARJ(16)=0.08000;
    PARJ(17)=0.17000; MSTP(3)=1;MSTP(71)=1"
 \end{code}
 
 \vspace{0.5cm}
 
 A very common error that appears quite often when using
 \pythiasix\ for SUSY or any other model having a stable particle that
 serves as a possible Dark Matter candidate, is the following
 warning/error message:
 \begin{Code}
      Advisory warning type 3 given after        0 PYEXEC calls:
      (PYRESD:) Failed to decay particle  1000022 with mass   15.000
 ******************************************************************************
 ******************************************************************************
 *** FATAL ERROR: Simulation: failed to generate valid event after 10000 tries
 ******************************************************************************
 ******************************************************************************
 \end{Code}
 In that case, \pythiasix\ gets a stable particle (here the lightest
 neutralino with the PDG code 1000022) handed over and does not know
 what to do with it. Particularly, it wants to treat it as a heavy
 resonance which should be decayed, but does not know how do
 that. After a certain number of tries (in the example abobe 10k),
 \whizard\ ends with a fatal error telling the user that the event
 transformation for the parton shower in the simulation has failed
 without producing a valid event. The solution to work around that
 problem is to let \pythiasix\ know that the neutralino (or any other
 DM candidate) is stable by means of
 \begin{code}
   $ps_PYTHIA_PYGIVE = "MDCY(C1000022,1)=0"
 \end{code}
 Here, 1000022 has to be replaced by the stable dark matter candidate
 or long-lived particle in the user's favorite model. Also note that
 with other options being passed to \pythiasix\, the \ttt{MDCY}
 option above has to be added to an existing
 \ttt{\$ps\_PYTHIA\_PYGIVE} command separated by a semicolon.
 
 %%%%%
 
 \subsection{Parton shower and hadronization from \pythiaeight}
 
 \subsection{Other tools for parton shower and hadronization}
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{More on Event Generation}
 \label{chap:events}
 
 In order to perform a physics analysis with \whizard\ one has to
 generate events. This seems to be a trivial statement, but as there
 have been any questions like "My \whizard\ does not produce plots --
 what has gone wrong?" we believe that repeating that rule is
 worthwile. Of course, it is not mandatory to use \whizard's own analysis
 set-up, the user can always choose to just generate events and use
 his/her own analysis package like \ttt{ROOT}, or \ttt{TopDrawer}, or
 you name it for the analysis.
 
 Accordingly, we first start to describe how to generate events and
 what options there are -- different event formats, renaming output
 files, using weighted or unweighted events with different
 normalizations. How to re-use and manipulate already generated event
 samples, how to limit the number of events per file, etc. etc.
 
 \section{Event generation}
 
 To explain how event generation works, we again take our favourite
 example, $e^+e^- \to \mu^+ \mu^-$,
 \begin{verbatim}
   process eemm = e1, E1 => e2, E2
 \end{verbatim}
 The command to trigger generation of events is \ttt{simulate
   (<proc\_name>) \{ <options> \}}, so in our case -- neglecting any
 options for now -- simply:
 \begin{verbatim}
   simulate (eemm)
 \end{verbatim}
 When you run this \sindarin\ file you will experience a fatal error:
 \ttt{FATAL ERROR: Colliding beams: sqrts is zero (please set
 sqrts)}. This is because \whizard\ needs to compile and integrate the
 process \ttt{eemm} first before event simulation, because it needs the
 information of the corresponding cross section, phase space
 parameterization and grids. It does both automatically, but you have
 to provide \whizard\ with the beam setup, or at least with the
 center-of-momentum energy.  A corresponding \ttt{integrate} command
 like
 \begin{verbatim}
   sqrts = 500 GeV
   integrate (eemm) { iterations = 3:10000 }
 \end{verbatim}
 obviously has to appear {\em before} the corresponding \ttt{simulate}
 command (otherwise you would be punished by the same error message as
 before). Putting things in the correct order results in an output
 like:
 \begin{footnotesize}
 \begin{verbatim}
 | Reading model file '/usr/local/share/whizard/models/SM.mdl'
 | Preloaded model: SM
 | Process library 'default_lib': initialized
 | Preloaded library: default_lib
 | Reading commands from file 'bla.sin'
 | Process library 'default_lib': recorded process 'eemm'
 sqrts =  5.000000000000E+02
 | Integrate: current process library needs compilation
 | Process library 'default_lib': compiling ...
 | Process library 'default_lib': keeping makefile
 | Process library 'default_lib': keeping driver
 | Process library 'default_lib': active
 | Process library 'default_lib': ... success.
 | Integrate: compilation done
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 29912
 | Initializing integration for process eemm:
 | ------------------------------------------------------------------------
 | Process [scattering]: 'eemm'
 |   Library name  = 'default_lib'
 |   Process index = 1
 |   Process components:
 |     1: 'eemm_i1':   e-, e+ => mu-, mu+ [omega]
 | ------------------------------------------------------------------------
 | Beam structure: [any particles]
 | Beam data (collision):
 |   e-  (mass = 5.1099700E-04 GeV)
 |   e+  (mass = 5.1099700E-04 GeV)
 |   sqrts = 5.000000000000E+02 GeV
 | Phase space: generating configuration ...
 | Phase space: ... success.
 | Phase space: writing configuration file 'eemm_i1.phs'
 | Phase space: 2 channels, 2 dimensions
 | Phase space: found 2 channels, collected in 2 groves.
 | Phase space: Using 2 equivalences between channels.
 | Phase space: wood
 Warning: No cuts have been defined.
 | OpenMP: Using 8 threads
 | Starting integration for process 'eemm'
 | Integrate: iterations = 3:10000
 | Integrator: 2 chains, 2 channels, 2 dimensions
 | Integrator: Using VAMP channel equivalences
 | Integrator: 10000 initial calls, 20 bins, stratified = T
 | Integrator: VAMP
 |=============================================================================|
 | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
 |=============================================================================|
    1       9216  4.2833237E+02  7.14E-02    0.02    0.02*  40.29
    2       9216  4.2829071E+02  7.08E-02    0.02    0.02*  40.29
    3       9216  4.2838304E+02  7.04E-02    0.02    0.02*  40.29
 |-----------------------------------------------------------------------------|
    3      27648  4.2833558E+02  4.09E-02    0.01    0.02   40.29    0.43   3
 |=============================================================================|
 | Time estimate for generating 10000 events: 0d:00h:00m:04s
 | Creating integration history display eemm-history.ps and eemm-history.pdf
 | Starting simulation for process 'eemm'
 | Simulate: using integration grids from file 'eemm_m1.vg'
 | RNG: Initializing TAO random-number generator
 | RNG: Setting seed for random-number generator to 29913
 | OpenMP: Using 8 threads
 | Simulation: requested number of events = 0
 |             corr. to luminosity [fb-1] =   0.0000E+00
 | Events: writing to raw file 'eemm.evx'
 | Events: generating 0 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 |         ... event sample complete.
 | Events: closing raw file 'eemm.evx'
 | There were no errors and    1 warning(s).
 | WHIZARD run finished.
 |=============================================================================|
 \end{verbatim}
 \end{footnotesize}
 
 So, \whizard\ tells you that it has entered simulation mode, but besides
 this, it has not done anything. The next step is that you have to
 demand event generation -- there are two ways to do this: you could
 either specify a certain number, say 42, of events you want to have
 generated by \whizard, or you could provide a number for an integrated
 luminosity of some experiment. (Note, that if you choose to take both
 options, \whizard\ will take the one which gives the larger event
 sample. This, of course, depends on the given process(es) -- as well
 as cuts -- and its corresponding cross section(s).) The first of these
 options is set with the command: \ttt{n\_events = <number>}, the
 second with \ttt{luminosity = <number> <opt. unit>}.
 
 Another important point already stated several times in the manual is
 that \whizard\ follows the commands in the steering \sindarin\ file in a
 chronological order. Hence, a given number of events or luminosity
 {\em after} a \ttt{simulate} command will be ignored -- or are
 relevant only for any \ttt{simulate} command potentially following
 further down in the \sindarin\ file. So, in our case, try:
 \begin{verbatim}
  n_events = 500
  luminosity = 10
  simulate (eemm)
 \end{verbatim}
 Per default, numbers for integrated luminosity are understood as
 inverse femtobarn. So, for the cross section above this would
 correspond to 4283 events, clearly superseding the demand for 500
 events. After reducing the luminosity number from ten to one inverse
 femtobarn, 500 is the larger number of events taken by \whizard\ for
 event generation. Now \whizard\ tells you:
 \begin{verbatim}
 | Simulation: requested number of events = 500
 |             corr. to luminosity [fb-1] =   1.1673E+00
 | Events: reading from raw file 'eemm.evx'
 | Events: reading 500 unweighted, unpolarized events ...
 | Events: event normalization mode '1'
 | ... event file terminates after 0 events.
 | Events: appending to raw file 'eemm.evx'
 | Generating remaining  500 events ...
 |         ... event sample complete.
 | Events: closing raw file 'eemm.evx'
 \end{verbatim}
 I.e., it evaluates the luminosity to which the sample of 500 events
 would correspond to, which is now, of course, bigger than the $1
 \fb^{-1}$ explicitly given for the luminosity. Furthermore, you can
 read off that a file \ttt{whizard.evx} has been generated, containing
 the demanded 500 events. (It was there before containing zero events,
 because to \ttt{n\_events} or \ttt{luminosity} value had been
 set. \whizard\ then tried to get the events first from file before
 generating new ones). Files with the suffix \ttt{.evx} are binary
 format event files, using a machine-dependent \whizard-specific
 event file format. Before we list the event formats supported by
 \whizard, the next two sections will tell you more about unweighted and
 weighted events as well as different possibilities to normalize events
 in \whizard.
 
 As already explained for the libraries, as well as the phase space and
 grid files in Chap.~\ref{chap:sindarin}, \whizard\ is trying to re-use
 as much information as possible. This is of course also true for the
 event files. There are special MD5 check sums testing the integrity
 and compatibility of the event files. If you demand for a process for
 which an event file already exists (as in the example above, though it
 was empty) equally many or less events than generated before,
 \whizard\ will not generate again but re-use the existing events (as
 already explained, the events are stored in a \whizard-own
 binary event format, i.e. in a so-called \ttt{.evx} file. If you
 suppress generation of that file, as will be described in subsection
 \ref{sec:eventformats} then \whizard\ has to generate events all the
 time). From version v2.2.0 of \whizard\ on, the program is also able
 to read in event from different event formats. However, most event
 formats do not contain as many information as \whizard's internal
 format, and a complete reconstruction of the events might not be
 possible. Re-using event files is very practical for doing several
 different analyses with the same data, especially if there are many
 and big data samples. Consider
 the case, there is an event file with 200 events, and you now ask
 \whizard\ to generate 300 events, then it will re-use the 200 events
 (if MD5 check sums are OK!), generate the remaining 100 events and
 append them to the existing file. If the user for some reason,
 however, wants to regenerate events (i.e. ignoring possibly existing
 events), there is the command option \ttt{whizard --rebuild-events}.
 
 %%%%%%%%%
 
 \section{Unweighted and weighted events}
 
 \whizard\ is able to generate unweighted events, i.e. events that are
 distributed uniformly and each contribute with the same event weight
 to the whole sample. This is done by mapping out the phase space of
 the process under consideration according to its different phase space
 channels (which each get their own weights), and then unweighting the
 sample of weighted events. Only a sample of unweighted events could in
 principle be compared to a real data sample from some experiment. The
 seventh column in the \whizard\ iteration/adaptation procedure tells you
 about the efficiency of the grids, i.e. how well the phase space is
 mapped to a flat function. The better this is achieved, the higher the
 efficiency becomes, and the closer the weights of the different phase
 space channels are to uniformity. This means, for higher efficiency
 less weighted events ("calls") are needed to generate a single
 unweighted event. An efficiency of 10 \% means that ten weighted
 events are needed to generate one single unweighted event. After the
 integration is done, \whizard\ uses the duration of calls during the
 adaptation to estimate a time interval needed to generate 10,000
 unweighted events. The ability of the adaptive multi-channel Monte
 Carlo decreases with the number of integrations, i.e. with the number
 of final state particles. Adding more and more final state particles
 in general also increases the complexity of phase space, especially
 its singularity structure. For a $2 \to 2$ process the efficiency is
 roughly of the order of several tens of per cent. As a rule of thumb,
 one can say that with every additional pair of final state particle
 the average efficiency one can achieve decreases by a factor of five
 to ten.
 
 The default of \whizard\ is to generate {\em unweighted} events. One can
 use the logical variable \ttt{?unweighted = false} to disable
 unweighting and generate weighted events. (The command
 \ttt{?unweighted = true} is a tautology, because \ttt{true} is the
 default for this variable.) Note that again this command has to appear
 {\em before} the corresponding \ttt{simulate} command, otherwise it will
 be ignored or effective only for any \ttt{simulate} command appearing
 later in the \sindarin\ file.
 
 In the unweighted procedure, \whizard\ is keeping track of the highest
 weight that has been appeared during the adaptation, and the
 efficiency for the unweighting has been estimated from the average
 value of the sampling function compared to the maximum value. In
 principle, during event generation no events should be generated whose
 sampling function value exceeds the maximum function value encountered
 during the grid adaptation. Sometimes, however, there are numerical
 fluctuations and such events are happening. They are called {\em
 excess events}. \whizard\ does keep track of these excess events
 during event generation and will report about them, e.g.:
 \begin{code}
 Warning: Encountered events with excess weight: 9 events (  0.090 %)
 | Maximum excess weight = 6.083E-01
 | Average excess weight = 2.112E-04
 \end{code}
 Whenever in an event generation excess events appear, this shows that
 the adaptation of the sampling function has not been perfect. When the
 number of excess weights is a finite number of percent, you should
 inspect the phase-space setup and try to improve its settings to get a
 better adaptation.
 
 %%%%%%%%%
 
 \section{Choice on event normalizations}
 
 There are basically four different choices to normalize event weights
 ($\braket{\ldots}$ denotes the average):
 \begin{enumerate}
 \item $\braket{w_i} = 1$, \qquad\qquad $\Braket{\sum_i w_i} = N$
 \item $\braket{w_i} = \sigma$, \qquad\qquad $\Braket{\sum_i w_i} = N
   \times \sigma$
 \item $\braket{w_i} = 1/N$, \quad\qquad $\Braket{\sum_i w_i} = 1$
 \item $\braket{w_i} = \sigma/N$, \quad\qquad $\Braket{\sum_i w_i} = \sigma$
 \end{enumerate}
 So the four options are to have the average weight equal to unity, to
 the cross section of the corresponding process, to one over the number
 of events, or the cross section over the event calls. In these four
 cases, the event weights sum up to the event number, the event number
 times the cross section, to unity, and to the cross section,
 respectively. Note that neither of these really guarantees that all
 event weights individually lie in the interval $0 \leq w_i \leq 1$.
 
 The user can steer the normalization of events by using in \sindarin\
 input files the string variable \ttt{\$sample\_normalization}. The default is
 \ttt{\$sample\_normalization = "auto"}, which uses option 1 for
 unweighted and 2 for weighted events, respectively. Note that this is
 also what the Les Houches Event Format (LHEF) demands for both types
 of events. This is \whizard's preferred mode, also for the reason, that
 event normalizations are independent from the number of events. Hence,
 event samples can be cut or expanded without further need to adjust
 the normalization. The unit normalization (option 1) can be switched
 on also for weighted events by setting the event normalization
 variable equal to \ttt{"1"}. Option 2 can be demanded
 by setting \ttt{\$sample\_normalization = "sigma"}. Options 3 and 4 can
 be set by \ttt{"1/n"} and \ttt{"sigma/n"}, respectively. \whizard\
 accepts small and capital letters for these expressions.
 
 In the following section we show some examples when discussing the
 different event formats available in \whizard.
 
 %%%%%%%%%
 
 \section{Event selection}
 
 The \ttt{selection} expression (cf.\ Sec.~\ref{subsec:analysis})
 reduces the event sample during generation or rescanning, selecting
 only events for which the expression evaluates to \ttt{true}.  Apart
 from internal analysis, the selection also applies to writing external
 files.  For instance, the following code generates a $e^+e^-\to
 W^+W^-$ sample with longitudinally polarized $W$ bosons only:
 \begin{footnotesize}
 \begin{verbatim}
 process ww = "e+", "e-" => "W-", "W+"
 polarized "W+"
 polarized "W-"
 ?polarized_events = true
 sqrts = 500
 selection = all Hel == 0 ["W+":"W-"]
 simulate (ww) { n_events = 1000 }
 \end{verbatim}
 \end{footnotesize}
 The number of events that end up in the sample on file is equal to the
 number of events with longitudinally polarized $W$s in the generated
 sample, so the file will contain less than 1000 events.
 
 
 %%%%%%%%%
 
 \section{Supported event formats}
 \label{sec:eventformats}
 
 Event formats can either be distinguished whether they are plain
 text (i.e. ASCII) formats or binary formats. Besides this, one can
 classify event formats according to whether they are natively
 supported by \whizard\ or need some external program or library to be
 linked. Table~\ref{tab:eventformats} gives a complete list of all
 event formats available in \whizard. The second column shows whether
 these are ASCII or binary formats, the third column contains brief
 remarks about the corresponding format, while the last column tells
 whether external programs or libraries are needed (which is the case
 only for the HepMC formats).
 
 \begin{table}
   \begin{center}
     \begin{tabular}{|l||l|l|r|}\hline
       Format & Type & remark & ext. \\\hline
       ascii & ASCII & \whizard\ verbose format & no
       \\
       Athena & ASCII & variant of HEPEVT & no
       \\
       debug & ASCII & most verbose \whizard\ format & no
       \\
       evx   & binary & \whizard's home-brew & no
       \\
       HepMC & ASCII & HepMC format & yes
       \\
       HEPEVT & ASCII & \whizard~1 style & no
       \\
       LCIO & ASCII & LCIO format & yes
       \\
       LHA  & ASCII & \whizard~1/old Les Houches style &no
       \\
       LHEF & ASCII & Les Houches accord compliant & no
       \\
       long & ASCII & variant of HEPEVT & no
       \\
       mokka & ASCII & variant of HEPEVT & no
       \\
       short & ASCII & variant of HEPEVT & no
       \\
       StdHEP (HEPEVT) & binary & based on HEPEVT common block  & no
       \\
       StdHEP (HEPRUP/EUP) & binary & based on HEPRUP/EUP common block
       & no \\
       Weight stream & ASCII & just weights & no \\
       \hline
     \end{tabular}
   \end{center}
   \caption{\label{tab:eventformats}
     Event formats supported by \whizard, classified according to
     ASCII/binary formats and whether an external program or library is
     needed to generate a file of this format. For both the HEPEVT and
     the LHA format there is a more verbose variant.
   }
 \end{table}
 The "\ttt{.evx}'' is \whizard's native binary event format. If you
 demand event generation and do not specify anything further, \whizard\
 will write out its events exclusively in this binary format. So in the
 examples discussed in the previous chapters (where we omitted all
 details about event formats), in all cases this and only this internal
 binary format has been generated. The generation of this raw format
 can be suppressed (e.g. if you want to have only one specific event
 file type) by setting the variable \verb|?write_raw = false|. However,
 if the raw event file is not present, \whizard\ is not able to re-use
 existing events (e.g. from an ASCII file) and will regenerate events
 for a given process. Note that from version v2.2.0 of \whizard\ on,
 the program is able to (partially) reconstruct complete events also
 from other formats than its internal format (e.g. LHEF), but this is
 still under construction and not yet complete.
 
 Other event formats can be written out by setting the variable
 \ttt{sample\_format = <format>}, where \ttt{<format>} can be any of
 the following supported variables:
 \begin{itemize}
 \item \ttt{ascii}: a quite verbose ASCII format which contains lots of
   information (an example is shown in the appendix). \newline
   Standard suffix: \ttt{.evt}
 \item \ttt{debug}: an even more verbose ASCII format intended for
   debugging which prints out also information about the internal data
   structures \newline
   Standard suffix: \ttt{.debug}
 \item \ttt{hepevt}: ASCII format that writes out a specific
   incarnation of the HEPEVT common block (\whizard~1
   back-compatibility) \newline
   Standard suffix: \ttt{.hepevt}
 \item \ttt{hepevt\_verb}: more verbose version of \ttt{hepevt} (\whizard~1
   back-compatibility) \newline
   Standard suffix: \ttt{.hepevt.verb}
 \item \ttt{short}: abbreviated variant of the previous HEPEVT (\whizard\
   1 back-compatibility)  \newline
   Standard suffix: \ttt{.short.evt}
 \item \ttt{long}: HEPEVT variant that contains a little bit more
   information than the short format but less than HEPEVT (\whizard\
   1 back-compatibility)  \newline
   Standard suffix: \ttt{.long.evt}
 \item \ttt{athena}: HEPEVT variant suitable for read-out in the ATLAS
   ATHENA software environment (\whizard\
   1 back-compatibility)  \newline
   Standard suffix: \ttt{.athena.evt}
 \item \ttt{mokka}: HEPEVT variant suitable for read-out in the MOKKA
   ILC software environment \newline
   Standard suffix: \ttt{.mokka.evt}
 \item \ttt{lcio}: LCIO ASCII format (only available if LCIO is
   installed and correctly linked) \newline
   Standard suffix: \ttt{.lcio}
 \item \ttt{lha}: Implementation of the Les Houches Accord as it was in
   the old MadEvent and \whizard~1 \newline
   Standard suffix: \ttt{.lha}
 \item \ttt{lha\_verb}: more verbose version of \ttt{lha} \newline
   Standard suffix: \ttt{.lha.verb}
 \item \ttt{lhef}: Formatted Les Houches Accord implementation that
   contains the XML headers \newline
   Standard suffix: \ttt{.lhe}
 \item \ttt{hepmc}: HepMC ASCII format (only available if HepMC is
   installed and correctly linked) \newline
   Standard suffix: \ttt{.hepmc}
 \item \ttt{stdhep}: StdHEP binary format based on the HEPEVT common
   block
   \newline
   Standard suffix: \ttt{.hep}
 \item \ttt{stdhep\_up}: StdHEP binary format based on the HEPRUP/HEPEUP
   common blocks
   \newline
   Standard suffix: \ttt{.up.hep}
 \item \ttt{stdhep\_ev4}: StdHEP binary format based on the HEPEVT/HEPEV4
   common blocks
   \newline
   Standard suffix: \ttt{.ev4.hep}
 \item \ttt{weight\_stream}: Format that prints out only the event
   weight (and maybe alternative ones) \newline
   Standard suffix: \ttt{.weight.dat}
 \end{itemize}
 Of course, the variable \ttt{sample\_format} can contain more than one
 of the above identifiers, in which case more  than one different event
 file format is generated. The list above also shows the standard
 suffixes for these event formats (remember, that the native binary
 format of \whizard\ does have the suffix \ttt{.evx}). (The suffix of
 the different event formats can even be changed by the user by setting
 the corresponding variable \ttt{\$extension\_lhef = "foo"} or
 \ttt{\$extension\_ascii\_short = "bread"}. The dot is automatically
 included.)
 
 The name of the corresponding event sample is taken to be the string
 of the name of the first process in the \ttt{simulate}
 statement. Remember, that conventionally the events for all processes
 in one \ttt{simulate} statement will be written into one single event
 file. So \ttt{simulate (proc1, proc2)} will write events for the two
 processes \ttt{proc1} and \ttt{proc2} into one single event file with
 name \ttt{proc1.evx}. The name can be changed by the user with the
 command \ttt{\$sample = "<name>"}.
 
 The commands \ttt{\$sample} and \ttt{sample\_format} are both accepted
 as optional arguments of a \ttt{simulate} command, so e.g.
 \ttt{simulate (proc) \{ \$sample = "foo" sample\_format = hepmc \}}
 generates an event sample in the HepMC format for the process
 \ttt{proc} in the file \ttt{foo.hepmc}.
 
 Examples for event formats, for specifications of the
 event formats correspond the different accords and publicatios:
 
 {\bf HEPEVT:}
 
 The HEPEVT is an ASCII event format that does not contain an event
 file header. There is a one-line header for each single event,
 containing four entries. The number of particles in the event
 (\ttt{ISTHEP}), which is four for a fictitious example process $hh\to
 hh$, but could be larger if e.g. beam remnants are demanded to be included in the
 event. The second entry and third entry are the number of outgoing
 particles and beam remnants, respectively. The event weight is the
 last entry. For each particle in the event there are three lines:
 the first one is the status according to the HEPEVT format,
 \ttt{ISTHEP}, the second one the PDG code, \ttt{IDHEP}, then there are
 the one or two possible mother particle, \ttt{JMOHEP}, the first and
 last possible daughter particle, \ttt{JDAHEP}, and the polarization.
 The second line contains the three momentum components, $p_x$, $p_y$,
 $p_z$, the particle energy $E$, and its mass, $m$.
 The last line contains the position of the vertex in the event
 reconstruction.
 
 \begin{scriptsize}
   \begin{verbatim}
  4 2 0  3.0574068604E+08
  2 25 0 0 3 4 0
   0.0000000000E+00  0.0000000000E+00  4.8412291828E+02  5.0000000000E+02  1.2500000000E+02
   0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00
  2 25 0 0 3 4 0
   0.0000000000E+00  0.0000000000E+00 -4.8412291828E+02  5.0000000000E+02  1.2500000000E+02
   0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00
  1 25 1 2 0 0 0
  -1.4960220911E+02 -4.6042825611E+02  0.0000000000E+00  5.0000000000E+02  1.2500000000E+02
   0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00
  1 25 1 2 0 0 0
   1.4960220911E+02  4.6042825611E+02  0.0000000000E+00  5.0000000000E+02  1.2500000000E+02
   0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00
   \end{verbatim}
 \end{scriptsize}
 
 {\bf ASCII SHORT:}
 
 This is basically the same as the HEPEVT standard, but very much
 abbreviated. The header line for each event is identical, but the first
 line per particle does only contain the PDG and the polarization,
 while the vertex information line is omitted.
 
 \begin{scriptsize}
   \begin{verbatim}
  4 2 0  3.0574068604E+08
  25 0
   0.0000000000E+00  0.0000000000E+00  4.8412291828E+02  5.0000000000E+02  1.2500000000E+02
  25 0
   0.0000000000E+00  0.0000000000E+00 -4.8412291828E+02  5.0000000000E+02  1.2500000000E+02
  25 0
  -1.4960220911E+02 -4.6042825611E+02  0.0000000000E+00  5.0000000000E+02  1.2500000000E+02
  25 0
   1.4960220911E+02  4.6042825611E+02  0.0000000000E+00  5.0000000000E+02  1.2500000000E+02
   \end{verbatim}
 \end{scriptsize}
 
 {\bf ASCII LONG:}
 
 Identical to the ASCII short format, but after each event there is a
 line containg two values: the value of the sample function to be
 integrated over phase space, so basically the squared matrix element
 including all normalization factors, flux factor, structure functions
 etc.
 
 \begin{scriptsize}
   \begin{verbatim}
  4 2 0  3.0574068604E+08
  25 0
   0.0000000000E+00  0.0000000000E+00  4.8412291828E+02  5.0000000000E+02  1.2500000000E+02
  25 0
   0.0000000000E+00  0.0000000000E+00 -4.8412291828E+02  5.0000000000E+02  1.2500000000E+02
  25 0
  -1.4960220911E+02 -4.6042825611E+02  0.0000000000E+00  5.0000000000E+02  1.2500000000E+02
  25 0
   1.4960220911E+02  4.6042825611E+02  0.0000000000E+00  5.0000000000E+02  1.2500000000E+02
   1.0000000000E+00  1.0000000000E+00
   \end{verbatim}
 \end{scriptsize}
 
 {\bf ATHENA:}
 
 Quite similar to the HEPEVT ASCII format. The header line, however,
 does contain only two numbers: an event counter, and the number of
 particles in the event. The first line for each particle lacks the
 polarization information (irrelevant for the ATHENA environment), but
 has as leading entry an ordering number counting the particles in the
 event. The vertex information line has only the four relevant position
 entries.
 
 
 \begin{scriptsize}
   \begin{verbatim}
  0 4
  1 2 25 0 0 3 4
   0.0000000000E+00  0.0000000000E+00  4.8412291828E+02  5.0000000000E+02  1.2500000000E+02
   0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00
  2 2 25 0 0 3 4
   0.0000000000E+00  0.0000000000E+00 -4.8412291828E+02  5.0000000000E+02  1.2500000000E+02
   0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00
  3 1 25 1 2 0 0
  -1.4960220911E+02 -4.6042825611E+02  0.0000000000E+00  5.0000000000E+02  1.2500000000E+02
   0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00
  4 1 25 1 2 0 0
   1.4960220911E+02  4.6042825611E+02  0.0000000000E+00  5.0000000000E+02  1.2500000000E+02
   0.0000000000E+00  0.0000000000E+00  0.0000000000E+00  0.0000000000E+00
   \end{verbatim}
 \end{scriptsize}
 
 {\bf MOKKA:}
 
 Quite similar to the ASCII short format, but the event entries are the
 particle status, the PDG code, the first and last daughter, the
 three spatial components of the momentum, as well as the mass.
 
 \begin{scriptsize}
 \begin{verbatim}
  4 2 0  3.0574068604E+08
  2 25 3 4  0.0000000000E+00  0.0000000000E+00  4.8412291828E+02  1.2500000000E+02
  2 25 3 4  0.0000000000E+00  0.0000000000E+00 -4.8412291828E+02  1.2500000000E+02
  1 25 0 0 -1.4960220911E+02 -4.6042825611E+02  0.0000000000E+00  1.2500000000E+02
  1 25 0 0  1.4960220911E+02  4.6042825611E+02  0.0000000000E+00  1.2500000000E+02
 \end{verbatim}
 \end{scriptsize}
 
 {\bf LHA:}
 
 This is the implementation of the Les Houches Accord, as it was used
 in \whizard\ 1 and the old MadEvent. There is a first line containing
 six entries: 1. the number of particles in the event, \ttt{NUP},
 2. the subprocess identification index, \ttt{IDPRUP}, 3. the event
 weight, \ttt{XWGTUP}, 4. the scale of the process, \ttt{SCALUP},
 5. the value or status of $\alpha_{QED}$, \ttt{AQEDUP}, 6. the value
 for $\alpha_s$, \ttt{AQCDUP}. The next seven lines contain as many
 entries as there are particles in the event: the first one has the PDG
 codes, \ttt{IDUP}, the next two the first and second mother of the particles,
 \ttt{MOTHUP}, the fourth and fifth line the two color indices,
 \ttt{ICOLUP}, the next one the status of the particle, \ttt{ISTUP},
 and the last line the polarization information, \ttt{ISPINUP}.
 At the end of the event there are as lines for each particles with the
 counter in the event and the four-vector of the particle. For more
 information on this event format confer~\cite{LesHouches}.
 
 \begin{scriptsize}
   \begin{verbatim}
  25 25  5.0000000000E+02  5.0000000000E+02 -1 -1 -1 -1 3 1
   1.0000000000E-01  1.0000000000E-03  1.0000000000E+00 42
      4     1  3.0574068604E+08  1.000000E+03 -1.000000E+00 -1.000000E+00
     25    25    25    25
      0     0     1     1
      0     0     2     2
      0     0     0     0
      0     0     0     0
     -1    -1     1     1
      9     9     9     9
      1  5.0000000000E+02  0.0000000000E+00  0.0000000000E+00  4.8412291828E+02
      2  5.0000000000E+02  0.0000000000E+00  0.0000000000E+00 -4.8412291828E+02
      3  5.0000000000E+02 -1.4960220911E+02 -4.6042825611E+02  0.0000000000E+00
      4  5.0000000000E+02  1.4960220911E+02  4.6042825611E+02  0.0000000000E+00
   \end{verbatim}
 \end{scriptsize}
 
 {\bf LHEF:}
 
 This is the modern version of the Les Houches accord event format
 (LHEF), for the details confer the corresponding publication~\cite{LHEF}.
 
 \begin{scriptsize}
   \begin{verbatim}
 <LesHouchesEvents version="1.0">
 <header>
   <generator_name>WHIZARD</generator_name>
   <generator_version>2.6.5</generator_version>
 </header>
 <init>
  25 25  5.0000000000E+02  5.0000000000E+02 -1 -1 -1 -1 3 1
   1.0000000000E-01  1.0000000000E-03  1.0000000000E+00 42
 </init>
 <event>
  4 42  3.0574068604E+08  1.0000000000E+03 -1.0000000000E+00 -1.0000000000E+00
  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
  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
  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
  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
 </event>
 </LesHouchesEvents>
   \end{verbatim}
 \end{scriptsize}
 
 Note that for the LHEF format, there are different versions according
 to the different stages of agreement. They can be addressed from
 within the \sindarin\ file by setting the string variable
 \ttt{\$lhef\_version} to one of (at the moment) three values:
 \ttt{"1.0"}, \ttt{"2.0"}, or \ttt{"3.0"}. The examples above
 corresponds (as is indicated in the header) to the version \ttt{"1.0"}
 of the LHEF format. Additional information in form of alternative
 squared matrix elements or event weights in the event are the most
 prominent features of the other two more advanced versions. For more
 details confer the literature.
 
 \vspace{.5cm}
 
 Sample files for the default ASCII format as well as for the debug
 event format are shown in the appendix.
 
 %%%%%%%%%
 
 \section[Interfaces to Parton Showers, Matching and
 Hadronization]{Interfaces to Parton Showers, Matching\\and
   Hadronization}
 
 This section describes the interfaces to the internal parton shower as
 well as the parton shower and hadronization routines from
 \pythia. Moreover, our implementation of the MLM matching making use
 of the parton showers is described. Sample \sindarin\ files are
 located in the \ttt{share/examples} directory.
 All input files come in two versions, one using the internal shower,
 ending in \ttt{W.sin}, and one using \pythia's shower, ending in
 \ttt{P.sin}. Thus we state all file names as ending with \ttt{X.sin},
 where \ttt{X} has to be replaced by either \ttt{W} or \ttt{P}.
 The input files include \ttt{EENoMatchingX.sin} and
 \ttt{DrellYanNoMatchingX.sin} for $e^+ e^- \to hadrons$ and $p\bar{p}
 \to Z$ without matching. The corresponding \sindarin\ files with
 matching enabled are \ttt{EEMatching2X.sin} to \ttt{EEMatching5X.sin}
 for $e^+ e^- \to hadrons$ with a different number of partons included
 in the matrix element and \ttt{DrallYanMatchingX.sin} for Drell-Yan
 with one matched emission.
 
 \subsection{Parton Showers and Hadronization}
 
 From version 2.1 onwards, \whizard\ contains an implementation of an
 analytic parton shower as presented in \cite{Kilian:2011ka}, providing
 the opportunity to perform the parton shower from whithin
 \whizard. Moreover, an interface to \pythia\ is included, which can be
 used to delegate the parton shower to \pythia. The same interface can
 be used to hadronize events using the generated events using \pythia's
 hadronization routines. Note that by \pythia's default, when
 performing initial-state radiation multiple interactions are included
 and when performing the hadronization hadronic decays are included. If
 required, these additional steps have to be switched off using the
 corresponding arguments for \pythia's \ttt{PYGIVE} routine vie the
 \ttt{\$ps\_PYTHIA\_PYGIVE} string.
 
 Note that from version 2.2.4 on the earlier flag
 \ttt{--enable-shower} flag has been abandoned, and there is only a
 flag to either compile or not compile the interally attached
 \pythia\ttt{6} package (\ttt{--enable-pythia6}) last release of
 the \fortran\ \pythia, v6.427) as well as the interface. It can be
 invoked by the following \sindarin\ keywords:\\[2ex]
 %
 \centerline{\begin{tabular}{|l|l|}
 \hline\ttt{?ps\_fsr\_active = true} & master switch for final-state
 parton showers\\\hline
 \ttt{?ps\_isr\_active = true} & master switch for initial-state parton
 showers\\\hline
 \ttt{?ps\_taudec\_active = true} & master switch for $\tau$ decays (at
 the moment only via \ttt{TAUOLA}\\\hline
 \ttt{?hadronization\_active = true} & master switch to enable
 hadronization\\\hline
 \ttt{\$shower\_method = "PYTHIA6"} & switch to use \pythiasix's parton
 shower instead of \\ &
  \whizard's own shower\\\hline
 \end{tabular}}\mbox{}
 
 \vspace{4mm}
 
 If either \ttt{?ps\_fsr\_active} or \ttt{?ps\_isr\_active} is set to \verb|true|, the
 event will be transferred to the internal shower routines or the \pythia\ data structures,
 and the chosen shower steps (initial- and final-state radiation) will be
 performed. If hadronization is enabled via the \ttt{?hadronization\_active} switch, \whizard\ will call \pythia's hadronization routine.
 The hadron\-ization can be applied to events showered using the internal shower or showered using \pythia's shower routines, as well as unshowered events.
 Any necessary transfer of event data to \pythia\ is automatically taken care of within \whizard's shower interface.
 The resulting (showered and/or hadronized) event will be transferred back to \whizard,
 the former final particles will be marked as intermediate. The
 analysis can be applied to a showered and/or hadronized event just
 like in the unshowered/unhadronized case. Any event file can be used
 and will contain the showered/hadronized event.
 
 Settings for the internal analytic parton shower are set via the following \sindarin\ variables:\\[2ex]
 \begin{description}
 \item[\ttt{ps\_mass\_cutoff}] The cut-off in virtuality, below
   which, partons are assumed to radiate no more. Used for both ISR and
   FSR. Given in $\mbox{GeV}$. (Default = 1.0)
 \item[\ttt{ps\_fsr\_lambda}] The value for $\Lambda$ used in
   calculating the value of the running coupling constant $\alpha_S$
   for Final State Radiation. Given in $\mbox{GeV}$. (Default = 0.29)
 \item[\ttt{ps\_isr\_lambda}] The value for $\Lambda$ used in
   calculating the value of the running coupling constant $\alpha_S$
   for Initial State Radiation. Given in $\mbox{GeV}$. (Default = 0.29)
 \item[\ttt{ps\_max\_n\_flavors}] Number of quark flavours taken
   into account during shower evolution. Meaningful choices are 3 to
   include $u,d,s$-quarks, 4 to include $u,d,s,c$-quarks and 5 to
   include $u,d,s,c,b$-quarks. (Default = 5)
 \item[\ttt{?ps\_isr\_alphas\_running}] Switch to decide between a
   constant $\alpha_S$, given by \ttt{ps\_fixed\_alphas}, and a
   running $\alpha_S$, calculated using \ttt{ps\_isr\_lambda} for
   ISR. (Default = true)
 \item[\ttt{?ps\_fsr\_alphas\_running}] Switch to decide between a
   constant $\alpha_S$, given by \ttt{ps\_fixed\_alphas}, and a
   running $\alpha_S$, calculated using \ttt{ps\_fsr\_lambda} for
   FSR. (Default = true)
 \item[\ttt{ps\_fixed\_alphas}] Fixed value of $\alpha_S$ for the
   parton shower. Used if either one of the variables
   \ttt{?ps\_fsr\_alphas\_running}
   or \ttt{?ps\_isr\_alphas\_running} are set to
   \verb|false|. (Default = 0.0)
 \item[\ttt{?ps\_isr\_angular\_ordered}] Switch for angular ordered
   ISR. (Default = true )\footnote{The FSR is always simulated with
     angular ordering enabled.}
 \item[\ttt{ps\_isr\_primordial\_kt\_width}] The width in
   $\mbox{GeV}$ of the Gaussian assumed to describe the transverse
   momentum of partons inside the proton. Other shapes are not yet
   implemented. (Default = 0.0)
 \item[\ttt{ps\_isr\_primordial\_kt\_cutoff}] The maximal transverse
   momentum in $\mbox{GeV}$ of a parton inside the proton. Used as a
   cut-off for the Gaussian. (Default = 5.0)
 \item[\ttt{ps\_isr\_z\_cutoff}] Maximal $z$-value in initial state
   branchings. (Default = 0.999)
 \item[\ttt{ps\_isr\_minenergy}] Minimal energy in $\mbox{GeV}$ of
   an emitted timelike or final parton. Note that the energy is not
   calculated in the labframe but in the center-of-mas frame of the two
   most initial partons resolved so far, so deviations may
   occur. (Default = 1.0)
 \item[\ttt{ps\_isr\_tscalefactor}] Factor for the starting scale in
   the initial state shower evolution. ( Default = 1.0 )
 \item[\ttt{?ps\_isr\_only\_onshell\_emitted\_partons}] Switch to
   allow only for on-shell emitted partons, thereby rejecting all
   possible final state parton showers starting from partons emitted
   during the ISR. (Default = false)
 \end{description}
 
 Settings for the \pythia\ are transferred using the following
 \sindarin\ variables:\\[2ex]
 \centerline{\begin{tabular}{|l|l|}
 \hline\ttt{?ps\_PYTHIA\_verbose} & if set to false, output from
 \pythia\ will be suppressed\\\hline
 \ttt{\$ps\_PYTHIA\_PYGIVE} & a string containing settings transferred
 to \pythia's \ttt{PYGIVE} subroutine.\\ & The format is explained in
 the \pythia\ manual. The limitation to 100 \\ & characters mentioned
 there does not apply here, the string is split \\ & appropriately
 before being transferred to \pythia.\\\hline
 \end{tabular}}\mbox{}
 
 \vspace{4mm}
 
 Note that the included version of \pythia\ uses \lhapdf\ for initial state
 radiation whenever this is available, but the PDF set has to be set
 manually in that case using the keyword \ttt{ps\_PYTHIA\_PYGIVE}.
 
 \subsection{Parton shower -- Matrix Element Matching}
 
 Along with the inclusion of the parton showers, \whizard\ includes an
 implementation of the MLM matching procedure. For a detailed
 description of the implemented steps see \cite{Kilian:2011ka}. The
 inclusion of MLM matching still demands some manual settings in the
 \sindarin\ file. For a given base process and a matching of $N$
 additional jets, all processes that can be obtained by attaching up to
 $N$ QCD splittings, either a quark emitting a gluon or a gluon
 splitting into two quarks ar two gluons, have to be manually specified
 as additional processes. These additional processes need to be
 included in the \ttt{simulate} statement along with the original
 process. The \sindarin\ variable \ttt{mlm\_nmaxMEjets} has to be
 set to the maximum number of additional jets $N$. Moreover additional
 cuts have to be specified for the additional processes.
 \begin{verbatim}
   alias quark = u:d:s:c
   alias antiq = U:D:S:C
   alias j = quark:antiq:g
 
   ?mlm_matching = true
   mlm_ptmin = 5 GeV
   mlm_etamax = 2.5
   mlm_Rmin = 1
 
   cuts = all Dist > mlm_Rmin [j, j]
          and all Pt > mlm_ptmin [j]
          and all abs(Eta) < mlm_etamax [j]
 \end{verbatim}
 Note that the variables \ttt{mlm\_ptmin}, \ttt{mlm\_etamax} and
 \ttt{mlm\_Rmin} are used by the matching routine. Thus, replacing the
 variables in the \ttt{cut} expression and omitting the assignment
 would destroy the matching procedure.
 
 The complete list of variables introduced to steer the matching procedure is as follows:
 \begin{description}
 \item[\ttt{?mlm\_matching\_active}] Master switch to enable MLM
   matching. (Default = false)
 \item[\ttt{mlm\_ptmin}] Minimal transverse momentum, also used in
   the definition of a jet
 \item[\ttt{mlm\_etamax}] Maximal absolute value of pseudorapidity
   $\eta$, also used in defining a jet
 \item[\ttt{mlm\_Rmin}] Minimal $\eta-\phi$ distance $R_{min}$
 \item[\ttt{mlm\_nmaxMEjets}] Maximum number of jets $N$
 \item[\ttt{mlm\_ETclusfactor}] Factor to vary the jet
   definition. Should be $\geq 1$ for complete coverage of phase
   space. (Default = 1)
 \item[\ttt{mlm\_ETclusminE}] Minimal energy in the variation of the
   jet definition
 \item[\ttt{mlm\_etaclusfactor}] Factor in the variation of the jet
   definition. Should be $\leq 1$ for complete coverage of phase
   space. (Default = 1)
 \item[\ttt{mlm\_Rclusfactor}] Factor in the variation of the jet
   definition. Should be $\ge 1$ for complete coverage of phase
   space. (Default = 1)
 \end{description}
 The variation of the jet definition is a tool to asses systematic
 uncertainties introduced by the matching procedure (See section 3.1 in
 \cite{Kilian:2011ka}).
 
 
 %%%%%%%%%
 
 \section{Rescanning and recalculating events}
 \label{sec:rescan}
 
 In the simplest mode of execution, \whizard\ handles its events at the
 point where they are generated.  It can apply event transforms such as
 decays or shower (see above), it can analyze the events, calculate and
 plot observables, and it can output them to file.  However, it is also
 possible to apply two different operations to those events in
 parallel, or to reconsider and rescan an event sample that has been
 previously generated.
 
 We first discuss the possibilities that \ttt{simulate} offers.  For
 each event, \whizard\ calculates the matrix element for the hard
 interaction, supplements this by Jacobian and phase-space factors in
 order to obtain the event weight, optionally applies a rejection step
 in order to gather uniformly weighted events, and applies the
 cuts and analysis setup.  We may ask about the event matrix element or
 weight, or the analysis result, that we would have obtained for a
 different setting.  To this end, there is an \ttt{alt\_setup} option.
 
 This option allows us to recalculate, event by event, the matrix
 element, weight, or analysis contribution with a different parameter
 set but identical kinematics.  For instance, we may evaluate a
 distribution for both zero and non-zero anomalous coupling \ttt{fw}
 and enter some observable in separate histograms:
 
 \begin{footnotesize}
 \begin{verbatim}
   simulate (some_proc) {
       fw = 0
       analysis = record hist1 (eval Pt [H])
     alt_setup = {
        fw = 0.01
        analysis = record hist2 (eval Pt [H])
     }
   }
 \end{verbatim}
 \end{footnotesize}
 
 In fact, the \ttt{alt\_setup} object is not restricted to a single
 code block (enclosed in curly braces) but can take a list of those,
 \begin{footnotesize}
 \begin{verbatim}
   alt_setup = { fw = 0.01 }, { fw = 0.02 }, ...
 \end{verbatim}
 \end{footnotesize}
 Each block provides the environment for a separate evaluation of the
 event data.  The generation of these events, i.e., their kinematics,
 is still steered by the primary environment.
 
 The \ttt{alt\_setup} blocks may modify various settings that affect the
 evaluation of an event, including physical parameters, PDF choice,
 cuts and analysis, output format, etc.  This must not (i.e., cannot)
 affect the kinematics of an event, so don't modify particle masses.
 When applying cuts, they can only reduce the generated event sample,
 so they apply on top of the primary cuts for the simulation.
 
 Alternatively, it is possible to \ttt{rescan} a sample that has been
 generated by a previous \ttt{simulate} command:
 \begin{footnotesize}
 \begin{verbatim}
   simulate (some_proc) { $sample = "my_events"
     analysis = record hist1 (eval Pt [H])
   }
   ?update_sqme = true
   ?update_weight = true
   rescan "my_events" (some_proc) {
     fw = 0.01
     analysis = record hist2 (eval Pt [H])
   }
   rescan "my_events" (some_proc) {
     fw = 0.05
     analysis = record hist3 (eval Pt [H])
   }
 \end{verbatim}
 \end{footnotesize}
 In more complicated situation, rescanning is more transparent and
 offers greater flexibility than doing all operations at the very point
 of event generation.
 
 Combining these features with the \ttt{scan} looping construct, we
 already cover a considerable range of applications.  (There are
 limitations due to the fact that \sindarin\ doesn't provide array
 objects, yet.)  Note that the \ttt{rescan} construct also allows
 for an \ttt{alt\_setup} option.
 
 You may generate a new sample by rescanning, for which you may choose
 any output format:
 \begin{footnotesize}
 \begin{verbatim}
   rescan "my_events" (some_proc) {
     selection = all Pt > 100 GeV [H]
     $sample = "new_events"
     sample_format = lhef
   }
 \end{verbatim}
 \end{footnotesize}
 
 The event sample that you rescan need not be an internal raw \whizard\
 file, as above.  You may rescan a LHEF file,
 \begin{footnotesize}
 \begin{verbatim}
   rescan "lhef_events" (proc) {
     $rescan_input_format = "lhef"
   }
 \end{verbatim}
 \end{footnotesize}
 This file may have any origin, not necessarily from \whizard.  To
 understand such an external file, \whizard\ must be able to
 reconstruct the hard process and match it to a process with a known
 name (e.g., \ttt{proc}), that has been defined in the \sindarin\ script
 previously.
 
 Within its limits, \whizard\ can thus be used for translating an event
 sample from one format to another format.
 
 There are three important switches that control the rescanning
 behavior.  They can be set or unset independently.
 \begin{itemize}
 \item \ttt{?update\_sqme} (default: false).
   If true, \whizard\ will recalculate the hard matrix element for each
   event.  When applying an analysis, the recalculated squared matrix
   element (averaged and summed over quantum numbers as usual) is
   available as the variable \ttt{sqme\_prc}.  This may be related to
   \ttt{sqme\_ref}, the corresponding
   value in the event file, if available.  (For the \ttt{alt\_env}
   option, this switch is implied.)
 \item \ttt{?update\_weight} (default: false).
   If true, \whizard\ will recalculate the event weight according to
   the current environment and apply this to the event.  In particular,
   the user may apply a \ttt{reweight} expression.  In an
   analysis, the new weight value is available as \ttt{weight\_prc}, to
   be related
   to \ttt{weight\_ref} from the sample.  The updated weight will be
   applied for histograms and averages.  An unweighted event sample
   will thus be transformed into a weighted event sample.  (This switch
   is also implied for the \ttt{alt\_env} option.)
 \item \ttt{?update\_event} (default: false).
   If true, \whizard\ will generate a new decay chain etc., if
   applicable.  That is, it reuses just the particles in the hard
   process.  Otherwise, the complete event is kept as it is written to
   file.
 \end{itemize}
 For these options to make sense, \whizard\ must have access to a full
 process object, so the \sindarin\ script must contain not just a
 definition but also a \ttt{compile} command for the matrix elements in
 question.
 
 If an event file (other than raw format) contains several processes as
 a mixture, they must be identifiable by a numeric ID.  \whizard\ will
 recognize the processes if their respective \sindarin\ definitions
 contain appropriate \ttt{process\_num\_id} options, such as
 \begin{footnotesize}
 \begin{verbatim}
   process foo = u, ubar => d, dbar { process_num_id = 42 }
 \end{verbatim}
 \end{footnotesize}
 
 Certain event-file formats, such as LHEF, support alternative
 matrix-element values or weights.  \whizard\ can thus write both
 original and
 recalculated matrix-element and weight values.
 Other formats support only a single
 event weight, so the \ttt{?update\_weight} option is necessary for a
 visible effect.
 
 External event files in formats such as LHEF, HepMC, or LCIO, also may
 carry information about the value of the strong coupling $\alpha_s$
 and the energy scale of each event.  This information will also be
 provided by \whizard\ when writing external event files.  When such an
 event file is rescanned, the user has the choice to either user the
 $\alpha_s$ value that \whizard\ defines in the current context (or the
 method for obtaining an event-specific running $\alpha_s$ value), or
 override this for each event by using the value in the event file.
 The corresponding parameter is \ttt{?use\_alphas\_from\_file}, which
 is false by default.  Analogously, the parameter
 \ttt{?use\_scale\_from\_file} may be set to override the scale
 definition in the current context.  Obviously, these settings
 influence matrix-element recalculation and therefore require
 \ttt{?update\_sqme} to be set in order to become operational.
 
 %%%%%%%%%
 
 \section{Negative weight events}
 For usage at NLO refer to Subsection~\ref{ss:fixedorderNLOevents}.
 In case, you have some other mechanism to produce events with negative
 weights (e.g. with the \ttt{weight = {\em <expr>}} command), keep in
 mind that you should activate \ttt{?negative\_weights = true} and
 \ttt{unweighted = false}.  The generation of unweighted events with
 varying sign (also known as events and counter events) is currently not
 supported.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{User Code Plug-Ins}
 \label{chap:user}
 
 {\color{red}
 Note that the user-code plug-in mechanism has been currently (for
 version 2.2.0) disabled, as the huge refactoring of the code between
 versions 2.1.X and 2.2.X has completely changed many of the
 interfaces. We plan to bring the interface for user code for spectra,
 structure functions and event shapes, cuts and observables back online
 as soon as possible, at latest for version 2.4.0.
 }
 
 \vspace{2cm}
 
 
 \section{The plug-in mechanism}
 
 The capabilities of \whizard\ and its \sindarin\ command
 language are not always sufficient to adapt to all users' needs.  To
 make the program more versatile, there are several spots in the
 workflow where the user may plug in his/her own code, to enhance or
 modify the default behavior.
 
 User code can be injected, without touching \whizard's source code, in
 the following places:
 \begin{itemize}
 \item
   Cuts, weights, analysis, etc.:
   \begin{itemize}
   \item
     Cut functions that operate on a whole subevent.
   \item
     Observable (e.g., event shapes) calculated from a whole subevent.
   \item
     Observable calculated for a particle or particle pair.
   \end{itemize}
 \item
   Spectra and structure functions.
 \end{itemize}
 Additional plug-in locations may be added in the future.
 
 User code is loaded dynamically by \whizard.  There are two
 possibilities:
 \begin{enumerate}
 \item
   The user codes the required procedures in one or more Fortran source
   files that are present in the working directory of the \whizard\
   program.  \whizard\ is called with the \ttt{-u} flag:
   \begin{quote}
     \ttt{whizard -u --user-src=\emph{user-source-code-file}} \ldots
   \end{quote}
   The file must have the extension \ttt{.f90}, and the file name must
   be specified without extension.
 
   There may be an arbitrary number of user source-code files.  The
   compilation is done in order of appearance.  If the name of the user
   source-code file is \ttt{user.f90}, the flag \ttt{--user-src} can
   be omitted.
 
   This tells the program to compile and dynamically link the code at
   runtime.  The basename of the linked library is \ttt{user}.
 
   If a compiled (shared) library with that name already exists, it is taken
   as-is.  If the
   user code changes or the library becomes invalid for other reasons,
   recompilation of the user-code files can be forced by the flag
   \ttt{--rebuild-user} or by the generic \ttt{-r} flag.
 \item
   The user codes and compiles the required procedures him/herself.
   They should be provided in form of a library, where the interfaces of
   the individual procedures follow C calling conventions and exactly
   match the required interfaces as described in the following
   sections.  The library must be compiled in such a way that it can be
   dynamically linked.  If the calling conventions are met, the actual
   user code may be written in any programming language.  E.g., it may
   be coded in Fortran, C, or C++ (with \ttt{extern(C)} specifications).
 
   \whizard\ is called with the \ttt{-u} flag and is
   given the name of the user library as
   \begin{quote}
     \ttt{whizard -u --user-lib=\emph{user-library-file}} \ldots
   \end{quote}
 \end{enumerate}
 The library file should either be a dynamically loadable (shared)
 library with appropriate extension (\ttt{.so} on Linux), or a libtool
 archive (\ttt{.la}).
 
 The user-provided procedures may have arbitrary names; the user just
 has to avoid clashes with procedures from the Fortran runtime library
 or from the operating-system environment.
 
 
 \section{Data Types Used for Communication}
 \label{sec:c_prt}
 
 Since the user-code interface is designed to be interoperable with C,
 it communicates with \whizard\ only via C-interoperable data types.
 The basic data types (Fortran: integer and real kinds) \ttt{c\_int}
 and \ttt{c\_double} are usually identical with the default kinds on
 the Fortran side.  If necessary, explicit conversion may be inserted.
 
 For transferring particle data, we are using a specific derived type
 \ttt{c\_prt\_t} which has the following content:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
   type, bind(C) :: c_prt_t
      integer(c_int) :: type
      integer(c_int) :: pdg
      integer(c_int) :: polarized
      integer(c_int) :: h
      real(c_double) :: pe
      real(c_double) :: px
      real(c_double) :: py
      real(c_double) :: pz
      real(c_double) :: p2
   end type c_prt_t
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 The meaning of the entries is as follows:
 \begin{description}
 \item[\ttt{type}:] The type of the particle.  The common type
   codes are 1=incoming, 2=outgoing, and 3=composite.  A composite
   particle in a subevent is created from a combination of individual
   particle momenta, e.g., in jet clustering.  If the status code is
   not defined, it is set to zero.
 \item[\ttt{pdg}:] The particle identification code as proposed by the
   Particle Data Group.  If undefined, it is zero.
 \item[\ttt{polarized}:] If nonzero, the particle is polarized.  The
   only polarization scheme supported at this stage is helicity.  If
   zero, particle polarization is ignored.
 \item[\ttt{h}:] If the particle is polarized, this is the helicity.  $0$
   for a scalar, $\pm 1$ for a spin-1/2 fermion, $-1,0,1$ for a spin-1
   boson.
 \item[\ttt{pe}:] The energy in GeV.
 \item[\ttt{px}/\ttt{py}:] The transversal momentum components in GeV.
 \item[\ttt{pz}:] The longitudinal momentum component in GeV.
 \item[\ttt{p2}:] The invariant mass squared of the actual momentum in GeV$^2$.
 \end{description}
 \whizard\ does not provide tools for manipulating \ttt{c\_prt\_t}
 objects directly.  However, the four-momentum can be used in
 Lorentz-algebra calculations from the \ttt{lorentz} module.  To this
 end, this module defines the transformational functions
 \ttt{vector4\_from\_c\_prt} and \ttt{vector4\_to\_c\_prt}.
 
 
 \section{User-defined Observables and Functions}
 \subsection{Cut function}
 Instead of coding a cut expression in \sindarin, it may be coded in
 Fortran, or in any other language with a C-compatible interface.  A
 user-defined cut expression is referenced in \sindarin\ as follows:
 \begin{quote}
 \begin{footnotesize}
   \ttt{cuts = user\_cut (\emph{name-string}) [\emph{subevent}]}
 \end{footnotesize}
 \end{quote}
 The \ttt{\emph{name-string}} is an expression that evaluates to
 string, the name of the function to call in the user code.  The
 \emph{subevent} is a subevent expression, analogous to the built-in
 cut definition syntax.  The result of the \ttt{user\_cut} function is
 a logical value in \sindarin.  It is true if the event passes the cut,
 false otherwise.
 
 If coded in Fortran, the actual user-cut function in the user-provided
 source code has the following form:
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 function user_cut_fun (prt, n_prt) result (iflag) bind(C)
    use iso_c_binding
    use c_particles
    type(c_prt_t), dimension(*), intent(in) :: prt
    integer(c_int), intent(in) :: n_prt
    integer(c_int) :: iflag
    ! ... code that evaluates iflag
 end function user_cut_fun
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 Here, \ttt{user\_cut\_fun} can be replaced by an arbitrary name by
 which the function is referenced as \ttt{\emph{name-string}} above.
 The \ttt{bind(C)} attribute in the function declaration is mandatory.
 
 The argument \ttt{prt} is an array of objects of type \ttt{c\_prt\_t},
 as described above.  The integer \ttt{n\_prt} is the number of entries
 in the array.  It is passed separately in order to determine the
 actual size of the assumed-size \ttt{prt} array.
 
 The result \ttt{iflag} is an integer.  A nonzero value indicates
 \ttt{true} (i.e., the event passes the cut), zero value indicates
 \ttt{false}.  (We do not use boolean values in the interface because
 their interoperability might be problematic on some systems.)
 
 \subsection{Event-shape function}
 
 An event-shape function is similar to a cut function.  It takes a
 subevent as argument and returns a real (i.e., C double) variable.  It
 can be used for defining subevent observables, event weights, or the
 event scale, as in
 \begin{quote}
 \begin{footnotesize}
   \ttt{analysis = record \emph{hist-id} (user\_event\_fun (\emph{name-string}) [\emph{subevent}])}
 \end{footnotesize}
 \end{quote}
 or
 \begin{quote}
 \begin{footnotesize}
   \ttt{scale = user\_event\_fun (\emph{name-string}) [\emph{subevent}]}
 \end{footnotesize}
 \end{quote}
 The corresponding Fortran source code has the form
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 function user_event_fun (prt, n_prt) result (rval) bind(C)
    use iso_c_binding
    use c_particles
    type(c_prt_t), dimension(*), intent(in) :: prt
    integer(c_int), intent(in) :: n_prt
    real(c_double) :: rval
    ! ... code that evaluates rval
 end function user_event_fun
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 with \ttt{user\_event\_fun} replaced by \ttt{\emph{name-string}}.
 
 \subsection{Observable}
 
 In \sindarin, an observable-type function is a function of one or two
 particle objects that returns a real value.  The particle objects
 result from scanning over subevents.  In the \sindarin\ code, the
 observable is used like a variable; the particle-object arguments are
 implictly assigned.
 
 A user-defined observable is used analogously, e.g.,
 \begin{quote}
 \begin{footnotesize}
   \ttt{cuts = all user\_obs (\emph{name-string}) > 0 [\emph{subevent}]}
 \end{footnotesize}
 \end{quote}
 The user observable is defined, as Fortran code, as either a unary or
 as a binary C-double-valued function of \ttt{c\_prt\_t} objects.  The
 use in \sindarin\ (unary or binary) must match the definition.
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 function user_obs_unary (prt1) result (rval) bind(C)
   use iso_c_binding
   use c_particles
   type(c_prt_t), intent(in) :: prt1
   real(c_double) :: rval
   ! ... code that evaluates rval
 end function user_obs_unary
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 or
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 function user_obs_binary (prt1, prt2) result (rval) bind(C)
   use iso_c_binding
   use c_particles
   type(c_prt_t), intent(in) :: prt1, prt2
   real(c_double) :: rval
   ! ... code that evaluates rval
 end function user_obs_binary
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 with \ttt{user\_obs\_unary}/\ttt{binary} replaced by
 \ttt{\emph{name-string}}.
 
 \subsection{Examples}
 
 For an example, we implement three different ways of computing the
 transverse momentum of a particle.  This observable is actually
 built into \whizard, so the examples are not particularly useful.  However,
 implementing kinematical functions that are not supported (yet) by
 \whizard\ (and not easily computed via \sindarin\ expressions)
 proceeds along the same lines.
 
 \subsubsection{Cut}
 The first function is a complete cut which can be used as
 \begin{quote}
   \begin{footnotesize}
     \ttt{cuts = user\_cut("ptcut") [\emph{subevt}]}
   \end{footnotesize}
 \end{quote}
 It is equivalent to
 \begin{quote}
   \begin{footnotesize}
     \ttt{cuts = all Pt $>$ 50 [\emph{subevt}]}
   \end{footnotesize}
 \end{quote}
 The implementation reads
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 function ptcut (prt, n_prt) result (iflag) bind(C)
   use iso_c_binding
   use c_particles
   use lorentz
   type(c_prt_t), dimension(*), intent(in) :: prt
   integer(c_int), intent(in) :: n_prt
   integer(c_int) :: iflag
   logical, save :: first = .true.
   if (all (transverse_part (vector4_from_c_prt (prt(1:n_prt))) > 50)) then
      iflag = 1
   else
      iflag = 0
   end if
 end function ptcut
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 The procedure makes use of the kinematical functions in the
 \ttt{lorentz} module, after transforming the particles into a
 \ttt{vector4} array.
 
 \subsubsection{Event Shape}
 Similar functionality can be achieved by implementing an event-shape
 function.  The function computes the minimum $p_T$ among all particles
 in the subevent.  The \sindarin\ expression reads
 \begin{quote}
   \begin{footnotesize}
     \ttt{cuts = user\_event\_shape("pt\_min") [\emph{subevt}] $>$ 50}
   \end{footnotesize}
 \end{quote}
 and the function is coded as
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 function pt_min (prt, n_prt) result (rval) bind(C)
   use iso_c_binding
   use c_particles
   use lorentz
   type(c_prt_t), dimension(*), intent(in) :: prt
   integer(c_int), intent(in) :: n_prt
   real(c_double) :: rval
   rval = minval (transverse_part (vector4_from_c_prt (prt(1:n_prt))))
 end function pt_min
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 
 \subsubsection{Observable}
 The third (and probably simplest) user implementation of the $p_T$ cut
 computes a single-particle observable.  Here, the usage is
 \begin{quote}
   \begin{footnotesize}
     \ttt{cuts = all user\_obs("ptval") $>$ 50 [\emph{subevt}]}
   \end{footnotesize}
 \end{quote}
 and the subroutine reads
 \begin{quote}
 \begin{footnotesize}
 \begin{verbatim}
 function ptval (prt1) result (rval) bind(C)
   use iso_c_binding
   use c_particles
   use lorentz
   type(c_prt_t), intent(in) :: prt1
   real(c_double) :: rval
   rval = transverse_part (vector4_from_c_prt (prt1))
 end function ptval
 \end{verbatim}
 \end{footnotesize}
 \end{quote}
 
 \section{User Code and Static Executables}
 
 In Sec.~\ref{sec:static} we describe how to build a static executable that can
 be submitted to batch jobs, e.g., on the grid, where a compiler may not be
 available.
 
 If there is user plug-in code, it would require the same setup of
 libtool, compiler and linker on the target host, as physical process
 code.  To avoid this, it is preferable to link the user code
 statically with the executable, which is then run as a monolithic
 program.
 
 This is actually simple.  Two conditions have to be met:
 \begin{enumerate}
 \item
   The \whizard\ job that creates the executable has to be given the appropriate
   options (\ttt{-u}, \ttt{--user-src}, \ttt{--user-lib}) such that
   the user code is dynamically compiled and linked.
 \item
   The compile command in the \sindarin\ script which creates the
   executable takes options that list the procedures which the
   stand-alone program should access:
   \begin{quote}
     \begin{footnotesize}
 \ttt{%
 compile as "\emph{executable-name}" \{ \\
 \hspace*{2em}  \$user\_procs\_cut          = "\emph{cut-proc-names}"\\
 \hspace*{2em}  \$user\_procs\_event\_shape = "\emph{event-shape-proc-names}"\\
 \hspace*{2em}  \$user\_procs\_obs1         = "\emph{obs1-proc-names}"\\
 \hspace*{2em}  \$user\_procs\_obs2         = "\emph{obs2-proc-names}"\\
 \hspace*{2em}  \$user\_procs\_sf           = "\emph{strfun-names}"\\
 \}}
     \end{footnotesize}
   \end{quote}
   The values of these option variables are comma-separated lists of procedure
   names, grouped by their nature.  \ttt{obs1} and \ttt{obs2} refer to unary
   and binary observables, respectively.  The \ttt{strfun-names} are
   the names of the user-defined spectra or structure functions as they
   would appear in the \sindarin\ file which uses them.
 \end{enumerate}
 With these conditions met, the stand-alone executable will have the
 user code statically linked, and it will be able to use exactly those
 user-defined routines that have been listed in the various option
 strings.  (It is possible nevertheless, to plug in additional user code
 into the stand-alone executable, using the same options as for the
 original \whizard\ program.)
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Data Visualization}
 \label{chap:visualization}
 
 \section{GAMELAN}
 
 The data values and tables that we have introduced in the previous section can
 be visualized using built-in features of \whizard.  To be precise,
 \whizard\ can write \LaTeX\ code which incorporates code in the graphics
 language GAMELAN to produce a pretty-printed account of observables,
 histograms, and plots.
 
 GAMELAN is a macro package for MetaPost, which is part of the
 \TeX/\LaTeX\ family.  MetaPost, a derivative of Knuth's MetaFont language for
 font design, is usually bundled with the \TeX\ distribution, but might need a
 separate switch for installation.  The GAMELAN macros are contained in a
 subdirectory of the \whizard\ package.  Upon installation, they will be
 installed in the appropriate directory, including the \ttt{gamelan.sty} driver
 for \LaTeX.  \whizard\ uses a subset of GAMELAN's graphics macros
 directly, but it allows for access to the full package if desired.
 
 An (incomplete) manual for GAMELAN can be found in the \ttt{share/doc}
 subdirectory of the \whizard\ system.  \whizard\ itself uses a subset of the
 GAMELAN capabilities, interfaced by \sindarin\ commands and parameters.  They
 are described in this chapter.
 
 To process analysis output beyond writing tables to file, the
 \ttt{write\_analysis} command described in the previous section should be
 replaced by \ttt{compile\_analysis}, with the same syntax:
 \begin{quote}
   \begin{footnotesize}
     \ttt{compile\_analysis (\emph{analysis-tags}) \{ \ttt{\emph{options}} \}}
   \end{footnotesize}
 \end{quote}
 where \ttt{\emph{analysis-tags}}, a comma-separated list of analysis objects,
 is optional.  If there are no tags, all analysis objects are processed.  The
 \ttt{\emph{options}} script of local commands is also optional, of course.
 
 This command will perform the following actions:
 \begin{enumerate}
 \item
   It writes a data file in default format, as \ttt{write\_analysis} would do.
   The file name is given by \ttt{\$out\_file}, if nonempty.  The file must not
   be already open, since the command needs a self-contained file, but the name
   is otherwise arbitrary.  If the value of \ttt{\$out\_file} is empty, the
   default file name is \ttt{whizard\_analysis.dat}.
 \item
   It writes a driver file for the chosen datasets, whose name is derived from
   the data file by replacing the file extension of the data file with the
   extension \ttt{.tex}.  The driver file is a \LaTeX\ source file which
   contains embedded GAMELAN code that handles the selected graphics data.  In
   the \LaTeX\ document, there is a separate section for each contained
   dataset. Furthermore, a process-/analysis-specific makefile with the
   name \ttt{<process\_name>\_ana.makefile} is created that can be used
   to generate postscript or PDF output from the \LaTeX\ source. If the
   steering flag \ttt{?analysis\_file\_only} is set to \ttt{true}, then
   the \LaTeX\ file and the makefile are only written, but no execution
   of the makefile resulting in compilation of the \LaTeX\ code (see
   the next item) is invoked.
 \item
   As mentioned above, if the flag \ttt{?analysis\_file\_only} is set
   to \ttt{false} (which is the default), the driver file is processed
   by \LaTeX (invoked by calling the makefile with the name
   \ttt{<process\_name>\_ana.makefile}), which generates an appropriate
   GAMELAN source file with extension \ttt{.mp}.  This code is executed
   (calling GAMELAN/MetaPost, and again \LaTeX\ for typesetting embedded
   labels).  There is a second \LaTeX\ pass (automatically done by the
   makefile) which collects the results, and finally conversion to
   PostScript and PDF formats.
 \end{enumerate}
 
 The resulting PostScript or PDF file -- the file name is the name of the data
 file with the extension replaced by \ttt{.ps} or \ttt{.pdf}, respectively
 -- can be printed or viewed with an appropriate viewer such as \ttt{gv}.  The
 viewing command is not executed automatically by \whizard.
 
 Note that \LaTeX\ will write further files with extensions \ttt{.log},
 \ttt{.aux}, and \ttt{.dvi}, and GAMELAN will produce auxiliary files with
 extensions \ttt{.ltp} and \ttt{.mpx}. The log file in particular, could
 overwrite \whizard's log file if the basename is identical.  Be careful to use
 a value for \ttt{\$out\_file} which is not likely to cause name clashes.
 
 
 \subsection{User-specific changes}
 
 In the case, that the \sindarin\ \ttt{compile\_analysis} command is
 invoked and the flag named \ttt{?analysis\_file\_only} is not changed
 from its default value \ttt{false}, \whizard\ calls the
 process-/analysis-specific makefile triggering the compilation of the
 \LaTeX\ code and the GAMELAN plots and histograms. If the user wants
 to edit the analysis output, for example changing captions, headlines,
 labels, properties of the plots, graphs and histograms using GAMELAN
 specials etc., this is possible and the output can be regenerated
 using the makefile. The user can also directly invoke the GAMELAN
 script, \ttt{whizard-gml}, that is installed in the binary directly
 along with the \whizard\ binary and other scripts. Note however, that
 the \LaTeX\ environment for the specific style files have to be set by
 hand (the command line invocation in the makefile does this
 automatically). Those style files are generally written into
 \ttt{share/texmf/whizard/} directory. The user can execute the
 commands in the same way as denoted in the process-/analysis-specific
 makefile by hand.
 
 
 %%%%%
 
 \section{Histogram Display}
 
 
 %%%%%
 
 \section{Plot Display}
 
 
 \section{Graphs}
 \label{sec:graphs}
 
 Graphs are an additional type of analysis object.  In contrast to histograms
 and plots, they do not collect data directly, but they rather act as
 containers for graph elements, which are copies of existing histograms and
 plots.  Their single purpose is to be displayed by the GAMELAN driver.
 
 Graphs are declared by simple assignments such as
 \begin{quote}
   \begin{footnotesize}
     \ttt{graph g1 = hist1}
 \\
     \ttt{graph g2 = hist2 \& hist3 \& plot1}
   \end{footnotesize}
 \end{quote}
 The first declaration copies a single histogram into the graph, the second one
 copies two histograms and a plot.  The syntax for collecting analysis objects
 uses the \ttt{\&} concatenation operator, analogous to string concatenation.
 In the assignment, the rhs must contain only histograms and plots.  Further
 concatenating previously declared graphs is not supported.
 
 After the graph has been declared, its contents can be written to file
 (\ttt{write\_analysis}) or, usually, compiledd by the \LaTeX/GAMELAN driver
 via the \ttt{compile\_analysis} command.
 
 The graph elements on the right-hand side of the graph assignment are copied
 with their current data content.  This implies a well-defined order of
 statements: first, histograms and plots are declared, then they are filled via
 \ttt{record} commands or functions, and finally they can be collected for
 display by graph declarations.
 
 A simple graph declaration without options as above is possible, but usually
 there are option which affect the graph display.  There are two kinds of
 options: graph options and drawing options.  Graph options apply to the graph
 as a whole (title, labels, etc.) and are placed in braces on the lhs of the
 assigment.  Drawing options apply to the individual graph elements
 representing the contained histograms and plots, and are placed together with
 the graph element on the rhs of the assignment.  Thus, the complete syntax for
 assigning multiple graph elements is
 \begin{quote}
   \begin{footnotesize}
     \ttt{graph \emph{graph-tag} \{ \emph{graph-options} \}}
 \\
     \ttt{= \emph{graph-element-tag1} \{ \emph{drawing-options1} \}}
 \\
     \ttt{\& \emph{graph-element-tag2} \{ \emph{drawing-options2} \}}
 \\
      \ldots
   \end{footnotesize}
 \end{quote}
 This form is recommended, but graph and drawing options can also be set as
 global parameters, as usual.
 
 We list the supported graph and drawing options in
 Tables~\ref{tab:graph-options} and \ref{tab:drawing-options}, respectively.
 
 \begin{table}
   \caption{Graph options.  The content of strings of type \LaTeX\ must be
     valid \LaTeX\ code (containing typesetting commands such as math mode).
     The content of strings of type GAMELAN must be valid GAMELAN code.
     If a graph bound is kept \emph{undefined}, the actual graph bound is
     determined such as not to crop the graph contents in the selected
     direction.}
   \label{tab:graph-options}
 
   \begin{center}
     \begin{tabular}{|l|l|l|l|}
       \hline
       Variable & Default & Type & Meaning
       \\
       \hline\hline
       \ttt{\$title}  & \ttt{""} & \LaTeX &
         Title of the graph = subsection headline
       \\
       \hline
       \ttt{\$description}  & \ttt{""} &  \LaTeX &
         Description text for the graph
       \\
       \hline
       \ttt{\$x\_label} & \ttt{""} & \LaTeX &
         $x$-axis label
       \\
       \hline
       \ttt{\$y\_label} & \ttt{""} & \LaTeX &
         $y$-axis label
       \\
       \hline
       \ttt{graph\_width\_mm} & 130 & Integer &
         graph width (on paper) in mm
       \\
       \hline
       \ttt{graph\_height\_mm} & 90 & Integer &
         graph height (on paper) in mm
       \\
       \hline
       \ttt{?x\_log} & false & Logical &
         Whether the $x$-axis scale is linear or logarithmic
       \\
       \hline
       \ttt{?y\_log} & false & Logical &
         Whether the $y$-axis scale is linear or logarithmic
       \\
       \hline
       \ttt{x\_min} & \emph{undefined} & Real &
         Lower bound for the $x$ axis
       \\
       \hline
       \ttt{x\_max} & \emph{undefined} & Real &
         Upper bound for the $x$ axis
       \\
       \hline
       \ttt{y\_min} & \emph{undefined} & Real &
         Lower bound for the $y$ axis
       \\
       \hline
       \ttt{y\_max} & \emph{undefined} & Real &
         Upper bound for the $y$ axis
       \\
       \hline
       \ttt{gmlcode\_bg} & \ttt{""} & GAMELAN &
          Code to be executed before drawing
       \\
       \hline
       \ttt{gmlcode\_fg} & \ttt{""} & GAMELAN &
          Code to be executed after drawing
       \\
       \hline
     \end{tabular}
   \end{center}
 \end{table}
 
 \begin{table}
   \caption{Drawing options.  The content of strings of type GAMELAN must be
     valid GAMELAN code.  The behavior w.r.t. the flags with \emph{undefined}
     default value depends on the type of graph element.  Histograms: draw
     baseline, piecewise, fill area, draw curve, no errors, no symbols;  Plots:
     no baseline, no fill, draw curve, no errors, no symbols.}
   \label{tab:drawing-options}
 
   \begin{center}
     \begin{tabular}{|l|l|l|l|}
       \hline
       Variable & Default & Type & Meaning
       \\
       \hline\hline
       \ttt{?draw\_base}  & \emph{undefined} & Logical &
         Whether to draw a baseline for the curve
       \\
       \hline
       \ttt{?draw\_piecewise}  & \emph{undefined} & Logical &
         Whether to draw bins separately (histogram)
       \\
       \hline
       \ttt{?fill\_curve}  & \emph{undefined} & Logical &
         Whether to fill area between baseline and curve
       \\
       \hline
       \ttt{\$fill\_options} & \ttt{""} & GAMELAN &
         Options for filling the area
       \\
       \hline
       \ttt{?draw\_curve} & \emph{undefined} & Logical &
         Whether to draw the curve as a line
       \\
       \hline
       \ttt{\$draw\_options} & \ttt{""} & GAMELAN &
         Options for drawing the line
       \\
       \hline
       \ttt{?draw\_errors} & \emph{undefined} & Logical &
         Whether to draw error bars for data points
       \\
       \hline
       \ttt{\$err\_options} & \ttt{""} & GAMELAN &
         Options for drawing the error bars
       \\
       \hline
       \ttt{?draw\_symbols} & \emph{undefined} & Logical &
         Whether to draw symbols at data points
       \\
       \hline
       \ttt{\$symbol} & Black dot & GAMELAN &
         Symbol to be drawn
       \\
       \hline
       \ttt{gmlcode\_bg} & \ttt{""} & GAMELAN &
          Code to be executed before drawing
       \\
       \hline
       \ttt{gmlcode\_fg} & \ttt{""} & GAMELAN &
          Code to be executed after drawing
       \\
       \hline
     \end{tabular}
   \end{center}
 \end{table}
 
 
 \section{Drawing options}
 
 The options for coloring lines, filling curves, or choosing line styles make
 use of macros in the GAMELAN language.  At this place, we do not intend to
 give a full account of the possiblities, but we rather list a few basic
 features that are likely to be useful for drawing graphs.
 
 
 \subsubsection{Colors}
 
 GAMELAN knows about basic colors identified by name:
 \begin{center}
   \ttt{black}, \ttt{white}, \ttt{red}, \ttt{green}, \ttt{blue}, \ttt{cyan},
   \ttt{magenta}, \ttt{yellow}
 \end{center}
 More generically, colors in GAMELAN are RGB triplets of numbers (actually,
 numeric expressions) with values between 0 and 1, enclosed in brackets:
 \begin{center}
   \ttt{(\emph{r}, \emph{g}, \emph{b})}
 \end{center}
 
 To draw an object in color, one should apply the construct \ttt{withcolor
   \emph{color}} to its drawing code.  The default color is always black.
 Thus, this will make a plot drawn in blue:
 \begin{quote}
   \begin{footnotesize}
     \ttt{\$draw\_options = "withcolor blue"}
   \end{footnotesize}
 \end{quote}
 and this will fill the drawing area of some histogram with an RGB color:
 \begin{quote}
   \begin{footnotesize}
     \ttt{\$fill\_options = "withcolor (0.8, 0.7, 1)"}
   \end{footnotesize}
 \end{quote}
 
 
 \subsubsection{Dashes}
 
 By default, lines are drawn continuously.  Optionally, they can be drawn using
 a \emph{dash pattern}.  Predefined dash patterns are
 \begin{center}
   \ttt{evenly}, \ttt{withdots}, \ttt{withdashdots}
 \end{center}
 Going beyond the predefined patterns, a generic dash pattern has the syntax
 \begin{center}
   \ttt{dashpattern (on \emph{l1} off \emph{l2} on} \ldots \ttt{)}
 \end{center}
 with an arbitrary repetition of \ttt{on} and \ttt{off} clauses.  The numbers
 \ttt{\emph{l1}}, \ttt{\emph{l2}}, \ldots\ are lengths measured in pt.
 
 To apply a dash pattern, the option syntax \ttt{dashed \emph{dash-pattern}}
 should be used.  Options strings can be concatenated.  Here is how to draw in
 color with dashes:
 \begin{quote}
   \begin{footnotesize}
     \ttt{\$draw\_options = "withcolor red dashed evenly"}
   \end{footnotesize}
 \end{quote}
 and this draws error bars consisting of intermittent dashes and
 dots:
 \begin{quote}
   \begin{footnotesize}
     \ttt{\$err\_options = "dashed (withdashdots scaled 0.5)"}
   \end{footnotesize}
 \end{quote}
 The extra brackets ensure that the scale factor $1/2$ is applied only the dash
 pattern.
 
 
 \subsubsection{Hatching}
 
 Areas (e.g., below a histogram) can be filled with plain colors by the
 \ttt{withcolor} option.  They can also be hatched by stripes, optionally
 rotated by some angle.  The syntax is completely analogous to dashes.  There
 are two predefined \emph{hatch patterns}:
 \begin{center}
    \ttt{withstripes}, \ttt{withlines}
 \end{center}
 and a generic hatch pattern is written
 \begin{center}
   \ttt{hatchpattern (on \emph{w1} off \emph{w2} on} \ldots \ttt{)}
 \end{center}
 where the numbers \ttt{\emph{l1}}, \ttt{\emph{l2}}, \ldots\ determine the
 widths of the stripes, measured in pt.
 
 When applying a hatch pattern, the pattern may be rotated by some angle (in
 degrees) and scaled.  This looks like
 \begin{quote}
   \begin{footnotesize}
     \ttt{\$fill\_options = "hatched (withstripes scaled 0.8 rotated 60)"}
   \end{footnotesize}
 \end{quote}
 
 
 \subsubsection{Smooth curves}
 
 Plot points are normally connected by straight lines.  If data are acquired by
 statistical methods, such as Monte Carlo integration, this is usually
 recommended.  However, if a plot is generated using an analytic mathematical
 formula, or with sufficient statistics to remove fluctuations, it might be
 appealing to connect lines by some smooth interpolation.  GAMELAN can switch
 on spline interpolation by the specific drawing option \ttt{linked smoothly}.
 Note that the results can be surprising if the data points do have sizable
 fluctuations or sharp kinks.
 
 
 \subsubsection{Error bars}
 
 Plots and histograms can be drawn with error bars.  For histograms, only
 vertical error bars are supported, while plot points can have error bars in
 $x$ and $y$ direction.  Error bars are switched on by the \ttt{?draw\_errors}
 flag.
 
 There is an option to draw error bars with ticks: \ttt{withticks} and an
 alternative option to draw arrow heads: \ttt{witharrows}.  These can be used
 in the \ttt{\$err\_options} string.
 
 
 \subsubsection{Symbols}
 
 To draw symbols at plot points (or histogram midpoints), the flag
 \ttt{?draw\_symbols} has to be switched on.
 
 
 
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{User Interfaces for WHIZARD}
 \label{chap:userint}
 
 \section{Command Line and \sindarin\ Input Files}
 \label{sec:cmdline-options}
 
 The standard way of using \whizard\ involves a command script written
 in \sindarin.  This script is executed by \whizard\ by mentioning it
 on the command line:
 \begin{interaction}
   whizard script-name.sin
 \end{interaction}
 You may specify several script files on the command line; they will be
 executed consecutively.
 
 If there is no script file, \whizard\ will read commands from standard
 input.  Hence, this is equivalent:
 \begin{interaction}
   cat script-name.sin | whizard
 \end{interaction}
 
 When executed from the command line, \whizard\ accepts several options.
 They are given in long form, i.e., they begin with two dashes.  Values
 that belong to options follow the option string, separated either by
 whitespace or by an equals sign.  Hence, \ttt{--prefix /usr} and
 \ttt{--prefix=/usr} are equivalent.  Some options are also available
 in short form, a single dash with a single letter.  Short-form options
 can be concatenated, i.e., a dash followed by several option letters.
 
 The first set of options is intended for normal operation.
 \begin{description}
 \item[\ttt{--debug AREA}]: Switch on debug output for \ttt{AREA}.
   \ttt{AREA} can be one of \whizard's source directories or \ttt{all}.
 \item[\ttt{--debug2 AREA}]: Switch on more verbose debug output for \ttt{AREA}.
 \item[\ttt{--single-event}]: Only compute one phase-space point (for debugging).
 \item[\ttt{--execute COMMANDS}]:  Execute \ttt{COMMANDS} as a script
   before the script file.  Short version: \ttt{-e}
 \item[\ttt{--help}]:  List the available options and exit.  Short version:
   \ttt{-h}
 \item[\ttt{--interactive}]:  Run \whizard\ interactively.  See
   Sec.~\ref{sec:whish}.  Short version: \ttt{-i}.
 \item[\ttt{--library LIB}]:  Preload process library \ttt{LIB}
   (instead of the default \ttt{processes}).  Short version: \ttt{-l}.
 \item[\ttt{--localprefix DIR}]:  Search in \ttt{DIR} for local
   models.  Default is \ttt{\$HOME/.whizard}.
 \item[\ttt{--logfile \ttt{FILE}}]: Write log to \ttt{FILE}.  Default is
   \ttt{whizard.log}.  Short version: \ttt{-L}.
 \item[\ttt{--logging}]: Start logging on startup (default).
 \item[\ttt{--model MODEL}]: Preload model \ttt{MODEL}.  Default is the
   Standard Model \ttt{SM}.  Short version: \ttt{-m}.
 \item[\ttt{--no-banner}]: Do not display banner at startup.
 \item[\ttt{--no-library}]: Do not preload a library.
 \item[\ttt{--no-logfile}]: Do not write a logfile.
 \item[\ttt{--no-logging}]: Do not issue information into the logfile.
 \item[\ttt{--no-model}]: Do not preload a specific physics model.
 \item[\ttt{--no-rebuild}]: Do not force a rebuild.
 \item[\ttt{--query VARIABLE}]: Display documentation of \ttt{VARIABLE}.
   Short version: \ttt{-q}.
 \item[\ttt{--rebuild}]: Do not preload a process library and do all
   calculations from scratch, even if results exist.  This combines all
   rebuild options.  Short version: \ttt{-r}.
 \item[\ttt{--rebuild-library}]: Rebuild the process library, even if code
   exists.
 \item[\ttt{--rebuild-phase-space}]: Rebuild the phase space setup, even if
   it exists.
 \item[\ttt{--rebuild-grids}]: Redo the integration, even if previous grids
   and results exist.
 \item[\ttt{--rebuild-events}]: Redo event generation, discarding previous
   event files.
 \item[\ttt{--show-config}]: Show build-time configuration.
 \item[\ttt{--version}]: Print version information and exit.  Short version:
   \ttt{-V}.
 \item[-]: Any further options are interpreted as file names.
 \end{description}
 The second set of options refers to the configuration.  They are
 relevant when dealing with a relocated \whizard\ installation, e.g.,
 on a batch systems.
 \begin{description}
 \item[\ttt{--prefix DIR}]: Specify the actual location of the \whizard\
   installation, including all subdirectories.
 \item[\ttt{--exec-prefix DIR}]:  Specify the actual location of the
   machine-specific parts of the \whizard\ installation (rarely needed).
 \item[\ttt{--bindir DIR}]:  Specify the actual location of the
   executables contained in the \whizard\ installation (rarely needed).
 \item[\ttt{--libdir DIR}]:  Specify the actual location of the
   libraries contained in the \whizard\ installation (rarely needed).
 \item[\ttt{--includedir DIR}]:  Specify the actual location of the
   include files contained in the \whizard\ installation (rarely needed).
 \item[\ttt{--datarootdir DIR}]:  Specify the actual location of the
   data files contained in the \whizard\ installation (rarely needed).
 \item[\ttt{--libtool LOCAL\_LIBTOOL}]:  Specify the actual location and
   name of the \ttt{libtool} script that should be used by \whizard.
 \item[\ttt{--lhapdfdir DIR}]:  Specify the actual location and
   of the \lhapdf\ installation that should be used by \whizard.
 \end{description}
 
 
 
 \section{WHISH -- The \whizard\ Shell/Interactive mode}
 \label{sec:whish}
 
 \whizard\ can be also run in the interactive mode using its own shell
 environment. This is called the \whizard\ Shell (WHISH). For this
 purpose, one starts with the command
 \begin{interaction}
   /home/user$ whizard --interactive
 \end{interaction}
 or
 \begin{interaction}
   /home/user$ whizard -i
 \end{interaction}
 \whizard\ will preload the Standard Model and display a command
 prompt:
 \begin{interaction}
   whish?
 \end{interaction}
 You now can enter one or more \sindarin\ commands, just as if they
 were contained in a script file.  The commands are compiled and
 executed after you hit the ENTER key.  When done, you get a new
 prompt.  The WHISH can be closed by the \ttt{quit} command:
 \begin{verbatim}
   whish? quit
 \end{verbatim}
 Obviously, each input must be self-contained: commands must be
 complete, and conditionals or scans must be closed on the same line.
 
 If \whizard\ is run without options and without a script file, it
 also reads commands interactively, from standard input.  The
 difference is that in this case, interactive input is multi-line,
 terminated by \ttt{Ctrl-D}, the script is then compiled and
 executed as a whole, and \whizard\ terminates.
 
 In WHISH mode, each input line is compiled and executed individually.
 Furthermore, fatal errors are masked, so in case of error the program
 does not terminate but returns to the WHISH command line.  (The
 attempt to recover may fail in some circumstances, however.)
 
 
 \section{Graphical user interface}
 
 \emph{This is still experimental.}
 
 \whizard\ ships with a graphical interface that can be steered in a
 browser of your choice. It is located in \ttt{share/gui}.  To use it,
 you have to run \ttt{npm install} (which will install javascript
 libraries locally in that folder) and \ttt{npm start} (which will start
 a local web server on your machine) in that folder.  More technical
 details and how to get \ttt{npm} is discussed in
 \ttt{share/gui/README.md}.  When it is running, you can access the GUI
 by entering \ttt{localhost:3000} as address in your browser.  The GUI is
 separated into different tabs for basic settings, integration,
 simulation, cuts, scans, NLO and beams.  You can select and enter what
 you are interested in and the GUI will produce a \sindarin\ file.  You
 can use the GUI to run WHIZARD with that \sindarin\ or just produce it
 with the GUI and then tweak it further with an editor.  In case you run
 it in the GUI, the log file will be updated in the browser as it is
 produced.  Any \sindarin\ features that are not supported by the GUI can
 be added directly as "Additional Code".
 
 \section{WHIZARD as a library}
 
 \emph{This is planned, but not implemented yet.}
 %%%%%
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{Examples}
 \label{chap:examples}
 
 In this chapter we discuss the running and steering of \whizard\ with
 the help of several examples. These examples can be found in the
 \ttt{share/examples} directory of your installation. All of these
 examples are also shown on the \whizard\ Wiki page:
 \url{https://whizard.hepforge.org/trac/wiki}.
 
 
 \section{$Z$ lineshape at LEP I}
 
 By this example, we demonstrate how a scan over collision energies
 works, using as example the measurement of the $Z$ lineshape at LEP I
 in 1989. The \sindarin\ script for this example, \ttt{Z-lineshape.sin}
 can be found in the \ttt{share/examples} folder of the \whizard\
 installation.
 
 We first use the Standard model as physics model:
 \begin{code}
 model = SM
 \end{code}
 Aliases for electron, muon and their antiparticles as leptons and
 those including the photon as particles in general are introduced:
 \begin{code}
 alias lep = e1:E1:e2:E2
 alias prt = lep:A
 \end{code}
 Next, the two processes are defined, \eemm, and the same with an
 explicit QED photon: $e^+e^- \to \mu^+\mu^-\gamma$,
 \begin{code}
 process bornproc = e1, E1 => e2, E2
 process rc = e1, E1 => e2, E2, A
 compile
 \end{code}
 and the processes are compiled. Now, we define some very loose cuts to
 avoid singular regions in phase space, name an infrared cutoff of 100
 MeV for all particles, a cut on the angular separation from the beam
 axis and a di-particle invariant mass cut which regularizes collinear
 singularities:
 \begin{code}
 cuts = all E >= 100 MeV [prt]
    and all abs (cos(Theta)) <= 0.99 [prt]
    and all M2 >= (1 GeV)^2 [prt, prt]
 \end{code}
 For the graphical analysis, we give a description and labels for the
 $x$- and $y$-axis in \LaTeX\ syntax:
 \begin{code}
 $description = "A WHIZARD Example"
 $x_label = "$\sqrt{s}$/GeV"
 $y_label = "$\sigma(s)$/pb"
 \end{code}
 We define two plots for the lineshape of the \eemm\ process between 88
 and 95 GeV,
 \begin{code}
 $title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-$"
 plot lineshape_born { x_min = 88 GeV  x_max = 95 GeV }
 \end{code}
 and the same for the radiative process with an additional photon:
 \begin{code}
 $title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-\gamma$"
 plot lineshape_rc { x_min = 88 GeV  x_max = 95 GeV }
 \end{code}
 %$
 The next part of the \sindarin\ file actually performs the scan:
 \begin{code}
 scan sqrts = ((88.0 GeV => 90.0 GeV /+ 0.5 GeV),
               (90.1 GeV => 91.9 GeV /+ 0.1 GeV),
               (92.0 GeV => 95.0 GeV /+ 0.5 GeV)) {
   beams = e1, E1
   integrate (bornproc) { iterations = 2:1000:"gw", 1:2000 }
   record lineshape_born (sqrts, integral (bornproc) / 1000)
   integrate (rc)   { iterations = 5:3000:"gw", 2:5000 }
   record lineshape_rc (sqrts, integral (rc) / 1000)
 }
 \end{code}
 So from 88 to 90 GeV, we go in 0.5 GeV steps, then from 90 to 92 GeV
 in tenth of GeV, and then up to 95 GeV again in half a GeV steps. The
 partonic beam definition is redundant. Then, the born process is
 integrated, using a certain specification of calls with adaptation of
 grids and weights, as well as a final pass. The lineshape of the Born
 process is defined as a \ttt{record} statement, generating tuples of
 $\sqrt{s}$ and the Born cross section (converted from femtobarn to
 picobarn). The same happens for the radiative $2\to3$ process with a
 bit more iterations because of the complexity, and the definition of
 the corresponding lineshape record.
 
 If you run the \sindarin\ script, you will find an output like:
 \begin{scriptsize}
 \begin{Verbatim}[frame=single]
            | Process library 'default_lib': loading
            | Process library 'default_lib': ... success.
            $description = "A WHIZARD Example"
            $x_label = "$\sqrt{s}$/GeV"
            $y_label = "$\sigma(s)$/pb"
            $title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-$"
            x_min =  8.800000000000E+01
            x_max =  9.500000000000E+01
            $title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-\gamma$"
            x_min =  8.800000000000E+01
            x_max =  9.500000000000E+01
            sqrts =  8.800000000000E+01
            | RNG: Initializing TAO random-number generator
            | RNG: Setting seed for random-number generator to 10713
            | Initializing integration for process bornproc:
            | ------------------------------------------------------------------------
            | Process [scattering]: 'bornproc'
            |   Library name  = 'default_lib'
            |   Process index = 1
            |   Process components:
            |     1: 'bornproc_i1':   e-, e+ => mu-, mu+ [omega]
            | ------------------------------------------------------------------------
            | Beam structure: e-, e+
            | Beam data (collision):
            |   e-  (mass = 5.1099700E-04 GeV)
            |   e+  (mass = 5.1099700E-04 GeV)
            |   sqrts = 8.800000000000E+01 GeV
            | Phase space: generating configuration ...
            | Phase space: ... success.
            | Phase space: writing configuration file 'bornproc_i1.phs'
            | 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
            | Applying user-defined cuts.
            | OpenMP: Using 8 threads
            | Starting integration for process 'bornproc'
            | Integrate: iterations = 2:1000:"gw", 1:2000
            | Integrator: 1 chains, 1 channels, 2 dimensions
            | Integrator: Using VAMP channel equivalences
            | Integrator: 1000 initial calls, 20 bins, stratified = T
            | Integrator: VAMP
            |=============================================================================|
            | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
            |=============================================================================|
               1        800  2.5881432E+05  1.85E+03    0.72    0.20*  48.97
               2        800  2.6368495E+05  9.25E+02    0.35    0.10*  28.32
            |-----------------------------------------------------------------------------|
               2       1600  2.6271122E+05  8.28E+02    0.32    0.13   28.32    5.54   2
            |-----------------------------------------------------------------------------|
               3       1988  2.6313791E+05  5.38E+02    0.20    0.09*  35.09
            |-----------------------------------------------------------------------------|
               3       1988  2.6313791E+05  5.38E+02    0.20    0.09   35.09
            |=============================================================================|
            | Time estimate for generating 10000 events: 0d:00h:00m:05s
            [.......]
 \end{Verbatim}
 \end{scriptsize} %$
 and then the integrations for the other energy points of the scan will
 \begin{figure}
   \centering
   \includegraphics[width=.47\textwidth]{Z-lineshape_1}
   \includegraphics[width=.47\textwidth]{Z-lineshape_2}
 \caption{\label{fig:zlineshape} $Z$ lineshape in the dimuon final
   state (left), and with an additional photon (right)}
 \end{figure}
 follow, and finally the same is done for the radiative process as
 well. At the end of the \sindarin\ script we compile the graphical
 \whizard\ analysis and direct the data for the plots into the file
 \ttt{Z-lineshape.dat}:
 \begin{code}
 compile_analysis { $out_file = "Z-lineshape.dat" }
 \end{code}
 %$
 In this case there is no event generation, but simply the cross
 section values for the scan are dumped into a data file:
 \begin{scriptsize}
 \begin{Verbatim}[frame=single]
            $out_file = "Z-lineshape.dat"
            | Opening file 'Z-lineshape.dat' for output
            | Writing analysis data to file 'Z-lineshape.dat'
            | Closing file 'Z-lineshape.dat' for output
            | Compiling analysis results display in 'Z-lineshape.tex'
 \end{Verbatim}
 \end{scriptsize}
 %$
 Fig.~\ref{fig:zlineshape} shows the graphical \whizard\ output of the
 $Z$ lineshape in the dimuon final state from the scan on the left, and
 the same for the radiative process with an additional photon on the
 right.
 
 %%%%%%%%%%%%%%%
 
 \section{$W$ pairs at LEP II}
 
 This example which can be found as file \ttt{LEP\_cc10.sin} in the
 \ttt{share/examples} directory, shows $W$ pair production in the
 semileptonic mode at LEP II with its final energy of 209 GeV. Because
 there are ten contributing Feynman diagrams, the process has been
 dubbed CC10: charged current process with 10 diagrams. We work within
 the Standard Model:
 \begin{code}
   model = SM
 \end{code}
 Then the process is defined, where no flavor summation is done for the
 jets here:
 \begin{code}
   process cc10 = e1, E1 => e2, N2, u, D
 \end{code}
 A compilation statement is optional, and then we set the muon mass to
 zero:
 \begin{code}
   mmu = 0
 \end{code}
 The final LEP center-of-momentum energy of 209 GeV is set:
 \begin{code}
   sqrts = 209 GeV
 \end{code}
 Then, we integrate the process:
 \begin{code}
   integrate (cc10) { iterations = 12:20000 }
 \end{code}
 Running the \sindarin\ file up to here, results in the output:
 \begin{scriptsize}
 \begin{Verbatim}[frame=single]
           | Process library 'default_lib': loading
           | Process library 'default_lib': ... success.
           SM.mmu =  0.000000000000E+00
           sqrts =  2.090000000000E+02
           | RNG: Initializing TAO random-number generator
           | RNG: Setting seed for random-number generator to 31255
           | Initializing integration for process cc10:
           | ------------------------------------------------------------------------
           | Process [scattering]: 'cc10'
           |   Library name  = 'default_lib'
           |   Process index = 1
           |   Process components:
           |     1: 'cc10_i1':   e-, e+ => mu-, numubar, u, dbar [omega]
           | ------------------------------------------------------------------------
           | Beam structure: [any particles]
           | Beam data (collision):
           |   e-  (mass = 5.1099700E-04 GeV)
           |   e+  (mass = 5.1099700E-04 GeV)
           |   sqrts = 2.090000000000E+02 GeV
           | Phase space: generating configuration ...
           | Phase space: ... success.
           | Phase space: writing configuration file 'cc10_i1.phs'
           | Phase space: 25 channels, 8 dimensions
           | Phase space: found 25 channels, collected in 7 groves.
           | Phase space: Using 25 equivalences between channels.
           | Phase space: wood
           Warning: No cuts have been defined.
           | OpenMP: Using 8 threads
           | Starting integration for process 'cc10'
           | Integrate: iterations = 12:20000
           | Integrator: 7 chains, 25 channels, 8 dimensions
           | Integrator: Using VAMP channel equivalences
           | Integrator: 20000 initial calls, 20 bins, stratified = T
           | Integrator: VAMP
           |=============================================================================|
           | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
           |=============================================================================|
              1      19975  6.4714908E+02  2.17E+01    3.36    4.75*   2.33
              2      19975  7.3251876E+02  2.45E+01    3.34    4.72*   2.17
              3      19975  6.7746497E+02  2.39E+01    3.52    4.98    1.77
              4      19975  7.2075198E+02  2.41E+01    3.34    4.72*   1.76
              5      19975  6.5976152E+02  2.26E+01    3.43    4.84    1.46
              6      19975  6.6633310E+02  2.26E+01    3.39    4.79*   1.43
              7      19975  6.7539385E+02  2.29E+01    3.40    4.80    1.43
              8      19975  6.6754027E+02  2.11E+01    3.15    4.46*   1.41
              9      19975  7.3975817E+02  2.52E+01    3.40    4.81    1.53
             10      19975  7.2284275E+02  2.39E+01    3.31    4.68*   1.47
             11      19975  6.5476917E+02  2.18E+01    3.33    4.71    1.33
             12      19975  7.2963866E+02  2.54E+01    3.48    4.92    1.46
           |-----------------------------------------------------------------------------|
             12     239700  6.8779583E+02  6.69E+00    0.97    4.76    1.46    2.18  12
           |=============================================================================|
           | Time estimate for generating 10000 events: 0d:00h:01m:16s
           | Creating integration history display cc10-history.ps and cc10-history.pdf
 \end{Verbatim}
 \end{scriptsize}
 \begin{figure}
   \centering
   \includegraphics[width=.6\textwidth]{cc10_1}
   \\\vspace{5mm}
   \includegraphics[width=.6\textwidth]{cc10_2}
   \caption{Histogram of the dijet invariant mass from the CC10 $W$
     pair production at LEP II, peaking around the $W$ mass (upper
     plot), and of the muon energy (lower plot).}
   \label{fig:cc10}
 \end{figure}
 The next step is event generation. In order to get smooth
 distributions, we set the integrated luminosity to 10
 fb${}^{-1}$. (Note that LEP II in its final year 2000 had an
 integrated luminosity of roughly 0.2 fb${}^{-1}$.)
 \begin{code}
   luminosity = 10
 \end{code}
 With the simulated events corresponding to those 10 inverse femtobarn
 we want to perform a \whizard\ analysis: we are going to plot the
 dijet invariant mass, as well as the energy of the outgoing muon. For
 the plot of the analysis, we define a description and label the $y$
 axis:
 \begin{code}
 $description =
   "A WHIZARD Example.
    Charged current CC10 process from LEP 2."
 $y_label = "$N_{\textrm{events}}$"
 \end{code}
 We also use \LaTeX-syntax for the title of the first plot and the
 $x$-label, and then define the histogram of the dijet invariant mass
 in the range around the $W$ mass from 70 to 90 GeV in steps of half a
 GeV:
 \begin{code}
 $title = "Di-jet invariant mass $M_{jj}$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
 $x_label = "$M_{jj}$/GeV"
 histogram m_jets (70 GeV, 90 GeV, 0.5 GeV)
 \end{code}
 And we do the same for the second histogram of the muon energy:
 \begin{code}
 $title = "Muon energy $E_\mu$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
 $x_label = "$E_\mu$/GeV"
 histogram e_muon (0 GeV, 209 GeV, 4)
 \end{code}
 Now, we define the \ttt{analysis} consisting of two \ttt{record}
 statements initializing the two observables that are plotted as
 histograms:
 \begin{code}
 analysis = record m_jets (eval M [u,D]);
            record e_muon (eval E [e2])
 \end{code}
 At the very end, we perform the event generation
 \begin{code}
 simulate (cc10)
 \end{code}
 and finally the writing and compilation of the analysis in a named
 data file:
 \begin{code}
 compile_analysis { $out_file = "cc10.dat" }
 \end{code}
 This event generation part screen output looks like this:
 \begin{scriptsize}
 \begin{Verbatim}[frame=single]
           luminosity =  1.000000000000E+01
           $description = "A WHIZARD Example.
              Charged current CC10 process from LEP 2."
           $y_label = "$N_{\textrm{events}}$"
           $title = "Di-jet invariant mass $M_{jj}$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
           $x_label = "$M_{jj}$/GeV"
           $title = "Muon energy $E_\mu$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
           $x_label = "$E_\mu$/GeV"
           | Starting simulation for process 'cc10'
           | Simulate: using integration grids from file 'cc10_m1.vg'
           | RNG: Initializing TAO random-number generator
           | RNG: Setting seed for random-number generator to 9910
           | OpenMP: Using 8 threads
           | Simulation: using n_events as computed from luminosity value
           | Events: writing to raw file 'cc10.evx'
           | Events: generating 6830 unweighted, unpolarized events ...
           | Events: event normalization mode '1'
           |         ... event sample complete.
           Warning: Encountered events with excess weight: 39 events (  0.571 %)
           | Maximum excess weight = 1.027E+00
           | Average excess weight = 6.764E-04
           | Events: closing raw file 'cc10.evx'
           $out_file = "cc10.dat"
           | Opening file 'cc10.dat' for output
           | Writing analysis data to file 'cc10.dat'
           | Closing file 'cc10.dat' for output
           | Compiling analysis results display in 'cc10.tex'
 \end{Verbatim}
 \end{scriptsize} %$
 Then comes the \LaTeX\ output of the compilation of the graphical
 analysis. Fig.~\ref{fig:cc10} shows the two histograms as the are
 produced as result of the \whizard\ internal graphical analysis.
 
 %%%%%%%%%%%%%%%
 
 \section{Higgs search at LEP II}
 
 This example can be found under the name \ttt{LEP\_higgs.sin} in the
 \ttt{share/doc} folder of \whizard. It displays different search
 channels for a very light would-be SM Higgs boson of mass 115 GeV at
 the LEP II machine at its highest energy it finally achieved, 209 GeV.
 First, we use the Standard Model:
 \begin{code}
 model = SM
 \end{code}
 Then, we define aliases for neutrinos, antineutrinos, light quarks and
 light anti-quarks:
 \begin{code}
 alias n = n1:n2:n3
 alias N = N1:N2:N3
 alias q = u:d:s:c
 alias Q = U:D:S:C
 \end{code}
 Now, we define the signal process, which is Higgsstrahlung,
 \begin{code}
 process zh = e1, E1 => Z, h
 \end{code}
 the missing-energy channel,
 \begin{code}
 process nnbb = e1, E1 => n, N, b, B
 \end{code}
 and finally the 4-jet as well as dilepton-dijet channels:
 \begin{code}
 process qqbb = e1, E1 => q, Q, b, B
 process bbbb = e1, E1 => b, B, b, B
 process eebb = e1, E1 => e1, E1, b, B
 process qqtt = e1, E1 => q, Q, e3, E3
 process bbtt = e1, E1 => b, B, e3, E3
 
 compile
 \end{code}
 and we compile the code. We set the center-of-momentum energy to the
 highest energy LEP II achieved,
 \begin{code}
 sqrts = 209 GeV
 \end{code}
 For the Higgs boson, we take the values of a would-be SM Higgs boson
 with mass of 115 GeV, which would have had a width of a bit more than
 3 MeV:
 \begin{code}
 mH = 115 GeV
 wH = 3.228 MeV
 \end{code}
 We take a running $b$ quark mass to take into account NLO corrections
 to the $Hb\bar b$ vertex, while all other fermions are massless:
 \begin{code}
 mb = 2.9 GeV
 me = 0
 ms = 0
 mc = 0
 \end{code}
 \begin{scriptsize}
 \begin{Verbatim}[frame=single]
            | Process library 'default_lib': loading
            | Process library 'default_lib': ... success.
            sqrts =  2.090000000000E+02
            SM.mH =  1.150000000000E+02
            SM.wH =  3.228000000000E-03
            SM.mb =  2.900000000000E+00
            SM.me =  0.000000000000E+00
            SM.ms =  0.000000000000E+00
            SM.mc =  0.000000000000E+00
 \end{Verbatim}
 \end{scriptsize}
 To avoid soft-collinear singular phase-space regions, we apply an
 invariant mass cut on light quark pairs:
 \begin{code}
 cuts = all M >= 10 GeV [q,Q]
 \end{code}
 Now, we integrate the signal process as well as the combined signal
 and background processes:
 \begin{code}
 integrate (zh) { iterations = 5:5000}
 
 integrate(nnbb,qqbb,bbbb,eebb,qqtt,bbtt) { iterations = 12:20000 }
 \end{code}
 \begin{scriptsize}
 \begin{Verbatim}[frame=single]
            | RNG: Initializing TAO random-number generator
            | RNG: Setting seed for random-number generator to 21791
            | Initializing integration for process zh:
            | ------------------------------------------------------------------------
            | Process [scattering]: 'zh'
            |   Library name  = 'default_lib'
            |   Process index = 1
            |   Process components:
            |     1: 'zh_i1':   e-, e+ => Z, H [omega]
            | ------------------------------------------------------------------------
            | Beam structure: [any particles]
            | Beam data (collision):
            |   e-  (mass = 0.0000000E+00 GeV)
            |   e+  (mass = 0.0000000E+00 GeV)
            |   sqrts = 2.090000000000E+02 GeV
            | Phase space: generating configuration ...
            | Phase space: ... success.
            | Phase space: writing configuration file 'zh_i1.phs'
            | 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
            | Applying user-defined cuts.
            | OpenMP: Using 8 threads
            | Starting integration for process 'zh'
            | Integrate: iterations = 5:5000
            | Integrator: 1 chains, 1 channels, 2 dimensions
            | Integrator: Using VAMP channel equivalences
            | Integrator: 5000 initial calls, 20 bins, stratified = T
            | Integrator: VAMP
            |=============================================================================|
            | It      Calls  Integral[fb]  Error[fb]   Err[%]    Acc  Eff[%]   Chi2 N[It] |
            |=============================================================================|
               1       4608  1.6114109E+02  5.52E-04    0.00    0.00*  99.43
               2       4608  1.6114220E+02  5.59E-04    0.00    0.00   99.43
               3       4608  1.6114103E+02  5.77E-04    0.00    0.00   99.43
               4       4608  1.6114111E+02  5.74E-04    0.00    0.00*  99.43
               5       4608  1.6114103E+02  5.66E-04    0.00    0.00*  99.43
            |-----------------------------------------------------------------------------|
               5      23040  1.6114130E+02  2.53E-04    0.00    0.00   99.43    0.82   5
            |=============================================================================|
            [.....]
 \end{Verbatim}
 \end{scriptsize}
 \begin{figure}
   \centering
   \includegraphics[width=.48\textwidth]{lep_higgs_1}
   \includegraphics[width=.48\textwidth]{lep_higgs_2}
   \\\vspace{5mm}
   \includegraphics[width=.48\textwidth]{lep_higgs_3}
   \caption{Upper line: final state $bb + E_{miss}$, histogram of
     the invisible mass distribution (left), and of the di-$b$
     distribution (right). Lower plot: light dijet distribution in the
     $bbjj$ final state.}
   \label{fig:lep_higgs}
 \end{figure}
 Because the other integrations look rather similar, we refrain from
 displaying them here, too. As a next step, we define titles,
 descriptions and axis labels for the histograms we want to
 generate. There are two of them, one os the invisible mass
 distribution, the other is the di-$b$-jet invariant mass. Both
 histograms are taking values between 70 and 130 GeV with
 bin widths of half a GeV:
 \begin{code}
 $description =
   "A WHIZARD Example. Light Higgs search at LEP. A 115 GeV pseudo-Higgs
     has been added. Luminosity enlarged by two orders of magnitude."
 $y_label = "$N_{\textrm{events}}$"
 
 $title = "Invisible mass distribution in $e^+e^- \to \nu\bar\nu b \bar b$"
 $x_label = "$M_{\nu\nu}$/GeV"
 histogram m_invisible (70 GeV, 130 GeV, 0.5 GeV)
 
 $title = "$bb$ invariant mass distribution in $e^+e^- \to \nu\bar\nu b \bar b$"
 $x_label = "$M_{b\bar b}$/GeV"
 histogram m_bb (70 GeV, 130 GeV, 0.5 GeV)
 \end{code}
 The analysis is initialized by defining the two records for the
 invisible mass and the invariant mass of the two $b$ jets:
 \begin{code}
 analysis = record m_invisible (eval M [n,N]);
            record m_bb (eval M [b,B])
 \end{code}
 In order to have enough statistics, we enlarge the LEP integrated
 luminosity at 209 GeV by more than two orders of magnitude:
 \begin{code}
 luminosity = 10
 \end{code}
 We start event generation by simulating the process with two $b$ jets
 and two neutrinos in the final state:
 \begin{code}
 simulate (nnbb)
 \end{code}
 As a third histogram, we define the dijet invariant mass of two light
 jets:
 \begin{code}
 $title = "Dijet invariant mass distribution in $e^+e^- \to q \bar q b \bar b$"
 $x_label = "$M_{q\bar q}$/GeV"
 histogram m_jj (70 GeV, 130 GeV, 0.5 GeV)
 \end{code}
 Then we simulate the 4-jet process defining the light-dijet
 distribution as a local record:
 \begin{code}
 simulate (qqbb) { analysis = record m_jj (eval M / 1 GeV [combine [q,Q]]) }
 \end{code}
 Finally, we compile the analysis,
 \begin{code}
 compile_analysis { $out_file = "lep_higgs.dat" }
 \end{code}
 \begin{scriptsize}
 \begin{Verbatim}[frame=single]
            | Starting simulation for process 'nnbb'
            | Simulate: using integration grids from file 'nnbb_m1.vg'
            | RNG: Initializing TAO random-number generator
            | RNG: Setting seed for random-number generator to 21798
            | OpenMP: Using 8 threads
            | Simulation: using n_events as computed from luminosity value
            | Events: writing to raw file 'nnbb.evx'
            | Events: generating 1070 unweighted, unpolarized events ...
            | Events: event normalization mode '1'
            |         ... event sample complete.
            Warning: Encountered events with excess weight: 207 events ( 19.346 %)
            | Maximum excess weight = 1.534E+00
            | Average excess weight = 4.909E-02
            | Events: closing raw file 'nnbb.evx'
            $title = "Dijet invariant mass distribution in $e^+e^- \to q \bar q b \bar b$"
            $x_label = "$M_{q\bar q}$/GeV"
            | Starting simulation for process 'qqbb'
            | Simulate: using integration grids from file 'qqbb_m1.vg'
            | RNG: Initializing TAO random-number generator
            | RNG: Setting seed for random-number generator to 21799
            | OpenMP: Using 8 threads
            | Simulation: using n_events as computed from luminosity value
            | Events: writing to raw file 'qqbb.evx'
            | Events: generating 4607 unweighted, unpolarized events ...
            | Events: event normalization mode '1'
            |         ... event sample complete.
            Warning: Encountered events with excess weight: 112 events (  2.431 %)
            | Maximum excess weight = 8.875E-01
            | Average excess weight = 4.030E-03
            | Events: closing raw file 'qqbb.evx'
            $out_file = "lep_higgs.dat"
            | Opening file 'lep_higgs.dat' for output
            | Writing analysis data to file 'lep_higgs.dat'
            | Closing file 'lep_higgs.dat' for output
            | Compiling analysis results display in 'lep_higgs.tex'
 \end{Verbatim}
 \end{scriptsize}
 The graphical analysis of the events generated by \whizard\ are shown
 in Fig.~\ref{fig:lep_higgs}. In the upper left, the invisible mass
 distribution in the $b\bar b + E_{miss}$ state is shown, peaking
 around the $Z$ mass. The upper right shows the $M(b\bar b)$
 distribution in the same final state, while the lower plot has the
 invariant mass distribution of the two non-$b$-tagged (light) jets in
 the $bbjj$ final state. The latter shows only the $Z$
 peak, while the former exhibits the narrow would-be 115 GeV Higgs
 state.
 
 %%%%%%%%%%%%%%%
 
 \section{Deep Inelastic Scattering at HERA}
 
 %%%%%%%%%%%%%%%
 
 \section{$W$ endpoint at LHC}
 
 %%%%%%%%%%%%%%%
 
 \section{SUSY Cascades at LHC}
 
 %%%%%%%%%%%%%%%
 
 \section{Polarized $WW$ at ILC}
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{Technical details -- Advanced Spells}
 \label{chap:tuning}
 
 \section{Efficiency and tuning}
 
 Since massless fermions and vector bosons (or almost massless states
 in a certain approximation) lead to restrictive selection rules for
 allowed helicity combinations in the initial and final state. To make
 use of this fact for the efficiency of the \whizard\ program, we are
 applying some sort of heuristics: \whizard\ dices events into all
 combinatorially possible helicity configuration during a warm-up
 phase. The user can specify a helicity threshold which sets the number
 of zeros \whizard\ should have got back from a specific helicity
 combination in order to ignore that combination from now on. By that
 mechanism, typically half up to more than three quarters of all
 helicity combinations are discarded (and hence the corresponding
 number of matrix element calls). This reduces calculation time up to
 more than one order of magnitude. \whizard\ shows at the end of the
 integration those helicity combinations which finally contributed to
 the process matrix element.
 
 Note that this list -- due to the numerical heuristics -- might very
 well depend on the number of calls for the matrix elements per
 iteration, and also on the corresponding random number seed.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \chapter{New External Physics Models}
 \label{chap:extmodels}
 
 It is never possible to include all incarnations of physics models that
 can be described by the maybe weirdest form of a quantum field theory
 in a tailor-made implementation within a program like \whizard. Users
 clearly want to be able to use their own special type of model; in
 order to do so there are external tools to translate models described
 by their field content and Lagrangian densities into Feynman rules and
 make them available in an event generator like \whizard. In this
 chapter, we describe the interfaces to two such external models,
 \sarah\ and \FeynRules.
 
 The \FeynRules\ interface had been started already for the legacy
 version \whizard\ttt{1} (where it had to be downloaded from
 \url{https://projects.hepforge.org/whizard} as a separate package), but
 for the \whizard\ttt{two} release series it has been included in the
 \FeynRules\ package (from their version v1.6.0 on). Note that there
 was a regression for the usage of external models (from either \sarah\
 or \FeynRules) in the first release of series v2.2, v2.2.0. This has
 been fixed in all upcoming versions.
 
 Besides using \sarah\ or \FeynRules\ via their interfaces, there is
 now a much easier way to let those programs output model files in the
 "Universal FeynRules Output" (or \UFO). This option does not have any
 principle limitations for models, and also does not rely on the never
 truly constant interfaces between two different tools. Their usage is
 described in Sec.~\ref{sec:ufo}.
 
 %%%%%%%%%%%%%%%
 
 \section{New physics models via \sarah}
 \sarah~\cite{Staub:2008uz,Staub:2009bi,Staub:2010jh,Staub:2012pb,Staub:2013tta}
 is a \Mathematica~\cite{mathematica} package which
 derives for a given model the
 minimum conditions of the vacuum, the mass matrices, and vertices at tree-level
 as well as expressions for the one-loop corrections for all masses and the
 full two-loop renormalization group equations (RGEs). The vertices can be exported
 to be used with \whizard/\oMega. All other information can be used to generate
 \fortran\ source code for the RGE solution tool and spectrum generator
 \spheno~\cite{Porod:2003um,Porod:2011nf}  to get a spectrum generator
 for any model. The
 advantage is that \spheno\ calculates a consistent set of parameters (couplings,
 masses, rotation matrices, decay widths) which can be used as input for \whizard.
 \sarah\ and \spheno\ can be also downloaded from the \ttt{HepForge} server:
 \begin{center}
 \url{https://sarah.hepforge.org} \\
 \url{https://spheno.hepforge.org}
 \end{center}
 
 
 \subsection{\whizard/\oMega\ model files from \sarah}
 
 \subsubsection{Generating the model files}
 
 Here we are giving only the information relevant to generate models
 for \whizard. For more details about the installation of \sarah\ and
 an exhaustion documentation about its usage, confer the \sarah\
 manual.
 
 To generate the model files for \whizard/\oMega\ with \sarah, a
 new \Mathematica\ session has to be started. \sarah\ is loaded via
 \begin{code}
 <<SARAH-4.2.1/SARAH.m;
 \end{code}
 if \sarah\ has been stored in the applications directory of
 \Mathematica. Otherwise, the full path has to be given
 \begin{code}
 <<[Path_to_SARAH]/SARAH.m;
 \end{code}
 To get an overview which models are delivered with \sarah, the command \verb"ShowModels"
 can be used. As an example, we use in the following the triplet
 extended MSSM (TMSSM) and initialize it in \sarah\ via
 \begin{code}
 Start["TMSSM"];
 \end{code}
 Finally, the output intended for \whizard/\oMega\ is started via
 \begin{code}
 MakeWHIZARD[Options]
 \end{code}
 The possible options of the \verb"MakeWHIZARD" command are
 \begin{enumerate}
   \item \verb"WriteOmega", with values: \verb"True" or \verb"False", default:
     \verb"True" \\
     Defines if the model files for \oMega\ should be written
   \item \verb"WriteWHIZARD", with values: \verb"True" or \verb"False",
     default: \verb"True" \\
     Defines if the model files for \whizard\ should be written
   \item \verb"Exclude", with values: list of generic type, Default:
     \verb"{SSSS}" \\
     Defines which generic vertices are {\em not} exported to the model
     file
   \item \verb"WOModelName", with values: string, default: name of the
     model in \sarah\ followed by \verb"_sarah"  \\
     Gives the possibility to change the model name
   \item \verb"MaximalCouplingsPerFile", with values: integer, default:
     \ttt{150} \\
     Defines the maximal number of couplings written per file
   \item \verb"Version", with values: formatted number, Default:
     \verb"2.2.1"~\footnote{Due to a regression in \whizard\ version
       v2.2.0, \sarah\ models cannot be successfully linked within
       that version. Hence, the default value here has been set to
       version number 2.2.1}, \\
     Defines the version of \whizard\ for which the model file is generated
 \end{enumerate}
 All options and the default values are also shown in the
 \Mathematica\ session via \newline\verb"Options[MakeWHIZARD]".
 
 \subsubsection{Using the generated model files with \whizard}
 
 After the interface has completed evaluation, the generated files can
 be found in the subdirectory \verb"WHIZARD_Omega" of {\sarah}s output
 directory. In order to use it the generated code must be compiled and
 installed. For this purpose, open a terminal, enter the output directory
 \begin{code}
 <PATH_to_SARAH>/Output/TMSSM/EWSB/WHIZARD_Omega/
 \end{code}
 and run
 %
 \begin{code}
 ./configure
 make install
 \end{code}
 %
 By default, the last command installs the compiled model into \verb".whizard"
 in current user's home directory where it is automatically picked up by
 \whizard. Alternative installation paths can be specified using the
 \verb"--prefix" option to \whizard.
 %
 \begin{code}
 ./configure --prefix=/path/to/installation/prefix
 \end{code}
 %
 If the files are installed into the \whizard\
 installation prefix, the program will also pick them up automatically, while
 {\whizard}'s \verb"--localprefix" option must be used to communicate any other
 choice to \whizard. In case \whizard\ is not available in the binary search
 path, the \verb"WO_CONFIG" environment variable can be used to point
 \verb"configure" to the binaries
 %
 \begin{code}
 ./configure WO_CONFIG=/path/to/whizard/binaries
 \end{code}
 %
 More information on the available options and their syntax can be obtained with
 the
 \verb"--help" option.
 
 After the model is compiled it can be used in \whizard\ as
 \begin{code}
 model = tmssm_sarah
 \end{code}
 
 
 
 \subsection{Linking \spheno\ and \whizard}
 As mentioned above, the user can also use \spheno\ to generate spectra
 for its models. This is done by means of \fortran\ code for \spheno,
 exported from \sarah.  To do so, the user has to apply the command
 \verb"MakeSPheno[]". For more details
 about the options of this command and how to compile and use the \spheno\ output,
 we refer to the \sarah\ manual. \\
 As soon as the \spheno\ version for the given model is ready it can be used to
 generate files with all necessary numerical values for the parameters in a format
 which is understood by \whizard. For this purpose, the corresponding flag in the
 Les Houches input file of \spheno\ has to be turned on:
 \begin{code}
 Block SPhenoInput   # SPheno specific input
 ...
 75 1               # Write WHIZARD files
 \end{code}
 Afterwards, \spheno\ returns not only the spectrum file in the
 standard SUSY Les Houches accord (SLHA) format (for more details about
 the SLHA and the \whizard\ SLHA interface cf. Sec.~\ref{sec:slha}),
 but also an additional file called \verb"WHIZARD.par.TMSSM" for our example.
 This file can be used
 in the \sindarin\ input file via
 \begin{code}
 include ("WHIZARD.par.TMSSM")
 \end{code}
 
 %%%%%
 
 \subsection{BSM Toolbox}
 
 A convenient way to install \sarah\ together with \whizard, \spheno\
 and some  other codes are the \ttt{BSM Toolbox} scripts
 \footnote{Those script have been published
 under the name SUSY Toolbox but \sarah\ is with version 4 no longer
 restricted to SUSY models}~\cite{Staub:2011dp}. These scripts are
 available at
 \begin{center}
  \url{https://projects.hepforge.org/sarah/Toolbox.html}
 \end{center}
 The \ttt{Toolbox} provides two scripts. First, the \verb"configure" script is
 used via
 \begin{code}
 toolbox-src-dir> mkdir build
 toolbox-src-dir> cd build
 toolbox-src-dir> ../configure
 \end{code}
 %
 The  \verb"configure" script checks for the requirements of the
 different packages and downloads all codes. All downloaded archives will
 be placed in the \verb"tarballs" subdirectory of the directory containing the
 \verb"configure" script.
 Command line options can be used to disable specific packages and to point the
 script to custom locations of compilers and of the \Mathematica\ kernel; a full
 list of those can be obtained by calling \verb"configure" with the \verb"--help"
 option.
 
 After \verb"configure" finishes successfully, \verb"make" can be called to build
 all configured packages
 %
 \begin{code}
 toolbox-build-dir> make
 \end{code}
 
 \verb"configure" creates also the second script which automates the implementation
 of a new model into all packages. The \verb"butler" script takes as argument the
 name of the model in \sarah, e.g.
 \begin{code}
 > ./butler TMSSM
 \end{code}
 The \verb"butler" script runs \sarah\ to get the output in the same
 form as the \whizard/\oMega\
 model files and the code for \spheno. Afterwards, it installs the
 model in all packages and compiles the new \whizard/\oMega\ model
 files as well as the new \spheno\ module.
 
 %%%%%
 \newpage
 
 \section{New physics models via \FeynRules}
 
 In this section, we present the interface between the external tool
 \FeynRules\ \cite{Christensen:2008py,Christensen:2009jx,Duhr:2011se}
 and \whizard. \FeynRules\ is a
 \Mathematica~\cite{mathematica} package that allows to derive
 Feynman rules from any perturbative quantum field theory-based Lagrangian
 in an automated way. It can be downloaded from
 \begin{center}
   \url{http://feynrules.irmp.ucl.ac.be/}
 \end{center}
 The input provided by the user is threefold and consists
 of the Lagrangian defining the model, together with the definitions of
 all the
 particles and parameters that appear in the model.
 Once this information is provided, \FeynRules\ can perform basic checks
 on the sanity of the implementation (e.g. hermiticity, normalization
 of the quadratic terms), and finally computes all the interaction
 vertices associated  with the model and store them in an internal
 format for later processing. After the Feynman rules have been
 obtained, \FeynRules\ can export the interaction vertices to \whizard\
 via a dedicated interface~\cite{Christensen:2010wz}. The interface
 checks whether all the vertices are compliant with the structures
 supported by \whizard's
 matrix element generator \oMega, and discard them in the case
 they are not supported. The output of the interface consists of a set
 of files organized in a single directory which can be injected into
 \whizard/\oMega\ and used as any other built-in models. Together with
 the model files, a framework is created which allows to communicate
 the new models to \whizard\ in a well defined way, after which
 step the model can be used exactly like the built-in ones.
 This specifically means that the user is not required to
 manually modify the code of \whizard/\oMega, the models created by the
 interface can be used directly without any further user intervention.
 We first describe the installation and general usage of the interface,
 and then list the general properties like the supported particle
 types, color quantum numbers and Lorentz structures as well as types
 of gauge interactions.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \subsection{Installation and Usage of the \whizard-\FeynRules\ interface}
 \label{sec:interface-usage}
 
 \paragraph{{\bf Installation and basic usage:}}
 %
 From \FeynRules\ version 1.6.0 onward, the interface to \whizard\ is
 part of the \FeynRules\ distribution\footnote{Note that though the
   main interface of \FeynRules\ to \whizard\ is for the most recent
   \whizard\ release, but also the legacy branch
   \whizard\ttt{1} is supported.}. In addition, the latest version
 of the interface can be downloaded from the \whizard\ homepage on
 \ttt{HepForge}. There you can also find an installer that can be used
 to inject the interface into an existing \FeynRules\
 installation (which allows to use the interface with the \FeynRules\
 release series1.4.x where it is not part of the package).
 
 Once installed, the interface can be called and used in the same way
 \FeynRules' other interfaces described
 in~\cite{Christensen:2008py}. The details of how to install and use
 \FeynRules\ itself can be found
 there,~\cite{Christensen:2008py,Christensen:2009jx,Duhr:2011se}. Here,
 we only describe how to use the interface to inject new models into
 \whizard.  For example, once the  \FeynRules\ environment has been
 initialized and a model has been loaded, the command
 \begin{code}
   WriteWOOutput[L]
 \end{code}
 will call the \ttt{FeynmanRules} command to extract the Feynman
 rules from the Lagrangian \ttt{L}, translate them together with the
 model data and finally write the files necessary for using the model
 within \whizard\ to an output directory (the name of which is inferred
 from the model name by default). Options can be added for further
 control over the translation process (see
 Sec.~\ref{app:interface-options}). Instead of using a Lagrangian, it
 is also possible to call the interface on a pure vertex list. For
 example, the following command
 \begin{code}
   WriteWOOutput[Input -> list]
 \end{code}
 will directly translate the vertex list \ttt{list}. Note that this
 vertex list must be given in flavor-expanded form in order for the
 interface to process it correctly.
 
 The interface also supports the \ttt{WriteWOExtParams} command
 described in~\cite{Christensen:2008py}. Issuing
 \begin{code}
   WriteWOExtParams[filename]
 \end{code}
 will write a list of all the external parameters to
 \ttt{filename}. This is done in the form of a \sindarin\
 script. The only option accepted by the command above is the target
 version of \whizard, set by the option \ttt{WOWhizardVersion}.
 
 During execution, the interface will print out a series of
 messages. It is highly advised to carefully read through this output
 as it not only summarizes the settings and the location of the output
 files, but also contains information on any skipped vertices or
 potential incompatibilities of the model with \whizard.
 
 After the interface has run successfully and written the model files to the
 output directory, the model must be imported into \whizard. For doing
 so, the model files have to be compiled and can then be installed
 independently of \whizard. In the simplest scenario, assuming that the
 output directory is the current working directory and that the
 \whizard\ binaries can be found in the current \ttt{\$\{PATH\}},
 the installation is performed by simply executing
 \begin{code}
 ./configure~\&\&~make clean~\&\&~make install
 \end{code}
 
 This will compile the model and install it into the directory
 \ttt{\$\{HOME\}/.whizard}, making it fully available to \whizard\
 without any further intervention. The build system can be adapted to
 more complicated cases through several options to the
 \ttt{configure} which are listed in the \ttt{INSTALL} file
 created in the output directory. A detailed explanation of all options
 can be found in Sec.~\ref{app:interface-options}.
 
 \paragraph{\bf Supported fields and vertices:}
 
 The following fields are currently supported by the interface:
 scalars, Dirac and Majorana fermions, vectors and symmetric tensors.
 The set of accepted operators, the full list of which can be found in
 Tab.~\ref{tab-operators}, is a subset of all the operators supported
 by \oMega. While still limited, this list is sufficient for a large
 number of BSM models. In addition, a future version of
 \whizard/\oMega\ will support the definition of completely general
 Lorentz structures in the model, allowing the interface to
 translate all interactions handled by \FeynRules. This will be done by
 means of a parser within \oMega\ of the \ttt{UFO} file format for
 model files from \FeynRules.
 
 \begin{table*}[!t]
 \centerline{\begin{tabular}{|c|c|}
 \hline Particle spins & Supported Lorentz structures \\\hline\hline
 FFS & \parbox{0.7\textwidth}{\raggedright
    All operators of dimension four are supported.
 \strut}\\\hline
 FFV & \parbox[t]{0.7\textwidth}{\raggedright
    All operators of dimension four are
    supported.
 \strut}\\\hline
 SSS & \parbox{0.7\textwidth}{\raggedright
    All dimension three interactions are supported.
 \strut}\\\hline
 SVV & \parbox[t]{0.7\textwidth}{\raggedright
    Supported operators:\\
    \mbox{}\hspace{5ex}$\begin{aligned}
       \text{dimension 3:} & \quad\mathcal{O}_3 = V_1^\mu V_{2\mu}\phi \mbox{}\\
       \text{dimension 5:} & \quad\mathcal{O}_5 = \phi
          \left(\partial^\mu V_1^\nu - \partial^\nu V_1^\mu\right)
          \left(\partial_\mu V_{2\nu} - \partial_\nu V_{2\mu}\right)
    \end{aligned}$\\
 Note that $\mathcal{O}_5$ generates the effective gluon-gluon-Higgs couplings obtained by integrating out heavy quarks.
 \strut}\\\hline
 SSV & \parbox[t]{0.7\textwidth}{\raggedright
    $\left(\phi_1\partial^\mu\phi_2 - \phi_2\partial^\mu\phi_1\right)V_\mu\;$
    type interactions are supported.
 \strut}\\\hline
 SSVV & \parbox{0.7\textwidth}{\raggedright
    All dimension four interactions are supported.
 \strut}\\\hline
 SSSS & \parbox{0.7\textwidth}{\raggedright
    All dimension four interactions are supported.
 \strut}\\\hline
 VVV & \parbox[t]{0.7\textwidth}{\raggedright
    All parity-conserving dimension four operators are supported, with
    the restriction that non-gauge interactions may be split into
    several vertices and can only be handled if all three fields are
    mutually different.\strut
 \strut}\\\hline
 VVVV & \parbox[t]{0.7\textwidth}{\raggedright
    All parity conserving dimension four operators are supported.
 \strut}\\\hline
 TSS, TVV, TFF & \parbox[t]{0.7\textwidth}{\raggedright
    The three point couplings in the Appendix of Ref.\
    \cite{Han:1998sg} are supported.
 \strut}\\\hline
 \end{tabular}}
 \caption{All Lorentz structures currently supported by the
   \whizard-\FeynRules\ interface, sorted with respect to the spins of
   the particles. ``S'' stands for scalar, ``F'' for fermion (either
   Majorana or Dirac) and ``V'' for vector.}
 \label{tab-operators}
 \end{table*}
 
 \paragraph{\bf Color:}
 %
 Color is treated in \oMega\ in the color flow decomposition,
 with the flow structure being implicitly determined from
 the representations of the particles present at the vertex. Therefore, the
 interface has to strip the color structure from the vertices derived by
 \FeynRules\ before writing them out to the model files.
 While this process is straightforward for all color structures which
 correspond only to a single flow assignment, vertices with several
 possible flow configurations must be treated with care in order to
 avoid mismatches between the flows assigned by \oMega\ and those
 actually encoded in the couplings. To this end, the interface derives
 the color flow decomposition from the color structure determined by
 \FeynRules\ and rejects all vertices which would lead to a wrong flow
 assignment by \oMega\ (these rejections are accompanied by warnings
 from the interface)\footnote{For the old \whizard\ttt{1} legacy
   branch, there was a maximum number of external color flows that had
   to explicitly specified. Essentially, this is $n_8 - \frac{1}{2}n_3$
   where $n_8$ is the maximum number of external color octets and $n_3$
   is the maximum number of external triplets and antitriplets. This
   can be set in the \whizard/\FeynRules\ interface by the
   \ttt{WOMaxNcf} command, whose default is \ttt{4}.}.
 
 At the moment, the $SU(3)_C$ representations supported by
 both \whizard\ and the interface are singlets ($1$), triplets ($3$),
 antitriplets ($\bar{3}$) and octets ($8$). Tab.~\ref{tab:su3struct}
 shows all combinations of these representations which can
 form singlets together with the support status of the respective color
 structures in \whizard\ and the interface. Although the supported
 color structures do not comprise all possible singlets, the list is
 sufficient for a large number of SM extensions. Furthermore, a future
 revision of \whizard/\oMega\ will allow for explicit color flow
 assignments, thus removing most of the current restrictions.
 
 \begin{table*}
 \centerline{\begin{tabular}{|c|c|}
 \hline $SU(3)_C$ representations &
    Support status
 \\\hline\hline
 \parbox[t]{0.2\textwidth}{
    \centerline{\begin{tabular}[t]{lll}
    $111,\quad$ & $\bar{3}31,\quad$ & $\bar{3}38,$ \\
    $1111,$ & $\bar{3}311,$ & $\bar{3}381$
    \end{tabular}}} &
 \parbox[t]{0.7\textwidth}{\raggedright\strut Fully supported by the interface\strut}
 \\\hline
 $888,\quad 8881$ &
 \parbox{0.7\textwidth}{\raggedright\strut Supported only if at least two of the octets
 are identical particles.\strut}
 \\\hline
 $881,\quad 8811$ &
 \parbox{0.7\textwidth}{\raggedright\strut Fully supported by the
   interface\footnote{%
     Not available in version 1.95 and earlier. Note that in order to
     use such couplings in 1.96/97, the
     \oMega\ option \ttt{2g} must be added to the process definition
     in \ttt{whizard.prc}.}.\strut}
 \\\hline
 $\bar{3}388$ &
 \parbox{0.7\textwidth}{\raggedright\strut Supported only if the octets
   are identical
 particles.\strut}
 \\\hline
 $8888$ &
 \parbox{0.7\textwidth}{\raggedright\strut The only supported flow structure is
 \begin{equation*}
 \parbox{21mm}{\includegraphics{flow4}}\cdot\;\Gamma(1,2,3,4)
    \quad+\quad \text{all acyclic permutations}
 \end{equation*}
 where $\Gamma(1,2,3,4)$ represents the Lorentz structure associated with the
 first flow.\strut}
 \\\hline
 \parbox[t]{0.2\textwidth}{
    \centerline{\begin{tabular}[t]{lll}
    $333,\quad$ & $\bar{3}\bar{3}\bar{3},\quad$ & $3331$\\
    $\bar{3}\bar{3}\bar{3}1,$ & $\bar{3}\bar{3}33$
    \end{tabular}}} &
 \parbox[t]{0.7\textwidth}{\raggedright\strut Unsupported (at the
   moment)\strut}
 \\\hline
 \end{tabular}}
 \caption{All possible combinations of three or four $SU(3)_C$
 representations supported by \FeynRules\ which can be used to build singlets,
 together with the support status of the corresponding color structures in
 \whizard\ and the interface.}
 \label{tab:su3struct}
 \end{table*}
 
 \paragraph{\bf Running $\alpha_S$:}
 
 While a running strong coupling is fully supported by the interface, a
 choice has to be made which quantities are to be reevaluated when the
 strong coupling is evolved. By default \ttt{aS}, \ttt{G} (see
 Ref.~\cite{Christensen:2008py} for the nomenclature regarding
 the QCD coupling) and any vertex factors depending on them are evolved.
 The list of internal parameters that are to be recalculated (together
 with the vertex factors depending on them) can be
 extended (beyond \ttt{aS} and \ttt{G}) by using
 the option \ttt{WORunParameters} when calling the
 interface~\footnote{As the legacy branch, \whizard\ttt{1}, does not
   support a running strong coupling, this is also vetoed by the
   interface when using \whizard \ttt{1.x}.}.
 
 \paragraph{\bf Gauge choices:}
 \label{sec:gauge-choices}
 
 The interface supports the unitarity, Feynman and $R_\xi$ gauges. The choice of
 gauge must be communicated to the interface via the option \ttt{WOGauge}.
 Note that massless gauge bosons are always treated in Feynman gauge.
 
 If the selected gauge is Feynman or $R_\xi$, the interface can
 automatically assign the proper masses to the Goldstone bosons. This behavior is
 requested by using the \ttt{WOAutoGauge} option. In the $R_\xi$
 gauges, the symbol representing the gauge $\xi$ must be communicated to the
 interface by using the \ttt{WOGaugeSymbol} option (the symbol is
 automatically introduced into the list of external
 parameters if \ttt{WOAutoGauge} is
 selected at the same time). This feature can be used to automatically extend
 models implemented in Feynman gauge to the $R_\xi$ gauges.
 
 Since \whizard\ (at least until the release series 2.3) is a
 tree-level tool working with helicity amplitudes, the ghost sector is
 irrelevant for \whizard\ and hence dropped by the interface.
 
 \subsection{Options of the \whizard-\FeynRules\ interface}
 \label{app:interface-options}
 
 In the following we present a comprehensive list of all the options accepted by
 \ttt{WriteWOOutput}. Additionally, we note that all options of the
 \FeynRules\ command \ttt{FeynmanRules} are accepted by
 \ttt{WriteWOOutput}, which passes them on to \ttt{FeynmanRules}.
 
 \begin{description}
 \item[\ttt{Input}]\mbox{}\\
 An optional vertex list to use instead of a Lagrangian (which can then be
 omitted).
 %
 \item[\ttt{WOWhizardVersion}]\mbox{}\\
 Select the \whizard\ version for which code is to be generated.
 The currently available choices are summarized in
 Tab.~\ref{tab-wowhizardversion}.
 %%
 \begin{table}
 \centerline{\begin{tabular}{|l|l|}
 \hline \ttt{WOWhizardVersion} & \whizard\ versions supported
 \\\hline\hline
 \ttt{"2.0.3"} (default) & 2.0.3+ \\\hline
 \ttt{"2.0"} & 2.0.0 -- 2.0.2 \\\hline\hline
 \ttt{"1.96"} & 1.96+ \qquad (deprecated) \\\hline
 \ttt{"1.93"} & 1.93 -- 1.95 \qquad (deprecated) \\\hline
 \ttt{"1.92"} & 1.92 \qquad (deprecated) \\\hline
 \end{tabular}}
 \caption{Currently available choices for the \ttt{WOWhizardVersion} option,
 together with the respective \whizard\ versions supported by them.}
 \label{tab-wowhizardversion}
 \end{table}
 %%
 This list  will expand as the program evolves. To get a summary
 of all choices available in a particular version of the interface, use
 the command
 \ttt{?WOWhizardVersion}.
 %
 \item[\ttt{WOModelName}]\mbox{}\\
 The name under which the model will be known to
 \whizard\footnote{For versions 1.9x, model names must start
   with ``\ttt{fr\_}'' if they are to be picked up by \whizard\
   automatically.}. The default is determined from the \FeynRules\
 model name.
 %
 \item[\ttt{Output}]\mbox{}\\
 The name of the output directory. The default is determined from the
 \FeynRules\ model name.
 %
 \item[\ttt{WOGauge}]\mbox{}\\
 Gauge choice (\emph{cf.} Sec.~\ref{sec:gauge-choices}).
 Possible values are: \ttt{WOUnitarity} (default),
 \ttt{WOFeynman}, \ttt{WORxi}
 %
 \item[\ttt{WOGaugeParameter}]\mbox{}\\
 The external or internal parameter representing the gauge $\xi$ in
 the $R_\xi$ gauges (\emph{cf.} Sec.~\ref{sec:gauge-choices}). Default:
 \ttt{Rxi}
 %
 \item[\ttt{WOAutoGauge}]\mbox{}\\
 Automatically assign the Goldstone boson masses in the Feynman and $R_\xi$
 gauges and automatically append the symbol for $\xi$ to the parameter list in
 the $R_\xi$ gauges. Default: \ttt{False}
 %
 \item[\ttt{WORunParameters}]\mbox{}\\
 The list of all internal parameters which will be recalculated if $\alpha_S$ is
 evolved (see above)\footnote{Not available for versions older than
   2.0.0}. Default: \mbox{\ttt{\{aS, G\}}}
 %
 \item[\ttt{WOFast}]\mbox{}\\
 If the interface drops vertices which are supported, this option can be
 set to \ttt{False} to enable some more time consuming checks which might aid
 the identification. Default: \ttt{True}
 %
 \item[\ttt{WOMaxCouplingsPerFile}]\mbox{}\\
 The maximum number of couplings that are written to a single \fortran\
 file. If compilation takes too long or fails, this can be
 lowered. Default: \ttt{500}
 %
 \item[\ttt{WOVerbose}]\mbox{}\\
 Enable verbose output and in particular more extensive information on any
 skipped vertices. Default: \ttt{False}
 \end{description}
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \subsection{Validation of the interface}
 
 The output of the interface has been extensively
 validated. Specifically, the integrated cross sections for all
 possible $2\rightarrow 2$ processes in the \FeynRules\ SM, the MSSM
 and the Three-Site Higgsless Model have been compared between
 \whizard, \madgraph, and \CalcHep, using the respective \FeynRules\
 interfaces as well as the in-house implementations of these models
 (the Three-Site Higgsless model not being available in \madgraph).
 Also, different gauges have been checked for \whizard\ and \CalcHep.
 In all comparisons, excellent agreement within the Monte Carlo errors
 was achieved. The detailed comparison including examples of the
 comparison tables can be found in~\cite{Christensen:2010wz}.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \subsection{Examples for the \whizard-/\FeynRules\ interface}
 
 Here, we will use the Standard Model, the MSSM and the Three-Site
 Higgsless Model as prime examples to explain the usage of the
 interface. Those are the models that have been used in the validation
 of the interface in~\cite{Christensen:2010wz}. The examples are
 constructed to show the application of the different options of the
 interface and to serve as a starting point for the generation of the
 user's own \whizard\ versions of other \FeynRules\ models.
 
 \subsubsection{\whizard-\FeynRules\ example: Standard
   Model}\label{sec:usageSM}
 
 To start off, we will create {\sc Whizard} 2 versions of the Standard
 Model as implemented in \FeynRules\ for different gauge choices.
 
 \paragraph{SM: Unitarity Gauge}
 
 In order to invoke \FeynRules, we change to the corresponding
 directory and load the program in \Mathematica\ via
 \begin{code}
 $FeynRulesPath =
      SetDirectory["<path-to-FeynRules>"];
 <<FeynRules`
 \end{code}
 %$
 The model is loaded by
 \begin{code}
 LoadModel["Models/SM/SM.fr"];
 FeynmanGauge = False;
 \end{code}
 Note that the second line is required to switch the Standard
 Model to Unitarity gauge as opposed to Feynman gauge (which is the default).
 Generating a \whizard\ model is now simply done by
 \begin{code}
 WriteWOOutput[LSM];
 \end{code}
 After invokation, the interface first gives a short summary of the setup
 \begin{code}
 Short model name is "fr_standard_model"
 Gauge: Unitarity
 Generating code for WHIZARD / O'Mega
                         version 2.0.3
 Maximum number of couplings per FORTRAN
                            module: 500
 Extensive lorentz structure checks disabled.
 \end{code}
 
 Note that, as we have not changed any options, those settings represent the
 defaults. The output proceeds with the calculation of the Feynman rules from the
 Standard Model Lagrangian \verb?LSM?. After the rules have been derived, the
 interface starts generating output and tries to match the vertices to
 their \whizard/\oMega\ counterparts.
 \begin{code}
    10 of 75 vertices processed...
    20 of 75 vertices processed...
    30 of 75 vertices processed...
    40 of 75 vertices processed...
    50 of 75 vertices processed...
    60 of 75 vertices processed...
    70 of 75 vertices processed...
 processed a total of 75 vertices, kept 74
    of them and threw away 1, 1 of which
    contained ghosts or goldstone bosons.
 \end{code}
 The last line of the above output is particularily interesting, as it informs us
 that everything worked out correctly: the interface was able to match all
 vertices, and the only discarded vertex was the QCD ghost interaction.
 After the interface has finished running, the model files in the output
 directory are ready to use and can be compiled using the procedure described in
 the previous section.
 
 %%%%%
 
 \paragraph{SM: Feynman and $R_\xi$ gauges}
 
 As the Standard Model as implemented in \FeynRules\ also supports Feynman
 gauge, we can use the program to generate a Feynman gauge version of the model.
 Loading \FeynRules\ and the model proceeds as above, with the only
 difference being the change
 \begin{code}
 FeynmanGauge = True;
 \end{code}
 In order to inform the interface about the modified gauge, we have to
 add the option \verb?WOGauge?
 \begin{code}
 WriteWOOutput[LSM, WOGauge -> WOFeynman];
 \end{code}
 The modified gauge is reflected in the output of the interface
 \begin{code}
 Short model name is "fr_standard_model"
 Gauge: Feynman
 Generating code for WHIZARD / O'Mega
                         version 2.0.3
 Maximum number of couplings per FORTRAN
                            module: 500
 Extensive lorentz structure checks disabled.
 \end{code}
 The summary of the vertex identification now takes the following form
 \begin{code}
 processed a total of 163 vertices, kept 139
    of them and threw away 24, 24 of which
    contained ghosts.
 \end{code}
 Again, this line tells us that there were no problems --- the only
 discarded interactions involved the ghost sector which is irrelevant
 for the tree-level part of \whizard.
 
 For a tree-level calculation, the only difference between the
 different gauges from the perspective of the interface are the gauge
 boson propagators and the Goldstone boson masses. Therefore, the
 interface can automatically convert a model in Feynman gauge to a
 model in $R_\xi$ gauge. To this end, the call to the interface must be
 changed to
 \begin{code}
 WriteWOOutput[LSM, WOGauge -> WORxi,
                WOAutoGauge -> True];
 \end{code}
 The \verb?WOAutoGauge? argument instructs the interface to
 automatically
 \begin{enumerate}
 \item Introduce a symbol for the gauge parameter $\xi$ into the
 list of external parameters
 \item Generate the Goldstone boson masses from those of the associated
   gauge bosons (ignoring the values provided by \FeynRules)
 \end{enumerate}
 The modified setup is again reflected in the interface output
 \begin{code}
 Short model name is "fr_standard_model"
 Gauge: Rxi
 Gauge symbol: "Rxi"
 Generating code for WHIZARD / O'Mega
                        version 2.0.3
 Maximum number of couplings per FORTRAN
                          module: 500
 Extensive lorentz structure checks disabled.
 \end{code}
 Note the default choice \verb?Rxi? for the name of the $\xi$ parameter
 -- this can be modified via the option \verb?WOGaugeParameter?.
 
 While the \verb?WOAutoGauge? feature allows to generate $R_\xi$ gauged models
 from models implemented in Feynman gauge, it is of course also possible to use
 models genuinely implemented in $R_\xi$ gauge by setting this parameter to
 \verb?False?. Also, note that the choice of gauge only affects the propagators
 of massive fields. Massless gauge bosons are always treated in Feynman
 gauge.
 
 \paragraph{Compilation and usage}
 
 In order to compile and use the freshly generated model files, change to the
 output directory which can be determined from the interface output (in this
 example, it is \verb?fr_standard_model-WO?). Assuming that \whizard\ is
 available in the binary search path, compilation and installation proceeds as
 described above by executing
 \begin{code}
 ./configure && make && make install
 \end{code}
 The model is now ready and can be used similarly to the builtin
 \whizard\ models. For example, a minimal \whizard\ input file for
 calculating the $e^+e^- \longrightarrow W^+W^-$ scattering cross
 section in the freshly generated model would look like
 \begin{code}
 model = fr_standard_model
 process test = "e+", "e-" -> "W+", "W-"
 sqrts = 500 GeV
 integrate (test)
 \end{code}
 
 %%%%%
 
 \subsubsection{\whizard/\FeynRules\ example: MSSM}
 In this Section, we illustrate the usage of the interface between {\sc
 FeynRules} and {\sc Whizard} in the context of the MSSM. All the
 parameters of the model are then ordered in Les Houches blocks and
 counters following the SUSY Les Houches Accord (SLHA)
 \cite{Skands:2003cj,AguilarSaavedra:2005pw,Allanach:2008qq} (cf. also
 Sec.~\ref{sec:slha}).
 
 After having downloaded the model
 from the \FeynRules\ website, we store it in a new directory, labelled
 \verb"MSSM", of the model library of the local installation of
 \FeynRules. The model can then be loaded in \Mathematica\ as in the
 case of the SM example above
 \begin{code}
 $FeynRulesPath =
         SetDirectory["<path-to-FeynRules>"];
 <<FeynRules`
 LoadModel["Models/MSSM/MSSM.fr"];
 FeynmanGauge = False;
 \end{code}
 %$
 We are again adopting unitarity gauge.
 
 The number of vertices associated to supersymmetric Lagrangians is in general
 very large (several thousands). For such models with many interactions,
 it is recommended to first extract all the Feynman rules of the theory before
 calling the interface between \whizard\ and \FeynRules.
 The reason is related to the efficiency of the interface  which takes
 a lot of time in the extraction of the interaction vertices. In the
 case one wishes to study the phenomenology of several benchmark
 scenarios, this procedure, which is illustrated below,
 allows to use the interface in the best way. The Feynman rules
 are derived from the Lagrangian once and for all and then reused by the
 interface for each set of \whizard\ model files to be produced,
 considerably  speeding up the generation of multiple model files
 issued from a single Lagrangian. In addition, the scalar potential of
 supersymmetric theories contains a large set of four scalar
 interactions, in general irrelevant for collider phenomenology. These
 vertices can be neglected with the help of the
 \verb"Exclude4Scalars->True" option of both interface commands
 \verb"FeynmanRules" and \verb"WriteWOOutput". The Feynman
 rules of the MSSM are then computed within the \Mathematica\ notebook
 by
 \begin{code}
 rules = FeynmanRules[lag,
    Exclude4Scalars->True, FlavorExpand->True];
 \end{code}
 where \verb'lag' is the variable containing the Lagrangian.
 
 By default, all the parameters of the model are set to the value of
 \ttt{1}. A complete parameter \ttt{{\em <slha\_params>}.dat} file
 must therefore be loaded. Such a parameter file can be downloaded from
 the \FeynRules\ website or created by hand by the user, and loaded
 into \FeynRules\ as
 \begin{code}
 ReadLHAFile[Input -> "<slha_params>.dat"];
 \end{code}
 This command does not reduce the size of the model output by removing
 vertices with vanishing couplings.  However, if desired, this task
 could be done with the  \ttt{LoadRestriction} command (see Ref.\
 \cite{Fuks:2012im} for details).
 
 The vertices are exported to \whizard\ by the command
 \begin{code}
 WriteWOOutput[Input -> rules];
 \end{code}
 Note that the numerical values of the parameters of the model can be
 modified directly from \whizard, without having to generate a second
 time the \whizard\ model files from \FeynRules. A \sindarin\ script is
 created by the interface with the help of the instruction
 \begin{code}
 WriteWOExtParams["parameters.sin"];
 \end{code}
 and can be further modified according to the needs of the user.
 
 \subsubsection{\whizard-\FeynRules\ example: Three-Site Higgsless Model}
 
 
 The Three-Site Higgsless model or Minimal Higgsless model (MHM) has
 been implemented into \ttt{LanHEP}~\cite{He:2007ge}, \FeynRules\
 and independently into \whizard~\cite{Speckner:2010zi},
 and the collider phenomenology has been studied by making use of these
 implementations \cite{He:2007ge,Ohl:2010zf,Speckner:2010zi}.
 Furthermore, the independent implementations in \FeynRules\ and
 directly into {\sc Whizard} have been compared and found to
 agree~\cite{Christensen:2010wz}. After the discovery of a Higgs boson
 at the LHC in 2012, such a model is not in good agreement with
 experimental data any more. Here, we simply use it as a guinea pig to
 describe the handling of a model with non-renormalizable interactions
 with the \FeynRules\ interface, and discuss how to generate \whizard\
 model files for it. The model has been implemented in Feynman gauge as
 well as unitarity gauge and contains the variable \verb|FeynmanGauge|
 which can be set to \verb|True|  or \verb|False|. When set to
 \verb|True|, the option \verb|WOGauge-> WOFeynman| must be used, as
 explained in~\cite{Christensen:2010wz}. $R_\xi$ gauge can also be
 accomplished with this model by use of the options
 \verb|WOGauge -> WORxi| and \verb?WOAutoGauge -> True?.
 
 Since this model makes use of a nonlinear sigma field of the form
 \begin{equation}
 \Sigma = 1 + i\pi - \frac{1}{2}\pi^2+\cdots
 \end{equation}
 many higher dimensional operators are included in the model which are
 not currently not supported by \whizard. Even for a future release of
 \whizard\ containing general Lorentz structures in interaction
 vertices, the user would be forced to expand the series only up to a
 certain order. Although \whizard\ can reject these vertices
 and print a warning message to the user, it is preferable to remove
 the vertices right away in the interface by the option
 \verb|MaxCanonicalDimension->4|. This is passed to the command
 \verb|FeynmanRules| and restricts the Feynman rules to those of
 dimension four and smaller\footnote{\ttt{MaxCanonicalDimension} is an
   option of the \ttt{FeynmanRules} function rather than of the
   interface, itself. In fact, the interface accepts all the options of
   {\tt FeynmanRules} and simply passes them on to the latter.}.
 
 As the use of different gauges was already illustrated in the SM
 example, we discuss the model only in Feynman gauge here. We load
 \FeynRules:
 \begin{code}
 $FeynRulesPath =
      SetDirectory["<path-to-FeynRules>"];
 <<FeynRules`
 \end{code}
 %$
 The MHM model itself is then loaded by
 \begin{code}
 SetDirectory["<path-to-MHM>"];
 LoadModel["3-Site-particles.fr",
    "3-Site-parameters.fr",
    "3-Site-lagrangian.fr"];
 FeynmanGauge = True;
 \end{code}
 where \verb|<path-to-MHM>| is the path to the directory where the MHM
 model files are stored and where the output of the \whizard\
 interface will be written. The \whizard\ interface is then initiated:
 \begin{code}
 WriteWOOutput[LGauge, LGold, LGhost, LFermion,
    LGoldLeptons, LGoldQuarks,
    MaxCanonicalDimension->4,
    WOGauge->WOFeynman, WOModelName->"fr_mhm"];
 \end{code}
 where we have also made use of the option \verb|WOModelName| to change
 the name of the model as seen by \whizard. As in the case of the SM,
 the interface begins by writing a short informational message:
 \begin{code}
 Short model name is "fr_mhm"
 Gauge: Feynman
 Generating code for WHIZARD / O'Mega
                        version 2.0.3
 Automagically assigning Goldstone
                         boson masses...
 Maximum number of couplings per FORTRAN
                         module: 500
 Extensive lorentz structure checks disabled.
 \end{code}
 After calculating the Feynman rules and processing the vertices, the
 interface gives a summary:
 \begin{code}
 processed a total of 922 vertices, kept 633
   of them and threw away 289, 289 of which
   contained ghosts.
 \end{code}
 showing that no vertices were missed.  The files are stored in the
 directory \verb|fr_mhm| and are ready to be installed and used with
 \whizard.
 
 %%%%%%%%%%%%%%%
 
 \section{New physics models via the \UFO\ file format}
 \label{sec:ufo}
 
 In this section, we describe how to use the {\em Universal FeynRules
 Output} (\UFO, \cite{Degrande:2011ua}) format for physics models
 inside \whizard. Please refer the manuals of e.g.~\FeynRules\ manual
 for details on how to generate a \UFO\ file for your favorite physics
 model. \UFO\ files are a collection of \ttt{Python} scripts that
 encode the particles, the couplings, the Lorentz structures, the
 decays, as well as parameters, vertices and propagators of the
 corresponding model. They reside in a directory of the exact name of
 the model they have been created from.
 
 If the user wants to generate events for processes from a physics
 model from a \UFO\ file, then this directory of scripts generated by
 \FeynRules\ is immediately available if it is a subdirectory of the working
 directory of \whizard.  The directory name will be taken as the model
 name. (The \UFO-model file name must not start with a
   non-letter character, i.e. especially not a number.  In case such a
   file name wants to be used at all costs, the model name in the
   \sindarin\ script has to put in quotation marks, but this is not
   guaranteed to always work.)  Then, a \UFO\ model named, e.g.,
 \ttt{test\_model} is accessed by an extra \ttt{ufo} tag in the model
 assignment:
 \begin{Code}
   model = test_model (ufo)
 \end{Code}
 
 If desired, \whizard\ can access a directory of \UFO\ files elsewhere
 on the file system.  For instance, if \FeynRules\ output resides in
 the subdirectory \ttt{MyMdl} of
 \ttt{/home/users/john/ufo}, \whizard\ can use the model
 named \ttt{MyMdl} as follows
 \begin{Code}
   model = MyMdl (ufo ('/home/users/john/my_ufo_models'))
 \end{Code}
 that is, the \sindarin\ keyword \ttt{ufo} can take an argument.  Note
 however, that the latter approach can backfire --- in case just the working
 directory is packed and archived for future reference.
 
 %%%%%%%%%%%%%%%
 
 
 
 \clearpage
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 \appendix
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{\sindarin\ Reference}
 
 In the \sindarin\ language, there are certain pre-defined constructors or
 commands that cannot be used in different context by the user, which
 are e.g. \ttt{alias}, \ttt{beams}, \ttt{integrate}, \ttt{simulate} etc.
 A complete list will be given below. Also units are fixed, like
 \ttt{degree}, \ttt{eV}, \ttt{keV},
 \ttt{MeV}, \ttt{GeV}, and \ttt{TeV}. Again, these tags are locked and
 not user-redefinable. Their functionality will be listed in detail
 below, too. Furthermore, a variable with a preceding
 question mark, ?, is a logical, while a preceding dollar, \$, denotes a
 character string variable.  Also, a lot of unary and binary operators
 exist, \ttt{+ - $\backslash$ , = : => < > <= >= \^ \;  () [] \{\} }
 \url{==}, as well as quotation marks, ". Note that the
 different parentheses and brackets fulfill different purposes, which
 will be explained below. Comments in a line can either be marked by a
 hash, \#, or an exclamation mark, !.
 
 \section{Commands and Operators}
 We begin the \sindarin\ reference with all commands, operators, functions
 and constructors.
 The list of variables (which can be set to change behavior of \whizard) can
 be found in the next section.
 \begin{itemize}
 \item
 \ttt{+} \newline
 1) Arithmetic operator for addition of integers, reals and complex
 numbers. Example: \ttt{real mm = mH + mZ} (cf. also \ttt{-}, \ttt{*},
 \ttt{/}, \ttt{\^{}}). 2) It also adds different particles for inclusive
 process containers: \ttt{process foo = e1, E1 => (e2, E2) + (e3,
   E3)}. 3) It also serves as a shorthand notation for the
 concatenation of ($\to$) \ttt{combine} operations on
 particles/subevents, e.g. \ttt{cuts = any 170 GeV < M < 180 GeV [b +
   lepton + invisible]}.
 %%%%%
 \item
 \ttt{-} \newline
 Arithmetic operator for subtraction of integers, reals and complex
 numbers. Example: \ttt{real foo = 3.1 - 5.7} (cf. also \ttt{+}, \ttt{*},
 \ttt{/}, \ttt{\^{}}).
 %%%%%
 \item
 \ttt{/} \newline
 Arithmetic operator for division of integers, reals and complex
 numbers. Example: \ttt{scale = mH / 2} (cf. also \ttt{+}, \ttt{*},
 \ttt{-}, \ttt{\^{}}).
 %%%%%
 \item
 \ttt{*} \newline
 Arithmetic operator for multiplication of integers, reals and complex
 numbers. Example: \ttt{complex z = 2 * I} (cf. also \ttt{+}, \ttt{/},
 \ttt{-}, \ttt{\^{}}).
 %%%%%
 \item
 \ttt{\^{}} \newline
 Arithmetic operator for exponentiation of integers, reals and complex
 numbers. Example: \ttt{real z = x\^{}2 + y\^{}2} (cf. also \ttt{+},
 \ttt{/}, \ttt{-}, \ttt{\^{}}).
 %%%%%
 \item
 \ttt{<} \newline
 Arithmetic comparator between values that checks for ordering
 of two values: \ttt{{\em <val1>} < {\em <val2>}} tests whether
 \ttt{{\em val1}} is smaller than \ttt{{\em val2}}. Allowed for
 integer and real values. Note that this is an exact comparison if
 \ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
 it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
 \ttt{==}, \ttt{>}, \ttt{>=}, \ttt{<=})
 %%%%%
 \item
 \ttt{>} \newline
 Arithmetic comparator between values that checks for ordering
 of two values: \ttt{{\em <val1>} > {\em <val2>}} tests whether
 \ttt{{\em val1}} is larger than \ttt{{\em val2}}. Allowed for
 integer and real values. Note that this is an exact comparison if
 \ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
 it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
 \ttt{==}, \ttt{>}, \ttt{>=}, \ttt{<=})
 %%%%%
 \item
 \ttt{<=} \newline
 Arithmetic comparator between values that checks for ordering
 of two values: \ttt{{\em <val1>} <= {\em <val2>}} tests whether
 \ttt{{\em val1}} is smaller than or equal \ttt{{\em val2}}. Allowed for
 integer and real values. Note that this is an exact comparison if
 \ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
 it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
 \ttt{==}, \ttt{>}, \ttt{<}, \ttt{>=})
 %%%%%
 \item
 \ttt{>=} \newline
 Arithmetic comparator between values that checks for ordering
 of two values: \ttt{{\em <val1>} >= {\em <val2>}} tests whether
 \ttt{{\em val1}} is larger than or equal \ttt{{\em val2}}. Allowed for
 integer and real values. Note that this is an exact comparison if
 \ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
 it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
 \ttt{==}, \ttt{>}, \ttt{<}, \ttt{>=})
 %%%%%
 \item
 \ttt{==} \newline
 Arithmetic comparator between values that checks for identity
 of two values: \ttt{{\em <val1>} == {\em <val2>}}. Allowed for
 integer and real values. Note that this is an exact comparison if
 \ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
 it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
 \ttt{>}, \ttt{<}, \ttt{>=}, \ttt{<=})
 %%%%%
 \item
 \ttt{<>} \newline
 Arithmetic comparator between values that checks for
 two values being unequal: \ttt{{\em <val1>} <> {\em <val2>}}. Allowed for
 integer and real values. Note that this is an exact comparison if
 \ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
 it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{==},
 \ttt{>}, \ttt{<}, \ttt{>=}, \ttt{<=})
 %%%%%
 \item
 \ttt{!} \newline
 The exclamation mark tells \sindarin\ that everything that follows in
 that line should be treated as a comment. It is the same as ($\to$)
 \ttt{\#}.
 %%%%%
 \item
 \ttt{\#} \newline
 The hash tells \sindarin\ that everything that follows in
 that line should be treated as a comment. It is the same as ($\to$)
 \ttt{!}.
 %%%%%
 \item
 \ttt{\&} \newline
 Concatenates two or more particle lists/subevents and hence acts in
 the same way as the subevent function ($\to$) \ttt{join}: \ttt{let
 @visible = [photon] \& [colored] \& [lepton] in ...}. (cf. also
 \ttt{join}, \ttt{combine}, \ttt{collect}, \ttt{extract}, \ttt{sort}).
 %%%%%
 \item
 \ttt{\$} \newline
 Constructor at the beginning of a variable name,
 \ttt{\${\em <string\_var>}}, that specifies a string variable.
 %%%%%
 \item
 \ttt{@} \newline
 Constructor at the beginning of a variable name, \ttt{@{\em
 <subevt\_var>}}, that specifies a subevent variable, e.g. \ttt{let
 @W\_candidates = combine ["mu-", "numubar"] in ...}.
 %%%%%
 \item
 \ttt{=} \newline
 Binary constructor to appoint values to commands, e.g. \ttt{{\em <command>}
   = {\em <expr>}} or \newline \ttt{{\em <command>} {\em <var\_name>} =
   {\em <expr>}}.
 %%%%%
 \item
 \ttt{\%} \newline
 Constructor that gives the percentage of a number, so in
 principle multiplies a real number by \ttt{0.01}. Example: \ttt{1.23
   \%} is equal to \ttt{0.0123}.
 %%%%%
 \item
 \ttt{:} \newline
 Separator in alias expressions for particles, e.g. \ttt{alias neutrino
   = n1:n2:n3:N1:N2:N3}. (cf. also \ttt{alias})
 %%%%%
 \item
 \ttt{;} \newline
 Concatenation operator for logical expressions: \ttt{{\em lexpr1} ;
   {\em lexpr2}}. Evaluates \ttt{{\em lexpr1}} and throws the result
 away, then evaluates \ttt{{\em lexpr2}} and returns that result. Used
 in analysis expressions. (cf. also \ttt{analysis}, \ttt{record})
 %%%%%
 \item
 \ttt{/+} \newline
 Incrementor for ($\to$) \ttt{scan} ranges, that increments additively,
 \ttt{scan {\em <num\_spec> <num>} = ({\em <lower val>} => {\em <upper
     val>} /+ {\em <step
 size>})}. E.g. \ttt{scan int i = (1 => 5 /+ 2)} scans over the values \ttt{1},
 \ttt{3}, \ttt{5}. For real ranges, it divides the interval between
 upper and lower bound into as many intervals as the incrementor
 provides, e.g. \ttt{scan real r = (1 => 1.5 /+ 0.2)} runs over
 \ttt{1.0}, \ttt{1.333}, \ttt{1.667}, \ttt{1.5}.
 %%%%%
 \item
 \ttt{/+/} \newline
 Incrementor for ($\to$) \ttt{scan} ranges, that increments additively,
 but the number after the incrementor is the number of steps, not the
 step size: \ttt{scan {\em <num\_spec> <num>} = ({\em <lower val>} =>
   {\em <upper val>}
 /+/ {\em <steps>})}. It is only available for real scan ranges, and divides
 the interval \ttt{{\em <upper val>} - {\em <lower val>}} into
 \ttt{{\em <steps>}} steps,
 e.g. \ttt{scan real r = (1 => 1.5 /+/ 3)} runs over \ttt{1.0},
 \ttt{1.25}, \ttt{1.5}.
 %%%%%
 \item
 \ttt{/-} \newline
 Incrementor for ($\to$) \ttt{scan} ranges, that increments subtractively,
 \ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>} /- {\em <step
 size>})}. E.g. \ttt{scan int i = (9 => 0 /+ 3)} scans over the values \ttt{9},
 \ttt{6}, \ttt{3}, \ttt{0}. For real ranges, it divides the interval
 between upper and lower bound into as many intervals as the incrementor
 provides, e.g. \ttt{scan real r = (1 => 0.5 /- 0.2)} runs over
 \ttt{1.0}, \ttt{0.833}, \ttt{0.667}, \ttt{0.5}.
 %%%%%
 \item
 \ttt{/*} \newline
 Incrementor for ($\to$) \ttt{scan} ranges, that increments multiplicatively,
 \ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>} /* {\em <step
 size>})}. E.g. \ttt{scan int i = (1 => 4 /* 2)} scans over the values \ttt{1},
 \ttt{2}, \ttt{4}. For real ranges, it divides the interval
 between upper and lower bound into as many intervals as the incrementor
 provides, e.g. \ttt{scan real r = (1 => 5 /* 2)} runs over
 \ttt{1.0}, \ttt{2.236} (i.e. $\sqrt{5}$), \ttt{5.0}.
 %%%%%
 \item
 \ttt{/*/} \newline
 Incrementor for ($\to$) \ttt{scan} ranges, that increments multiplicatively,
 but the number after the incrementor is the number of steps, not the
 step size: \ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>}
 /*/ {\em <steps>})}. It is only available for real scan ranges, and divides
 the interval \ttt{{\em <upper val>} - {\em <lower val>}} into \ttt{{\em <steps>}} steps,
 e.g. \ttt{scan real r = (1 => 9 /*/ 4)} runs over \ttt{1.000},
 \ttt{2.080}, \ttt{4.327}, \ttt{9.000}.
 %%%%%
 \item
 \ttt{//} \newline
 Incrementor for ($\to$) \ttt{scan} ranges, that increments by division,
 \ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>} // {\em <step
 size>})}. E.g. \ttt{scan int i = (13 => 0 // 3)} scans over the values \ttt{13},
 \ttt{4}, \ttt{1}, \ttt{0}. For real ranges, it divides the interval
 between upper and lower bound into as many intervals as the incrementor
 provides, e.g. \ttt{scan real r = (5 => 1 // 2)} runs over
 \ttt{5.0}, \ttt{2.236} (i.e. $\sqrt{5}$), \ttt{1.0}.
 %%%%%
 \item
 \ttt{=>} \newline
 Binary operator that is used in several different contexts: 1) in
 process declarations between the particles specifying the
 initial and final state, e.g. \ttt{process {\em <proc\_name>} = {\em <in1>}, {\em <in2>}
 => {\em <out1>}, ....}; 2) for the specification of beams when
 structure functions are applied to the beam particles, e.g. \ttt{beams
 = p, p => pdf\_builtin}; 3) for the specification of the scan range in
 the \ttt{scan {\em <var>} {\em <var\_name>} = ({\em <scan\_start>} => {\em <scan\_end>}
   {\em <incrementor>})} (cf. also \ttt{process}, \ttt{beams}, \ttt{scan})
 %%%%%
 \item
 \ttt{\%d} \newline
 Format specifier in analogy to the \ttt{C} language for the print out
 on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
 \ttt{sprintf} command. It is used for decimal integer numbers,
 e.g. \ttt{printf "one = \%d" (i)}. The difference between \ttt{\%i}
 and \ttt{\%d} does not play a role here. (cf. also \ttt{printf}, \ttt{sprintf},
 \ttt{\%i}, \ttt{\%e}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
 \ttt{\%G}, \ttt{\%s})
 %%%%%
 \item
 \ttt{\%e} \newline
 Format specifier in analogy to the \ttt{C} language for the print out
 on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
 \ttt{sprintf} command. It is used for floating-point numbers in
 standard form \ttt{[-]d.ddd e[+/-]ddd}. Usage e.g. \ttt{printf "pi =
 \%e" (PI)}.  (cf. also \ttt{printf}, \ttt{sprintf},
 \ttt{\%d}, \ttt{\%i}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
 \ttt{\%G}, \ttt{\%s})
 %%%%%
 \item
 \ttt{\%E} \newline
 Same as ($\to$) \ttt{\%e}, but using upper-case letters.  (cf. also
 \ttt{printf}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f},
 \ttt{\%g}, \ttt{\%F}, \ttt{\%G}, \ttt{\%s})
 %%%%%
 \item
 \ttt{\%f} \newline
 Format specifier in analogy to the \ttt{C} language for the print out
 on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
 \ttt{sprintf} command. It is used for floating-point numbers in
 fixed-point form. Usage e.g. \ttt{printf "pi =
 \%f" (PI)}.  (cf. also \ttt{printf}, \ttt{sprintf},
 \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
 \ttt{\%G}, \ttt{\%s})
 %%%%%
 \item
 \ttt{\%F} \newline
 Same as ($\to$) \ttt{\%f}, but using upper-case letters.  (cf. also
 \ttt{printf}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f},
 \ttt{\%g}, \ttt{\%E}, \ttt{\%G}, \ttt{\%s})
 %%%%%
 \item
 \ttt{\%g} \newline
 Format specifier in analogy to the \ttt{C} language for the print out
 on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
 \ttt{sprintf} command. It is used for floating-point numbers in
 normal or exponential notation, whichever is more approriate. Usage
 e.g. \ttt{printf "pi = \%g" (PI)}.  (cf. also \ttt{printf}, \ttt{sprintf},
 \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f}, \ttt{\%E}, \ttt{\%F},
 \ttt{\%G}, \ttt{\%s})
 %%%%%
 \item
 \ttt{\%G} \newline
 Same as ($\to$) \ttt{\%g}, but using upper-case letters.  (cf. also
 \ttt{printf}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f},
 \ttt{\%g}, \ttt{\%E}, \ttt{\%F}, \ttt{\%s})
 %%%%%
 \item
 \ttt{\%i} \newline
 Format specifier in analogy to the \ttt{C} language for the print out
 on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
 \ttt{sprintf} command. It is used for integer numbers,
 e.g. \ttt{printf "one = \%i" (i)}. The difference between \ttt{\%i}
 and \ttt{\%d} does not play a role here. (cf. \ttt{printf}, \ttt{sprintf},
 \ttt{\%d}, \ttt{\%e}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
 \ttt{\%G}, \ttt{\%s})
 %%%%%
 \item
 \ttt{\%s} \newline
 Format specifier in analogy to the \ttt{C} language for the print out
 on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
 \ttt{sprintf} command. It is used for logical or string variables
 e.g. \ttt{printf "foo = \%s" (\$method)}. (cf. \ttt{printf}, \ttt{sprintf},
 \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
 \ttt{\%G})
 %%%%%
 \item
 \ttt{abarn} \newline
 Physical unit, stating that a number is in attobarns ($10^{-18}$
 barn). (cf. also \ttt{nbarn}, \ttt{fbarn}, \ttt{pbarn})
 %%%%%
 \item
 \ttt{abs} \newline
 Numerical function that takes the absolute value of its argument:
 \ttt{abs ({\em <num\_val>})} yields \ttt{|{\em
 <num\_val>}|}. (cf. also \ttt{conjg}, \ttt{sgn}, \ttt{mod}, \ttt{modulo})
 %%%%%
 \item
 \ttt{acos} \newline
 Numerical function \ttt{asin ({\em <num\_val>})} that calculates the
 arccosine trigonometric function (inverse of \ttt{cos}) of real and
 complex numerical numbers or variables. (cf. also \ttt{sin},
 \ttt{cos}, \ttt{tan}, \ttt{asin}, \ttt{atan})
 %%%%%
 \item
 \ttt{alias} \newline
 This allows to define a collective expression for a class of
 particles, e.g. to define a generic expression for leptons, neutrinos
 or a jet as \ttt{alias lepton = e1:e2:e3:E1:E2:E3}, \ttt{alias
 neutrino = n1:n2:n3:N1:N2:N3}, and \ttt{alias jet =
 u:d:s:c:U:D:S:C:g}, respectively.
 %%%%%
 \item
 \ttt{all} \newline
 \ttt{all} is a function that works on a logical expression and a list,
 \ttt{all {\em <log\_expr>} [{\em <list>}]}, and returns \ttt{true} if and only if
 \ttt{log\_expr} is fulfilled for {\em all} entries in \ttt{list}, and
 \ttt{false} otherwise. Examples: \ttt{all Pt > 100 GeV [lepton]}
 checks whether all leptons are harder than 100 GeV, \ttt{all Dist > 2
   [u:U, d:D]} checks whether all pairs of corresponding quarks
 are separated in $R$ space by more than 2. Logical expressions with
 \ttt{all} can be logically combined with \ttt{and} and
 \ttt{or}. (cf. also \ttt{any}, \ttt{and}, \ttt{no}, and \ttt{or})
 %%%%%
 \item
 \ttt{alt\_setup} \newline
 This command allows to specify alternative setups for a process/list
 of processes, \ttt{alt\_setup = \{ {\em <setup1>} \} [, \{ {\em <setup2>} \} ,
   ...]}. An alternative setup can be a resetting of a coupling
 constant, or different cuts etc. It can be particularly used in a
 ($\to$) \ttt{rescan} procedure.
 %%%%%
 \item
 \ttt{analysis} \newline
 This command, \ttt{analysis = {\em <log\_expr>}}, allows to define an
 analysis as a logical expression, with a syntax similar to the ($\to$)
 \ttt{cuts} or ($\to$) \ttt{selection} command. Note that a ($\to$)
 formally is a logical expression.
 %%%%%
 \item
 \ttt{and} \newline
 This is the standard two-place logical connective that has the value
 true if both of its operands are true, otherwise a value of false. It
 is applied to logical values, e.g. cut expressions. (cf. also
 \ttt{all}, \ttt{no}, \ttt{or}).
 %%%%%
 \item
 \ttt{any} \newline
 \ttt{any} is a function that works on a logical expression and a list,
 \ttt{any {\em <log\_expr>} [{\em <list>}]}, and returns \ttt{true} if
 \ttt{log\_expr} is fulfilled for any entry in \ttt{list}, and
 \ttt{false} otherwise. Examples: \ttt{any PDG == 13 [lepton]} checks
 whether any lepton is a muon, \ttt{any E > 2 * mW [jet]} checks
 whether any jet has an energy of twice the $W$ mass. Logical
 expressions with \ttt{any} can be logically combined with \ttt{and}
 and \ttt{or}. (cf. also \ttt{all}, \ttt{and}, \ttt{no}, and \ttt{or})
 %%%%%
 \item
 \ttt{as} \newline
 cf. \ttt{compile}
 %%%%%
 \item
 \ttt{ascii} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of the standard \whizard\ verbose/debug ASCII event
 files. (cf. also \ttt{\$sample}, \ttt{\$sample\_normalization},
 \ttt{sample\_format})
 %%%%%
 \item
 \ttt{asin} \newline
 Numerical function \ttt{asin ({\em <num\_val>})} that calculates the
 arcsine trigonometric function (inverse of \ttt{sin}) of real and
 complex numerical numbers or variables. (cf. also \ttt{sin},
 \ttt{cos}, \ttt{tan}, \ttt{acos}, \ttt{atan})
 %%%%%
 \item
 \ttt{atan} \newline
 Numerical function \ttt{atan ({\em <num\_val>})} that calculates the
 arctangent trigonometric function (inverse of \ttt{tan}) of real and
 complex numerical numbers or variables. (cf. also \ttt{sin},
 \ttt{cos}, \ttt{tan}, \ttt{asin}, \ttt{acos})
 %%%%%
 \item
 \ttt{athena} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of the ATHENA variant for HEPEVT ASCII event
 files. (cf. also \ttt{\$sample}, \ttt{\$sample\_normalization},
 \ttt{sample\_format})
 %%%%%
 \item
 \ttt{beam} \newline
 Constructor that specifies a particle (in a subevent) as beam particle. It is
 used in cuts, analyses or selections, e.g. \ttt{cuts = all Theta > 20
 degree [beam lepton, lepton]}. (cf. also \ttt{incoming}, \ttt{outgoing},
 \ttt{cuts}, \ttt{analysis}, \ttt{selection}, \ttt{record})
 %%%%%
 \item
 \ttt{beam\_events} \newline
 Beam structure specifier to read in lepton collider beamstrahlung's
 spectra from external files as pairs of energy fractions: \ttt{beams:
   e1, E1 => beam\_events}. Note that this is a pair spectrum that has to
 be applied to both beams simultaneously. (cf. also \ttt{beams},
 \ttt{\$beam\_events\_file}, \ttt{?beam\_events\_warn\_eof})
 %%%%%
 \item
 \ttt{beams} \newline
 This specifies the contents and structure of the beams: \ttt{beams =
   {\em <prt1>}, {\em <prt2>} [ => {\em <str\_fun1>} ....]}. If this
 command is absent in the input file, \whizard\ automatically takes the
 two incoming partons (or one for decays) of the corresponding process
 as beam particles, and no structure functions are applied. Protons and
 antiprotons as beam particles are predefined as \ttt{p} and
 \ttt{pbar}, respectively. A structure function, like \ttt{pdf\_builtin},
 \ttt{ISR}, \ttt{EPA} and so on are switched on as e.g. \ttt{beams = p,
 p => lhapdf}. Structure functions can be specified for one of the two
 beam particles only, of the structure function is not a
 spectrum. (cf. also \ttt{beams\_momentum}, \ttt{beams\_theta},
 \ttt{beams\_phi}, \ttt{beams\_pol\_density},
 \ttt{beams\_pol\_fraction}, \ttt{beam\_events}, \ttt{circe1},
 \ttt{circe2}, \ttt{energy\_scan}, \ttt{epa}, \ttt{ewa}, \ttt{isr},
 \ttt{lhapdf}, \ttt{pdf\_builtin}).
 %%%%%
 \item
 \ttt{beams\_momentum} \newline
 Command to set the momenta (or energies) for the two beams of a
 scattering process: \ttt{beams\_momentum = {\em <mom1>}, {\em <mom2>}} to allow
 for asymmetric beam setups (e.g. HERA: \ttt{beams\_momentum = 27.5
   GeV, 920 GeV}). Two arguments must be present
 for a scattering process, but the command can be used with one
 argument to integrate and simulate a decay of a moving
 particle. (cf. also \ttt{beams}, \ttt{beams\_theta},
 \ttt{beams\_phi}, \ttt{beams\_pol\_density},
 \ttt{beams\_pol\_fraction})
 %%%%%
 \item
 \ttt{beams\_phi} \newline
 Same as ($\to$) \ttt{beams\_theta}, but to allow for a non-vanishing
 beam azimuth angle, too. (cf. also \ttt{beams}, \ttt{beams\_theta},
 \ttt{beams\_momentum}, \ttt{beams\_pol\_density},
 \ttt{beams\_pol\_fraction})
 %%%%%
 \item
 \ttt{beams\_pol\_density} \newline
 This command allows to specify the initial state for polarized beams
 by the syntax: \ttt{beams\_pol\_density = @({\em <pol\_spec\_1>}),
   @({\em <pol\_spec\_2>})}. Two polarization specifiers are mandatory for
 scattering, while one can be used for decays from polarized
 probes. The specifier \ttt{{\em <pol\_spec\_i>}} can be empty (no
 polarization), has one entry (for a definite helicity/spin
 orientation), or ranges of entries of a spin density matrix. The
 command can be used globally, or as a local argument of the
 \ttt{integrate} command. For detailed information, see
 Sec.~\ref{sec:initialpolarization}. It is also possible to use
 variables as placeholders in the specifiers. Note that polarization is
 assumed to be complete, for partial polarization use ($\to$)
 \ttt{beams\_pol\_fraction}. (cf. also \ttt{beams}, \ttt{beams\_theta},
 \ttt{beams\_phi}, \ttt{beams\_momentum}, \ttt{beams\_pol\_fraction})
 %%%%%
 \item
 \ttt{beams\_pol\_fraction} \newline
 This command allows to specify the amount of polarization when using
 polarized beams ($\to$ \ttt{beams\_pol\_density}). The syntax is:
 \ttt{beams\_pol\_fraction = {\em <frac\_1>}, {\em <frac\_2>}}. Two fractions must
 be present for scatterings, being real numbers between \ttt{0} and
 \ttt{1}. A specification with percentage is also possible,
 e.g. \ttt{beams\_pol\_fraction = 80\%, 40\%}. (cf. also \ttt{beams},
 \ttt{beams\_theta}, \ttt{beams\_phi}, \ttt{beams\_momentum},
 \ttt{beams\_pol\_density})
 %%%%%
 \item
 \ttt{beams\_theta} \newline
 Command to set a crossing angle (with respect to the $z$ axis) for one
 or both of the beams of a
 scattering process: \ttt{beams\_theta = {\em <angle1>}, {\em <angle2>}} to allow
 for asymmetric beam setups (e.g. \ttt{beams\_angle = 0, 10
 degree}). Two arguments must be present for a scattering process, but
 the command can be used with one argument to integrate and simulate a
 decay of a moving particle. (cf. also \ttt{beams}, \ttt{beams\_phi},
 \ttt{beams\_momentum}, \ttt{beams\_pol\_density},
 \ttt{beams\_pol\_fraction})
 %%%%%
 \item
 \ttt{by} \newline
 Constructor that replaces the default sorting criterion (according to
 PDG codes) of the ($\to$) \ttt{sort} function on particle
 lists/subevents by one given by a unary or binary particle observable:
 \ttt{sort by {\em <observable>} [{\em <particles>} [, {\em
 <ref\_particles>}] ]}. (cf. also \ttt{sort}, \ttt{extract}, \ttt{join},
 \ttt{collect}, \ttt{combine}, \ttt{+})
 %%%%%
 \item
 \ttt{ceiling} \newline
 This is a function \ttt{ceiling ({\em <num\_val>})} that gives the
 least integer greater than or equal to \ttt{{\em <num\_val>}},
 e.g. \ttt{int i = ceiling (4.56789)} gives \ttt{i = 5}. (cf. also
 \ttt{int}, \ttt{nint}, \ttt{floor})
 %%%%%
 \item
 \ttt{circe1} \newline
 Beam structure specifier for the \circeone\ structure function for
 beamstrahlung at a linear lepton collider: \ttt{beams = e1, E1 =>
 circe1}. Note that this is a pair spectrum, so the specifier acts for
 both beams simultaneously. (cf. also \ttt{beams}, \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})
 %%%%%
 \item
 \ttt{circe2} \newline
 Beam structure specifier for the lepton-collider structure function
 for photon spectra, \circetwo: \ttt{beams = A, A => circe2}. Note that
 this is a pair spectrum, an application to only one beam is not
 possible. (cf. also \ttt{beams}, \ttt{?circe2\_polarized},
 \ttt{\$circe2\_file}, \ttt{\$circe2\_design})
 %%%%%
 \item
 \ttt{clear} \newline
 This command allows to clear a variable set before: \ttt{clear
 ({\em <clearable var.>})} resets the variable \ttt{{\em <clearable var.>}} which
 could be the \ttt{beams}, the \ttt{unstable} settings, \ttt{sqrts},
 any kind of \ttt{cuts} or \ttt{scale} expressions, any user-set
 variable etc. The syntax of the command is completely analogous to
 ($\to$) \ttt{show}.
 %%%%%
 \item
 \ttt{close\_out} \newline
 With the command, \ttt{close\_out ("{\em <out\_file">})} user-defined
 information like data or ($\to$) \ttt{printf} statements can be
 written out to a user-defined file. The command closes an I/O stream to
 an external file \ttt{{\em <out\_file>}}. (cf. also \ttt{open\_out},
 \ttt{\$out\_file}, \ttt{printf})
 %%%%%
 \item
 \ttt{cluster} \newline
 Command that allows to cluster all particles in a subevent to a set of
 jets: \ttt{cluster [{\em<particles>}]}. It also to cluster particles
 subject to a certain boolean condition, \ttt{cluster if
   {\em<condition>} [{\em<particles>}]}. At the moment only available
 if the \fastjet\ package is linked.
 (cf. also \ttt{jet\_r}, \ttt{combine}, \ttt{jet\_algorithm},
 \ttt{kt\_algorithm}, \newline \ttt{cambridge\_[for\_passive\_]algorithm},
 \ttt{antikt\_algorithm}, \ttt{plugin\_algorithm}, \newline
 \ttt{genkt\_[for\_passive\_]algorithm},
 \ttt{ee\_kt\_algorithm}, \ttt{ee\_genkt\_algorithm},
 \ttt{?keep\_flavors\_when\_clustering})
 %%%%%
 \item
 \ttt{collect} \newline
 The \ttt{collect [{\em <list>}]} operation collects all particles in
 the list \ttt{{\em <list>}} into a one-entry subevent with a
 four-momentum of the sum of all four-momenta of non-overlapping
 particles in \ttt{{\em <list>}}. (cf. also \ttt{combine},
 \ttt{select}, \ttt{extract}, \ttt{sort})
 %%%%%
 \item
 \ttt{complex} \newline
 Defines a complex variable. The syntax is e.g. \ttt{complex x = 2 + 3
   * I}. (cf.~also \ttt{int}, \ttt{real})
 %%%%%
 \item
 \ttt{combine} \newline
 The \ttt{combine [{\em <list1>}, {\em <list2>}]} operation makes a particle list
 whose entries are the result of adding (the momenta of) each pair of
 particles in the two input lists \ttt{list1}, {list2}. For example,
 \ttt{combine [incoming lepton, lepton]} constructs all mutual pairings
 of an incoming lepton with an outgoing lepton (an alias for the
 leptons has to be defined, of course). (cf. also \ttt{collect},
 \ttt{select}, \ttt{extract}, \ttt{sort}, \ttt{+})
 %%%%%
 \item
 \ttt{compile} \newline
 The \ttt{compile ()} command has no arguments (the parentheses can
 also been left out: /\ttt{compile ()}. The command is optional, it
 invokes the compilation of the process(es) (i.e. the matrix element
 file(s)) to be compiled as a shared library. This shared object file
 has the standard name \ttt{default\_lib.so} and resides in the
 \ttt{.libs} subdirectory of the corresponding user workspace. If the
 user has defined a different library name \ttt{lib\_name} with the
 \ttt{library} command, then WHIZARD compiles this as the shared object
 \ttt{.libs/lib\_name.so}. (This allows to split process classes and to
 avoid too large libraries.)
 Another possibility is to use the command \ttt{compile as
   "static\_name"}. This will compile and link the process library in a
 static way and create the static executable \ttt{static\_name} in the
 user workspace. (cf. also \ttt{library})
 %%%%%
 \item
 \ttt{compile\_analysis} \newline
 The \ttt{compile\_analysis} statement does the same as
 the \ttt{write\_analysis} command, namely to tell \whizard\ to write
 the analysis setup by the user for the \sindarin\ input file under
 consideration. If no \ttt{\$out\_file} is provided, the histogram
 tables/plot data etc. are written to the default file
 \ttt{whizard\_analysis.dat}. In addition to \ttt{write\_analysis},
 \ttt{compile\_analysis} also invokes the \whizard\ \LaTeX routines for
 producing postscript or PDF output of the data (unless the flag
 $\rightarrow$ \ttt{?analysis\_file\_only} is set to \ttt{true}).
 (cf. also \ttt{\$out\_file}, \ttt{write\_analysis},
 \ttt{?analysis\_file\_only})
 %%%%%
 \item
 \ttt{conjg} \newline
 Numerical function that takes the complex conjugate of its argument:
 \ttt{conjg ({\em <num\_val>})} yields \ttt{{\em
 <num\_val>}$^\ast$}. (cf. also \ttt{abs}, \ttt{sgn}, \ttt{mod}, \ttt{modulo})
 %%%%%
 \item
 \ttt{cos} \newline
 Numerical function \ttt{cos ({\em <num\_val>})} that calculates the
 cosine trigonometric function of real and complex numerical numbers or
 variables. (cf. also \ttt{sin}, \ttt{tan}, \ttt{asin}, \ttt{acos},
 \ttt{atan})
 %%%%%
 \item
 \ttt{cosh} \newline
 Numerical function \ttt{cosh ({\em <num\_val>})} that calculates the
 hyperbolic cosine function of real and complex numerical numbers or
 variables. Note that its inverse function is part of the
 \ttt{Fortran2008} status and hence not realized. (cf. also \ttt{sinh},
 \ttt{tanh})
 %%%%%
 \item
 \ttt{count} \newline
 Subevent function that counts the number of particles or particle
 pairs in a subevent: \ttt{count [{\em <particles\_1>} [, {\em
 <particles\_2>}]]}. This can also be a counting subject to a
 condition: \ttt{count if {\em <condition>} [{\em <particles\_1>} [,
 {\em <particles\_2>}]]}.
 %%%%%
 \item
 \ttt{cuts} \newline
 This command defines the cuts to be applied to certain processes. The
 syntax is: \ttt{cuts = {\em <log\_class>} {\em <log\_expr>} [{\em <unary or binary
   particle (list) arg>}]}, where the cut expression must be initialized
 with a logical classifier \ttt{log\_class} like \ttt{all}, \ttt{any},
 \ttt{no}. The logical expression \ttt{log\_expr} contains the cut to
 be evaluated. Note that this need not only be a kinematical cut
 expression like \ttt{E > 10  GeV} or \ttt{5 degree < Theta < 175
   degree}, but can also be some sort of trigger expression or event
 selection, e.g. \ttt{PDG == 15} would select a tau lepton.  Whether the
 expression is evaluated on particles or pairs of particles depends on
 whether the discriminating variable is unary or binary, \ttt{Dist}
 being obviously binary, \ttt{Pt} being unary. Note that some variables
 are both unary and binary, e.g. the invariant mass $M$. Cut
 expressions can be connected by the logical  connectives \ttt{and} and
 \ttt{or}. The \ttt{cuts} statement acts on all subsequent process
 integrations and analyses until a new \ttt{cuts} statement appears.
 (cf. also \ttt{all}, \ttt{any},
 \ttt{Dist}, \ttt{E}, \ttt{M},
 \ttt{no}, \ttt{Pt}).
 %%%%%
 \item
 \ttt{debug} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of the very verbose \whizard\ ASCII event
 file format intended for debugging. (cf. also \ttt{\$sample},
 \ttt{sample\_format}, \ttt{\$sample\_normalization})
 %%%%%
 \item
 \ttt{degree} \newline
 Expression specifying the physical unit of degree for angular
 variables, e.g. the cut expression function \ttt{Theta}. (if no unit is
 specified for angular variables, radians are used; cf. \ttt{rad}, \ttt{mrad}).
 %%%%
 \item
 \ttt{Dist} \newline
 Binary observable specifier, that gives the $\eta$-$\phi$-
 (pseudorapidity-azimuth) distance $R = \sqrt{(\Delta \eta)^2 +
 (\Delta\phi)^2}$ between the momenta of the two particles: \ttt{eval
 Dist [jet, jet]}. (cf. also \ttt{eval}, \ttt{cuts}, \ttt{selection},
 \ttt{Theta}, \ttt{Eta}, \ttt{Phi})
 %%%%%
 \item
 \ttt{dump} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of the intrinsic \whizard\ event record format
 (output of the \ttt{particle\_t} type container). (cf. also
 \ttt{\$sample}, \ttt{sample\_format}, \ttt{\$sample\_normalization}
 %%%%%
 \item
 \ttt{E} \newline
 Unary (binary) observable specifier for the energy of a single
 (two) particle(s), e.g. \ttt{eval E ["W+"]}, \ttt{all E > 200 GeV [b,
   B]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
 %%%%%
 \item
 \ttt{else} \label{sindarin_else}\newline
 Constructor for providing an alternative in a conditional clause:
 \ttt{if {\em <log\_expr>} then {\em <expr 1>} else {\em <expr 2>} endif}. (cf. also
 \ttt{if}, \ttt{elsif}, \ttt{endif}, \ttt{then}).
 %%%%%
 \item
 \ttt{elsif} \newline
 Constructor for concatenating more than one conditional clause with
 each other: \ttt{if {\em <log\_expr 1>} then {\em <expr 1>} elsif {\em <log\_expr 2>}
 then {\em <expr 2>} \ldots endif}. (cf. also \ttt{if}, \ttt{else},
 \ttt{endif}, \ttt{then}).
 %%%%%
 \item
 \ttt{endif} \newline
 Mandatory constructor to conclude a conditional clause: \ttt{if
   {\em <log\_expr>} then \ldots endif}. (cf. also \ttt{if},
 \ttt{else}, \ttt{elsif}, \ttt{then}).
 %%%%%
 \item
 \ttt{energy\_scan} \newline
 Beam structure specifier for the energy scan structure function:
 \ttt{beams = e1, E1 => energy\_scan}. This pair spectrum that has to
 be applied to both beams simultaneously can be used to scan over a
 range of collider energies without using the \ttt{scan} command.
 (cf. also \ttt{beams}, \ttt{scan}, \ttt{?energy\_scan\_normalize})
 %%%%%
 \item
 \ttt{epa} \newline
 Beam structure specifier for the equivalent-photon approximation
 (EPA), i.e the Weizs\"acker-Williams structure function:
 e.g. \ttt{beams = e1, E1 => epa} (applied to both beams), or
 e.g. \ttt{beams = e1, u => epa, none} (applied to only one
 beam). (cf. also \ttt{beams}, \ttt{epa\_alpha}, \ttt{epa\_x\_min},
 \ttt{epa\_mass}, \ttt{epa\_q\_max}, \ttt{epa\_q\_min},
 \ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})
 %%%%%
 \item
 \ttt{Eta} \newline
 Unary and also binary observable specifier, that as a unary observable
 gives the pseudorapidity of a particle momentum. The pseudorapidity is
 given by $\eta = - \log \left[ \tan (\theta/2) \right]$, where
 $\theta$ is the angle with the beam direction. As a binary
 observable, it gives the pseudorapidity difference between the momenta
 of two particles, where $\theta$ is the enclosed angle: \ttt{eval Eta
 [e1]},  \ttt{all abs (Eta) < 3.5 [jet, jet]}. (cf. also \ttt{eval},
 \ttt{cuts}, \ttt{selection}, \ttt{Rap}, \ttt{abs})
 %%%%%
 \item
 \ttt{eV} \newline
 Physical unit, stating that the corresponding number is in electron
 volt. (cf. also \ttt{keV}, \ttt{meV}, \ttt{MeV}, \ttt{GeV}, \ttt{TeV})
 %%%%%
 \item
 \ttt{eval} \newline
 Evaluator that tells \whizard\ to evaluate the following expr:
 \ttt{eval {\em <expr>}}. Examples are: \ttt{eval Rap [e1]}, \ttt{eval
   M / 1 GeV [combine [q,Q]]} etc. (cf. also \ttt{cuts},
 \ttt{selection}, \ttt{record})
 %%%%%
 \item
 \ttt{ewa} \newline
 Beam structure specifier for the equivalent-photon approximation
 (EWA): e.g. \ttt{beams = e1, E1 => ewa} (applied to both beams), or
 e.g. \ttt{beams = e1, u => ewa, none} (applied to only one
 beam). (cf. also \ttt{beams}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max},
 \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy},
 \ttt{?ewa\_recoil})
 %%%%%
 \item
 \ttt{exec} \newline
 Constructor \ttt{exec ("{\em <cmd\_name>}")} that demands WHIZARD to
 execute/run the command \ttt{cmd\_name}. For this to work that
 specific command must be present either in the path of the operating
 system or as a command in the user workspace.
 %%%%%
 \item
 \ttt{exit} \newline
 Command to finish the \whizard\ run (and not execute any further code
 beyond the appearance of \ttt{exit} in the \sindarin\ file. The command
 (which is the same as $\to$ \ttt{quit}) allows for an argument,
 \ttt{exit ({\em <expr>})}, where the expression can be executed, e.g. a
 screen message or an exit code.
 %%%%%
 \item
 \ttt{exp} \newline
 Numerical function \ttt{exp ({\em <num\_val>})} that calculates the
 exponential of real and complex numerical numbers or
 variables. (cf. also \ttt{sqrt}, \ttt{log}, \ttt{log10})
 %%%%%
 \item
 \ttt{expect} \newline
 The binary function \ttt{expect} compares two numerical expressions
 whether they fulfill a certain ordering condition or are equal up
 to a specific uncertainty or tolerance which can bet set by the
 specifier \ttt{tolerance}, i.e. in principle it checks whether a
 logical expression is true. The \ttt{expect} function does actually
 not just check a value for correctness, but also records its result.
 If failures are present when the program terminates, the exit code is
 nonzero. The syntax is  \ttt{expect ({\em <num1>} {\em
 <log\_comp>} {\em <num2>})}, where \ttt{{\em <num1>}} and
 \ttt{{\em <num2>}} are two numerical values (or
 corresponding variables) and  \ttt{{\em <log\_comp>}} is one of the following
 logical comparators: \ttt{<}, \ttt{>}, \ttt{<=},  \ttt{>=}, \ttt{==},
 \ttt{<>}.
 (cf. also \ttt{<}, \ttt{>}, \ttt{<=},  \ttt{>=}, \ttt{==}, \ttt{<>},
 \ttt{tolerance}).
 %%%%%
 \item
 \ttt{extract} \newline
 Subevent function that either extracts the first element of a
 particle list/subevent: \ttt{extract [ {\em <particles>}]}, or the
 element at position \ttt{<index\_value>} of the particle list:
 \ttt{extract {\em index <index\_value>} [ {\em
     <particles>}]}. Negative index values count from the end of the
 list. (cf. also \ttt{sort}, \ttt{combine},
 \ttt{collect}, \ttt{+}, \ttt{index})
 %%%%%
 \item
 \ttt{factorization\_scale} \newline
 This is a command, \ttt{factorization\_scale = {\em <expr>}}, that sets
 the factorization scale of a process or list of processes. It
 overwrites a possible scale set by the ($\to$) \ttt{scale} command.
 \ttt{{\em <expr>}} can be any kinematic expression that leads to a result of
 momentum dimension one, e.g. \ttt{100 GeV}, \ttt{eval
 Pt [e1]}. (cf. also \ttt{renormalization\_scale}).
 %%%%%
 \item
 \ttt{false} \newline
 Constructor stating that a logical expression or variable is false,
 e.g. \ttt{?{\em <log\_var>} = false}. (cf. also \ttt{true}).
 %%%%%
 \item
 \ttt{fbarn} \newline
 Physical unit, stating that a number is in femtobarns ($10^{-15}$
 barn). (cf. also \ttt{nbarn}, \ttt{abarn}, \ttt{pbarn})
 %%%%%
 \item
 \ttt{floor} \newline
 This is a function \ttt{floor ({\em <num\_val>})} that gives the
 greatest integer less than or equal to \ttt{{\em <num\_val>}},
 e.g. \ttt{int i = floor (4.56789)} gives \ttt{i = 4}. (cf. also
 \ttt{int}, \ttt{nint}, \ttt{ceiling})
 %%%%%
 \item
 \ttt{gaussian} \newline
 Beam structure specifier that imposes a Gaussian energy distribution,
 separately for each beam.  The $\sigma$ values are set by
 \ttt{gaussian\_spread1} and \ttt{gaussian\_spread2}, respectively.
 %%%%%
 \item
 \ttt{GeV} \newline
 Physical unit, energies in $10^9$ electron volt. This is the default
 energy unit of WHIZARD. (cf. also \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{meV},
 \ttt{TeV})
 %%%%%
 \item
 \ttt{graph} \newline
 This command defines the necessary information regarding producing
 a graph of a function in \whizard's internal graphical \gamelan\
 output. The syntax is: \ttt{graph {\em <record\_name>} \{ {\em <optional
 arguments>} \}}. The record with name \ttt{{\em <record\_name>}} has to be
 defined, either before or after the graph definition. Possible optional
 arguments of the \ttt{graph} command are the minimal and maximal values
 of the axes (\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}).
 (cf. \ttt{plot}, \ttt{histogram}, \ttt{record})
 %%%%%
 \item
 \ttt{Hel} \newline
 Unary observable specifier that allows to specify the helicity of a
 particle, e.g. \ttt{all Hel == -1 [e1]} in a selection. (cf. also
 \ttt{eval}, \ttt{cuts}, \ttt{selection})
 %%%%%
 \item
 \ttt{hepevt} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of HEPEVT ASCII event files. (cf. also \ttt{\$sample},
 \ttt{sample\_format})
 %%%%%
 \item
 \ttt{hepevt\_verb} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of the extended or verbose version of HEPEVT ASCII event
 files. (cf. also \ttt{\$sample}, \ttt{sample\_format})
 %%%%%
 \item
 \ttt{hepmc} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of HepMC ASCII event files. Note that this is only
 available if the HepMC package is installed and correctly
 linked. (cf. also \ttt{\$sample}, \ttt{sample\_format},
 \ttt{?hepmc\_output\_cross\_section})
 %%%%%
 \item
 \ttt{histogram} \newline
 This command defines the necessary information regarding plotting data
 as a histogram, in the form of: \ttt{histogram {\em <record\_name>} \{
 {\em <optional arguments>} \}}. The record with name \ttt{{\em <record\_name>}} has to be
 defined, either before or after the histogram definition. Possible optional
 arguments of the \ttt{histogram} command are the minimal and maximal values
 of the axes (\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}).
 (cf. \ttt{graph}, \ttt{plot}, \ttt{record})
 %%%%%
 \item
 \ttt{if} \newline
 Conditional clause with the construction \ttt{if {\em <log\_expr>} then
 {\em <expr>} [else {\em <expr>} \ldots] endif}. Note that there must be an
 \ttt{endif}  statement. For more complicated expressions it is better
 to use expressions in parentheses: \ttt{if ({\em <log\_expr>}) then
 \{{\em <expr>}\} else \{{\em <expr>}\} endif}. Examples are a selection of up quarks
 over down quarks depending on a logical variable: \ttt{if ?ok then u
   else d}, or the setting of an integer variable depending on the
 rapidity of some particle: \ttt{if (eta > 0) then \{ a = +1\} else
 \{ a = -1\}}. (cf. also \ttt{elsif}, \ttt{endif}, \ttt{then})
 %%%%%
 \item
 \ttt{in} \newline
 Second part of the constructor to let a variable be local to an
 expression. It has the syntax \ttt{let {\em <var>} = {\em <value>} in
 {\em <expression>}}.  E.g. \ttt{let int a = 3 in let int b = 4 in
 {\em <expression>}} (cf. also \ttt{let})
 %%%%%
 \item
 \ttt{include} \newline
 The \ttt{include} statement, \ttt{include ("file.sin")} allows to
 include external \sindarin\ files \ttt{file.sin} into the main WHIZARD
 input file. A standard example is the inclusion of the standard cut
 file \ttt{default\_cuts.sin}.
 %%%%%
 \item
 \ttt{incoming} \newline
 Constructor that specifies particles (or subevents) as incoming. It is
 used in cuts, analyses or selections, e.g. \ttt{cuts = all Theta > 20
 degree [incoming lepton, lepton]}. (cf. also \ttt{beam}, \ttt{outgoing},
 \ttt{cuts}, \ttt{analysis}, \ttt{selection}, \ttt{record})
 %%%%%
 \item
 \ttt{index} \newline
 Specifies the position of the element of a particle to be extracted by
 the subevent function ($\to$) \ttt{extract}: \ttt{extract {\em index
 <index\_value>} [ {\em <particles>}]}. Negative index values count
 from the end of the list. (cf. also \ttt{extract}, \ttt{sort}, \ttt{combine},
 \ttt{collect}, \ttt{+})
 %%%%%
 \item
 \ttt{int} \newline
 1) This is a constructor to specify integer constants in the input
 file. Strictly speaking, it is a unary function setting the value
 \ttt{int\_val} of the integer variable \ttt{int\_var}:
 \ttt{int {\em <int\_var>} = {\em <int\_val>}}. Note that is mandatory for all
 user-defined variables. (cf. also \ttt{real} and \ttt{complex})
 2) It is a function \ttt{int ({\em <num\_val>})} that converts real and
 complex numbers (here their real parts) into integers. (cf. also
 \ttt{nint}, \ttt{floor}, \ttt{ceiling})
 %%%%%
 \item
 \ttt{integrate} \newline
 The \ttt{integrate ({\em <proc\_name>}) \{ {\em <integrate\_options>} \}} command
 invokes the integration (phase-space generation and Monte-Carlo
 sampling) of the process \ttt{proc\_name} (which can also be a list of
 processes) with the integration options
 \ttt{{\em <integrate\_options>}}. Possible options are (1) via
 \ttt{\$integration\_method = "{\em <intg. method>}"} the integration
 method (the default being VAMP), (2) the number of iterations and
 calls per integration during the Monte-Carlo phase-space integration
 via the \ttt{iterations} specifier; (3) goal for the
 accuracy, error or relative error (\ttt{accuracy\_goal},
 \ttt{error\_goal}, \ttt{relative\_error\_goal}). (4) Invoking only
 phase space generation (\ttt{?phs\_only = true}), (5) making test
 calls of the matrix element. (cf. also \ttt{iterations},
 \ttt{accuracy\_goal}, \ttt{error\_goal}, \ttt{relative\_error\_goal},
 \ttt{error\_threshold})
 %%%%%
 \item
 \ttt{isr} \newline
 Beam structure specifier for the lepton-collider/QED initial-state
 radiation (ISR) structure function: e.g. \ttt{beams = e1, E1 => isr}
 (applied to both beams), or e.g. \ttt{beams = e1, u => isr, none}
 (applied to only one beam). (cf. also \ttt{beams}, \ttt{isr\_alpha},
 \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order},
 \ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})
 %%%%%
 \item
 \ttt{iterations} \qquad (default: internal heuristics) \newline
 Option to set the number of iterations and calls per iteration during
 the Monte-Carlo phase-space integration process. The syntax is
 \ttt{iterations = {\em <n\_iterations>}:{\em <n\_calls>}}. Note that this can be
 also a list, separated by colons, which breaks up the integration
 process into passes of the specified number of integrations and calls
 each. It works for all integration methods. For VAMP, there is the
 additional option to specify whether grids and channel weights should
 be adapted during iterations (\ttt{"g"}, \ttt{"w"},
 \ttt{"gw"} for both, or \ttt{""} for no adaptation).   (cf. also
 \ttt{integrate}, \ttt{accuracy\_goal}, \ttt{error\_goal},
 \ttt{relative\_error\_goal}, \ttt{error\_threshold}).
 %%%%%
 \item
 \ttt{join} \newline
 Subevent function that concatenates two particle lists/subevents if
 there is no overlap: \ttt{join [{\em <particles>}, {\em
 <new\_particles>}]}. The joining of the two lists can also be made
 depending on a condition: \ttt{join if {\em <condition>} [{\em
 <particles>}, {\em <new\_particles>}]}. (cf. also \ttt{\&},
 \ttt{collect}, \ttt{combine}, \ttt{extract}, \ttt{sort}, \ttt{+})
 %%%%%
 \item
 \ttt{keV} \newline
 Physical unit, energies in $10^3$ electron volt. (cf. also \ttt{eV},
 \ttt{meV}, \ttt{MeV}, \ttt{GeV}, \ttt{TeV})
 %%%%%
 \item
 \ttt{kT} \newline
 Binary particle observable that represents a jet $k_T$ clustering
 measure: \ttt{kT [j1, j2]} gives the following kinematic expression:
 $2 \min(E_{j1}^2, E_{j2}^2) / Q^2 \times (1 - \cos\theta_{j1,j2})$. At the
 moment, $Q^2 = 1$.
 %%%%%
 \item
 \ttt{let} \newline
 This allows to let a variable be local to an expression. It has the
 syntax \ttt{let {\em <var>} = {\em <value>} in {\em <expression>}}.
 E.g. \ttt{let int a = 3 in let int b = 4 in {\em <expression>}}
 (cf. also \ttt{in})
 %%%%%
 \item
 \ttt{lha} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of the \whizard\ version 1 style (deprecated) LHA ASCII event
 format files. (cf. also \ttt{\$sample}, \newline
 \ttt{sample\_format})
 %%%%%
 \item
 \ttt{lhapdf} \newline
 This is a beams specifier to demand calling \lhapdf\ parton densities as
 structure functions to integrate processes in hadron collisions. Note
 that this only works if the external \lhapdf\ library is present and
 correctly linked. (cf. \ttt{beams}, \ttt{\$lhapdf\_dir},
 \ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon},
 \ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member},
 \ttt{lhapdf\_photon\_scheme})
 %%%%%
 \item
 \ttt{lhapdf\_photon} \newline
 This is a beams specifier to demand calling \lhapdf\ parton densities as
 structure functions to integrate processes in hadron collisions with a
 photon as initializer of the hard scattering process. Note
 that this only works if the external \lhapdf\ library is present and
 correctly linked. (cf. \ttt{beams}, \ttt{lhapdf}, \ttt{\$lhapdf\_dir},
 \ttt{\$lhapdf\_file}, \ttt{\$lhapdf\_photon\_file},
 \ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})
 %%%%%
 \item
 \ttt{lhef} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of the Les Houches Accord (LHEF) event format files, with
 XML headers. There are several different versions of this format,
 which can be selected via the \ttt{\$lhef\_version} specifier
 (cf. also \ttt{\$sample}, \ttt{sample\_format}, \ttt{\$lhef\_version},
 \ttt{\$lhef\_extension}, \ttt{?lhef\_write\_sqme\_prc},
 \newline \ttt{?lhef\_write\_sqme\_ref}, \ttt{?lhef\_write\_sqme\_alt})
 %%%%%
 \item
 \ttt{library} \newline
 The command \ttt{library = "{\em <lib\_name>}"} allows to specify a separate
 shared object library archive \ttt{lib\_name.so}, not using the
 standard library \ttt{default\_lib.so}. Those libraries (when using
 shared libraries) are located in the \ttt{.libs} subdirectory of the
 user workspace. Specifying a separate library is useful for splitting
 up large lists of processes, or to restrict a larger number of
 different loaded model files to one specific process library.
 (cf. also \ttt{compile}, \ttt{\$library\_name})
 %%%%%
 \item
 \ttt{log} \newline
 Numerical function \ttt{log ({\em <num\_val>})} that calculates the
 natural logarithm of real and complex numerical numbers or
 variables. (cf. also \ttt{sqrt}, \ttt{exp}, \ttt{log10})
 %%%%%
 \item
 \ttt{log10} \newline
 Numerical function \ttt{log10 ({\em <num\_val>})} that calculates the
 base 10 logarithm of real and complex numerical numbers or
 variables. (cf. also \ttt{sqrt}, \ttt{exp}, \ttt{log})
 %%%%%
 \item
 \ttt{long} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of the long variant of HEPEVT ASCII event
 files. (cf. also \ttt{\$sample},
 \ttt{sample\_format})
 %%%%%
 \item
 \ttt{M} \newline
 Unary (binary) observable specifier for the (signed) mass of a single
 (two) particle(s), e.g. \ttt{eval M [e1]}, \ttt{any M = 91 GeV [e2,
   E2]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
 %%%%%
 \item
 \ttt{M2} \newline
 Unary (binary) observable specifier for the mass squared of a single
 (two) particle(s), e.g. \ttt{eval M2 [e1]}, \ttt{all M2 > 2*mZ [e2,
   E2]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
 %%%%%
 \item
 \ttt{max} \newline
 Numerical function with two arguments \ttt{max ({\em <var1>}, {\em
 <var2>})} that gives the maximum of the two arguments: $\max (var1,
 var2)$. It can act on all combinations of integer and real
 variables. Example: \ttt{real heavier\_mass = max (mZ, mH)}. (cf. also
 \ttt{min})
 %%%%%
 \item
 \ttt{meV} \newline
 Physical unit, stating that the corresponding number is in $10^{-3}$
 electron volt. (cf. also \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{GeV},
 \ttt{TeV})
 %%%%%
 \item
 \ttt{MeV} \newline
 Physical unit, energies in $10^6$ electron volt. (cf. also \ttt{eV},
 \ttt{keV}, \ttt{meV}, \ttt{GeV}, \ttt{TeV})
 %%%%%
 \item
 \ttt{min} \newline
 Numerical function with two arguments \ttt{min ({\em <var1>}, {\em
 <var2>})} that gives the minimum of the two arguments: $\min (var1,
 var2)$. It can act on all combinations of integer and real
 variables. Example: \ttt{real lighter\_mass = min (mZ, mH)}. (cf. also
 \ttt{max})
 %%%%%
 \item
 \ttt{mod} \newline
 Numerical function for integer and real numbers \ttt{mod (x, y)} that
 computes the remainder of the division of \ttt{x} by \ttt{y} (which
 must not be zero). (cf. also
 \ttt{abs}, \ttt{conjg}, \ttt{sgn}, \ttt{modulo})
 %%%%%
 \item
 \ttt{model} \qquad (default: \ttt{SM}) \newline
 With this specifier, \ttt{model = {\em <model\_name>}}, one sets the hard
 interaction physics model for the processes defined after this model
 specification. The list of available models can be found in Table
 \ref{tab:models}. Note that the model specification can appear
 arbitrarily often in a \sindarin\ input file, e.g. for compiling and
 running processes defined in different physics models. (cf. also
 \ttt{\$model\_name})
 %%%%%
 \item
 \ttt{modulo} \newline
 Numerical function for integer and real numbers \ttt{modulo (x, y)} that
 computes the value of $x$ modulo $y$. (cf. also
 \ttt{abs}, \ttt{conjg}, \ttt{sgn}, \ttt{mod})
 %%%%%
 \item
 \ttt{mokka} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of the MOKKA variant for HEPEVT ASCII event
 files. (cf. also \ttt{\$sample},
 \ttt{sample\_format})
 %%%%%
 \item
 \ttt{mrad} \newline
 Expression specifying the physical unit of milliradians for angular
 variables. This default in \whizard\ is \ttt{rad}. (cf. \ttt{degree}, \ttt{rad}).
 %%%%%
 \item
 \ttt{nbarn} \newline
 Physical unit, stating that a number is in nanobarns ($10^{-9}$
 barn). (cf. also \ttt{abarn}, \ttt{fbarn}, \ttt{pbarn})
 %%%%%
 \item
 \ttt{n\_in} \newline
 Integer variable that accesses the number of incoming particles of a
 process. It can be used in cuts or in an analysis. (cf. also
 \ttt{sqrts\_hat}, \ttt{cuts}, \ttt{record}, \ttt{n\_out}, \ttt{n\_tot})
 %%%%%
 \item
 \ttt{Nacl} \newline
 Unary observable specifier that returns the total number of open anticolor lines
 of a particle or subevent (i.e., composite particle).  Defined only if
 \ttt{?colorize\_subevt} is true.. (cf. also
 \ttt{Ncol}, \ttt{?colorize\_subevt})
 %%%%%
 \item
 \ttt{Ncol} \newline
 Unary observable specifier that returns the total number of open color lines
 of a particle or subevent (i.e., composite particle).  Defined only if
 \ttt{?colorize\_subevt} is true.. (cf. also
 \ttt{Nacl}, \ttt{?colorize\_subevt})
 %%%%%
 \item
 \ttt{nint} \newline
 This is a function \ttt{nint ({\em <num\_val>})} that converts real
 numbers into the closest integer, e.g. \ttt{int i = nint (4.56789)}
 gives \ttt{i = 5}. (cf. also
 \ttt{int}, \ttt{floor}, \ttt{ceiling})
 %%%%%
 \item
 \ttt{no} \newline
 \ttt{no} is a function that works on a logical expression and a list,
 \ttt{no {\em <log\_expr>} [{\em <list>}]}, and returns \ttt{true} if and only if
 \ttt{log\_expr} is fulfilled for {\em none} of the entries in
 \ttt{list}, and \ttt{false} otherwise. Examples: \ttt{no Pt < 100 GeV
   [lepton]} checks whether no lepton is softer than 100 GeV. It is the
 logical opposite of the function \ttt{all}. Logical expressions with
 \ttt{no} can be logically combined with \ttt{and} and
 \ttt{or}. (cf. also \ttt{all}, \ttt{any}, \ttt{and}, and \ttt{or})
 %%%%%
 \item
 \ttt{none} \newline
 Beams specifier that can used to explicitly {\em not} apply a
 structure function to a beam, e.g. in HERA physics: \ttt{beams = e1, P
   => none, pdf\_builtin}. (cf. also \ttt{beams})
 %%%%%
 \item
 \ttt{not} \newline
 This is the standard logical negation that converts true into false
 and vice versa. It is applied to logical values, e.g. cut
 expressions. (cf. also \ttt{and}, \ttt{or}).
 %%%%%
 \item
 \ttt{n\_out} \newline
 Integer variable that accesses the number of outgoing particles of a
 process. It can be used in cuts or in an analysis. (cf. also
 \ttt{sqrts\_hat}, \ttt{cuts}, \ttt{record}, \ttt{n\_in}, \ttt{n\_tot})
 %%%%%
 \item
 \ttt{n\_tot} \newline
 Integer variable that accesses the total number of particles (incoming
 plus outgoing) of a process. It can be used in cuts or in an
 analysis. (cf. also \ttt{sqrts\_hat}, \ttt{cuts}, \ttt{record},
 \ttt{n\_in}, \ttt{n\_out})
 %%%%%
 \item
 \ttt{observable} \newline
 With this, \ttt{observable = {\em <obs\_spec>}}, the user is able to define
 a variable specifier \ttt{obs\_spec} for observables. These can be
 reused in the analysis, e.g. as a \ttt{record}, as functions of the
 fundamental kinematical variables of the processes.
 (cf. \ttt{analysis}, \ttt{record})
 %%%%%
 \item
 \ttt{open\_out} \newline
 With the command, \ttt{open\_out ("{\em <out\_file">})} user-defined
 information like data or ($\to$) \ttt{printf} statements can be
 written out to a user-defined file. The command opens an I/O stream to
 an external file \ttt{{\em <out\_file>}}. (cf. also \ttt{close\_out},
 \ttt{\$out\_file}, \ttt{printf})
 %%%%%
 \item
 \ttt{or} \newline
 This is the standard two-place logical connective that has the value
 true if one of its operands is true, otherwise a value of false. It
 is applied to logical values, e.g. cut expressions. (cf. also
 \ttt{and}, \ttt{not}).
 %%%%%
 \item
 \ttt{outgoing} \newline
 Constructor that specifies particles (or subevents) as outgoing. It is
 used in cuts, analyses or selections, e.g. \ttt{cuts = all Theta > 20
 degree [incoming lepton, outgoing lepton]}. Note that the \ttt{outgoing}
 keyword is redundant and included only for completeness: \ttt{outgoing lepton}
 has the same meaning as \ttt{lepton}.  (cf. also \ttt{beam},
 \ttt{incoming},
 \ttt{cuts}, \ttt{analysis}, \ttt{selection}, \ttt{record})
 %%%%%
 \item
 \ttt{P} \newline
 Unary (binary) observable specifier for the spatial momentum
 $\sqrt{\vec{p}^2}$ of a single (two) particle(s), e.g. \ttt{eval P
 ["W+"]}, \ttt{all P > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
 \ttt{selection})
 %%%%%
 \item
 \ttt{pbarn} \newline
 Physical unit, stating that a number is in picobarns ($10^{-12}$
 barn). (cf. also \ttt{abarn}, \ttt{fbarn}, \ttt{nbarn})
 %%%%%
 \item
 \ttt{pdf\_builtin} \newline
 This is a beams specifier for \whizard's internal PDF structure
 functions to integrate processes in hadron collisions.
 (cf. \ttt{beams}, \ttt{pdf\_builtin\_photon},
 \ttt{\$pdf\_builtin\_file})
 %%%%%
 \item
 \ttt{pdf\_builtin\_photon} \newline
 This is a beams specifier for \whizard's internal PDF structure
 functions to integrate processes in hadron collisions with a photon as
 initializer of the hard scattering process.
 (cf. \ttt{beams}, \ttt{\$pdf\_builtin\_file})
 %%%%%
 \item
 \ttt{PDG} \newline
 Unary observable specifier that allows to specify the PDG code of a
 particle, e.g. \ttt{eval PDG [e1]}, giving \ttt{11}. (cf. also
 \ttt{eval}, \ttt{cuts}, \ttt{selection})
 %%%%%
 \item
 \ttt{Phi} \newline
 Unary and also binary observable specifier, that as a unary observable
 gives the azimuthal angle of a particle's momentum in the detector
 frame (beam into $+z$ direction). As a binary observable, it gives the
 azimuthal difference between the momenta of two particles: \ttt{eval
 Phi [e1]},  \ttt{all Phi > Pi [jet, jet]}. (cf. also \ttt{eval},
 \ttt{cuts}, \ttt{selection}, \ttt{Theta})
 %%%%%
 \item
 \ttt{Pl} \newline
 Unary (binary) observable specifier for the longitudinal momentum
 ($p_z$ in the c.m. frame) of a single (two) particle(s),
 e.g. \ttt{eval Pl ["W+"]}, \ttt{all Pl > 200 GeV [b,
 B]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
 %%%%%
 \item
 \ttt{plot} \newline
 This command defines the necessary information regarding plotting data
 as a graph, in the form of: \ttt{plot {\em <record\_name>} \{ {\em <optional
 arguments>} \}}. The record with name \ttt{{\em <record\_name>}} has to be
 defined, either before or after the plot definition. Possible optional
 arguments of the \ttt{plot} command are the minimal and maximal values
 of the axes (\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}).
 (cf. \ttt{graph}, \ttt{histogram}, \ttt{record})
 %%%%%
 \item
 \ttt{polarized} \newline
 Constructor to instruct \whizard\ to retain polarization of the
 corresponding particles in the generated events: \ttt{polarized {\em <prt1>}
   [, {\em <prt2>} , ...]}. (cf. also \ttt{unpolarized}, \ttt{simulate},
 \ttt{?polarized\_events})
 %%%%%
 \item
 \ttt{printf} \newline
 Command that allows to print data as screen messages, into logfiles or
 into user-defined output files: \ttt{printf "{\em <string\_expr>}"}. There
 exist format specifiers, very similar to the \ttt{C} command
 \ttt{printf}, e.g. \ttt{printf "\%i" (123)}. (cf. also
 \ttt{open\_out}, \ttt{close\_out}, \ttt{\$out\_file},
 \ttt{?out\_advance}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e},
 \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F}, \ttt{\%G}, \ttt{\%s})
 %%%%%
 \item
 \ttt{process} \newline
 Allows to set a hard interaction process, either for a decay process
 with name \ttt{{\em <decay\_proc>}} as \ttt{process {\em
 <decay\_proc>} = {\em <mother>} => {\em <daughter1>}, {\em
 <daughter2>}, ...}, or for a scattering process
 with name \ttt{{\em <scat\_proc}} as \ttt{process {\em <scat\_proc>} =
 {\em <in1>}, {\em <in2>} => {\em <out1>}, {\em <out2>}, ...}. Note
 that there can be arbitrarily many processes to be defined in a
 \sindarin\ input file. There are two options for particle/process sums: flavor sums:
 \ttt{{\em <prt1>}:{\em <prt2>}:...}, where all masses have to be identical, and
 inclusive sums, \ttt{{\em <prt1>} + {\em <prt2>} + ...}. The latter can be done on
 the level of individual particles, or sums over whole final
 states. Here, masses can differ, and terms will be translated into
 different process components. The \ttt{process} command also allows for
 optional arguments, e.g. to specify a numerical identifier
 (cf. \ttt{process\_num\_id}), the method how to generate the code for
 the matrix element(s): \ttt{\$method}, possible methods are either
 with the \oMega\ matrix element generator, using template matrix
 elements with different normalizations, or completely internal matrix
 element; for \oMega\ matrix elements there is also the possibility to
 specify possible restrictions (cf. \ttt{\$restrictions}).
 %%%%%
 \item
 \ttt{Pt} \newline
 Unary (binary) observable specifier for the transverse momentum
 ($\sqrt{p_x^2 + p_y^2}$ in the c.m. frame) of a single (two)
 particle(s), e.g. \ttt{eval Pt ["W+"]}, \ttt{all Pt > 200 GeV [b,
 B]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
 %%%%%
 \item
 \ttt{Px} \newline
 Unary (binary) observable specifier for the $x$-component of the
 momentum of a single (two) particle(s), e.g. \ttt{eval Px ["W+"]},
 \ttt{all Px > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
 \ttt{selection})
 %%%%%
 \item
 \ttt{Py} \newline
 Unary (binary) observable specifier for the $y$-component of the
 momentum of a single (two) particle(s), e.g. \ttt{eval Py ["W+"]},
 \ttt{all Py > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
 \ttt{selection})
 %%%%%
 \item
 \ttt{Pz} \newline
 Unary (binary) observable specifier for the $z$-component of the
 momentum of a single (two) particle(s), e.g. \ttt{eval Pz ["W+"]},
 \ttt{all Pz > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
 \ttt{selection})
 %%%%%
 \item
 \ttt{quit} \newline
 Command to finish the \whizard\ run (and not execute any further code
 beyond the appearance of \ttt{quit} in the \sindarin\ file. The command
 (which is the same as $\to$ \ttt{exit}) allows for an argument,
 \ttt{quit ({\em <expr>})}, where the expression can be executed, e.g. a
 screen message or an quit code.
 %%%%%
 \item
 \ttt{rad} \newline
 Expression specifying the physical unit of radians for angular
 variables. This is the default in \whizard. (cf. \ttt{degree}, \ttt{mrad}).
 %%%%%
 \item
 \ttt{Rap} \newline
 Unary and also binary observable specifier, that as a unary observable
 gives the rapidity of a particle momentum. The rapidity is given by $y
 = \frac12 \log \left[ (E + p_z)/(E-p_z) \right]$. As a binary
 observable, it gives the rapidity difference between the momenta of
 two particles: \ttt{eval Rap [e1]},  \ttt{all abs (Rap) < 3.5 [jet,
   jet]}. (cf. also \ttt{eval}, \ttt{cuts}, \ttt{selection}, \ttt{Eta},
 \ttt{abs})
 %%%%%
 \item
 \ttt{read\_slha} \newline
 Tells \whizard\ to read in an input file in the SUSY Les Houches accord
 (SLHA), as \ttt{read\_slha ("slha\_file.slha")}. Note that the files
 for the use in \whizard\ should have the suffix \ttt{.slha}.
 (cf. also \ttt{write\_slha}, \ttt{?slha\_read\_decays},
 \ttt{?slha\_read\_input}, \ttt{?slha\_read\_spectrum})
 %%%%%
 \item
 \ttt{real} \newline
 This is a constructor to specify real constants in the input
 file. Strictly speaking, it is a unary function setting the value
 \ttt{real\_val} of the real variable \ttt{real\_var}:
 \ttt{real {\em <real\_var>} = {\em <real\_val>}}. (cf. also \ttt{int} and
 \ttt{complex})
 %%%%%
 \item
 \ttt{real\_epsilon}\\
 Predefined real; the relative uncertainty intrinsic to the floating
 point type of the \fortran\ compiler with which \whizard\ has been
 built.
 %%%%%
 \item
 \ttt{real\_precision}\\
 Predefined integer; the decimal precision of the floating point type
 of the \fortran\ compiler with which \whizard\ has been built.
 %%%%%
 \item
 \ttt{real\_range}\\
 Predefined integer; the decimal range of the floating point type of
 the \fortran\ compiler with which \whizard\ has been built.
 %%%%%
 \item
 \ttt{real\_tiny}\\
 Predefined real; the smallest number which can be represented by the
 floating point type of the \fortran\ compiler with which \whizard\ has
 been built.
 %%%%%
 \item
 \ttt{record} \newline
 The \ttt{record} constructor provides an internal data structure in
 \sindarin\ input files. Its syntax is in general \ttt{record
   {\em <record\_name>} ({\em <cmd\_expr>})}. The \ttt{{\em <cmd\_expr>}} could be the
 definition of a tuple of points for a histogram or an \ttt{eval}
 constructor that tells \whizard\ e.g. by which rule to calculate an
 observable to be stored in the record \ttt{record\_name}. Example:
 \ttt{record h (12)} is a record for a histogram defined under the name
 \ttt{h} with the single data point (bin) at value 12; \ttt{record rap1
 (eval Rap [e1])} defines a record with name \ttt{rap1} which has an
 evaluator to calculate the rapidity (predefined \whizard\ function) of
 an outgoing electron.
 (cf. also \ttt{eval}, \ttt{histogram}, \ttt{plot})
 %%%%%
 \item
 \ttt{renormalization\_scale} \newline
 This is a command, \ttt{renormalization\_scale = {\em <expr>}}, that sets
 the renormalization scale of a process or list of processes. It
 overwrites a possible scale set by the ($\to$) \ttt{scale} command.
 \ttt{{\em <expr>}} can be any kinematic expression that leads to a result of
 momentum dimension one, e.g. \ttt{100 GeV}, \ttt{eval
 Pt [e1]}. (cf. also \ttt{factorization\_scale}).
 %%%%%
 \item
 \ttt{rescan} \newline
 This command allows to rescan event samples with modified model
 parameter, beam structure etc. to recalculate (analysis) observables,
 e.g.: \newline
 \ttt{rescan "{\em <event\_file>}" ({\em <proc\_name>}) \{ {\em <rescan\_setup>}\}}.
 \newline
 \ttt{"{\em <event\_file>}"} is the name of the event file and
 \ttt{{\em <proc\_name>}} is the process whose (existing) event
 file of arbitrary size that is to be rescanned. Several flags allow to
 reconstruct the beams ($\to$ \ttt{?recover\_beams}), to reuse only the
 hard process but rebuild the full events ($\to$
 \ttt{?update\_event}), to recalculate the matrix element ($\to$
 \ttt{?update\_sqme}) or to recalculate the individual event weight ($\to$
 \ttt{?update\_weight}). Further rescan options are redefining model
 parameter input, or defining a completely new alternative setup ($\to$
 \ttt{alt\_setup}) (cf. also \ttt{\$rescan\_input\_format})
 %%%%%
 \item
 \ttt{results} \newline
 Only used in the combination \ttt{show (results)}. Forces \whizard\ to
 print out a results summary for the integrated processes.
 (cf. also \ttt{show})
 %%%%%
 \item
 \ttt{reweight} \newline
 The \ttt{reweight = {\em <expr>}} command allows to give for a process or
 list of processes an alternative weight, given by any kind of scalar
 expression \ttt{{\em <expr>}}, e.g. \ttt{reweight = 0.2} or \ttt{reweight =
 (eval M2 [e1, E1]) / (eval M2 [e2, E2])}. (cf. also \ttt{alt\_setup},
 \ttt{weight}, \ttt{rescan})
 %%%%%
 \item
 \ttt{sample\_format} \newline
 Variable that allows the user to specify additional event formats
 beyond the \whizard\ native binary event format. Its syntax is
 \ttt{sample\_format = {\em <format>}}, where \ttt{{\em <format>}} can be any of
 the following specifiers: \ttt{hepevt}, \ttt{hepevt\_verb}, \ttt{ascii},
 \ttt{athena}, \ttt{debug}, \ttt{long}, \ttt{short}, \ttt{hepmc},
 \ttt{lhef}, \ttt{lha}, \ttt{lha\_verb}, \ttt{stdhep}, \ttt{stdhep\_up}.
 (cf. also \ttt{\$sample}, \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}, \newline
 \ttt{\$sample\_normalization}, \ttt{?sample\_pacify},
 \ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt},
 \ttt{sample\_split\_n\_kbytes})
 %%%%%
 \item
 \ttt{scale} \newline
 This is a command, \ttt{scale = {\em <expr>}}, that sets the kinematic scale
 of a process or list of processes. Unless overwritten explicitly by
 ($\to$) \ttt{factorization\_scale} and/or ($\to$)
 \ttt{renormalization\_scale} it sets both scales. \ttt{{\em <expr>}} can be
 any kinematic expression that leads to a result of momentum dimension
 one, e.g. \ttt{scale = 100 GeV}, \ttt{scale = eval Pt [e1]}.
 %%%%%
 \item
 \ttt{scan} \newline
 Constructor to perform loops over variables or scan over processes in
 the integration procedure. The syntax is \ttt{scan {\em <var>} {\em <var\_name>}
   ({\em <value list>} or  {\em <value\_init>} => {\em <value\_fin>} /{\em <incrementor>}
   {\em <increment>}) \{ {\em <scan\_cmd>} \}}. The variable \ttt{var} can be
 specified if it is not a real, e.g. an integer. \ttt{var\_name} is the
 name of the variable which is also allowed to be a predefined one like
 \ttt{seed}. For the scan, one can either specify an explicit list of
 values \ttt{value list}, or use an initial and final value and a
 rule to increment. The \ttt{scan\_cmd}  can either be just a
 \ttt{show} to print out the scanned variable or the integration of a process.
 Examples are: \ttt{scan seed (32 => 1 // 2) \{ show (seed\_value) \}
 }, which runs the seed down in steps 32, 16, 8, 4, 2, 1 (division by
 two). \ttt{scan mW (75 GeV, 80 GeV => 82 GeV /+ 0.5 GeV,  83 GeV => 90
 GeV /* 1.2) \{ show (sw) \} } scans over the $W$ mass for the values
 75, 80, 80.5, 81, 81.5, 82, 83 GeV, namely one discrete value, steps
 by adding 0.5 GeV, and increase by 20 \% (the latter having no effect
 as it already exceeds the final value). It prints out the
 corresponding value of the effective mixing angle which is defined as
 a dependent variable in the model input file(s). \ttt{scan sqrts (500 GeV =>
   600 GeV /+ 10 GeV) \{ integrate (proc) \} } integrates the process
 \ttt{proc} in eleven increasing 10 GeV steps in center-of-mass energy
 from 500 to 600 GeV. (cf. also \ttt{/+}, \ttt{/+/}, \ttt{/-},
 \ttt{/*}, \ttt{/*/}, \ttt{//})
 %%%%%
 \item
 \ttt{select} \newline
 Subevent function \ttt{select if {\em <condition>} [{\em <list1>} [ ,
   {\em <list2>}]]} that select all particles in \ttt{{\em <list1>}}
 that satisfy the condition \ttt{{\em <condition>}}. The second
 particle list \ttt{{\em <list2>}} is for conditions that depend on
 binary observables. (cf. also \ttt{collect},
 \ttt{combine}, \ttt{extract}, \ttt{sort}, \ttt{+})
 %%%%%
 \item
 \ttt{selection} \newline
 Command that allows to select particular final states in an analysis
 selection, \ttt{selection = {\em <log\_expr>}}. The term \ttt{log\_expr} can
 be any kind of logical expression. The syntax matches exactly
 the one of the ($\to$) \ttt{cuts} command. E.g. \ttt{selection = any
 PDG == 13} is an electron selection in a lepton sample.
 %%%%%
 \item
 \ttt{sgn} \newline
 Numerical function for integer and real numbers that gives the sign of
 its argument: \ttt{sgn ({\em <num\_val>})} yields $+1$ if \ttt{{\em
 <num\_val>}} is positive or zero, and $-1$ otherwise. (cf. also
 \ttt{abs}, \ttt{conjg}, \ttt{mod}, \ttt{modulo})
 %%%%%
 \item
 \ttt{short} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of the short variant of HEPEVT ASCII event
 files. (cf. also \ttt{\$sample}, \ttt{sample\_format})
 %%%%%
 \item
 \ttt{show} \newline
 This is a unary function that is operating on specific constructors in
 order to print them out in the \whizard\ screen output as well as the
 log file \ttt{whizard.log}. Examples are \ttt{show({\em <parameter\_name>})}
 to issue a specific parameter from a model or a constant defined in a
 \sindarin\ input file, \ttt{show(integral({\em <proc\_name>}))},
 \ttt{show(library)}, \ttt{show(results)}, or \ttt{show({\em <var>})} for any
 arbitrary variable. Further possibilities are \ttt{show(real)},
 \ttt{show(string)}, \ttt{show(logical)} etc. to allow to show all
 defined real, string, logical etc. variables, respectively.
 (cf. also \ttt{library}, \ttt{results})
 %%%%%
 \item
 \ttt{simulate} \newline
 This command invokes the generation of events for the process
 \ttt{proc} by means of \ttt{simulate ({\em <proc>})}.
 Optional arguments: \ttt{\$sample}, \ttt{sample\_format},
 \ttt{checkpoint} (cf. also \ttt{integrate}, \ttt{luminosity},
 \ttt{n\_events}, \ttt{\$sample}, \ttt{sample\_format},
 \ttt{checkpoint}, \ttt{?unweighted}, \ttt{safety\_factor},
 \ttt{?negative\_weights}, \ttt{sample\_max\_tries},
 \ttt{sample\_split\_n\_evt}, \ttt{sample\_split\_n\_kbytes})
 %%%%%
 \item
 \ttt{sin} \newline
 Numerical function \ttt{sin ({\em <num\_val>})} that calculates the
 sine trigonometric function of real and complex numerical numbers or
 variables. (cf. also \ttt{cos}, \ttt{tan}, \ttt{asin}, \ttt{acos},
 \ttt{atan})
 %%%%%
 \item
 \ttt{sinh} \newline
 Numerical function \ttt{sinh ({\em <num\_val>})} that calculates the
 hyperbolic sine function of real and complex numerical numbers or
 variables. Note that its inverse function is part of the
 \ttt{Fortran2008} status and hence not realized. (cf. also \ttt{cosh},
 \ttt{tanh})
 %%%%%
 \item
 \ttt{sort} \newline
 Subevent function that allows to sort a particle list/subevent either
 by increasing PDG code: \ttt{sort [{\em <particles>}]} (particles
 first, then antiparticles). Alternatively, it can sort according to a
 unary or binary particle observable (in that case there is a second
 particle list, where the first particle is taken as a reference):
 \ttt{sort by {\em <observable>} [{\em <particles>} [, {\em
 <ref\_particles>}]]}. (cf. also \ttt{extract}, \ttt{combine},
 \ttt{collect}, \ttt{join}, \ttt{by}, \ttt{+})
 %%%%%
 \item
 \ttt{sprintf} \newline
 Command that allows to print data into a string variable: \ttt{sprintf
 "{\em <string\_expr>}"}. There exist format specifiers, very similar
 to the \ttt{C} command \ttt{sprintf}, e.g. \ttt{sprintf "\%i"
 (123)}. (cf. \ttt{printf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e},
 \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F}, \ttt{\%G}, \ttt{\%s})
 %%%%%
 \item
 \ttt{sqrt} \newline
 Numerical function \ttt{sqrt ({\em <num\_val>})} that calculates the
 square root of real and complex numerical numbers or
 variables. (cf. also \ttt{exp}, \ttt{log}, \ttt{log10})
 %%%%%
 \item
 \ttt{sqrts\_hat} \newline
 Real variable that accesses the partonic energy of a hard-scattering
 process. It can be used in cuts or in an analysis, e.g. \ttt{cuts =
 sqrts\_hat > {\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}. (cf. also \ttt{sqrts}, \ttt{cuts}, \ttt{record})
 %%%%%
 \item
 \ttt{stable} \newline
 This constructor allows particles in the final states of processes in
 decay cascade set-up to be set as stable, and not letting them
 decay. The syntax is \ttt{stable {\em <prt\_name>}} (cf. also \ttt{unstable})
 %%%%%
 \item
 \ttt{stdhep} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of binary StdHEP event files based on the HEPEVT common
 block. (cf. also \ttt{\$sample}, \ttt{sample\_format})
 %%%%%
 \item
 \ttt{stdhep\_up} \newline
 Specifier for the \ttt{sample\_format} command to demand the
 generation of binary StdHEP event files based on the HEPRUP/HEPEUP common
 blocks. (cf. also \ttt{\$sample}, \ttt{sample\_format})
 %%%%%
 \item
 \ttt{tan} \newline
 Numerical function \ttt{tan ({\em <num\_val>})} that calculates the
 tangent trigonometric function of real and complex numerical numbers or
 variables. (cf. also \ttt{sin}, \ttt{cos}, \ttt{asin}, \ttt{acos},
 \ttt{atan})
 %%%%%
 \item
 \ttt{tanh} \newline
 Numerical function \ttt{tanh ({\em <num\_val>})} that calculates the
 hyperbolic tangent function of real and complex numerical numbers or
 variables. Note that its inverse function is part of the
 \ttt{Fortran2008} status and hence not realized. (cf. also \ttt{cosh},
 \ttt{sinh})
 %%%%%
 \item
 \ttt{TeV} \newline
 Physical unit, for energies in $10^{12}$ electron volt. (cf. also
 \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{meV}, \ttt{GeV})
 %%%%
 \item
 \ttt{then} \newline
 Mandatory phrase in a conditional clause: \ttt{if {\em <log\_expr>} then
   {\em <expr 1>} \ldots endif}. (cf. also \ttt{if}, \ttt{else}, \ttt{elsif},
 \ttt{endif}).
 %%%%%
 \item
 \ttt{Theta} \newline
 Unary and also binary observable specifier, that as a unary observable
 gives the angle between a particle's momentum and the beam axis ($+z$
 direction). As a binary observable, it gives the angle enclosed
 between the momenta of the two particles: \ttt{eval Theta [e1]},
 \ttt{all Theta > 30 degrees [jet, jet]}. (cf. also \ttt{eval},
 \ttt{cuts}, \ttt{selection}, \ttt{Phi}, \ttt{Theta\_star})
 %%%%%
 \item
 \ttt{Theta\_star} \newline
 Binary observable specifier, that gives the polar angle enclosed
 between the momenta of the two particles in the rest frame of the
 mother particle (momentum sum of the two particle): \ttt{eval
 Theta\_star [jet, jet]}. (cf. also \ttt{eval},
 \ttt{cuts}, \ttt{selection}, \ttt{Theta})
 %%%%%
 \item
 \ttt{true} \newline
 Constructor stating that a logical expression or variable is true,
 e.g. \ttt{?{\em <log\_var>} = true}. (cf. also \ttt{false}).
 %%%%%
 \item
 \ttt{unpolarized} \newline
 Constructor to force \whizard\ to discard polarization of the
 corresponding particles in the generated events: \ttt{unpolarized {\em <prt1>}
   [, {\em <prt2>} , ...]}. (cf. also \ttt{polarized}, \ttt{simulate},
 \ttt{?polarized\_events})
 %%%%%
 \item
 \ttt{unstable} \newline
 This constructor allows to let final state particles of the hard
 interaction undergo a subsequent (cascade) decay (in the on-shell
 approximation). For this the user has to define the list of desired
 \begin{figure}
   \begin{Verbatim}[frame=single]
     process zee =   Z => e1, E1
     process zuu =   Z => u, U
     process zz = e1, E1 => Z, Z
     compile
     integrate (zee) { iterations = 1:100 }
     integrate (zuu) { iterations = 1:100 }
     sqrts = 500 GeV
     integrate (zz) { iterations = 3:5000, 2:5000 }
     unstable Z (zee, zuu)
  \end{Verbatim}
   \caption{\label{fig:ex_unstable} \sindarin\ input file for unstable
     particles and inclusive decays.}
 \end{figure}
 decay channels as \ttt{unstable {\em <mother>} ({\em <decay1>}, {\em <decay2>}, ....)},
 where \ttt{mother} is the mother particle, and the argument is a list
 of decay channels. Note that -- unless the \ttt{?auto\_decays = true}
 flag has been set -- these decay channels have to be provided by the
 user as  in the example in Fig. \ref{fig:ex_unstable}. First, the $Z$
 decays to electrons and up quarks are generated, then $ZZ$ production
 at a 500 GeV ILC is called, and then both $Z$s are decayed according
 to the probability distribution of the two generated decay matrix
 elements. This obviously allows also for inclusive decays.
 (cf. also \ttt{stable}, \ttt{?auto\_decays})
 %%%%%
 \item
 \ttt{weight} \newline
 This is a command, \ttt{weight = {\em <expr>}}, that allows to specify a
 weight for a process or list of processes. \ttt{{\em <expr>}} can be
 any expression that leads to a scalar result, e.g. \ttt{weight = 0.2},
 \ttt{weight = eval Pt [jet]}.  (cf. also \ttt{rescan},
 \ttt{alt\_setup}, \ttt{reweight})
 %%%%%
 \item
 \ttt{write\_analysis} \newline
 The \ttt{write\_analysis} statement tells \whizard\ to write the
 analysis setup by the user for the \sindarin\ input file under
 consideration. If no \ttt{\$out\_file} is provided, the histogram
 tables/plot data etc. are written to the default file
 \ttt{whizard\_analysis.dat}. Note that the related command
 \ttt{compile\_analysis} does the same as \ttt{write\_analysis} but in
 addition invokes the \whizard\ \LaTeX routines for producing
 postscript or PDF output of the data.
 (cf. also \ttt{\$out\_file}, \ttt{compile\_analysis})
 %%%%%
 \item
 \ttt{write\_slha} \newline
 Demands \whizard\ to write out a file in the SUSY Les Houches accord
 (SLHA) format. (cf. also \ttt{read\_slha}, \ttt{?slha\_read\_decays},
 \ttt{?slha\_read\_input}, \ttt{?slha\_read\_spectrum})
 %%%%%
 \end{itemize}
 \section{Variables}
 \subsection{Rebuild Variables}
 \begin{itemize}
 \item
 \ttt{?rebuild\_events} \qquad (default: \ttt{false}) \newline
 This logical variable, if set \ttt{true} triggers \whizard\ to newly
 create an event sample, even if nothing seems to have changed,
 including the MD5 checksum. This can be used when manually
 manipulating some settings. (cf also \ttt{?rebuild\_grids},
 \ttt{?rebuild\_library}, \ttt{?rebuild\_phase\_space})
 %%%%%
 \item
 \ttt{?rebuild\_grids} \qquad (default: \ttt{false}) \newline
 The logical variable \ttt{?rebuild\_grids} forces \whizard\ to newly
 create the VAMP grids when using VAMP as an integration method, even
 if they are already present. (cf. also \ttt{?rebuild\_events},
 \ttt{?rebuild\_library}, \ttt{?rebuild\_phase\_space})
 %%%%%
 \item
 \ttt{?rebuild\_library} \qquad (default: \ttt{false}) \newline
 The logical variable \ttt{?rebuild\_library = true/false} specifies
 whether the library(-ies) for the matrix element code for processes is
 re-generated (incl. possible Makefiles etc.) by the corresponding ME
 method (e.g. if the process has been changed, but not its name). This
 can also be set as a command-line option \ttt{whizard --rebuild}. The
 default is \ttt{false}, i.e. code is never re-generated if it is
 present and the MD5 checksum is valid.
 (cf. also \ttt{?recompile\_library}, \ttt{?rebuild\_grids},
 \ttt{?rebuild\_phase\_space})
 %%%%%
 \item
 \ttt{?rebuild\_phase\_space} \qquad (default: \ttt{false}) \newline
 This logical variable, if set \ttt{true}, triggers recreation of the
 phase space file by \whizard\. (cf. also \ttt{?rebuild\_events},
 \ttt{?rebuild\_grids}, \ttt{?rebuild\_library})
 %%%%%
 \item
 \ttt{?recompile\_library} \qquad (default: \ttt{false}) \newline
 The logical variable \ttt{?recompile\_library = true/false} specifies
 whether the library(-ies) for the matrix element code for processes is
 re-compiled (e.g. if the process code has been manually modified by
 the user). This can also be set as a command-line option \ttt{whizard
   --recompile}. The default is \ttt{false}, i.e. code is never
 re-compiled if its corresponding object file is present. (cf. also
 \ttt{?rebuild\_library})
 %%%%%
 \end{itemize}
 \subsection{Standard Variables}
 \begin{itemize}
 \input{variables}
 \end{itemize}
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \clearpage
 \section*{Acknowledgements}
 
 We would like to thank E.~Boos, R.~Chierici, K.~Desch, M.~Kobel,
 F.~Krauss, P.M.~Manakos, N.~Meyer, K.~M\"onig, H.~Reuter, T.~Robens,
 S.~Rosati, J.~Schumacher, M.~Schumacher, and C.~Schwinn who
 contributed to \whizard\ by their suggestions, bits of codes and
 valuable remarks and/or used several versions of the program for
 real-life applications and thus helped a lot in debugging and
 improving the code.  Special thanks go to A.~Vaught and J.~Weill for
 their continuos efforts on improving the g95 and gfortran compilers,
 respectively.
 
 %\end{fmffile}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%% References
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %\baselineskip15pt
 \begin{thebibliography}{19}
 
 \bibitem{PYTHIA}
   T.~Sj\"ostrand,
   Comput.\ Phys.\ Commun.\ \textbf{82} (1994) 74.
 
 \bibitem{comphep}
   A.~Pukhov, \emph{et al.},
   Preprint INP MSU 98-41/542, \ttt{hep-ph/9908288}.
 
 \bibitem{madgraph}
   T.~Stelzer and W.F.~Long,
   Comput.\ Phys.\ Commun.\ \textbf{81} (1994) 357.
 
 \bibitem{omega}
   T.~Ohl,
   \emph{Proceedings of the Seventh International Workshop on
   Advanced Computing and Analysis Technics in Physics Research},
   ACAT 2000, Fermilab, October 2000,
   IKDA-2000-30, \ttt{hep-ph/0011243};
   M.~Moretti, Th.~Ohl, and J.~Reuter,
   LC-TOOL-2001-040
 
 \bibitem{VAMP}
   T.~Ohl,
   {\em Vegas revisited: Adaptive Monte Carlo integration beyond
     factorization},
   Comput.\ Phys.\ Commun.\  {\bf 120}, 13 (1999)
   [arXiv:hep-ph/9806432].
   %%CITATION = CPHCB,120,13;%%
 
 \bibitem{CIRCE}
   T.~Ohl,
   {\em CIRCE version 1.0: Beam spectra for simulating linear collider
     physics},
   Comput.\ Phys.\ Commun.\  {\bf 101}, 269 (1997)
   [arXiv:hep-ph/9607454].
   %%CITATION = CPHCB,101,269;%%
 
 %\cite{Gribov:1972rt}
 \bibitem{Gribov:1972rt}
   V.~N.~Gribov and L.~N.~Lipatov,
   {\em e+ e- pair annihilation and deep inelastic e p scattering in
     perturbation theory},
   Sov.\ J.\ Nucl.\ Phys.\  {\bf 15}, 675 (1972)
   [Yad.\ Fiz.\  {\bf 15}, 1218 (1972)].
   %%CITATION = SJNCA,15,675;%%
 
 %\cite{Kuraev:1985hb}
 \bibitem{Kuraev:1985hb}
   E.~A.~Kuraev and V.~S.~Fadin,
   {\em On Radiative Corrections to e+ e- Single Photon Annihilation at
     High-Energy},
   Sov.\ J.\ Nucl.\ Phys.\  {\bf 41}, 466 (1985)
   [Yad.\ Fiz.\  {\bf 41}, 733 (1985)].
   %%CITATION = SJNCA,41,466;%%
 
 %\cite{Skrzypek:1990qs}
 \bibitem{Skrzypek:1990qs}
   M.~Skrzypek and S.~Jadach,
   {\em Exact and approximate solutions for the electron nonsinglet
     structure function in QED},
   Z.\ Phys.\ C {\bf 49}, 577 (1991).
   %%CITATION = ZEPYA,C49,577;%%
 
 %\cite{Schulte:1998au}
 \bibitem{Schulte:1998au}
   D.~Schulte,
   {\em Beam-beam simulations with Guinea-Pig},
   eConf C {\bf 980914}, 127 (1998).
   %%CITATION = ECONF,C980914,127;%%
 
 %\cite{Schulte:1999tx}
 \bibitem{Schulte:1999tx}
   D.~Schulte,
   {\em Beam-beam simulations with GUINEA-PIG},
   CERN-PS-99-014-LP.
   %%CITATION = CERN-PS-99-014-LP;%%
 
 %\cite{Schulte:2007zz}
 \bibitem{Schulte:2007zz}
   D.~Schulte, M.~Alabau, P.~Bambade, O.~Dadoun, G.~Le Meur, C.~Rimbault and F.~Touze,
   {\em GUINEA PIG++ : An Upgraded Version of the Linear Collider Beam
     Beam Interaction Simulation Code GUINEA PIG},
   Conf.\ Proc.\ C {\bf 070625}, 2728 (2007).
   %%CITATION = CONFP,C070625,2728;%%
 
 %\cite{Behnke:2013xla}
 \bibitem{Behnke:2013xla}
   T.~Behnke, J.~E.~Brau, B.~Foster, J.~Fuster, M.~Harrison, J.~M.~Paterson, M.~Peskin and M.~Stanitzki {\it et al.},
   {\em The International Linear Collider Technical Design Report -
     Volume 1: Executive Summary},
   arXiv:1306.6327 [physics.acc-ph].
   %%CITATION = ARXIV:1306.6327;%%
 
 %\cite{Baer:2013cma}
 \bibitem{Baer:2013cma}
   H.~Baer, T.~Barklow, K.~Fujii, Y.~Gao, A.~Hoang, S.~Kanemura, J.~List and H.~E.~Logan {\it et al.},
   {\em The International Linear Collider Technical Design Report -
     Volume 2: Physics},
   arXiv:1306.6352 [hep-ph].
   %%CITATION = ARXIV:1306.6352;%%
 
 %\cite{Adolphsen:2013jya}
 \bibitem{Adolphsen:2013jya}
   C.~Adolphsen, M.~Barone, B.~Barish, K.~Buesser, P.~Burrows, J.~Carwardine, J.~Clark and H\'{e}l\`{e}n.~M.~Durand {\it et al.},
   {\em The International Linear Collider Technical Design Report -
     Volume 3.I: Accelerator \& in the Technical Design Phase},
   arXiv:1306.6353 [physics.acc-ph].
   %%CITATION = ARXIV:1306.6353;%%
 
 %\cite{Adolphsen:2013kya}
 \bibitem{Adolphsen:2013kya}
   C.~Adolphsen, M.~Barone, B.~Barish, K.~Buesser, P.~Burrows, J.~Carwardine, J.~Clark and H\'{e}l\`{e}n.~M.~Durand {\it et al.},
   {\em The International Linear Collider Technical Design Report -
     Volume 3.II: Accelerator Baseline Design},
   arXiv:1306.6328 [physics.acc-ph].
   %%CITATION = ARXIV:1306.6328;%%
 
 %\cite{Behnke:2013lya}
 \bibitem{Behnke:2013lya}
   T.~Behnke, J.~E.~Brau, P.~N.~Burrows, J.~Fuster, M.~Peskin, M.~Stanitzki, Y.~Sugimoto and S.~Yamada {\it et al.},
   %``The International Linear Collider Technical Design Report - Volume 4: Detectors,''
   arXiv:1306.6329 [physics.ins-det].
   %%CITATION = ARXIV:1306.6329;%%
 
 %\cite{Aicheler:2012bya}
 \bibitem{Aicheler:2012bya}
   M.~Aicheler, P.~Burrows, M.~Draper, T.~Garvey, P.~Lebrun, K.~Peach and N.~Phinney {\it et al.},
   {\em A Multi-TeV Linear Collider Based on CLIC Technology : CLIC
     Conceptual Design Report},
   CERN-2012-007.
   %%CITATION = CERN-2012-007;%%
 
 %\cite{Lebrun:2012hj}
 \bibitem{Lebrun:2012hj}
   P.~Lebrun, L.~Linssen, A.~Lucaci-Timoce, D.~Schulte, F.~Simon, S.~Stapnes, N.~Toge and H.~Weerts {\it et al.},
   {\em The CLIC Programme: Towards a Staged e+e- Linear Collider
     Exploring the Terascale : CLIC Conceptual Design Report},
   arXiv:1209.2543 [physics.ins-det].
   %%CITATION = ARXIV:1209.2543;%%
 
 %\cite{Linssen:2012hp}
 \bibitem{Linssen:2012hp}
   L.~Linssen, A.~Miyamoto, M.~Stanitzki and H.~Weerts,
   {\em Physics and Detectors at CLIC: CLIC Conceptual Design Report},
   arXiv:1202.5940 [physics.ins-det].
   %%CITATION = ARXIV:1202.5940;%%
 
 %\cite{vonWeizsacker:1934sx}
 \bibitem{vonWeizsacker:1934sx}
   C.~F.~von Weizs\"acker,
   {\em Radiation emitted in collisions of very fast electrons},
   Z.\ Phys.\  {\bf 88}, 612 (1934).
   %%CITATION = ZEPYA,88,612;%%
 
 %\cite{Williams:1934ad}
 \bibitem{Williams:1934ad}
   E.~J.~Williams,
   {\em Nature of the high-energy particles of penetrating radiation
     and status of ionization and radiation formulae},
   Phys.\ Rev.\  {\bf 45}, 729 (1934).
   %%CITATION = PHRVA,45,729;%%
 
 %\cite{Budnev:1974de}
 \bibitem{Budnev:1974de}
   V.~M.~Budnev, I.~F.~Ginzburg, G.~V.~Meledin and V.~G.~Serbo,
   {\em The Two photon particle production mechanism. Physical problems.
   Applications. Equivalent photon approximation},
   Phys.\ Rept.\  {\bf 15} (1974) 181.
   %%CITATION = PRPLC,15,181;%%
 
 %\cite{Ginzburg:1981vm}
 \bibitem{Ginzburg:1981vm}
   I.~F.~Ginzburg, G.~L.~Kotkin, V.~G.~Serbo and V.~I.~Telnov,
   {\em Colliding gamma e and gamma gamma Beams Based on the Single
     Pass Accelerators (of Vlepp Type)},
   Nucl.\ Instrum.\ Meth.\  {\bf 205}, 47 (1983).
   %%CITATION = NUIMA,205,47;%%
 
 %\cite{Telnov:1989sd}
 \bibitem{Telnov:1989sd}
   V.~I.~Telnov,
   {\em Problems of Obtaining $\gamma \gamma$ and $\gamma \epsilon$
     Colliding Beams at Linear Colliders},
   Nucl.\ Instrum.\ Meth.\ A {\bf 294}, 72 (1990).
   %%CITATION = NUIMA,A294,72;%%
 
 %\cite{Telnov:1995hc}
 \bibitem{Telnov:1995hc}
   V.~I.~Telnov,
   {\em Principles of photon colliders},
   Nucl.\ Instrum.\ Meth.\ A {\bf 355}, 3 (1995).
   %%CITATION = NUIMA,A355,3;%%
 
 %\cite{AguilarSaavedra:2001rg}
 \bibitem{AguilarSaavedra:2001rg}
   J.~A.~Aguilar-Saavedra {\it et al.}  [ECFA/DESY LC Physics Working
   Group Collaboration],
   {\em TESLA: The Superconducting electron positron linear collider
     with an integrated x-ray laser laboratory. Technical design
     report. Part 3. Physics at an e+ e- linear collider},
   hep-ph/0106315.
   %%CITATION = HEP-PH/0106315;%%
 
 %\cite{Richard:2001qm}
 \bibitem{Richard:2001qm}
   F.~Richard, J.~R.~Schneider, D.~Trines and A.~Wagner,
   {\em TESLA, The Superconducting Electron Positron Linear Collider
     with an Integrated X-ray Laser Laboratory, Technical Design Report
     Part 1 : Executive Summary},
   hep-ph/0106314.
   %%CITATION = HEP-PH/0106314;%%
 
 %\cite{Sudakov:1954sw}
 \bibitem{Sudakov:1954sw}
   V.~V.~Sudakov,
   %``Vertex parts at very high-energies in quantum electrodynamics,''
   Sov.\ Phys.\ JETP {\bf 3}, 65 (1956)
   [Zh.\ Eksp.\ Teor.\ Fiz.\  {\bf 30}, 87 (1956)].
   %%CITATION = SPHJA,3,65;%%
 
 \cite{Sjostrand:1985xi}
 \bibitem{Sjostrand:1985xi}
   T.~Sjostrand,
   %``A Model for Initial State Parton Showers,''
   Phys.\ Lett.\  {\bf 157B}, 321 (1985).
   doi:10.1016/0370-2693(85)90674-4
   %%CITATION = doi:10.1016/0370-2693(85)90674-4;%%
 
 %\cite{Sjostrand:2006za}
 \bibitem{Sjostrand:2006za}
   T.~Sjostrand, S.~Mrenna and P.~Z.~Skands,
   %``PYTHIA 6.4 Physics and Manual,''
   JHEP {\bf 0605}, 026 (2006)
   doi:10.1088/1126-6708/2006/05/026
   [hep-ph/0603175].
   %%CITATION = doi:10.1088/1126-6708/2006/05/026;%%
 
 %\cite{Ohl:1998jn}
 \bibitem{Ohl:1998jn}
   T.~Ohl,
   {\em Vegas revisited: Adaptive Monte Carlo integration beyond
     factorization},
   Comput.\ Phys.\ Commun.\  {\bf 120}, 13 (1999)
   [hep-ph/9806432].
   %%CITATION = HEP-PH/9806432;%%
 
 %\cite{Lepage:1980dq}
 \bibitem{Lepage:1980dq}
   G.~P.~Lepage,
   %``Vegas: An Adaptive Multidimensional Integration Program,''
   CLNS-80/447.
   %%CITATION = CLNS-80/447;%%
 
 \bibitem{HDECAY}
   A.~Djouadi, J.~Kalinowski, M.~Spira,
   Comput.\ Phys.\ Commun.\ \textbf{108} (1998) 56-74.
 
 %\cite{Beyer:2006hx}
 \bibitem{Beyer:2006hx}
   M.~Beyer, W.~Kilian, P.~Krstono\v{s}ic, K.~M\"onig, J.~Reuter, E.~Schmidt
   and H.~Schr\"oder,
   {\em Determination of New Electroweak Parameters at the ILC -
     Sensitivity to New Physics},
   Eur.\ Phys.\ J.\ C {\bf 48}, 353 (2006)
   [hep-ph/0604048].
   %%CITATION = HEP-PH/0604048;%%
 
 %\cite{Alboteanu:2008my}
 \bibitem{Alboteanu:2008my}
   A.~Alboteanu, W.~Kilian and J.~Reuter,
   {\em Resonances and Unitarity in Weak Boson Scattering at the LHC},
   JHEP {\bf 0811}, 010 (2008)
   [arXiv:0806.4145 [hep-ph]].
   %%CITATION = ARXIV:0806.4145;%%
 
 %\cite{Binoth:2010xt}
 \bibitem{Binoth:2010xt}
   T.~Binoth {\it et al.},
   %``A Proposal for a standard interface between Monte Carlo tools and one-loop programs,''
   Comput.\ Phys.\ Commun.\  {\bf 181}, 1612 (2010)
   doi:10.1016/j.cpc.2010.05.016
   [arXiv:1001.1307 [hep-ph]].
   %%CITATION = doi:10.1016/j.cpc.2010.05.016;%%
 
 %\cite{Alioli:2013nda}
 \bibitem{Alioli:2013nda}
   S.~Alioli {\it et al.},
   %``Update of the Binoth Les Houches Accord for a standard interface
   %between Monte Carlo tools and one-loop programs,''
   Comput.\ Phys.\ Commun.\  {\bf 185}, 560 (2014)
   doi:10.1016/j.cpc.2013.10.020
   [arXiv:1308.3462 [hep-ph]].
   %%CITATION = doi:10.1016/j.cpc.2013.10.020;%%
 
 %\cite{Speckner:2010zi}
 \bibitem{Speckner:2010zi}
   C.~Speckner,
   {\em LHC Phenomenology of the Three-Site Higgsless Model},
   PhD thesis, arXiv:1011.1851 [hep-ph].
   %%CITATION = ARXIV:1011.1851;%%
 
 %\cite{Chivukula:2006cg}
 \bibitem{Chivukula:2006cg}
   R.~S.~Chivukula, B.~Coleppa, S.~Di Chiara, E.~H.~Simmons, H.~-J.~He,
   M.~Kurachi and M.~Tanabashi,
   {\em A Three Site Higgsless Model},
   Phys.\ Rev.\ D {\bf 74}, 075011 (2006)
   [hep-ph/0607124].
   %%CITATION = HEP-PH/0607124;%%
 
 %\cite{Chivukula:2005xm}
 \bibitem{Chivukula:2005xm}
   R.~S.~Chivukula, E.~H.~Simmons, H.~-J.~He, M.~Kurachi and M.~Tanabashi,
   {\em Ideal fermion delocalization in Higgsless models},
   Phys.\ Rev.\ D {\bf 72}, 015008 (2005)
   [hep-ph/0504114].
   %%CITATION = HEP-PH/0504114;%%
 
 %\cite{Ohl:2008ri}
 \bibitem{Ohl:2008ri}
   T.~Ohl and C.~Speckner,
   {\em Production of Almost Fermiophobic Gauge Bosons in the Minimal
     Higgsless Model at the LHC},
   Phys.\ Rev.\ D {\bf 78}, 095008 (2008)
   [arXiv:0809.0023 [hep-ph]].
   %%CITATION = ARXIV:0809.0023;%%
 
 %\cite{Ohl:2002jp}
 \bibitem{Ohl:2002jp}
   T.~Ohl and J.~Reuter,
   {\em Clockwork SUSY: Supersymmetric Ward and Slavnov-Taylor
     identities at work in Green's functions and scattering
     amplitudes},
   Eur.\ Phys.\ J.\ C {\bf 30}, 525 (2003)
   [hep-th/0212224].
   %%CITATION = HEP-TH/0212224;%%
 
 %\cite{Reuter:2009ex}
 \bibitem{Reuter:2009ex}
   J.~Reuter and F.~Braam,
   {\em The NMSSM implementation in WHIZARD},
   AIP Conf.\ Proc.\  {\bf 1200}, 470 (2010)
   [arXiv:0909.3059 [hep-ph]].
   %%CITATION = ARXIV:0909.3059;%%
 
 %\cite{Kalinowski:2008fk}
 \bibitem{Kalinowski:2008fk}
   J.~Kalinowski, W.~Kilian, J.~Reuter, T.~Robens and K.~Rolbiecki,
   {\em Pinning down the Invisible Sneutrino},
   JHEP {\bf 0810}, 090 (2008)
   [arXiv:0809.3997 [hep-ph]].
   %%CITATION = ARXIV:0809.3997;%%
 
 %\cite{Robens:2008sa}
 \bibitem{Robens:2008sa}
   T.~Robens, J.~Kalinowski, K.~Rolbiecki, W.~Kilian and J.~Reuter,
   {\em (N)LO Simulation of Chargino Production and Decay},
   Acta Phys.\ Polon.\ B {\bf 39}, 1705 (2008)
   [arXiv:0803.4161 [hep-ph]].
   %%CITATION = ARXIV:0803.4161;%%
 
 %\cite{Kilian:2004pp}
 \bibitem{Kilian:2004pp}
   W.~Kilian, D.~Rainwater and J.~Reuter,
   {\em Pseudo-axions in little Higgs models},
   Phys.\ Rev.\ D {\bf 71}, 015008 (2005)
   [hep-ph/0411213].
   %%CITATION = HEP-PH/0411213;%%
 
 %\cite{Kilian:2006eh}
 \bibitem{Kilian:2006eh}
   W.~Kilian, D.~Rainwater and J.~Reuter,
   {\em Distinguishing little-Higgs product and simple group models at
     the LHC and ILC},
   Phys.\ Rev.\ D {\bf 74}, 095003 (2006)
   [Erratum-ibid.\ D {\bf 74}, 099905 (2006)]
   [hep-ph/0609119].
   %%CITATION = HEP-PH/0609119;%%
 
 %\cite{Ohl:2004tn}
 \bibitem{Ohl:2004tn}
   T.~Ohl and J.~Reuter,
   {\em Testing the noncommutative standard model at a future photon
     collider},
   Phys.\ Rev.\ D {\bf 70}, 076007 (2004)
   [hep-ph/0406098].
   %%CITATION = HEP-PH/0406098;%%
 
 %\cite{Ohl:2010zf}
 \bibitem{Ohl:2010zf}
   T.~Ohl and C.~Speckner,
   {\em The Noncommutative Standard Model and Polarization in Charged
     Gauge Boson Production at the LHC},
   Phys.\ Rev.\ D {\bf 82}, 116011 (2010)
   [arXiv:1008.4710 [hep-ph]].
   %%CITATION = ARXIV:1008.4710;%%
 
 \bibitem{LesHouches}
   E.~Boos {\it et al.},
   {\em Generic user process interface for event generators},
   arXiv:hep-ph/0109068.
   %%CITATION = HEP-PH/0109068;%%
 
 \bibitem{Skands:2003cj}
   P.~Z.~Skands {\it et al.},
   {\em SUSY Les Houches Accord: Interfacing SUSY Spectrum Calculators, Decay
   Packages, and Event Generators},
   JHEP {\bf 0407}, 036 (2004)
   [arXiv:hep-ph/0311123].
   %%CITATION = JHEPA,0407,036;%%
 
 %\cite{AguilarSaavedra:2005pw}
 \bibitem{AguilarSaavedra:2005pw}
   J.~A.~Aguilar-Saavedra, A.~Ali, B.~C.~Allanach, R.~L.~Arnowitt, H.~A.~Baer, J.~A.~Bagger, C.~Balazs and V.~D.~Barger {\it et al.},
   {\em Supersymmetry parameter analysis: SPA convention and project},
   Eur.\ Phys.\ J.\ C {\bf 46}, 43 (2006)
   [hep-ph/0511344].
   %%CITATION = HEP-PH/0511344;%%
 
 %\cite{Allanach:2008qq}
 \bibitem{Allanach:2008qq}
   B.~C.~Allanach, C.~Balazs, G.~Belanger, M.~Bernhardt, F.~Boudjema, D.~Choudhury, K.~Desch and U.~Ellwanger {\it et al.},
   %``SUSY Les Houches Accord 2,''
   Comput.\ Phys.\ Commun.\  {\bf 180}, 8 (2009)
   [arXiv:0801.0045 [hep-ph]].
   %%CITATION = ARXIV:0801.0045;%%
 
 \bibitem{LHEF}
   J.~Alwall {\it et al.},
   {\em A standard format for Les Houches event files},
   Comput.\ Phys.\ Commun.\  {\bf 176}, 300 (2007)
   [arXiv:hep-ph/0609017].
   %%CITATION = CPHCB,176,300;%%
 
 \bibitem{Hagiwara:2005wg}
   K.~Hagiwara {\it et al.},
   {\em Supersymmetry simulations with off-shell effects for LHC and
     ILC},
   Phys.\ Rev.\  D {\bf 73}, 055005 (2006)
   [arXiv:hep-ph/0512260].
   %%CITATION = PHRVA,D73,055005;%%
 
 \bibitem{Allanach:2002nj}
   B.~C.~Allanach {\it et al.},
   {\em The Snowmass points and slopes: Benchmarks for SUSY searches},
   in {\it Proc. of the APS/DPF/DPB Summer Study on the Future of Particle Physics (Snowmass 2001) } ed. N.~Graf,
   Eur.\ Phys.\ J.\ C {\bf 25} (2002) 113
   [eConf {\bf C010630} (2001) P125]
   [arXiv:hep-ph/0202233].
   %%CITATION = HEP-PH 0202233;%%
 
 \bibitem{PeskinSchroeder}
   M.E. Peskin, D.V.Schroeder, {\em An Introduction to Quantum Field
     Theory}, Addison-Wesley Publishing Co., 1995.
 
 \bibitem{stdhep}
   L.~Garren, {\em StdHep, Monte Carlo Standardization at FNAL},
   Fermilab CS-doc-903,
   \url{http://cd-docdb.fnal.gov/cgi-bin/ShowDocument?docid=903}
 
 \bibitem{LHAPDF}
   W.~Giele {\it et al.},
   {\em The QCD / SM working group: Summary report},
   arXiv:hep-ph/0204316;
   %%CITATION = HEP-PH/0204316;%%
   M.~R.~Whalley, D.~Bourilkov and R.~C.~Group,
   {\em The Les Houches Accord PDFs (LHAPDF) and Lhaglue},
   arXiv:hep-ph/0508110;
   %%CITATION = HEP-PH/0508110;%%
   D.~Bourilkov, R.~C.~Group and M.~R.~Whalley,
   {\em LHAPDF: PDF use from the Tevatron to the LHC},
   arXiv:hep-ph/0605240.
   %%CITATION = HEP-PH/0605240;%%
 
 \bibitem{HepMC}
   M.~Dobbs and J.~B.~Hansen,
   {\em The HepMC C++ Monte Carlo event record for High Energy
     Physics},
   Comput.\ Phys.\ Commun.\  {\bf 134}, 41 (2001).
   %%CITATION = CPHCB,134,41;%%
 
 %\cite{Boos:2004kh}
 \bibitem{Boos:2004kh}
   E.~Boos {\it et al.}  [CompHEP Collaboration],
   %``CompHEP 4.4: Automatic computations from Lagrangians to events,''
   Nucl.\ Instrum.\ Meth.\ A {\bf 534}, 250 (2004)
   [hep-ph/0403113].
   %%CITATION = HEP-PH/0403113;%%
   %493 citations counted in INSPIRE as of 12 May 2014
 
 % Parton distributions
 %\cite{Pumplin:2002vw}
 \bibitem{Pumplin:2002vw}
   J.~Pumplin, D.~R.~Stump, J.~Huston {\it et al.},
   {\em New generation of parton distributions with uncertainties from
     global QCD analysis},
   JHEP {\bf 0207}, 012 (2002).
   [hep-ph/0201195].
 %\cite{Martin:2004dh}
 \bibitem{Martin:2004dh}
   A.~D.~Martin, R.~G.~Roberts, W.~J.~Stirling {\it et al.},
   {\em Parton distributions incorporating QED contributions},
   Eur.\ Phys.\ J.\  {\bf C39}, 155-161 (2005).
   [hep-ph/0411040].
 %\cite{Martin:2009iq}
 \bibitem{Martin:2009iq}
   A.~D.~Martin, W.~J.~Stirling, R.~S.~Thorne {\it et al.},
   {\em Parton distributions for the LHC},
   Eur.\ Phys.\ J.\  {\bf C63}, 189-285 (2009).
   [arXiv:0901.0002 [hep-ph]].
 %\cite{Lai:2010vv}
 \bibitem{Lai:2010vv}
   H.~L.~Lai, M.~Guzzi, J.~Huston, Z.~Li, P.~M.~Nadolsky, J.~Pumplin and C.~P.~Yuan,
   {\em New parton distributions for collider physics},
   Phys.\ Rev.\  D {\bf 82}, 074024 (2010)
   [arXiv:1007.2241 [hep-ph]].
   %%CITATION = PHRVA,D82,074024;%%
 %\cite{Owens:2012bv}
 \bibitem{Owens:2012bv}
   J.~F.~Owens, A.~Accardi and W.~Melnitchouk,
   {\em Global parton distributions with nuclear and finite-$Q^2$
     corrections},
   Phys.\ Rev.\ D {\bf 87}, no. 9, 094012 (2013)
   [arXiv:1212.1702 [hep-ph]].
   %%CITATION = ARXIV:1212.1702;%%
 %\cite{Accardi:2016qay}
 \bibitem{Accardi:2016qay}
   A.~Accardi, L.~T.~Brady, W.~Melnitchouk, J.~F.~Owens and N.~Sato,
   %``Constraints on large-$x$ parton distributions from new weak boson production and deep-inelastic scattering data,''
   arXiv:1602.03154 [hep-ph].
   %%CITATION = ARXIV:1602.03154;%%
 %\cite{Harland-Lang:2014zoa}
 \bibitem{Harland-Lang:2014zoa}
   L.~A.~Harland-Lang, A.~D.~Martin, P.~Motylinski and R.~S.~Thorne,
   %``Parton distributions in the LHC era: MMHT 2014 PDFs,''
   arXiv:1412.3989 [hep-ph].
   %%CITATION = ARXIV:1412.3989;%%
 %\cite{Dulat:2015mca}
 \bibitem{Dulat:2015mca}
   S.~Dulat {\it et al.},
   %``The CT14 Global Analysis of Quantum Chromodynamics,''
   arXiv:1506.07443 [hep-ph].
   %%CITATION = ARXIV:1506.07443;%%
 
 
 %\cite{Salam:2008qg}
 \bibitem{Salam:2008qg}
   G.~P.~Salam and J.~Rojo,
   {\em A Higher Order Perturbative Parton Evolution Toolkit (HOPPET)},
   Comput.\ Phys.\ Commun.\  {\bf 180}, 120 (2009)
   [arXiv:0804.3755 [hep-ph]].
   %%CITATION = ARXIV:0804.3755;%%
 
 %\cite{Kilian:2011ka}
 \bibitem{Kilian:2011ka}
   W.~Kilian, J.~Reuter, S.~Schmidt and D.~Wiesler,
   {\em An Analytic Initial-State Parton Shower},
   JHEP {\bf 1204} (2012) 013
   [arXiv:1112.1039 [hep-ph]].
   %%CITATION = ARXIV:1112.1039;%%
 
 %\cite{Staub:2008uz}
 \bibitem{Staub:2008uz}
   F.~Staub,
   {\em Sarah},
   arXiv:0806.0538 [hep-ph].
   %%CITATION = ARXIV:0806.0538;%%
 
 %\cite{Staub:2009bi}
 \bibitem{Staub:2009bi}
   F.~Staub,
   {\em From Superpotential to Model Files for FeynArts and
     CalcHep/CompHep},
   Comput.\ Phys.\ Commun.\  {\bf 181}, 1077 (2010)
   [arXiv:0909.2863 [hep-ph]].
   %%CITATION = ARXIV:0909.2863;%%
 
 %\cite{Staub:2010jh}
 \bibitem{Staub:2010jh}
   F.~Staub,
   {\em Automatic Calculation of supersymmetric Renormalization Group
     Equations and Self Energies},
   Comput.\ Phys.\ Commun.\  {\bf 182}, 808 (2011)
   [arXiv:1002.0840 [hep-ph]].
   %%CITATION = ARXIV:1002.0840;%%
 
 %\cite{Staub:2012pb}
 \bibitem{Staub:2012pb}
   F.~Staub,
   {\em SARAH 3.2: Dirac Gauginos, UFO output, and more},
   Computer Physics Communications {\bf 184}, pp. 1792 (2013)
   [Comput.\ Phys.\ Commun.\  {\bf 184}, 1792 (2013)]
   [arXiv:1207.0906 [hep-ph]].
   %%CITATION = ARXIV:1207.0906;%%
 
 %\cite{Staub:2013tta}
 \bibitem{Staub:2013tta}
   F.~Staub,
   {\em SARAH 4: A tool for (not only SUSY) model builders},
   Comput.\ Phys.\ Commun.\  {\bf 185}, 1773 (2014)
   [arXiv:1309.7223 [hep-ph]].
   %%CITATION = ARXIV:1309.7223;%%
 
 \bibitem{mathematica}
   \Mathematica\ is a registered trademark of Wolfram Research, Inc.,
   Champain, IL, USA.
 
 %\cite{Porod:2003um}
 \bibitem{Porod:2003um}
   W.~Porod,
   {\em SPheno, a program for calculating supersymmetric spectra, SUSY
     particle decays and SUSY particle production at e+ e- colliders},
   Comput.\ Phys.\ Commun.\  {\bf 153}, 275 (2003)
   [hep-ph/0301101].
   %%CITATION = HEP-PH/0301101;%%
 
 %\cite{Porod:2011nf}
 \bibitem{Porod:2011nf}
   W.~Porod and F.~Staub,
   {\em SPheno 3.1: Extensions including flavour, CP-phases and models
     beyond the MSSM},
   Comput.\ Phys.\ Commun.\  {\bf 183}, 2458 (2012)
   [arXiv:1104.1573 [hep-ph]].
   %%CITATION = ARXIV:1104.1573;%%
 
 %\cite{Staub:2011dp}
 \bibitem{Staub:2011dp}
   F.~Staub, T.~Ohl, W.~Porod and C.~Speckner,
   %``A Tool Box for Implementing Supersymmetric Models,''
   Comput.\ Phys.\ Commun.\  {\bf 183}, 2165 (2012)
   [arXiv:1109.5147 [hep-ph]].
   %%CITATION = ARXIV:1109.5147;%%
 
 %%%%% FeynRules %%%%%
 
 %\cite{Christensen:2008py}
 \bibitem{Christensen:2008py}
   N.~D.~Christensen and C.~Duhr,
   {\em FeynRules - Feynman rules made easy},
   Comput.\ Phys.\ Commun.\  {\bf 180}, 1614 (2009)
   [arXiv:0806.4194 [hep-ph]].
   %%CITATION = ARXIV:0806.4194;%%
 
 %\cite{Christensen:2009jx}
 \bibitem{Christensen:2009jx}
   N.~D.~Christensen, P.~de Aquino, C.~Degrande, C.~Duhr, B.~Fuks,
   M.~Herquet, F.~Maltoni and S.~Schumann,
   {\em A Comprehensive approach to new physics simulations},
   Eur.\ Phys.\ J.\ C {\bf 71}, 1541 (2011)
   [arXiv:0906.2474 [hep-ph]].
   %%CITATION = ARXIV:0906.2474;%%
 
 %\cite{Duhr:2011se}
 \bibitem{Duhr:2011se}
   C.~Duhr and B.~Fuks,
   %``A superspace module for the FeynRules package,''
   Comput.\ Phys.\ Commun.\  {\bf 182}, 2404 (2011)
   [arXiv:1102.4191 [hep-ph]].
   %%CITATION = ARXIV:1102.4191;%%
 
 %\cite{Christensen:2010wz}
 \bibitem{Christensen:2010wz}
   N.~D.~Christensen, C.~Duhr, B.~Fuks, J.~Reuter and C.~Speckner,
   {\em Introducing an interface between WHIZARD and FeynRules},
   Eur.\ Phys.\ J.\ C {\bf 72}, 1990 (2012)
   [arXiv:1010.3251 [hep-ph]].
   %%CITATION = ARXIV:1010.3251;%%
 
 %\cite{Degrande:2011ua}
 \bibitem{Degrande:2011ua}
   C.~Degrande, C.~Duhr, B.~Fuks, D.~Grellscheid, O.~Mattelaer and T.~Reiter,
   %``UFO - The Universal FeynRules Output,''
   Comput.\ Phys.\ Commun.\  {\bf 183}, 1201 (2012)
   doi:10.1016/j.cpc.2012.01.022
   [arXiv:1108.2040 [hep-ph]].
   %%CITATION = doi:10.1016/j.cpc.2012.01.022;%%
 
 %\cite{Han:1998sg}
 \bibitem{Han:1998sg}
   T.~Han, J.~D.~Lykken and R.~-J.~Zhang,
   {\em On Kaluza-Klein states from large extra dimensions},
   Phys.\ Rev.\ D {\bf 59}, 105006 (1999)
   [hep-ph/9811350].
   %%CITATION = HEP-PH/9811350;%%
 
 %\cite{Fuks:2012im}
 \bibitem{Fuks:2012im}
   B.~Fuks,
   {\em Beyond the Minimal Supersymmetric Standard Model: from theory
     to phenomenology},
   Int.\ J.\ Mod.\ Phys.\ A {\bf 27}, 1230007 (2012)
   [arXiv:1202.4769 [hep-ph]].
   %%CITATION = ARXIV:1202.4769;%%
 
 %\cite{He:2007ge}
 \bibitem{He:2007ge}
   H.~-J.~He, Y.~-P.~Kuang, Y.~-H.~Qi, B.~Zhang, A.~Belyaev,
   R.~S.~Chivukula, N.~D.~Christensen and A.~Pukhov {\it et al.},
   {\em CERN LHC Signatures of New Gauge Bosons in Minimal Higgsless
     Model},
   Phys.\ Rev.\ D {\bf 78}, 031701 (2008)
   [arXiv:0708.2588 [hep-ph]].
   %%CITATION = ARXIV:0708.2588;%%
 
 %%%%% WHIZARD NLO %%%%%
 
 %\cite{Kilian:2006cj}
 \bibitem{Kilian:2006cj}
   W.~Kilian, J.~Reuter and T.~Robens,
   {\em NLO Event Generation for Chargino Production at the ILC},
   Eur.\ Phys.\ J.\ C {\bf 48}, 389 (2006)
   [hep-ph/0607127].
   %%CITATION = HEP-PH/0607127;%%
 
 %\cite{Binoth:2010ra}
 \bibitem{Binoth:2010ra}
   J.~R.~Andersen {\it et al.}  [SM and NLO Multileg Working Group
   Collaboration],
   {\em Les Houches 2009: The SM and NLO Multileg Working Group:
     Summary report},
   arXiv:1003.1241 [hep-ph].
   %%CITATION = ARXIV:1003.1241;%%
 
 %\cite{Butterworth:2010ym}
 \bibitem{Butterworth:2010ym}
   J.~M.~Butterworth, A.~Arbey, L.~Basso, S.~Belov, A.~Bharucha,
   F.~Braam, A.~Buckley and M.~Campanelli {\it et al.},
   {\em Les Houches 2009: The Tools and Monte Carlo working group
     Summary Report},
   arXiv:1003.1643 [hep-ph], arXiv:1003.1643 [hep-ph].
   %%CITATION = ARXIV:1003.1643;%%
 
 %\cite{Binoth:2009rv}
 \bibitem{Binoth:2009rv}
   T.~Binoth, N.~Greiner, A.~Guffanti, J.~Reuter, J.-P.~.Guillet and T.~Reiter,
   {\em Next-to-leading order QCD corrections to pp --> b anti-b b
     anti-b + X at the LHC: the quark induced case},
   Phys.\ Lett.\ B {\bf 685}, 293 (2010)
   [arXiv:0910.4379 [hep-ph]].
   %%CITATION = ARXIV:0910.4379;%%
 
 %\cite{Greiner:2011mp}
 \bibitem{Greiner:2011mp}
   N.~Greiner, A.~Guffanti, T.~Reiter and J.~Reuter,
   {\em NLO QCD corrections to the production of two bottom-antibottom
     pairs at the LHC}
   Phys.\ Rev.\ Lett.\  {\bf 107}, 102002 (2011)
   [arXiv:1105.3624 [hep-ph]].
   %% CITATION = ARXIV:1105.3624;%%
 
 %\cite{L_Ecuyer:2002}
 \bibitem{L_Ecuyer:2002}
   P.~L\'{e}Ecuyer, R.~Simard, E.~J.~Chen, and W.~D.~Kelton,
   {\em An Object-Oriented Random-Number Package with Many Long Streams and
-    Substreams}
+    Substreams},
   Operations Research, vol. 50, no. 6, pp. 1073-1075, Dec. 2002.
 
+ %\cite{Platzer:2013esa}
+\bibitem{Platzer:2013esa}
+  S.~Plätzer,
+  {\em RAMBO on diet},
+  [arXiv:1308.2922 [hep-ph]].
+  %% CITATION = ARXIV:1308.2922;%%
+
+%\cite{Kleiss:1991rn}
+\bibitem{Kleiss:1991rn}
+  R.~Kleiss and W.~J.~Stirling,
+  {\em Massive multiplicities and Monte Carlo},
+  Nucl.\ Phys.\ B {\bf 385}, 413 (1992).
+  doi:10.1016/0550-3213(92)90107-M
+  %%CITATION = doi:10.1016/0550-3213(92)90107-M;%%
+
+%\cite{Kleiss:1985gy}
+\bibitem{Kleiss:1985gy}
+  R.~Kleiss, W.~J.~Stirling and S.~D.~Ellis,
+  {\em A New Monte Carlo Treatment of Multiparticle Phase Space at High-energies},
+  Comput.\ Phys.\ Commun.\  {\bf 40} (1986) 359.
+  doi:10.1016/0010-4655(86)90119-0
+  %% CITATION = doi:10.1016/0010-4655(86)90119-0;%%
+
 \end{thebibliography}
 
 \end{document}
Index: trunk/tests/unit_tests/phs_rambo.sh
===================================================================
--- trunk/tests/unit_tests/phs_rambo.sh	(revision 0)
+++ trunk/tests/unit_tests/phs_rambo.sh	(revision 8187)
@@ -0,0 +1,4 @@
+#!/bin/sh
+### Check WHIZARD module phs_single
+echo "Running script $0"
+exec ./run_whizard_ut.sh --check phs_rambo
Index: trunk/tests/unit_tests/Makefile.am
===================================================================
--- trunk/tests/unit_tests/Makefile.am	(revision 8186)
+++ trunk/tests/unit_tests/Makefile.am	(revision 8187)
@@ -1,410 +1,411 @@
 ## Makefile.am -- Makefile for executable WHIZARD test scripts
 ##
 ## Process this file with automake to produce Makefile.in
 ##
 ########################################################################
 #
 # Copyright (C) 1999-2018 by 
 #     Wolfgang Kilian <kilian@physik.uni-siegen.de>
 #     Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
 #     Juergen Reuter <juergen.reuter@desy.de>
 #     with contributions from
 #     cf. main AUTHORS file
 #
 # WHIZARD is free software; you can redistribute it and/or modify it
 # under the terms of the GNU General Public License as published by 
 # the Free Software Foundation; either version 2, or (at your option)
 # any later version.
 #
 # WHIZARD is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 # GNU General Public License for more details.
 #
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 #
 ########################################################################
 
 WHIZARD_UT_DRIVER = run_whizard_ut.sh
 
 UNIT_TESTS = \
     analysis.run \
     pdg_arrays.run \
     expressions.run \
     beams.run \
     su_algebra.run \
     bloch_vectors.run \
     polarizations.run \
     md5.run \
     cputime.run \
     lexers.run \
     parser.run \
     color.run \
     os_interface.run \
     evaluators.run \
     formats.run \
     sorting.run \
     grids.run \
     solver.run \
     state_matrices.run \
     interactions.run \
     xml.run \
     sm_qcd.run \
     sm_physics.run \
     models.run \
     auto_components.run \
     radiation_generator.run \
     blha.run \
     particles.run \
     beam_structures.run \
     sf_aux.run \
     sf_mappings.run \
     sf_base.run \
     sf_pdf_builtin.run \
     sf_isr.run \
     sf_epa.run \
     sf_ewa.run \
     sf_circe1.run \
     sf_circe2.run \
     sf_gaussian.run \
     sf_beam_events.run \
     sf_escan.run \
     phs_base.run \
     phs_none.run \
     phs_single.run \
+    phs_rambo.run \
     resonances.run \
     phs_trees.run \
     phs_forests.run \
     phs_wood.run \
     phs_fks_generator.run \
     fks_regions.run \
     real_subtraction.run \
     rng_base.run \
     rng_tao.run \
     rng_stream.run \
     selectors.run \
     vegas.run \
     vamp2.run \
     mci_base.run \
     mci_none.run \
     mci_midpoint.run \
     mci_vamp.run \
     mci_vamp2.run \
     integration_results.run \
     prclib_interfaces.run \
     particle_specifiers.run \
     process_libraries.run \
     prclib_stacks.run \
     slha_interface.run \
     prc_test.run \
     prc_template_me.run \
     parton_states.run \
     subevt_expr.run \
     processes.run \
     process_stacks.run \
     cascades.run \
     cascades2_lexer.run \
     cascades2.run \
     event_transforms.run \
     resonance_insertion.run \
     recoil_kinematics.run \
     isr_handler.run \
     epa_handler.run \
     decays.run \
     shower.run \
     shower_base.run \
     events.run \
     hep_events.run \
     eio_data.run \
     eio_base.run \
     eio_direct.run \
     eio_raw.run \
     eio_checkpoints.run \
     eio_lhef.run \
     eio_stdhep.run \
     eio_ascii.run \
     eio_weights.run \
     eio_dump.run \
     iterations.run \
     rt_data.run \
     dispatch.run \
     dispatch_rng.run \
     dispatch_mci.run \
     dispatch_phs.run \
     dispatch_transforms.run \
     process_configurations.run \
     event_streams.run \
     integrations.run \
     ttv_formfactors.run \
     restricted_subprocesses.run \
     simulations.run
 
 XFAIL_UNIT_TESTS =
 
 UNIT_TESTS_REQ_GAMELAN = \
     commands.run
 
 UNIT_TESTS_REQ_EV_ANA = \
     phs_wood_vis.run \
     prc_omega_diags.run \
     integrations_history.run
 
 UNIT_TESTS_REQ_FASTJET = \
     jets.run
 
 UNIT_TESTS_REQ_HEPMC = \
     hepmc.run \
     eio_hepmc.run
 
 UNIT_TESTS_REQ_LCIO = \
     lcio.run \
     eio_lcio.run
 
 UNIT_TESTS_REQ_OCAML = \
     prc_omega.run \
     compilations.run \
     compilations_static.run
     
 UNIT_TESTS_REQ_RECOLA = \
    prc_recola.run
     
 UNIT_TESTS_REQ_LHAPDF5 = \
     sf_lhapdf5.run 
 UNIT_TESTS_REQ_LHAPDF6 = \
     sf_lhapdf6.run 
 
 TEST_DRIVERS_RUN = \
     $(UNIT_TESTS) \
     $(UNIT_TESTS_REQ_GAMELAN) \
     $(UNIT_TESTS_REQ_HEPMC) \
     $(UNIT_TESTS_REQ_LCIO) \
     $(UNIT_TESTS_REQ_FASTJET) \
     $(UNIT_TESTS_REQ_LHAPDF5) \
     $(UNIT_TESTS_REQ_LHAPDF6) \
     $(UNIT_TESTS_REQ_OCAML) \
     $(UNIT_TESTS_REQ_RECOLA)
 TEST_DRIVERS_SH = $(TEST_DRIVERS_RUN:.run=.sh)
 
 ########################################################################
 
 TESTS = 
 XFAIL_TESTS =
 TESTS_SRC =
 
 UNIT_TESTS += $(UNIT_TESTS_REQ_GAMELAN)
 UNIT_TESTS += $(UNIT_TESTS_REQ_FASTJET)
 UNIT_TESTS += $(UNIT_TESTS_REQ_HEPMC)
 UNIT_TESTS += $(UNIT_TESTS_REQ_LCIO)
 UNIT_TESTS += $(UNIT_TESTS_REQ_LHAPDF5)
 UNIT_TESTS += $(UNIT_TESTS_REQ_LHAPDF6)
 UNIT_TESTS += $(UNIT_TESTS_REQ_OCAML)
 UNIT_TESTS += $(UNIT_TESTS_REQ_EV_ANA)
 UNIT_TESTS += $(UNIT_TESTS_REQ_RECOLA)
 
 TESTS += $(UNIT_TESTS)
 XFAIL_TESTS += $(XFAIL_UNIT_TESTS)
 
 
 EXTRA_DIST = $(TEST_DRIVERS_SH)
     $(TESTS_SRC)
 
 ########################################################################
 # Force building the whizard_ut executable in the main src directory.
 # This depends on the unit-test libraries which will be built recursively.
 
 WHIZARD_UT = ../../src/whizard_ut
 
 $(TEST_DRIVERS_RUN): $(WHIZARD_UT)
 
 $(WHIZARD_UT):
 	$(MAKE) -C ../../src check
 
 ########################################################################
 
 VPATH = $(srcdir)
 
 SUFFIXES = .sh .run
 
 .sh.run:
 	@rm -f $@
 	@cp $< $@
 	@chmod +x $@
 
 sf_beam_events.run: test_beam_events.dat
 test_beam_events.dat: $(top_builddir)/share/beam-sim/test_beam_events.dat
 	cp $< $@
 
 cascades2_lexer.run: cascades2_lexer_1.fds
 cascades2_lexer_1.fds: $(top_srcdir)/share/tests/cascades2_lexer_1.fds
 	cp $< $@
 cascades2.run: cascades2_1.fds cascades2_2.fds
 cascades2_1.fds: $(top_srcdir)/share/tests/cascades2_1.fds
 	cp $< $@
 cascades2_2.fds: $(top_srcdir)/share/tests/cascades2_2.fds
 	cp $< $@
 
 
 
 commands.run: sps1ap_decays.slha
 sps1ap_decays.slha: $(top_builddir)/share/susy/sps1ap_decays.slha
 	cp $< $@
 
 WT_OCAML_NATIVE_EXT=opt
 
 if MPOST_AVAILABLE
 $(UNIT_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
 
 if OCAML_AVAILABLE
 
 UFO_TAG_FILE = __init__.py
 UFO_MODELPATH = ../models/UFO
 
 models.run: $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
 
 $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE): $(top_srcdir)/omega/tests/UFO/SM/$(UFO_TAG_FILE)
 	$(MAKE) -C $(UFO_MODELPATH)/SM all
 
 endif
 
 BUILT_SOURCES = \
     TESTFLAG  \
     HEPMC_FLAG \
     LCIO_FLAG \
     FASTJET_FLAG \
     LHAPDF5_FLAG \
     LHAPDF6_FLAG \
     GAMELAN_FLAG \
     EVENT_ANALYSIS_FLAG \
     OCAML_FLAG \
     RECOLA_FLAG \
     PYTHIA6_FLAG \
     STATIC_FLAG \
     ref-output \
     err-output
 
 # If this file is found in the working directory, WHIZARD
 # will use the paths for the uninstalled version (source/build tree),
 # otherwise it uses the installed version
 TESTFLAG:
 	touch $@
 
 FASTJET_FLAG:
 if FASTJET_AVAILABLE
 	touch $@
 endif
 
 HEPMC_FLAG:
 if HEPMC_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
 
 OCAML_FLAG:
 if OCAML_AVAILABLE
 	touch $@
 endif
 
 RECOLA_FLAG:
 if RECOLA_AVAILABLE
 	touch $@
 endif
 
 PYTHIA6_FLAG:
 if PYTHIA6_AVAILABLE
 	touch $@
 endif
 
 EVENT_ANALYSIS_FLAG:
 if EVENT_ANALYSIS_AVAILABLE
 	touch $@
 endif
 
 STATIC_FLAG:
 if STATIC_AVAILABLE
 	touch $@
 endif
 
 # The reference output files are in the source directory.  Copy them here.
 ref-output: $(top_srcdir)/share/tests/unit_tests/ref-output
 	mkdir -p ref-output
 	for f in $</*.ref; do cp $$f $@; done
 
 # The output files from self tests go here.
 err-output:
 	mkdir -p err-output
 
 ## installcheck runs the test scripts with the TESTFLAG removed.
 ## NOTE: disabled for unit tests, because whizard_ut will not be installed.
 installcheck-local:
 #installcheck-local: notestflag check-am
 notestflag:
 	rm -f TESTFLAG
 .PHONY: notestflag
 
 ### Remove DWARF debug information on MAC OS X
 clean-macosx:
 	-rm -rf compilations_static_1.dSYM
 	-rm -rf compilations_static_2.dSYM
 .PHONY: clean-macosx
 
 ## Remove generated files
 clean-local: clean-macosx
 	rm -f gamelan.sty
 	rm -f TESTFLAG GAMELAN_FLAG 
 	rm -f OCAML_FLAG FASTJET_FLAG HEPMC_FLAG LCIO_FLAG RECOLA_FLAG
 	rm -f EVENT_ANALYSIS_FLAG PYTHIA6_FLAG LHAPDF5_FLAG
 	rm -f LHAPDF6_FLAG STATIC_FLAG static_1.exe
 	rm -f *.run *.log slha_test.out
 	rm -f core* 
 	rm -f *.f90 *.c *.$(FC_MODULE_EXT) *.o *.la
 	rm -f *.makefile
 	rm -f *.grid output.rcl
 	rm -rf err-output
 	rm -rf ref-output
 	rm -f *.sin *.hbc *_fks_regions.out
 	rm -f *.phs *.vg *.vgb *.evt *.evx *.lhe *.hepmc *.dat *.debug *.mdl
 	rm -f *.tmp *.hepevt *.hepevt.verb *.lha *.lha.verb *.slcio
 	rm -f prc_omega_diags_1_p_i1_diags.out prc_omega_diags_1_p_i1_diags.toc
 	rm -f *.hep *.up.hep *.hep.out *.[1-9] *.[1-9][0-9] *.[1-9][0-9][0-9] 
 	rm -f *.tex *.mp *.mpx *.t[1-9] *.t[1-9][0-9] *.t[1-9][0-9][0-9] 
 	rm -f *.ltp *.aux *.dvi *.ps *.pdf so_test.*
 	rm -f *.tbl sps1ap_decays.slha bar structure_6[a-b].out
 	rm -f *.fds
 	rm -f *.vg2 *.vegas *.grids grids_2_test
 	rm -rf output_cll
 	rm -rf *.dSYM
 if FC_SUBMODULES
 	rm -f *.smod
 endif
 
 ## Remove backup files
 maintainer-clean-local: maintainer-clean-fc
 	-rm -f *~
 .PHONY: maintainer-clean-local
Index: trunk/tests/functional_tests/testproc_12.sh
===================================================================
--- trunk/tests/functional_tests/testproc_12.sh	(revision 0)
+++ trunk/tests/functional_tests/testproc_12.sh	(revision 8187)
@@ -0,0 +1,5 @@
+#!/bin/sh
+### Check WHIZARD for a simple test process
+echo "Running script $0"
+./run_whizard.sh @script@ --no-logging
+diff ref-output/`basename @script@`.ref `basename @script@`.log
Index: trunk/tests/functional_tests/Makefile.am
===================================================================
--- trunk/tests/functional_tests/Makefile.am	(revision 8186)
+++ trunk/tests/functional_tests/Makefile.am	(revision 8187)
@@ -1,740 +1,741 @@
 ## Makefile.am -- Makefile for executable WHIZARD test scripts
 ##
 ## Process this file with automake to produce Makefile.in
 ##
 ########################################################################
 #
 # Copyright (C) 1999-2018 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 \
     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
 
 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_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 \
     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 \
     reweight_1.run \
     reweight_2.run \
     reweight_3.run \
     reweight_4.run \
     reweight_5.run \
     reweight_6.run \
     reweight_7.run \
     reweight_8.run \
     analyze_1.run \
     analyze_2.run \
     analyze_5.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 \
     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 \
     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 \
     recola_1.run \
     recola_2.run \
     recola_3.run \
     recola_4.run \
     recola_5.run \
     recola_6.run \
     recola_7.run \
     recola_8.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 \
     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
 
 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
 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_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_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 $@
 
 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_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_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
 
 endif
 
 if HEPMC_AVAILABLE
 TESTS_SRC += $(hepmc_6_rd_SOURCES)
 noinst_PROGRAMS += hepmc_6_rd
 if HEPMC_IS_VERSION3
 hepmc_6_rd_SOURCES = hepmc_6_v3_rd.cpp
 else
 hepmc_6_rd_SOURCES = hepmc_6_v2_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
 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  \
     HEPMC_FLAG \
     LCIO_FLAG \
     FASTJET_FLAG \
     LHAPDF5_FLAG \
     LHAPDF6_FLAG \
     GAMELAN_FLAG \
     MPI_FLAG \
     EVENT_ANALYSIS_FLAG \
     OCAML_FLAG \
     PYTHIA6_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
 
 HEPMC_FLAG:
 if HEPMC_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
 
 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 HEPMC_FLAG LCIO_FLAG
 	rm -f EVENT_ANALYSIS_FLAG PYTHIA6_FLAG LHAPDF5_FLAG
 	rm -f LHAPDF6_FLAG 
 	rm -f GZIP_FLAG STATIC_FLAG static_1.exe static_2.exe
 	rm -f *.run *.log slha_test.out
 	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 *.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
 	rm -f ufo_1_SM.ufo.mdl ufo_2_SM.ufo.mdl ufo_3_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/.gitlab-ci.yml
===================================================================
--- trunk/.gitlab-ci.yml	(revision 8186)
+++ trunk/.gitlab-ci.yml	(revision 8187)
@@ -1,525 +1,525 @@
 stages:
   - build
   - deploy
   - daily
   - weekly
   - weekly-applications
   - weekly-report
 
 variables:
   NAGFOR_OPTIONS: "-w=all -gline -C=all -nan -f2008"
   GFORTRAN_OPTIONS: "-fbacktrace -fcheck=array-temps,bounds,do,mem,pointer"
   JOBS: "-j2"
 
 .default_template: &default_definition
   stage: build
   before_script:
     - ./build_master.sh
     - autoreconf
     - mkdir build || true
     - cd build
   except:
     - production
     - schedules
     - /^.*xfail.*$/
   artifacts:
     expire_in: 3 weeks
     when: always
     paths:
     - build/configure.log
     - build/make.log
     - build/make-install.log
     - build/circe2/tests/test-suite.log
     - build/omega/tests/test-suite.log
     - build/vamp/tests/test-suite.log
     - build/tests/unit_tests/test-suite.log
     - build/tests/unit_tests/err-output/*
     - build/tests/functional_tests/test-suite.log
 
 .docker_template: &docker_definition
   variables:
     GIT_SSL_NO_VERIFY: "1"
   tags:
     - docker
 
 # SMALL TEST SUITE (BRANCHES)
 
 gfortran-5.4.0-fully:
   <<: *default_definition
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-tools
   script:
     - export LD_LIBRARY_PATH=/home/whizard/OpenLoops/lib:$LD_LIBRARY_PATH
     - ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" --enable-hoppet --enable-fastjet --enable-openloops > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   <<: *docker_definition
 
 nagfor-6:
   <<: *default_definition
   script:
     - ../configure FC=nagfor FCFLAGS="$NAGFOR_OPTIONS" F77=nagfor --disable-static --prefix="`pwd`/install" --enable-distribution > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   tags:
     - nagfor
     - latex
 
 ifort-17:
   <<: *default_definition
   script:
     - source /opt/intel/2017/bin/compilervars.sh intel64
     - ../configure FC=ifort2017 FCFLAGS="-O1" F77=ifort2017 --disable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   tags:
     - ifort
 
 # BIG TEST SUITE (MASTER + TESTING BRANCHES)
 
 .extra_template: &extra_definition
   <<: *default_definition
   only:
     - master
     - /^testing.*$/
 
 .distcheck_template: &distcheck_script
   script:
     - ../configure FC=gfortran FCFLAGS="-O2 $GFORTRAN_OPTIONS" F77=gfortran --enable-distribution --enable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 DISTCHECK_CONFIGURE_FLAGS='FC=gfortran F77=gfortran --enable-distribution --disable-noweb-force' distcheck > make-distcheck.log
 
 .distcheck_template: &distcheck_definition
   <<: *default_definition
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-4.9.4
   <<: *distcheck_script
   <<: *docker_definition
   only:
     - master
     - /^testing.*$/
   artifacts:
     expire_in: 3 weeks
     when: always
     paths:
     - build/configure.log
     - build/make.log
     - build/make-install.log
     - build/circe2/tests/test-suite.log
     - build/omega/tests/test-suite.log
     - build/vamp/tests/test-suite.log
     - build/tests/unit_tests/test-suite.log
     - build/tests/unit_tests/err-output/*
     - build/tests/functional_tests/test-suite.log
     - "build/whizard*.tar.gz"
     - build/make-distcheck.log
   after_script:
   - find . -type f -exec chmod 644 {} +
   - find . -type d -exec chmod 755 {} +
   - rm whizard*/ -rf
 
 distcheck.static.gfortran-4.9.4:
   <<: *distcheck_definition
 
 gfortran-4.9.4:
   <<: *extra_definition
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-4.9.4
   script:
     - ../configure FC=gfortran FCFLAGS="-O2 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   <<: *docker_definition
 
 gfortran-4.8.5:
   <<: *extra_definition
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-4.8.5
   script:
     - ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   <<: *docker_definition
 
 gfortran-6.4.0:
   <<: *extra_definition
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-6.4.0
   script:
     - ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   <<: *docker_definition
 
 gfortran-7.3.0:
   <<: *extra_definition
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-7.3.0
   script:
     - ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   <<: *docker_definition
 
 gfortran-8.2.0:
   <<: *extra_definition
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-8.2.0
   script:
     - ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   <<: *docker_definition
 
 
 osx.gfortran:
   <<: *extra_definition
   script:
     - ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --prefix="`pwd`/install" --enable-distribution --enable-hepmc --enable-lcio --enable-lhapdf --enable-hoppet --enable-fastjet --enable-looptools LOOPTOOLS_DIR=/usr/local/lib --enable-gosam --enable-openloops --enable-recola --enable-pythia8 > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   tags:
     - osx
 
 disabled.static.nagfor-6:
   <<: *extra_definition
   script:
     - ../configure --disable-lhapdf --disable-hepmc --disable-lcio --disable-pythia8 --disable-fastjet --disable-hoppet --disable-gosam --disable-openloops --disable-looptools  --disable-pythia6 --enable-distribution FC=nagfor FCFLAGS="$NAGFOR_OPTIONS" F77=nagfor --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   tags:
     - nagfor
     - latex
 
 extended.gfortran-5.4.0-fully:
   <<: *extra_definition
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-tools
   script:
     - export LD_LIBRARY_PATH=/home/whizard/OpenLoops/lib:$LD_LIBRARY_PATH
     - ../configure --with-precision=extended FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" --enable-hoppet --enable-fastjet --enable-openloops > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   <<: *docker_definition
 
 openmp.gfortran-5.5.0:
   <<: *extra_definition
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-5.5.0
   script:
     - ../configure --enable-fc-openmp FC=gfortran FCFLAGS="-O1 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   <<: *docker_definition
 
 mpi.gfortran-5.5.0:
   <<: *extra_definition
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-5.5.0-openmpi-2.1.1
   script:
     - ../configure --enable-fc-mpi FC=mpifort FCFLAGS="-O1 $GFORTRAN_OPTIONS" F77=mpifort --disable-static --prefix="`pwd`/install" > configure.log
     - sed -i.bak 's/mpirun="mpirun -np 1"/mpirun="mpirun -np 1 --allow-run-as-root"/' tests/functional_tests/run_whizard.sh
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   <<: *docker_definition
 
 parallel.gfortran-5.5.0:
   <<: *extra_definition
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-5.5.0-openmpi-2.1.1
   script:
     - ../configure --enable-fc-openmp --enable-fc-mpi FC=mpifort FCFLAGS="-O1 $GFORTRAN_OPTIONS" F77=mpifort --disable-static --prefix="`pwd`/install" > configure.log
     - sed -i.bak 's/mpirun="mpirun -np 1"/mpirun="mpirun -np 1 --allow-run-as-root"/' tests/functional_tests/run_whizard.sh
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   <<: *docker_definition
 
 
 quadruple.ifort-17:
   <<: *extra_definition
   script:
     - source /opt/intel/2017/bin/compilervars.sh intel64
     - ../configure --with-precision=quadruple FC=ifort2017 FCFLAGS="-O1" F77=ifort2017 --disable-static --prefix="`pwd`/install" --enable-fastjet --enable-openloops > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   tags:
     - ifort
 
 ifort-18:
   <<: *extra_definition
   script:
     - source /opt/intel/2018/bin/compilervars.sh intel64
     - ../configure FC=ifort2018 F77=ifort2018 --disable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
   tags:
     - ifort
 
 # DEPLOY (MASTER)
 
 .deploy_template: &deploy_definition
   stage: deploy
   tags:
     - deployment
   only:
     - master
   before_script:
     - eval `ssh-agent -s`
     - ssh-add /scratch/vrothe/id_rsa /scratch/vrothe/id_rsa_runner_wgs
   except:
     - production
     - schedules
     - /^.*xfail.*$/
 
 notify slack:
   <<: *deploy_definition
   when: on_failure
   script:
     - echo "Build on \`$CI_BUILD_REF_NAME\` failed! Commit \`$(git log -1 --oneline)\` See pipeline of https://gitlab.tp.nt.uni-siegen.de/whizard/development/commit/$CI_BUILD_REF" | slacktee.sh -a "danger" -p --config /scratch/vrothe/gitlab/.slacktee
 
 deploy to production:
   <<: *deploy_definition
   environment: production
   script:
     - export GIT_SSH=/scratch/vrothe/gitlab/ssh.sh
     - git remote set-url --push origin git@gitlab.tp.nt.uni-siegen.de:whizard/development.git
     - git checkout production
     - git merge master --ff-only
     - git push
 
 deploy to svn:
   <<: *deploy_definition
   environment: svn
   script:
     - svn co --config-dir /scratch/vrothe/gitlab/.subversion/ --config-option="config:tunnels:ssh=ssh -o UserKnownHostsFile=/scratch/vrothe/gitlab/known_hosts" svn+ssh://vcs@phab.hepforge.org/source/whizardsvn/trunk trunk
     - cp .git trunk/ -r
     - cd trunk
     - git status
     - git checkout -- .
     - git clean -d -f
     - svn diff --config-dir /scratch/vrothe/gitlab/.subversion/ > ../svndiff.log || true
     - svn status --config-dir /scratch/vrothe/gitlab/.subversion/ | grep "^?" | grep -v '.git$' | awk '{print $2}' >| ../svn-add-files.log || true
     - svn status --config-dir /scratch/vrothe/gitlab/.subversion/ | grep "^\!" | grep -v '.git$' | awk '{print $2}' >| ../svn-del-files.log || true
     - if test -s ../svn-add-files.log ; then cat ../svn-add-files.log | xargs svn add --config-dir /scratch/vrothe/gitlab/.subversion/ ; fi
     - if test -s ../svn-del-files.log ; then cat ../svn-del-files.log | xargs svn rm --config-dir /scratch/vrothe/gitlab/.subversion/ ; fi
     - git log --format="%h %s" -n 1 HEAD > svn-commit.msg
     - svn commit --config-dir /scratch/vrothe/gitlab/.subversion/ --config-option="config:tunnels:ssh=ssh -o UserKnownHostsFile=/scratch/vrothe/gitlab/known_hosts" --file=svn-commit.msg
   artifacts:
     paths:
     - svndiff.log
     - svn-add-files.log
     - svn-del-files.log
 
 # NIGHTLY BUILD (DAILY)
 build whizard tarball:
   stage: daily
   environment: nightly
   only:
     refs:
       - schedules
     variables:
       - $type == "nightly"
   before_script:
     - ./build_master.sh
     - autoreconf
     - mkdir build || true
     - cd build
   script:
     - ../configure --enable-distribution FC=nagfor FCFLAGS="$NAGFOR_OPTIONS" F77=nagfor > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 dist > make-dist.log
     - mv "$(ls whizard-*.tar.gz)" "$(basename $(ls whizard-*.tar.gz) .tar.gz)-$(date -Idate)-$(git rev-parse --short HEAD).tar.gz"
-    - ssh whizard@beryllium 'cd tarballs && (for f in "$(ls -t1 *.tar.gz | tail -n +5)"; do rm -f "${f}"; done)'
+    - ssh whizard@beryllium 'cd tarballs && (for f in $(ls -t1 *.tar.gz | tail -n +5); do rm -f "${f}"; done)'
     - rsync whizard*.tar.gz whizard@beryllium:~/tarballs
-    - ssh whizard@beryllium 'cd tarballs && ln -sf "$(ls -t1 *.tar.gz | head -n 2 | tail -n 1)" whizard-nightly-latest.tar.gz'
+    - ssh whizard@beryllium 'cd tarballs && ln -sf $(ls -t1 *.tar.gz | head -n 2 | tail -n 1) whizard-nightly-latest.tar.gz'
   artifacts:
     expire_in: 3 weeks
     when: always
     paths:
       - configure.log
       - make.log
       - make-dist.log
   tags:
     - jenkins2
     - nagfor
     - latex
 
 # WHIZARD IMAGE (WEEKLY)
 build whizard image:
   stage: weekly
   script:
     - git clone https://${GITLAB_USER}:${GITLAB_PASSWORD}@gitlab.tp.nt.uni-siegen.de/whizard/docker.git
     - docker build -t gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master -f docker/whizard-master/Dockerfile .
     - docker login -u ${GITLAB_USER} -p ${GITLAB_PASSWORD} gitlab.tp.nt.uni-siegen.de:4567
     - docker push gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master
     - docker login -u ${DOCKER_USER} -p ${DOCKER_PASSWORD}
     - docker tag gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master whizard/whizard-weekly:master
     - docker push whizard/whizard-weekly:master
   tags:
     - whizard
   only:
     refs:
       - schedules
     variables:
       - $type == "weekly"
 
 # GCC TRUNK IMAGE (WEEKLY)
 
 build gcc-trunk image:
   stage: weekly
   script:
     - git clone https://${GITLAB_USER}:${GITLAB_PASSWORD}@gitlab.tp.nt.uni-siegen.de/whizard/docker.git
     - cd docker/whizard-gcc-trunk
     - wget http://mirrors.ctan.org/install/fonts/doublestroke.tds.zip
     - docker build --no-cache=true -t gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-trunk .
     - docker login -u ${GITLAB_USER} -p ${GITLAB_PASSWORD} gitlab.tp.nt.uni-siegen.de:4567
     - docker push gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-trunk
   tags:
     - whizard
   only:
     refs:
       - schedules
     variables:
       - $type == "weekly"
 
 # SUBPACKAGES (WEEKLY)
 
 .subpackage_template: &subpackage_definition
   <<: *distcheck_definition
   stage: weekly
   only:
     refs:
       - schedules
     variables:
       - $type == "weekly"
   except:
 
 circe1.distcheck.static.gfortran-4.9.4:
   <<: *subpackage_definition
   before_script:
     - ./build_master.sh CIRCE1
     - autoreconf
     - mkdir -p build
     - cd build
 
 circe2.distcheck.static.gfortran-4.9.4:
   <<: *subpackage_definition
   before_script:
     - ./build_master.sh CIRCE2
     - autoreconf
     - mkdir -p build
     - cd build
 
 vamp.distcheck.static.gfortran-4.9.4:
   <<: *subpackage_definition
   before_script:
     - ./build_master.sh VAMP
     - autoreconf
     - mkdir -p build
     - cd build
 
 omega.distcheck.static.gfortran-4.9.4:
   <<: *subpackage_definition
   before_script:
     - ./build_master.sh OMEGA
     - autoreconf
     - mkdir -p build
     - cd build
   script:
     - ../configure FC=gfortran FCFLAGS="-O2 $GFORTRAN_OPTIONS" F77=gfortran --enable-distribution --enable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
     - make $JOBS -s V=0 extra-distcheck > make-distcheck.log
 
 whizard.distcheck.static.gfortran-4.9.4:
   <<: *subpackage_definition
   before_script:
     - ./build_master.sh
     - autoreconf
     - mkdir -p build
     - cd build
   script:
     - ../configure FC=gfortran FCFLAGS="-O2 $GFORTRAN_OPTIONS" F77=gfortran --enable-distribution --enable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
     - make $JOBS -s V=0 extra-distcheck > make-distcheck.log
 
 
 
 # EXAMPLES (WEEKLY)
 
 .examples_template: &examples_definition
   stage: weekly-applications
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master
   only:
     refs:
       - schedules
     variables:
       - $type == "weekly"
   before_script:
     - source /home/whizard/GoSam/local/bin/gosam_setup_env.sh
     - cd ~/whizard/share/examples
   <<: *docker_definition
 
 run matching examples:
   <<: *examples_definition
   script:
     - for s in *Matching*.sin ; do whizard $s; done
 
 run NLO examples:
   <<: *examples_definition
   script:
     - for s in *NLO*OpenLoops.sin ; do whizard $s; done
     # - for s in *NLO*GoSam.sin ; do whizard $s; done
 
 run collider examples:
   <<: *examples_definition
   script:
     - for s in HERA_DIS.sin LEP_cc10.sin LEP_higgs.sin W-endpoint.sin Z-lineshape.sin ; do whizard $s; done
 
 run other examples:
   <<: *examples_definition
   script:
     - for s in Zprime.sin casc_dec.sin circe1.sin eeww_polarized.sin fourjetsLO.sin ; do whizard $s; done
 
 build whizard with gcc-trunk:
   <<: *default_definition
   <<: *docker_definition
   stage: weekly-applications
   image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-trunk
   only:
     refs:
       - schedules
     variables:
       - $type == "weekly"
   except:
   dependencies:
   script:
     - ../configure --disable-static --prefix="`pwd`/install" > configure.log
     - make $JOBS -s V=0 > make.log
     - make $JOBS -s V=0 install > make-install.log
     - make $JOBS -s V=0 check
 
 notify slack weekly:
   stage: weekly-report
   tags:
     - deployment
   only:
     refs:
       - schedules
     variables:
       - $type == "weekly"
   before_script:
     - eval `ssh-agent -s`
     - ssh-add /scratch/vrothe/id_rsa /scratch/vrothe/id_rsa_runner_wgs
   when: on_failure
   script:
     - echo "Weekly build on \`$CI_BUILD_REF_NAME\` failed! Commit \`$(git log -1 --oneline)\`. See pipeline of https://gitlab.tp.nt.uni-siegen.de/whizard/development/commit/$CI_BUILD_REF" | slacktee.sh -a "warning" -p --config /scratch/vrothe/gitlab/.slacktee
Index: trunk/ChangeLog
===================================================================
--- trunk/ChangeLog	(revision 8186)
+++ trunk/ChangeLog	(revision 8187)
@@ -1,1792 +1,1795 @@
 ChangeLog -- Summary of changes to the WHIZARD package
 
 Use svn log to see detailed changes.
 
 	Version 2.6.5
 
 2018-11-30
 	RELEASE: version 2.6.5
 
+2018-10-29
+        Flat phase space parametrization with RAMBO (on diet) implemented
+
 2018-10-17
 	Revise extended test suite
 
 2018-09-27
 	Process container for RECOLA processes
 
 2018-09-15
 	Fixes by M. Berggren for PYTHIA6 interface
 
 2018-09-14
 	First fixes after HepForge modernization
 ##################################################################
 
 2018-08-23
 	RELEASE: version 2.6.4
 
 2018-08-09
 	Infrastructure to check colored subevents
 
 2018-07-10
 	Infrastructure for running WHIZARD in batch mode
 
 2018-07-04
 	MPI available from distribution tarball
 
 2018-06-03
 	Support Intel Fortran Compiler under MAC OS X
 
 2018-05-07
 	FKS slicing parameter delta_i (initial state) implementend
 
 2018-05-03
 	Refactor structure function assignment for NLO
 
 2018-05-02
 	FKS slicing parameter xi_cut, delta_0 implemented
 
 2018-04-20
 	Workspace subdirectory for process integration (grid/phs files)
 	Packing/unpacking of files at job end/start
 	Exporting integration results from scan loops
 
 2018-04-13
 	Extended QCD NLO test suite
 
 2018-04-09
 	Bugfix for Higgs Singlet Extension model
 
 2018-04-06
 	Workspace subdirectory for process generation and compilation
 	--job-id option for creating job-specific names
 
 2018-03-20
 	Bug fix for color flow matching in hadron collisions
 	   with identical initial state quarks
 
 2018-03-08
 	Structure functions quantum numbers correctly assigned for NLO
 
 2018-02-24
 	Configure setup includes 'pgfortran' and 'flang'
 
 2018-02-21
 	Include spin-correlated matrix elements in interactions
 
 2018-02-15
 	Separate module for QED ISR structure functions
 
 ##################################################################
 
 2018-02-10
 	RELEASE: version 2.6.3
 
 2018-02-08
 	Improvements in memory management for PS generation
 
 2018-01-31
 	Partial refactoring: quantum number assigment NLO
 	Initial-state QCD splittings for hadron collisions
 
 2018-01-25
 	Bug fix for weighted events with VAMP2
 
 2018-01-17
 	Generalized interface for Recola versions 1.3+  and 2.1+
 
 2018-01-15
 	Channel equivalences also for VAMP2 integrator
 
 2018-01-12
 	Fix for OCaml compiler 4.06 (and newer)
 
 2017-12-19
 	RECOLA matrix elements with flavor sums can be integrated
 
 2017-12-18
 	Bug fix for segmentation fault in empty resonance histories
 
 2017-12-16
 	Fixing a bug in PYTHIA6 PYHEPC routine by omitting CMShowers
 	  from transferral between PYTHIA and WHIZARD event records
 
 2017-12-15
 	Event index for multiple processes in event file correct
 
 ##################################################################
 
 2017-12-13
 	RELEASE: version 2.6.2
 
 2017-12-07
 	User can set offset in event numbers
 
 2017-11-29
 	Possibility to have more than one RECOLA process in one file
 
 2017-11-23
 	Transversal/mixed (and unitarized) dim-8 operators
 
 2017-11-16
 	epa_q_max replaces epa_e_max (trivial factor 2)
 
 2017-11-15
 	O'Mega matrix element compilation silent now
 
 2017-11-14
 	Complete expanded P-wave form factor for top threshold
 
 2017-11-10
 	Incoming particles can be accessed in SINDARIN
 
 2017-11-08
 	Improved handling of resonance insertion, additional parameters
 
 2017-11-04
 	Added Higgs-electron coupling (SM_Higgs)
 
 ##################################################################
 
 2017-11-03
 	RELEASE: version 2.6.1
 
 2017-10-20
 	More than 5 NLO components possible at same time
 
 2017-10-19
 	Gaussian cutoff for shower resonance matching
 
 2017-10-12
 	Alternative (more efficient) method to generate
 	   phase space file
 
 2017-10-11
 	Bug fix for shower resonance histories for processes
 	   with multiple components
 
 2017-09-25
 	Bugfix for process libraries in shower resonance histories
 
 2017-09-21
 	Correctly generate pT distribution for EPA remnants
 
 2017-09-20
 	Set branching ratios for unstable particles also by hand
 
 2017-09-14
 	Correctly generate pT distribution for ISR photons
 
 ##################################################################
 
 2017-09-08
 	RELEASE: version 2.6.0
 
 2017-09-05
 	Bug fix for initial state NLO QCD flavor structures
 	Real and virtual NLO QCD hadron collider processes
 	   work with internal interactions
 
 2017-09-04
 	Fully validated MPI integration and event generation
 
 2017-09-01
 	Resonance histories for shower: full support
 	Bug fix in O'Mega model constraints
 	O'Mega allows to output a parsable form of the DAG
 
 2017-08-24
 	Resonance histories in events for transferral
 	   to parton shower (e.g. in ee -> jjjj)
 
 2017-08-01
 	Alpha version of HepMC v3 interface
 	   (not yet really functional)
 
 2017-07-31
 	Beta version for RECOLA OLP support
 
 2017-07-06
 	Radiation generator fix for LHC processes
 
 2017-06-30
 	Fix bug for NLO with structure
 	   functions and/or polarization
 
 2017-06-23
 	Collinear limit for QED corrections works
 
 2017-06-17
 	POWHEG grids generated already during integration
 
 2017-06-12
 	Soft limit for QED corrections works
 
 2017-05-16
 	Beta version of full MPI parallelization (VAMP2)
 	Check consistency of POWHEG grid files
 	Logfile config-summary.log for configure summary
 
 2017-05-12
 	Allow polarization in top threshold
 
 2017-05-09
 	Minimal demand automake 1.12.2
 	Silent rules for make procedures
 
 2017-05-07
 	Major fix for POWHEG damping
 	Correctly initialize FKS ISR phasespace
 
 ##################################################################
 
 2017-05-06
 	RELEASE: version 2.5.0
 
 2017-05-05
 	Full UFO support (SM-like models)
 	Fixed-beam ISR FKS phase space
 
 2017-04-26
 	QED splittings in radiation generator
 
 2017-04-10
 	Retire deprecated O'Mega vertex cache files
 
 ##################################################################
 
 2017-03-24
 	RELEASE: version 2.4.1
 
 2017-03-16
 	Distinguish resonance charge in phase space channels
 	Keep track of resonance histories in phase space
 	Complex mass scheme default for OpenLoops amplitudes
 
 2017-03-13
 	Fix helicities for polarized OpenLoops calculations
 
 2017-03-09
 	Possibility to advance RNG state in rng_stream
 
 2017-03-04
 	General setup for partitioning real emission
 	   phase space
 
 2017-03-06
 	Bugfix on rescan command for converting event files
 
 2017-02-27
 	Alternative multi-channel VEGAS implementation
 	   VAMP2: serial backbone for MPI setup
 	Smoothstep top threshold matching
 
 2017-02-25
 	Single-beam structure function with
 	   s-channel mapping supported
 	Safeguard against invalid process libraries
 
 2017-02-16
 	Radiation generator for photon emission
 
 2017-02-10
 	Fixes for NLO QCD processes (color correlations)
 
 2017-01-16
 	LCIO variable takes precedence over LCIO_DIR
 
 2017-01-13
 	Alternative random number generator
 	   rng_stream (cf. L'Ecuyer et al.)
 
 2017-01-01
 	Fix for multi-flavor BLHA tree
 	   matrix elements
 
 2016-12-31
 	Grid path option for VAMP grids
 
 2016-12-28
 	Alpha version of Recola OLP support
 
 2016-12-27
 	Dalitz plots for FKS phase space
 
 2016-12-14
 	NLO multi-flavor events possible
 
 2016-12-09
 	LCIO event header information added
 
 2016-12-02
 	Alpha version of RECOLA interface
 	Bugfix for generator status in LCIO
 
 ##################################################################
 
 2016-11-28
 	RELEASE: version 2.4.0
 
 2016-11-24
 	Bugfix for OpenLoops interface: EW scheme
 	   is set by WHIZARD
 	Bugfixes for top threshold implementation
 
 2016-11-11
 	Refactoring of dispatching
 
 2016-10-18
 	Bug fix for LCIO output
 
 2016-10-10
 	First implementation for collinear soft terms
 
 2016-10-06
 	First full WHIZARD models from UFO files
 
 2016-10-05
 	WHIZARD does not support legacy gcc 4.7.4 any longer
 
 2016-09-30
 	Major refactoring of process core and NLO components
 
 2016-09-23
 	WHIZARD homogeneous entity: discarding subconfigures
 	  for CIRCE1/2, O'Mega, VAMP subpackages; these are
 	  reconstructable by script projectors
 
 2016-09-06
 	Introduce main configure summary
 
 2016-08-26
 	Fix memory leak in event generation
 
 ##################################################################
 
 2016-08-25
 	RELEASE: version 2.3.1
 
 2016-08-19
 	Bug fix for EW-scheme dependence of gluino propagators
 
 2016-08-01
 	Beta version of complex mass scheme support
 
 2016-07-26
 	Fix bug in POWHEG damping for the matching
 
 ##################################################################
 
 2016-07-21
 	RELEASE: version 2.3.0
 
 2016-07-20
 	UFO file support (alpha version) in O'Mega
 
 2016-07-13
 	New (more) stable of WHIZARD GUI
 	Support for EW schemes for OpenLoops
 	Factorized NLO top decays for threshold model
 
 2016-06-15
 	Passing factorization scale to PYTHIA6
 	Adding charge and neutral observables
 
 2016-06-14
 	Correcting angular distribution/tweaked kinematics in
 	   non-collinear structure functions splittings
 
 2016-05-10
 	Include (Fortran) TAUOLA/PHOTOS for tau decays via PYTHIA6
 	   (backwards validation of LC CDR/TDR samples)
 
 2016-04-27
 	Within OpenLoops virtuals: support for Collier library
 
 2016-04-25
 	O'Mega vertex tables only loaded at first usage
 
 2016-04-21
 	New CJ15 PDF parameterizations added
 
 2016-04-21
 	Support for hadron collisions at NLO QCD
 
 2016-04-05
 	Support for different (parameter) schemes in model files
 
 2016-03-31
 	Correct transferral of lifetime/vertex from PYTHIA/TAUOLA
 	  into the event record
 
 2016-03-21
 	New internal implementation of polarization
 	  via Bloch vectors, remove pointer constructions
 
 2016-03-13
 	Extension of cascade syntax for processes:
 	  exclude propagators/vertices etc. possible
 
 2016-02-24
 	Full support for OpenLoops QCD NLO matrix
 	  elements, inclusion in test suite
 
 2016-02-12
 	Substantial progress on QCD NLO support
 
 2016-02-02
 	Automated resonance mapping for FKS subtraction
 
 2015-12-17
 	New BSM model WZW for diphoton resonances
 
 ##################################################################
 
 2015-11-22
 	RELEASE: version 2.2.8
 
 2015-11-21
 	Bugfix for fixed-order NLO events
 
 2015-11-20
 	Anomalous FCNC top-charm vertices
 
 2015-11-19
 	StdHEP output via HEPEVT/HEPEV4 supported
 
 2015-11-18
 	Full set of electroweak dim-6 operators included
 
 2015-10-22
 	Polarized one-loop amplitudes supported
 
 2015-10-21
 	Fixes for event formats for showered events
 
 2015-10-14
 	Callback mechanism for event output
 
 2015-09-22
 	Bypass matrix elements in pure event sample rescans
 	StdHep frozen final version v5.06.01 included internally
 
 2015-09-21
 	configure option --with-precision to
 	  demand 64bit, 80bit, or 128bit Fortran
 	  and bind C precision types
 
 2015-09-07
 	More extensive tests of NLO
 	   infrastructure and POWHEG matching
 
 2015-09-01
 	NLO decay infrastructure
 	User-defined squared matrix elements
 	Inclusive FastJet algorithm plugin
 	Numerical improvement for small boosts
 	
 ##################################################################
 
 2015-08-11
 	RELEASE: version 2.2.7
 	
 2015-08-10
 	Infrastructure for damped POWHEG
 	Massive emitters in POWHEG
 	Born matrix elements via BLHA
 	GoSam filters via SINDARIN
 	Minor running coupling bug fixes
 	Fixed-order NLO events
 
 2015-08-06
 	CT14 PDFs included (LO, NLO, NNLL)
 
 2015-07-07
 	Revalidation of ILC WHIZARD-PYTHIA event chain
 	Extended test suite for showered events
 	Alpha version of massive FSR for POWHEG
 	
 2015-06-09
 	Fix memory leak in interaction for long cascades
 	Catch mismatch between beam definition and CIRCE2 spectrum
 	
 2015-06-08
 	Automated POWHEG matching: beta version
 	Infrastructure for GKS matching
 	Alpha version of fixed-order NLO events
 	CIRCE2 polarization averaged spectra with
 	   explicitly polarized beams
 	
 2015-05-12
 	Abstract matching type: OO structure for matching/merging
 	
 2015-05-07
 	Bug fix in event record WHIZARD-PYTHIA6 transferral
 	Gaussian beam spectra for lepton colliders
 	
 ##################################################################
 
 2015-05-02
 	RELEASE: version 2.2.6
 
 2015-05-01
 	Models for (unitarized) tensor resonances in VBS
 	
 2015-04-28
 	Bug fix in channel weights for event generation.
 	
 2015-04-18
 	Improved event record transfer WHIZARD/PYTHIA6
 
 2015-03-19
 	POWHEG matching: alpha version
 	
 ##################################################################
 	
 2015-02-27
 	RELEASE: version 2.2.5
 
 2015-02-26
 	Abstract types for quantum numbers
 	
 2015-02-25
 	Read-in of StdHEP events, self-tests
 	
 2015-02-22
 	Bugfix for mother-daughter relations in
 	   showered/hadronized events
 
 2015-02-20
 	Projection on polarization in intermediate states
 	
 2015-02-13	
 	Correct treatment of beam remnants in
 	   event formats (also LC remnants)
 	
 ##################################################################
 	
 2015-02-06
 	RELEASE: version 2.2.4
 
 2015-02-06
 	Bugfix in event output
 
 2015-02-05	
 	LCIO event format supported
 	
 2015-01-30
 	Including state matrices in WHIZARD's internal IO
 	Versioning for WHIZARD's internal IO
 	Libtool update from 2.4.3 to 2.4.5
 	LCIO event output (beta version)
 	
 2015-01-27
 	Progress on NLO integration
 	Fixing a bug for multiple processes in a single
 	   event file when using beam event files
 	
 2015-01-19
 	Bug fix for spin correlations evaluated in the rest
 	   frame of the mother particle
 	
 2015-01-17
 	Regression fix for statically linked processes
 	   from SARAH and FeynRules
 	
 2015-01-10
 	NLO: massive FKS emitters supported (experimental)
 	
 2015-01-06
 	MMHT2014 PDF sets included
 	
 2015-01-05
 	Handling mass degeneracies in auto_decays
 
 2014-12-19
 	Fixing bug in rescan of event files
 
 ##################################################################
 
 2014-11-30
 	RELEASE: version 2.2.3
 
 2014-11-29
 	Beta version of LO continuum/NLL-threshold
 	matched top threshold model for e+e- physics
 
 2014-11-28
 	More internal refactoring: disentanglement of module
 	   dependencies
 
 2014-11-21
 	OVM: O'Mega Virtual Machine, bytecode instructions
 	   instead of compiled Fortran code
 
 2014-11-01
 	Higgs Singlet extension model included
 
 2014-10-18
 	Internal restructuring of code; half-way
 	  WHIZARD main code file disassembled
 
 2014-07-09
 	Alpha version of NLO infrastructure
 
 ##################################################################
 
 2014-07-06
 	RELEASE: version 2.2.2
 
 2014-07-05
 	CIRCE2: correlated LC beam spectra and
 	  GuineaPig Interface to LC machine parameters
 
 2014-07-01
 	Reading LHEF for decayed/factorized/showered/
 	   hadronized events
 
 2014-06-25
 	Configure support for GoSAM/Ninja/Form/QGraf
 
 2014-06-22
 	LHAPDF6 interface
 
 2014-06-18	
 	Module for automatic generation of 
 	  radiation and loop infrastructure code
 	
 2014-06-11
 	Improved internal directory structure
 	
 ##################################################################
 	
 2014-06-03
 	RELEASE: version 2.2.1
 
 2014-05-30
 	Extensions of internal PDG arrays
 	
 2014-05-26
 	FastJet interface
 
 2014-05-24
 	CJ12 PDFs included
 	
 2014-05-20
 	Regression fix for external models (via SARAH
 	    or FeynRules)
 	
 ##################################################################
 
 2014-05-18
 	RELEASE: version 2.2.0
 
 2014-04-11
 	Multiple components: inclusive process definitions,
 	   syntax: process A + B + ...
 
 2014-03-13
 	Improved PS mappings for e+e- ISR
 	ILC TDR and CLIC spectra included in CIRCE1
 
 2014-02-23
 	New models: AltH w\ Higgs for exclusion purposes,
 	  SM_rx for Dim 6-/Dim-8 operators, SSC for
 	  general strong interactions (w/ Higgs), and
 	  NoH_rx (w\ Higgs)
 
 2014-02-14
 	Improved s-channel mapping, new on-shell
 	  production mapping (e.g. Drell-Yan)
 
 2014-02-03
 	PRE-RELEASE: version 2.2.0_beta
 
 2014-01-26
 	O'Mega: Feynman diagram generation possible (again)
 
 2013-12-16
 	HOPPET interface for b parton matching
 
 2013-11-15
 	PRE-RELEASE: version 2.2.0_alpha-4
 
 2013-10-27
 	LHEF standards 1.0/2.0/3.0 implemented
 
 2013-10-15
 	PRE-RELEASE: version 2.2.0_alpha-3
 
 2013-10-02
 	PRE-RELEASE: version 2.2.0_alpha-2
 
 2013-09-25
 	PRE-RELEASE: version 2.2.0_alpha-1
 
 2013-09-12
 	PRE-RELEASE: version 2.2.0_alpha
 
 2013-09-03
 	General 2HDM implemented
 	
 2013-08-18
 	Rescanning/recalculating events 
 	
 2013-06-07
 	Reconstruction of complete event 
 	  from 4-momenta possible
 	
 2013-05-06
 	Process library stacks
 	
 2013-05-02
 	Process stacks
 	
 2013-04-29
 	Single-particle phase space module
 	
 2013-04-26
 	Abstract interface for random
 	  number generator
 	
 2013-04-24
 	More object-orientation on modules
 	Midpoint-rule integrator
 
 2013-04-05
 	Object-oriented integration and
 	  event generation
 
 2013-03-12
 	Processes recasted object-oriented:
 	  MEs, scales, structure functions
 	First infrastructure for general Lorentz
 	  structures
 
 2013-01-17
 	Object-orientated reworking of library and
 	   process core, more variable internal structure,
 	   unit tests
 
 2012-12-14
 	Update Pythia version to 6.4.27
 
 2012-12-04
 	Fix the phase in HAZ vertices
 
 2012-11-21
 	First O'Mega unit tests, some infrastructure
 
 2012-11-13
 	Bugfix in anom. HVV Lorentz structures
 
 ##################################################################
 
 2012-09-18
 	RELEASE: version 2.1.1
 
 2012-09-11
 	Model MSSM_Hgg with Hgg and HAA vertices
 
 2012-09-10
 	First version of implementation of multiple
 	   interactions in WHIZARD
 
 2012-09-05
 	Infrastructure for internal CKKW matching
 
 2012-09-02
 	C, C++, Python API
 
 2012-07-19
 	Fixing particle numbering in HepMC format
 
 ##################################################################
 
 2012-06-15
 	RELEASE: version 2.1.0
 
 2012-06-14
 	Analytical and kT-ordered shower officially
 	  released
 	PYTHIA interface officially released
 
 2012-05-09
 	Intrisince PDFs can be used for showering
 
 2012-05-04
 	Anomalous Higgs couplings a la hep-ph/9902321
 
 ##################################################################
 
 2012-03-19
 	RELEASE: version 2.0.7
 
 2012-03-15
 	Run IDs are available now
 	More event variables in analysis
 	Modified raw event format (compatibility mode exists)
 
 2012-03-12
 	Bugfix in decay-integration order
 	MLM matching steered completely internally now
 	
 2012-03-09
 	Special phase space mapping for narrow resonances
 	  decaying to 4-particle final states with far off-shell
 	  intermediate states
 	Running alphas from PDF collaborations with
 	  builtin PDFs
 	
 2012-02-16
 	Bug fix in cascades decay infrastructure
 	
 2012-02-04
 	WHIZARD documentation compatible with TeXLive 2011
 	
 2012-02-01
 	Bug fix in FeynRules interface with --prefix flag
 	
 2012-01-29
 	Bug fix with name clash of O'Mega variable names
 	
 2012-01-27
 	Update internal PYTHIA to version 6.4.26
 	Bug fix in LHEF output
 	
 2012-01-21
 	Catching stricter automake 1.11.2 rules
 	
 2011-12-23
 	Bug fix in decay cascade setup
 	
 2011-12-20
 	Bug fix in helicity selection rules
 	
 2011-12-16
 	Accuracy goal reimplemented
 	
 2011-12-14
 	WHIZARD compatible with TeXLive 2011
 	
 2011-12-09
 	Option --user-target added
 
 ##################################################################
 
 2011-12-07
 	RELEASE: version 2.0.6
 
 2011-12-07
 	Bug fixes in SM_top_anom
 	Added missing entries to HepMC format
 
 2011-12-06
 	Allow to pass options to O'Mega
 	Bug fix for HEPEVT block for showered/hadronized events
 
 2011-12-01
 	Reenabled user plug-in for external code for
 	   cuts, structure functions, routines etc.
 
 2011-11-29
 	Changed model SM_Higgs for Higgs phenomenology
 
 2011-11-25
 	Supporting a Y, (B-L) Z' model
 
 2011-11-23
 	Make WHIZARD compatible for MAC OS X Lion/XCode 4
 
 2011-09-25
 	WHIZARD paper published: Eur.Phys.J. C71 (2011) 1742
 
 2011-08-16
 	Model SM_QCD: QCD with one EW insertion
 
 2011-07-19
 	Explicit output channel for dvips avoids printing
 
 2011-07-10
 	Test suite for WHIZARD unit tests
 
 2011-07-01
 	Commands for matrix element tests
 	More OpenMP parallelization of kinematics
 	Added unit tests
 
 2011-06-23
 	Conversion of CIRCE2 from F77 to F90, major
 	  clean-up
 
 2011-06-14
 	Conversion of CIRCE1 from F77 to F90
 
 2011-06-10
 	OpenMP parallelization of channel kinematics
 		(by Matthias Trudewind)
 
 2011-05-31 
 	RELEASE: version 1.97
 
 2011-05-24 
 	Minor bug fixes: update grids and elsif statement. 
 
 ##################################################################
 
 2011-05-10 
 	RELEASE: version 2.0.5
 
 2011-05-09
 	Fixed bug in final state flavor sums
 	Minor improvements on phase-space setup
 
 2011-05-05
 	Minor bug fixes
 
 2011-04-15
 	WHIZARD as a precompiled 64-bit binary available
 
 2011-04-06
 	Wall clock instead of cpu time for time estimates
 
 2011-04-05
 	Major improvement on the phase space setup
 
 2011-04-02
 	OpenMP parallelization for helicity loop in O'Mega
 	   matrix elements
 
 2011-03-31
 	Tools for relocating WHIZARD and use in batch
 	environments
 
 2011-03-29
 	Completely static builds possible, profiling options
 
 2011-03-28
 	Visualization of integration history
 
 2011-03-27
 	Fixed broken K-matrix implementation
 
 2011-03-23
 	Including the GAMELAN manual in the distribution
 
 2011-01-26
 	WHIZARD analysis can handle hadronized event files
 
 2011-01-17
 	MSTW2008 and CT10 PDF sets included
 
 2010-12-23
 	Inclusion of NMSSM with Hgg couplings
 
 2010-12-21
 	Advanced options for integration passes
 
 2010-11-16
 	WHIZARD supports CTEQ6 and possibly other PDFs
 	directly; data files included in the distribution
 
 ##################################################################
 
 2010-10-26
 	RELEASE: version 2.0.4
 
 2010-10-06
 	Bug fix in MSSM implementation
 
 2010-10-01
 	Update to libtool 2.4
 
 2010-09-29
 	Support for anomalous top couplings (form factors etc.)
 	Bug fix for running gauge Yukawa SUSY couplings
 
 2010-09-28
 	RELEASE: version 1.96
 
 2010-09-21
 	Beam remnants and pT spectra for lepton collider re-enabled
 	Restructuring subevt class
 
 2010-09-16
 	Shower and matching are disabled by default
 	PYTHIA as a conditional on these two options
 
 2010-09-14
 	Possibility to read in beam spectra re-enabled (e.g. Guinea
 	   Pig)
 
 2010-09-13
 	Energy scan as (pseudo-) structure functions re-implemented
 
 2010-09-10
 	CIRCE2 included again in WHIZARD 2 and validated
 
 2010-09-02
 	Re-implementation of asymmetric beam energies and collision
 	  angles, e-p collisions work, inclusion of a HERA DIS test
 	  case
 
 ##################################################################
 
 2010-10-18
 	RELEASE: version 2.0.3
 
 2010-08-08
 	Bug in CP-violating anomalous triple TGCs fixed
 
 2010-08-06
 	Solving backwards compatibility problem with O'Caml 3.12.0
 
 2010-07-12
 	Conserved quantum numbers speed up O'Mega code generation
 
 2010-07-07
 	Attaching full ISR/FSR parton shower and MPI/ISR
 	   module
 	Added SM model containing Hgg, HAA, HAZ vertices
 
 2010-07-02
 	Matching output available as LHEF and STDHEP
 
 2010-06-30
 	Various bug fixes, missing files, typos
 
 2010-06-26
 	CIRCE1 completely re-enabled
 	Chaining structure functions supported
 
 2010-06-25
 	Partial support for conserved quantum numbers in
 	   O'Mega
 
 2010-06-21
 	Major upgrade of the graphics package: error bars,
 	   smarter SINDARIN steering, documentation, and all that...
 
 2010-06-17
 	MLM matching with PYTHIA shower included
 
 2010-06-16 
 	Added full CIRCE1 and CIRCE2 versions including
 	full documentation and miscellanea to the trunk
 
 2010-06-12
 	User file management supported, improved variable
 	and command structure
 
 2010-05-24
 	Improved handling of variables in local command lists
 
 2010-05-20
 	PYTHIA interface re-enabled
 
 2010-05-19
 	ASCII file formats for interfacing ROOT and gnuplot in
 	   data analysis
 
 ##################################################################
 
 2010-05-18
 	RELEASE: version 2.0.2
 
 2010-05-14
 	Reimplementation of visualization of phase space
 	   channels
 	Minor bug fixes
 
 2010-05-12
 	Improved phase space - elimination of redundancies
 
 2010-05-08
 	Interface for polarization completed: polarized beams etc.
 
 2010-05-06
 	Full quantum numbers appear in process log
 	Integration results are usable as user variables
 	Communication with external programs
 
 2010-05-05
 	Split module commands into commands, integration,
 	   simulation modules
 
 2010-05-04
 	FSR+ISR for the first time connected to the WHIZARD 2 core
 
 ##################################################################
 
 2010-04-25
 	RELEASE: version 2.0.1
 
 2010-04-23
 	Automatic compile and integrate if simulate is called
 	Minor bug fixes in O'Mega
 
 2010-04-21
 	Checkpointing for event generation
 	Flush statements to use WHIZARD inside a pipe
 
 2010-04-20
 	Reimplementation of signal handling in WGIZARD 2.0
 
 2010-04-19
 	VAMP is now a separately configurable and installable unit of
 	   WHIZARD, included VAMP self-checks
 	Support again compilation in quadruple precision
 
 2010-04-06
 	Allow for logarithmic plots in GAMELAN, reimplement the
 	   possibility to set the number of bins
 
 2010-04-15
 	Improvement on time estimates for event generation
 
 ##################################################################
 
 2010-04-12
 	RELEASE: version 2.0.0
 
 2010-04-09
 	Per default, the code for the amplitudes is subdivided to allow
 	  faster compiler optimization
 	More advanced and unified and straightforward command language
 	  syntax
 	Final bug fixes
 
 2010-04-07
 	Improvement on SINDARIN syntax; printf, sprintf function
 	  thorugh a C interface
 
 2010-04-05
 	Colorizing DAGs instead of model vertices: speed boost
 	  in colored code generation
 
 2010-03-31
 	Generalized options for normalization of weighted and
 	  unweighted events
 	Grid and weight histories added again to log files
 	Weights can be used in analyses
 
 2010-03-28
 	Cascade decays completely implemented including color and
 	   spin correlations
 
 2010-03-07
 	Added new WHIZARD header with logo
 
 2010-03-05
 	Removed conflict in O'Mega amplitudes between flavour sums
 	   and cascades
 	StdHEP interface re-implemented
 
 2010-03-03
 	RELEASE: version 2.0.0rc3
 	Several bug fixes for preventing abuse in input files
 	OpenMP support for amplitudes
 	Reimplementation of WHIZARD 1 HEPEVT ASCII event formats
 	FeynRules interface successfully passed MSSM test
 
 2010-02-26
 	Eliminating ghost gluons from multi-gluon amplitudes
 
 2010-02-25
 	RELEASE: version 1.95
 	HEPEVT format from WHIZARD 1 re-implemented in WHIZARD 2
 
 2010-02-23
 	Running alpha_s implemented in the FeynRules interface
 
 2010-02-19
 	MSSM (semi-) automatized self-tests finalized
 
 2010-02-17
 	RELEASE: version 1.94
 
 2010-02-16
 	Closed memory corruption in WHIZARD 1
 	Fixed problems of old MadGraph and CompHep drivers
 	   with modern compilers
 	Uncolored vertex selection rules for colored amplitudes in
 	   O'Mega
 
 2010-02-15
 	Infrastructure for color correlation computation in O'Mega
 	   finished
 	Forbidden processes are warned about, but treated as non-fatal
 
 2010-02-14
 	Color correlation computation in O'Mega finalized
 
 2010-02-10
 	Improving phase space mappings for identical particles in
 	initial and final states
 	Introduction of more extended multi-line error message
 
 2010-02-08
 	First O'Caml code for computation of color correlations in
 	O'Mega
 
 2010-02-07
 	First MLM matching with e+ e- -> jets
 
 ##################################################################
 
 2010-02-06
 	RELEASE: version 2.0.0rc2
 
 2010-02-05
 	Reconsidered the Makefile structure and more extended tests
 	Catch a crash between WHIZARD and O'Mega for forbidden processes
 	Tensor products of arbitrary color structures in jet definitions
 
 2010-02-04
 	Color correlation computation in O'Mega finalized
 
 ##################################################################
 
 2010-02-03
 	RELEASE: version 2.0.0rc1
 
 ##################################################################
 
 2010-01-31
 	Reimplemented numerical helicity selection rules
 	Phase space functionality of version 1 restored and improved
 
 2009-12-05
 	NMSSM validated with FeynRules in WHIZARD 1 (Felix Braam)
 
 2009-12-04
 	RELEASE: version 2.0.0alpha
 
 ##################################################################
 
 2009-04-16
 	RELEASE: version 1.93
 
 2009-04-15
 	Clean-up of Makefiles and configure scripts
 	Reconfiguration of BSM model implementation
 	extended supersymmetric models
 
 2008-12-23
 	New model NMSSM	(Felix Braam)
 	SLHA2 added
 	Bug in LHAPDF interface fixed
 
 2008-08-16
 	Bug fixed in K matrix implementation
 	Gravitino option in the MSSM added
 
 2008-03-20
 	Improved color and flavor sums
 
 ##################################################################
 
 2008-03-12
 	RELEASE: version 1.92
 	LHEF (Les Houches Event File) format added
 	Fortran 2003 command-line interface (if supported by the compiler)
 	Automated interface to colored models
 	More bug fixes and workarounds for compiler compatibility
 
 ##################################################################
 
 2008-03-06
 	RELEASE: version 1.91
 	New model K-matrix (resonances and anom. couplings in WW scattering)
 	EWA spectrum
 	Energy-scan pseudo spectrum
 	Preliminary parton shower module (only from final-state quarks)
 	Cleanup and improvements of configure process
 	Improvements for O'Mega parameter files
 	Quadruple precision works again
 	More plotting options: lines, symbols, errors
 	Documentation with PDF bookmarks enabled
 	Various bug fixes
 
 2007-11-29 
 	New model UED
 
 ##################################################################
 
 2007-11-23 
 	RELEASE: version 1.90
 	O'Mega now part of the WHIZARD tree
 	Madgraph/CompHEP disabled by default (but still usable)
 	Support for LHAPDF (preliminary)
 	Added new models: SMZprime, SM_km, Template
 	Improved compiler recognition and compatibility
 	Minor bug fixes
 
 ##################################################################
 
 2006-06-15
 	RELEASE: version 1.51
 	Support for anomaly-type Higgs couplings (to gluon and photon/Z)
 	Support for spin 3/2 and spin 2
 	New models: Little Higgs (4 versions), toy models for extra dimensions
           and gravitinos
 	Fixes to the whizard.nw source documentation to run through LaTeX
 	Intel 9.0 bug workaround (deallocation of some arrays)
 
 2006-05-15
 	O'Mega RELEASE: version 0.11
 	merged JRR's O'Mega extensions
 
 ##################################################################
 
 2006-02-07
 	RELEASE: version 1.50
         To avoid confusion: Mention outdated manual example in BUGS file
         O'Mega becomes part of the WHIZARD generator
 
 2006-02-02   [bug fix update]
 	Bug fix: spurious error when writing event files for weighted events
 	Bug fix: 'r' option for omega produced garbage for some particle names
 	Workaround for ifort90 bug (crash when compiling whizard_event)
 	Workaround for ifort90 bug (crash when compiling hepevt_common)
 
 2006-01-27
 	Added process definition files for MSSM 2->2 processes
 	Included beam recoil for EPA (T.Barklow)
 	Updated STDHEP byte counts (for STDHEP 5.04.02)
 	Fixed STDHEP compatibility (avoid linking of incomplete .so libs)
 	Fixed issue with comphep requiring Xlibs on Opteron
 	Fixed issue with ifort 8.x on Opteron (compiling 'signal' interface)
 	Fixed color-flow code: was broken for omega with option 'c' and 'w'
 	Workaround hacks for g95 compatibility
 
 2005-11-07
 	O'Mega RELEASE: version 0.10
 	O'Mega, merged JRR's and WK's color hack for WHiZard
         O'Mega, EXPERIMENTAL: cache fusion tables (required for colors
 	  a la JRR/WK)
         O'Mega, make JRR's MSSM official
 
 ##################################################################
 
 2005-10-25
 	RELEASE: version 1.43
 	Minor fixes in MSSM couplings (Higgs/3rd gen squarks).
 	  This should be final, since the MSSM results agree now completely
           with Madgraph and Sherpa
 	User-defined lower and upper limits for split event file count
 	Allow for counters (events, bytes) exceeding $2^{31}$
 	Revised checksum treatment and implementation (now MD5)
         Bug fix: missing process energy scale in raw event file
 
 ##################################################################
 
 2005-09-30
 	RELEASE: version 1.42
 	Graphical display of integration history ('make history')
 	Allow for switching off signals even if supported (configure option)
 
 2005-09-29
 	Revised phase space generation code, in particular for flavor sums
 	Negative cut and histogram codes use initial beams instead of
 	  initial parton momenta.  This allows for computing, e.g., E_miss
 	Support constant-width and zero-width options for O'Mega
 	Width options now denoted by w:X (X=f,c,z).  f option obsolescent
 	Bug fix: colorized code: flipped indices could screw up result
 	Bug fix: O'Mega with 'c' and 'w:f' option together (still some problem)
 	Bug fix: dvips on systems where dvips defaults to lpr
 	Bug fix: integer overflow if too many events are requested
 
 2005-07-29
 	Allow for 2 -> 1 processes (if structure functions are on)
 
 2005-07-26
 	Fixed and expanded the 'test' matrix element:
 	  Unit matrix element with option 'u' / default: normalized phase space
 
 ##################################################################
 
 2005-07-15
 	RELEASE: version 1.41
 	Bug fix: no result for particle decay processes with width=0
 	Bug fix: line breaks in O'Mega files with color decomposition
 
 2005-06-02
 	New self-tests (make test-QED / test-QCD / test-SM)
 	  check lists of 2->2 processes
 	Bug fix: HELAS calling convention for wwwwxx and jwwwxx (4W-Vertex)
 
 2005-05-25
 	Revised Makefile structure
 	Eliminated obsolete references to ISAJET/SUSY (superseded by SLHA)
 
 2005-05-19
 	Support for color in O'Mega (using color flow decomposition)
 	New model QCD
 	Parameter file changes that correspond to replaced SM module in O'Mega
 	Bug fixes in MSSM (O'Mega) parameter file
 
 2005-05-18
 	New event file formats, useful for LHC applications:
           ATHENA and Les Houches Accord (external fragmentation)
         Naive (i.e., leading 1/N) color factor now implemented both for
           incoming and outgoing partons
 
 2005-01-26
 	include missing HELAS files for bundle
 	pgf90 compatibility issues [note: still internal error in pgf90]
 
 ##################################################################
 
 2004-12-13
 	RELEASE: version 1.40
 	compatibility fix: preprocessor marks in helas code now commented out
 	minor bug fix: format string in madgraph source
 
 2004-12-03
 	support for arbitray beam energies and directions
 	allow for pT kick in structure functions
 	bug fix: rounding error could result in zero cross section
 	  (compiler-dependent)
 
 2004-10-07
 	simulate decay processes
 	list fraction (of total width/cross section) instead of efficiency
           in process summary
 	new cut/analysis parameters AA, AAD, CTA: absolute polar angle
 
 2004-10-04
 	Replaced Madgraph I by Madgraph II.  Main improvement: model no
           longer hardcoded
 	introduced parameter reset_seed_each_process (useful for debugging)
         bug fix: color initialization for some processes was undefined
 
 2004-09-21
 	don't compile unix_args module if it is not required
 
 ##################################################################
 
 2004-09-20
 	RELEASE: version 1.30
 	g95 compatibility issues resolved
 	some (irrelevant) memory leaks closed
 	removed obsolete warning in circe1
 	manual update (essentially) finished
 
 2004-08-03
 	O'Mega RELEASE: version 0.9
 	O'Mega, src/trie.mli, src/trie.ml: make interface compatible with
           the O'Caml 3.08 library (remains compatible with older
           versions).  Implementation of unused functions still
           incomplete.
 
 2004-07-26
 	minor fixes and improvements in make process
 
 2004-06-29
 	workarounds for new Intel compiler bugs ...
 	no rebuild of madgraph/comphep executables after 'make clean'
 	bug fix in phase space routine:
           wrong energy for massive initial particles
         bug fix in (new) model interface: name checks for antiparticles
         pre-run checks for comphep improved
         ww-strong model file extended
         Model files particle name fixes, chep SM vertices included
 
 2004-06-22
 	O'Mega RELEASE: version 0.8
 	O'Mega MSSM: sign of W+/W-/A and W+/W-/Z couplings
 
 2004-05-05
 	Fixed bug in PDFLIB interface: p+pbar was initialized as p+p (ThO)
 	NAG compiler: set number of continuation lines to 200 as default
 	Extended format for cross section summary; appears now in whizard.out
 	Fixed 'bundle' feature
 
 2004-04-28
 	Fixed compatibility with revised O'Mega SM_ac model
 	Fixed problem with x=0 or x=1 when calling PDFLIB (ThO)
 	Fixed bug in comphep module: Vtb was overlooked
 
 ##################################################################
 
 2004-04-15 
 	RELEASE: version 1.28	
         Fixed bug: Color factor was missing for O'Mega processes with
           four quarks and more
         Manual partially updated
 
 2004-04-08 
 	Support for grid files in binary format
 	New default value show_histories=F (reduce output file size)
 	Revised phase space switches: removed annihilation_lines,
 	  removed s_channel_resonance, changed meaning of 
 	  extra_off_shell_lines, added show_deleted_channels
 	Bug fixed which lead to omission of some phase space channels
 	Color flow guessed only if requested by guess_color_flow
 
 2004-03-10 
 	New model interface: Only one model name specified in whizard.prc
         All model-dependent files reside in conf/models (modellib removed)
 
 2004-03-03 
 	Support for input/output in SUSY Les Houches Accord format
 	Split event files if requested
 	Support for overall time limit
 	Support for CIRCE and CIRCE2 generator mode
 	Support for reading beam events from file
 
 2004-02-05 
 	Fixed compiler problems with Intel Fortran 7.1 and 8.0
 	Support for catching signals
 
 ##################################################################
 
 2003-08-06 
 	RELEASE: version 1.27	
 	User-defined PDF libraries as an alternative to the standard PDFLIB
 
 2003-07-23 
 	Revised phase space module: improved mappings for massless particles,
 	  equivalences of phase space channels are exploited
 	Improved mapping for PDF (hadron colliders)
 	Madgraph module: increased max number of color flows from 250 to 1000
 
 ##################################################################
 
 2003-06-23 
 	RELEASE: version 1.26
 	CIRCE2 support
 	Fixed problem with 'TC' integer kind [Intel compiler complained]
 
 2003-05-28 
 	Support for drawing histograms of grids
 	Bug fixes for MSSM definitions
 
 ##################################################################
 
 2003-05-22 
 	RELEASE: version 1.25
 	Experimental MSSM support with ISAJET interface
 	Improved capabilities of generating/analyzing weighted events
 	Optional drawing phase space diagrams using FeynMF
 
 ##################################################################
 
 2003-01-31 
 	RELEASE: version 1.24
 	A few more fixes and workarounds (Intel and Lahey compiler)
 
 2003-01-15 
 	Fixes and workarounds needed for WHIZARD to run with Intel compiler
 	Command-line option interface for the Lahey compiler
 
 	Bug fix: problem with reading whizard.phs
 
 ##################################################################
 
 2002-12-10 
 	RELEASE: version 1.23
 
 	Command-line options (on some systems)
 
 	Allow for initial particles in the event record, ordered:
           [beams, initials] - [remnants] - outgoing partons
 
 	Support for PYTHIA 6.2: Les Houches external process interface
 	String pythia_parameters can be up to 1000 characters long
 	Select color flow states in (internal) analysis
 	Bug fix in color flow content of raw event files
 
 	Support for transversal polarization of fermion beams
 	Cut codes: PHI now for absolute azimuthal angle, DPHI for distance
 	'Test' matrix elements optionally respect polarization
 
 	User-defined code can be inserted for spectra, structure functions
           and fragmentation
 
 	Time limits can be specified for adaptation and simulation
 	User-defined file names and file directory
         Initial weights in input file no longer supported
 
         Bug fix in MadGraph (wave function counter could overflow)
 
 	Bug fix: Gamelan (graphical analysis) was not built if noweb absent
 
 ##################################################################
 
 2002-03-16 
 	RELEASE: version 1.22
 	Allow for beam remnants in the event record
 
 2002-03-01 
         Handling of aliases in whizard.prc fixed (aliases are whole tokens)
 
 2002-02-28 
 	Optimized phase space handling routines
 	  (total execution time reduced by 20-60%, depending on process)
 
 ##################################################################
 
 2002-02-26 
 	RELEASE: version 1.21
 	Fixed ISR formula (ISR was underestimated in previous versions).
           New version includes ISR in leading-log approximation up to 
           third order.  Parameter ISR_sqrts renamed to ISR_scale.
 
 ##################################################################
 
 2002-02-19 
 	RELEASE: version 1.20	
 	New process-generating method 'test' (dummy matrix element)
 	Compatibility with autoconf 2.50 and current O'Mega version
 
 2002-02-05 
 	Prevent integration channels from being dropped (optionally)
 	New internal mapping for structure functions improves performance
 	Old whizard.phx file deleted after recompiling (could cause trouble)
 
 2002-01-24 
 	Support for user-defined cuts and matrix element reweighting
 	STDHEP output now written by write_events_format=20 (was 3)
 
 2002-01-16 
 	Improved structure function handling; small changes in user interface:
           new parameter structured_beams in &process_input
           parameter fixed_energy in &beam_input removed
 	Support for multiple initial states
 	Eta-phi (cone) cut possible (hadron collider applications)
 	Fixed bug: Whizard library was not always recompiled when necessary
 	Fixed bug: Default cuts were insufficient in some cases
 	Fixed bug: Unusable phase space mappings generated in some cases
 
 2001-12-06 
 	Reorganized document source
 
 2001-12-05 
 	Preliminary CIRCE2 support (no functionality yet)
 
 2001-11-27 
 	Intel compiler support (does not yet work because of compiler bugs)
 	New cut and analysis mode cos-theta* and related
 	Fixed circular jetset_interface dependency warning
 	Some broadcast routines removed (parallel support disabled anyway)
 	Minor shifts in cleanup targets (Makefiles)
         Modified library search, check for pdflib8*
 
 2001-08-06 
 	Fixed bug: I/O unit number could be undefined when reading phase space
 	Fixed bug: Unitialized variable could cause segfault when 
                    event generation was disabled
 	Fixed bug: Undefined subroutine in CIRCE replacement module
 	Enabled feature: TGCs in O'Mega (not yet CompHEP!) matrix elements
 		   (CompHEP model sm-GF #5, O'Mega model SM_ac)
 	Fixed portability issue: Makefile did rely on PWD environment variable
 	Fixed portability issue: PYTHIA library search ambiguity resolved
 
 2001-08-01 
 	Default whizard.prc and whizard.in depend on activated modules
 	Fixed bug: TEX=latex was not properly enabled when making plots
 
 2001-07-20 
 	Fixed output settings in PERL script calls
 	Cache enabled in various configure checks
 
 2001-07-13 
 	Support for multiple processes in a single WHIZARD run.  The 
           integrations are kept separate, but the generated events are mixed
 	The whizard.evx format has changed (incompatible), including now
 	  the color flow information for PYTHIA fragmentation
 	Output files are now process-specific, except for the event file
 	Phase space file whizard.phs (if present) is used only as input,
 	  program-generated phase space is now in whizard.phx
 
 2001-07-10 
 	Bug fix: Undefined parameters in parameters_SM_ac.f90 removed
 
 2001-07-04 
 	Bug fix: Compiler options for the case OMEGA is disabled
 	Small inconsistencies in whizard.out format fixed
 
 2001-07-01 
 	Workaround for missing PDFLIB dummy routines in PYTHIA library
 
 ##################################################################
 
 2001-06-30
 	RELEASE: version 1.13
 	Default path /cern/pro/lib in configure script
 
 2001-06-20
 	New fragmentation option: Interface for PYTHIA with full color flow
           information, beam remnants etc.
 
 2001-06-18
 	Severe bug fixed in madgraph interface: 3-gluon coupling was missing
 	Enabled color flow information in madgraph
 
 2001-06-11
 	VAMP interface module rewritten
 	Revised output format: Multiple VAMP iterations count as one WHIZARD
           iteration in integration passes 1 and 3
 	Improved message and error handling
 	Bug fix in VAMP: handle exceptional cases in rebinning_weights
 
 2001-05-31
 	new parameters for grid adaptation: accuracy_goal and efficiency_goal
 
 ##################################################################
 
 2001-05-29
 	RELEASE: version 1.12
 	bug fixes (compilation problems): deleted/modified unused functions
 
 2001-05-16
 	diagram selection improved and documented
 
 2001-05-06
         allow for disabling packages during configuration
 
 2001-05-03
 	slight changes in whizard.out format; manual extended
 
 ##################################################################
 
 2001-04-20
 	RELEASE: version 1.11
 	fixed some configuration and compilation problems (PDFLIB etc.)
 
 2001-04-18
 	linked PDFLIB: support for quark/gluon structure functions
 
 2001-04-05
 	parameter interface written by PERL script
 	SM_ac model file: fixed error in continuation line
 
 2001-03-13
 	O'Mega, O'Caml 3.01: incompatible changes
 	O'Mega, src/trie.mli: add covariance annotation to T.t
 	  This breaks O'Caml 3.00, but is required for O'Caml 3.01.
 	O'Mega, many instances: replace `sig include Module.T end' by
 	  `Module.T', since the bug is fixed in O'Caml 3.01
 
 2001-02-28
 	O'Mega, src/model.mli:
             new field Model.vertices required for model functors, will
 	    retire Model.fuse2, Model.fuse3, Model.fusen soon.
 
 ##################################################################
 
 2001-03-27
 	RELEASE: version 1.10
 	reorganized the modules as libraries
 	linked PYTHIA: support for parton fragmentation
 
 2000-12-14
 	fixed some configuration problems (if noweb etc. are absent)
 
 ##################################################################
 
 2000-12-01
 	RELEASE of first public version: version 1.00beta