Index: trunk/omega/src/partial.ml
===================================================================
--- trunk/omega/src/partial.ml	(revision 8813)
+++ trunk/omega/src/partial.ml	(revision 8814)
@@ -1,160 +1,160 @@
 (* partial.ml --
 
    Copyright (C) 1999-2015 by
 
        Wolfgang Kilian <kilian@physik.uni-siegen.de>
        Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
        Juergen Reuter <juergen.reuter@desy.de>
 
    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.  *)
 
 module type T =
   sig
     type domain
     type 'a t
     val of_list : (domain * 'a) list -> 'a t
     val of_lists : domain list -> 'a list -> 'a t
     exception Undefined of domain
     val apply : 'a t -> domain -> 'a
     val apply_with_fallback : (domain -> 'a) -> 'a t -> domain -> 'a
     val auto : domain t -> domain -> domain
   end
 
 module Make (D : Map.OrderedType) : T with type domain = D.t =
   struct
 
     module M = Map.Make (D)
 
     type domain = D.t
     type 'a t = 'a M.t
 
     let of_list l =
       List.fold_left (fun m (d, v) -> M.add d v m) M.empty l
 
     let of_lists domain values =
       of_list
 	(try
 	   List.map2 (fun d v -> (d, v)) domain values
 	 with
-	    | Invalid_argument "List.map2" ->
-	      invalid_arg "Partial.of_lists: length mismatch")
+	 | Invalid_argument _ (* ["List.map2"] *) ->
+	    invalid_arg "Partial.of_lists: length mismatch")
 
     let auto partial d =
       try
 	M.find d partial
       with
       | Not_found -> d
 
     exception Undefined of domain
 
     let apply partial d =
       try
 	M.find d partial
       with
       | Not_found -> raise (Undefined d)
 
     let apply_with_fallback fallback partial d =
       try
 	M.find d partial
       with
       | Not_found -> fallback d
 
   end
 
 (* \thocwmodulesection{Unit Tests} *)
 
 module Test : sig val suite : OUnit.test end =
   struct
 
     open OUnit
 
     module P = Make (struct type t = int let compare = compare end)
 
     let apply_ok =
       "apply/ok" >::
 	(fun () ->
 	  let p = P.of_list [ (0,"a"); (1,"b"); (2,"c") ]
 	  and l = [ 0; 1; 2 ] in
 	  assert_equal [ "a"; "b"; "c" ] (List.map (P.apply p) l))
 	
     let apply_ok2 =
       "apply/ok2" >::
 	(fun () ->
 	  let p = P.of_lists [0; 1; 2] ["a"; "b"; "c"]
 	  and l = [ 0; 1; 2 ] in
 	  assert_equal [ "a"; "b"; "c" ] (List.map (P.apply p) l))
 
     let apply_shadowed =
       "apply/shadowed" >::
 	(fun () ->
 	  let p = P.of_list [ (0,"a"); (1,"b"); (2,"c"); (1,"d") ]
 	  and l = [ 0; 1; 2 ] in
 	  assert_equal [ "a"; "d"; "c" ] (List.map (P.apply p) l))
 
     let apply_shadowed2 =
       "apply/shadowed2" >::
 	(fun () ->
 	  let p = P.of_lists [0; 1; 2; 1] ["a"; "b"; "c"; "d"]
 	  and l = [ 0; 1; 2 ] in
 	  assert_equal [ "a"; "d"; "c" ] (List.map (P.apply p) l))
 
     let apply_mismatch =
       "apply/mismatch" >::
 	(fun () ->
 	  assert_raises
 	    (Invalid_argument "Partial.of_lists: length mismatch")
 	    (fun () -> P.of_lists [0; 1; 2] ["a"; "b"; "c"; "d"]))
 
     let suite_apply =
       "apply" >:::
 	[apply_ok;
 	 apply_ok2;
 	 apply_shadowed;
 	 apply_shadowed2;
 	 apply_mismatch]
 
     let auto_ok =
       "auto/ok" >::
 	(fun () ->
 	  let p = P.of_list [ (0,10); (1,11)]
 	  and l = [ 0; 1; 2 ] in
 	  assert_equal [ 10; 11; 2 ] (List.map (P.auto p) l))
 
     let suite_auto =
       "auto" >:::
 	[auto_ok]
 
     let apply_with_fallback_ok =
       "apply_with_fallback/ok" >::
 	(fun () ->
 	  let p = P.of_list [ (0,10); (1,11)]
 	  and l = [ 0; 1; 2 ] in
 	  assert_equal
 	    [ 10; 11; -2 ] (List.map (P.apply_with_fallback (fun n -> - n) p) l))
 
     let suite_apply_with_fallback =
       "apply_with_fallback" >:::
 	[apply_with_fallback_ok]
 
     let suite =
       "Partial" >:::
 	[suite_apply;
 	 suite_auto;
 	 suite_apply_with_fallback]
 
     let time () =
       ()
 
   end
Index: trunk/omega/src/format_Fortran.ml
===================================================================
--- trunk/omega/src/format_Fortran.ml	(revision 8813)
+++ trunk/omega/src/format_Fortran.ml	(revision 8814)
@@ -1,275 +1,275 @@
 (* format_Fortran.ml -- Fortran90+ continuation lines etc.
 
    Copyright (C) 2019-2022 by
 
        Wolfgang Kilian <kilian@physik.uni-siegen.de>
        Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
        Juergen Reuter <juergen.reuter@desy.de>
 
    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.  *)
 
 let default_width = 80
 
 let max_clines = ref (-1) (* 255 *)
 exception Continuation_Lines of int
 
 (* Fortran style line continuation: *)
 
 type formatter =
   { formatter : Format.formatter;
     mutable current_cline : int;
     mutable width : int }
 
 let formatter_of_formatter ?(width=default_width) ff =
   { formatter = ff;
     current_cline = 1;
     width = width }
 
 (* Default function to output new lines. *)
 let pp_output_function ff =
   fst (Format.pp_get_formatter_output_functions ff.formatter ())
 
 (* Default function to output spaces (copied from \texttt{format.ml}). *)
 let blank_line = String.make 80 ' '
 let rec pp_display_blanks ff n =
   if n > 0 then
     if n <= 80 then
       pp_output_function ff blank_line 0 n
     else begin
         pp_output_function ff blank_line 0 80;
         pp_display_blanks ff (n - 80)
       end
 
 let pp_display_newline ff =
   pp_output_function ff "\n" 0  1
 
 (* [ff.current_cline]
    \begin{itemize}
      \item $\le0$: not continuing: print a straight newline,
      \item $>0$: continuing: append [" &"] until we run up to [!max_clines].
        NB: [!max_clines < 0] means \emph{unlimited} continuation lines.
    \end{itemize} *)
 
 let pp_switch_line_continuation ff = function
   | false -> ff.current_cline <- 0
   | true -> ff.current_cline <- 1
 
 let pp_fortran_newline ff () =
   if ff.current_cline > 0 then
     begin
       if !max_clines >= 0 && ff.current_cline > !max_clines then
         raise (Continuation_Lines ff.current_cline)
       else
         begin
           pp_output_function ff " &" 0 2;
           ff.current_cline <- succ ff.current_cline
         end
     end;
   pp_display_newline ff
 
 let pp_newline ff () =
   pp_switch_line_continuation ff false;
   Format.pp_print_newline ff.formatter ();
   pp_switch_line_continuation ff true
 
 (* Make a formatter with default functions to output spaces and new lines. *)
 
 (*i
 let unsafe_output oc s i j =
   try
     output oc s i j
   with
   | _ -> Printf.eprintf "unsafe_output: '%s'\n" s
 i*)
 
 let pp_setup ff =
   let formatter_out_functions =
     Format.pp_get_formatter_out_functions ff.formatter () in
   Format.pp_set_formatter_out_functions
     ff.formatter
     { formatter_out_functions with
-      out_newline = pp_fortran_newline ff;
-      out_spaces = pp_display_blanks ff };
+      Format.out_newline = pp_fortran_newline ff;
+      Format.out_spaces = pp_display_blanks ff };
   Format.pp_set_margin ff.formatter (ff.width - 2)
 
 let std_formatter =
   let ff = formatter_of_formatter Format.std_formatter in
   pp_setup ff;
   ff
 
 let formatter_of_out_channel ?(width=default_width) oc =
   let ff = formatter_of_formatter ~width (Format.formatter_of_out_channel oc) in
   pp_setup ff;
   ff
 
 let formatter_of_buffer ?(width=default_width) b =
   let ff =
     { formatter = Format.formatter_of_buffer b;
       current_cline = 1;
       width = width } in
   pp_setup ff;
   ff
 
 let pp_set_formatter_out_channel ff ?(width=default_width) oc =
   Format.pp_set_formatter_out_channel ff.formatter oc;
   ff.width <- width;
   pp_setup ff
 
 let set_formatter_out_channel ?(width=default_width) oc =
   Format.pp_set_formatter_out_channel std_formatter.formatter oc;
   std_formatter.width <- width;
   pp_setup std_formatter
 
 let fprintf ff fmt = Format.fprintf ff.formatter fmt
 let pp_flush ff = Format.pp_print_flush ff.formatter
 
 let printf fmt = fprintf std_formatter fmt
 let newline = pp_newline std_formatter
 let flush = pp_flush std_formatter
 let switch_line_continuation = pp_switch_line_continuation std_formatter
 
 module Test =
   struct
 
     open OUnit
 
     let input_line_opt ic =
       try
         Some (input_line ic)
       with
       | End_of_file -> None
  
     let read_lines ic =
       let rec read_lines' acc =
         match input_line_opt ic with
         | Some line -> read_lines' (line :: acc)
         | None -> List.rev acc
       in
       read_lines' []
  
     let lines_of_file filename =
       let ic = open_in filename in
       let lines = read_lines ic in
       close_in ic;
       lines
 
     let equal_or_dump_lines lhs rhs =
       if lhs = rhs then
         true
       else
         begin
           Printf.printf "Unexpected output:\n";
           List.iter (Printf.printf "< %s\n") lhs;
           List.iter (Printf.printf "> %s\n") rhs;
           false
         end
 
     let format_and_compare f expected () =
       bracket_tmpfile
         ~prefix:"omega-" ~suffix:".f90"
         (fun (name, oc) ->
           (* There can be something left in the queue from [OUnit]! *)
           Format.print_flush ();
           f oc;
           close_out oc;
           (* [OUnit] uses [Format.printf]! *)
           Format.set_formatter_out_channel stdout;
           assert_bool "" (equal_or_dump_lines expected (lines_of_file name)))
         ()
 
     let suite =
       "Format_Fortran" >:::
         [ "formatter_of_out_channel" >::
             format_and_compare
               (fun oc ->
                 let ff = formatter_of_out_channel ~width:20 oc in
                 let nl = pp_newline ff in
                 List.iter
                   (fprintf ff)
                   ["@[<2>lhs = rhs";
                    "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs";
                    "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"];
                 nl ())
               [ "lhs = rhs + rhs &";
                 "  + rhs + rhs &";
                 "  + rhs + rhs &";
                 "  + rhs + rhs &";
                 "  + rhs + rhs &";
                 "  + rhs" ];
 
           "formatter_of_buffer" >::
             format_and_compare
               (fun oc ->
                 let buffer = Buffer.create 1024 in
                 let ff = formatter_of_buffer ~width:20 buffer in
                 let nl = pp_newline ff in
                 List.iter
                   (fprintf ff)
                   ["  @[<2>lhs = rhs";
                    "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs";
                    "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"];
                 nl ();
                 pp_flush ff ();
                 let ff' = formatter_of_out_channel ~width:20 oc in
                 fprintf ff' "do mu = 0, 3"; pp_newline ff' ();
                 fprintf ff' "%s" (Buffer.contents buffer);
                 fprintf ff' "end do";
                 pp_newline ff' ())
               [ "do mu = 0, 3";
                 "  lhs = rhs + rhs &";
                 "    + rhs + rhs &";
                 "    + rhs + rhs &";
                 "    + rhs + rhs &";
                 "    + rhs + rhs &";
                 "    + rhs";
                 "end do" ];
 
           "formatter_of_out_channel+indentation" >::
             format_and_compare
               (fun oc ->
                 let ff = formatter_of_out_channel ~width:20 oc in
                 let nl = pp_newline ff in
                 List.iter
                   (fprintf ff)
                   ["  @[<4>lhs = rhs";
                    "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs";
                    "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"];
                 nl ())
               [ "  lhs = rhs + rhs &";
                 "      + rhs + rhs &";
                 "      + rhs + rhs &";
                 "      + rhs + rhs &";
                 "      + rhs + rhs &";
                 "      + rhs" ];
 
           "set_formatter_out_channel" >::
             format_and_compare
               (fun oc ->
                 let nl = newline in
                 set_formatter_out_channel ~width:20 oc;
                 List.iter
                   printf
                   ["@[<2>lhs = rhs";
                    "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs";
                    "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"; "@ + rhs"];
                 nl ())
               [ "lhs = rhs + rhs &";
                 "  + rhs + rhs &";
                 "  + rhs + rhs &";
                 "  + rhs + rhs &";
                 "  + rhs + rhs &";
                 "  + rhs" ]; ]
 
   end
Index: trunk/omega/tests/ward_driver_UFO.sh
===================================================================
--- trunk/omega/tests/ward_driver_UFO.sh	(revision 8813)
+++ trunk/omega/tests/ward_driver_UFO.sh	(revision 8814)
@@ -1,161 +1,161 @@
 #! /bin/sh
 # ward_driver_UFO.sh --
 ########################################################################
 
 omega="$1"
 shift
 
 models="sm_ufo"
 
 modules=""
 
 ########################################################################
 while read module threshold n roots model unphysical mode process; do 
 
   case $module in
 
    '#'*) # skip comments
      ;;
 
    '')   # skip empty lines
      ;;
 
    '!'*) break
      ;;
 
     *)
       ########################################################################
       modules="$modules $module"
       eval threshold_$module=$threshold
       eval n_$module=$n
       eval roots_$module=$roots
       eval process_$module="'$process'"
       ########################################################################
 
       ########################################################################
 
       # echo "running $omega_bin -$mode '$process'" 1>&2
       $omega "$@" -model:exec \
         -target:parameter_module parameters_sm_ufo \
         -target:module amplitude_ward_ufo_physical_$module \
         -$mode "$process" 2>/dev/null
       $omega "$@" -model:exec \
         -target:parameter_module parameters_sm_ufo \
         -target:module amplitude_ward_ufo_unphysical_$module \
         -$mode "$process" -unphysical $unphysical 2>/dev/null
     ;;
   esac
 
 done
 ########################################################################
 
 for module in $modules; do
 
     for mode in physical unphysical; do
 
 cat <<EOF
 module interface_ward_ufo_${mode}_${module}
   use omega_interface
   use amplitude_ward_ufo_${mode}_${module}
   implicit none
   private
   public :: load
 contains
   function load () result (p)
     type(omega_procedures) :: p
     p%number_particles_in => number_particles_in
     p%number_particles_out => number_particles_out
     p%number_spin_states => number_spin_states
     p%spin_states => spin_states
     p%number_flavor_states => number_flavor_states
     p%flavor_states => flavor_states
     p%number_color_indices => number_color_indices
     p%number_color_flows => number_color_flows
     p%color_flows => color_flows
     p%number_color_factors => number_color_factors
     p%color_factors => color_factors
     p%color_sum => color_sum
     p%new_event => new_event
     p%reset_helicity_selection => reset_helicity_selection
     p%is_allowed => is_allowed
     p%get_amplitude => get_amplitude
   end function load
 end module interface_ward_ufo_${mode}_${module}
 
 EOF
 
     done
 
 done
 
 ########################################################################
 
 cat <<EOF
 program ward_ufo_driver
   use kinds
   use ward_lib
 EOF
 
 for module in $modules; do
     for mode in physical unphysical; do
 cat <<EOF
   use interface_ward_ufo_${mode}_${module}, load_${mode}_${module} => load
 EOF
     done
 done
 
 for model in $models; do
 cat <<EOF
   use parameters_$model, init_parameters_$model => setup_parameters
 EOF
 done
 
 cat <<EOF
   implicit none
   integer, parameter :: N = 1000
   real(kind=default), parameter :: THRESHOLD = 0.8
   real(kind=default), parameter :: ROOTS = 1000
   integer, parameter :: SEED = 42
   integer :: failures, attempts, failed_processes, attempted_processes
   failed_processes = 0
   attempted_processes = 0
 EOF
 
 for model in $models; do
 cat <<EOF
   call init_parameters_$model ()
 EOF
 done
 
 for module in $modules; do
 
 eval process="\${process_$module}"
 eval n="\${n_$module}"
 eval threshold="\${threshold_$module}"
 eval roots="\${roots_$module}"
 
 cat <<EOF
   print *, "checking process '$process'"
   call check (load_physical_$module (), load_unphysical_$module (), &
               roots = real ($roots, kind=default), &
-	      m1 = 0._default, m2 = 0._default, &
-	      m3 = 0._default, m4 = 0._default, &
-              threshold = real ($threshold, kind=default), &	      
+              m1 = 0._default, m2 = 0._default, &
+              m3 = 0._default, m4 = 0._default, &
+              threshold = real ($threshold, kind=default), &
               n = $n, seed = SEED, &
               failures = failures, attempts = attempts)
   if (failures > 0) then
      print *, failures, " failures in ", attempts, " attempts"
      failed_processes = failed_processes + 1
   end if
 EOF
 done
 
 cat <<EOF
   if (failed_processes > 0) then
      print *, failed_processes, " failed processes in ", attempted_processes, " attempts"
      stop 1
   end if
 end program ward_ufo_driver
 EOF
 
 exit 0
Index: trunk/omega/tests/ward_driver.sh
===================================================================
--- trunk/omega/tests/ward_driver.sh	(revision 8813)
+++ trunk/omega/tests/ward_driver.sh	(revision 8814)
@@ -1,175 +1,175 @@
 #! /bin/sh
 # ward_driver.sh --
 ########################################################################
 
 omega="$1"
 shift
 
 models="qed qcd sym sm sm_top_anom"
 
 modules=""
 
 ########################################################################
 # m1 m2 are the masses of the incoming particles
 # m3 m4 are the masses of the first two outgoing particles, all further
 #            outgoing particles are assumed to be massless
 ########################################################################
 while read module threshold n roots m1 m2 m3 m4 model unphysical mode process; do 
 
   case $module in
 
    '#'*) # skip comments
      ;;
 
    '')   # skip empty lines
      ;;
 
    '!'*) break
      ;;
 
     *)
       ########################################################################
       modules="$modules $module"
       eval threshold_$module=$threshold
       eval n_$module=$n
       eval roots_$module=$roots
       eval m1_$module=$m1
       eval m2_$module=$m2
       eval m3_$module=$m3
       eval m4_$module=$m4
       eval process_$module="'$process'"
       ########################################################################
 
       ########################################################################
 
       omega_bin="`echo $omega | sed s/%%%/$model/g`"
       # echo "running $omega_bin -$mode '$process'" 1>&2
       $omega_bin "$@" \
         -target:parameter_module parameters_$model \
         -target:module amplitude_ward_physical_$module \
         -$mode "$process" 2>/dev/null
       $omega_bin "$@" \
         -target:parameter_module parameters_$model \
         -target:module amplitude_ward_unphysical_$module \
         -$mode "$process" -unphysical $unphysical 2>/dev/null
     ;;
   esac
 
 done
 ########################################################################
 
 for module in $modules; do
 
     for mode in physical unphysical; do
 
 cat <<EOF
 module interface_ward_${mode}_${module}
   use omega_interface
   use amplitude_ward_${mode}_${module}
   implicit none
   private
   public :: load
 contains
   function load () result (p)
     type(omega_procedures) :: p
     p%number_particles_in => number_particles_in
     p%number_particles_out => number_particles_out
     p%number_spin_states => number_spin_states
     p%spin_states => spin_states
     p%number_flavor_states => number_flavor_states
     p%flavor_states => flavor_states
     p%number_color_indices => number_color_indices
     p%number_color_flows => number_color_flows
     p%color_flows => color_flows
     p%number_color_factors => number_color_factors
     p%color_factors => color_factors
     p%color_sum => color_sum
     p%new_event => new_event
     p%reset_helicity_selection => reset_helicity_selection
     p%is_allowed => is_allowed
     p%get_amplitude => get_amplitude
   end function load
 end module interface_ward_${mode}_${module}
 
 EOF
 
     done
 
 done
 
 ########################################################################
 
 cat <<EOF
 program ward_driver
   use kinds
   use ward_lib
 EOF
 
 for module in $modules; do
     for mode in physical unphysical; do
 cat <<EOF
   use interface_ward_${mode}_${module}, load_${mode}_${module} => load
 EOF
     done
 done
 
 for model in $models; do
 cat <<EOF
   use parameters_$model, init_parameters_$model => init_parameters
 EOF
 done
 
 cat <<EOF
   implicit none
   integer, parameter :: N = 1000
   real(kind=default), parameter :: THRESHOLD = 0.8
   real(kind=default), parameter :: ROOTS = 1000
   real(kind=default) :: m1, m2, m3, m4
   integer, parameter :: SEED = 42
   integer :: failures, attempts, failed_processes, attempted_processes
   failed_processes = 0
   attempted_processes = 0
 EOF
 
 for model in $models; do
 cat <<EOF
   call init_parameters_$model ()
 EOF
 done
 
 for module in $modules; do
 
 eval process="\${process_$module}"
 eval n="\${n_$module}"
 eval threshold="\${threshold_$module}"
 eval roots="\${roots_$module}"
 eval m1="\${m1_$module}"
 eval m2="\${m2_$module}"
 eval m3="\${m3_$module}"
 eval m4="\${m4_$module}"
 
 cat <<EOF
   print *, "checking process '$process'"
   call check (load_physical_$module (), load_unphysical_$module (), &
               roots = real ($roots, kind=default), &
-	      m1 = real ($m1, kind=default), m2 = real ($m2, kind=default), &
-	      m3 = real ($m3, kind=default), m4 = real ($m4, kind=default), &
+              m1 = real ($m1, kind=default), m2 = real ($m2, kind=default), &
+              m3 = real ($m3, kind=default), m4 = real ($m4, kind=default), &
               threshold = real ($threshold, kind=default), &
               n = $n, seed = SEED, &
               failures = failures, attempts = attempts)
   if (failures > 0) then
      print *, failures, " failures in ", attempts, " attempts"
      failed_processes = failed_processes + 1
   end if
 EOF
 done
 
 cat <<EOF
   if (failed_processes > 0) then
      print *, failed_processes, " failed processes in ", attempted_processes, " attempts"
      stop 1
   end if
 end program ward_driver
 EOF
 
 exit 0